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 Cwd;

    48 use File::Basename;

    49 use File::Spec;

    50 use File::stat;

    51 use Getopt::Long;

    52 use MIME::Base64;

    53 use POSIX qw(:errno_h);

    54 use Time::gmtime;

    55 

    56 sub binarycmp($$);

    57 sub canonicalizePath($);

    58 sub findBaseUrl($);

    59 sub findMimeType($;$);

    60 sub findModificationType($);

    61 sub findSourceFileAndRevision($);

    62 sub fixChangeLogPatch($);

    63 sub generateDiff($);

    64 sub generateFileList($\%);

    65 sub isBinaryMimeType($);

    66 sub manufacturePatchForAdditionWithHistory($);

    67 sub numericcmp($$);

    68 sub outputBinaryContent($);

    69 sub pathcmp($$);

    70 sub processPaths(\@);

    71 sub splitpath($);

    72 sub testfilecmp($$);

    73 

    74 $ENV{'LC_ALL'} = 'C';

    75 

    76 my $showHelp;

    77 

    78 my $result = GetOptions(

    79     "help"       => \$showHelp,

    80 );

    81 if (!$result || $showHelp) {

    82     print STDERR basename($0) . " [-h|--help] [svndir1 [svndir2 ...]]\n";

    83     exit 1;

    84 }

    85 

    86 my %paths = processPaths(@ARGV);

    87 

    88 # Generate a list of files requiring diffs

    89 my %diffFiles;

    90 for my $path (keys %paths) {

    91     generateFileList($path, %diffFiles);

    92 }

    93 

    94 # Generate the diff for source code files, test files then binary files for easy reviewing

    95 for my $fileData (sort binarycmp sort testfilecmp sort pathcmp values %diffFiles) {

    96     generateDiff($fileData);

    97 }

    98 

    99 exit 0;

   100 

   101 

   102 # Sort so text files appear before binary files.

   103 sub binarycmp($$)

   104 {

   105     my ($fileDataA, $fileDataB) = @_;

   106     return $fileDataA->{isBinary} <=> $fileDataB->{isBinary};

   107 }

   108 

   109 sub canonicalizePath($)

   110 {

   111     my ($file) = @_;

   112 

   113     # Remove extra slashes and '.' directories in path

   114     $file = File::Spec->canonpath($file);

   115 

   116     # Remove '..' directories in path

   117     my @dirs = ();

   118     foreach my $dir (File::Spec->splitdir($file)) {

   119         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {

   120             pop(@dirs);

   121         } else {

   122             push(@dirs, $dir);

   123         }

   124     }

   125     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";

   126 }

   127 

   128 sub findBaseUrl($)

   129 {

   130     my ($infoPath) = @_;

   131     my $baseUrl;

   132     open INFO, "svn info '$infoPath' |" or die;

   133     while (<INFO>) {

   134         if (/^URL: (.+)/) {

   135             $baseUrl = $1;

   136             last;

   137         }

   138     }

   139     close INFO;

   140     return $baseUrl;

   141 }

   142 

   143 sub findMimeType($;$)

   144 {

   145     my ($file, $revision) = @_;

   146     my $args = $revision ? "--revision $revision" : "";

   147     open PROPGET, "svn propget svn:mime-type $args '$file' |" or die;

   148     my $mimeType = <PROPGET>;

   149     close PROPGET;

   150     chomp $mimeType if $mimeType;

   151     return $mimeType;

   152 }

   153 

   154 sub findModificationType($)

   155 {

   156     my ($stat) = @_;

   157     my $fileStat = substr($stat, 0, 1);

   158     my $propertyStat = substr($stat, 1, 1);

   159     if ($fileStat eq "A") {

   160         my $additionWithHistory = substr($stat, 3, 1);

   161         return $additionWithHistory eq "+" ? "additionWithHistory" : "addition";

   162     }

   163     return "modification" if ($fileStat eq "M" || $propertyStat eq "M");

   164     return "deletion" if ($fileStat eq "D");

   165     return undef;

   166 }

   167 

   168 sub findSourceFileAndRevision($)

   169 {

   170     my ($file) = @_;

   171     my $baseUrl = findBaseUrl(".");

   172     my $sourceFile;

   173     my $sourceRevision;

   174     open INFO, "svn info '$file' |" or die;

   175     while (<INFO>) {

   176         if (/^Copied From URL: (.+)/) {

   177             $sourceFile = File::Spec->abs2rel($1, $baseUrl);

   178         } elsif (/^Copied From Rev: ([0-9]+)/) {

   179             $sourceRevision = $1;

   180         }

   181     }

   182     close INFO;

   183     return ($sourceFile, $sourceRevision);

   184 }

   185 

   186 sub fixChangeLogPatch($)

   187 {

   188     my $patch = shift;

   189     my $contextLineCount = 3;

   190 

   191     return $patch if $patch !~ /\n@@ -1,(\d+) \+1,(\d+) @@\n( .*\n)+(\+.*\n)+( .*\n){$contextLineCount}$/m;

   192     my ($oldLineCount, $newLineCount) = ($1, $2);

   193     return $patch if $oldLineCount <= $contextLineCount;

   194 

   195     # The diff(1) command is greedy when matching lines, so a new ChangeLog entry will

   196     # have lines of context at the top of a patch when the existing entry has the same

   197     # date and author as the new entry.  This nifty loop alters a ChangeLog patch so

   198     # that the added lines ("+") in the patch always start at the beginning of the

   199     # patch and there are no initial lines of context.

   200     my $newPatch;

   201     my $lineCountInState = 0;

   202     my $oldContentLineCountReduction = $oldLineCount - $contextLineCount;

   203     my $newContentLineCountWithoutContext = $newLineCount - $oldLineCount - $oldContentLineCountReduction;

   204     my ($stateHeader, $statePreContext, $stateNewChanges, $statePostContext) = (1..4);

   205     my $state = $stateHeader;

   206     foreach my $line (split(/\n/, $patch)) {

   207         $lineCountInState++;

   208         if ($state == $stateHeader && $line =~ /^@@ -1,$oldLineCount \+1,$newLineCount @\@$/) {

   209             $line = "@@ -1,$contextLineCount +1," . ($newLineCount - $oldContentLineCountReduction) . " @@";

   210             $lineCountInState = 0;

   211             $state = $statePreContext;

   212         } elsif ($state == $statePreContext && substr($line, 0, 1) eq " ") {

   213             $line = "+" . substr($line, 1);

   214             if ($lineCountInState == $oldContentLineCountReduction) {

   215                 $lineCountInState = 0;

   216                 $state = $stateNewChanges;

   217             }

   218         } elsif ($state == $stateNewChanges && substr($line, 0, 1) eq "+") {

   219             # No changes to these lines

   220             if ($lineCountInState == $newContentLineCountWithoutContext) {

   221                 $lineCountInState = 0;

   222                 $state = $statePostContext;

   223             }

   224         } elsif ($state == $statePostContext) {

   225             if (substr($line, 0, 1) eq "+" && $lineCountInState <= $oldContentLineCountReduction) {

   226                 $line = " " . substr($line, 1);

   227             } elsif ($lineCountInState > $contextLineCount && substr($line, 0, 1) eq " ") {

   228                 next; # Discard

   229             }

   230         }

   231         $newPatch .= $line . "\n";

   232     }

   233 

   234     return $newPatch;

   235 }

   236 

   237 sub generateDiff($)

   238 {

   239     my ($fileData) = @_;

   240     my $file = $fileData->{path};

   241     my $patch;

   242     if ($fileData->{modificationType} eq "additionWithHistory") {

   243         manufacturePatchForAdditionWithHistory($fileData);

   244     }

   245     open DIFF, "svn diff --diff-cmd diff -x -uaNp '$file' |" or die;

   246     while (<DIFF>) {

   247         $patch .= $_;

   248     }

   249     close DIFF;

   250     $patch = fixChangeLogPatch($patch) if basename($file) eq "ChangeLog";

   251     print $patch if $patch;

   252     if ($fileData->{isBinary}) {

   253         print "\n" if ($patch && $patch =~ m/\n\S+$/m);

   254         outputBinaryContent($file);

   255     }

   256 }

   257 

   258 sub generateFileList($\%)

   259 {

   260     my ($statPath, $diffFiles) = @_;

   261     my %testDirectories = map { $_ => 1 } qw(LayoutTests);

   262     open STAT, "svn stat '$statPath' |" or die;

   263     while (my $line = <STAT>) {

   264         chomp $line;

   265         my $stat = substr($line, 0, 7);

   266         my $path = substr($line, 7);

   267         next if -d $path;

   268         my $modificationType = findModificationType($stat);

   269         if ($modificationType) {

   270             $diffFiles->{$path}->{path} = $path;

   271             $diffFiles->{$path}->{modificationType} = $modificationType;

   272             $diffFiles->{$path}->{isBinary} = isBinaryMimeType($path);

   273             $diffFiles->{$path}->{isTestFile} = exists $testDirectories{(File::Spec->splitdir($path))[0]} ? 1 : 0;

   274             if ($modificationType eq "additionWithHistory") {

   275                 my ($sourceFile, $sourceRevision) = findSourceFileAndRevision($path);

   276                 $diffFiles->{$path}->{sourceFile} = $sourceFile;

   277                 $diffFiles->{$path}->{sourceRevision} = $sourceRevision;

   278             }

   279         } else {

   280             print STDERR $line, "\n";

   281         }

   282     }

   283     close STAT;

   284 }

   285 

   286 sub isBinaryMimeType($)

   287 {

   288     my ($file) = @_;

   289     my $mimeType = findMimeType($file);

   290     return 0 if (!$mimeType || substr($mimeType, 0, 5) eq "text/");

   291     return 1;

   292 }

   293 

   294 sub manufacturePatchForAdditionWithHistory($)

   295 {

   296     my ($fileData) = @_;

   297     my $file = $fileData->{path};

   298     print "Index: ${file}\n";

   299     print "=" x 67, "\n";

   300     my $sourceFile = $fileData->{sourceFile};

   301     my $sourceRevision = $fileData->{sourceRevision};

   302     print "--- ${file}\t(revision ${sourceRevision})\t(from ${sourceFile}:${sourceRevision})\n";

   303     print "+++ ${file}\t(working copy)\n";

   304     if ($fileData->{isBinary}) {

   305         print "\nCannot display: file marked as a binary type.\n";

   306         my $mimeType = findMimeType($file, $sourceRevision);

   307         print "svn:mime-type = ${mimeType}\n\n";

   308     } else {

   309         print `svn cat ${sourceFile} | diff -u /dev/null - | tail -n +3`;

   310     }

   311 }

   312 

   313 # Sort numeric parts of strings as numbers, other parts as strings.

   314 # Makes 1.33 come after 1.3, which is cool.

   315 sub numericcmp($$)

   316 {

   317     my ($aa, $bb) = @_;

   318 

   319     my @a = split /(\d+)/, $aa;

   320     my @b = split /(\d+)/, $bb;

   321 

   322     # Compare one chunk at a time.

   323     # Each chunk is either all numeric digits, or all not numeric digits.

   324     while (@a && @b) {

   325         my $a = shift @a;

   326         my $b = shift @b;

   327         

   328         # Use numeric comparison if chunks are non-equal numbers.

   329         return $a <=> $b if $a =~ /^\d/ && $b =~ /^\d/ && $a != $b;

   330 

   331         # Use string comparison if chunks are any other kind of non-equal string.

   332         return $a cmp $b if $a ne $b;

   333     }

   334     

   335     # One of the two is now empty; compare lengths for result in this case.

   336     return @a <=> @b;

   337 }

   338 

   339 sub outputBinaryContent($)

   340 {

   341     my ($path) = @_;

   342     # Deletion

   343     return if (! -e $path);

   344     # Addition or Modification

   345     my $buffer;

   346     open BINARY, $path  or die;

   347     while (read(BINARY, $buffer, 60*57)) {

   348         print encode_base64($buffer);

   349     }

   350     close BINARY;

   351     print "\n";

   352 }

   353 

   354 # Sort first by directory, then by file, so all paths in one directory are grouped

   355 # rather than being interspersed with items from subdirectories.

   356 # Use numericcmp to sort directory and filenames to make order logical.

   357 sub pathcmp($$)

   358 {

   359     my ($fileDataA, $fileDataB) = @_;

   360 

   361     my ($dira, $namea) = splitpath($fileDataA->{path});

   362     my ($dirb, $nameb) = splitpath($fileDataB->{path});

   363 

   364     return numericcmp($dira, $dirb) if $dira ne $dirb;

   365     return numericcmp($namea, $nameb);

   366 }

   367 

   368 sub processPaths(\@)

   369 {

   370     my ($paths) = @_;

   371     return ("." => 1) if (!@{$paths});

   372 

   373     my %result = ();

   374 

   375     for my $file (@{$paths}) {

   376         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);

   377         die "can't handle empty string path\n" if $file eq "";

   378         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)

   379 

   380         my $untouchedFile = $file;

   381 

   382         $file = canonicalizePath($file);

   383 

   384         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;

   385 

   386         $result{$file} = 1;

   387     }

   388 

   389     return ("." => 1) if ($result{"."});

   390 

   391     # Remove any paths that also have a parent listed.

   392     for my $path (keys %result) {

   393         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {

   394             if ($result{$parent}) {

   395                 delete $result{$path};

   396                 last;

   397             }

   398         }

   399     }

   400 

   401     return %result;

   402 }

   403 

   404 # Break up a path into the directory (with slash) and base name.

   405 sub splitpath($)

   406 {

   407     my ($path) = @_;

   408 

   409     my $pathSeparator = "/";

   410     my $dirname = dirname($path) . $pathSeparator;

   411     $dirname = "" if $dirname eq "." . $pathSeparator;

   412 

   413     return ($dirname, basename($path));

   414 }

   415 

   416 # Sort so source code files appear before test files.

   417 sub testfilecmp($$)

   418 {

   419     my ($fileDataA, $fileDataB) = @_;

   420     return $fileDataA->{isTestFile} <=> $fileDataB->{isTestFile};

   421 }