#!/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.

# "patch" script for WebKit Open Source Project, used to apply patches.

# Differences from invoking "patch -p0":
#
#   Handles added files (does a svn add with logic to handle local changes).
#   Handles added directories (does a svn add).
#   Handles removed files (does a svn rm with logic to handle local changes).
#   Handles removed directories--those with no more files or directories left in them
#       (does a svn rm).
#   Has mode where it will roll back to svn version numbers in the patch file so svn
#       can do a 3-way merge.
#   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 set in
#       the patch to today's date using $changeLogTimeZone.
#   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).
#   When doing a removal, check that old file matches what's being removed.
#   Notice a patch that's being applied 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 Digest::MD5;
use File::Basename;
use File::Spec;
use Getopt::Long;
use MIME::Base64;
use POSIX qw(strftime);

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

sub addDirectoriesIfNeeded($);
sub applyPatch($$;$);
sub checksum($);
sub fixChangeLogPatch($);
sub gitdiff2svndiff($);
sub handleBinaryChange($$);
sub isDirectoryEmptyForRemoval($);
sub patch($);
sub removeDirectoriesIfNeeded();
sub setChangeLogDateAndReviewer($$);
sub svnStatus($);

# These should be replaced by an scm class/module:
sub scmKnowsOfFile($);
sub scmCopy($$);
sub scmAdd($);
sub scmRemove($);


# Project time zone for Cupertino, CA, US
my $changeLogTimeZone = "PST8PDT";

my $merge = 0;
my $showHelp = 0;
my $reviewer;
my $force = 0;

my $optionParseSuccess = GetOptions(
    "merge!" => \$merge,
    "help!" => \$showHelp,
    "reviewer=s" => \$reviewer,
    "force!" => \$force
);

if (!$optionParseSuccess || $showHelp) {
    print STDERR basename($0) . " [-h|--help] [--force] [-m|--merge] [-r|--reviewer name] patch1 [patch2 ...]\n";
    exit 1;
}

my $isGit = isGitDirectory(".");
my $isSVN = isSVNDirectory(".");
$isSVN || $isGit || die "Couldn't determine your version control system.";

my %removeDirectoryIgnoreList = (
    '.' => 1,
    '..' => 1,
    '.git' => 1,
    '.svn' => 1,
    '_svn' => 1,
);

my %checkedDirectories;
my %copiedFiles;
my @patches;
my %versions;

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 @patches, $patch;
            }
            $copiedFromPath = "";
            $patch = "";
        }
    }
    if ($indexPath) {
        # Fix paths on diff, ---, and +++ lines to match preceding Index: line.
        s/\S+$/$indexPath/ if /^diff/;
        s/^--- \S+/--- $indexPath/;
        if (/^--- .+\(from (\S+):(\d+)\)$/) {
            $copiedFromPath = $1;
            $copiedFiles{$indexPath} = $copiedFromPath;
            $versions{$copiedFromPath} = $2 if ($2 != 0);
        }
        elsif (/^--- .+\(revision (\d+)\)$/) {
            $versions{$indexPath} = $1 if ($1 != 0);
        }
        if (s/^\+\+\+ \S+/+++ $indexPath/) {
            $indexPath = "";
        }
    }
    $patch .= $_;
    $patch .= $eol;
}

if ($patch && !$copiedFromPath) {
    push @patches, $patch;
}

if ($merge) {
    die "--merge is currently only supported for SVN" unless $isSVN;
    # How do we handle Git patches applied to an SVN checkout here?
    for my $file (sort keys %versions) {
        print "Getting version $versions{$file} of $file\n";
        system "svn", "update", "-r", $versions{$file}, $file;
    }
}

# Handle copied and moved files first since moved files may have their source deleted before the move.
for my $file (keys %copiedFiles) {
    addDirectoriesIfNeeded(dirname($file));
    scmCopy($copiedFiles{$file}, $file);
}

for $patch (@patches) {
    patch($patch);
}

removeDirectoriesIfNeeded();

exit 0;

sub addDirectoriesIfNeeded($)
{
    my ($path) = @_;
    my @dirs = File::Spec->splitdir($path);
    my $dir = ".";
    while (scalar @dirs) {
        $dir = File::Spec->catdir($dir, shift @dirs);
        next if exists $checkedDirectories{$dir};
        if (! -e $dir) {
            mkdir $dir or die "Failed to create required directory '$dir' for path '$path'\n";
            scmAdd($dir);
            $checkedDirectories{$dir} = 1;
        }
        elsif (-d $dir) {
            # SVN prints "svn: warning: 'directory' is already under version control"
            # if you try and add a directory which is already in the repository.
            # Git will ignore the add, but re-adding large directories can be sloooow.
            # So we check first to see if the directory is under version control first.
            if (!scmKnowsOfFile($dir)) {
                scmAdd($dir);
            }
            $checkedDirectories{$dir} = 1;
        }
        else {
            die "'$dir' exists, but is not a directory";
        }
    }
}

