p4.pm #6

  • //
  • guest/
  • perforce_software/
  • revml/
  • lib/
  • VCP/
  • Utils/
  • p4.pm
  • View
  • Commits
  • Open Download .zip Download (7 KB)
package VCP::Utils::p4 ;

=head1 NAME

VCP::Utils::p4 - utilities for dealing with the p4 command

=head1 SYNOPSIS

   use base qw( ... VCP::Utils::p4 ) ;

=head1 DESCRIPTION

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

=cut

use strict ;

use Carp ;
use VCP::Debug qw( debug debugging ) ;
use File::Spec ;
use File::Temp qw( mktemp ) ;
use POSIX ':sys_wait_h' ;

=head1 METHODS

=item repo_client

The p4 client name. This is an accessor for a data member in each class.
The data member should be part of VCP::Utils::p4, but the fields pragma
does not support multiple inheritance, so the accessor is here but all
derived classes supporting this accessor must provide for a key named
"P4_REPO_CLIENT".

=cut

sub repo_client {
   my $self = shift ;

   $self->{P4_REPO_CLIENT} = shift if @_ ;
   return $self->{P4_REPO_CLIENT} ;
}


=item p4

Calls the p4 command with the appropriate user, client, port, and password.

=cut

sub p4 {
   my $self = shift ;

   local $ENV{P4PASSWD} = $self->repo_password if defined $self->repo_password ;
   unshift @{$_[0]}, '-p', $self->repo_server  if defined $self->repo_server ;
   unshift @{$_[0]}, '-c', $self->repo_client  if defined $self->repo_client ;
   unshift @{$_[0]}, '-u', $self->repo_user    if defined $self->repo_user ;

   ## TODO: Specify an empty 

   ## localizing this was giving me some grief.  Can't recall what.
   ## PWD must be cleared because, unlike all other Unix utilities I
   ## know of, p4 looks at it and bases it's path calculations on it.
   my $tmp = $ENV{PWD} ;
   delete $ENV{PWD} ;

   my $args = shift ;

   $self->run_safely( [ $^O !~ /Win32/ ? "p4" : "p4.exe", @$args ], @_ ) ;
   $ENV{PWD} = $tmp if defined $tmp ;
}


=item parse_p4_repo_spec

Calls $self->parse_repo_spec, the post-processes the repo_user in to a user
name and a client view. If the user specified no client name, then a client
name of "vcp_tmp_$$" is used by default.

This also initializes the client to have a mapping to a working directory
under /tmp, and arranges for the current client definition to be restored
or deleted on exit.

=cut

