Commit | Line | Data |
---|---|---|
a619eb9e JH |
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 | ||
10 | use strict; | |
11 | use File::Temp qw(tempdir); | |
12 | use File::Compare; | |
00082bef JH |
13 | use File::Spec; |
14 | use File::Spec::Unix; | |
a619eb9e | 15 | use Time::Local; |
667f40ee GS |
16 | use Getopt::Long; |
17 | use Cwd qw(cwd); | |
a619eb9e JH |
18 | |
19 | sub correctmtime ($$$); | |
20 | sub Usage (); | |
21 | ||
667f40ee GS |
22 | $0 =~ s|^.*[\\/]||; |
23 | my $VERSION = '0.05'; | |
24 | my $TOPDIR = cwd(); | |
25 | my @P4opt; | |
2d74ac5a | 26 | our %OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" ); |
a619eb9e | 27 | Getopt::Long::Configure("no_ignore_case"); |
2d6becbd | 28 | GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage; |
a619eb9e JH |
29 | print Usage and exit if $OPT{h}; |
30 | print "$VERSION\n" and exit if $OPT{V}; | |
fc867767 GS |
31 | die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/; |
32 | my $CHANGE = shift; | |
a619eb9e JH |
33 | |
34 | for my $p4opt (qw(p)) { | |
35 | push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt}; | |
36 | } | |
37 | ||
fc867767 | 38 | my $system = "p4 @P4opt describe -s $CHANGE |"; |
a619eb9e JH |
39 | open my $p4, $system or die "Could not run $system"; |
40 | my @action; | |
41 | while (<$p4>) { | |
42 | print; | |
ca8a8491 GS |
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 JH |
47 | if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) { |
48 | next if $action eq "delete"; | |
ca8a8491 | 49 | push @action, [$action, $file, $prefix]; |
a619eb9e JH |
50 | } |
51 | } | |
52 | close $p4; | |
53 | ||
54 | my $tempdir; | |
9b174a27 | 55 | my @unlink; |
a619eb9e JH |
56 | print "Differences ...\n"; |
57 | for my $a (@action) { | |
8d7ecf55 | 58 | $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 ); |
9b174a27 | 59 | @unlink = (); |
ca8a8491 GS |
60 | my($action,$file,$prefix) = @$a; |
61 | my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|; | |
00082bef JH |
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 GS |
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 JH |
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 JH |
83 | my $status = `$system`; |
84 | if ($?) { | |
85 | warn "$0: system[$system] failed, status[$?]\n"; | |
86 | next; | |
87 | } | |
00082bef | 88 | chmod 0644, $t1; |
fc867767 GS |
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 JH |
94 | my $oldt1 = $t1; |
95 | $t1 = File::Spec->catfile($tempdir, $d1); | |
96 | rename $oldt1, $t1; | |
a619eb9e | 97 | } |
9b174a27 | 98 | push @unlink, $t1; |
a619eb9e JH |
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 JH |
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 JH |
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 JH |
118 | unless ($type =~ /text/) { |
119 | next; | |
120 | } | |
9b174a27 GS |
121 | unless ($^O eq 'MacOS') { |
122 | $d1 =~ s,\\,/,g; | |
123 | $d2 =~ s,\\,/,g; | |
124 | } | |
38dcbcb1 | 125 | print "Index: $d2\n"; |
00082bef JH |
126 | correctmtime($prevfile,$prev,$t1) unless $doadd; |
127 | correctmtime($file,$number,$t2); | |
667f40ee GS |
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 GS |
133 | } |
134 | continue { | |
135 | for (@unlink) { | |
a619eb9e JH |
136 | unlink or warn "Could not unlink $_: $!" if -f; |
137 | } | |
138 | } | |
139 | print "End of Patch.\n"; | |
140 | ||
00082bef | 141 | my($tz_offset); |
a619eb9e | 142 | sub correctmtime ($$$) { |
fc867767 | 143 | my($depotfile,$nr,$localfile) = @_; |
cbdeeddd GS |
144 | my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`; |
145 | return unless exists($fstat{headRev}) and $fstat{headRev} == $nr; | |
00082bef JH |
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 JH |
156 | } |
157 | ||
158 | sub Usage () { | |
159 | qq{Usage: $0 [OPTIONS] patchnumber | |
160 | ||
ca8a8491 GS |
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 A |
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 GS |
168 | -v verbose |
169 | -h print this help and exit | |
170 | -V print version number and exit | |
a619eb9e JH |
171 | |
172 | Fetches all required files from the repository, puts them into a | |
173 | temporary directory with sensible names and sensible modification | |
174 | times and composes a patch to STDOUT using external diff command. | |
175 | Requires repository access. | |
176 | ||
177 | Examples: | |
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 JH |
181 | }; |
182 | } |