4 # p4genpatch - Generate a perl patch from the repository
8 # andreas.koenig@anima.de
11 use File::Temp qw(tempdir);
15 sub correctmtime ($$$);
21 %OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" );
23 Getopt::Long::Configure("no_ignore_case");
24 GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
25 print Usage and exit if $OPT{h};
26 print "$VERSION\n" and exit if $OPT{V};
27 die Usage unless @ARGV == 1;
29 for my $p4opt (qw(p)) {
30 push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
33 my $system = "p4 @P4opt describe -s @ARGV |";
34 open my $p4, $system or die "Could not run $system";
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];
47 print "Differences ...\n";
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;
55 if ($prev==0 or $action =~ /^(add|branch)$/) {
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`;
63 warn "$0: system[$system] failed, status[$?]\n";
66 if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) {
69 rename "$tempdir/$oldd1", "$tempdir/$d1";
72 die "Unknown action[$action]";
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]";
80 warn "$0: `$system` failed, status[$?]\n";
83 $type =~ m|^//.*\((.+)\)$| or next;
85 if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
86 print "\n==== $file ($type) ====\nIndex: $path$basename\n";
87 unless ($type =~ /text/) {
90 my @filelog = `p4 @P4opt filelog $file`;
91 correctmtime(\@filelog,$prev,"$tempdir/$d1");
92 correctmtime(\@filelog,$number,"$tempdir/$d2");
93 $system = "cd $tempdir && $OPT{D} -$OPT{d} '$d1' '$d2'";
94 system($system); # no return check because diff doesn't always return 0
96 for ("$tempdir/$d1","$tempdir/$d2") {
97 unlink or warn "Could not unlink $_: $!" if -f;
100 print "End of Patch.\n";
102 sub correctmtime ($$$) {
103 my($filelog,$nr,$file) = @_;
104 for my $line (@$filelog) {
105 my($rev,$change,$action,$date) =
106 $line =~ m{ ^ \.\.\. \s
115 next unless $rev == $nr;
116 my(@date) = split m|/|, $date;
119 my $time = timelocal(0,0,0,reverse @date);
120 utime $time, $time, $file;
126 qq{Usage: $0 [OPTIONS] patchnumber
128 -p host:port p4 port (e.g. myhost:1666)
129 -d diffopt option to pass to diff(1)
130 -D diff diff(1) to use
131 -b branch(es) which branches to include (regex)
132 (default: //depot/perl/)
134 -h print this help and exit
135 -V print version number and exit
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.
143 perl $0 12345 | gzip -c > 12345.gz
144 perl $0 -dc 12345 > change-12345.patch