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