eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}' & eval 'exec perl -w -S $0 $argv:q' if 0; # THE PRECEEDING STUFF EXECS perl via $PATH # -*-Fundamental-*- use Carp; use strict; $| = 1; my $Myname; ($Myname = $0) =~ s%^.*/%%; my @Args; my $Usage = < LIT sub usage { print STDERR $Usage; exit 1; } sub help { print STDERR <= 0) { if ($ARGV[0] eq "-help") { &help; } elsif ($ARGV[0] =~ /^-/) { &usage; } push(@Args, $ARGV[0]); shift; } if ($#Args < 0) { &usage; } my $Change = pop(@Args); if ($Change !~ /^\d+$/) { print "$Myname: bad change# \"$Change\".\n"; &usage; } my $cmd_desc1 = "/auto/tools/bin/p4 describe -s $Change 2>&1 |"; #print "$Myname> $cmd_desc1\n"; if (! open(DESC, $cmd_desc1)) { print "$Myname: open(\"$cmd_desc1\"): $!\n"; exit(1); } $_ = ; my $Client; if (/^Change \d+ by [^\@]+\@(.*) on \d{4}\/\d\d\/\d\d \d\d:\d\d:\d\d/) { $Client = $1; } elsif (/ - no such changelist/) { print; exit(1); } else { print "$Myname: unrecognized format for \"Change N by ...\" line in describe output:\n $_"; print "$Myname: please report this to the $Myname maintainer.\n"; exit(1); } my $dummy = ; my $Odesc = ""; my $section = "Description"; my @Files; my $branch = ""; while () { if (/^Jobs fixed \.\.\./) { $section = "Jobs"; next; } elsif (/^Affected files \.\.\./) { $section = "Files"; next; } if ($section eq "Description") { $Odesc .= $_; } elsif ($section eq "Files" && /^\.\.\. (.*)$/) { # Remember the file information # push (@Files, $1); # And update "branch" determination for this change # if (/^\.\.\. \/\/prod\/([^\/]+)\// && $branch ne "MIXED") { my $b = $1; if (! $b || ($branch && $b ne $branch)) { $branch = "MIXED"; } else { $branch = $b; } } } } close DESC; if (! $branch) { $branch = "UNKNOWN"; } my $nrevs = $#Files + 1; print "change $Change branch $branch $nrevs revisions\n"; my $Tmpfile0 = "/tmp/$Myname.0.$$"; my $cmd_filelog1 = "| /auto/tools/bin/p4 -s -x - filelog -m1 > $Tmpfile0 2>&1"; #print "$Myname> $cmd_filelog1\n"; if (! open(FLOG, $cmd_filelog1)) { print "$Myname: \"$cmd_filelog1\": $!.\n"; exit 1; } my $fileop; foreach $fileop (@Files) { my ($file, $op); if ($fileop =~ /^(.*#\d+) (.*)$/) { ($file, $op) = ($1, $2); print FLOG "$file\n"; } else { print } } close FLOG; # number of "edit"s - anything (add, edit) that not an integrated change my $nedit = 0; # counts per-source change, indexed by source change # my %ninteg; # OK, now we have the client name, the extant Description, and the # list of files/ops. if (! open(LOG, "< $Tmpfile0")) { print "$Myname: open(\"< $Tmpfile0\"): $!.\n"; exit(1); } # These are the patterns we may see: # # branch from # branch into # copy from # copy into # delete from # delete into # edit from # edit into # ignored # ignored by # merge from # merge into # # We want to build a hash, indexed by change number for each change # contributing to or recieving revisions from this one. (For any one # source/recipient change, it's going to be all one or the other, # since it obviously can't be both!). # # Each element of the hash is a list, each element of which contains # the revision identifier and the "how" value with respect to the # change being annotated. # # From this we should easily be able to derive the desired annotation # information... # # So, first we need to identiify the change numbers of all of the # contributing/contributed-to changes... job for another "filelog"! # my $Tmpfile1 = "/tmp/$Myname.1.$$"; my $cmd_filelog2 = "| /auto/tools/bin/p4 -s -x - filelog -m1 > $Tmpfile1 2>&1"; #print "$Myname> $cmd_filelog2\n"; if (! open(FLOG, $cmd_filelog2)) { print "$Myname: open(\"$cmd_filelog2\"): $!.\n"; exit(1); } my @revs; my $sts; while () { if (/^exit: (\d+)/) { $sts = $1; last; } if (/^error: /) { print "$Myname: \"$cmd_filelog1\" said:\n $_"; print "$Myname: please report this to the $Myname maintainer.\n"; exit(1); } if (/^info(\d+)?: (.*)/) { my $level = defined($1) ? $1 : 0; my $info = $2; if ($level == 2) { if ($info =~ /^([a-z ]+) (\/\/.*)/) { my ($how, $what) = ($1, $2); my $frev; my $trev; # If multiple revisions (a range) are involved, # unroll the range into individual entries... # my $path; if ($what =~ /(.*)#(\d+),#(\d+)$/) { $path = $1; $frev = $2; $trev = $3 } elsif ($what =~ /(.*)#(\d+)$/) { $path = $1; $frev = $trev = $2 } else { print "$Myname: unrecognized filelog output: $_."; print "$Myname: please report this to the $Myname maintainer.\n"; exit(1); } my $i; for ($i = $frev; $i <= $trev; $i++) { my $rev = "$path#$i"; print FLOG "$rev\n"; push(@revs, "$rev\001$how"); } } } } } close LOG; close FLOG; unlink $Tmpfile0; if ($sts) { print "$Myname: \"$cmd_filelog1\" exited with status $sts.\n"; exit(1); } if (! open(LOG, "< $Tmpfile1")) { print "$Myname: open(\"< $Tmpfile1\"): $!\n"; exit(1); } my %change; my $chkrev; while () { if (/^exit: (\d+)/) { $sts = $1; last; } if (/^error: /) { print "$Myname: \"$cmd_filelog2\" said:\n $_"; print "$Myname: please report this to the $Myname maintainer.\n"; exit(1); } if (/^info(\d+)?: (.*)/) { my $level = defined($1) ? $1 : 0; my $info = $2; if ($level == 0) { $chkrev = $info; next; } elsif ($level == 1) { if ($info =~ /^(#\d+) change (\d+) /) { my $rev = $1; my $change = $2; $chkrev .= $rev; my $orig_revhow = shift(@revs); my ($orig_rev, $orig_how) = split(/\001/, $orig_revhow); if ($orig_rev ne $chkrev) { print "$Myname: internal error: records out of sync:\n"; print " orig: $orig_rev:\n"; print " check: $chkrev:\n"; print "$Myname: please report this to the $Myname maintainer.\n"; exit(1); } if (! defined($change{$change})) { $change{$change} = {}; } ${$change{$change}}{$orig_rev} = $orig_how; } } } } close LOG; close FLOG; unlink $Tmpfile1; if ($sts) { print "$Myname: \"$cmd_filelog2\" exited with status $sts.\n"; exit(1); } # OK, now go through each changelist, determining from/to, # partial/complete, and branch. For the "partial/complete" # we'll need the "describe -s", so let's start up that pipeline... my $Tmpfile2 = "/tmp/$Myname.2.$$"; my $cmd_desc2 = "| /auto/tools/bin/p4 -s -x - describe -s > $Tmpfile2 2>&1"; #print "$Myname> $cmd_desc2\n"; if (! open(DESC, $cmd_desc2)) { print "$Myname: \"$cmd_desc2\": $!.\n"; exit 1; } my @change_keys = (sort { $a <=> $b } (keys(%change))); my $change; foreach $change (@change_keys) { print DESC "$change\n"; } close DESC; if (! open(DESC, "< $Tmpfile2")) { print "$Myname: open(\"< $Tmpfile2\"): $!\n"; exit(1); } my $descchange; my %change_sts; my %change_dir; my %change_branch; my $change_sts_from; my $change_sts_into; sub set_change_status { # This sets the change status (partial/complete), based on the direction # of the change and the accumulated $change_sts_from (which *is* the value # for the change status on a "from" integration), or the revision count # (0 == complete), for "into" integrations. # my ($descchange, $change_sts_from, $change_status_into, $change_dir, $change_sts) = @_; if ($descchange) { if (${$change_dir}{$descchange} eq "from") { ${$change_sts}{$descchange} = $change_sts_from; } elsif (${$change_dir}{$descchange} eq "into") { ${$change_sts}{$descchange} = $change_sts_into ? "partial" : "complete"; } } } while () { if (/^exit: (\d+)/) { $sts = $1; &set_change_status($descchange, $change_sts_from, $change_sts_into, \%change_dir, \%change_sts); last; } if (/^error: /) { print "$Myname: \"$cmd_desc2\" said:\n $_"; print "$Myname: please report this to the $Myname maintainer.\n"; exit(1); } if (/^text: (.*)/) { my $info = $1; if ($info =~ /^Change (\d+)/) { # Ah, the start of a "describe" for the next change... # &set_change_status($descchange, $change_sts_from, $change_sts_into, \%change_dir, \%change_sts); $descchange = $1; # We need to independently compute both of these, since we might not # know the the change direction until we've looked at a few of the # revisions in the change... (we pick up the direction from the # original change's filelog information)... # $change_sts_from = "complete"; $change_sts_into = keys(%{$change{$descchange}}); # as a ref count } } if (/^info(\d+)?: (.*)/) { my $level = defined($1) ? $1 : 0; my $info = $2; $info =~ s/ [^ ]+//; if ($level != 1) { next; } if (! defined(${$change{$descchange}}{$info})) { $change_sts_from = "partial"; } else { $change_sts_into--; # Set the "direction" if we haven't yet... # if (! defined($change_dir{$descchange})) { my $how = ${$change{$descchange}}{$info}; if ($how =~ / from$|ignored$/) { $change_dir{$descchange} = "from"; } else { $change_dir{$descchange} = "into"; } } # Set the branch if we haven't yet... # if (defined($change_branch{$descchange}) && $change_branch{$descchange} eq "MIXED") { next; } if ($info =~ /^\/\/prod\/([^\/]+)\//) { my $branch = $1; if (defined($change_branch{$descchange})) { if ($change_branch{$descchange} ne $branch) { $change_branch{$descchange} = "MIXED"; } } else { $change_branch{$descchange} = $branch; } } } } } close DESC; unlink $Tmpfile2; if ($sts) { print "$Myname: \"$cmd_desc2\" exited with status $sts.\n"; exit(1); } my $c; foreach $c (@change_keys) { printf " %s integrate %s branch %s change %d\n", $change_sts{$c}, $change_dir{$c}, $change_branch{$c}, $c; } exit(0);