use strict;
use File::Temp qw(tempdir);
use File::Compare;
+use File::Spec;
+use File::Spec::Unix;
use Time::Local;
+use Getopt::Long;
+use Cwd qw(cwd);
sub correctmtime ($$$);
sub Usage ();
-my $VERSION = '0.03';
-$0 =~ s|^.*/||;
-our(%OPT, @P4opt);
-%OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" );
-use Getopt::Long;
+$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;
+die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
+my $CHANGE = shift;
for my $p4opt (qw(p)) {
push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
}
-my $system = "p4 @P4opt describe -s @ARGV |";
+my $system = "p4 @P4opt describe -s $CHANGE |";
open my $p4, $system or die "Could not run $system";
my @action;
while (<$p4>) {
print;
- next unless m|$OPT{b}|;
+ next unless m|($OPT{b})|;
+ my($prefix) = $1;
+ $prefix =~ s|/$||;
+ $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];
+ push @action, [$action, $file, $prefix];
}
}
close $p4;
my $tempdir;
+my @unlink;
print "Differences ...\n";
for my $a (@action) {
- $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1 );
- my($action,$file) = @$a;
- my($path,$basename,$number) = $file =~ m|//depot/(.+/)?([^/]+)#(\d+)|;
+ $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
+ @unlink = ();
+ my($action,$file,$prefix) = @$a;
+ my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
+
+ my @splitdir = File::Spec::Unix->splitdir($path);
+ $path = File::Spec->catdir(@splitdir);
+
+ my($depotfile) = $file =~ m|^(.+)#\d+\z|;
+ die "Panic: Could not parse file[$file]" unless $number;
$path = "" unless defined $path;
- my($d1,$d2,$prev);
+ my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
$prev = $number-1;
- if ($prev==0 or $action =~ /^(add|branch)$/) {
- $d1 = "/dev/null";
+ $prevchange = $CHANGE-1;
+ # can't assume previous rev == $number-1 due to obliterated revisions
+ $prevfile = "$depotfile\@$prevchange";
+ if ($number == 1 or $action =~ /^(add|branch)$/) {
+ $d1 = $^O eq 'MacOS' ? File::Spec->devnull : "/dev/null";
+ $t1 = $d1;
+ ++$doadd;
} elsif ($action =~ /^(edit|integrate)$/) {
- $d1 = "$path$basename#$prev";
+ $d1 = File::Spec->catfile($path, "$basename-$prevchange");
+ $t1 = File::Spec->catfile($tempdir, $d1);
warn "==> $d1 <==\n" if $OPT{v};
- my $system = "p4 @P4opt print -o $tempdir/$d1 //depot/$path$basename#$prev";
+ my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
my $status = `$system`;
if ($?) {
warn "$0: system[$system] failed, status[$?]\n";
next;
}
- if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) {
+ chmod 0644, $t1;
+ if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
+ ($prev,$prevchange) = ($1,$2);
+ $prevfile = "$depotfile#$prev";
my $oldd1 = $d1;
- $d1 .= "~$prevch~";
- rename "$tempdir/$oldd1", "$tempdir/$d1";
+ $d1 =~ s/-\d+$/#$prev~$prevchange~/;
+ my $oldt1 = $t1;
+ $t1 = File::Spec->catfile($tempdir, $d1);
+ rename $oldt1, $t1;
}
+ push @unlink, $t1;
} else {
die "Unknown action[$action]";
}
- $d2 = "$path$basename";
+ $d2 = File::Spec->catfile($path, $basename);
+ $t2 = File::Spec->catfile($tempdir, $d2);
+ push @unlink, $t2;
warn "==> $d2#$number <==\n" if $OPT{v};
- my $system = "p4 @P4opt print -o $tempdir/$d2 $file";
+ my $system = qq[p4 @P4opt print -o "$t2" "$file"];
# warn "system[$system]";
my $type = `$system`;
if ($?) {
warn "$0: `$system` failed, status[$?]\n";
next;
}
+ chmod 0644, $t2;
$type =~ m|^//.*\((.+)\)$| or next;
$type = $1;
- if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
- print "\n==== $file ($type) ====\nIndex: $path$basename\n";
+ if ($doadd or File::Compare::compare($t1, $t2)) {
+ print "\n==== $file ($type) ====\n";
unless ($type =~ /text/) {
next;
}
- my @filelog = `p4 @P4opt filelog $file`;
- correctmtime(\@filelog,$prev,"$tempdir/$d1");
- correctmtime(\@filelog,$number,"$tempdir/$d2");
- $system = "cd $tempdir && $OPT{D} -$OPT{d} '$d1' '$d2'";
+ unless ($^O eq 'MacOS') {
+ $d1 =~ s,\\,/,g;
+ $d2 =~ s,\\,/,g;
+ }
+ print "Index: $d2\n";
+ correctmtime($prevfile,$prev,$t1) unless $doadd;
+ correctmtime($file,$number,$t2);
+ 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") {
+}
+continue {
+ for (@unlink) {
unlink or warn "Could not unlink $_: $!" if -f;
}
}
print "End of Patch.\n";
+my($tz_offset);
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;
+ my($depotfile,$nr,$localfile) = @_;
+ my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
+ return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
+
+ if ($^O eq 'MacOS') { # fix epoch ... still off by three hours (EDT->PDT)
+ require Time::Local;
+ $tz_offset ||= sprintf "%+0.4d\n", (
+ Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
+ );
+ $fstat{headTime} += 2082844801 + $tz_offset;
}
+
+ utime $fstat{headTime}, $fstat{headTime}, $localfile;
}
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)
- (default: //depot/perl/)
- -v verbose
- -h print this help and exit
- -V print version number and exit
+ -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); the last
+ directory within the matched part will be
+ preserved on the local copy, so that patch -p1
+ will work (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
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
};
}