A slightly better layout for the diagram.
[p5sagit/p5-mst-13.2.git] / Porting / p4genpatch
CommitLineData
a619eb9e 1#!/usr/bin/perl -w
2
3
4# p4genpatch - Generate a perl patch from the repository
5
6# Usage: $0 -h
7
8# andreas.koenig@anima.de
9
10use strict;
11use File::Temp qw(tempdir);
12use File::Compare;
00082bef 13use File::Spec;
14use File::Spec::Unix;
a619eb9e 15use Time::Local;
667f40ee 16use Getopt::Long;
17use Cwd qw(cwd);
a619eb9e 18
19sub correctmtime ($$$);
20sub Usage ();
21
667f40ee 22$0 =~ s|^.*[\\/]||;
23my $VERSION = '0.05';
24my $TOPDIR = cwd();
25my @P4opt;
2d74ac5a 26our %OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" );
a619eb9e 27Getopt::Long::Configure("no_ignore_case");
2d6becbd 28GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
a619eb9e 29print Usage and exit if $OPT{h};
30print "$VERSION\n" and exit if $OPT{V};
fc867767 31die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
32my $CHANGE = shift;
a619eb9e 33
34for my $p4opt (qw(p)) {
35 push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
36}
37
fc867767 38my $system = "p4 @P4opt describe -s $CHANGE |";
a619eb9e 39open my $p4, $system or die "Could not run $system";
40my @action;
41while (<$p4>) {
42 print;
ca8a8491 43 next unless m|($OPT{b})|;
44 my($prefix) = $1;
2d74ac5a 45 $prefix =~ s|/$||;
ca8a8491 46 $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
a619eb9e 47 if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
48 next if $action eq "delete";
ca8a8491 49 push @action, [$action, $file, $prefix];
a619eb9e 50 }
51}
52close $p4;
53
54my $tempdir;
9b174a27 55my @unlink;
a619eb9e 56print "Differences ...\n";
57for my $a (@action) {
8d7ecf55 58 $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
9b174a27 59 @unlink = ();
ca8a8491 60 my($action,$file,$prefix) = @$a;
61 my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
00082bef 62
63 my @splitdir = File::Spec::Unix->splitdir($path);
64 $path = File::Spec->catdir(@splitdir);
65
fc867767 66 my($depotfile) = $file =~ m|^(.+)#\d+\z|;
ca8a8491 67 die "Panic: Could not parse file[$file]" unless $number;
a619eb9e 68 $path = "" unless defined $path;
00082bef 69 my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
a619eb9e 70 $prev = $number-1;
fc867767 71 $prevchange = $CHANGE-1;
72 # can't assume previous rev == $number-1 due to obliterated revisions
73 $prevfile = "$depotfile\@$prevchange";
74 if ($number == 1 or $action =~ /^(add|branch)$/) {
9b174a27 75 $d1 = $^O eq 'MacOS' ? File::Spec->devnull : "/dev/null";
00082bef 76 $t1 = $d1;
cbdeeddd 77 ++$doadd;
a619eb9e 78 } elsif ($action =~ /^(edit|integrate)$/) {
00082bef 79 $d1 = File::Spec->catfile($path, "$basename-$prevchange");
80 $t1 = File::Spec->catfile($tempdir, $d1);
a619eb9e 81 warn "==> $d1 <==\n" if $OPT{v};
00082bef 82 my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
a619eb9e 83 my $status = `$system`;
84 if ($?) {
85 warn "$0: system[$system] failed, status[$?]\n";
86 next;
87 }
00082bef 88 chmod 0644, $t1;
fc867767 89 if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
90 ($prev,$prevchange) = ($1,$2);
91 $prevfile = "$depotfile#$prev";
a619eb9e 92 my $oldd1 = $d1;
fc867767 93 $d1 =~ s/-\d+$/#$prev~$prevchange~/;
00082bef 94 my $oldt1 = $t1;
95 $t1 = File::Spec->catfile($tempdir, $d1);
96 rename $oldt1, $t1;
a619eb9e 97 }
9b174a27 98 push @unlink, $t1;
a619eb9e 99 } else {
100 die "Unknown action[$action]";
101 }
38dcbcb1 102 $d2 = File::Spec->catfile($path, $basename);
00082bef 103 $t2 = File::Spec->catfile($tempdir, $d2);
9b174a27 104 push @unlink, $t2;
a619eb9e 105 warn "==> $d2#$number <==\n" if $OPT{v};
00082bef 106 my $system = qq[p4 @P4opt print -o "$t2" "$file"];
a619eb9e 107 # warn "system[$system]";
108 my $type = `$system`;
109 if ($?) {
110 warn "$0: `$system` failed, status[$?]\n";
111 next;
112 }
00082bef 113 chmod 0644, $t2;
a619eb9e 114 $type =~ m|^//.*\((.+)\)$| or next;
115 $type = $1;
00082bef 116 if ($doadd or File::Compare::compare($t1, $t2)) {
667f40ee 117 print "\n==== $file ($type) ====\n";
a619eb9e 118 unless ($type =~ /text/) {
119 next;
120 }
9b174a27 121 unless ($^O eq 'MacOS') {
122 $d1 =~ s,\\,/,g;
123 $d2 =~ s,\\,/,g;
124 }
38dcbcb1 125 print "Index: $d2\n";
00082bef 126 correctmtime($prevfile,$prev,$t1) unless $doadd;
127 correctmtime($file,$number,$t2);
667f40ee 128 chdir $tempdir or warn "Could not chdir '$tempdir': $!";
129 $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
a619eb9e 130 system($system); # no return check because diff doesn't always return 0
667f40ee 131 chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
a619eb9e 132 }
9b174a27 133}
134continue {
135 for (@unlink) {
a619eb9e 136 unlink or warn "Could not unlink $_: $!" if -f;
137 }
138}
139print "End of Patch.\n";
140
00082bef 141my($tz_offset);
a619eb9e 142sub correctmtime ($$$) {
fc867767 143 my($depotfile,$nr,$localfile) = @_;
cbdeeddd 144 my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
145 return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
00082bef 146
147 if ($^O eq 'MacOS') { # fix epoch ... still off by three hours (EDT->PDT)
148 require Time::Local;
149 $tz_offset ||= sprintf "%+0.4d\n", (
150 Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
151 );
152 $fstat{headTime} += 2082844801 + $tz_offset;
153 }
154
fc867767 155 utime $fstat{headTime}, $fstat{headTime}, $localfile;
a619eb9e 156}
157
158sub Usage () {
159 qq{Usage: $0 [OPTIONS] patchnumber
160
ca8a8491 161 -p host:port p4 port (e.g. myhost:1666)
162 -d diffopt option to pass to diff(1)
163 -D diff diff(1) to use
2d74ac5a 164 -b branch(es) which branches to include (regex); the last
165 directory within the matched part will be
166 preserved on the local copy, so that patch -p1
167 will work (default: "//depot/perl/")
ca8a8491 168 -v verbose
169 -h print this help and exit
170 -V print version number and exit
a619eb9e 171
172Fetches all required files from the repository, puts them into a
173temporary directory with sensible names and sensible modification
174times and composes a patch to STDOUT using external diff command.
175Requires repository access.
176
177Examples:
178 perl $0 12345 | gzip -c > 12345.gz
179 perl $0 -dc 12345 > change-12345.patch
ca8a8491 180 perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
a619eb9e 181};
182}