add detailed changelogs and 'genlog'--the script which generates them

p4raw-id: //depot/perl@1192

1 files changed, 118 insertions, 0 deletions

diff --git a/Porting/genlog b/Porting/genlog
new file mode 100755
index 0000000000..5c3e90577e
--- /dev/null
+++ b/Porting/genlog
@@ -0,0 +1,118 @@
+#!/l/local/bin/perl -w
+#
+# Generate a nice changelist by querying perforce.
+#
+# Each change is described with the change number, description,
+# which branch the change happened in, files modified,
+# and who was responsible for entering the change.
+#
+# Can be called with a list of change numbers or a range of the
+# form "12..42".  Changelog will be printed from highest number
+# to lowest.
+#
+# Outputs the changelist to stdout.
+#
+# Gurusamy Sarathy <gsar@umich.edu>
+#
+
+use Text::Wrap;
+
+$0 =~ s|^.*/||;
+unless (@ARGV) {
+    die <<USAGE;
+        $0 [-p \$P4PORT] <change numbers or from..to>
+USAGE
+}
+
+my @changes;
+
+my %editkind;
+@editkind{ qw(   add      edit    delete integrate   branch )}
+         = qw(     +         !         -        !>       +> );
+
+my $p4port = $ENV{P4PORT} || 'localhost:1666';
+
+while (@ARGV) {
+    $_ = shift;
+    if (/^(\d+)\.\.(\d+)$/) {
+        push @changes, $1 .. $2;
+    }
+    elsif (/^\d+$/) {
+        push @changes, $_;
+    }
+    elsif (/^-p(.*)$/) {
+        $p4port = $1 || shift;
+    }
+    else {
+        warn "Arguments must be change numbers, ignoring `$_'\n";
+    }
+}
+
+@changes = sort { $b <=> $a } @changes;
+
+my @desc = `p4 -p $p4port describe -s @changes`;
+if ($?) {
+    die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n";
+}
+else {
+    chomp @desc;
+    while (@desc) {
+	my ($change,$who,$date,$time,@log,$branch,$file,$type,%files);
+	$_ = shift @desc;
+	if (/^Change (\d+) by (\w+)\@.+ on (\S+) (\S+)\s*$/) {
+	    ($change, $who, $date, $time) = ($1,$2,$3,$4);
+	    $_ = shift @desc;  # get rid of empty line
+	    while (@desc) {
+	        $_ = shift @desc;
+		last if /^Affected/;
+		push @log, $_;    
+	    }
+	    if (/^Affected/) {
+		$_ = shift @desc;  # get rid of empty line
+		while ($_ = shift @desc) {
+		    last unless /^\.\.\./;
+		    if (m{^\.\.\. //depot/(.*?perl|[^/]*)/([^#]+)#\d+ (\w+)\s*$}) {
+			($branch,$file,$type) = ($1,$2,$3);
+			$files{$branch} = {} unless exists $files{$branch};
+			$files{$branch}{$type} = [] unless exists $files{$branch}{$type};
+			push @{$files{$branch}{$type}}, $file;
+		    }
+		    else {
+			warn "Unknown line [$_], ignoring\n";
+		    }
+		}
+	    }
+	}
+	next unless $change;
+	print "_" x 76, "\n";
+	printf <<EOT, $change, $who, $date, $time;
+[%6s] By: %-25s             on %9s %9s
+EOT
+	print "        Log: ";
+	my $i = 0;
+	while (@log) {
+	    $_ = shift @log;
+	    s/^\s*//;
+	    s/^\[.*\]\s*// unless $i ;
+            # don't print last empty line
+	    if ($_ or @log) {
+	        print "             " if $i++;
+	        print "$_\n";
+	    }
+	}
+	for my $branch (sort keys %files) {
+	    printf "%11s: $branch\n", 'Branch';
+	    for my $kind (sort keys %{$files{$branch}}) {
+	        warn("### $kind ###\n"), next unless exists $editkind{$kind};
+		my $files = $files{$branch}{$kind};
+		# don't show large branches and integrations
+		$files = ["($kind " . scalar(@$files) . ' files)']
+		    if (@$files > 25
+		        && ( $kind eq 'integrate' || $kind eq 'branch'));
+	        print wrap(sprintf("%12s ", $editkind{$kind}),
+			   sprintf("%12s ", $editkind{$kind}),
+			   "@$files\n");
+            }
+	}
+    }
+}