sub applyPatch($$;$)
{
    my ($patch, $fullPath, $options) = @_;
    $options = [] if (! $options);
    my $command = "patch " . join(" ", "-p0", @{$options});
    open PATCH, "| $command" or die "Failed to patch $fullPath\n";
    print PATCH $patch;
    close PATCH;

    my $exitCode = $? >> 8;
    if ($exitCode != 0) {
        print "patch -p0 \"$fullPath\" returned $exitCode.  Pass --force to ignore patch failures.\n";
        exit($exitCode);
    }
}

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 handleBinaryChange($$)
{
    my ($fullPath, $contents) = @_;
    if ($contents =~ m#((\n[A-Za-z0-9+/]{76})+\n[A-Za-z0-9+/=]{4,76}\n)#) {
        # Addition or Modification
        open FILE, ">", $fullPath or die;
        print FILE decode_base64($1);
        close FILE;
        if (!scmKnowsOfFile($fullPath)) {
            # Addition
            scmAdd($fullPath);
        }
    } else {
        # Deletion
        scmRemove($fullPath);
    }
}

sub isDirectoryEmptyForRemoval($)
{
    my ($dir) = @_;
    my $directoryIsEmpty = 1;
    opendir DIR, $dir or die "Could not open '$dir' to list files: $?";
    for (my $item = readdir DIR; $item && $directoryIsEmpty; $item = readdir DIR) {
        next if exists $removeDirectoryIgnoreList{$item};
        if (! -d File::Spec->catdir($dir, $item)) {
            $directoryIsEmpty = 0;
        } else {
            next if (scmWillDeleteFile(File::Spec->catdir($dir, $item)));
            $directoryIsEmpty = 0;
        }
    }
    closedir DIR;
    return $directoryIsEmpty;
}

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;

    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";
            applyPatch(setChangeLogDateAndReviewer(fixChangeLogPatch($patch), $reviewer), $fullPath, ["--fuzz=3"]);
            unlink("${fullPath}.orig") if (! $changeLogDotOrigExisted);
        } else {
            applyPatch($patch, $fullPath);
        }
    } else {
        # Either a deletion, an addition or a binary change.

        addDirectoriesIfNeeded(dirname($fullPath));

        if ($isBinary) {
            # Binary change
            handleBinaryChange($fullPath, $patch);
        } elsif ($deletion) {
            # Deletion
            applyPatch($patch, $fullPath, ["--force"]);
            scmRemove($fullPath);
        } else {
            # Addition
            rename($fullPath, "$fullPath.orig") if -e $fullPath;
            applyPatch($patch, $fullPath);
            unlink("$fullPath.orig") if -e "$fullPath.orig" && checksum($fullPath) eq checksum("$fullPath.orig");
            scmAdd($fullPath);
            # What is this for?
            system "svn", "stat", "$fullPath.orig" if $isSVN && -e "$fullPath.orig";
        }
    }
}

sub removeDirectoriesIfNeeded()
{
    foreach my $dir (reverse sort keys %checkedDirectories) {
        if (isDirectoryEmptyForRemoval($dir)) {
            scmRemove($dir);
        }
    }
}

sub setChangeLogDateAndReviewer($$)
{
    my $patch = shift;
    my $reviewer = shift;
    my $savedTimeZone = $ENV{'TZ'};
    # Set TZ temporarily so that localtime() is in that time zone
    $ENV{'TZ'} = $changeLogTimeZone;
    my $newDate = strftime("%Y-%m-%d", localtime());
    if (defined $savedTimeZone) {
         $ENV{'TZ'} = $savedTimeZone;
    } else {
         delete $ENV{'TZ'};
    }
    $patch =~ s/(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )/$1$newDate$2/;
    if (defined($reviewer)) {
        $patch =~ s/NOBODY \(OOPS!\)/$reviewer/;
    }
    return $patch;
}

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

# This could be made into a more general "status" call, except svn and git
# have different ideas about "moving" files which might get confusing.
sub scmWillDeleteFile($)
{
    my ($path) = @_;
    if ($isSVN) {
        my $svnOutput = svnStatus($path);
        return 1 if $svnOutput && substr($svnOutput, 0, 1) eq "D";
    } elsif ($isGit) {
        my $gitOutput = `git diff-index --name-status head -- $path`;
        return 1 if $gitOutput && substr($gitOutput, 0, 1) eq "D";
    }
    return 0;
}

sub scmKnowsOfFile($)
{
    my ($path) = @_;
    if ($isSVN) {
        my $svnOutput = svnStatus($path);
        # This will match more than intended.  ? might not be the first field in the status
        if ($svnOutput && $svnOutput =~ m#\?\s+$path\n#) {
            return 0;
        }
        # This does not handle errors well.
        return 1;
    } elsif ($isGit) {
        `git ls-files --error-unmatch -- $path`;
        my $exitCode = $? >> 8;
        return $exitCode == 0;
    }
}

sub scmCopy($$)
{
    my ($source, $destination) = @_;
    if ($isSVN) {
        system "svn", "copy", $source, $destination;
    } elsif ($isGit) {
        system "cp", $source, $destination;
        system "git", "add", $destination;
    }
}

sub scmAdd($)
{
    my ($path) = @_;
    if ($isSVN) {
        system "svn", "add", $path;
    } elsif ($isGit) {
        system "git", "add", $path;
    }
}

sub scmRemove($)
{
    my ($path) = @_;
    if ($isSVN) {
        # SVN is very verbose when removing directories.  Squelch all output except the last line.
        my $svnOutput;
        open SVN, "svn rm --force '$path' |" or die "svn rm --force '$path' failed!";
        # Only print the last line.  Subversion outputs all changed statuses below $dir
        while (<SVN>) {
            $svnOutput = $_;
        }
        close SVN;
        print $svnOutput if $svnOutput;
    } elsif ($isGit) {
        system "git", "rm", "--force", $path;
    }
}