4 # p4genpatch - Generate a perl patch from the repository
8 # andreas.koenig@anima.de
11 use File::Temp qw(tempdir);
19 sub correctmtime ($$$);
26 our %OPT = ( "d" => "u", b => "//depot/perl", "D" => "diff" );
27 Getopt::Long::Configure("no_ignore_case");
28 GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
29 print Usage and exit if $OPT{h};
30 print "$VERSION\n" and exit if $OPT{V};
31 die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
34 for my $p4opt (qw(p)) {
35 push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
38 my $system = "p4 @P4opt describe -s $CHANGE |";
39 open my $p4, $system or die "Could not run $system";
43 next unless m|($OPT{b})|;
45 $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
46 if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
47 next if $action eq "delete";
48 push @action, [$action, $file, $prefix];
54 print "Differences ...\n";
56 $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
57 my($action,$file,$prefix) = @$a;
58 my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
60 my @splitdir = File::Spec::Unix->splitdir($path);
61 $path = File::Spec->catdir(@splitdir);
63 my($depotfile) = $file =~ m|^(.+)#\d+\z|;
64 die "Panic: Could not parse file[$file]" unless $number;
65 $path = "" unless defined $path;
66 my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
68 $prevchange = $CHANGE-1;
69 # can't assume previous rev == $number-1 due to obliterated revisions
70 $prevfile = "$depotfile\@$prevchange";
71 if ($number == 1 or $action =~ /^(add|branch)$/) {
72 $d1 = File::Spec->devnull;
75 } elsif ($action =~ /^(edit|integrate)$/) {
76 $d1 = File::Spec->catfile($path, "$basename-$prevchange");
77 $t1 = File::Spec->catfile($tempdir, $d1);
78 warn "==> $d1 <==\n" if $OPT{v};
79 my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
80 my $status = `$system`;
82 warn "$0: system[$system] failed, status[$?]\n";
86 if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
87 ($prev,$prevchange) = ($1,$2);
88 $prevfile = "$depotfile#$prev";
90 $d1 =~ s/-\d+$/#$prev~$prevchange~/;
92 $t1 = File::Spec->catfile($tempdir, $d1);
96 die "Unknown action[$action]";
98 $d2 = "$path$basename";
99 $t2 = File::Spec->catfile($tempdir, $d2);
100 warn "==> $d2#$number <==\n" if $OPT{v};
101 my $system = qq[p4 @P4opt print -o "$t2" "$file"];
102 # warn "system[$system]";
103 my $type = `$system`;
105 warn "$0: `$system` failed, status[$?]\n";
109 $type =~ m|^//.*\((.+)\)$| or next;
111 if ($doadd or File::Compare::compare($t1, $t2)) {
112 print "\n==== $file ($type) ====\n";
113 unless ($type =~ /text/) {
116 print "Index: $path$basename\n";
117 correctmtime($prevfile,$prev,$t1) unless $doadd;
118 correctmtime($file,$number,$t2);
119 chdir $tempdir or warn "Could not chdir '$tempdir': $!";
120 $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
121 system($system); # no return check because diff doesn't always return 0
122 chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
125 unlink or warn "Could not unlink $_: $!" if -f;
128 print "End of Patch.\n";
131 sub correctmtime ($$$) {
132 my($depotfile,$nr,$localfile) = @_;
133 my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
134 return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
136 if ($^O eq 'MacOS') { # fix epoch ... still off by three hours (EDT->PDT)
138 $tz_offset ||= sprintf "%+0.4d\n", (
139 Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
141 $fstat{headTime} += 2082844801 + $tz_offset;
144 utime $fstat{headTime}, $fstat{headTime}, $localfile;
148 qq{Usage: $0 [OPTIONS] patchnumber
150 -p host:port p4 port (e.g. myhost:1666)
151 -d diffopt option to pass to diff(1)
152 -D diff diff(1) to use
153 -b branch(es) which branches to include (regex); everything up
154 to the last slash of matched portion of path is
155 stripped on local copy (default: //depot/perl)
157 -h print this help and exit
158 -V print version number and exit
160 Fetches all required files from the repository, puts them into a
161 temporary directory with sensible names and sensible modification
162 times and composes a patch to STDOUT using external diff command.
163 Requires repository access.
166 perl $0 12345 | gzip -c > 12345.gz
167 perl $0 -dc 12345 > change-12345.patch
168 perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571