#!/usr/bin/perl -w

# Copyright (C) 2005, 2006, 2007 Apple Inc.  All rights reserved.
# Copyright (C) 2009 Cameron McCormack <cam@mcc.id.au>
#
# 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 WebKit 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;

use FindBin;
use lib $FindBin::Bin;
use VCSUtils;

sub checksum($);
sub patch($);
sub revertDirectories();
sub removeEOL($);
sub unapplyPatch($$;$);
sub unsetChangeLogDate($$);

my $showHelp = 0;
if (!GetOptions("help!" => \$showHelp) || $showHelp) {
    print STDERR basename($0) . " [-h|--help] patch1 [patch2 ...]\n";
    exit 1;
}

my $pathScriptWasRunFrom = Cwd::getcwd();
my $pathForRepositoryRoot = determineVCSRoot();

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);
}

if (isSVN()) {
    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 patch($)
{
    my ($patch) = @_;
    return if !$patch;

    unless ($patch =~ m|^Index: ([^\r\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()
{
    chdir $pathForRepositoryRoot;
    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 removeEOL($)
{
    my ($line) = @_;

    $line =~ s/[\r\n]+$//g;
    return $line;
}

sub unapplyPatch($$;$)
{
    my ($patch, $fullPath, $options) = @_;
    chdir $pathForRepositoryRoot;
    $options = [] if (! $options);
    my $command = "patch " . join(" ", "-p0", "-R", @{$options});
    open PATCH, "| $command" or die "Failed to patch $fullPath: $!";
    print PATCH $patch;
    close PATCH;
    chdir $pathScriptWasRunFrom;
}

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