| #!/usr/bin/perl -w |
| |
| # Copyright (C) 2005, 2006, 2007 Apple Inc. All rights reserved. |
| # |
| # Redistribution and use in source and binary forms, with or without |
| # modification, are permitted provided that the following conditions |
| # are met: |
| # |
| # 1. Redistributions of source code must retain the above copyright |
| # notice, this list of conditions and the following disclaimer. |
| # 2. Redistributions in binary form must reproduce the above copyright |
| # notice, this list of conditions and the following disclaimer in the |
| # documentation and/or other materials provided with the distribution. |
| # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of |
| # its contributors may be used to endorse or promote products derived |
| # from this software without specific prior written permission. |
| # |
| # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY |
| # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
| # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
| # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY |
| # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES |
| # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; |
| # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
| # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
| # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF |
| # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| |
| # "unpatch" script for Web Kit Open Source Project, used to remove patches. |
| |
| # Differences from invoking "patch -p0 -R": |
| # |
| # Handles added files (does a svn revert with additional logic to handle local changes). |
| # Handles added directories (does a svn revert and a rmdir). |
| # Handles removed files (does a svn revert with additional logic to handle local changes). |
| # Handles removed directories (does a svn revert). |
| # Paths from Index: lines are used rather than the paths on the patch lines, which |
| # makes patches generated by "cvs diff" work (increasingly unimportant since we |
| # use Subversion now). |
| # ChangeLog patches use --fuzz=3 to prevent rejects, and the entry date is reset in |
| # the patch before it is applied (svn-apply sets it when applying a patch). |
| # Handles binary files (requires patches made by svn-create-patch). |
| # Handles copied and moved files (requires patches made by svn-create-patch). |
| # Handles git-diff patches (without binary changes) created at the top-level directory |
| # |
| # Missing features: |
| # |
| # Handle property changes. |
| # Handle copied and moved directories (would require patches made by svn-create-patch). |
| # Use version numbers in the patch file and do a 3-way merge. |
| # When reversing an addition, check that the file matches what's being removed. |
| # Notice a patch that's being unapplied at the "wrong level" and make it work anyway. |
| # Do a dry run on the whole patch and don't do anything if part of the patch is |
| # going to fail (probably too strict unless we exclude ChangeLog). |
| # Handle git-diff patches with binary changes |
| |
| use strict; |
| use warnings; |
| |
| use Cwd; |
| use Digest::MD5; |
| use Fcntl qw(:DEFAULT :seek); |
| use File::Basename; |
| use File::Spec; |
| use File::Temp qw(tempfile); |
| use Getopt::Long; |
| |
| sub checksum($); |
| sub fixChangeLogPatch($); |
| sub gitdiff2svndiff($); |
| sub patch($); |
| sub revertDirectories(); |
| sub svnStatus($); |
| sub unapplyPatch($$;$); |
| sub unsetChangeLogDate($$); |
| |
| my $showHelp = 0; |
| if (!GetOptions("help!" => \$showHelp) || $showHelp) { |
| print STDERR basename($0) . " [-h|--help] patch1 [patch2 ...]\n"; |
| exit 1; |
| } |
| |
| my @copiedFiles; |
| my %directoriesToCheck; |
| |
| my $copiedFromPath; |
| my $filter; |
| my $indexPath; |
| my $patch; |
| while (<>) { |
| s/([\n\r]+)$//mg; |
| my $eol = $1; |
| if (!defined($indexPath) && m#^diff --git a/#) { |
| $filter = \&gitdiff2svndiff; |
| } |
| $_ = &$filter($_) if $filter; |
| if (/^Index: (.*)/) { |
| $indexPath = $1; |
| if ($patch) { |
| if ($copiedFromPath) { |
| push @copiedFiles, $patch; |
| } else { |
| patch($patch); |
| } |
| $copiedFromPath = ""; |
| $patch = ""; |
| } |
| } |
| if ($indexPath) { |
| # Fix paths on diff, ---, and +++ lines to match preceding Index: line. |
| s/^--- \S+/--- $indexPath/; |
| if (/^--- .+\(from (\S+):\d+\)$/) { |
| $copiedFromPath = $1; |
| } |
| if (s/^\+\+\+ \S+/+++ $indexPath/) { |
| $indexPath = ""; |
| } |
| } |
| $patch .= $_; |
| $patch .= $eol; |
| } |
| |
| if ($patch) { |
| if ($copiedFromPath) { |
| push @copiedFiles, $patch; |
| } else { |
| patch($patch); |
| } |
| } |
| |
| # Handle copied and moved files last since they may have had post-copy changes that have now been unapplied |
| for $patch (@copiedFiles) { |
| patch($patch); |
| } |
| |
| revertDirectories(); |
| |
| exit 0; |
| |
| sub checksum($) |
| { |
| my $file = shift; |
| open(FILE, $file) or die "Can't open '$file': $!"; |
| binmode(FILE); |
| my $checksum = Digest::MD5->new->addfile(*FILE)->hexdigest(); |
| close(FILE); |
| return $checksum; |
| } |
| |
| sub fixChangeLogPatch($) |
| { |
| my $patch = shift; |
| my $contextLineCount = 3; |
| |
| return $patch if $patch !~ /\n@@ -1,(\d+) \+1,(\d+) @@\n( .*\n)+(\+.*\n)+( .*\n){$contextLineCount}$/m; |
| my ($oldLineCount, $newLineCount) = ($1, $2); |
| return $patch if $oldLineCount <= $contextLineCount; |
| |
| # The diff(1) command is greedy when matching lines, so a new ChangeLog entry will |
| # have lines of context at the top of a patch when the existing entry has the same |
| # date and author as the new entry. This nifty loop alters a ChangeLog patch so |
| # that the added lines ("+") in the patch always start at the beginning of the |
| # patch and there are no initial lines of context. |
| my $newPatch; |
| my $lineCountInState = 0; |
| my $oldContentLineCountReduction = $oldLineCount - $contextLineCount; |
| my $newContentLineCountWithoutContext = $newLineCount - $oldLineCount - $oldContentLineCountReduction; |
| my ($stateHeader, $statePreContext, $stateNewChanges, $statePostContext) = (1..4); |
| my $state = $stateHeader; |
| foreach my $line (split(/\n/, $patch)) { |
| $lineCountInState++; |
| if ($state == $stateHeader && $line =~ /^@@ -1,$oldLineCount \+1,$newLineCount @\@$/) { |
| $line = "@@ -1,$contextLineCount +1," . ($newLineCount - $oldContentLineCountReduction) . " @@"; |
| $lineCountInState = 0; |
| $state = $statePreContext; |
| } elsif ($state == $statePreContext && substr($line, 0, 1) eq " ") { |
| $line = "+" . substr($line, 1); |
| if ($lineCountInState == $oldContentLineCountReduction) { |
| $lineCountInState = 0; |
| $state = $stateNewChanges; |
| } |
| } elsif ($state == $stateNewChanges && substr($line, 0, 1) eq "+") { |
| # No changes to these lines |
| if ($lineCountInState == $newContentLineCountWithoutContext) { |
| $lineCountInState = 0; |
| $state = $statePostContext; |
| } |
| } elsif ($state == $statePostContext) { |
| if (substr($line, 0, 1) eq "+" && $lineCountInState <= $oldContentLineCountReduction) { |
| $line = " " . substr($line, 1); |
| } elsif ($lineCountInState > $contextLineCount && substr($line, 0, 1) eq " ") { |
| next; # Discard |
| } |
| } |
| $newPatch .= $line . "\n"; |
| } |
| |
| return $newPatch; |
| } |
| |
| sub gitdiff2svndiff($) |
| { |
| $_ = shift @_; |
| if (m#^diff --git a/(.+) b/(.+)#) { |
| return "Index: $1"; |
| } elsif (m/^new file.*/) { |
| return ""; |
| } elsif (m#^index [0-9a-f]{7}\.\.[0-9a-f]{7} [0-9]{6}#) { |
| return "==================================================================="; |
| } elsif (m#^--- a/(.+)#) { |
| return "--- $1"; |
| } elsif (m#^\+\+\+ b/(.+)#) { |
| return "+++ $1"; |
| } |
| return $_; |
| } |
| |
| sub patch($) |
| { |
| my ($patch) = @_; |
| return if !$patch; |
| |
| unless ($patch =~ m|^Index: ([^\n]+)|) { |
| my $separator = '-' x 67; |
| warn "Failed to find 'Index:' in:\n$separator\n$patch\n$separator\n"; |
| return; |
| } |
| my $fullPath = $1; |
| $directoriesToCheck{dirname($fullPath)} = 1; |
| |
| my $deletion = 0; |
| my $addition = 0; |
| my $isBinary = 0; |
| |
| $addition = 1 if ($patch =~ /\n--- .+\(revision 0\)\n/ || $patch =~ /\n@@ -0,0 .* @@/); |
| $deletion = 1 if $patch =~ /\n@@ .* \+0,0 @@/; |
| $isBinary = 1 if $patch =~ /\nCannot display: file marked as a binary type\./; |
| |
| if (!$addition && !$deletion && !$isBinary) { |
| # Standard patch, patch tool can handle this. |
| if (basename($fullPath) eq "ChangeLog") { |
| my $changeLogDotOrigExisted = -f "${fullPath}.orig"; |
| unapplyPatch(unsetChangeLogDate($fullPath, fixChangeLogPatch($patch)), $fullPath, ["--fuzz=3"]); |
| unlink("${fullPath}.orig") if (! $changeLogDotOrigExisted); |
| } else { |
| unapplyPatch($patch, $fullPath); |
| } |
| } else { |
| # Either a deletion, an addition or a binary change. |
| |
| if ($isBinary) { |
| # Reverse binary change |
| unlink($fullPath) if (-e $fullPath); |
| system "svn", "revert", $fullPath; |
| } elsif ($deletion) { |
| # Reverse deletion |
| rename($fullPath, "$fullPath.orig") if -e $fullPath; |
| |
| unapplyPatch($patch, $fullPath); |
| |
| # If we don't ask for the filehandle here, we always get a warning. |
| my ($fh, $tempPath) = tempfile(basename($fullPath) . "-XXXXXXXX", |
| DIR => dirname($fullPath), UNLINK => 1); |
| close($fh); |
| |
| # Keep the version from the patch in case it's different from svn. |
| rename($fullPath, $tempPath); |
| system "svn", "revert", $fullPath; |
| rename($tempPath, $fullPath); |
| |
| # This works around a bug in the svn client. |
| # [Issue 1960] file modifications get lost due to FAT 2s time resolution |
| # http://subversion.tigris.org/issues/show_bug.cgi?id=1960 |
| system "touch", $fullPath; |
| |
| # Remove $fullPath.orig if it is the same as $fullPath |
| unlink("$fullPath.orig") if -e "$fullPath.orig" && checksum($fullPath) eq checksum("$fullPath.orig"); |
| |
| # Show status if the file is modifed |
| system "svn", "stat", $fullPath; |
| } else { |
| # Reverse addition |
| unapplyPatch($patch, $fullPath, ["--force"]); |
| unlink($fullPath) if -z $fullPath; |
| system "svn", "revert", $fullPath; |
| } |
| } |
| } |
| |
| sub revertDirectories() |
| { |
| my %checkedDirectories; |
| foreach my $path (reverse sort keys %directoriesToCheck) { |
| my @dirs = File::Spec->splitdir($path); |
| while (scalar @dirs) { |
| my $dir = File::Spec->catdir(@dirs); |
| pop(@dirs); |
| next if (exists $checkedDirectories{$dir}); |
| if (-d $dir) { |
| my $svnOutput = svnStatus($dir); |
| if ($svnOutput && $svnOutput =~ m#A\s+$dir\n#) { |
| system "svn", "revert", $dir; |
| rmdir $dir; |
| } |
| elsif ($svnOutput && $svnOutput =~ m#D\s+$dir\n#) { |
| system "svn", "revert", $dir; |
| } |
| else { |
| # Modification |
| print $svnOutput if $svnOutput; |
| } |
| $checkedDirectories{$dir} = 1; |
| } |
| else { |
| die "'$dir' is not a directory"; |
| } |
| } |
| } |
| } |
| |
| sub svnStatus($) |
| { |
| my ($fullPath) = @_; |
| my $svnStatus; |
| open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die; |
| if (-d $fullPath) { |
| # When running "svn stat" on a directory, we can't assume that only one |
| # status will be returned (since any files with a status below the |
| # directory will be returned), and we can't assume that the directory will |
| # be first (since any files with unknown status will be listed first). |
| my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath)); |
| while (<SVN>) { |
| chomp; |
| my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7))); |
| if ($normalizedFullPath eq $normalizedStatPath) { |
| $svnStatus = $_; |
| last; |
| } |
| } |
| # Read the rest of the svn command output to avoid a broken pipe warning. |
| local $/ = undef; |
| <SVN>; |
| } |
| else { |
| # Files will have only one status returned. |
| $svnStatus = <SVN>; |
| } |
| close SVN; |
| return $svnStatus; |
| } |
| |
| sub unapplyPatch($$;$) |
| { |
| my ($patch, $fullPath, $options) = @_; |
| $options = [] if (! $options); |
| my $command = "patch " . join(" ", "-p0", "-R", @{$options}); |
| open PATCH, "| $command" or die "Failed to patch $fullPath: $!"; |
| print PATCH $patch; |
| close PATCH; |
| } |
| |
| sub unsetChangeLogDate($$) |
| { |
| my $fullPath = shift; |
| my $patch = shift; |
| my $newDate; |
| sysopen(CHANGELOG, $fullPath, O_RDONLY) or die "Failed to open $fullPath: $!"; |
| sysseek(CHANGELOG, 0, SEEK_SET); |
| my $byteCount = sysread(CHANGELOG, $newDate, 10); |
| die "Failed reading $fullPath: $!" if !$byteCount || $byteCount != 10; |
| close(CHANGELOG); |
| $patch =~ s/(\n\+)\d{4}-[^-]{2}-[^-]{2}( )/$1$newDate$2/; |
| return $patch; |
| } |