eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' & eval 'exec perl -S $0 $argv:q' if 0; # THE PRECEEDING STUFF EXECS perl via $PATH # # $Id: //guest/sandy_currier/utils/p4revert.pl#2 $ # # # Copyright (c) 2000, Sandy Currier (sandy@releng.com) # Distributed under the GNU GENERAL PUBLIC LICENSE: # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 1, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software Foundation, # Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # # # Unbuffer STDERR and STDOUT select(STDERR); $| = 1; # Make STDERR be unbuffered. select(STDOUT); $| = 1; # STDOUT too so, they can mix. # # set up some globals # Note: assume that the PATH EV is going to be used to find p4 $ThisCmd = "p4revert.pl"; # this command name $debug = 0; $P4 = "p4"; # the p4 command to execute (can either be # absolute or relative) $vb = ">>>"; $err = "***"; $printonly = 0; $verbose = 1; # # local variables @info = (); # the output of p4 info $clientname = ""; # the "Client name: " $clientroot = ""; # the "Client root: " $cwd = ""; # the current working directory @Changes = (); # the list of changes @RealFiles = (); # the list of real files $all_p = 0; # weird switch $regexp = ""; # a regexp to match files against... # # now parse any args # the usage message (for -h or on error) $help = "$ThisCmd changelist Function: $ThisCmd will revert a changelist. It will back out the changelist with the following caveats: added files will be deleted unless the file has been edited since it was added (in which case it is skipped); deleted files will be re-constituted from the deleted version; and edited files will be by auto-merged (if possible) to the head of the codeline. If there is a conflict, it will be left unresolved. By default, will iterate over each file specified in the changelists (see the -all option below). All changes are left checked out and must be submitted by hand. Args: \@changelist ... the single change to backout Switches/Options: -h Prints this help message -all If specified, will not iterate the various p4 commands over the files contained in the specified change number, but instead will run it over the entire client spec. This is basically a manual performance tradeoff switch. -regexp A perl regular expression to match files from the supplied changelists. If supplied, only those files that match will be reverted. "; # # parse command line { my($i, $param); while($i <= $#ARGV) { # scan for a help switch if ($ARGV[$i] =~ /^-h/i) { &DieHelp("", $help); } # scan for switches elsif ($ARGV[$i] =~ /^-debug/i) { $debug = 1; $i++; } elsif ($ARGV[$i] =~ /^-all/i) { $all_p = 1; $i++; } elsif ($ARGV[$i] =~ /^-n/i) { $printonly = 1; $i++; } # scan for variable definitions (-variable value) elsif ($ARGV[$i] =~ /^-\w+/ and defined($ARGV[$i+1]) and $ARGV[$i+1] !~ /^-[^-]/) { # NOTE: nt has a difficult time with '=' on a command line... # process any variable value switches my($var) = $ARGV[$i]; $var =~ s/^-//; my($value) = $ARGV[$i+1]; if (defined $$var) { $$var = $value; } else { &DieHelp("Unknown parameter '$var'\n", $help); } $i=$i+2; } # catch unsupported switches elsif ($ARGV[$i] =~ /^-/) { &DieHelp("Unsupported switch \"$ARGV[$i]\"\n", $help); } else { # swallow files or a changeset if ($ARGV[$i] =~ /^\@\S+/) { my($tmp) = $ARGV[$i]; $tmp =~ s|^\@||; # remove the @ push(@Changes, $tmp); } else { # a change without a @ push(@Changes, $ARGV[$i]); } $i++; $param++; } } } # # if debugging, re-arrange variables if ($debug) { $verbose = 2; } # # Note: if there is no args, prompt for an input (explorer launch support) if ($#Changes < 0) { &TheEnd(0); } # # make sure that a valid client is selected { my($client_string) = "Client name: "; my($root_string) = "Client root: "; my($cwd_string) = "Current directory: "; my(@tmp); @info = &ExecuteP4Cmd("$P4 info", $verbose, 1); if ($?) { die "$ThisCmd - could not execute '$P4 info'\n$info"; } chomp(@info); # now get client name @tmp = grep(/^$client_string/,@info); # grep out the client name $clientname = &other2unix($tmp[0]); # transfer to a scalar $clientname =~ s/^$client_string//; # ditch the uninteresting part if ($clientname eq "") { # check things die "$ThisCmd - something wrong - no client name found from p4 info output"; } # get the client root @tmp = grep(/^$root_string/,@info); # grep out the client name $clientroot = &other2unix($tmp[0]); # transfer to a scalar $clientroot =~ s/^$root_string//; # ditch the uninteresting part if ($clientroot eq "") { # check things die "$ThisCmd - something wrong - no client name found from p4 info output"; } # get the cwd @tmp = grep(/^$cwd_string/,@info); # grep out the client name $cwd = &other2unix($tmp[0]); # transfer to a scalar $cwd =~ s/^$cwd_string//; # ditch the uninteresting part if ($cwd eq "") { # check things die "$ThisCmd - something wrong - no cwd found from p4 info output"; } } # # before continuing, grab the already opened files for statistics { @oldfiles = &ExecuteP4Cmd("$P4 opened", $verbose); chomp(@oldfiles); # if no files, will get "File(s) not opened on this client" if ($oldfiles[0] =~ /^File\(s\) not opened on this client/) { undef @oldfiles; } } # # handle multiple changes foreach my $change (@Changes) { my($tmp, $script, @output, $line); my($DescribeCmd) = "$P4 describe -s"; # this gets the filelist from the changelist if supplied # describe the changeset # get the file list with revision number @output = &ExecuteP4Cmd("$DescribeCmd $change", $verbose, 1); # see if @output contains a files chomp(@output); foreach $line (@output) { # if not a valid file line, punt and go to next one next unless ($line =~ /^\.\.\. \/\//); # push the complete file spec into the array $line =~ s|^\.\.\. ||; # remove beginning text # note: if $regexp, then match next if ($regexp and ($line =~ /$regexp/)); push(@RealFiles, $line); my($file, $revision, $action) = &SplitFilename3($line); push(@JustFiles, $file); # note: the first action is for work done within the codeline # the second action is for merged work of some type... if ($action eq "edit" or $action eq "integrate") { push(@EditFiles, $file); } elsif ($action eq "add" or $action eq "branch") { my(@tmp); # note: if the current head of the file is not revision 1, then # it has been edited. If so, just warn and do not delete... @tmp = &ExecuteP4Cmd("$P4 files \"$file\""); # ignore errors? my($f, $r) = &SplitFilename3($tmp[0]); if ($r and $r ne "1") { &PrintWarning("Warning: the added file \"$file\", is no longer at revision 1; it will not be deleted"); push(@SkippedFiles, $file); } else { push(@AddFiles, $file); } } elsif ($action eq "delete") { push(@DeleteFiles, $file); } else { &PrintError("unknown action for line\n$line"); } } } # # Note: the file list is now known. # perform the sequence of commands to backout this change { &PrintMessage("\nAbout to backout change $Changes[0]:\n"); } # # now back out the change { my($tmp, @output, $script, $previous, $file); $previous = $Changes[0] - 1; # this is executed after all the integrates have been performed if ($all_p) { @output = &ExecuteP4Cmd("$P4 sync \@$previous", $verbose); } else { foreach my $file (@JustFiles) { @output = &ExecuteP4Cmd("$P4 sync \"$file\@$previous\"", $verbose); } } # now loop over all edits &PrintMessage("checking out files for edit (or add)...") if ($verbose); foreach $file (@EditFiles) { @output = &ExecuteP4Cmd("$P4 edit \"$file\""); } # now loop over all deleted files and add them back in foreach $file (@DeleteFiles) { @output = &ExecuteP4Cmd("$P4 add \"$file\""); } # now do second sync if ($all_p) { @output = &ExecuteP4Cmd("$P4 sync \@$Changes[0]", $verbose); } else { foreach my $file (@JustFiles) { @output = &ExecuteP4Cmd("$P4 sync \"$file\@$Changes[0]\"", $verbose); } } # now do resolve -ay (keep the backed out changes) @output = &ExecuteP4Cmd("$P4 resolve -ay", $verbose); # now sync to head if ($all_p) { @output = &ExecuteP4Cmd("$P4 sync", $verbose); } else { foreach my $file (@JustFiles) { @output = &ExecuteP4Cmd("$P4 sync \"$file\"", $verbose); } } # now do resolve (this could result in conflicts...) @output = &ExecuteP4Cmd("$P4 resolve -am", $verbose, 1); # delete those files that were added in the changeset foreach $file (@AddFiles) { @output = &ExecuteP4Cmd("$P4 delete \"$file\"", $verbose); # ignore errors? } # never script a submit } # # now print something { my($tmp, $string); # print some statistics?... @newfiles = &ExecuteP4Cmd("$P4 opened", $verbose); chomp(@newfiles); # compare the old with the new, and print something # construct a hash # if no files, will get "File(s) not opened on this client" if ($newfiles[0] =~ /^File\(s\) not opened on this client/) { undef @newfiles; } else { foreach (@newfiles) { # let the entire string be the key if (!defined($new{$_})) { $new{$_} = 1; } } # delete from the hash anything that matches from @oldfiles foreach (@oldfiles) { if (defined($new{$_})) { delete $new{$_}; } } } $string = sprintf "edited %3d file(s)", $#EditFiles+1; &PrintNote($string); $string = sprintf "added %3d file(s)", $#DeleteFiles+1; &PrintNote($string); $string = sprintf "deleted %3d file(s)", $#AddFiles+1; &PrintNote($string); $string = sprintf "skipped %3d file(s)", $#SkippedFiles+1; &PrintNote($string); $string = sprintf " %3d total files", ($#RealFiles+1); &PrintNote($string); } # # the end &TheEnd(); # # subroutines (these should come from an include file, but not # enough time now to set it up) # # will convert a random OS delimited pathname to a perl pathname sub other2unix { my($filename) = @_; my($pattern) = $Platform{'pd'}; $pattern =~ s/(\W)/\\$1/g; # escape wildchars $filename =~ s|$pattern|/|g; return("/") if ($filename =~ /^\/+$/); # if just /+, return just / if ($filename =~ /^\/\//) { # add them back in later $filename =~ s|/+|/|g; # remove doubles $filename = "/$filename"; } else { $filename =~ s|/+|/|g; # remove doubles } # remove trailing $filename =~ s|/+$||; return($filename); } sub DieHelp { my($str, $help) = @_; print STDERR "$err $str\nUsage: $help"; exit(2); } # # Note: this will actually execute any command... # returns the action of the revision of the specified file#revision sub ExecuteP4Cmd { my($script, $verbose, $print_output, $no_error_check, $stream_p) = @_; my(@output); if ($stream_p) { print $stream_p "$vb\n$vb running: $script\n$vb\n" if ($verbose); } else { print STDOUT "$vb\n$vb running: $script\n$vb\n" if ($verbose); } if (!$Platform{'nt'} and $Platform{'os'} eq "win32") { @output = `$script` unless ($printonly); } else { @output = `$script 2>&1` unless ($printonly); } if ($stream_p) { print $stream_p "@output" if ($print_output); } else { print STDOUT "@output" if ($print_output); } if (!$no_error_check and $?) { # now what - just keep going &PrintError("$ThisCmd - something happened with '$script'\n$?", $stream_p); } return(@output); } # can handle, somewhat, either # or @... # Note: the output of a 'p4 change ...' will not be of the form # ... //depot/main/scm/tests/bar#4 edit # ... //depot/main/scm/tests/xxx#1 add # ... //depot/main/scm/tests/zzz#1 add # # the output of s 'p4 files ...' will be something like # //depot/main/scm/tests/foo#4 - edit change 1833 (text) # try to handle both here... sub SplitFilename3 { my($thing) = @_; my($f, $tmp, $r, $a, $d, $junk); if ($thing =~ /\#/){ ($f, $tmp) = split('#', $thing); $d = "\#"; } elsif ($thing =~ /\@/) { ($f, $tmp) = split('@', $thing); $d = "\@"; } else { # hoping that the thing passed in is really a file... $f = $thing; } return($f, $r, $a, $d) unless ($tmp); # if empty $tmp, just return now if ($tmp =~ / - /) { ($r, $a) = split(/ - /, $tmp); # split on the first ' - ' (here's hoping again) } else { # if no ' - ', split on first space... ($r, $a) = split(/ /, $tmp); } ($a, $junk) = split(' ', $a); # just use first word return($f, $r, $a, $d); } # should not be called by a server sub TheEnd { my($tmp); print STDERR "$err exiting with $Error{'Errors'} Error(s) & $Error{'Warnings'} Warning(s)\n"; # exit with the number of errors in the bottom 16 bits # and the number of warnings in the top # Note: make sure that if things shift off, that error is at least still set $tmp = $Error{'Warnings'} << 16; $tmp |= $Error{'Errors'}; # explicitly set $! to the explicit value # see the documentation on die exit($tmp); } sub PrintError { my($text, $stream_p) = @_; my($tmp); # first, increment error count $Error{'Errors'}++; # make sure $? is set $? = 1; # prepend with the correct prefix $text =~ s/^(.*)$/$err $1/gm; # store error away push(@{$Error{'ErrorSummary'}}, $text); # add a \n $text = "$text\n"; # print and log (maybe) if ($stream_p) { print $stream_p "$text"; } else { print STDERR "$text"; } $LogOutput = "$LogOutput$text" if (defined($LogOutput)); return($tmp); } # will increment $Error{'Warnings'} and append $err to every line sub PrintWarning { my($text, $stream_p) = @_; my($tmp); # first, increment warning count $Error{'Warnings'}++; # prepend with the correct prefix $text =~ s/^(.*)$/$err $1/gm; # store error away push(@{$Error{'WarningSummary'}}, $text); # add a \n $text = "$text\n"; # print and log (maybe) if ($stream_p) { print $stream_p "$text"; } else { print STDERR "$text"; } $LogOutput = "$LogOutput$text" if (defined($LogOutput)); return($tmp); } # will append $vb to every line sub PrintMessage { my($text, $stream_p) = @_; my($tmp); # prepend with the correct prefix $text =~ s/^(.*)$/$vb $1/gm; # add a \n $text = "$text\n"; # print and log (maybe) if ($verbose) { if ($stream_p) { print $stream_p "$text"; } else { print STDOUT "$text"; } } $LogOutput = "$LogOutput$text" if (defined($LogOutput)); return($tmp); } # will append $err to every line (but not set or increment any error variables) sub PrintNote { my($text, $stream_p) = @_; my($tmp); # prepend with the correct prefix $text =~ s/^(.*)$/$err $1/gm; # add a \n $text = "$text\n"; # print and log (maybe) if ($stream_p) { print $stream_p "$text"; } else { print STDERR "$text"; } $LogOutput = "$LogOutput$text" if (defined($LogOutput)); return($tmp); }