Utils.pm #9

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 = qw(
   shell_quote
   profile
   profiling
   prepend_time_cmd
);

@ISA = qw( Exporter );
use Exporter;

use Carp;
use strict ;
use Cwd;
use IO::Handle ;
use Env::Path qw(PATH) ;

# disallow defined but not true logfiles.
use constant profiling => defined $ENV{VCPPROFILE} && length $ENV{VCPPROFILE} && $ENV{VCPPROFILE} ;

# return the profile file
my $profile_file_name;


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

      $profile_file_name = abs_path( $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 ;
   }
}


=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 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();
   printf PROFILE_LOG "%10d.%06d $_[0]\n", $sec, $usec;
}

=item profile

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

=cut


my $time_full_path;

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

   unless( $time_full_path ) {
      Env::Path->PATH;
      $time_full_path = PATH->Whence( "time" );
   }
   my @time_cmd = ( $time_full_path, "-o", $profile_file_name, "-a", "-f", "%e ELA $cmdstr" );

   unshift @cmd, @time_cmd;

#   print join " ", @cmd;
#   print "\n+++++++++++++++++++++\n";

   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 ;