[p4] Find old dead code?

[Peter Stephenson]

Peter Stephenson wrote:
> The attached Perl script

Hmm.  I specifically looked to see if my mailer had got the details in
the attachment correct and it still looks like it's decided not to send it.

It's not that long: here it is inline with some lines wrapped, although
some mailers aggresively wreck plain text anyway.


#!/usr/bin/perl -w -

=head1 NAME

p4annotate.pl - Front end to `p4 annotate' for customizing the annotation.

=head1 SYNOPSIS

	p4annotate.pl -f "%r %c" file.c

=head1 DESCRIPTION

F<p4annotate.pl> I<file> has the same basic effect as C<p4 annotate> I<file>,
but you can customize the annotation using the option C<-f>.  Note that
the global options to C<p4> are not currently handled, so that you
will need to set environment variables (C<P4CLIENT>, etc.) appropriately.

The options C<-a> and C<-q> work as expected, so the only
differences are the additional options:

=over

=item C<-f> I<fmt>

I<fmt> is a format string containing printf-style
escapes which will be replaced by information about each version.
The escapes are:

=over

=item C<%r>

The revision number.

=item C<%c>

The change which brought about the revision.

=item C<%T>

The type of the change --- edit, integrate, etc.

=item C<%d>

The date of the change.

=item C<%t>

The time of the change (not including the date).

=item C<%u>

The Perforce user who submitted the change.

=item C<%C>

The user's client which submitted the change.

=item C<%f>

The type of the file after the change.

=item C<%m>

The start of the change's description.

=back

Hence, for example, the annotation given by p4 annotate itself is
represented by "%r".  The default is "%r %u", i.e. the revision augmented
by the user.  This agrees with the research which led to the corresponding
command in Subversion being called `svn blame'.

=item C<-r>

Raw: don't put the colon and space after the annotation.

=back

=cut

use strict;

use vars qw($join $opt_a $opt_f $opt_q $opt_r $warn @p4_args);

$opt_f = "%c %u";
$opt_a = $opt_q = $opt_r = $warn = 0;

use Getopt::Std;

getopts('af:qr')  or  exit 1;

@p4_args = ('-a') if $opt_a;

$join = $opt_r ? "" : ": ";

# Do substitution on $opt_f using the hash ref passed.
sub subst ($) {
    my $hashref = shift;
    my $sofar = '';
    my $fmt = $opt_f;

    while ($fmt =~ /%(.)/) {
	$sofar .= $`;
	$fmt = $';
	if ($1 eq '%') {
	    $sofar .= '%';
	} else {
	    my $repl = $hashref->{$1};
	    $repl = "%$1"  unless defined $repl;
	    $sofar .= $repl;
	}
    }
    $sofar . $fmt;
}


sub get_filelog($$) {
    # Get the filelog for the specified file/revision.
    # Only remember changes from revision to revision, ignore
    # integrations to other branches etc.
    my $filespec = shift;
    my $hashref = shift;
    my $pid = open(PIPEINFO, "-|");
    die "Failed to fork: $!\n"  unless defined $pid;

    exec "p4", "filelog", "-t", $filespec  if $pid == 0;
    # avoid long lines
    my $pat = '^\.\.\. \#(\d+) change (\d+) (\S+)' .
	' on (\S+) (\S+) by (\S+)\@(\S+) \((\S+)\) ' . "'(.*)'\$";

    while (<PIPEINFO>) {
	next unless /$pat/o;
	$hashref->{$1} = subst(
	  {
	   r => $1,
	   c => $2,
	   T => $3,
	   d => $4,
	   t => $5,
	   u => $6,
	   C => $7,
	   f => $8,
	   "m" => $9
	  });
    }
    close PIPEINFO;
    die "Subcommand failed" if $? >> 8;
}


while (@ARGV) {
    my $spec = shift;
    my $filespec;
    my %versioninfo;
    my $pid = open(PIPEIT, "-|");
    my $curver;
    my $curspec;
    die "Failed to fork: $!\n"  unless defined $pid;

    exec "p4", "annotate", @p4_args, "$spec"  if $pid == 0;

    while (<PIPEIT>) {
	if (m%^//.*\#\d+%) {
	    $filespec = $&;
	    %versioninfo = ();
	    $curver = undef;
	    print unless $opt_q;
	} elsif (/^(\d+): /) {
	    # use cache if possible
	    if (defined($curver) && $curver == $1) {
		print "$curspec$join$'";
	    } else {
		$curver = $1;
		my $line = $';
		get_filelog($filespec, \%versioninfo)  unless %versioninfo;
		my $curinfo = $versioninfo{$curver};
		if (defined $curinfo) {
		    $curspec = $curinfo;
		} else {
		    $curspec = $curver;
		}
		print "$curspec$join$line";
	    }
	} else {
	    $warn++;
	    print;
	}
    }
    close PIPEIT;
    die "Subcommand failed" if $? >> 8;
}

warn "Some lines could not be parsed properly.\n" if $warn;

exit 0;
# end