The #16401 was far from enough, and mostly in a wrong direction.

[p5sagit/p5-mst-13.2.git] / Porting / p4genpatch

#!/usr/bin/perl -w


# p4genpatch - Generate a perl patch from the repository

# Usage: $0 -h

# andreas.koenig@anima.de

use strict;
use File::Temp qw(tempdir);
use File::Compare;
use Time::Local;
use Getopt::Long;
use Cwd qw(cwd);

sub correctmtime ($$$);
sub Usage ();

$0 =~ s|^.*[\\/]||;
my $VERSION = '0.05';
my $TOPDIR = cwd();
my @P4opt;
our %OPT = ( "d" => "u", b => "//depot/perl", "D" => "diff" );
Getopt::Long::Configure("no_ignore_case");
GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
print Usage and exit if $OPT{h};
print "$VERSION\n" and exit if $OPT{V};
die Usage unless @ARGV == 1;

for my $p4opt (qw(p)) {
  push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
}

my $system = "p4 @P4opt describe -s @ARGV |";
open my $p4, $system or die "Could not run $system";
my @action;
while (<$p4>) {
  print;
  next unless m|($OPT{b})|;
  my($prefix) = $1;
  $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
  if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
    next if $action eq "delete";
    push @action, [$action, $file, $prefix];
  }
}
close $p4;

my $tempdir;
print "Differences ...\n";
for my $a (@action) {
  $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
  my($action,$file,$prefix) = @$a;
  my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
  my($prevfile) = $file =~ m|^(.+)#\d+\z|;
  die "Panic: Could not parse file[$file]" unless $number;
  $path = "" unless defined $path;
  my($d1,$d2,$prev);
  $prev = $number-1;
  $prevfile .= "#$prev";
  if ($prev==0 or $action =~ /^(add|branch)$/) {
    $d1 = "/dev/null";
  } elsif ($action =~ /^(edit|integrate)$/) {
    $d1 = "$path$basename#$prev";
    warn "==> $d1 <==\n" if $OPT{v};
    my $system = "p4 @P4opt print -o $tempdir/$d1 $prevfile";
    my $status = `$system`;
    if ($?) {
      warn "$0: system[$system] failed, status[$?]\n";
      next;
    }
    chmod 0644, "$tempdir/$d1";
    if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) {
      my $oldd1 = $d1;
      $d1 .= "~$prevch~";
      rename "$tempdir/$oldd1", "$tempdir/$d1";
    }
  } else {
    die "Unknown action[$action]";
  }
  $d2 = "$path$basename";
  warn "==> $d2#$number <==\n" if $OPT{v};
  my $system = "p4 @P4opt print -o $tempdir/$d2 $file";
  # warn "system[$system]";
  my $type = `$system`;
  if ($?) {
    warn "$0: `$system` failed, status[$?]\n";
    next;
  }
  chmod 0644, "$tempdir/$d2";
  $type =~ m|^//.*\((.+)\)$| or next;
  $type = $1;
  if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
    print "\n==== $file ($type) ====\n";
    unless ($type =~ /text/) {
      next;
    }
    print "Index: $path$basename\n";
    my @filelog = `p4 @P4opt filelog $file`;
    correctmtime(\@filelog,$prev,"$tempdir/$d1");
    correctmtime(\@filelog,$number,"$tempdir/$d2");
    chdir $tempdir or warn "Could not chdir '$tempdir': $!";
    $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
    system($system); # no return check because diff doesn't always return 0
    chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
  }
  for ("$tempdir/$d1","$tempdir/$d2") {
    unlink or warn "Could not unlink $_: $!" if -f;
  }
}
print "End of Patch.\n";

sub correctmtime ($$$) {
  my($filelog,$nr,$file) = @_;
  for my $line (@$filelog) {
    my($rev,$change,$action,$date) =
        $line =~ m{ ^ \.\.\. \s
                    \#
                    (\d+)            # rev
                    \s change \s
                    (\d+)            # change
                    \s (\w+) \s      # action
                    on \s (\S+)      # date
                  }x or next;
    # warn "rev[$rev]";
    next unless $rev == $nr;
    my(@date) = split m|/|, $date;
    $date[0] -= 1900;
    $date[1]--;
    my $time = timelocal(0,0,0,reverse @date);
    utime $time, $time, $file;
    last;
  }
}

sub Usage () {
    qq{Usage: $0 [OPTIONS] patchnumber

      -p host:port    p4 port (e.g. myhost:1666)
      -d diffopt      option to pass to diff(1)
      -D diff         diff(1) to use
      -b branch(es)   which branches to include (regex); everything up
                      to the last slash of matched portion of path is
                      stripped on local copy (default: //depot/perl)
      -v              verbose
      -h              print this help and exit
      -V              print version number and exit

Fetches all required files from the repository, puts them into a
temporary directory with sensible names and sensible modification
times and composes a patch to STDOUT using external diff command.
Requires repository access.

Examples:
          perl $0 12345 | gzip -c > 12345.gz
          perl $0 -dc 12345 > change-12345.patch
          perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
};
}