Tools/Scripts/svn-create-patch

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2005, 2006 Apple Computer, Inc.  All rights reserved.
   4 #
   5 # Redistribution and use in source and binary forms, with or without
   6 # modification, are permitted provided that the following conditions
   7 # are met:
   8 #
   9 # 1.  Redistributions of source code must retain the above copyright
  10 #     notice, this list of conditions and the following disclaimer.
  11 # 2.  Redistributions in binary form must reproduce the above copyright
  12 #     notice, this list of conditions and the following disclaimer in the
  13 #     documentation and/or other materials provided with the distribution.
  14 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
  15 #     its contributors may be used to endorse or promote products derived
  16 #     from this software without specific prior written permission.
  17 #
  18 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
  19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  21 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
  22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 # Extended "svn diff" script for WebKit Open Source Project, used to make patches.
  30
  31 # Differences from standard "svn diff":
  32 #
  33 #   Uses the real diff, not svn's built-in diff.
  34 #   Always passes "-p" to diff so it will try to include function names.
  35 #   Handles binary files (encoded as a base64 chunk of text).
  36 #   Sorts the diffs alphabetically by text files, then binary files.
  37 #   Handles copied and moved files.
  38 #
  39 # Missing features:
  40 #
  41 #   Handle copied and moved directories.
  42
  43 use strict;
  44 use warnings;
  45
  46 use Config;
  47 use File::Basename;
  48 use File::Spec;
  49 use File::stat;
  50 use FindBin;
  51 use Getopt::Long;
  52 use lib $FindBin::Bin;
  53 use MIME::Base64;
  54 use POSIX qw(:errno_h);
  55 use Time::gmtime;
  56 use VCSUtils;
  57
  58 sub binarycmp($$);
  59 sub diffOptionsForFile($);
  60 sub findBaseUrl($);
  61 sub findMimeType($;$);
  62 sub findModificationType($);
  63 sub findSourceFileAndRevision($);
  64 sub generateDiff($$);
  65 sub generateFileList($\%);
  66 sub hunkHeaderLineRegExForFile($);
  67 sub isBinaryMimeType($);
  68 sub manufacturePatchForAdditionWithHistory($);
  69 sub numericcmp($$);
  70 sub outputBinaryContent($);
  71 sub patchpathcmp($$);
  72 sub pathcmp($$);
  73 sub processPaths(\@);
  74 sub splitpath($);
  75 sub testfilecmp($$);
  76
  77 $ENV{'LC_ALL'} = 'C';
  78
  79 my $showHelp;
  80 my $ignoreChangelogs = 0;
  81 my $devNull = File::Spec->devnull();
  82
  83 my $result = GetOptions(
  84     "help"       => \$showHelp,
  85     "ignore-changelogs"    => \$ignoreChangelogs
  86 );
  87 if (!$result || $showHelp) {
  88     print STDERR basename($0) . " [-h|--help] [--ignore-changelogs] [svndir1 [svndir2 ...]]\n";
  89     exit 1;
  90 }
  91
  92 # Sort the diffs for easier reviewing.
  93 my %paths = processPaths(@ARGV);
  94
  95 # Generate a list of files requiring diffs.
  96 my %diffFiles;
  97 for my $path (keys %paths) {
  98     generateFileList($path, %diffFiles);
  99 }
 100
 101 my $svnRoot = determineSVNRoot();
 102 my $prefix = chdirReturningRelativePath($svnRoot);
 103
 104 my $patchSize = 0;
 105
 106 # Generate the diffs, in a order chosen for easy reviewing.
 107 for my $path (sort patchpathcmp values %diffFiles) {
 108     $patchSize += generateDiff($path, $prefix);
 109 }
 110
 111 if ($patchSize > 20480) {
 112     print STDERR "WARNING: Patch's size is " . int($patchSize/1024) . " kbytes.\n";
 113     print STDERR "Patches 20k or smaller are more likely to be reviewed. Larger patches may sit unreviewed for a long time.\n";
 114 }
 115
 116 exit 0;
 117
 118 # Overall sort, considering multiple criteria.
 119 sub patchpathcmp($$)
 120 {
 121     my ($a, $b) = @_;
 122
 123     # All binary files come after all non-binary files.
 124     my $result = binarycmp($a, $b);
 125     return $result if $result;
 126
 127     # All test files come after all non-test files.
 128     $result = testfilecmp($a, $b);
 129     return $result if $result;
 130
 131     # Final sort is a "smart" sort by directory and file name.
 132     return pathcmp($a, $b);
 133 }
 134
 135 # Sort so text files appear before binary files.
 136 sub binarycmp($$)
 137 {
 138     my ($fileDataA, $fileDataB) = @_;
 139     return $fileDataA->{isBinary} <=> $fileDataB->{isBinary};
 140 }
 141
 142 sub diffOptionsForFile($)
 143 {
 144     my ($file) = @_;
 145
 146     my $options = "uaNp";
 147
 148     if (my $hunkHeaderLineRegEx = hunkHeaderLineRegExForFile($file)) {
 149         $options .= "F'$hunkHeaderLineRegEx'";
 150     }
 151
 152     return $options;
 153 }
 154
 155 sub findBaseUrl($)
 156 {
 157     my ($infoPath) = @_;
 158     my $baseUrl;
 159     open INFO, "svn info '$infoPath' |" or die;
 160     while (<INFO>) {
 161         if (/^URL: (.+?)[\r\n]*$/) {
 162             $baseUrl = $1;
 163         }
 164     }
 165     close INFO;
 166     return $baseUrl;
 167 }
 168
 169 sub findMimeType($;$)
 170 {
 171     my ($file, $revision) = @_;
 172     my $args = $revision ? "--revision $revision" : "";
 173     open PROPGET, "svn propget svn:mime-type $args '$file' |" or die;
 174     my $mimeType = <PROPGET>;
 175     close PROPGET;
 176     # svn may output a different EOL sequence than $/, so avoid chomp.
 177     if ($mimeType) {
 178         $mimeType =~ s/[\r\n]+$//g;
 179     }
 180     return $mimeType;
 181 }
 182
 183 sub findModificationType($)
 184 {
 185     my ($stat) = @_;
 186     my $fileStat = substr($stat, 0, 1);
 187     my $propertyStat = substr($stat, 1, 1);
 188     if ($fileStat eq "A" || $fileStat eq "R") {
 189         my $additionWithHistory = substr($stat, 3, 1);
 190         return $additionWithHistory eq "+" ? "additionWithHistory" : "addition";
 191     }
 192     return "modification" if ($fileStat eq "M" || $propertyStat eq "M");
 193     return "deletion" if ($fileStat eq "D");
 194     return undef;
 195 }
 196
 197 sub findSourceFileAndRevision($)
 198 {
 199     my ($file) = @_;
 200     my $baseUrl = findBaseUrl(".");
 201     my $sourceFile;
 202     my $sourceRevision;
 203     open INFO, "svn info '$file' |" or die;
 204     while (<INFO>) {
 205         if (/^Copied From URL: (.+?)[\r\n]*$/) {
 206             $sourceFile = File::Spec->abs2rel($1, $baseUrl);
 207         } elsif (/^Copied From Rev: ([0-9]+)/) {
 208             $sourceRevision = $1;
 209         }
 210     }
 211     close INFO;
 212     return ($sourceFile, $sourceRevision);
 213 }
 214
 215 sub generateDiff($$)
 216 {
 217     my ($fileData, $prefix) = @_;
 218     my $file = File::Spec->catdir($prefix, $fileData->{path});
 219
 220     if ($ignoreChangelogs && basename($file) eq "ChangeLog") {
 221         return 0;
 222     }
 223
 224     my $patch = "";
 225     if ($fileData->{modificationType} eq "additionWithHistory") {
 226         manufacturePatchForAdditionWithHistory($fileData);
 227     }
 228
 229     my $diffOptions = diffOptionsForFile($file);
 230     open DIFF, "svn diff --diff-cmd diff -x -$diffOptions '$file' |" or die;
 231     while (<DIFF>) {
 232         $patch .= $_;
 233     }
 234     close DIFF;
 235     if (basename($file) eq "ChangeLog") {
 236         my $changeLogHash = fixChangeLogPatch($patch);
 237         $patch = $changeLogHash->{patch};
 238     }
 239     print $patch;
 240     if ($fileData->{isBinary}) {
 241         print "\n" if ($patch && $patch =~ m/\n\S+$/m);
 242         outputBinaryContent($file);
 243     }
 244     return length($patch);
 245 }
 246
 247 sub generateFileList($\%)
 248 {
 249     my ($statPath, $diffFiles) = @_;
 250     my %testDirectories = map { $_ => 1 } qw(LayoutTests);
 251     open STAT, "svn stat '$statPath' |" or die;
 252     while (my $line = <STAT>) {
 253         # svn may output a different EOL sequence than $/, so avoid chomp.
 254         $line =~ s/[\r\n]+$//g;
 255         my $stat;
 256         my $path;
 257         if (isSVNVersion16OrNewer()) {
 258             $stat = substr($line, 0, 8);
 259             $path = substr($line, 8);
 260         } else {
 261             $stat = substr($line, 0, 7);
 262             $path = substr($line, 7);
 263         }
 264         next if -d $path;
 265         my $modificationType = findModificationType($stat);
 266         if ($modificationType) {
 267             $diffFiles->{$path}->{path} = $path;
 268             $diffFiles->{$path}->{modificationType} = $modificationType;
 269             $diffFiles->{$path}->{isBinary} = isBinaryMimeType($path);
 270             $diffFiles->{$path}->{isTestFile} = exists $testDirectories{(File::Spec->splitdir($path))[0]} ? 1 : 0;
 271             if ($modificationType eq "additionWithHistory") {
 272                 my ($sourceFile, $sourceRevision) = findSourceFileAndRevision($path);
 273                 $diffFiles->{$path}->{sourceFile} = $sourceFile;
 274                 $diffFiles->{$path}->{sourceRevision} = $sourceRevision;
 275             }
 276         } else {
 277             print STDERR $line, "\n";
 278         }
 279     }
 280     close STAT;
 281 }
 282
 283 sub hunkHeaderLineRegExForFile($)
 284 {
 285     my ($file) = @_;
 286
 287     my $startOfObjCInterfaceRegEx = "@(implementation\\|interface\\|protocol)";
 288     return "^[-+]\\|$startOfObjCInterfaceRegEx" if $file =~ /\.mm?$/;
 289     return "^$startOfObjCInterfaceRegEx" if $file =~ /^(.*\/)?(mac|objc)\// && $file =~ /\.h$/;
 290 }
 291
 292 sub isBinaryMimeType($)
 293 {
 294     my ($file) = @_;
 295     my $mimeType = findMimeType($file);
 296     return 0 if (!$mimeType || substr($mimeType, 0, 5) eq "text/");
 297     return 1;
 298 }
 299
 300 sub manufacturePatchForAdditionWithHistory($)
 301 {
 302     my ($fileData) = @_;
 303     my $file = $fileData->{path};
 304     print "Index: ${file}\n";
 305     print "=" x 67, "\n";
 306     my $sourceFile = $fileData->{sourceFile};
 307     my $sourceRevision = $fileData->{sourceRevision};
 308     print "--- ${file}\t(revision ${sourceRevision})\t(from ${sourceFile}:${sourceRevision})\n";
 309     print "+++ ${file}\t(working copy)\n";
 310     if ($fileData->{isBinary}) {
 311         print "\nCannot display: file marked as a binary type.\n";
 312         my $mimeType = findMimeType($file, $sourceRevision);
 313         print "svn:mime-type = ${mimeType}\n\n";
 314     } else {
 315         print `svn cat ${sourceFile} | diff -u $devNull - | tail -n +3`;
 316     }
 317 }
 318
 319 # Sort numeric parts of strings as numbers, other parts as strings.
 320 # Makes 1.33 come after 1.3, which is cool.
 321 sub numericcmp($$)
 322 {
 323     my ($aa, $bb) = @_;
 324
 325     my @a = split /(\d+)/, $aa;
 326     my @b = split /(\d+)/, $bb;
 327
 328     # Compare one chunk at a time.
 329     # Each chunk is either all numeric digits, or all not numeric digits.
 330     while (@a && @b) {
 331         my $a = shift @a;
 332         my $b = shift @b;
 333
 334         # Use numeric comparison if chunks are non-equal numbers.
 335         return $a <=> $b if $a =~ /^\d/ && $b =~ /^\d/ && $a != $b;
 336
 337         # Use string comparison if chunks are any other kind of non-equal string.
 338         return $a cmp $b if $a ne $b;
 339     }
 340
 341     # One of the two is now empty; compare lengths for result in this case.
 342     return @a <=> @b;
 343 }
 344
 345 sub outputBinaryContent($)
 346 {
 347     my ($path) = @_;
 348     # Deletion
 349     return if (! -e $path);
 350     # Addition or Modification
 351     my $buffer;
 352     open BINARY, $path  or die;
 353     while (read(BINARY, $buffer, 60*57)) {
 354         print encode_base64($buffer);
 355     }
 356     close BINARY;
 357     print "\n";
 358 }
 359
 360 # Sort first by directory, then by file, so all paths in one directory are grouped
 361 # rather than being interspersed with items from subdirectories.
 362 # Use numericcmp to sort directory and filenames to make order logical.
 363 # Also include a special case for ChangeLog, which comes first in any directory.
 364 sub pathcmp($$)
 365 {
 366     my ($fileDataA, $fileDataB) = @_;
 367
 368     my ($dira, $namea) = splitpath($fileDataA->{path});
 369     my ($dirb, $nameb) = splitpath($fileDataB->{path});
 370
 371     return numericcmp($dira, $dirb) if $dira ne $dirb;
 372     return -1 if $namea eq "ChangeLog" && $nameb ne "ChangeLog";
 373     return +1 if $namea ne "ChangeLog" && $nameb eq "ChangeLog";
 374     return numericcmp($namea, $nameb);
 375 }
 376
 377 sub processPaths(\@)
 378 {
 379     my ($paths) = @_;
 380     return ("." => 1) if (!@{$paths});
 381
 382     my %result = ();
 383
 384     for my $file (@{$paths}) {
 385         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
 386         die "can't handle empty string path\n" if $file eq "";
 387         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
 388
 389         my $untouchedFile = $file;
 390
 391         $file = canonicalizePath($file);
 392
 393         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
 394
 395         $result{$file} = 1;
 396     }
 397
 398     return ("." => 1) if ($result{"."});
 399
 400     # Remove any paths that also have a parent listed.
 401     for my $path (keys %result) {
 402         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {
 403             if ($result{$parent}) {
 404                 delete $result{$path};
 405                 last;
 406             }
 407         }
 408     }
 409
 410     return %result;
 411 }
 412
 413 # Break up a path into the directory (with slash) and base name.
 414 sub splitpath($)
 415 {
 416     my ($path) = @_;
 417
 418     my $pathSeparator = "/";
 419     my $dirname = dirname($path) . $pathSeparator;
 420     $dirname = "" if $dirname eq "." . $pathSeparator;
 421
 422     return ($dirname, basename($path));
 423 }
 424
 425 # Sort so source code files appear before test files.
 426 sub testfilecmp($$)
 427 {
 428     my ($fileDataA, $fileDataB) = @_;
 429     return $fileDataA->{isTestFile} <=> $fileDataB->{isTestFile};
 430 }
 431