VCSUtils.pm revision cad810f21b803229eb11403f9209855525a25d57
1# Copyright (C) 2007, 2008, 2009 Apple Inc.  All rights reserved.
2# Copyright (C) 2009, 2010 Chris Jerdonek (chris.jerdonek@gmail.com)
3# Copyright (C) Research In Motion Limited 2010. 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# Module to share code to work with various version control systems.
30package VCSUtils;
31
32use strict;
33use warnings;
34
35use Cwd qw();  # "qw()" prevents warnings about redefining getcwd() with "use POSIX;"
36use English; # for $POSTMATCH, etc.
37use File::Basename;
38use File::Spec;
39use POSIX;
40
41BEGIN {
42    use Exporter   ();
43    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
44    $VERSION     = 1.00;
45    @ISA         = qw(Exporter);
46    @EXPORT      = qw(
47        &applyGitBinaryPatchDelta
48        &callSilently
49        &canonicalizePath
50        &changeLogEmailAddress
51        &changeLogName
52        &chdirReturningRelativePath
53        &decodeGitBinaryChunk
54        &decodeGitBinaryPatch
55        &determineSVNRoot
56        &determineVCSRoot
57        &exitStatus
58        &fixChangeLogPatch
59        &gitBranch
60        &gitdiff2svndiff
61        &isGit
62        &isGitBranchBuild
63        &isGitDirectory
64        &isSVN
65        &isSVNDirectory
66        &isSVNVersion16OrNewer
67        &makeFilePathRelative
68        &mergeChangeLogs
69        &normalizePath
70        &parsePatch
71        &pathRelativeToSVNRepositoryRootForPath
72        &prepareParsedPatch
73        &removeEOL
74        &runPatchCommand
75        &scmMoveOrRenameFile
76        &scmToggleExecutableBit
77        &setChangeLogDateAndReviewer
78        &svnRevisionForDirectory
79        &svnStatus
80        &toWindowsLineEndings
81    );
82    %EXPORT_TAGS = ( );
83    @EXPORT_OK   = ();
84}
85
86our @EXPORT_OK;
87
88my $gitBranch;
89my $gitRoot;
90my $isGit;
91my $isGitBranchBuild;
92my $isSVN;
93my $svnVersion;
94
95# Project time zone for Cupertino, CA, US
96my $changeLogTimeZone = "PST8PDT";
97
98my $gitDiffStartRegEx = qr#^diff --git (\w/)?(.+) (\w/)?([^\r\n]+)#;
99my $svnDiffStartRegEx = qr#^Index: ([^\r\n]+)#;
100my $svnPropertiesStartRegEx = qr#^Property changes on: ([^\r\n]+)#; # $1 is normally the same as the index path.
101my $svnPropertyStartRegEx = qr#^(Modified|Name|Added|Deleted): ([^\r\n]+)#; # $2 is the name of the property.
102my $svnPropertyValueStartRegEx = qr#^   (\+|-|Merged|Reverse-merged) ([^\r\n]+)#; # $2 is the start of the property's value (which may span multiple lines).
103
104# This method is for portability. Return the system-appropriate exit
105# status of a child process.
106#
107# Args: pass the child error status returned by the last pipe close,
108#       for example "$?".
109sub exitStatus($)
110{
111    my ($returnvalue) = @_;
112    if ($^O eq "MSWin32") {
113        return $returnvalue >> 8;
114    }
115    return WEXITSTATUS($returnvalue);
116}
117
118# Call a function while suppressing STDERR, and return the return values
119# as an array.
120sub callSilently($@) {
121    my ($func, @args) = @_;
122
123    # The following pattern was taken from here:
124    #   http://www.sdsc.edu/~moreland/courses/IntroPerl/docs/manual/pod/perlfunc/open.html
125    #
126    # Also see this Perl documentation (search for "open OLDERR"):
127    #   http://perldoc.perl.org/functions/open.html
128    open(OLDERR, ">&STDERR");
129    close(STDERR);
130    my @returnValue = &$func(@args);
131    open(STDERR, ">&OLDERR");
132    close(OLDERR);
133
134    return @returnValue;
135}
136
137sub toWindowsLineEndings
138{
139    my ($text) = @_;
140    $text =~ s/\n/\r\n/g;
141    return $text;
142}
143
144# Note, this method will not error if the file corresponding to the $source path does not exist.
145sub scmMoveOrRenameFile
146{
147    my ($source, $destination) = @_;
148    return if ! -e $source;
149    if (isSVN()) {
150        system("svn", "move", $source, $destination);
151    } elsif (isGit()) {
152        system("git", "mv", $source, $destination);
153    }
154}
155
156# Note, this method will not error if the file corresponding to the path does not exist.
157sub scmToggleExecutableBit
158{
159    my ($path, $executableBitDelta) = @_;
160    return if ! -e $path;
161    if ($executableBitDelta == 1) {
162        scmAddExecutableBit($path);
163    } elsif ($executableBitDelta == -1) {
164        scmRemoveExecutableBit($path);
165    }
166}
167
168sub scmAddExecutableBit($)
169{
170    my ($path) = @_;
171
172    if (isSVN()) {
173        system("svn", "propset", "svn:executable", "on", $path) == 0 or die "Failed to run 'svn propset svn:executable on $path'.";
174    } elsif (isGit()) {
175        chmod(0755, $path);
176    }
177}
178
179sub scmRemoveExecutableBit($)
180{
181    my ($path) = @_;
182
183    if (isSVN()) {
184        system("svn", "propdel", "svn:executable", $path) == 0 or die "Failed to run 'svn propdel svn:executable $path'.";
185    } elsif (isGit()) {
186        chmod(0664, $path);
187    }
188}
189
190sub isGitDirectory($)
191{
192    my ($dir) = @_;
193    return system("cd $dir && git rev-parse > " . File::Spec->devnull() . " 2>&1") == 0;
194}
195
196sub isGit()
197{
198    return $isGit if defined $isGit;
199
200    $isGit = isGitDirectory(".");
201    return $isGit;
202}
203
204sub gitBranch()
205{
206    unless (defined $gitBranch) {
207        chomp($gitBranch = `git symbolic-ref -q HEAD`);
208        $gitBranch = "" if exitStatus($?);
209        $gitBranch =~ s#^refs/heads/##;
210        $gitBranch = "" if $gitBranch eq "master";
211    }
212
213    return $gitBranch;
214}
215
216sub isGitBranchBuild()
217{
218    my $branch = gitBranch();
219    chomp(my $override = `git config --bool branch.$branch.webKitBranchBuild`);
220    return 1 if $override eq "true";
221    return 0 if $override eq "false";
222
223    unless (defined $isGitBranchBuild) {
224        chomp(my $gitBranchBuild = `git config --bool core.webKitBranchBuild`);
225        $isGitBranchBuild = $gitBranchBuild eq "true";
226    }
227
228    return $isGitBranchBuild;
229}
230
231sub isSVNDirectory($)
232{
233    my ($dir) = @_;
234
235    return -d File::Spec->catdir($dir, ".svn");
236}
237
238sub isSVN()
239{
240    return $isSVN if defined $isSVN;
241
242    $isSVN = isSVNDirectory(".");
243    return $isSVN;
244}
245
246sub svnVersion()
247{
248    return $svnVersion if defined $svnVersion;
249
250    if (!isSVN()) {
251        $svnVersion = 0;
252    } else {
253        chomp($svnVersion = `svn --version --quiet`);
254    }
255    return $svnVersion;
256}
257
258sub isSVNVersion16OrNewer()
259{
260    my $version = svnVersion();
261    return eval "v$version" ge v1.6;
262}
263
264sub chdirReturningRelativePath($)
265{
266    my ($directory) = @_;
267    my $previousDirectory = Cwd::getcwd();
268    chdir $directory;
269    my $newDirectory = Cwd::getcwd();
270    return "." if $newDirectory eq $previousDirectory;
271    return File::Spec->abs2rel($previousDirectory, $newDirectory);
272}
273
274sub determineGitRoot()
275{
276    chomp(my $gitDir = `git rev-parse --git-dir`);
277    return dirname($gitDir);
278}
279
280sub determineSVNRoot()
281{
282    my $last = '';
283    my $path = '.';
284    my $parent = '..';
285    my $repositoryRoot;
286    my $repositoryUUID;
287    while (1) {
288        my $thisRoot;
289        my $thisUUID;
290        # Ignore error messages in case we've run past the root of the checkout.
291        open INFO, "svn info '$path' 2> " . File::Spec->devnull() . " |" or die;
292        while (<INFO>) {
293            if (/^Repository Root: (.+)/) {
294                $thisRoot = $1;
295            }
296            if (/^Repository UUID: (.+)/) {
297                $thisUUID = $1;
298            }
299            if ($thisRoot && $thisUUID) {
300                local $/ = undef;
301                <INFO>; # Consume the rest of the input.
302            }
303        }
304        close INFO;
305
306        # It's possible (e.g. for developers of some ports) to have a WebKit
307        # checkout in a subdirectory of another checkout.  So abort if the
308        # repository root or the repository UUID suddenly changes.
309        last if !$thisUUID;
310        $repositoryUUID = $thisUUID if !$repositoryUUID;
311        last if $thisUUID ne $repositoryUUID;
312
313        last if !$thisRoot;
314        $repositoryRoot = $thisRoot if !$repositoryRoot;
315        last if $thisRoot ne $repositoryRoot;
316
317        $last = $path;
318        $path = File::Spec->catdir($parent, $path);
319    }
320
321    return File::Spec->rel2abs($last);
322}
323
324sub determineVCSRoot()
325{
326    if (isGit()) {
327        return determineGitRoot();
328    }
329
330    if (!isSVN()) {
331        # Some users have a workflow where svn-create-patch, svn-apply and
332        # svn-unapply are used outside of multiple svn working directores,
333        # so warn the user and assume Subversion is being used in this case.
334        warn "Unable to determine VCS root; assuming Subversion";
335        $isSVN = 1;
336    }
337
338    return determineSVNRoot();
339}
340
341sub svnRevisionForDirectory($)
342{
343    my ($dir) = @_;
344    my $revision;
345
346    if (isSVNDirectory($dir)) {
347        my $svnInfo = `LC_ALL=C svn info $dir | grep Revision:`;
348        ($revision) = ($svnInfo =~ m/Revision: (\d+).*/g);
349    } elsif (isGitDirectory($dir)) {
350        my $gitLog = `cd $dir && LC_ALL=C git log --grep='git-svn-id: ' -n 1 | grep git-svn-id:`;
351        ($revision) = ($gitLog =~ m/ +git-svn-id: .+@(\d+) /g);
352    }
353    die "Unable to determine current SVN revision in $dir" unless (defined $revision);
354    return $revision;
355}
356
357sub pathRelativeToSVNRepositoryRootForPath($)
358{
359    my ($file) = @_;
360    my $relativePath = File::Spec->abs2rel($file);
361
362    my $svnInfo;
363    if (isSVN()) {
364        $svnInfo = `LC_ALL=C svn info $relativePath`;
365    } elsif (isGit()) {
366        $svnInfo = `LC_ALL=C git svn info $relativePath`;
367    }
368
369    $svnInfo =~ /.*^URL: (.*?)$/m;
370    my $svnURL = $1;
371
372    $svnInfo =~ /.*^Repository Root: (.*?)$/m;
373    my $repositoryRoot = $1;
374
375    $svnURL =~ s/$repositoryRoot\///;
376    return $svnURL;
377}
378
379sub makeFilePathRelative($)
380{
381    my ($path) = @_;
382    return $path unless isGit();
383
384    unless (defined $gitRoot) {
385        chomp($gitRoot = `git rev-parse --show-cdup`);
386    }
387    return $gitRoot . $path;
388}
389
390sub normalizePath($)
391{
392    my ($path) = @_;
393    $path =~ s/\\/\//g;
394    return $path;
395}
396
397sub adjustPathForRecentRenamings($)
398{
399    my ($fullPath) = @_;
400
401    if ($fullPath =~ m|^WebCore/| || $fullPath =~ m|^JavaScriptCore/|) {
402        return "Source/$fullPath";
403    }
404    return $fullPath;
405}
406
407sub canonicalizePath($)
408{
409    my ($file) = @_;
410
411    # Remove extra slashes and '.' directories in path
412    $file = File::Spec->canonpath($file);
413
414    # Remove '..' directories in path
415    my @dirs = ();
416    foreach my $dir (File::Spec->splitdir($file)) {
417        if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
418            pop(@dirs);
419        } else {
420            push(@dirs, $dir);
421        }
422    }
423    return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
424}
425
426sub removeEOL($)
427{
428    my ($line) = @_;
429    return "" unless $line;
430
431    $line =~ s/[\r\n]+$//g;
432    return $line;
433}
434
435sub svnStatus($)
436{
437    my ($fullPath) = @_;
438    my $svnStatus;
439    open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die;
440    if (-d $fullPath) {
441        # When running "svn stat" on a directory, we can't assume that only one
442        # status will be returned (since any files with a status below the
443        # directory will be returned), and we can't assume that the directory will
444        # be first (since any files with unknown status will be listed first).
445        my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
446        while (<SVN>) {
447            # Input may use a different EOL sequence than $/, so avoid chomp.
448            $_ = removeEOL($_);
449            my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
450            if ($normalizedFullPath eq $normalizedStatPath) {
451                $svnStatus = "$_\n";
452                last;
453            }
454        }
455        # Read the rest of the svn command output to avoid a broken pipe warning.
456        local $/ = undef;
457        <SVN>;
458    }
459    else {
460        # Files will have only one status returned.
461        $svnStatus = removeEOL(<SVN>) . "\n";
462    }
463    close SVN;
464    return $svnStatus;
465}
466
467# Return whether the given file mode is executable in the source control
468# sense.  We make this determination based on whether the executable bit
469# is set for "others" rather than the stronger condition that it be set
470# for the user, group, and others.  This is sufficient for distinguishing
471# the default behavior in Git and SVN.
472#
473# Args:
474#   $fileMode: A number or string representing a file mode in octal notation.
475sub isExecutable($)
476{
477    my $fileMode = shift;
478
479    return $fileMode % 2;
480}
481
482# Parse the next Git diff header from the given file handle, and advance
483# the handle so the last line read is the first line after the header.
484#
485# This subroutine dies if given leading junk.
486#
487# Args:
488#   $fileHandle: advanced so the last line read from the handle is the first
489#                line of the header to parse.  This should be a line
490#                beginning with "diff --git".
491#   $line: the line last read from $fileHandle
492#
493# Returns ($headerHashRef, $lastReadLine):
494#   $headerHashRef: a hash reference representing a diff header, as follows--
495#     copiedFromPath: the path from which the file was copied or moved if
496#                     the diff is a copy or move.
497#     executableBitDelta: the value 1 or -1 if the executable bit was added or
498#                         removed, respectively.  New and deleted files have
499#                         this value only if the file is executable, in which
500#                         case the value is 1 and -1, respectively.
501#     indexPath: the path of the target file.
502#     isBinary: the value 1 if the diff is for a binary file.
503#     isDeletion: the value 1 if the diff is a file deletion.
504#     isCopyWithChanges: the value 1 if the file was copied or moved and
505#                        the target file was changed in some way after being
506#                        copied or moved (e.g. if its contents or executable
507#                        bit were changed).
508#     isNew: the value 1 if the diff is for a new file.
509#     shouldDeleteSource: the value 1 if the file was copied or moved and
510#                         the source file was deleted -- i.e. if the copy
511#                         was actually a move.
512#     svnConvertedText: the header text with some lines converted to SVN
513#                       format.  Git-specific lines are preserved.
514#   $lastReadLine: the line last read from $fileHandle.
515sub parseGitDiffHeader($$)
516{
517    my ($fileHandle, $line) = @_;
518
519    $_ = $line;
520
521    my $indexPath;
522    if (/$gitDiffStartRegEx/) {
523        # The first and second paths can differ in the case of copies
524        # and renames.  We use the second file path because it is the
525        # destination path.
526        $indexPath = adjustPathForRecentRenamings($4);
527        # Use $POSTMATCH to preserve the end-of-line character.
528        $_ = "Index: $indexPath$POSTMATCH"; # Convert to SVN format.
529    } else {
530        die("Could not parse leading \"diff --git\" line: \"$line\".");
531    }
532
533    my $copiedFromPath;
534    my $foundHeaderEnding;
535    my $isBinary;
536    my $isDeletion;
537    my $isNew;
538    my $newExecutableBit = 0;
539    my $oldExecutableBit = 0;
540    my $shouldDeleteSource = 0;
541    my $similarityIndex = 0;
542    my $svnConvertedText;
543    while (1) {
544        # Temporarily strip off any end-of-line characters to simplify
545        # regex matching below.
546        s/([\n\r]+)$//;
547        my $eol = $1;
548
549        if (/^(deleted file|old) mode (\d+)/) {
550            $oldExecutableBit = (isExecutable($2) ? 1 : 0);
551            $isDeletion = 1 if $1 eq "deleted file";
552        } elsif (/^new( file)? mode (\d+)/) {
553            $newExecutableBit = (isExecutable($2) ? 1 : 0);
554            $isNew = 1 if $1;
555        } elsif (/^similarity index (\d+)%/) {
556            $similarityIndex = $1;
557        } elsif (/^copy from (\S+)/) {
558            $copiedFromPath = $1;
559        } elsif (/^rename from (\S+)/) {
560            # FIXME: Record this as a move rather than as a copy-and-delete.
561            #        This will simplify adding rename support to svn-unapply.
562            #        Otherwise, the hash for a deletion would have to know
563            #        everything about the file being deleted in order to
564            #        support undoing itself.  Recording as a move will also
565            #        permit us to use "svn move" and "git move".
566            $copiedFromPath = $1;
567            $shouldDeleteSource = 1;
568        } elsif (/^--- \S+/) {
569            $_ = "--- $indexPath"; # Convert to SVN format.
570        } elsif (/^\+\+\+ \S+/) {
571            $_ = "+++ $indexPath"; # Convert to SVN format.
572            $foundHeaderEnding = 1;
573        } elsif (/^GIT binary patch$/ ) {
574            $isBinary = 1;
575            $foundHeaderEnding = 1;
576        # The "git diff" command includes a line of the form "Binary files
577        # <path1> and <path2> differ" if the --binary flag is not used.
578        } elsif (/^Binary files / ) {
579            die("Error: the Git diff contains a binary file without the binary data in ".
580                "line: \"$_\".  Be sure to use the --binary flag when invoking \"git diff\" ".
581                "with diffs containing binary files.");
582        }
583
584        $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
585
586        $_ = <$fileHandle>; # Not defined if end-of-file reached.
587
588        last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
589    }
590
591    my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
592
593    my %header;
594
595    $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
596    $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
597    $header{indexPath} = $indexPath;
598    $header{isBinary} = $isBinary if $isBinary;
599    $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
600    $header{isDeletion} = $isDeletion if $isDeletion;
601    $header{isNew} = $isNew if $isNew;
602    $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
603    $header{svnConvertedText} = $svnConvertedText;
604
605    return (\%header, $_);
606}
607
608# Parse the next SVN diff header from the given file handle, and advance
609# the handle so the last line read is the first line after the header.
610#
611# This subroutine dies if given leading junk or if it could not detect
612# the end of the header block.
613#
614# Args:
615#   $fileHandle: advanced so the last line read from the handle is the first
616#                line of the header to parse.  This should be a line
617#                beginning with "Index:".
618#   $line: the line last read from $fileHandle
619#
620# Returns ($headerHashRef, $lastReadLine):
621#   $headerHashRef: a hash reference representing a diff header, as follows--
622#     copiedFromPath: the path from which the file was copied if the diff
623#                     is a copy.
624#     indexPath: the path of the target file, which is the path found in
625#                the "Index:" line.
626#     isBinary: the value 1 if the diff is for a binary file.
627#     isNew: the value 1 if the diff is for a new file.
628#     sourceRevision: the revision number of the source, if it exists.  This
629#                     is the same as the revision number the file was copied
630#                     from, in the case of a file copy.
631#     svnConvertedText: the header text converted to a header with the paths
632#                       in some lines corrected.
633#   $lastReadLine: the line last read from $fileHandle.
634sub parseSvnDiffHeader($$)
635{
636    my ($fileHandle, $line) = @_;
637
638    $_ = $line;
639
640    my $indexPath;
641    if (/$svnDiffStartRegEx/) {
642        $indexPath = adjustPathForRecentRenamings($1);
643    } else {
644        die("First line of SVN diff does not begin with \"Index \": \"$_\"");
645    }
646
647    my $copiedFromPath;
648    my $foundHeaderEnding;
649    my $isBinary;
650    my $isNew;
651    my $sourceRevision;
652    my $svnConvertedText;
653    while (1) {
654        # Temporarily strip off any end-of-line characters to simplify
655        # regex matching below.
656        s/([\n\r]+)$//;
657        my $eol = $1;
658
659        # Fix paths on ""---" and "+++" lines to match the leading
660        # index line.
661        if (s/^--- \S+/--- $indexPath/) {
662            # ---
663            if (/^--- .+\(revision (\d+)\)/) {
664                $sourceRevision = $1;
665                $isNew = 1 if !$sourceRevision; # if revision 0.
666                if (/\(from (\S+):(\d+)\)$/) {
667                    # The "from" clause is created by svn-create-patch, in
668                    # which case there is always also a "revision" clause.
669                    $copiedFromPath = $1;
670                    die("Revision number \"$2\" in \"from\" clause does not match " .
671                        "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
672                }
673            }
674        } elsif (s/^\+\+\+ \S+/+++ $indexPath/) {
675            $foundHeaderEnding = 1;
676        } elsif (/^Cannot display: file marked as a binary type.$/) {
677            $isBinary = 1;
678            $foundHeaderEnding = 1;
679        }
680
681        $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
682
683        $_ = <$fileHandle>; # Not defined if end-of-file reached.
684
685        last if (!defined($_) || /$svnDiffStartRegEx/ || $foundHeaderEnding);
686    }
687
688    if (!$foundHeaderEnding) {
689        die("Did not find end of header block corresponding to index path \"$indexPath\".");
690    }
691
692    my %header;
693
694    $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
695    $header{indexPath} = $indexPath;
696    $header{isBinary} = $isBinary if $isBinary;
697    $header{isNew} = $isNew if $isNew;
698    $header{sourceRevision} = $sourceRevision if $sourceRevision;
699    $header{svnConvertedText} = $svnConvertedText;
700
701    return (\%header, $_);
702}
703
704# Parse the next diff header from the given file handle, and advance
705# the handle so the last line read is the first line after the header.
706#
707# This subroutine dies if given leading junk or if it could not detect
708# the end of the header block.
709#
710# Args:
711#   $fileHandle: advanced so the last line read from the handle is the first
712#                line of the header to parse.  For SVN-formatted diffs, this
713#                is a line beginning with "Index:".  For Git, this is a line
714#                beginning with "diff --git".
715#   $line: the line last read from $fileHandle
716#
717# Returns ($headerHashRef, $lastReadLine):
718#   $headerHashRef: a hash reference representing a diff header
719#     copiedFromPath: the path from which the file was copied if the diff
720#                     is a copy.
721#     executableBitDelta: the value 1 or -1 if the executable bit was added or
722#                         removed, respectively.  New and deleted files have
723#                         this value only if the file is executable, in which
724#                         case the value is 1 and -1, respectively.
725#     indexPath: the path of the target file.
726#     isBinary: the value 1 if the diff is for a binary file.
727#     isGit: the value 1 if the diff is Git-formatted.
728#     isSvn: the value 1 if the diff is SVN-formatted.
729#     sourceRevision: the revision number of the source, if it exists.  This
730#                     is the same as the revision number the file was copied
731#                     from, in the case of a file copy.
732#     svnConvertedText: the header text with some lines converted to SVN
733#                       format.  Git-specific lines are preserved.
734#   $lastReadLine: the line last read from $fileHandle.
735sub parseDiffHeader($$)
736{
737    my ($fileHandle, $line) = @_;
738
739    my $header;  # This is a hash ref.
740    my $isGit;
741    my $isSvn;
742    my $lastReadLine;
743
744    if ($line =~ $svnDiffStartRegEx) {
745        $isSvn = 1;
746        ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
747    } elsif ($line =~ $gitDiffStartRegEx) {
748        $isGit = 1;
749        ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
750    } else {
751        die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
752    }
753
754    $header->{isGit} = $isGit if $isGit;
755    $header->{isSvn} = $isSvn if $isSvn;
756
757    return ($header, $lastReadLine);
758}
759
760# FIXME: The %diffHash "object" should not have an svnConvertedText property.
761#        Instead, the hash object should store its information in a
762#        structured way as properties.  This should be done in a way so
763#        that, if necessary, the text of an SVN or Git patch can be
764#        reconstructed from the information in those hash properties.
765#
766# A %diffHash is a hash representing a source control diff of a single
767# file operation (e.g. a file modification, copy, or delete).
768#
769# These hashes appear, for example, in the parseDiff(), parsePatch(),
770# and prepareParsedPatch() subroutines of this package.
771#
772# The corresponding values are--
773#
774#   copiedFromPath: the path from which the file was copied if the diff
775#                   is a copy.
776#   executableBitDelta: the value 1 or -1 if the executable bit was added or
777#                       removed from the target file, respectively.
778#   indexPath: the path of the target file.  For SVN-formatted diffs,
779#              this is the same as the path in the "Index:" line.
780#   isBinary: the value 1 if the diff is for a binary file.
781#   isDeletion: the value 1 if the diff is known from the header to be a deletion.
782#   isGit: the value 1 if the diff is Git-formatted.
783#   isNew: the value 1 if the dif is known from the header to be a new file.
784#   isSvn: the value 1 if the diff is SVN-formatted.
785#   sourceRevision: the revision number of the source, if it exists.  This
786#                   is the same as the revision number the file was copied
787#                   from, in the case of a file copy.
788#   svnConvertedText: the diff with some lines converted to SVN format.
789#                     Git-specific lines are preserved.
790
791# Parse one diff from a patch file created by svn-create-patch, and
792# advance the file handle so the last line read is the first line
793# of the next header block.
794#
795# This subroutine preserves any leading junk encountered before the header.
796#
797# Composition of an SVN diff
798#
799# There are three parts to an SVN diff: the header, the property change, and
800# the binary contents, in that order. Either the header or the property change
801# may be ommitted, but not both. If there are binary changes, then you always
802# have all three.
803#
804# Args:
805#   $fileHandle: a file handle advanced to the first line of the next
806#                header block. Leading junk is okay.
807#   $line: the line last read from $fileHandle.
808#
809# Returns ($diffHashRefs, $lastReadLine):
810#   $diffHashRefs: A reference to an array of references to %diffHash hashes.
811#                  See the %diffHash documentation above.
812#   $lastReadLine: the line last read from $fileHandle
813sub parseDiff($$)
814{
815    # FIXME: Adjust this method so that it dies if the first line does not
816    #        match the start of a diff.  This will require a change to
817    #        parsePatch() so that parsePatch() skips over leading junk.
818    my ($fileHandle, $line) = @_;
819
820    my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
821
822    my $headerHashRef; # Last header found, as returned by parseDiffHeader().
823    my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
824    my $svnText;
825    while (defined($line)) {
826        if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
827            # Then assume all diffs in the patch are Git-formatted. This
828            # block was made to be enterable at most once since we assume
829            # all diffs in the patch are formatted the same (SVN or Git).
830            $headerStartRegEx = $gitDiffStartRegEx;
831        }
832
833        if ($line =~ $svnPropertiesStartRegEx) {
834            my $propertyPath = $1;
835            if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
836                # This is the start of the second diff in the while loop, which happens to
837                # be a property diff.  If $svnPropertiesHasRef is defined, then this is the
838                # second consecutive property diff, otherwise it's the start of a property
839                # diff for a file that only has property changes.
840                last;
841            }
842            ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
843            next;
844        }
845        if ($line !~ $headerStartRegEx) {
846            # Then we are in the body of the diff.
847            $svnText .= $line;
848            $line = <$fileHandle>;
849            next;
850        } # Otherwise, we found a diff header.
851
852        if ($svnPropertiesHashRef || $headerHashRef) {
853            # Then either we just processed an SVN property change or this
854            # is the start of the second diff header of this while loop.
855            last;
856        }
857
858        ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
859
860        $svnText .= $headerHashRef->{svnConvertedText};
861    }
862
863    my @diffHashRefs;
864
865    if ($headerHashRef->{shouldDeleteSource}) {
866        my %deletionHash;
867        $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
868        $deletionHash{isDeletion} = 1;
869        push @diffHashRefs, \%deletionHash;
870    }
871    if ($headerHashRef->{copiedFromPath}) {
872        my %copyHash;
873        $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
874        $copyHash{indexPath} = $headerHashRef->{indexPath};
875        $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
876        if ($headerHashRef->{isSvn}) {
877            $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
878        }
879        push @diffHashRefs, \%copyHash;
880    }
881
882    # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
883    # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
884    # only has property changes).
885    if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
886        # Then add the usual file modification.
887        my %diffHash;
888        # FIXME: We should expand this code to support other properties.  In the future,
889        #        parseSvnDiffProperties may return a hash whose keys are the properties.
890        if ($headerHashRef->{isSvn}) {
891            # SVN records the change to the executable bit in a separate property change diff
892            # that follows the contents of the diff, except for binary diffs.  For binary
893            # diffs, the property change diff follows the diff header.
894            $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
895        } elsif ($headerHashRef->{isGit}) {
896            # Git records the change to the executable bit in the header of a diff.
897            $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
898        }
899        $diffHash{indexPath} = $headerHashRef->{indexPath};
900        $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
901        $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
902        $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
903        $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
904        $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
905        if (!$headerHashRef->{copiedFromPath}) {
906            # If the file was copied, then we have already incorporated the
907            # sourceRevision information into the change.
908            $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
909        }
910        # FIXME: Remove the need for svnConvertedText.  See the %diffHash
911        #        code comments above for more information.
912        #
913        # Note, we may not always have SVN converted text since we intend
914        # to deprecate it in the future.  For example, a property change
915        # diff for a file that only has property changes will not return
916        # any SVN converted text.
917        $diffHash{svnConvertedText} = $svnText if $svnText;
918        push @diffHashRefs, \%diffHash;
919    }
920
921    if (!%$headerHashRef && $svnPropertiesHashRef) {
922        # A property change diff for a file that only has property changes.
923        my %propertyChangeHash;
924        $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
925        $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
926        $propertyChangeHash{isSvn} = 1;
927        push @diffHashRefs, \%propertyChangeHash;
928    }
929
930    return (\@diffHashRefs, $line);
931}
932
933# Parse an SVN property change diff from the given file handle, and advance
934# the handle so the last line read is the first line after this diff.
935#
936# For the case of an SVN binary diff, the binary contents will follow the
937# the property changes.
938#
939# This subroutine dies if the first line does not begin with "Property changes on"
940# or if the separator line that follows this line is missing.
941#
942# Args:
943#   $fileHandle: advanced so the last line read from the handle is the first
944#                line of the footer to parse.  This line begins with
945#                "Property changes on".
946#   $line: the line last read from $fileHandle.
947#
948# Returns ($propertyHashRef, $lastReadLine):
949#   $propertyHashRef: a hash reference representing an SVN diff footer.
950#     propertyPath: the path of the target file.
951#     executableBitDelta: the value 1 or -1 if the executable bit was added or
952#                         removed from the target file, respectively.
953#   $lastReadLine: the line last read from $fileHandle.
954sub parseSvnDiffProperties($$)
955{
956    my ($fileHandle, $line) = @_;
957
958    $_ = $line;
959
960    my %footer;
961    if (/$svnPropertiesStartRegEx/) {
962        $footer{propertyPath} = $1;
963    } else {
964        die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
965    }
966
967    # We advance $fileHandle two lines so that the next line that
968    # we process is $svnPropertyStartRegEx in a well-formed footer.
969    # A well-formed footer has the form:
970    # Property changes on: FileA
971    # ___________________________________________________________________
972    # Added: svn:executable
973    #    + *
974    $_ = <$fileHandle>; # Not defined if end-of-file reached.
975    my $separator = "_" x 67;
976    if (defined($_) && /^$separator[\r\n]+$/) {
977        $_ = <$fileHandle>;
978    } else {
979        die("Failed to find separator line: \"$_\".");
980    }
981
982    # FIXME: We should expand this to support other SVN properties
983    #        (e.g. return a hash of property key-values that represents
984    #        all properties).
985    #
986    # Notice, we keep processing until we hit end-of-file or some
987    # line that does not resemble $svnPropertyStartRegEx, such as
988    # the empty line that precedes the start of the binary contents
989    # of a patch, or the start of the next diff (e.g. "Index:").
990    my $propertyHashRef;
991    while (defined($_) && /$svnPropertyStartRegEx/) {
992        ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
993        if ($propertyHashRef->{name} eq "svn:executable") {
994            # Notice, for SVN properties, propertyChangeDelta is always non-zero
995            # because a property can only be added or removed.
996            $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};
997        }
998    }
999
1000    return(\%footer, $_);
1001}
1002
1003# Parse the next SVN property from the given file handle, and advance the handle so the last
1004# line read is the first line after the property.
1005#
1006# This subroutine dies if the first line is not a valid start of an SVN property,
1007# or the property is missing a value, or the property change type (e.g. "Added")
1008# does not correspond to the property value type (e.g. "+").
1009#
1010# Args:
1011#   $fileHandle: advanced so the last line read from the handle is the first
1012#                line of the property to parse.  This should be a line
1013#                that matches $svnPropertyStartRegEx.
1014#   $line: the line last read from $fileHandle.
1015#
1016# Returns ($propertyHashRef, $lastReadLine):
1017#   $propertyHashRef: a hash reference representing a SVN property.
1018#     name: the name of the property.
1019#     value: the last property value.  For instance, suppose the property is "Modified".
1020#            Then it has both a '-' and '+' property value in that order.  Therefore,
1021#            the value of this key is the value of the '+' property by ordering (since
1022#            it is the last value).
1023#     propertyChangeDelta: the value 1 or -1 if the property was added or
1024#                          removed, respectively.
1025#   $lastReadLine: the line last read from $fileHandle.
1026sub parseSvnProperty($$)
1027{
1028    my ($fileHandle, $line) = @_;
1029
1030    $_ = $line;
1031
1032    my $propertyName;
1033    my $propertyChangeType;
1034    if (/$svnPropertyStartRegEx/) {
1035        $propertyChangeType = $1;
1036        $propertyName = $2;
1037    } else {
1038        die("Failed to find SVN property: \"$_\".");
1039    }
1040
1041    $_ = <$fileHandle>; # Not defined if end-of-file reached.
1042
1043    # The "svn diff" command neither inserts newline characters between property values
1044    # nor between successive properties.
1045    #
1046    # FIXME: We do not support property values that contain tailing newline characters
1047    #        as it is difficult to disambiguate these trailing newlines from the empty
1048    #        line that precedes the contents of a binary patch.
1049    my $propertyValue;
1050    my $propertyValueType;
1051    while (defined($_) && /$svnPropertyValueStartRegEx/) {
1052        # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
1053        # or "Name" property.  We only care about the ending value (i.e. the '+' property)
1054        # in such circumstances.  So, we take the property value for the property to be its
1055        # last parsed property value.
1056        #
1057        # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
1058        #        add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
1059        $propertyValueType = $1;
1060        ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
1061    }
1062
1063    if (!$propertyValue) {
1064        die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
1065    }
1066
1067    my $propertyChangeDelta;
1068    if ($propertyValueType eq "+" || $propertyValueType eq "Merged") {
1069        $propertyChangeDelta = 1;
1070    } elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
1071        $propertyChangeDelta = -1;
1072    } else {
1073        die("Not reached.");
1074    }
1075
1076    # We perform a simple validation that an "Added" or "Deleted" property
1077    # change type corresponds with a "+" and "-" value type, respectively.
1078    my $expectedChangeDelta;
1079    if ($propertyChangeType eq "Added") {
1080        $expectedChangeDelta = 1;
1081    } elsif ($propertyChangeType eq "Deleted") {
1082        $expectedChangeDelta = -1;
1083    }
1084
1085    if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
1086        die("The final property value type found \"$propertyValueType\" does not " .
1087            "correspond to the property change type found \"$propertyChangeType\".");
1088    }
1089
1090    my %propertyHash;
1091    $propertyHash{name} = $propertyName;
1092    $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
1093    $propertyHash{value} = $propertyValue;
1094    return (\%propertyHash, $_);
1095}
1096
1097# Parse the value of an SVN property from the given file handle, and advance
1098# the handle so the last line read is the first line after the property value.
1099#
1100# This subroutine dies if the first line is an invalid SVN property value line
1101# (i.e. a line that does not begin with "   +" or "   -").
1102#
1103# Args:
1104#   $fileHandle: advanced so the last line read from the handle is the first
1105#                line of the property value to parse.  This should be a line
1106#                beginning with "   +" or "   -".
1107#   $line: the line last read from $fileHandle.
1108#
1109# Returns ($propertyValue, $lastReadLine):
1110#   $propertyValue: the value of the property.
1111#   $lastReadLine: the line last read from $fileHandle.
1112sub parseSvnPropertyValue($$)
1113{
1114    my ($fileHandle, $line) = @_;
1115
1116    $_ = $line;
1117
1118    my $propertyValue;
1119    my $eol;
1120    if (/$svnPropertyValueStartRegEx/) {
1121        $propertyValue = $2; # Does not include the end-of-line character(s).
1122        $eol = $POSTMATCH;
1123    } else {
1124        die("Failed to find property value beginning with '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
1125    }
1126
1127    while (<$fileHandle>) {
1128        if (/^[\r\n]+$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/) {
1129            # Note, we may encounter an empty line before the contents of a binary patch.
1130            # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
1131            # followed by a '+' property in the case of a "Modified" or "Name" property.
1132            # We check for $svnPropertyStartRegEx because it indicates the start of the
1133            # next property to parse.
1134            last;
1135        }
1136
1137        # Temporarily strip off any end-of-line characters. We add the end-of-line characters
1138        # from the previously processed line to the start of this line so that the last line
1139        # of the property value does not end in end-of-line characters.
1140        s/([\n\r]+)$//;
1141        $propertyValue .= "$eol$_";
1142        $eol = $1;
1143    }
1144
1145    return ($propertyValue, $_);
1146}
1147
1148# Parse a patch file created by svn-create-patch.
1149#
1150# Args:
1151#   $fileHandle: A file handle to the patch file that has not yet been
1152#                read from.
1153#
1154# Returns:
1155#   @diffHashRefs: an array of diff hash references.
1156#                  See the %diffHash documentation above.
1157sub parsePatch($)
1158{
1159    my ($fileHandle) = @_;
1160
1161    my $newDiffHashRefs;
1162    my @diffHashRefs; # return value
1163
1164    my $line = <$fileHandle>;
1165
1166    while (defined($line)) { # Otherwise, at EOF.
1167
1168        ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line);
1169
1170        push @diffHashRefs, @$newDiffHashRefs;
1171    }
1172
1173    return @diffHashRefs;
1174}
1175
1176# Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
1177#
1178# Args:
1179#   $shouldForce: Whether to continue processing if an unexpected
1180#                 state occurs.
1181#   @diffHashRefs: An array of references to %diffHashes.
1182#                  See the %diffHash documentation above.
1183#
1184# Returns $preparedPatchHashRef:
1185#   copyDiffHashRefs: A reference to an array of the $diffHashRefs in
1186#                     @diffHashRefs that represent file copies. The original
1187#                     ordering is preserved.
1188#   nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
1189#                        @diffHashRefs that do not represent file copies.
1190#                        The original ordering is preserved.
1191#   sourceRevisionHash: A reference to a hash of source path to source
1192#                       revision number.
1193sub prepareParsedPatch($@)
1194{
1195    my ($shouldForce, @diffHashRefs) = @_;
1196
1197    my %copiedFiles;
1198
1199    # Return values
1200    my @copyDiffHashRefs = ();
1201    my @nonCopyDiffHashRefs = ();
1202    my %sourceRevisionHash = ();
1203    for my $diffHashRef (@diffHashRefs) {
1204        my $copiedFromPath = $diffHashRef->{copiedFromPath};
1205        my $indexPath = $diffHashRef->{indexPath};
1206        my $sourceRevision = $diffHashRef->{sourceRevision};
1207        my $sourcePath;
1208
1209        if (defined($copiedFromPath)) {
1210            # Then the diff is a copy operation.
1211            $sourcePath = $copiedFromPath;
1212
1213            # FIXME: Consider printing a warning or exiting if
1214            #        exists($copiedFiles{$indexPath}) is true -- i.e. if
1215            #        $indexPath appears twice as a copy target.
1216            $copiedFiles{$indexPath} = $sourcePath;
1217
1218            push @copyDiffHashRefs, $diffHashRef;
1219        } else {
1220            # Then the diff is not a copy operation.
1221            $sourcePath = $indexPath;
1222
1223            push @nonCopyDiffHashRefs, $diffHashRef;
1224        }
1225
1226        if (defined($sourceRevision)) {
1227            if (exists($sourceRevisionHash{$sourcePath}) &&
1228                ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
1229                if (!$shouldForce) {
1230                    die "Two revisions of the same file required as a source:\n".
1231                        "    $sourcePath:$sourceRevisionHash{$sourcePath}\n".
1232                        "    $sourcePath:$sourceRevision";
1233                }
1234            }
1235            $sourceRevisionHash{$sourcePath} = $sourceRevision;
1236        }
1237    }
1238
1239    my %preparedPatchHash;
1240
1241    $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
1242    $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
1243    $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
1244
1245    return \%preparedPatchHash;
1246}
1247
1248# Return localtime() for the project's time zone, given an integer time as
1249# returned by Perl's time() function.
1250sub localTimeInProjectTimeZone($)
1251{
1252    my $epochTime = shift;
1253
1254    # Change the time zone temporarily for the localtime() call.
1255    my $savedTimeZone = $ENV{'TZ'};
1256    $ENV{'TZ'} = $changeLogTimeZone;
1257    my @localTime = localtime($epochTime);
1258    if (defined $savedTimeZone) {
1259         $ENV{'TZ'} = $savedTimeZone;
1260    } else {
1261         delete $ENV{'TZ'};
1262    }
1263
1264    return @localTime;
1265}
1266
1267# Set the reviewer and date in a ChangeLog patch, and return the new patch.
1268#
1269# Args:
1270#   $patch: a ChangeLog patch as a string.
1271#   $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
1272#   $epochTime: an integer time as returned by Perl's time() function.
1273sub setChangeLogDateAndReviewer($$$)
1274{
1275    my ($patch, $reviewer, $epochTime) = @_;
1276
1277    my @localTime = localTimeInProjectTimeZone($epochTime);
1278    my $newDate = strftime("%Y-%m-%d", @localTime);
1279
1280    my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )#;
1281    $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
1282
1283    if (defined($reviewer)) {
1284        # We include a leading plus ("+") in the regular expression to make
1285        # the regular expression less likely to match text in the leading junk
1286        # for the patch, if the patch has leading junk.
1287        $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
1288    }
1289
1290    return $patch;
1291}
1292
1293# If possible, returns a ChangeLog patch equivalent to the given one,
1294# but with the newest ChangeLog entry inserted at the top of the
1295# file -- i.e. no leading context and all lines starting with "+".
1296#
1297# If given a patch string not representable as a patch with the above
1298# properties, it returns the input back unchanged.
1299#
1300# WARNING: This subroutine can return an inequivalent patch string if
1301# both the beginning of the new ChangeLog file matches the beginning
1302# of the source ChangeLog, and the source beginning was modified.
1303# Otherwise, it is guaranteed to return an equivalent patch string,
1304# if it returns.
1305#
1306# Applying this subroutine to ChangeLog patches allows svn-apply to
1307# insert new ChangeLog entries at the top of the ChangeLog file.
1308# svn-apply uses patch with --fuzz=3 to do this. We need to apply
1309# this subroutine because the diff(1) command is greedy when matching
1310# lines. A new ChangeLog entry with the same date and author as the
1311# previous will match and cause the diff to have lines of starting
1312# context.
1313#
1314# This subroutine has unit tests in VCSUtils_unittest.pl.
1315#
1316# Returns $changeLogHashRef:
1317#   $changeLogHashRef: a hash reference representing a change log patch.
1318#     patch: a ChangeLog patch equivalent to the given one, but with the
1319#            newest ChangeLog entry inserted at the top of the file, if possible.
1320sub fixChangeLogPatch($)
1321{
1322    my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
1323
1324    $patch =~ /(\r?\n)/;
1325    my $lineEnding = $1;
1326    my @lines = split(/$lineEnding/, $patch);
1327
1328    my $i = 0; # We reuse the same index throughout.
1329
1330    # Skip to beginning of first chunk.
1331    for (; $i < @lines; ++$i) {
1332        if (substr($lines[$i], 0, 1) eq "@") {
1333            last;
1334        }
1335    }
1336    my $chunkStartIndex = ++$i;
1337    my %changeLogHashRef;
1338
1339    # Optimization: do not process if new lines already begin the chunk.
1340    if (substr($lines[$i], 0, 1) eq "+") {
1341        $changeLogHashRef{patch} = $patch;
1342        return \%changeLogHashRef;
1343    }
1344
1345    # Skip to first line of newly added ChangeLog entry.
1346    # For example, +2009-06-03  Eric Seidel  <eric@webkit.org>
1347    my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
1348                         . '\s+(.+)\s+' # name
1349                         . '<([^<>]+)>$'; # e-mail address
1350
1351    for (; $i < @lines; ++$i) {
1352        my $line = $lines[$i];
1353        my $firstChar = substr($line, 0, 1);
1354        if ($line =~ /$dateStartRegEx/) {
1355            last;
1356        } elsif ($firstChar eq " " or $firstChar eq "+") {
1357            next;
1358        }
1359        $changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
1360        return \%changeLogHashRef;
1361    }
1362    if ($i >= @lines) {
1363        $changeLogHashRef{patch} = $patch; # Do not change if date not found.
1364        return \%changeLogHashRef;
1365    }
1366    my $dateStartIndex = $i;
1367
1368    # Rewrite overlapping lines to lead with " ".
1369    my @overlappingLines = (); # These will include a leading "+".
1370    for (; $i < @lines; ++$i) {
1371        my $line = $lines[$i];
1372        if (substr($line, 0, 1) ne "+") {
1373          last;
1374        }
1375        push(@overlappingLines, $line);
1376        $lines[$i] = " " . substr($line, 1);
1377    }
1378
1379    # Remove excess ending context, if necessary.
1380    my $shouldTrimContext = 1;
1381    for (; $i < @lines; ++$i) {
1382        my $firstChar = substr($lines[$i], 0, 1);
1383        if ($firstChar eq " ") {
1384            next;
1385        } elsif ($firstChar eq "@") {
1386            last;
1387        }
1388        $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
1389        last;
1390    }
1391    my $deletedLineCount = 0;
1392    if ($shouldTrimContext) { # Also occurs if end of file reached.
1393        splice(@lines, $i - @overlappingLines, @overlappingLines);
1394        $deletedLineCount = @overlappingLines;
1395    }
1396
1397    # Work backwards, shifting overlapping lines towards front
1398    # while checking that patch stays equivalent.
1399    for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
1400        my $line = $lines[$i];
1401        if (substr($line, 0, 1) ne " ") {
1402            next;
1403        }
1404        my $text = substr($line, 1);
1405        my $newLine = pop(@overlappingLines);
1406        if ($text ne substr($newLine, 1)) {
1407            $changeLogHashRef{patch} = $patch; # Unexpected difference.
1408            return \%changeLogHashRef;
1409        }
1410        $lines[$i] = "+$text";
1411    }
1412
1413    # If @overlappingLines > 0, this is where we make use of the
1414    # assumption that the beginning of the source file was not modified.
1415    splice(@lines, $chunkStartIndex, 0, @overlappingLines);
1416
1417    # Update the date start index as it may have changed after shifting
1418    # the overlapping lines towards the front.
1419    for ($i = $chunkStartIndex; $i < $dateStartIndex; ++$i) {
1420        $dateStartIndex = $i if $lines[$i] =~ /$dateStartRegEx/;
1421    }
1422    splice(@lines, $chunkStartIndex, $dateStartIndex - $chunkStartIndex); # Remove context of later entry.
1423    $deletedLineCount += $dateStartIndex - $chunkStartIndex;
1424
1425    # Update the initial chunk range.
1426    my $chunkRangeRegEx = '^\@\@ -(\d+),(\d+) \+\d+,(\d+) \@\@$'; # e.g. @@ -2,6 +2,18 @@
1427    if ($lines[$chunkStartIndex - 1] !~ /$chunkRangeRegEx/) {
1428        # FIXME: Handle errors differently from ChangeLog files that
1429        # are okay but should not be altered. That way we can find out
1430        # if improvements to the script ever become necessary.
1431        $changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
1432        return \%changeLogHashRef;
1433    }
1434    my $oldSourceLineCount = $2;
1435    my $oldTargetLineCount = $3;
1436
1437    my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
1438    my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
1439    $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
1440
1441    $changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
1442    return \%changeLogHashRef;
1443}
1444
1445# This is a supporting method for runPatchCommand.
1446#
1447# Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
1448#
1449# Returns ($patchCommand, $isForcing).
1450#
1451# This subroutine has unit tests in VCSUtils_unittest.pl.
1452sub generatePatchCommand($)
1453{
1454    my ($passedArgsHashRef) = @_;
1455
1456    my $argsHashRef = { # Defaults
1457        ensureForce => 0,
1458        shouldReverse => 0,
1459        options => []
1460    };
1461
1462    # Merges hash references. It's okay here if passed hash reference is undefined.
1463    @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
1464
1465    my $ensureForce = $argsHashRef->{ensureForce};
1466    my $shouldReverse = $argsHashRef->{shouldReverse};
1467    my $options = $argsHashRef->{options};
1468
1469    if (! $options) {
1470        $options = [];
1471    } else {
1472        $options = [@{$options}]; # Copy to avoid side effects.
1473    }
1474
1475    my $isForcing = 0;
1476    if (grep /^--force$/, @{$options}) {
1477        $isForcing = 1;
1478    } elsif ($ensureForce) {
1479        push @{$options}, "--force";
1480        $isForcing = 1;
1481    }
1482
1483    if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
1484        push @{$options}, "--reverse";
1485    }
1486
1487    @{$options} = sort(@{$options}); # For easier testing.
1488
1489    my $patchCommand = join(" ", "patch -p0", @{$options});
1490
1491    return ($patchCommand, $isForcing);
1492}
1493
1494# Apply the given patch using the patch(1) command.
1495#
1496# On success, return the resulting exit status. Otherwise, exit with the
1497# exit status. If "--force" is passed as an option, however, then never
1498# exit and always return the exit status.
1499#
1500# Args:
1501#   $patch: a patch string.
1502#   $repositoryRootPath: an absolute path to the repository root.
1503#   $pathRelativeToRoot: the path of the file to be patched, relative to the
1504#                        repository root. This should normally be the path
1505#                        found in the patch's "Index:" line. It is passed
1506#                        explicitly rather than reparsed from the patch
1507#                        string for optimization purposes.
1508#                            This is used only for error reporting. The
1509#                        patch command gleans the actual file to patch
1510#                        from the patch string.
1511#   $args: a reference to a hash of optional arguments. The possible
1512#          keys are --
1513#            ensureForce: whether to ensure --force is passed (defaults to 0).
1514#            shouldReverse: whether to pass --reverse (defaults to 0).
1515#            options: a reference to an array of options to pass to the
1516#                     patch command. The subroutine passes the -p0 option
1517#                     no matter what. This should not include --reverse.
1518#
1519# This subroutine has unit tests in VCSUtils_unittest.pl.
1520sub runPatchCommand($$$;$)
1521{
1522    my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
1523
1524    my ($patchCommand, $isForcing) = generatePatchCommand($args);
1525
1526    # Temporarily change the working directory since the path found
1527    # in the patch's "Index:" line is relative to the repository root
1528    # (i.e. the same as $pathRelativeToRoot).
1529    my $cwd = Cwd::getcwd();
1530    chdir $repositoryRootPath;
1531
1532    open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
1533    print PATCH $patch;
1534    close PATCH;
1535    my $exitStatus = exitStatus($?);
1536
1537    chdir $cwd;
1538
1539    if ($exitStatus && !$isForcing) {
1540        print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
1541              "status $exitStatus.  Pass --force to ignore patch failures.\n";
1542        exit $exitStatus;
1543    }
1544
1545    return $exitStatus;
1546}
1547
1548# Merge ChangeLog patches using a three-file approach.
1549#
1550# This is used by resolve-ChangeLogs when it's operated as a merge driver
1551# and when it's used to merge conflicts after a patch is applied or after
1552# an svn update.
1553#
1554# It's also used for traditional rejected patches.
1555#
1556# Args:
1557#   $fileMine:  The merged version of the file.  Also known in git as the
1558#               other branch's version (%B) or "ours".
1559#               For traditional patch rejects, this is the *.rej file.
1560#   $fileOlder: The base version of the file.  Also known in git as the
1561#               ancestor version (%O) or "base".
1562#               For traditional patch rejects, this is the *.orig file.
1563#   $fileNewer: The current version of the file.  Also known in git as the
1564#               current version (%A) or "theirs".
1565#               For traditional patch rejects, this is the original-named
1566#               file.
1567#
1568# Returns 1 if merge was successful, else 0.
1569sub mergeChangeLogs($$$)
1570{
1571    my ($fileMine, $fileOlder, $fileNewer) = @_;
1572
1573    my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
1574
1575    local $/ = undef;
1576
1577    my $patch;
1578    if ($traditionalReject) {
1579        open(DIFF, "<", $fileMine) or die $!;
1580        $patch = <DIFF>;
1581        close(DIFF);
1582        rename($fileMine, "$fileMine.save");
1583        rename($fileOlder, "$fileOlder.save");
1584    } else {
1585        open(DIFF, "-|", qw(diff -u -a --binary), $fileOlder, $fileMine) or die $!;
1586        $patch = <DIFF>;
1587        close(DIFF);
1588    }
1589
1590    unlink("${fileNewer}.orig");
1591    unlink("${fileNewer}.rej");
1592
1593    open(PATCH, "| patch --force --fuzz=3 --binary $fileNewer > " . File::Spec->devnull()) or die $!;
1594    if ($traditionalReject) {
1595        print PATCH $patch;
1596    } else {
1597        my $changeLogHash = fixChangeLogPatch($patch);
1598        print PATCH $changeLogHash->{patch};
1599    }
1600    close(PATCH);
1601
1602    my $result = !exitStatus($?);
1603
1604    # Refuse to merge the patch if it did not apply cleanly
1605    if (-e "${fileNewer}.rej") {
1606        unlink("${fileNewer}.rej");
1607        if (-f "${fileNewer}.orig") {
1608            unlink($fileNewer);
1609            rename("${fileNewer}.orig", $fileNewer);
1610        }
1611    } else {
1612        unlink("${fileNewer}.orig");
1613    }
1614
1615    if ($traditionalReject) {
1616        rename("$fileMine.save", $fileMine);
1617        rename("$fileOlder.save", $fileOlder);
1618    }
1619
1620    return $result;
1621}
1622
1623sub gitConfig($)
1624{
1625    return unless $isGit;
1626
1627    my ($config) = @_;
1628
1629    my $result = `git config $config`;
1630    if (($? >> 8)) {
1631        $result = `git repo-config $config`;
1632    }
1633    chomp $result;
1634    return $result;
1635}
1636
1637sub changeLogNameError($)
1638{
1639    my ($message) = @_;
1640    print STDERR "$message\nEither:\n";
1641    print STDERR "  set CHANGE_LOG_NAME in your environment\n";
1642    print STDERR "  OR pass --name= on the command line\n";
1643    print STDERR "  OR set REAL_NAME in your environment";
1644    print STDERR "  OR git users can set 'git config user.name'\n";
1645    exit(1);
1646}
1647
1648sub changeLogName()
1649{
1650    my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
1651
1652    changeLogNameError("Failed to determine ChangeLog name.") unless $name;
1653    # getpwuid seems to always succeed on windows, returning the username instead of the full name.  This check will catch that case.
1654    changeLogNameError("'$name' does not contain a space!  ChangeLogs should contain your full name.") unless ($name =~ /\w \w/);
1655
1656    return $name;
1657}
1658
1659sub changeLogEmailAddressError($)
1660{
1661    my ($message) = @_;
1662    print STDERR "$message\nEither:\n";
1663    print STDERR "  set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
1664    print STDERR "  OR pass --email= on the command line\n";
1665    print STDERR "  OR set EMAIL_ADDRESS in your environment\n";
1666    print STDERR "  OR git users can set 'git config user.email'\n";
1667    exit(1);
1668}
1669
1670sub changeLogEmailAddress()
1671{
1672    my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
1673
1674    changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
1675    changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
1676
1677    return $emailAddress;
1678}
1679
1680# http://tools.ietf.org/html/rfc1924
1681sub decodeBase85($)
1682{
1683    my ($encoded) = @_;
1684    my %table;
1685    my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
1686    for (my $i = 0; $i < 85; $i++) {
1687        $table{$characters[$i]} = $i;
1688    }
1689
1690    my $decoded = '';
1691    my @encodedChars = $encoded =~ /./g;
1692
1693    for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
1694        my $digit = 0;
1695        for (my $i = 0; $i < 5; $i++) {
1696            $digit *= 85;
1697            my $char = $encodedChars[$encodedIter];
1698            $digit += $table{$char};
1699            $encodedIter++;
1700        }
1701
1702        for (my $i = 0; $i < 4; $i++) {
1703            $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
1704        }
1705    }
1706
1707    return $decoded;
1708}
1709
1710sub decodeGitBinaryChunk($$)
1711{
1712    my ($contents, $fullPath) = @_;
1713
1714    # Load this module lazily in case the user don't have this module
1715    # and won't handle git binary patches.
1716    require Compress::Zlib;
1717
1718    my $encoded = "";
1719    my $compressedSize = 0;
1720    while ($contents =~ /^([A-Za-z])(.*)$/gm) {
1721        my $line = $2;
1722        next if $line eq "";
1723        die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
1724        my $actualSize = length($2) / 5 * 4;
1725        my $encodedExpectedSize = ord($1);
1726        my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
1727
1728        die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
1729        $compressedSize += $expectedSize;
1730        $encoded .= $line;
1731    }
1732
1733    my $compressed = decodeBase85($encoded);
1734    $compressed = substr($compressed, 0, $compressedSize);
1735    return Compress::Zlib::uncompress($compressed);
1736}
1737
1738sub decodeGitBinaryPatch($$)
1739{
1740    my ($contents, $fullPath) = @_;
1741
1742    # Git binary patch has two chunks. One is for the normal patching
1743    # and another is for the reverse patching.
1744    #
1745    # Each chunk a line which starts from either "literal" or "delta",
1746    # followed by a number which specifies decoded size of the chunk.
1747    #
1748    # Then, content of the chunk comes. To decode the content, we
1749    # need decode it with base85 first, and then zlib.
1750    my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
1751    if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
1752        die "$fullPath: unknown git binary patch format"
1753    }
1754
1755    my $binaryChunkType = $1;
1756    my $binaryChunkExpectedSize = $2;
1757    my $encodedChunk = $3;
1758    my $reverseBinaryChunkType = $4;
1759    my $reverseBinaryChunkExpectedSize = $5;
1760    my $encodedReverseChunk = $6;
1761
1762    my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
1763    my $binaryChunkActualSize = length($binaryChunk);
1764    my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
1765    my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
1766
1767    die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkType eq "literal" and $binaryChunkExpectedSize != $binaryChunkActualSize);
1768    die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkType eq "literal" and $reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
1769
1770    return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
1771}
1772
1773sub readByte($$)
1774{
1775    my ($data, $location) = @_;
1776
1777    # Return the byte at $location in $data as a numeric value.
1778    return ord(substr($data, $location, 1));
1779}
1780
1781# The git binary delta format is undocumented, except in code:
1782# - https://github.com/git/git/blob/master/delta.h:get_delta_hdr_size is the source
1783#   of the algorithm in decodeGitBinaryPatchDeltaSize.
1784# - https://github.com/git/git/blob/master/patch-delta.c:patch_delta is the source
1785#   of the algorithm in applyGitBinaryPatchDelta.
1786sub decodeGitBinaryPatchDeltaSize($)
1787{
1788    my ($binaryChunk) = @_;
1789
1790    # Source and destination buffer sizes are stored in 7-bit chunks at the
1791    # start of the binary delta patch data.  The highest bit in each byte
1792    # except the last is set; the remaining 7 bits provide the next
1793    # chunk of the size.  The chunks are stored in ascending significance
1794    # order.
1795    my $cmd;
1796    my $size = 0;
1797    my $shift = 0;
1798    for (my $i = 0; $i < length($binaryChunk);) {
1799        $cmd = readByte($binaryChunk, $i++);
1800        $size |= ($cmd & 0x7f) << $shift;
1801        $shift += 7;
1802        if (!($cmd & 0x80)) {
1803            return ($size, $i);
1804        }
1805    }
1806}
1807
1808sub applyGitBinaryPatchDelta($$)
1809{
1810    my ($binaryChunk, $originalContents) = @_;
1811
1812    # Git delta format consists of two headers indicating source buffer size
1813    # and result size, then a series of commands.  Each command is either
1814    # a copy-from-old-version (the 0x80 bit is set) or a copy-from-delta
1815    # command.  Commands are applied sequentially to generate the result.
1816    #
1817    # A copy-from-old-version command encodes an offset and size to copy
1818    # from in subsequent bits, while a copy-from-delta command consists only
1819    # of the number of bytes to copy from the delta.
1820
1821    # We don't use these values, but we need to know how big they are so that
1822    # we can skip to the diff data.
1823    my ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1824    $binaryChunk = substr($binaryChunk, $bytesUsed);
1825    ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
1826    $binaryChunk = substr($binaryChunk, $bytesUsed);
1827
1828    my $out = "";
1829    for (my $i = 0; $i < length($binaryChunk); ) {
1830        my $cmd = ord(substr($binaryChunk, $i++, 1));
1831        if ($cmd & 0x80) {
1832            # Extract an offset and size from the delta data, then copy
1833            # $size bytes from $offset in the original data into the output.
1834            my $offset = 0;
1835            my $size = 0;
1836            if ($cmd & 0x01) { $offset = readByte($binaryChunk, $i++); }
1837            if ($cmd & 0x02) { $offset |= readByte($binaryChunk, $i++) << 8; }
1838            if ($cmd & 0x04) { $offset |= readByte($binaryChunk, $i++) << 16; }
1839            if ($cmd & 0x08) { $offset |= readByte($binaryChunk, $i++) << 24; }
1840            if ($cmd & 0x10) { $size = readByte($binaryChunk, $i++); }
1841            if ($cmd & 0x20) { $size |= readByte($binaryChunk, $i++) << 8; }
1842            if ($cmd & 0x40) { $size |= readByte($binaryChunk, $i++) << 16; }
1843            if ($size == 0) { $size = 0x10000; }
1844            $out .= substr($originalContents, $offset, $size);
1845        } elsif ($cmd) {
1846            # Copy $cmd bytes from the delta data into the output.
1847            $out .= substr($binaryChunk, $i, $cmd);
1848            $i += $cmd;
1849        } else {
1850            die "unexpected delta opcode 0";
1851        }
1852    }
1853
1854    return $out;
1855}
1856
18571;
1858