#!/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 Cwd;

use Digest::MD5;

use File::Basename;

use File::Spec;

use Getopt::Long;

use MIME::Base64;

use POSIX qw(strftime);

sub addDirectoriesIfNeeded($);

sub applyPatch($$;$);

sub checksum($);

sub fixChangeLogPatch($);

sub gitdiff2svndiff($);

sub handleBinaryChange($$);

sub isDirectoryEmptyForRemoval($);

sub patch($);

sub removeDirectoriesIfNeeded();

sub setChangeLogDate($);

sub svnStatus($);

# Project time zone for Cupertino, CA, US

my $changeLogTimeZone = "PST8PDT";

my $merge = 0;

my $showHelp = 0;

if (!GetOptions("merge!" => \$merge, "help!" => \$showHelp) || $showHelp) {

    print STDERR basename($0) . " [-h|--help] [-m|--merge] patch1 [patch2 ...]\n";

    exit 1;

}

my %removeDirectoryIgnoreList = (

    '.' => 1,

    '..' => 1,

    '.svn' => 1,

    '_svn' => 1,

);

my %checkedDirectories;

my %copiedFiles;

my @patches;

my %versions;

my $copiedFromPath;

my $filter;

my $indexPath;

my $patch;

while (<>) {

    s/\r//g;

    chomp;

    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 .= "\n";

}

if ($patch && !$copiedFromPath) {

    push @patches, $patch;

}

if ($merge) {

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

    system "svn", "copy", $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";

            system "svn", "add", $dir;

            $checkedDirectories{$dir} = 1;

        }

        elsif (-d $dir) {

            my $svnOutput = svnStatus($dir);

            if ($svnOutput && $svnOutput =~ m#\?\s+$dir\n#) {

                system "svn", "add", $dir;

            }

            $checkedDirectories{$dir} = 1;

        }

        else {

            die "'$dir' 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;

}

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;

        my $svnOutput = svnStatus($fullPath);

        if ($svnOutput && substr($svnOutput, 0, 1) eq "?") {

            # Addition

            system "svn", "add", $fullPath;

        } else {

            # Modification

            print $svnOutput if $svnOutput;

        }

    } else {

        # Deletion

        system "svn", "rm", $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 {

            my $svnOutput = svnStatus(File::Spec->catdir($dir, $item));

            next if $svnOutput && substr($svnOutput, 0, 1) eq "D";

            $directoryIsEmpty = 0;

        }

    }

    closedir DIR;

    return $directoryIsEmpty;

}

sub patch($)

{

    my ($patch) = @_;

    return if !$patch;

    $patch =~ m|^Index: ([^\n]+)| or die "Failed to find 'Index:' in \"$patch\"\n";

    my $fullPath = $1;

    my $deletion = 0;

    my $addition = 0;

    my $isBinary = 0;

    $addition = 1 if $patch =~ /\n--- .+\(revision 0\)\n/;

    $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(setChangeLogDate(fixChangeLogPatch($patch)), $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"]);

            system "svn", "rm", "--force", $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");

            system "svn", "add", $fullPath;

            system "svn", "stat", "$fullPath.orig" if -e "$fullPath.orig";

        }

    }

}

sub removeDirectoriesIfNeeded()

{

    foreach my $dir (reverse sort keys %checkedDirectories) {

        if (isDirectoryEmptyForRemoval($dir)) {

            my $svnOutput;

            open SVN, "svn rm '$dir' |" or die;

            # Only save the last line since Subversion lists all changed statuses below $dir

            while (<SVN>) {

                $svnOutput = $_;

            }

            close SVN;

            print $svnOutput if $svnOutput;

        }

    }

}

sub setChangeLogDate($)

{

    my $patch = 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/;

    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;

}