Commit | Line | Data |
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 | |
10 | use strict; |
11 | use File::Temp qw(tempdir); |
12 | use File::Compare; |
13 | use Time::Local; |
14 | |
15 | sub correctmtime ($$$); |
16 | sub Usage (); |
17 | |
18 | my $VERSION = '0.03'; |
19 | $0 =~ s|^.*/||; |
20 | our(%OPT, @P4opt); |
2d6becbd |
21 | %OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" ); |
a619eb9e |
22 | use Getopt::Long; |
23 | Getopt::Long::Configure("no_ignore_case"); |
2d6becbd |
24 | GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage; |
a619eb9e |
25 | print Usage and exit if $OPT{h}; |
26 | print "$VERSION\n" and exit if $OPT{V}; |
27 | die Usage unless @ARGV == 1; |
28 | |
29 | for my $p4opt (qw(p)) { |
30 | push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt}; |
31 | } |
32 | |
33 | my $system = "p4 @P4opt describe -s @ARGV |"; |
34 | open my $p4, $system or die "Could not run $system"; |
35 | my @action; |
36 | while (<$p4>) { |
37 | print; |
38 | next unless m|$OPT{b}|; |
39 | if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) { |
40 | next if $action eq "delete"; |
41 | push @action, [$action, $file]; |
42 | } |
43 | } |
44 | close $p4; |
45 | |
46 | my $tempdir; |
47 | print "Differences ...\n"; |
48 | for my $a (@action) { |
49 | $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1 ); |
50 | my($action,$file) = @$a; |
51 | my($path,$basename,$number) = $file =~ m|//depot/(.+/)?([^/]+)#(\d+)|; |
52 | $path = "" unless defined $path; |
53 | my($d1,$d2,$prev); |
54 | $prev = $number-1; |
55 | if ($prev==0 or $action =~ /^(add|branch)$/) { |
56 | $d1 = "/dev/null"; |
57 | } elsif ($action =~ /^(edit|integrate)$/) { |
58 | $d1 = "$path$basename#$prev"; |
59 | warn "==> $d1 <==\n" if $OPT{v}; |
60 | my $system = "p4 @P4opt print -o $tempdir/$d1 //depot/$path$basename#$prev"; |
61 | my $status = `$system`; |
62 | if ($?) { |
63 | warn "$0: system[$system] failed, status[$?]\n"; |
64 | next; |
65 | } |
66 | if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) { |
67 | my $oldd1 = $d1; |
68 | $d1 .= "~$prevch~"; |
69 | rename "$tempdir/$oldd1", "$tempdir/$d1"; |
70 | } |
71 | } else { |
72 | die "Unknown action[$action]"; |
73 | } |
74 | $d2 = "$path$basename"; |
75 | warn "==> $d2#$number <==\n" if $OPT{v}; |
76 | my $system = "p4 @P4opt print -o $tempdir/$d2 $file"; |
77 | # warn "system[$system]"; |
78 | my $type = `$system`; |
79 | if ($?) { |
80 | warn "$0: `$system` failed, status[$?]\n"; |
81 | next; |
82 | } |
83 | $type =~ m|^//.*\((.+)\)$| or next; |
84 | $type = $1; |
85 | if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) { |
86 | print "\n==== $file ($type) ====\nIndex: $path$basename\n"; |
87 | unless ($type =~ /text/) { |
88 | next; |
89 | } |
90 | my @filelog = `p4 @P4opt filelog $file`; |
91 | correctmtime(\@filelog,$prev,"$tempdir/$d1"); |
92 | correctmtime(\@filelog,$number,"$tempdir/$d2"); |
2d6becbd |
93 | $system = "cd $tempdir && $OPT{D} -$OPT{d} '$d1' '$d2'"; |
a619eb9e |
94 | system($system); # no return check because diff doesn't always return 0 |
95 | } |
96 | for ("$tempdir/$d1","$tempdir/$d2") { |
97 | unlink or warn "Could not unlink $_: $!" if -f; |
98 | } |
99 | } |
100 | print "End of Patch.\n"; |
101 | |
102 | sub correctmtime ($$$) { |
103 | my($filelog,$nr,$file) = @_; |
104 | for my $line (@$filelog) { |
105 | my($rev,$change,$action,$date) = |
106 | $line =~ m{ ^ \.\.\. \s |
107 | \# |
108 | (\d+) # rev |
109 | \s change \s |
110 | (\d+) # change |
111 | \s (\w+) \s # action |
112 | on \s (\S+) # date |
113 | }x or next; |
114 | # warn "rev[$rev]"; |
115 | next unless $rev == $nr; |
116 | my(@date) = split m|/|, $date; |
117 | $date[0] -= 1900; |
118 | $date[1]--; |
119 | my $time = timelocal(0,0,0,reverse @date); |
120 | utime $time, $time, $file; |
121 | last; |
122 | } |
123 | } |
124 | |
125 | sub Usage () { |
126 | qq{Usage: $0 [OPTIONS] patchnumber |
127 | |
128 | -p host:port p4 port (e.g. myhost:1666) |
129 | -d diffopt option to pass to diff(1) |
2d6becbd |
130 | -D diff diff(1) to use |
a619eb9e |
131 | -b branch(es) which branches to include (regex) |
132 | (default: //depot/perl/) |
133 | -v verbose |
134 | -h print this help and exit |
135 | -V print version number and exit |
136 | |
137 | Fetches all required files from the repository, puts them into a |
138 | temporary directory with sensible names and sensible modification |
139 | times and composes a patch to STDOUT using external diff command. |
140 | Requires repository access. |
141 | |
142 | Examples: |
143 | perl $0 12345 | gzip -c > 12345.gz |
144 | perl $0 -dc 12345 > change-12345.patch |
145 | }; |
146 | } |