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