package P4; use strict; use vars qw(@ISA @verbs); use subs qw(import AUTOLOAD); require Exporter; @ISA = qw(Exporter); @verbs = qw( add admin branch branches change changes client clients counter counters delete depot depots describe diff diff2 dirs edit filelog files fix fixes flush fstat group groups have help info integrate integrated job jobs jobspec label labels labelsync lock obliterate opened passwd print protect rename reopen resolve resolved revert review reviews set submit sync triggers unlock user users verify where ); sub import { my $self = shift; my ($callpack, $callfile, $callline) = caller; my @EXPORT = 'AUTOLOAD'; foreach my $sym (@EXPORT) { no strict "refs"; *{"${callpack}::$sym"} = \&{"P4::$sym"}; use strict "refs"; } }; AUTOLOAD { use vars qw(*AUTOLOAD); my $cmd = $AUTOLOAD; $cmd =~ s/^.*:://; if (grep /$cmd/, @verbs) { my ($callpack, $callfile, $callline) = caller; no strict "refs"; my $opts = ${"${callpack}::options"}; my $args = ${"${callpack}::arguments"}; use strict "refs"; eval qq { *$AUTOLOAD = sub { open(SUBPROC, "p4 $opts $cmd $args |") or die "Can't exec $cmd: \$!\n"; if (wantarray) { my \@ret = ; close SUBPROC; \@ret; } else { local(\$/) = undef; my \$ret = ; close SUBPROC; \$ret; } } }; } else { eval qq { *$AUTOLOAD = sub { P4::Simple::$cmd(\@_); } }; } goto &$AUTOLOAD; } package P4::Simple; use strict; use Carp; #require Exporter; local (*STDOUT, *IN, *OUT); use subs qw( run_p4 _setup_vars _error_handler _reset _redir_i _redir_o _form_vals _write_file Info Label Get ci Checkin co Checkout User Group Client Protect getForm setForm Admin Ulist SList ); # @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION use vars qw( %p4db %MUL $options $arguments %form $formFile $result $datapath $licenses $userlist $p4Schema $p4XSLT $VERSION *SAVEIN *SAVEOUT *SAVEERR ); $VERSION = '0.18'; my $tempdir = (defined $ENV{tmp} && -d $ENV{tmp} && -w $ENV{tmp}) ? $ENV{tmp} : (defined $ENV{TEMP} && -d $ENV{TEMP}) ? $ENV{TEMP} : '.'; # use env var tmp or TEMP or . (current dir) BEGIN { # ini conf variables - server aliases # default directory for data files - p4-servers.ini & MUL.txt $datapath = "."; $licenses = 395; $userlist = -e './MUL.txt' ? './MUL.txt' : 'nul'; my @sects; my $profile = -e './p4servers.ini' ? './p4servers.ini' : 'nul'; if (-e $profile) { require 'IniConf.pm'; import IniConf qw(new); $result = "Using active profile, $profile"; my $cfg = IniConf->new(-file=>$profile); if (defined $cfg) { @sects = $cfg->Sections; } else { print "Invalid data file: aliases disabled for this session\n"; foreach (@IniConf::errors) {print}; } foreach my $sect (@sects) { foreach my $envk ($cfg->Parameters($sect)) { $p4db{$sect}{$envk} = $cfg->val($sect, $envk); } } } else { $result = "Failed to find profile, $profile"; } } $formFile = "$tempdir/form.p4"; _reset(); # the ini file translation to XML syntax $p4Schema =<<'EOS'; EOS $p4XSLT =<<'EOX'; Perforce Servers

Perforce Servers

:
ID Name Description Status Contact Admin Host:Port Root Log Journal
EOX sub run_p4 { ##### # runs a Perforce command (p4) ##### my ($cmd) = @_; $result = undef; open(SUBPROC, "p4 $options $cmd $arguments |") or return $!; local($/) = undef; my $ret = ; close SUBPROC; if ($?) { _error_handler("$cmd $options $arguments", $ret); _reset(); return; } else { $result = $ret; } _reset(); return $ret; } sub _setup_vars { ##### # given options hash, sets the package global variables, deletes the form file ##### my %opts = @_; $options .= " -p " . $p4db{$opts{alias}}{P4HOST} . ':' . $p4db{$opts{alias}}{P4PORT} if (exists $opts{alias} && defined $opts{alias}); $options .= $opts{options} if defined $opts{options}; $arguments .= $opts{arguments} if defined $opts{arguments}; chmod 0755, $formFile; unlink $formFile; } sub _error_handler { ##### # stores result code in $result and prints error message ##### my $particulars = shift; # last arg is either scalar or array $result = $? >> 8; carp("$0: '$particulars' result code: '$result'\n"); } sub _reset { ##### # resets package global session variables ##### $options = ""; $arguments = ""; } sub _redir_i { ##### # given a redirect method (open or close) and form parameters # creates the form file and redirects STDIN from the form file ##### my $arg = shift; my (%opts, %params); if (@_) { %params = setForm(@_); } if ($arg eq 'open') { if (exists $params{form}) { my $data; foreach my $key (keys %{$params{form}}) { next if $key =~ /^(Update|Access)/; if (ref($params{form}{$key}) =~ /ARRAY/) { $data .= "$key:\n"; foreach my $item (@{$params{form}{$key}}) { $data .= "\t$item\n"; } } else { $data .= "$key: $params{form}{$key}\n" if defined $params{form}{$key}; } } _write_file($formFile, $data); } if (-e $formFile) { open(SAVEIN, "<&STDIN"); open(STDIN, "<$formFile"); } else { return; } } else { # assume close close(STDIN); open(STDIN, "<&SAVEIN"); } select STDIN; $| = 1; select STDOUT; return 1; } sub _redir_o { ##### # given a redirect method (open or close), redirects STDOUT # to the form file # THIS JUST DOESN'T WORK AT ALL - use the return val from run_p4 instead: # turn it into an array (run_p4 returns scalar only) - split /\n/ # run it through _form_vals('set', @result) ##### my ($opts) = @_; if ($opts eq 'open') { # replacement code # @list = split /\n/, run_p4('command'); open(SAVEOUT, ">&STDOUT"); open(STDOUT, ">$formFile"); open SAVEERR, ">STDERR"; open STDERR, ">&STDOUT"; } else { # assume close # replacement code # _form_vals('get', @list); close(STDOUT); open(STDOUT, ">&SAVEOUT"); close STDERR; open STDERR, ">&SAVEERR"; select STDOUT; $| = 1; select STDIN; # read back form values from file into data structure _redir_i('open'); _form_vals('get', ); _redir_i('close'); } select STDOUT; $| = 1; select STDIN; return 1; } # form interface sub setForm { ##### # given any of form => $ref, form => {} or %form, # sets global %form and returns copy of same ##### my %params; shift if ($_[0] =~ /form/i || ref($_[1])); %form = %{$_[0]}; return {form => %form}; } sub getForm { ##### # returns global form as %form ##### return {form => %form}; } sub _form_vals { ##### # Given an $opt (get or set), reads form datastructure or # writes the form.p4 file (since that doesn't work, pass the return # value, converted from string to array, of p4 form gen'd command) ##### my $opt = shift; my @form = @_;# || <>; my ($tag, $val); if ($opt =~ /get/) { undef %form; foreach (@form) { chomp; next if m!^$!; next if m!^#!; $val = undef; if (m!^(.[^\s]*):\s*(.*)!) { ($tag, $val) = ($1, $2); } elsif (m!^(.[^\s]*):\s*$!) { $tag = $1; next; } else { ($val = $_) =~ s!\s*(.*)\s*$!$1!; } if (exists $form{$tag}) { if (ref $form{$tag} eq 'ARRAY') { push @{$form{$tag}}, $val; } else { $form{$tag} .= $val; } } else { if ($val) { $form{$tag} = $val; } else { @{$form{$tag}} = (); } } } } else { my $data; foreach my $key (keys %{$form{form}}) { if (ref($form{form}->{$key}) =~ /ARRAY/) { $data .= "$key:\n"; foreach my $item (@{$form{form}->{$key}}) { $data .= "\t$item\n"; } } else { $data .= "$key: $form{form}->{$key}\n" if defined $form{form}->{$key}; } } _write_file($formFile, $data); } } sub _write_file { ##### # given name and data, writes data to file named name optionally as binary ##### my ($name, $data, $flag) = @_; if (-e $name) {chmod 0777, $name; unlink $name} open OUT, ">$name"; binmode OUT if defined $flag; # make it so by default print OUT $data; close OUT; } sub Info { ##### # Given a dummy arg, returns perforce Information ##### my $arg = shift; my %opts = @_; _setup_vars(%opts); run_p4('info'); } sub Label { ##### # given label and params, either in form hash or # named vals of a form to be made hash, applies label ##### my $label = shift; my %opts = @_; _setup_vars(%opts); $arguments .= ' -i '; # TODO: # should ensure unique label name (labels are in the same namespace as client and depot) # when locked option is set: if label isn't available, declare new, sync then lock it otherwise, just apply the label if (exists $opts{form}) { _redir_i('open', form => $opts{form}) or return undef; } else { $form{Label} = $label; $form{Owner} = $opts{Owner} if exists $opts{Owner}; @{$form{Description}} = @{$opts{Description}} if (exists $opts{Description} && defined @{$opts{Description}}); $form{Options} = $opts{Options} if exists $opts{Options}; @{$form{View}} = @{$opts{View}} if (exists $opts{View} && defined @{$opts{View}}); _redir_i('open', %form); } my $return = run_p4('label'); _redir_i('close'); _setup_vars(%opts); $arguments = " -l $label "; $return .= run_p4('labelsync') if ($result && "\slocked" !~ /@{$form{View}}/); $return; } sub Get { ##### # given filename as spec, performs sync ##### my $file = shift; my %opts = @_; _setup_vars(%opts); $arguments .= " $file "; run_p4('sync'); } sub Flush { ##### # given filename as spec (or dummy arg), performs flush ##### my $file = shift; my %opts = @_; _setup_vars(%opts); $arguments .= " $file "; run_p4('flush'); } sub co { Checkout(@_) } sub Checkout { ##### # given filename, executes edit ##### my $file = shift; my %opts = @_; $arguments = " $file "; _setup_vars(%opts); run_p4('edit'); } sub ci { Checkin(@_) } sub Checkin { ##### # given filename as item, submits changelist item ##### my $file = shift; my %opts = @_; _setup_vars(%opts); $arguments .= " -i $file "; if (exists $opts{form}) { _redir_i('open', $opts{form}) or return undef; } else { return; # force error, unfinished work _redir_i('open', this => $opts{that} ); } my $return = run_p4('submit'); _redir_i('close'); $return; } sub Client { ##### # given an arg (get, set or use) manipulates P4 client record ##### my $arg = shift; # add or del my %opts = @_; my ($return, @list); _setup_vars(%opts); if ($arg =~ /get/i) { $arguments .= " -o "; @list = split /\n/, run_p4('client'); _form_vals('get', @list); $return = \%form; } elsif ($arg =~ /set/) { $arguments = " -i "; $arguments .= $opts{arguments} if defined $opts{arguments}; if (exists $opts{form}) { _redir_i('open', $opts{form}); } else { $form{Owner} = $opts{Owner} if exists $opts{Owner}; $form{Host} = $opts{Host} if exists $opts{Host}; @{$form{Description}} = @{$opts{Description}} if (exists $opts{Description} && defined @{$opts{Description}}); $form{Root} = $opts{Root} if exists $opts{Root}; $form{Options} = $opts{Options} if exists $opts{Options}; @{$form{View}} = @{$opts{View}} if (exists $opts{View} && defined @{$opts{View}}); _redir_i('open', %form) or return undef; } $return = run_p4('client'); _redir_i('close'); } elsif ($arg =~ /use/) { $ENV{P4CLIENT} = $opts{Client}; } else { return; } $return; } sub User { ##### # given an arg (add, del or list) manipulates P4 user record ##### my $arg = shift; # add or del my %opts = @_; my ($return, %list); $arguments = " -d $opts{User} " if $arg =~ /del/i; _setup_vars(%opts); if ($arg =~ /add/i) { # check user against users list, only add new # return unless $userlist = _run_p4('users'); # map return 'notnew' if $form{User} =~ m/^$_\s/, foreach csv in $userlist, ; if (exists $opts{form}) { _redir_i('open', $opts{form}) or return undef; } else { _redir_i('open', User => $opts{User}, FullName => $opts{FullName}, Email => $opts{Email} ) or return undef; } $arguments .= ' -i '; $return = run_p4('user'); _redir_i('close'); } elsif ($arg =~ /del/) { $return = run_p4('user'); } elsif ($arg =~ /list/) { map { $list{$1} = $2 if m/^(.[^\s]*)\s.*\s\((.[^\s]*)\)\s.*$/ } (split /\n/, run_p4('users')); return %list if defined %list; } $return; } sub Group { ##### # given an arg (add or del) manipulates P4 group record ##### my $arg = shift; # add or del my %opts = @_; my ($return, @list); _setup_vars(%opts); if ($arg =~ /add/i) { $arguments .= " -o $opts{Group} "; @list = split /\n/, run_p4('group'); _form_vals('get', @list); foreach my $user (@{$opts{Users}}) { next if grep(/$user/, @{$form{Users}}); push @{$form{Users}}, $user; } $arguments .= $opts{arguments} if defined $opts{arguments}; $arguments .= " -i "; _redir_i('open', Group => $opts{Group}, Users => [@{$form{Users}}] ) or return undef; $return = run_p4('group'); _redir_i('close'); } elsif ($arg =~ /del/) { $arguments = " -d $opts{Group} "; $arguments .= $opts{arguments} if defined $opts{arguments}; $return = run_p4('group'); } else { return; } $return; } sub Protect { # work needed, set only unique masks ##### # given an option (get or set), performs protection manip ##### my $arg = shift; # get or set my %opts = @_; my ($return, @list); _setup_vars(%opts); if ($arg =~ /set/) { foreach my $prots (@{$opts{Protections}}) { next if grep(quotemeta($prots), @{$form{Protections}}); push @{$form{Protections}}, $prots; _redir_i('open', Protections => [@{$form{Protections}}] ) or return undef; $arguments .= ' -i '; $return = run_p4('protect'); _redir_i('close'); } } elsif ($arg =~ /get/) { $arguments .= ' -o '; @list = split /\n/, run_p4('protect'); _form_vals('get', @list); } $return; } sub UList { ##### # given an option argument (get or set), counts and records the p4 users, # returns the number of new records or zero for set option. ##### my $arg = shift; # get or set my ($id, $name, $data, @list, %users); my $return = 0; if ($arg =~ /get/) { if (-e $userlist && $userlist ne 'nul') { open IN, $userlist or croak "can't open $userlist"; while () { chomp; next if /^#/; ($id, $name) = split /,/; $MUL{$id} = $name; } close IN; } foreach my $alias (keys %p4db) { _setup_vars(alias => $alias); @list = split /\n/, run_p4('users'); map { $users{$1} = $2 if m/^(.[^\s]*)\s.*\s\((.[^\)]*)\)\s.*$/ } @list; } foreach my $key (keys %users) { unless (exists $MUL{$key}) { $MUL{$key} = $users{$key}; $return++; } } } elsif ($arg =~ /set/) { $return = (keys %MUL); $data = "# Perforce Master User List - all $return licensed users of $licenses licenses\n"; foreach my $key (sort keys %MUL) { $data .= $key . ',' . $MUL{$key} . "\n"} _write_file($userlist, $data); } elsif ($arg =~ /verify/) { $return = $licenses - (keys %MUL); } $return; } sub SList { ##### # Given an option argument (new, del, edit or report), manipulates the p4servers.ini ##### my $arg = shift; my %opts = @_ if defined @_; my $return = 1; if ($arg eq 'report') { my $data = "\n"; $data .= "\n"; foreach my $server (keys %p4db) { $data .= "\t\n"; foreach my $key (keys %{$p4db{$server}}) { $data .= "\t\t<$key>$p4db{$server}{$key}\n"; } $data .= "\t\n"; } $data .= "\n"; _write_file("$datapath/perforce.xml", $data); _write_file("$datapath/report.xslt", $p4XSLT); _write_file("$datapath/perforce-Schema.xml", $p4Schema); } elsif ($arg =~ /new/) { $return = 0; } elsif ($arg =~ /del/) { $return = 0; } elsif ($arg =~ /edit|update/) { $return = 0; } else { $return = 0; } $return; } sub Admin { ##### # given an option (stop or checkpoint), performs admin function using option ##### my $arg = shift; my %opts = @_; _setup_vars(%opts); if ($arg =~ /stop/) { run_p4('admin stop'); } elsif ($arg =~ /checkpoint/) { run_p4('admin checkpoint'); } else { return; } } 1; __END__ # perldoc! =head1 NAME P4 - Perl extension for Perforce, the SCM. =head1 SYNOPSIS use P4; $options = "-p perforce:1666"; $arguments = ""; print info(); print depots(); print files(); print jobs(); print labels(); print users(); $arguments = "close"; print admin(); Alternatively, use the common p4 commands as mapped through P4::Simple (identified as not being a proper P4 command - usually upper cased first character). All these functions take a single action argument and optionally a hash of options, arguments and form values. use P4; Info('dummy', options=>'-p bldsrv:1666', arguments=>''); Label('label', options=>'-p bldsrv:1666', arguments=>'', form => %form); Get('file', options=>'-p bldsrv:1666', arguments=>''); Checkout('file', options=>'-p bldsrv:1666', arguments=>'', form => %form); Checkin('file', options=>'-p bldsrv:1666', arguments=>''); =head1 DESCRIPTION Methods to use in a Perforce SCM. This module supports B on a rudimentary level, it assumes the methods called are actual B commands. The P4::Simple package provides a comprehensive set of methods to the most common P4 actions such as edit, sync and label through well known named method verbs like Get, ci or Checkin, co or Checkout and Label. All methods return a value on success, undefined on error and prints a message with the error code. The error code is also stored in $P4::Simple::result. The SList function depends on an ini file called p4servers.ini to provide information about all known perforce servers available for use. The structure is as follows: =over 4 [LOCAL] name=Local p4 db P4HOST=hostname P4PORT=1666 P4ROOT=/p4db P4LOG=/logs/p4.log P4JOURNAL=/logs/p4journal.log contact=A. Name status=Up admin=Another Name description=test db =back Provided p4servers.ini exists, a client parameter called alias can also be used in calls to the modules methods. Replace the -p host:port construct of "options" and use the alias => key instead by setting it's value to the ini section (the [LOCAL] part of the template shown above) of a server description. eg. Get('file', alias => 'LOCAL'); =head1 METHODS These are the P4::Simple methods. =over 4 =item B Given a hash, form hash or a reference to a hash as the only form val, sets the global %form data structure. eg. %form = setForm(%form); =item B Returns the package global form structure as a form hash. eg. %form = getForm(); =item B Returns perforce Information. =item B Given label and params, either in form hash or named vals of a form, applies label. eg. Label('lbl', Label => 'lbl', Options => 'locked'); =item B Given filename(s) as spec, performs sync. Files with spaces need to be quoted. A file spec with date needs to be quoted and if the file spec contains a space, the quote must contain both the file and the date. eg. Get('"file with space.txt" "read me.txt@2001/01/20 23:59:59"', %form); =item B Updates a client workspace's have list without actually copying any files. =item B Alias ci. Given filename as item, submits changelist item. =item B Alias co. Given filename, executes edit. =item B Given an arg (get, set or use), manipulates P4 client record. =item B Given an arg (add, del or list) manipulates P4 user record. The arg 'list' will cause the return value to be a hash of usernames as keys and FullNames as values. =item B Given an arg (add or del) manipulates P4 group record. =item B given an option (get or set), performs protection manip. =item B Given an option (stop or checkpoint), performs admin function using option. =item B Given an option (get, set or verify), counts or updates the Master User List (MUL - a text file of csv delimited user ids and thier associated names) for all servers listed in the p4servers.ini config file. Returns the number of new user accounts not listed in the MUL (issue 'set' to update if so: eg. C) or the number of valid licenses remaining after counting the licenses used ($P4::Simple::license defaults to 395). =item B Given an option (new, del, update (or edit) or report), manips p4servers.ini. =back This is the list of methods that perforce understands as commands. Arguments to these commands can be found in the Perforce documentation. Use these commands through the AUTOLOAD facility of the P4 module (set $options and $arguments as appropriate) by specifying the command verb alone. ie. info() will be passed to P4, wrapped in a p4 command with any $options and $arguments defined in the package within which the info() call is made. eg. perl -MP4 -e "$options='-p wottcopej2k:1666';$arguments='';print info();" =over 4 =item B Open a new file to add it to the depot. =item B Perform administrative operations on the server. =item B Create or edit a branch specification. =item B Display list of branches. =item B Create or edit a changelist description. =item B Display list of pending and submitted changelists. =item B Create or edit a client specification and its view. =item B Display list of known clients. =item B Display, set, or delete a counter. =item B Display list of known counters. =item B Open an existing file to delete it from the depot. =item B Create or edit a depot specification. =item B Display list of depots. =item B Display a changelist description. =item B Display diff of client file with depot file. =item B Display diff of two depot files. =item B List subdirectories of a given depot directory. =item B Open an existing file for edit. =item B List revision history of files. =item B List files in the depot. =item B Mark jobs as being fixed by named changelists. =item B List what changelists fix what job. =item B Fake a 'p4 sync' by not moving files. =item B Dump file info. =item B Change members of a user group. =item B List groups (of users). =item B List revisions last synced. =item B Print this help message. =item B Print out client/server information. =item B Schedule integration from one file to another. =item B Show integrations that have been submitted. =item B Create or edit a job (defect) specification. =item B Display list of jobs. =item B Edit the job template. =item B