WebKitTools/Scripts/svn-unapply

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2005, 2006, 2007 Apple 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 # "unpatch" script for Web Kit Open Source Project, used to remove patches.
  30
  31 # Differences from invoking "patch -p0 -R":
  32 #
  33 #   Handles added files (does a svn revert with additional logic to handle local changes).
  34 #   Handles added directories (does a svn revert and a rmdir).
  35 #   Handles removed files (does a svn revert with additional logic to handle local changes).
  36 #   Handles removed directories (does a svn revert).
  37 #   Paths from Index: lines are used rather than the paths on the patch lines, which
  38 #       makes patches generated by "cvs diff" work (increasingly unimportant since we
  39 #       use Subversion now).
  40 #   ChangeLog patches use --fuzz=3 to prevent rejects, and the entry date is reset in
  41 #       the patch before it is applied (svn-apply sets it when applying a patch).
  42 #   Handles binary files (requires patches made by svn-create-patch).
  43 #   Handles copied and moved files (requires patches made by svn-create-patch).
  44 #   Handles git-diff patches (without binary changes) created at the top-level directory
  45 #
  46 # Missing features:
  47 #
  48 #   Handle property changes.
  49 #   Handle copied and moved directories (would require patches made by svn-create-patch).
  50 #   Use version numbers in the patch file and do a 3-way merge.
  51 #   When reversing an addition, check that the file matches what's being removed.
  52 #   Notice a patch that's being unapplied at the "wrong level" and make it work anyway.
  53 #   Do a dry run on the whole patch and don't do anything if part of the patch is
  54 #       going to fail (probably too strict unless we exclude ChangeLog).
  55 #   Handle git-diff patches with binary changes
  56
  57 use strict;
  58 use warnings;
  59
  60 use Cwd;
  61 use Digest::MD5;
  62 use Fcntl qw(:DEFAULT :seek);
  63 use File::Basename;
  64 use File::Spec;
  65 use File::Temp qw(tempfile);
  66 use Getopt::Long;
  67
  68 sub checksum($);
  69 sub fixChangeLogPatch($);
  70 sub gitdiff2svndiff($);
  71 sub patch($);
  72 sub revertDirectories();
  73 sub svnStatus($);
  74 sub unapplyPatch($$;$);
  75 sub unsetChangeLogDate($$);
  76
  77 my $showHelp = 0;
  78 if (!GetOptions("help!" => \$showHelp) || $showHelp) {
  79     print STDERR basename($0) . " [-h|--help] patch1 [patch2 ...]\n";
  80     exit 1;
  81 }
  82
  83 my @copiedFiles;
  84 my %directoriesToCheck;
  85
  86 my $copiedFromPath;
  87 my $filter;
  88 my $indexPath;
  89 my $patch;
  90 while (<>) {
  91     s/([\n\r]+)$//mg;
  92     my $eol = $1;
  93     if (!defined($indexPath) && m#^diff --git a/#) {
  94         $filter = \&gitdiff2svndiff;
  95     }
  96     $_ = &$filter($_) if $filter;
  97     if (/^Index: (.*)/) {
  98         $indexPath = $1;
  99         if ($patch) {
 100             if ($copiedFromPath) {
 101                 push @copiedFiles, $patch;
 102             } else {
 103                 patch($patch);
 104             }
 105             $copiedFromPath = "";
 106             $patch = "";
 107         }
 108     }
 109     if ($indexPath) {
 110         # Fix paths on diff, ---, and +++ lines to match preceding Index: line.
 111         s/^--- \S+/--- $indexPath/;
 112         if (/^--- .+\(from (\S+):\d+\)$/) {
 113             $copiedFromPath = $1;
 114         }
 115         if (s/^\+\+\+ \S+/+++ $indexPath/) {
 116             $indexPath = "";
 117         }
 118     }
 119     $patch .= $_;
 120     $patch .= $eol;
 121 }
 122
 123 if ($patch) {
 124     if ($copiedFromPath) {
 125         push @copiedFiles, $patch;
 126     } else {
 127         patch($patch);
 128     }
 129 }
 130
 131 # Handle copied and moved files last since they may have had post-copy changes that have now been unapplied
 132 for $patch (@copiedFiles) {
 133     patch($patch);
 134 }
 135
 136 revertDirectories();
 137
 138 exit 0;
 139
 140 sub checksum($)
 141 {
 142     my $file = shift;
 143     open(FILE, $file) or die "Can't open '$file': $!";
 144     binmode(FILE);
 145     my $checksum = Digest::MD5->new->addfile(*FILE)->hexdigest();
 146     close(FILE);
 147     return $checksum;
 148 }
 149
 150 sub fixChangeLogPatch($)
 151 {
 152     my $patch = shift;
 153     my $contextLineCount = 3;
 154
 155     return $patch if $patch !~ /\n@@ -1,(\d+) \+1,(\d+) @@\n( .*\n)+(\+.*\n)+( .*\n){$contextLineCount}$/m;
 156     my ($oldLineCount, $newLineCount) = ($1, $2);
 157     return $patch if $oldLineCount <= $contextLineCount;
 158
 159     # The diff(1) command is greedy when matching lines, so a new ChangeLog entry will
 160     # have lines of context at the top of a patch when the existing entry has the same
 161     # date and author as the new entry.  This nifty loop alters a ChangeLog patch so
 162     # that the added lines ("+") in the patch always start at the beginning of the
 163     # patch and there are no initial lines of context.
 164     my $newPatch;
 165     my $lineCountInState = 0;
 166     my $oldContentLineCountReduction = $oldLineCount - $contextLineCount;
 167     my $newContentLineCountWithoutContext = $newLineCount - $oldLineCount - $oldContentLineCountReduction;
 168     my ($stateHeader, $statePreContext, $stateNewChanges, $statePostContext) = (1..4);
 169     my $state = $stateHeader;
 170     foreach my $line (split(/\n/, $patch)) {
 171         $lineCountInState++;
 172         if ($state == $stateHeader && $line =~ /^@@ -1,$oldLineCount \+1,$newLineCount @\@$/) {
 173             $line = "@@ -1,$contextLineCount +1," . ($newLineCount - $oldContentLineCountReduction) . " @@";
 174             $lineCountInState = 0;
 175             $state = $statePreContext;
 176         } elsif ($state == $statePreContext && substr($line, 0, 1) eq " ") {
 177             $line = "+" . substr($line, 1);
 178             if ($lineCountInState == $oldContentLineCountReduction) {
 179                 $lineCountInState = 0;
 180                 $state = $stateNewChanges;
 181             }
 182         } elsif ($state == $stateNewChanges && substr($line, 0, 1) eq "+") {
 183             # No changes to these lines
 184             if ($lineCountInState == $newContentLineCountWithoutContext) {
 185                 $lineCountInState = 0;
 186                 $state = $statePostContext;
 187             }
 188         } elsif ($state == $statePostContext) {
 189             if (substr($line, 0, 1) eq "+" && $lineCountInState <= $oldContentLineCountReduction) {
 190                 $line = " " . substr($line, 1);
 191             } elsif ($lineCountInState > $contextLineCount && substr($line, 0, 1) eq " ") {
 192                 next; # Discard
 193             }
 194         }
 195         $newPatch .= $line . "\n";
 196     }
 197
 198     return $newPatch;
 199 }
 200
 201 sub gitdiff2svndiff($)
 202 {
 203     $_ = shift @_;
 204     if (m#^diff --git a/(.+) b/(.+)#) {
 205         return "Index: $1";
 206     } elsif (m/^new file.*/) {
 207         return "";
 208     } elsif (m#^index [0-9a-f]{7}\.\.[0-9a-f]{7} [0-9]{6}#) {
 209         return "===================================================================";
 210     } elsif (m#^--- a/(.+)#) {
 211         return "--- $1";
 212     } elsif (m#^\+\+\+ b/(.+)#) {
 213         return "+++ $1";
 214     }
 215     return $_;
 216 }
 217
 218 sub patch($)
 219 {
 220     my ($patch) = @_;
 221     return if !$patch;
 222
 223     unless ($patch =~ m|^Index: ([^\n]+)|) {
 224         my $separator = '-' x 67;
 225         warn "Failed to find 'Index:' in:\n$separator\n$patch\n$separator\n";
 226         return;
 227     }
 228     my $fullPath = $1;
 229     $directoriesToCheck{dirname($fullPath)} = 1;
 230
 231     my $deletion = 0;
 232     my $addition = 0;
 233     my $isBinary = 0;
 234
 235     $addition = 1 if ($patch =~ /\n--- .+\(revision 0\)\n/ || $patch =~ /\n@@ -0,0 .* @@/);
 236     $deletion = 1 if $patch =~ /\n@@ .* \+0,0 @@/;
 237     $isBinary = 1 if $patch =~ /\nCannot display: file marked as a binary type\./;
 238
 239     if (!$addition && !$deletion && !$isBinary) {
 240         # Standard patch, patch tool can handle this.
 241         if (basename($fullPath) eq "ChangeLog") {
 242             my $changeLogDotOrigExisted = -f "${fullPath}.orig";
 243             unapplyPatch(unsetChangeLogDate($fullPath, fixChangeLogPatch($patch)), $fullPath, ["--fuzz=3"]);
 244             unlink("${fullPath}.orig") if (! $changeLogDotOrigExisted);
 245         } else {
 246             unapplyPatch($patch, $fullPath);
 247         }
 248     } else {
 249         # Either a deletion, an addition or a binary change.
 250
 251         if ($isBinary) {
 252             # Reverse binary change
 253             unlink($fullPath) if (-e $fullPath);
 254             system "svn", "revert", $fullPath;
 255         } elsif ($deletion) {
 256             # Reverse deletion
 257             rename($fullPath, "$fullPath.orig") if -e $fullPath;
 258
 259             unapplyPatch($patch, $fullPath);
 260
 261             # If we don't ask for the filehandle here, we always get a warning.
 262             my ($fh, $tempPath) = tempfile(basename($fullPath) . "-XXXXXXXX",
 263                                            DIR => dirname($fullPath), UNLINK => 1);
 264             close($fh);
 265
 266             # Keep the version from the patch in case it's different from svn.
 267             rename($fullPath, $tempPath);
 268             system "svn", "revert", $fullPath;
 269             rename($tempPath, $fullPath);
 270
 271             # This works around a bug in the svn client.
 272             # [Issue 1960] file modifications get lost due to FAT 2s time resolution
 273             # http://subversion.tigris.org/issues/show_bug.cgi?id=1960
 274             system "touch", $fullPath;
 275
 276             # Remove $fullPath.orig if it is the same as $fullPath
 277             unlink("$fullPath.orig") if -e "$fullPath.orig" && checksum($fullPath) eq checksum("$fullPath.orig");
 278
 279             # Show status if the file is modifed
 280             system "svn", "stat", $fullPath;
 281         } else {
 282             # Reverse addition
 283             unapplyPatch($patch, $fullPath, ["--force"]);
 284             unlink($fullPath) if -z $fullPath;
 285             system "svn", "revert", $fullPath;
 286         }
 287     }
 288 }
 289
 290 sub revertDirectories()
 291 {
 292     my %checkedDirectories;
 293     foreach my $path (reverse sort keys %directoriesToCheck) {
 294         my @dirs = File::Spec->splitdir($path);
 295         while (scalar @dirs) {
 296             my $dir = File::Spec->catdir(@dirs);
 297             pop(@dirs);
 298             next if (exists $checkedDirectories{$dir});
 299             if (-d $dir) {
 300                 my $svnOutput = svnStatus($dir);
 301                 if ($svnOutput && $svnOutput =~ m#A\s+$dir\n#) {
 302                    system "svn", "revert", $dir;
 303                    rmdir $dir;
 304                 }
 305                 elsif ($svnOutput && $svnOutput =~ m#D\s+$dir\n#) {
 306                    system "svn", "revert", $dir;
 307                 }
 308                 else {
 309                     # Modification
 310                     print $svnOutput if $svnOutput;
 311                 }
 312                 $checkedDirectories{$dir} = 1;
 313             }
 314             else {
 315                 die "'$dir' is not a directory";
 316             }
 317         }
 318     }
 319 }
 320
 321 sub svnStatus($)
 322 {
 323     my ($fullPath) = @_;
 324     my $svnStatus;
 325     open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die;
 326     if (-d $fullPath) {
 327         # When running "svn stat" on a directory, we can't assume that only one
 328         # status will be returned (since any files with a status below the
 329         # directory will be returned), and we can't assume that the directory will
 330         # be first (since any files with unknown status will be listed first).
 331         my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
 332         while (<SVN>) {
 333             chomp;
 334             my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
 335             if ($normalizedFullPath eq $normalizedStatPath) {
 336                 $svnStatus = $_;
 337                 last;
 338             }
 339         }
 340         # Read the rest of the svn command output to avoid a broken pipe warning.
 341         local $/ = undef;
 342         <SVN>;
 343     }
 344     else {
 345         # Files will have only one status returned.
 346         $svnStatus = <SVN>;
 347     }
 348     close SVN;
 349     return $svnStatus;
 350 }
 351
 352 sub unapplyPatch($$;$)
 353 {
 354     my ($patch, $fullPath, $options) = @_;
 355     $options = [] if (! $options);
 356     my $command = "patch " . join(" ", "-p0", "-R", @{$options});
 357     open PATCH, "| $command" or die "Failed to patch $fullPath: $!";
 358     print PATCH $patch;
 359     close PATCH;
 360 }
 361
 362 sub unsetChangeLogDate($$)
 363 {
 364     my $fullPath = shift;
 365     my $patch = shift;
 366     my $newDate;
 367     sysopen(CHANGELOG, $fullPath, O_RDONLY) or die "Failed to open $fullPath: $!";
 368     sysseek(CHANGELOG, 0, SEEK_SET);
 369     my $byteCount = sysread(CHANGELOG, $newDate, 10);
 370     die "Failed reading $fullPath: $!" if !$byteCount || $byteCount != 10;
 371     close(CHANGELOG);
 372     $patch =~ s/(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )/$1$newDate$2/;
 373     return $patch;
 374 }