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"; } : $_ : "<>"; } @parms; } } =item escape_filename escape a string so that it may be used as a filename. TODO: check if Win32 and behave apropriately. This will need to do more. =cut sub escape_filename { my ($s) = @_; croak "usage: escape_filename " unless defined $s && length $s; $s =~ s/%/%%/ ; } =item empty Determines if a scalar value is empty, that is not defined or zero length. =cut sub empty { ! ( defined $_[0] && length $_[0] ) } =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 " 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 , " 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 " 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. =cut 1 ;