sub parse_p4_repo_spec {
   my $self = shift ;
   my ( $spec ) = @_ ;

   my $parsed_spec = $self->parse_repo_spec( $spec ) ;

   my ( $user, $client ) ;
   ( $user, $client ) = $self->repo_user =~ m/([^()]*)(?:\((.*)\))?/
      if defined $self->repo_user ;
   $client = "vcp_tmp_$$" unless defined $client && length $client ;

   $self->repo_user( $user ) ;
   $self->repo_client( $client ) ;

   if ( $self->can( "min" ) ) {
      my $filespec = $self->repo_filespec ;

      ## If a change range was specified, we need to list the files in
      ## each change.  p4 doesn't allow an @ range in the filelog command,
      ## for wataver reason, so we must parse it ourselves and call lots
      ## of filelog commands.  Even if it did, we need to chunk the list
      ## so that we don't consume too much memory or need a temporary file
      ## to contain one line per revision per file for an entire large
      ## repo.
      my ( $name, $min, $comma, $max ) ;
      ( $name, $min, $comma, $max ) =
	 $filespec =~ m/^([^@]*)(?:@(-?\d+)(?:(\D|\.\.)((?:\d+|#head)))?)?$/i
	 or die "Unable to parse p4 filespec '$filespec'\n";

      die "'$comma' should be ',' in revision range in '$filespec'\n"
	 if defined $comma && $comma ne ',' ;

      if ( ! defined $min ) {
	 $min = 1 ;
	 $max = '#head' ;
      }

      if ( ! defined $max ) {
	 $max = $min ;
      }
      elsif ( lc( $max ) eq '#head' ) {
	 $self->p4( [qw( counter change )], \$max ) ;
	 chomp $max ;
      }

      if ( $max == 0 ) {
         ## TODO: make this a "normal exit"
         die "Current change number is 0, no work to do\n";
      }

      if ( $min < 0 ) {
	 $min = $max + $min ;
      }

      $self->repo_filespec( $name ) ;
      $self->min( $min ) ;
      $self->max( $max ) ;
   }

   return $parsed_spec ;
}


=item init_p4_view

   $self->init_p4_view

Borrows or creates a client with the right view.  Only called from
VCP::Dest::p4, since VCP::Source::p4 uses non-view oriented commands.

=cut

sub init_p4_view {
   my $self = shift ;

   my $client = $self->repo_client ;

   $self->repo_client( undef ) ;
   my $client_exists = grep $_ eq $client, $self->p4_clients ;
   debug "p4: client '$client' exists" if $client_exists && debugging $self ;
   $self->repo_client( $client ) ;

   my $client_spec = $self->p4_get_client_spec ;
   $self->queue_p4_restore_client_spec( $client_exists ? $client_spec : undef );

   my $p4_spec = $self->repo_filespec ;
   $p4_spec =~ s{(/(\.\.\.)?)?$}{/...} ;
   my $work_dir = $self->work_root ;

   $client_spec =~ s{^Root.*}{Root:\t$work_dir}m ;
   $client_spec =~ s{^View.*}{View:\n\t$p4_spec\t//$client/...\n}ms ;
   $client_spec =~ s{^(Options:.*)}{$1 nocrlf}m 
      if $^O =~ /Win32/ ;
   $client_spec =~ s{^LineEnd.*}{LineEnd:\tunix}mi ;

   debug "p4: using client spec", $client_spec if debugging $self ;

   $self->p4_set_client_spec( $client_spec ) ;

}

=item p4_clients

Returns a list of known clients.

=cut

sub p4_clients {
   my $self = shift ;

   my $clients ;
   $self->p4( [ "clients", ], ">", \$clients ) ;
   return map { /^Client (\S*)/ ; $1 } split /\n/m, $clients ;
}

=item p4_get_client_spec

Returns the current client spec for the named client. The client may or may not
exist first, grep the results from L</p4_clients> to see if it already exists.

=cut

sub p4_get_client_spec {
   my $self = shift ;
   my $client_spec ;
   $self->p4( [ "client", "-o" ], ">", \$client_spec ) ;
   return $client_spec ;
}


=item queue_p4_restore_client_spec

   $self->queue_p4_restore_client_spec( $client_spec ) ;

Saves a copy of the named p4 client and arranges for it's restoral on exit
(assuming END blocks run). Used when altering a user-specified client that
already exists.

If $client_spec is undefined, then the named client will be deleted on
exit.

Note that END blocks may be skipped in certain cases, like coredumps,
kill -9, or a call to POSIX::exit().  None of these should happen except
in debugging, but...

=cut

my @client_backups ;

END {
   for ( @client_backups ) {
      my ( $object, $name, $spec ) = @$_ ;
      my $tmp_name = $object->repo_client ;
      $object->repo_client( $name ) ;
      if ( defined $spec ) {
	 $object->p4_set_client_spec( $spec ) ;
      }
      else {
         my $out ;
         $object->p4( [ "client", "-d", $object->repo_client ], ">", \$out ) ;
	 die "vcp: unexpected stdout from p4:\np4: ", $out
	    unless $out =~ /^Client\s.*\sdeleted./ ;
      }
      $object->repo_client( $tmp_name ) ;
      $_ = undef ;
   }
   @client_backups = () ;
}


sub queue_p4_restore_client_spec {
   my $self = shift ;
   my ( $client_spec ) = @_ ;
   push @client_backups, [ $self, $self->repo_client, $client_spec ] ;
}

=item p4_set_client_spec

   $self->p4_set_client_spec( $client_spec ) ;

Writes a client spec to the repository.

=cut


sub p4_set_client_spec {
   my $self = shift ;
   my ( $client_spec ) = @_ ;

   ## Capture stdout so it doesn't leak.
   my $out ;
   $self->p4( [ "client", "-i" ], "<", \$client_spec, ">", \$out ) ;

   die "vcp: unexpected stdout from p4:\np4: ", $out
      unless $out =~ /^Client\s.*\ssaved.$/ ;
}


=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 ;
# Change User Description Committed
#67 5085 Barrie Slaymaker - Prevent $_ from getting clobbered, esp.
in sdbm.pm
#66 4523 Barrie Slaymaker - Don't autodetect P4::Client by default, require setting VCPP4CLIENT=1
#65 4478 Barrie Slaymaker - "client not changed" message ignored (thanks clkao)
#64 4470 Barrie Slaymaker - VCP::Utils::p4 is more test friendly
#63 4414 Barrie Slaymaker - Indentation corrected
#62 4067 Barrie Slaymaker - VCP::Source::p4 now tells the user what's taking so long while
  it's requesting initial data sets from the repository
- VCP::Source::p4 no longer loads the branch specs from the source,
  they're no longer used.
#61 4021 Barrie Slaymaker - Remove all phashes and all base & fields pragmas
- Work around SWASHGET error
#60 4019 Barrie Slaymaker - typo fixed
#59 4006 Barrie Slaymaker - VCP will now use the P4::Client module if it's installed.
#58 3973 Barrie Slaymaker - p4d launching no longer require IPC::Run on Unix
#57 3970 Barrie Slaymaker - VCP::Source handles rev queing, uses disk to reduce RAM
- Lots of other fixes
#56 3900 Barrie Slaymaker - p4-like specs (such as VCP's config files) may now contain
  underscores in their field names ("csv_trace:").
#55 3893 Barrie Slaymaker - p4d is now launched in the proper directory
#54 3833 Barrie Slaymaker - Minor debugging improvements
#53 3799 Barrie Slaymaker - Empty strings values emitted by p4 set are parsed
#52 3736 Barrie Slaymaker - Source and dest specs are now quoted in .vcp files as needed
- The server and client paths are now quoted in the p4 client
  vcp creates
#51 3649 Barrie Slaymaker - Stray DB::single = 1s removed
#50 3572 John Fetkovich added y/n question to accept default of user_id
#49 3570 John Fetkovich change p4_get_settings (wrapper around 'p4 set' command)
to remove parenthesized things at the end of a line
which indicate where a value came from (such as a config file)
#48 3569 Barrie Slaymaker - Work around bug caused by p4's using the long pathname when
  $ENV{PWD} is not set.
#47 3508 John Fetkovich added p4_get_settings sub to read P4...
env vars/config settings
#46 3480 John Fetkovich add friendly error message if p4_spec has no leading '/'.
#45 3432 Barrie Slaymaker - "p4 print" to "p4 sync"
#44 3422 Barrie Slaymaker - Factor some common code in to VCP::Utils::p4.
- Add error when a p4 filespec ends in a '/' or '\'
- Clean up revml2p4 test scripts
#43 3402 Barrie Slaymaker - now passes all tests using the p4 api library.
  (still not default, set env var VCPP4API=1)
- foo->p4 handles branch-but-no-change case when
  --change-branch-rev-1 is passed.
- sources & dests can now provide their own command
  execution routine in place of shelling out to an
  external command (as in call the p4api library
  instead of running the p4 command).
#42 3382 John Fetkovich Moved setting of repo_id to 'sub init'
       moved defaulting of repo_server to P4PORT env var to 'sub init'
#41 3377 John Fetkovich bug fixes for weird input
#40 3284 John Fetkovich 'sub new' constructor in Source and Dest p4.pm fixed so parse_p4_repo_spec
       only called when a $spec is provided to the constructor.  parse_p4_repo_spec
       now also sets the repo_id.  parse_repo_spec (TODO item) no longer returns
       a hash value of the values parsed, it only sets fields in $self.  Fixed a few
       places where that return hash was used.
#39 3173 Barrie Slaymaker Add partial support for P4 API to test with.
#38 3167 Barrie Slaymaker Add profiling report that details various chunks of time
       taken.
#37 3155 Barrie Slaymaker Convert to logging using VCP::Logger to reduce stdout/err spew.
       Simplify & speed up debugging quite a bit.
       Provide more verbose information in logs.
       Print to STDERR progress reports to keep users from wondering
       what's going on.
       Breaks test; halfway through upgrading run3() to an inline
       function for speed and for VCP specific features.
#36 3098 Barrie Slaymaker Convert all length p4 command line calls to us p4 -x -.
       All hail p4 -x -.
#35 3079 Barrie Slaymaker Remove old commented-out code
#34 3014 Barrie Slaymaker minor warnings cleanups
#33 2967 Barrie Slaymaker Fix p4d launch retry and port selection logic
#32 2953 John Fetkovich p4d was still not attempting a re-launch if a launch failed
       due to the TCP port apparently being taken.  Probably fixed now.
#31 2933 John Fetkovich Added calls to empty()
#30 2932 John Fetkovich Fixed launch_p4d so if it fails to find an open port,
       it will retry.
#29 2862 Barrie Slaymaker Swallow p4d output to stdout so it won't interfere with emitting
       revml (or any other output) to stdout.
#28 2719 Barrie Slaymaker Improve error reporting, allow run_safely's in_dir to be
       relative to the default command_chdir setting
#27 2704 Barrie Slaymaker export underscorify_name
#26 2692 Barrie Slaymaker Centralize escaping of p4 label (etc) names.
NOTE: I have not been able to find a description of the set of legal p4
names (namelength, character set, etc).  This is purely a first attempt,
if you have details on this, please let me know.
#25 2689 Barrie Slaymaker Prevent kill_all_vcp_p4ds() from swallowing $?
#24 2664 Barrie Slaymaker Try IPC::Run3 to see if it speeds up p4 calls
#23 2641 Barrie Slaymaker Add --run-p4d option to VCP::{Source,Dest}::p4.
       Implement port hunting and p4d up & ready detection for
       vcp-launched p4ds.
#22 2639 John Fetkovich Added profiling to be made active when VCPPROFILE environment
       variable turned on.  writes profile info to filename defined
       in VCPPROFILE.  Put some profiling statements (activated at
       compile time) in vcp and p4.pm.
#21 2589 John Fetkovich Split 90p4.t into 90revml2p4_0.t, 90revml2p4_1.t, 91p42revml.t, 95p42cvs.t.
       Added some utilities to the library files listed.
#20 2350 Barrie Slaymaker Get p4d to be killed after the last p4 cleanup commands,
       generalize the p4d launching & destruction system because
       we'll need it in VCP::Source::p4 too to take checkpoints.
#19 2318 Barrie Slaymaker enable end of line comments
#18 2303 Barrie Slaymaker Allow field values to be one letter in p4 forms
#17 2293 Barrie Slaymaker Update CHANGES, TODO, improve .vcp files, add --init-cvs
#16 2283 Barrie Slaymaker fix error message
#15 2282 Barrie Slaymaker Add in support for *.vcp files
#14 2278 Barrie Slaymaker Reduce use()ed modules quite a bit.
 old copy-n-paste
       leftovers, don't want to slow down VCP.pm which now
       needs the p4 forms i/o.
#13 2051 Barrie Slaymaker Enable p4_branch_spec to be carried through revml->revml.
#12 2042 Barrie Slaymaker Basic source::p4 branching support
#11 1855 Barrie Slaymaker Major VSS checkin.
 Works on Win32
#10 1852 Barrie Slaymaker force delete clients, so that later test runs won't trip over them
#9 1851 Barrie Slaymaker No need to die() in an END block.
#8 1841 Barrie Slaymaker Remove .exe if Win32 hack now that IPC::Run is better.
#7 1816 Barrie Slaymaker hack around the p4 client -o Options: hibit corruption problem
#6 1809 Barrie Slaymaker VCP::Patch should ignore lineends
#5 1358 Barrie Slaymaker Win32 changes
#4 703 Barrie Slaymaker VCP::Source::p4 now uses VCP::Utils::p4::parse_p4_repo_spec()
#3 702 Barrie Slaymaker Doc tweak
#2 694 Barrie Slaymaker cleanup up warning about undef var in VCP::Utils::p4.
#1 692 Barrie Slaymaker Add VCP::Utils::p4 and use it to get VCP::Dest::p4 to create it's
own client view as needed.