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/p4vtree.pl#2 $
#
#
# Copyright (c) 2000, Sandy Currier ([email protected])
# 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
#
# set up some globals
$ThisCmd = "p4vtree"; # this command name
#
# local variables
$filespecs = "";
$P4 = "p4";
$verbose = 1;
$columns = 80;
# p4 variables passed in...
$filelogswitches = "";
$m = "";
#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd filespecs
Function:
$ThisCmd will add label information to a p4 filelog
command output. It does it the slow way, so depending
on the label database, it may take a while.
Args:
filespecs A list pf valid filespecs
Switches/Options:
-h Prints this help message
-columns <#> Will limit the output to # columns
(def = $columns)
-verbose <#> A verbose level (def = $verbose)
";
#
# parse command line
{
my($i) = 0;
while($i <= $#ARGV) {
# scan for a help switch
if ($ARGV[$i] =~ /^-h/i) {
&DieHelp("", $help);
}
# scan for switches
elsif ($ARGV[$i] =~ /^-n/i) {
$printonly = 1;
$i++;
}
elsif ($ARGV[$i] =~ /^-i/i) {
$filelogswitches = "$filelogswitches -i";
$i++;
}
elsif ($ARGV[$i] =~ /^-l/i) {
$filelogswitches = "$filelogswitches -l";
$i++;
}
elsif ($ARGV[$i] =~ /^-debug/i) {
$debug = 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 {
push @filespecs, $ARGV[$i];
$i++;
}
}
}
#
# fold in $m if defined
if ($m) {
$filelogswitches = "$filelogswitches -m $m";
}
#
# if debugging, re-arrange variables
if ($debug) {
$verbose = 2;
}
#
# get a list of labels
{
my @tmp;
@tmp = &ExecuteP4Cmd("$P4 labels");
# if an error is returned, just keep going...
chomp(@tmp);
foreach my $label (@tmp) {
my($content) = $label;
$label =~ s|^Label (.+) \d\d\d\d/\d\d/\d\d \'.*$|$1|o;
# push @Labels, $label;
$Labels{$label} = $content;
}
}
#
# for each label, create a local hash of the files
{
my($printhack);
foreach my $label (keys(%Labels)) {
foreach my $fs (@filespecs) {
my(@output);
&PrintRaw(".") if ($verbose);
$printhack++;
if ($filelogswitches =~ /-i/) {
# if -i is specified, have no idea what may have been integrated into...
@output = &ExecuteP4Cmd("$P4 files //...\@$label");
}
else {
# if no -i, just use this name
@output = &ExecuteP4Cmd("$P4 files $fs\@$label");
}
next if (grep(/ - file\(s\) not in label\.$/, @output));
chomp(@{$Files{$label}} = @output);
}
}
&PrintRaw("\n") if ($printhack and $verbose);
}
#
# run the p4 filelog command and collect output (let filelog expand wildcards)
{
my(@filelog, $currentFile, $currentRev, $printhack);
my($filespecs);
foreach my $fs (@filespecs) {
$filespecs = "\"$fs\"";
}
@filelog= &ExecuteP4Cmd("$P4 filelog $filelogswitches $filespecs");
# if an error - just keep on going
chomp(@filelog);
# print it
foreach my $line (@filelog) {
my($foo);
if ($line =~ /^\/\//) {
$currentFile = $line;
$foo = $line;
$foo = substr($foo, 0, $columns) if ($columns > 8);
&PrintRaw("$foo\n");
}
elsif ($line =~ /^\.\.\. \#(\d+) /) {
$currentRev = $1;
$foo = $line;
$foo = substr($foo, 0, $columns) if ($columns > 8);
&PrintRaw("$foo\n");
# add label stuff here
foreach my $label (sort(keys(%Labels))) {
my($safestring) = quotemeta("$currentFile#$currentRev");
if (grep(/^$safestring - /, @{$Files{$label}})) {
my($foo) = $Labels{$label};
$foo = substr($foo, 0, $columns - 8) if ($columns > 8);
&PrintRaw("... ... $foo\n");
}
}
}
else {
my($foo) = $line;
$foo = substr($foo, 0, $columns) if ($columns > 8);
&PrintRaw("$foo\n");
}
}
}
#
# the end
&TheEnd();
#
# Subroutines
#
sub DieHelp {
my($str, $help) = @_;
print STDERR "$err $str\nUsage: $help";
$Error{'Errors'}++;
&TheEnd();
}
# should not be called by a server
sub TheEnd {
my($tmp);
# 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{'Errors'};
# explicitly set $! to the explicit value
# see the documentation on die
exit($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 PrintRaw {
my($text, $stream_p) = @_;
my($tmp);
# print and log (maybe)
if ($stream_p) {
print $stream_p "$text";
}
else {
print STDOUT "$text";
}
$LogOutput = "$LogOutput$text" if (defined($LogOutput));
return($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;
# 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);
}
# 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);
}