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 VCP::Debug qw( debug debugging ) ; =head1 METHODS =over =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 ; #if ( $ENV{UHOH} && grep( /^client$/, @$args ) && grep( /^-o$/, @$args ) ) { # warn( ">>>>>>>>>>>>>p4.exe @$args > bah1" ); # system( "p4.exe @$args > bah1" ); # system( "p4.exe @$args > bah2" ); #} $self->run_safely( [ "p4", @$args ], @_ ) ; $ENV{PWD} = $tmp if defined $tmp ; } =item parse_p4_form my %form = $self->parse_p4_form( $form ); my %form = $self->parse_p4_form( \@command_to_emit_form ); Parses a p4 form and returns a list containing the form's data elements in the order that they were accumulated. This is suitable for initializing a hash if order's not important, or an array if it is. You can pass the form in verbatim, or a reference to a command to run to get the form. If the first parameter is an ARRAY reference, all parameters will be passed to C<$self->p4> with stdout redirected to a temporary variable. Multiline fields will have trailing \n>s in the data, single-line fields won't. All fields have leading spaces on each line removed. Comments are tagged with a field name of "#", blank (containing only spaces if that) are tagged with a " ". This is to allow accurate reproduction of the file if reemitted. =cut sub parse_p4_form { my $self = shift; my $form; if ( ref $_[0] eq "ARRAY" ) { $self->p4( $_[0], ">", \$form, @_[1..$#_] ) } else { $form = shift; } my @lines = split /\r?\n/, $form; my @entries; my $accum; for ( @lines ) { if ( /\A\s*\z/ ) { push @entries, ( " ", $_ ); } if ( s/^\s*#\s*(.*)/$1/ ) { unless ( @entries && $entries[-2] eq "#" ) { chomp $entries[-1] if $accum; push @entries, ( "#", "" ); $accum = 1; } } elsif ( /^([A-Za-z]+):(?:\s*(.+))?\z/ ) { chomp $entries[-1] if $accum; $accum = undef; push @entries, $1; if ( defined $2 ) { push @entries, $2; } else { push @entries, ""; $accum = 1; } next; } if ( $accum ) { s/^\s*//; ## This may be too general. May need to trim the same ## number of characters from each line. $entries[-1] .= $_ . "\n"; } elsif ( ! length ) { next; } else { warn "Ignoring '$_' from p4 output\n"; } } chomp $entries[-1] if $accum; return @entries; } =item build_p4_form my $form = $self->build_p4_form( @form_fields ); my $form = $self->build_p4_form( %form_fields ); $self->build_p4_form( ..., \@command_to_emit_form ); Builds a p4 form and either returns it or submits it to the indicated command. =cut sub build_p4_form { my $self = shift; my @form; while ( @_ ) { last if ref $_[0] eq "ARRAY"; ## rest is a command. my ( $name, $value ) = ( shift, shift ); if ( $name eq "#" ) { $value =~ s/^/# /mg; chomp $value; push @form, $value, "\n\n"; next; } push @form, ( $name, ":" ); if ( $value =~ tr/\n// ) { push @form, "\n" unless substr( $value, 0, 1 ) eq "\n"; $value =~ s/^/\t/gm; chomp $value; push @form, $value, "\n\n"; } else { push @form, ( " ", $value, "\n\n" ); } } my $form = join "", @form; @form = (); $self->p4( $_[0], "<", \$form, @_[1..$#_] ) if @_; return $form; } =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 change_id 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 ; ## work around a wierd intermittant failure on Win32. The ## Options: line *should* end in nomodtime normdir ## instead it looks like: ## ## Options: noallwrite noclobber nocompress unlocked nomÔ+ ## ## but only occasionally! $client_spec = $self->p4_get_client_spec if $^O =~ /Win32/ && $client_spec =~ /[\x80-\xFF]/; $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 ; debug "p4: using client spec", $client_spec if debugging $self ; $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 { my $child_exit; { local $?; ## Protect this; we're about to run a child process and ## we want to exit with the appropriate value. 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", "-df", $object->repo_client ], ">", \$out); warn "vcp: unexpected stdout from p4:\np4: ", $out unless $out =~ /^Client\s.*\sdeleted./ ; $child_exit = $?; } $object->repo_client( $tmp_name ) ; $_ = undef ; } @client_backups = () ; } $? = $child_exit if $child_exit && ! $?; } 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.$/ ; } =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 ;
# | 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. |