Utils.pm #21

package VCP::Utils;

=head1 NAME

VCP::Utils - utilities used within VCP's modules.

=head1 SYNOPSIS

   use VCP::Utils qw( shell_quote );

=head1 DESCRIPTION

A mix-in class providing methods shared by VCP::Source::cvs and VCP::Dest::cvs,
mostly wrappers for calling the cvs command.

=cut

@EXPORT_OK = qw(
   empty
   escape_filename
   profile
   profiling
   profile_beg_interval
   profile_end_interval
   prepend_time_cmd
   shell_quote
   start_dir
);

@ISA = qw( Exporter );
use Exporter;

use Carp;
use strict ;
use File::Spec;
use IO::Handle ;
use Cwd;

my $start_dir;
BEGIN { $start_dir = cwd }

# disallow defined but not true logfiles.
# TODO: Tell the user that they used a bad profile file name or allow
# defined but false names.
#
use constant profiling => 
   defined $ENV{VCPPROFILE} && length $ENV{VCPPROFILE} ;
use constant profiling_with_time =>
   defined $ENV{VCPPROFILETIME} && length $ENV{VCPPROFILETIME} ;



my $profile_file_name;

BEGIN {
   if ( profiling ) {
      eval "use Time::HiRes qw(gettimeofday tv_interval); 1" or die $@;

      $profile_file_name = File::Spec->rel2abs( $ENV{VCPPROFILE} );
      
      open PROFILE_LOG, ">>$profile_file_name"
         or die "couldn't open log file '$profile_file_name' for append\n";
      autoflush PROFILE_LOG 1
         if profiling_with_time;
   }
}


=head1 FUNCTIONS

=over

=item shell_quote

   my $line = shell_quote \@command;
   my $line = shell_quote @command;
   print STDERR, $line, "\n";

Selectively quotes the command line to allow it to be printed in a non-vague
fashion and to be pastable in the local shell (sh/bash on Unix, COMMAND.COM,
etc. on Win32 and OS2).

NOTE: May not be perfect; errs on the side of safety and doesn't try to
escape things right on Win32 yet.  Patches welcome.

=cut

{
my $q = $^O =~ /Win32|OS2/ ? '"' : "'";

    sub shell_quote {
       my @parms = ref $_[0] eq "ARRAY" ? @{$_[0]} : @_;

       return join " ", map {
          defined $_ ? m{[^\w:/\\.,=-]}
             ? do {
                ( my $s = $_ ) =~ s/[\\$q]/\\$1/;
                "$q$s$q";
             }
             : $_ : "<<undef>>";
       } @parms;
    }
}


=item empty

Determines if a scalar value is empty, that is
not defined or zero length.

=cut

sub empty($) { 
   return ! ( defined $_[0] && length $_[0] );
}


=item escape_filename

escape a string so that it may be used as a filename.

=cut

sub escape_filename {
   my ($s) = @_;
   croak "usage: escape_filename <filename-to-escape>"
      if empty $s;

   $s =~ s/([^0-9a-zA-Z.\-_])/sprintf '%%%03d', ord $1/eg ;
   return $s;
}


=item start_dir

Returns the directory that was current when VCP::Utils was parsed.

=cut

sub start_dir { $start_dir }


=item profile

log high resolution time info to the PROFILE_LOG file.

=cut


sub profile {
   unless ( profiling ) {
      return;
   }

   die "usage: log_time <message>" unless @_ == 1;
   die "profile's log message must start with the string BEG or END"
      unless $_[0] =~ /^(BEG|END)/ ;
      
   my ($sec, $usec) = gettimeofday();
   seek PROFILE_LOG, 0, 2 or warn "$! seeking in PROFILE_LOG";
   printf PROFILE_LOG "%10d.%06d $_[0]\n", $sec, $usec;
}


=item profile_start_interval

takes no arguments.
returns a reference to array returned by gettimeofday.

=cut

sub profile_beg_interval {
   unless( profiling ) {
      return;
   }
   die "usage: profile_beg_interval" unless @_ == 0;

   my @timeofday = gettimeofday();
   return \@timeofday;
}


=item profile_end_interval

takes: 
1. a reference to array returned by gettimeofday (or profile_beg_interval)
2. a log message.

calculates interval between the given time and the current time.
logs that as 'ELA' (elapsed time) to the profile log.

=cut

sub profile_end_interval {
   unless( profiling ) {
      return;
   }
   die "usage: profile_end_interval <prev_time_ref>, <msg>" unless @_ == 2;

   my ($prev_time_ref, $msg) = @_;
   my $tv_interval = tv_interval $prev_time_ref;

   seek PROFILE_LOG, 0, 2 or warn "$! seeking in PROFILE_LOG";
   printf PROFILE_LOG "%s ELA $msg\n", $tv_interval;
}



=item prepend_time_cmd

Prepend unix time command to the given command and return it.
the command must be given as an array reference.

Only change code if VCPPROFILETIME is set.

=cut


my $time_full_path;

sub prepend_time_cmd {
   unless( profiling ) {
      die "prepend_time_cmd should only be called when profiling is turned on.";
   }
   
   die "usage: prepend_time_cmd <command-arg-array-ref>"
      unless @_ == 1 && ref $_[0] eq "ARRAY";
   my @cmd = @{$_[0]};

   if( profiling_with_time ) {
      my $cmdstr = join " ", @cmd;

      unless( $time_full_path ) {
         $time_full_path = `which time`;
         chomp $time_full_path;
      }
      my @time_cmd = ( $time_full_path, "-o", $profile_file_name, "-a", "-f", "%e ELA $cmdstr" );

      unshift @cmd, @time_cmd;
   }

   return \@cmd;
}


=back

=head1 COPYRIGHT

Copyright 2000, Perforce Software, Inc.  All Rights Reserved.

This module and the VCP package are licensed according to the terms given in
the file LICENSE accompanying this distribution, a copy of which is included in
L<vcp>.

=cut

1 ;