p4_anno_change #5

#!/usr/local/bin/perl -w
# -*-Fundamental-*-

use Carp;
use strict;
$| = 1;

use vars qw($P4);

# set P4 to the appropriate value; default shown here will find the
# executable along the PATH
#
$P4 = "p4";

use File::Basename ;

my $Myname;
$Myname = basename("$0") ;

my @Args;

my $Usage = <<LIT;
$Myname: usage: $Myname [-help] <change>
LIT


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;
$Usage

$Myname will examine a change, and, by checking the integration
history for each file revision mentioned in the change, and the
integration history of each contributing/receiving revision, prints a
summary showing corresponding changes, the branch represented by those
changes, the direction the integration, and whether *all* revisions
of the source change were integrated.

For example:

| rmg \$ p4_anno_change 6862
| change 6862 branch beta7 17 revisions
|   partial integrate from branch main change 6394

      "partial" indicates that change 6862, a change to the "beta7"
      branch, integrated *some* of the revisions from change 6394 (a
      change to main).
	
|   partial integrate from branch main change 6577
|   complete integrate from branch main change 6651
      
      "complete" indicates that *all* revisions from change
      6651 (in main) were integrated.

         .
         .
         .
|   complete integrate from branch main change 6849
|   complete integrate into branch p1.cifs change 6863
      
	"into" means that change 7116 (a change to 1.0.10)
	integrated *all* of the revisions from this change
	(6862)

|   complete integrate into branch 1.0.10 change 7116
|   complete integrate into branch beta7.elee change 7297
|   complete integrate into branch 1.5.0 change 7328
|   complete integrate into branch beta7.tmp change 7447
|   complete integrate into branch main change 7643

If any involved change contains revisions to more than a single
branch, the branch value will display as "MIXED".

If the change to be reported on doesn't contain any revisions
to product files, it will display, e.g.,

| rmg \$ p4 describe -s 7000
| Change 7000 by elee\@elee:iweb on 2004/01/20 18:13:41
| 
|         GC for P1.51 docs.
| 
| Affected files ...
| 
| ... //iweb/eweb/arch/arch_specs/expunge_151.html#1 add
| ... //iweb/eweb/arch/index.html#16 edit
|
|rmg \$ p4_anno_change 7000
|change 7000 branch UNKNOWN 1 revisions

Bear in mind that "integrated" means that the integrations are
accounted for in Perforce's integration history. This does *not* imply
that the integration was resolved by merging the changes. Revisions
resolved by "ignoring" them (p4 resolve -ay) also count as integrated
revisions.

${Myname}'s running time is porportional to the number of revisions
integrated into or from the examined change. In particular, running it
on changes that create new branches will be time consuming.

LIT
  exit 1;
}

#
# stuff to simplify portability across Unix and Windows
#

# declarations of global variables, so that they are accessible within
#   functions, and so that they are obviously global
#
use vars qw($GLOBAL_is_win32 $GLOBAL_win32_string $GLOBAL_OS_platform_in_use) ;

# control-O is set to 'MSWin32' on NT4
$GLOBAL_win32_string = "MSWin32";
$GLOBAL_OS_platform_in_use = $;

$GLOBAL_is_win32 = ( $GLOBAL_OS_platform_in_use =~ m/^${GLOBAL_win32_string}$/ ? 1 : 0 ) ;

sub set_temp_dir
{
  # returns a string representing the temporary directory preferred by the
  # user running the script
  #
  my ($temp_string, $temp_dir_name);

  # $GLOBAL_is_win32 is a global, set at start-up
  #
  $temp_string = $GLOBAL_is_win32 ? "TEMP" : "TMPDIR";
  $temp_dir_name = $ENV{$temp_string} || "";
  if ($temp_dir_name =~ m/^\s*$/ || (! -d "$temp_dir_name"))
    {
      if ($GLOBAL_is_win32)
	{
	  # could try the registry, but try TMP first - anyway, the
	  #   registry has it under the "Environment" section, so it is just
	  #   a lot more work to use the registry for an identical result
	  #
  	  $temp_dir_name = $ENV{"TMP"} || "c:\temp";
	}
      else
	{
  	  # assume unix-like, try with the "_" though uncommon
          #
	  $temp_dir_name = $ENV{"TMP_DIR"} || "/tmp";
	}
    }
  return $temp_dir_name ;
}

my $tmp_dir = &set_temp_dir . ($GLOBAL_is_win32 ? '\\' : '/');

# option switch variables get defaults here...

while ($#ARGV >= 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 = "$P4 describe -s $Change 2>&1 |";
#print "$Myname> $cmd_desc1\n";
if (! open(DESC, $cmd_desc1))
  {
    print "$Myname: open(\"$cmd_desc1\"): $!\n";
    exit(1);
  }


$_ = <DESC>;

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 = <DESC>;

my $Odesc = "";
my $section = "Description";
my @Files;
my $branch = "";

while (<DESC>)
  {
    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_dir . "$Myname.0.$$";

my $cmd_filelog1 = "| $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's 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_dir . "$Myname.1.$$";
my $cmd_filelog2 = "| $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 (<LOG>)
  {
    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 (<LOG>)
  {
    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_dir . "$Myname.2.$$";
my $cmd_desc2 = "| $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 (<DESC>)
  {
    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 = $nrevs;
          }
      }

    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);