labeldiff.pl #1

#!/usr/local/bin/perl5.001

# $Id: //depot/sandbox/jab/throwaways/progs/labeldiff#1 $
#
# labeldiff [-fvcb]  label1   label2
#
# Produces info on the differences between two labels in Perforce.
# It's best if they're labels applied to the same tree, but if not,
# then files in their intersection will be examined for changes, and
# the others will be reported in as "X appears in label1 but not label2"
# and so on.
#
# -f reports file info
# -c reports the change numbers (when the files are different
#			between the labels)
# -b reports the bug numbers if there are "Related-to-bug" clues
#			in the change descriptions
# -v is verbose, probably useful only for debugging.
#
#
# Todo: we have changes, but they don't include the changes that created
#       new files; doesn't include the changes that deleted old files, which
#	is slightly counter-intuitive. Both should be available.
#
require "getopts.pl";
do Getopts('fvcb');

die "Must give two arguments: label1 and label2!\n"
	if ($#ARGV < 1);
$lab1 = $ARGV[0];
$lab2 = $ARGV[1];
warn "Ignoring extraneous arguments, comparing only $lab1 and $lab2\n"
	if ($#ARGV > 1);

$OutputFilenames = $opt_f;
$OutputChangeNumbers = $opt_c;
$OutputBugNumbers = $opt_b;
$Verbose = $opt_v;

$p4 = "/usr/local/bin/p4";
$ENV{P4USER} = "jab" if ($ENV{P4USER} eq "");
$ENV{P4CLIENT} = "OvernightBuild" if ($ENV{P4CLIENT} eq "");
die "Must set \$P4PORT before running this script!\n"
		if ($ENV{P4PORT} eq "");


%Files1 = &Process("$p4 files //depot/...\@$lab1");
%Files2 = &Process("$p4 files //depot/...\@$lab2");

foreach $f (sort keys %Files1) {
	if ($Files1{$f} eq $Files2{$f}) {
		delete $Files1{$f};
		delete $Files2{$f};
	}
}
##
# At this point, %Files1 and %Files2 contain the files in label1 and
# label2, respectively, that are different.
##
foreach $f (sort keys %Files1) {
	if ($Files2{$f} eq "") {
		push(@AddedInLab1, $f);
		next;
	}
	if ($Files2{$f} ne $Files1{$f}) {
		push(@ChangedFiles, $f);
		next;
	}
}
foreach $f (sort keys %Files2) {
	if ($Files1{$f} eq "") {
		push(@AddedInLab2, $f);
		next;
	}
}

if ($OutputFilenames) {
	print "Only in '$lab1'\n" if ($#AddedInLab1 >= 0);
	foreach $f (sort @AddedInLab1) {
		print "$f\n";
		}
	print "Only in '$lab2'\n" if ($#AddedInLab2 >= 0);
	foreach $f (sort @AddedInLab2) {
		print "$f\n";
		}
	print "Changed between '$lab1' and '$lab2'\n"
		 if ($#ChangedFiles >= 0);
	foreach $f (sort @ChangedFiles) {
		print "$f (ver1=$Files1{$f} ver2=$Files2{$f})\n";
		}
}

foreach $f (@ChangedFiles) {
	@C =  &GetChanges($f, $Files1{$f}, $Files2{$f});
	if ($#C >= 0) {
		foreach $c (@C) {
			$Changes{$c}++;
		}
	}
}
@ChangeNumbers = sort keys %Changes;

if ($OutputChangeNumbers) {
	foreach $c (@ChangeNumbers) {
		print "Change $c\n";
	}
}

foreach $c (@ChangeNumbers) {
	@B =  &GetBugNumbers($c);
	if ($#B >= 0) {
		foreach $b (@B) {
			$BugNums{$b}++;
		}
	}
}
@BugNumbers = sort keys %BugNums;
if ($OutputBugNumbers) {
	$cmd = "bugcmd -p printbug @BugNumbers";
	# print "Running '$cmd'\n";
	system("$cmd");
}

sub GetBugNumbers {
	local($changenumber) = @_;
	local($cmd) = "$p4 describe -s $changenumber";
	local($p4description) = ();
	local(@b) = ();
	
	print "Processing '$cmd'\n" if ($Verbose);
	$p4description = `$cmd`;
	next if ($p4description eq "");
	$p4description =~ tr/\n:/  /;
	while ($p4description =~ /(Related-to-Bug)\s+(BUGtk\d+)/i
		|| $p4description =~ /(Fix\s+bug)\s+(\d+)/i
		|| $p4description =~ /(Fixing\s+bug)\s+(\d+)/i
		|| $p4description =~ /(Related-to-Bug)\s+(\d+)/i)
	{
		push(@b, &MassageBug($2));
		$p4description =~ s/$1\s+$2//;
	}
	@b;
}

#
# Stolen from 'bugcmd'
#
sub MassageBug {
	local($bugid) = @_;
	local($ret);

	if ($bugid =~ /^\d+$/) {
		$ret = sprintf("BUGtk%05d", $bugid);
	} elsif ($bugid =~ /Bugtk(\d+)/i) {		# In case of mistyping.
		$ret = sprintf("BUGtk%05d", $1);
	} else {
		$ret = $bugid;
	}
	$ret;
}
sub GetChanges {
	local($filename, $ver1, $ver2) = @_;
	local($cmd) = "$p4 filelog $filename";
	local($ver, $changenum) = ();
	local(@c) = ();
	
	if ($ver1 > $ver2) {
		$ver2 <=> $ver1;
	}
	
	print "Processing '$cmd'\n" if ($Verbose);
	open(CMD, "$cmd |") || die "Cannot run '$cmd'\n";
	while (<CMD>) {
		chop;
		next unless /^\.\.\. #(\d+) change (\d+)/;
		($ver, $changenum) = ($1,$2);
		next if ($ver <= $ver1 || $ver > $ver2);
		push(@c, $changenum);
	}
	close(CMD);
	@c;
}

sub Process {
	local($cmd) = @_;
	local($filename, $ver);
	local($cnt) = 0;
	local(%Files);

	print "Processing '$cmd'\n" if ($Verbose);
	open(CMD, "$cmd |") || die "Cannot run '$cmd'\n";
	while (<CMD>) {
		chop;
		($filename,$ver) = /(\S+)#([0-9]+) - .*/;
		if ($filename eq "") {
			warn "Malformed line: $_\n";
			next;
		}
		$Files{$filename} = $ver;
		$cnt++;
	}
	close(CMD);
	print "$cnt files in '$cmd'\n" if ($Verbose);
	%Files;
}