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
# -*-Fundamental-*-
#
# $Id: //guest/sandy_currier/utils/p4submit.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.
#
# first, see if unix or NT or what...
# need a recent version of perl on NT to have win32 module/config stuff
BEGIN: {
require 5.004;
unless ($Platform{'os'}) {
unless ($Platform{'os'} = $^O) {
require Config;
$Platform{'os'} = $Config::Config{'osname'};
$Platform{'os'} = $Config::Config{'osname'};
}
}
# bottom layer OS specific variables/constants
if ($Platform{'os'}=~/Win/i) {
#########################
# win32
#########################
$Platform{'os'} = "win32";
$Platform{'pd'} = '\\';
} else {
#########################
# unix
#########################
$Platform{'os'} = "unix";
$Platform{'pd'} = '/';
}
}
#
# Unbuffer STDERR and STDOUT
select(STDERR);
$| = 1; # Make STDERR be unbuffered.
select(STDOUT);
$| = 1; # STDOUT too so, they can mix.
if ($Platform{'os'}=~/Win/i) {
$Platform{'tmp'} = &other2unix("$ENV{'TEMP'}"); # a temp file for writing
} else {
$Platform{'tmp'} = "/tmp"; # a temp file for writing
}
#
# set up some globals
# Note: assume that the PATH EV is going to be used to find p4
$ThisCmd = "p4submit.pl"; # this command name
$verbose = 0;
$P4 = "p4"; # the p4 command to execute (can either be
# absolute or relative)
$vb = ">>>";
$err = "***";
$printonly = 0;
$Platform{'tmp'} = "$Platform{'tmp'}/$ThisCmd.$$";
#
# user defined variables
@Files = (); # the list of files
$c = ""; # changenumber
$d = ""; # description
$force = ""; # force switch
$minimum = 8; # the minimum description length
$regexp = ""; # a regexp match
$identical = ""; #
#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd description [-c changenumber] [files ...]
Function:
$ThisCmd will submit either the default changelist or a
specified changelist. An optional list of files is supported.
If supplied while the default changelist is being used, only
those files will be submitted. If supplied with a numbered
changelist, the files that do match will be moved to the
default changelist. In either case, the files MUST be
in depot syntax (//depot/...).
The first 'non-switch' argument is the description and must
be delimited by '\"'.
Args:
\"description\" The description for the change
files ... Files in DEPOT SYNTAX
Switches/Options:
-h Prints this help message
-f Force. Normally, $ThisCmd prints the
changelist to STDOUT and prompts on STDIN
whether or not to proceed. -f will turn
this functionality off.
-P4 \"p4 ...\" By setting the value of 'P4', one can add
any supported p4 switch to all the p4
commands that this script invokes. This can
by used to set the -c, -d, -H, -p, -P,
-s, or -u switches to the p4 command.
-regexp <...> A perl regexp to be used to match for files
to submit. Those files not matching are not
submitted.
-identical If set, will revert files that are identical
before submitting the changelist
";
# future functionality
# -update Instead of submitting the change, will
# update the change description. If the
# default changelist is implied, will
# create a numbered changelist with those
# specified files in it. If a numbered
# changeset is specified, will
#
# parse command line
{
my($i, $param);
while($i <= $#ARGV) {
# scan for a help switch
if ($ARGV[$i] =~ /^-h/i) {
&DieHelp("", $help);
}
elsif ($ARGV[$i] =~ /^-f/i) {
$force = 1;
$i++;
}
elsif ($ARGV[$i] =~ /^-ident/i) {
$identical = 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'", $help);
}
$i=$i+2;
}
# catch unsupported switches
elsif ($ARGV[$i] =~ /^-/) {
&DieHelp("Unsupported switch \"$ARGV[$i]\"", $help);
}
# snarf first arg
elsif ($param == 0) {
$d = $ARGV[$i];
$i++; $param++;
}
else {
# swallow files, if any
push(@Files, $ARGV[$i]);
$i++; $param++;
}
}
}
#
# check args
if (!$c and length($d) < $minimum) {
&DieHelp("A change description of at least $minimum characters is required", $help);
}
if ($c and $c !~ /^[0-9]+$/) {
&DieHelp("A changelist argument must consist of only numbers", $help);
}
#
# if the default changelist is being used
$errors = &P4Submit($c, $d, @Files);
&Exit($errors);
#
# subroutines
#
sub Exit {
my($val) = @_;
unlink $Platform{'tmp'};
exit($val);
}
sub DieHelp {
my($str, $help) = @_;
print STDOUT "Usage: $help\n$err $str\n";
exit(2);
}
# 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);
}
# will print an error
sub PrintError {
my($text, $stream_p) = @_;
my($tmp);
# make sure $? is set
$? = 1;
# 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";
}
return($tmp);
}
#
# 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);
}
sub P4Submit {
my($changenum, $description, @files) = @_;
my($p4submit, $error, @default, @change, @output, @movefiles, $skip_p, $input);
#
# first, grab the default changelist
@default = &ExecuteP4Cmd("$P4 change -o $changenum", $verbose);
chomp(@default);
if ($?) {
&PrintError("$ThisCmd: exiting do to above '$P4 change -o' error");
&Exit(1);
}
#
# if @files is supplied, replace the file list with those files
$skip_p = 0;
if ($#files >= 0 or $regexp) {
# cheap way of replacing files
foreach (@default) {
push @change, $_ unless ($skip_p);
if (/^Files:/) {
$skip_p = 1;
next;
}
push @movefiles, $_ if ($skip_p and $_ ne "");
}
unless ($skip_p) {
# if there were no files listed in the first place, then
push @change, "Files:\n";
}
# if a regexp is supplied, use it. Regardless, add those files supplied on the CLI
if ($regexp) {
foreach my $file (@movefiles) {
if (grep(/$regexp/, $file)) {
push @change, $file;
}
}
}
foreach (@files) {
push @change, "\t$_ # how'd you get up there\n";
}
}
else {
@change = @default;
}
undef @default;
#
# Insert the log message...
# prepend $description with the correct tab prefix
$skip_p = 0;
if ($description) {
$description =~ s/^(.*)$/\t$1/gm;
foreach (@change) {
$skip_p = 0 if (/^Files/);
next if ($skip_p);
push @default, $_;
if (/^Description:/) {
# add in description
push @default, $description;
$skip_p = 1;
}
}
}
else {
@default = @change;
}
#
# if $identical, revert identical files
if ($identical) {
my(@tmpfiles, @revertedfiles);
# loop over @default a get the file list
$skip_p = 0;
foreach (@default) {
if (/^Files:/) {
$skip_p = 1;
next;
}
push @tmpfiles, $_ if ($skip_p and $_ ne "");
}
# remove the syntax around the files catalogued in @movefiles
foreach (@tmpfiles) {
s|^\s*||; # remove leading spaces
s|\s*\#.*$||; # remove trailing comments
}
@revertedfiles = &RevertUnchangedFiles(\@tmpfiles);
# now remove these from @default
foreach my $file (@revertedfiles) {
@default = grep(!/^\t$file \#/, @default);
}
}
#
# prompt
unless ($force) {
foreach my $line (@default) {
print STDOUT "$line\n";
}
print STDOUT "\nAbout to submit the above. Proceed? [yes] ";
$input = <STDIN>;
chomp($input);
unless ($input eq "" or $input =~ /^y/i) {
print "Aborting on user input...\n";
&Exit(0);
}
}
#
# if this is a numbered changelist and there are files to
# move back to the default changelist...
if ($changenum) {
foreach my $file (@movefiles) {
my($foo);
$file =~ s|\s*\# .+$||; # remove trailing comments
$file =~ s|^\s*||; # remove leading spaces
$foo = quotemeta($file);
if (grep(!/^$foo$/, @files)) {
# move it to the default changelist
@output = &ExecuteP4Cmd("$P4 -s reopen -c default \"$file\"", $verbose);
if ($? or grep(/^error:/i, @output) or !grep(/^exit:\s+0/i, @output)) {
my($bar) = join(//, @output);
&PrintError("$ThisCmd: could not move '$file' to the default changelist\n$bar");
&Exit(1);
}
}
}
}
#
# Start the submit...
$p4submit = "$P4 -s submit -i >$Platform{'tmp'} 2>&1";
if (!open(SUBMITW, "| $p4submit")) {
&PrintError("$ThisCmd: open \"| $p4submit\" failed: $!\n");
&Exit(1);
}
# stuff it
foreach (@default) {
$error = print SUBMITW "$_\n";
unless ($error) {
&PrintError("$ThisCmd: could not print '$error' to SUBMITW\n$!");
# print the tmp file anyway
}
}
$error = close SUBMITW;
unless ($error) {
&PrintError("$ThisCmd: could not cleanly close SUBMITW\n$?");
# try print the tmp file anyway
}
# OK, now we inspect the output from "p4 submit".
if (!open(SUBMITR, "<$Platform{'tmp'}")) {
&PrintError("$ThisCmd: open \"<$Platform{'tmp'}\" failed: $!");
&Exit(1);
}
@output = <SUBMITR>;
close SUBMITR;
if ($? or grep(/^error:/i, @output) or !grep(/^exit:\s+0/i, @output)) {
# an error occured - print the whole thing and exit
my($foo) = join(//, @output);
&PrintError("$ThisCmd: an error occured during the submit:\n$foo\n");
&Exit(1);
}
else {
foreach (@output) {
print STDOUT $_;
}
}
return(0);
}
#
# revert unchanged files
sub RevertUnchangedFiles {
my($arrayref) = @_;
my(@revertedfiles);
# note: diff returns files in workspace syntax
my(@output) = &ExecuteP4Cmd("$P4 -s diff -sr", $verbose);
chomp(@output);
my(@files) = grep(/^info: /, @output);
# @files are the list of files that are the same
foreach my $file (@files) {
$file =~ s|^info: ||; # remove info: token
$file =~ s|\#.*$||; # remove revision stuff
my($realfilename) = &GetFilenameFromSyntax($file, "depot");
my($safefile) = quotemeta($realfilename);
next unless (grep(/^$safefile$/, @{$arrayref})); # only delete our files
@output = &ExecuteP4Cmd("$P4 -s revert \"$file\"", $verbose);
if (grep(/^error:/, @output) or $?) {
&PrintError("Could not revert file $file\n@output");
&Exit(1);
}
push @revertedfiles, $file;
}
return(@revertedfiles);
}
sub GetFilenameFromSyntax {
my($file, $syntax) = @_;
my($realfilename, @tmp);
my(@out) = &ExecuteP4Cmd("$P4 where \"$file\"");
if ($Platform{'os'} eq "win32") {
@tmp = split(/ ([a-zA-Z]:\\)/, $out[0]);
if ($#tmp == 2) {
# the expected number
my($foo, $bar) = split(/ \/\//, $tmp[0]);
if ($syntax eq "depot") {
$realfilename = "$foo";
}
elsif ($syntax eq "client") {
$realfilename = "//$bar";
}
else {
$out[0] =~ / ([a-zA-Z]:\\)/;
$realfilename = "$1$tmp[1]";
}
}
}
else {
@tmp = split(/ \//, $out[0]);
if ($#tmp == 3) {
# the expected number
if ($syntax eq "depot") {
$realfilename = "/$tmp[0]";
}
elsif ($syntax eq "client") {
$realfilename = "/$tmp[1]";
}
else {
$realfilename = "/$tmp[2]";
}
}
}
unless ($realfilename) {
die "Could not determine the workspace mapping of $file";
}
return($realfilename);
}