p4d2p #9

#!/usr/bin/perl -w

=head1 NAME

p4d2p - convert diffs from Perforce to patch format

=head1 SYNOPSIS

p4d2p [-hiv] [-o comment] [-p command] [files ...]

=head2 Options:

  -h          Display this help message
  -i[suffix]  Edit files in place; append suffix to original names
  -o comment  Output the comment instead of the old file version
  -p command  Use the command instead of `p4 print -q` to get files
  -v          Output progress messages

=head1 DESCRIPTION

Change diffs in Perforce format (from `p4 diff`, `p4 diff2` or `p4 describe`)
to a form suitable for input to the GNU `patch` program.
Insert headers and diffs, but don't remove anything.

Edit each file in place if file names are given;
otherwise filter from input to output.

=head1 EXAMPLES

p4 diff -du ...@ver8_0 | p4d2p -o "-r v80" | patch -p3

p4 diff2 -dc ...@Beta1 ...@Beta2 | p4d2p -o "-r Beta1" | patch -p5

p4 describe -du 123 | p4d2p -o "@122" | patch -p2

=head1 KNOWN BUGS

RCS format diffs (from `p4 diff -dn`) are not converted.

=head1 SEE ALSO

To generate a patch from a change number:
L<http://public.activestate.com/gsar/APC/perl-current/Porting/p4genpatch>

To generate a patch for added files:
L<http://public.activestate.com/gsar/APC/perl-5.6.x/Porting/p4desc>

Perforce L<http://www.perforce.com/perforce/technical.html>

GNU `patch` L<http://www.fsf.org/manual/diffutils-2.8.1/html_node/Multiple-Patches.html>

=head1 AUTHOR

John Kristian <jkristian@docent.com>.
Thanks to Gurusamy Sarathy for inspiration; but I accept all blame.

=cut

use Getopt::Std;
use POSIX qw(strftime);
use Time::Local qw(timegm);

use vars qw($opt_h $opt_i $opt_o $opt_p $opt_v);
if (!getopts('hi::o:p:v') || $opt_h) {
    open(STDOUT, '>&STDERR');
    exec('perldoc', $0);
    exit(1); # exec failed
}
if (not @ARGV) {@ARGV = '-'; undef $^I;}
elsif (defined($opt_i)) {$^I = $opt_i; warn "-i$opt_i\n" if $opt_v;}
# else $^I comes from Perl's -i option; e.g. perl -i.bak p4d2p ...
my $Z = timegm(localtime(0)) / 60;
$Z = ($Z >= 0) ? sprintf('+%02d%02d', $Z/60, $Z%60)
               : sprintf('-%02d%02d',-$Z/60,-$Z%60);
my $timeFormat = "%Y-%m-%d %H:%M:%S $Z"; # ISO 8601
my $now = strftime($timeFormat, localtime);
my $epoch = "1970-01-01 00:00:00Z";
my ($oldFile, $oldNote, $newFile, $newNote, @movedFiles);

while (<>) {

    # `p4 diff` header
    if (m<^==== //(.+?)(\#\d+) +- +(.+?) +====( \(.+\))?$>) {
        ($oldFile, $oldNote, $newFile) = ($1, $2, $3);
        $oldNote = " " . ($opt_o || $oldNote);
        my (@stat) = stat($newFile);
        $newNote = ((@stat && defined($stat[9]))
                    ? strftime($timeFormat, localtime($stat[9])) # time last modified
                    : $now);
        $newNote = " $newNote";
    }

    # `p4 diff2` header
    elsif (m<^==== //(.+?)(\#\d+) +\(.+?\) +- +(.+?)(\#\d+) +\(.+?\) +==== +\w+$>) {
        ($oldFile, $oldNote, $newFile, $newNote) = ($1, $2, $3, $4);
        $oldNote = " " . ($opt_o || $oldNote);
        $newNote = " $newNote";
    }

    # `p4 describe` header
    elsif (m<^==== //(.+?)(\#\d+) .*?====( \(.+\))?$>) {
        ($newFile, $newNote) = ($1, $2);
        $oldFile = $newFile;
        $oldNote = " " . ($opt_o ||
                        (($newNote =~ m<\#(\d+)>)
                         && "#" . ($1-1))); # the previous version
        $newNote = " $newNote";
    }

    # unified diff (the preferred format for `patch`)
    elsif (defined($oldFile) && m<^\@\@\s.*\s\@\@$>) {
        warn "emitting diff -u header\n" if $opt_v;
        print("Index: //$oldFile\n", "--- $oldFile$oldNote\n", "+++ $oldFile$newNote\n");
        undef $oldFile;
    }

    # context diff
    elsif (defined($oldFile) && m<^\*+$>) {
        warn "emitting diff -c header\n" if $opt_v;
        print("Index: //$oldFile\n", "*** $oldFile$oldNote\n", "--- $oldFile$newNote\n");
        undef $oldFile;
    }

    # default diff (not recommended for `patch`)
    elsif (defined($oldFile) && m<^\d+(,\d+)?[acd]\d+>) {
        warn "emitting diff header (not recommended for `patch`)\n" if $opt_v;
        print("Index: $oldFile\n", "diff -r //$oldFile $newFile\n");
        undef $oldFile;
    }

    # `p4 describe` add, branch or delete
    elsif (m<^\.\.\. (//.+?\#\d+ (add|branch|delete))$>) {
        push @movedFiles, $1;
    }

} continue {
    print; # echo all input

    if (eof) {
        if (@movedFiles) {
            my ($verb, @file);
            for (@movedFiles) {
                ($newFile, $newNote, $verb) = m<//(.+?)(\#\d+) (\w*)$>;
                warn $verb if $opt_v;
                $oldFile = $newFile;
                if ($verb eq 'delete') {
                    $oldNote = "#" . (($newNote =~ m<\#(\d+)>) && ($1-1)); # the previous version
                    $newNote = $epoch;
                    @file = p4print("//$oldFile$oldNote");
                } else { # add or branch
                    $oldNote = $epoch;
                    @file = p4print("//$newFile$newNote");
                }
                if (!$? && @file) {
                    $oldNote = " " . ($opt_o || $oldNote);
                    $newNote = " $newNote";
                    my $lines = (@file <= 1) ? "" : ("," . @file);
                    print("\nIndex: //$newFile\n", "--- $oldFile$oldNote\n", "+++ $newFile$newNote\n");
                    if ($verb eq 'delete') {
                        print("\@\@ -1$lines +0,0 \@\@\n");
                        print(join("-", "", @file));
                    } else { # add or branch
                        print("\@\@ -0,0 +1$lines \@\@\n");
                        print(join("+", "", @file));
                    }
                    print("\n\\ No newline at end of file\n") if ($file[$#file] !~ m<\n$>);
                }
            }
            @movedFiles = ();
        }
        undef $oldFile;
    }
}

sub p4print {
    my ($name) = @_;
    my $cmd = ($opt_p || "p4 print -q")." \"$name\"";
    # Sadly, executing `p4 print` will consume some input.
    # Which is one reason not to emit files immediately
    # upon reading their names from the input stream.
    my @file = `$cmd`;
    warn "status $? from $cmd" if ($?);
    return @file;
}