123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196 |
- # Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013 Apple Inc. All rights reserved.
- # Copyright (C) 2009, 2010 Chris Jerdonek (chris.jerdonek@gmail.com)
- # Copyright (C) 2010, 2011 Research In Motion Limited. All rights reserved.
- # Copyright (C) 2012 Daniel Bates (dbates@intudata.com)
- #
- # Redistribution and use in source and binary forms, with or without
- # modification, are permitted provided that the following conditions
- # are met:
- #
- # 1. Redistributions of source code must retain the above copyright
- # notice, this list of conditions and the following disclaimer.
- # 2. Redistributions in binary form must reproduce the above copyright
- # notice, this list of conditions and the following disclaimer in the
- # documentation and/or other materials provided with the distribution.
- # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of
- # its contributors may be used to endorse or promote products derived
- # from this software without specific prior written permission.
- #
- # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
- # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
- # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
- # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
- # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
- # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
- # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
- # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- # Module to share code to work with various version control systems.
- package VCSUtils;
- use strict;
- use warnings;
- use Cwd qw(); # "qw()" prevents warnings about redefining getcwd() with "use POSIX;"
- use English; # for $POSTMATCH, etc.
- use File::Basename;
- use File::Spec;
- use POSIX;
- use Term::ANSIColor qw(colored);
- BEGIN {
- use Exporter ();
- our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
- $VERSION = 1.00;
- @ISA = qw(Exporter);
- @EXPORT = qw(
- &applyGitBinaryPatchDelta
- &callSilently
- &canonicalizePath
- &changeLogEmailAddress
- &changeLogFileName
- &changeLogName
- &chdirReturningRelativePath
- &decodeGitBinaryChunk
- &decodeGitBinaryPatch
- &determineSVNRoot
- &determineVCSRoot
- &escapeSubversionPath
- &exitStatus
- &fixChangeLogPatch
- &gitBranch
- &gitdiff2svndiff
- &isGit
- &isGitSVN
- &isGitBranchBuild
- &isGitDirectory
- &isSVN
- &isSVNDirectory
- &isSVNVersion16OrNewer
- &makeFilePathRelative
- &mergeChangeLogs
- &normalizePath
- &parseChunkRange
- &parseFirstEOL
- &parsePatch
- &pathRelativeToSVNRepositoryRootForPath
- &possiblyColored
- &prepareParsedPatch
- &removeEOL
- &runCommand
- &runPatchCommand
- &scmMoveOrRenameFile
- &scmToggleExecutableBit
- &setChangeLogDateAndReviewer
- &svnRevisionForDirectory
- &svnStatus
- &toWindowsLineEndings
- &gitCommitForSVNRevision
- &listOfChangedFilesBetweenRevisions
- );
- %EXPORT_TAGS = ( );
- @EXPORT_OK = ();
- }
- our @EXPORT_OK;
- my $gitBranch;
- my $gitRoot;
- my $isGit;
- my $isGitSVN;
- my $isGitBranchBuild;
- my $isSVN;
- my $svnVersion;
- # Project time zone for Cupertino, CA, US
- my $changeLogTimeZone = "PST8PDT";
- my $gitDiffStartRegEx = qr#^diff --git [^\r\n]+#;
- my $gitDiffStartWithPrefixRegEx = qr#^diff --git \w/(.+) \w/([^\r\n]+)#; # We suppose that --src-prefix and --dst-prefix don't contain a non-word character (\W) and end with '/'.
- my $gitDiffStartWithoutPrefixNoSpaceRegEx = qr#^diff --git (\S+) (\S+)$#;
- my $svnDiffStartRegEx = qr#^Index: ([^\r\n]+)#;
- my $gitDiffStartWithoutPrefixSourceDirectoryPrefixRegExp = qr#^diff --git ([^/]+/)#;
- my $svnPropertiesStartRegEx = qr#^Property changes on: ([^\r\n]+)#; # $1 is normally the same as the index path.
- my $svnPropertyStartRegEx = qr#^(Modified|Name|Added|Deleted): ([^\r\n]+)#; # $2 is the name of the property.
- my $svnPropertyValueStartRegEx = qr#^\s*(\+|-|Merged|Reverse-merged)\s*([^\r\n]+)#; # $2 is the start of the property's value (which may span multiple lines).
- my $svnPropertyValueNoNewlineRegEx = qr#\ No newline at end of property#;
- # This method is for portability. Return the system-appropriate exit
- # status of a child process.
- #
- # Args: pass the child error status returned by the last pipe close,
- # for example "$?".
- sub exitStatus($)
- {
- my ($returnvalue) = @_;
- if ($^O eq "MSWin32") {
- return $returnvalue >> 8;
- }
- if (!WIFEXITED($returnvalue)) {
- return 254;
- }
- return WEXITSTATUS($returnvalue);
- }
- # Call a function while suppressing STDERR, and return the return values
- # as an array.
- sub callSilently($@) {
- my ($func, @args) = @_;
- # The following pattern was taken from here:
- # http://www.sdsc.edu/~moreland/courses/IntroPerl/docs/manual/pod/perlfunc/open.html
- #
- # Also see this Perl documentation (search for "open OLDERR"):
- # http://perldoc.perl.org/functions/open.html
- open(OLDERR, ">&STDERR");
- close(STDERR);
- my @returnValue = &$func(@args);
- open(STDERR, ">&OLDERR");
- close(OLDERR);
- return @returnValue;
- }
- sub toWindowsLineEndings
- {
- my ($text) = @_;
- $text =~ s/\n/\r\n/g;
- return $text;
- }
- # Note, this method will not error if the file corresponding to the $source path does not exist.
- sub scmMoveOrRenameFile
- {
- my ($source, $destination) = @_;
- return if ! -e $source;
- if (isSVN()) {
- my $escapedDestination = escapeSubversionPath($destination);
- my $escapedSource = escapeSubversionPath($source);
- system("svn", "move", $escapedSource, $escapedDestination);
- } elsif (isGit()) {
- system("git", "mv", $source, $destination);
- }
- }
- # Note, this method will not error if the file corresponding to the path does not exist.
- sub scmToggleExecutableBit
- {
- my ($path, $executableBitDelta) = @_;
- return if ! -e $path;
- if ($executableBitDelta == 1) {
- scmAddExecutableBit($path);
- } elsif ($executableBitDelta == -1) {
- scmRemoveExecutableBit($path);
- }
- }
- sub scmAddExecutableBit($)
- {
- my ($path) = @_;
- if (isSVN()) {
- my $escapedPath = escapeSubversionPath($path);
- system("svn", "propset", "svn:executable", "on", $escapedPath) == 0 or die "Failed to run 'svn propset svn:executable on $escapedPath'.";
- } elsif (isGit()) {
- chmod(0755, $path);
- }
- }
- sub scmRemoveExecutableBit($)
- {
- my ($path) = @_;
- if (isSVN()) {
- my $escapedPath = escapeSubversionPath($path);
- system("svn", "propdel", "svn:executable", $escapedPath) == 0 or die "Failed to run 'svn propdel svn:executable $escapedPath'.";
- } elsif (isGit()) {
- chmod(0664, $path);
- }
- }
- sub isGitDirectory($)
- {
- my ($dir) = @_;
- return system("cd $dir && git rev-parse > " . File::Spec->devnull() . " 2>&1") == 0;
- }
- sub isGit()
- {
- return $isGit if defined $isGit;
- $isGit = isGitDirectory(".");
- return $isGit;
- }
- sub isGitSVN()
- {
- return $isGitSVN if defined $isGitSVN;
- # There doesn't seem to be an officially documented way to determine
- # if you're in a git-svn checkout. The best suggestions seen so far
- # all use something like the following:
- my $output = `git config --get svn-remote.svn.fetch 2>& 1`;
- $isGitSVN = $output ne '';
- return $isGitSVN;
- }
- sub gitBranch()
- {
- unless (defined $gitBranch) {
- chomp($gitBranch = `git symbolic-ref -q HEAD`);
- $gitBranch = "" if exitStatus($?);
- $gitBranch =~ s#^refs/heads/##;
- $gitBranch = "" if $gitBranch eq "master";
- }
- return $gitBranch;
- }
- sub isGitBranchBuild()
- {
- my $branch = gitBranch();
- chomp(my $override = `git config --bool branch.$branch.webKitBranchBuild`);
- return 1 if $override eq "true";
- return 0 if $override eq "false";
- unless (defined $isGitBranchBuild) {
- chomp(my $gitBranchBuild = `git config --bool core.webKitBranchBuild`);
- $isGitBranchBuild = $gitBranchBuild eq "true";
- }
- return $isGitBranchBuild;
- }
- sub isSVNDirectory($)
- {
- my ($dir) = @_;
- return system("cd $dir && svn info > " . File::Spec->devnull() . " 2>&1") == 0;
- }
- sub isSVN()
- {
- return $isSVN if defined $isSVN;
- $isSVN = isSVNDirectory(".");
- return $isSVN;
- }
- sub svnVersion()
- {
- return $svnVersion if defined $svnVersion;
- if (!isSVN()) {
- $svnVersion = 0;
- } else {
- chomp($svnVersion = `svn --version --quiet`);
- }
- return $svnVersion;
- }
- sub isSVNVersion16OrNewer()
- {
- my $version = svnVersion();
- return eval "v$version" ge v1.6;
- }
- sub chdirReturningRelativePath($)
- {
- my ($directory) = @_;
- my $previousDirectory = Cwd::getcwd();
- chdir $directory;
- my $newDirectory = Cwd::getcwd();
- return "." if $newDirectory eq $previousDirectory;
- return File::Spec->abs2rel($previousDirectory, $newDirectory);
- }
- sub determineGitRoot()
- {
- chomp(my $gitDir = `git rev-parse --git-dir`);
- return dirname($gitDir);
- }
- sub determineSVNRoot()
- {
- my $last = '';
- my $path = '.';
- my $parent = '..';
- my $repositoryRoot;
- my $repositoryUUID;
- while (1) {
- my $thisRoot;
- my $thisUUID;
- my $escapedPath = escapeSubversionPath($path);
- # Ignore error messages in case we've run past the root of the checkout.
- open INFO, "svn info '$escapedPath' 2> " . File::Spec->devnull() . " |" or die;
- while (<INFO>) {
- if (/^Repository Root: (.+)/) {
- $thisRoot = $1;
- }
- if (/^Repository UUID: (.+)/) {
- $thisUUID = $1;
- }
- if ($thisRoot && $thisUUID) {
- local $/ = undef;
- <INFO>; # Consume the rest of the input.
- }
- }
- close INFO;
- # It's possible (e.g. for developers of some ports) to have a WebKit
- # checkout in a subdirectory of another checkout. So abort if the
- # repository root or the repository UUID suddenly changes.
- last if !$thisUUID;
- $repositoryUUID = $thisUUID if !$repositoryUUID;
- last if $thisUUID ne $repositoryUUID;
- last if !$thisRoot;
- $repositoryRoot = $thisRoot if !$repositoryRoot;
- last if $thisRoot ne $repositoryRoot;
- $last = $path;
- $path = File::Spec->catdir($parent, $path);
- }
- return File::Spec->rel2abs($last);
- }
- sub determineVCSRoot()
- {
- if (isGit()) {
- return determineGitRoot();
- }
- if (!isSVN()) {
- # Some users have a workflow where svn-create-patch, svn-apply and
- # svn-unapply are used outside of multiple svn working directores,
- # so warn the user and assume Subversion is being used in this case.
- warn "Unable to determine VCS root for '" . Cwd::getcwd() . "'; assuming Subversion";
- $isSVN = 1;
- }
- return determineSVNRoot();
- }
- sub isWindows()
- {
- return ($^O eq "MSWin32") || 0;
- }
- sub svnRevisionForDirectory($)
- {
- my ($dir) = @_;
- my $revision;
- if (isSVNDirectory($dir)) {
- my $escapedDir = escapeSubversionPath($dir);
- my $command = "svn info $escapedDir | grep Revision:";
- $command = "LC_ALL=C $command" if !isWindows();
- my $svnInfo = `$command`;
- ($revision) = ($svnInfo =~ m/Revision: (\d+).*/g);
- } elsif (isGitDirectory($dir)) {
- my $command = "git log --grep=\"git-svn-id: \" -n 1 | grep git-svn-id:";
- $command = "LC_ALL=C $command" if !isWindows();
- $command = "cd $dir && $command";
- my $gitLog = `$command`;
- ($revision) = ($gitLog =~ m/ +git-svn-id: .+@(\d+) /g);
- }
- if (!defined($revision)) {
- $revision = "unknown";
- warn "Unable to determine current SVN revision in $dir";
- }
- return $revision;
- }
- sub pathRelativeToSVNRepositoryRootForPath($)
- {
- my ($file) = @_;
- my $relativePath = File::Spec->abs2rel($file);
- my $svnInfo;
- if (isSVN()) {
- my $escapedRelativePath = escapeSubversionPath($relativePath);
- my $command = "svn info $escapedRelativePath";
- $command = "LC_ALL=C $command" if !isWindows();
- $svnInfo = `$command`;
- } elsif (isGit()) {
- my $command = "git svn info $relativePath";
- $command = "LC_ALL=C $command" if !isWindows();
- $svnInfo = `$command`;
- }
- $svnInfo =~ /.*^URL: (.*?)$/m;
- my $svnURL = $1;
- $svnInfo =~ /.*^Repository Root: (.*?)$/m;
- my $repositoryRoot = $1;
- $svnURL =~ s/$repositoryRoot\///;
- return $svnURL;
- }
- sub makeFilePathRelative($)
- {
- my ($path) = @_;
- return $path unless isGit();
- unless (defined $gitRoot) {
- chomp($gitRoot = `git rev-parse --show-cdup`);
- }
- return $gitRoot . $path;
- }
- sub normalizePath($)
- {
- my ($path) = @_;
- $path =~ s/\\/\//g;
- return $path;
- }
- sub possiblyColored($$)
- {
- my ($colors, $string) = @_;
- if (-t STDOUT) {
- return colored([$colors], $string);
- } else {
- return $string;
- }
- }
- sub adjustPathForRecentRenamings($)
- {
- my ($fullPath) = @_;
-
- $fullPath =~ s|WebCore/webaudio|WebCore/Modules/webaudio|g;
- $fullPath =~ s|JavaScriptCore/wtf|WTF/wtf|g;
- $fullPath =~ s|test_expectations.txt|TestExpectations|g;
- return $fullPath;
- }
- sub canonicalizePath($)
- {
- my ($file) = @_;
- # Remove extra slashes and '.' directories in path
- $file = File::Spec->canonpath($file);
- # Remove '..' directories in path
- my @dirs = ();
- foreach my $dir (File::Spec->splitdir($file)) {
- if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..') {
- pop(@dirs);
- } else {
- push(@dirs, $dir);
- }
- }
- return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
- }
- sub removeEOL($)
- {
- my ($line) = @_;
- return "" unless $line;
- $line =~ s/[\r\n]+$//g;
- return $line;
- }
- sub parseFirstEOL($)
- {
- my ($fileHandle) = @_;
- # Make input record separator the new-line character to simplify regex matching below.
- my $savedInputRecordSeparator = $INPUT_RECORD_SEPARATOR;
- $INPUT_RECORD_SEPARATOR = "\n";
- my $firstLine = <$fileHandle>;
- $INPUT_RECORD_SEPARATOR = $savedInputRecordSeparator;
- return unless defined($firstLine);
- my $eol;
- if ($firstLine =~ /\r\n/) {
- $eol = "\r\n";
- } elsif ($firstLine =~ /\r/) {
- $eol = "\r";
- } elsif ($firstLine =~ /\n/) {
- $eol = "\n";
- }
- return $eol;
- }
- sub firstEOLInFile($)
- {
- my ($file) = @_;
- my $eol;
- if (open(FILE, $file)) {
- $eol = parseFirstEOL(*FILE);
- close(FILE);
- }
- return $eol;
- }
- # Parses a chunk range line into its components.
- #
- # A chunk range line has the form: @@ -L_1,N_1 +L_2,N_2 @@, where the pairs (L_1, N_1),
- # (L_2, N_2) are ranges that represent the starting line number and line count in the
- # original file and new file, respectively.
- #
- # Note, some versions of GNU diff may omit the comma and trailing line count (e.g. N_1),
- # in which case the omitted line count defaults to 1. For example, GNU diff may output
- # @@ -1 +1 @@, which is equivalent to @@ -1,1 +1,1 @@.
- #
- # This subroutine returns undef if given an invalid or malformed chunk range.
- #
- # Args:
- # $line: the line to parse.
- # $chunkSentinel: the sentinel that surrounds the chunk range information (defaults to "@@").
- #
- # Returns $chunkRangeHashRef
- # $chunkRangeHashRef: a hash reference representing the parts of a chunk range, as follows--
- # startingLine: the starting line in the original file.
- # lineCount: the line count in the original file.
- # newStartingLine: the new starting line in the new file.
- # newLineCount: the new line count in the new file.
- sub parseChunkRange($;$)
- {
- my ($line, $chunkSentinel) = @_;
- $chunkSentinel = "@@" if !$chunkSentinel;
- my $chunkRangeRegEx = qr#^\Q$chunkSentinel\E -(\d+)(,(\d+))? \+(\d+)(,(\d+))? \Q$chunkSentinel\E#;
- if ($line !~ /$chunkRangeRegEx/) {
- return;
- }
- my %chunkRange;
- $chunkRange{startingLine} = $1;
- $chunkRange{lineCount} = defined($2) ? $3 : 1;
- $chunkRange{newStartingLine} = $4;
- $chunkRange{newLineCount} = defined($5) ? $6 : 1;
- return \%chunkRange;
- }
- sub svnStatus($)
- {
- my ($fullPath) = @_;
- my $escapedFullPath = escapeSubversionPath($fullPath);
- my $svnStatus;
- open SVN, "svn status --non-interactive --non-recursive '$escapedFullPath' |" or die;
- if (-d $fullPath) {
- # When running "svn stat" on a directory, we can't assume that only one
- # status will be returned (since any files with a status below the
- # directory will be returned), and we can't assume that the directory will
- # be first (since any files with unknown status will be listed first).
- my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
- while (<SVN>) {
- # Input may use a different EOL sequence than $/, so avoid chomp.
- $_ = removeEOL($_);
- my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
- if ($normalizedFullPath eq $normalizedStatPath) {
- $svnStatus = "$_\n";
- last;
- }
- }
- # Read the rest of the svn command output to avoid a broken pipe warning.
- local $/ = undef;
- <SVN>;
- }
- else {
- # Files will have only one status returned.
- $svnStatus = removeEOL(<SVN>) . "\n";
- }
- close SVN;
- return $svnStatus;
- }
- # Return whether the given file mode is executable in the source control
- # sense. We make this determination based on whether the executable bit
- # is set for "others" rather than the stronger condition that it be set
- # for the user, group, and others. This is sufficient for distinguishing
- # the default behavior in Git and SVN.
- #
- # Args:
- # $fileMode: A number or string representing a file mode in octal notation.
- sub isExecutable($)
- {
- my $fileMode = shift;
- return $fileMode % 2;
- }
- # Parse the Git diff header start line.
- #
- # Args:
- # $line: "diff --git" line.
- #
- # Returns the path of the target file.
- sub parseGitDiffStartLine($)
- {
- my $line = shift;
- $_ = $line;
- if (/$gitDiffStartWithPrefixRegEx/ || /$gitDiffStartWithoutPrefixNoSpaceRegEx/) {
- return $2;
- }
- # Assume the diff was generated with --no-prefix (e.g. git diff --no-prefix).
- if (!/$gitDiffStartWithoutPrefixSourceDirectoryPrefixRegExp/) {
- # FIXME: Moving top directory file is not supported (e.g diff --git A.txt B.txt).
- die("Could not find '/' in \"diff --git\" line: \"$line\"; only non-prefixed git diffs (i.e. not generated with --no-prefix) that move a top-level directory file are supported.");
- }
- my $pathPrefix = $1;
- if (!/^diff --git \Q$pathPrefix\E.+ (\Q$pathPrefix\E.+)$/) {
- # FIXME: Moving a file through sub directories of top directory is not supported (e.g diff --git A/B.txt C/B.txt).
- die("Could not find '/' in \"diff --git\" line: \"$line\"; only non-prefixed git diffs (i.e. not generated with --no-prefix) that move a file between top-level directories are supported.");
- }
- return $1;
- }
- # Parse the next Git diff header from the given file handle, and advance
- # the handle so the last line read is the first line after the header.
- #
- # This subroutine dies if given leading junk.
- #
- # Args:
- # $fileHandle: advanced so the last line read from the handle is the first
- # line of the header to parse. This should be a line
- # beginning with "diff --git".
- # $line: the line last read from $fileHandle
- #
- # Returns ($headerHashRef, $lastReadLine):
- # $headerHashRef: a hash reference representing a diff header, as follows--
- # copiedFromPath: the path from which the file was copied or moved if
- # the diff is a copy or move.
- # executableBitDelta: the value 1 or -1 if the executable bit was added or
- # removed, respectively. New and deleted files have
- # this value only if the file is executable, in which
- # case the value is 1 and -1, respectively.
- # indexPath: the path of the target file.
- # isBinary: the value 1 if the diff is for a binary file.
- # isDeletion: the value 1 if the diff is a file deletion.
- # isCopyWithChanges: the value 1 if the file was copied or moved and
- # the target file was changed in some way after being
- # copied or moved (e.g. if its contents or executable
- # bit were changed).
- # isNew: the value 1 if the diff is for a new file.
- # shouldDeleteSource: the value 1 if the file was copied or moved and
- # the source file was deleted -- i.e. if the copy
- # was actually a move.
- # svnConvertedText: the header text with some lines converted to SVN
- # format. Git-specific lines are preserved.
- # $lastReadLine: the line last read from $fileHandle.
- sub parseGitDiffHeader($$)
- {
- my ($fileHandle, $line) = @_;
- $_ = $line;
- my $indexPath;
- if (/$gitDiffStartRegEx/) {
- # Use $POSTMATCH to preserve the end-of-line character.
- my $eol = $POSTMATCH;
- # The first and second paths can differ in the case of copies
- # and renames. We use the second file path because it is the
- # destination path.
- $indexPath = adjustPathForRecentRenamings(parseGitDiffStartLine($_));
- $_ = "Index: $indexPath$eol"; # Convert to SVN format.
- } else {
- die("Could not parse leading \"diff --git\" line: \"$line\".");
- }
- my $copiedFromPath;
- my $foundHeaderEnding;
- my $isBinary;
- my $isDeletion;
- my $isNew;
- my $newExecutableBit = 0;
- my $oldExecutableBit = 0;
- my $shouldDeleteSource = 0;
- my $similarityIndex = 0;
- my $svnConvertedText;
- while (1) {
- # Temporarily strip off any end-of-line characters to simplify
- # regex matching below.
- s/([\n\r]+)$//;
- my $eol = $1;
- if (/^(deleted file|old) mode (\d+)/) {
- $oldExecutableBit = (isExecutable($2) ? 1 : 0);
- $isDeletion = 1 if $1 eq "deleted file";
- } elsif (/^new( file)? mode (\d+)/) {
- $newExecutableBit = (isExecutable($2) ? 1 : 0);
- $isNew = 1 if $1;
- } elsif (/^similarity index (\d+)%/) {
- $similarityIndex = $1;
- } elsif (/^copy from ([^\t\r\n]+)/) {
- $copiedFromPath = $1;
- } elsif (/^rename from ([^\t\r\n]+)/) {
- # FIXME: Record this as a move rather than as a copy-and-delete.
- # This will simplify adding rename support to svn-unapply.
- # Otherwise, the hash for a deletion would have to know
- # everything about the file being deleted in order to
- # support undoing itself. Recording as a move will also
- # permit us to use "svn move" and "git move".
- $copiedFromPath = $1;
- $shouldDeleteSource = 1;
- } elsif (/^--- \S+/) {
- # Convert to SVN format.
- # We emit the suffix "\t(revision 0)" to handle $indexPath which contains a space character.
- # The patch(1) command thinks a file path is characters before a tab.
- # This suffix make our diff more closely match the SVN diff format.
- $_ = "--- $indexPath\t(revision 0)";
- } elsif (/^\+\+\+ \S+/) {
- # Convert to SVN format.
- # We emit the suffix "\t(working copy)" to handle $indexPath which contains a space character.
- # The patch(1) command thinks a file path is characters before a tab.
- # This suffix make our diff more closely match the SVN diff format.
- $_ = "+++ $indexPath\t(working copy)";
- $foundHeaderEnding = 1;
- } elsif (/^GIT binary patch$/ ) {
- $isBinary = 1;
- $foundHeaderEnding = 1;
- # The "git diff" command includes a line of the form "Binary files
- # <path1> and <path2> differ" if the --binary flag is not used.
- } elsif (/^Binary files / ) {
- die("Error: the Git diff contains a binary file without the binary data in ".
- "line: \"$_\". Be sure to use the --binary flag when invoking \"git diff\" ".
- "with diffs containing binary files.");
- }
- $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
- $_ = <$fileHandle>; # Not defined if end-of-file reached.
- last if (!defined($_) || /$gitDiffStartRegEx/ || $foundHeaderEnding);
- }
- my $executableBitDelta = $newExecutableBit - $oldExecutableBit;
- my %header;
- $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
- $header{executableBitDelta} = $executableBitDelta if $executableBitDelta;
- $header{indexPath} = $indexPath;
- $header{isBinary} = $isBinary if $isBinary;
- $header{isCopyWithChanges} = 1 if ($copiedFromPath && ($similarityIndex != 100 || $executableBitDelta));
- $header{isDeletion} = $isDeletion if $isDeletion;
- $header{isNew} = $isNew if $isNew;
- $header{shouldDeleteSource} = $shouldDeleteSource if $shouldDeleteSource;
- $header{svnConvertedText} = $svnConvertedText;
- return (\%header, $_);
- }
- # Parse the next SVN diff header from the given file handle, and advance
- # the handle so the last line read is the first line after the header.
- #
- # This subroutine dies if given leading junk or if it could not detect
- # the end of the header block.
- #
- # Args:
- # $fileHandle: advanced so the last line read from the handle is the first
- # line of the header to parse. This should be a line
- # beginning with "Index:".
- # $line: the line last read from $fileHandle
- #
- # Returns ($headerHashRef, $lastReadLine):
- # $headerHashRef: a hash reference representing a diff header, as follows--
- # copiedFromPath: the path from which the file was copied if the diff
- # is a copy.
- # indexPath: the path of the target file, which is the path found in
- # the "Index:" line.
- # isBinary: the value 1 if the diff is for a binary file.
- # isNew: the value 1 if the diff is for a new file.
- # sourceRevision: the revision number of the source, if it exists. This
- # is the same as the revision number the file was copied
- # from, in the case of a file copy.
- # svnConvertedText: the header text converted to a header with the paths
- # in some lines corrected.
- # $lastReadLine: the line last read from $fileHandle.
- sub parseSvnDiffHeader($$)
- {
- my ($fileHandle, $line) = @_;
- $_ = $line;
- my $indexPath;
- if (/$svnDiffStartRegEx/) {
- $indexPath = adjustPathForRecentRenamings($1);
- } else {
- die("First line of SVN diff does not begin with \"Index \": \"$_\"");
- }
- my $copiedFromPath;
- my $foundHeaderEnding;
- my $isBinary;
- my $isNew;
- my $sourceRevision;
- my $svnConvertedText;
- while (1) {
- # Temporarily strip off any end-of-line characters to simplify
- # regex matching below.
- s/([\n\r]+)$//;
- my $eol = $1;
- # Fix paths on "---" and "+++" lines to match the leading
- # index line.
- if (s/^--- [^\t\n\r]+/--- $indexPath/) {
- # ---
- if (/^--- .+\(revision (\d+)\)/) {
- $sourceRevision = $1;
- $isNew = 1 if !$sourceRevision; # if revision 0.
- if (/\(from (\S+):(\d+)\)$/) {
- # The "from" clause is created by svn-create-patch, in
- # which case there is always also a "revision" clause.
- $copiedFromPath = $1;
- die("Revision number \"$2\" in \"from\" clause does not match " .
- "source revision number \"$sourceRevision\".") if ($2 != $sourceRevision);
- }
- }
- } elsif (s/^\+\+\+ [^\t\n\r]+/+++ $indexPath/ || $isBinary && /^$/) {
- $foundHeaderEnding = 1;
- } elsif (/^Cannot display: file marked as a binary type.$/) {
- $isBinary = 1;
- # SVN 1.7 has an unusual display format for a binary diff. It repeats the first
- # two lines of the diff header. For example:
- # Index: test_file.swf
- # ===================================================================
- # Cannot display: file marked as a binary type.
- # svn:mime-type = application/octet-stream
- # Index: test_file.swf
- # ===================================================================
- # --- test_file.swf
- # +++ test_file.swf
- #
- # ...
- # Q1dTBx0AAAB42itg4GlgYJjGwMDDyODMxMDw34GBgQEAJPQDJA==
- # Therefore, we continue reading the diff header until we either encounter a line
- # that begins with "+++" (SVN 1.7 or greater) or an empty line (SVN version less
- # than 1.7).
- }
- $svnConvertedText .= "$_$eol"; # Also restore end-of-line characters.
- $_ = <$fileHandle>; # Not defined if end-of-file reached.
- last if (!defined($_) || !$isBinary && /$svnDiffStartRegEx/ || $foundHeaderEnding);
- }
- if (!$foundHeaderEnding) {
- die("Did not find end of header block corresponding to index path \"$indexPath\".");
- }
- my %header;
- $header{copiedFromPath} = $copiedFromPath if $copiedFromPath;
- $header{indexPath} = $indexPath;
- $header{isBinary} = $isBinary if $isBinary;
- $header{isNew} = $isNew if $isNew;
- $header{sourceRevision} = $sourceRevision if $sourceRevision;
- $header{svnConvertedText} = $svnConvertedText;
- return (\%header, $_);
- }
- # Parse the next diff header from the given file handle, and advance
- # the handle so the last line read is the first line after the header.
- #
- # This subroutine dies if given leading junk or if it could not detect
- # the end of the header block.
- #
- # Args:
- # $fileHandle: advanced so the last line read from the handle is the first
- # line of the header to parse. For SVN-formatted diffs, this
- # is a line beginning with "Index:". For Git, this is a line
- # beginning with "diff --git".
- # $line: the line last read from $fileHandle
- #
- # Returns ($headerHashRef, $lastReadLine):
- # $headerHashRef: a hash reference representing a diff header
- # copiedFromPath: the path from which the file was copied if the diff
- # is a copy.
- # executableBitDelta: the value 1 or -1 if the executable bit was added or
- # removed, respectively. New and deleted files have
- # this value only if the file is executable, in which
- # case the value is 1 and -1, respectively.
- # indexPath: the path of the target file.
- # isBinary: the value 1 if the diff is for a binary file.
- # isGit: the value 1 if the diff is Git-formatted.
- # isSvn: the value 1 if the diff is SVN-formatted.
- # sourceRevision: the revision number of the source, if it exists. This
- # is the same as the revision number the file was copied
- # from, in the case of a file copy.
- # svnConvertedText: the header text with some lines converted to SVN
- # format. Git-specific lines are preserved.
- # $lastReadLine: the line last read from $fileHandle.
- sub parseDiffHeader($$)
- {
- my ($fileHandle, $line) = @_;
- my $header; # This is a hash ref.
- my $isGit;
- my $isSvn;
- my $lastReadLine;
- if ($line =~ $svnDiffStartRegEx) {
- $isSvn = 1;
- ($header, $lastReadLine) = parseSvnDiffHeader($fileHandle, $line);
- } elsif ($line =~ $gitDiffStartRegEx) {
- $isGit = 1;
- ($header, $lastReadLine) = parseGitDiffHeader($fileHandle, $line);
- } else {
- die("First line of diff does not begin with \"Index:\" or \"diff --git\": \"$line\"");
- }
- $header->{isGit} = $isGit if $isGit;
- $header->{isSvn} = $isSvn if $isSvn;
- return ($header, $lastReadLine);
- }
- # FIXME: The %diffHash "object" should not have an svnConvertedText property.
- # Instead, the hash object should store its information in a
- # structured way as properties. This should be done in a way so
- # that, if necessary, the text of an SVN or Git patch can be
- # reconstructed from the information in those hash properties.
- #
- # A %diffHash is a hash representing a source control diff of a single
- # file operation (e.g. a file modification, copy, or delete).
- #
- # These hashes appear, for example, in the parseDiff(), parsePatch(),
- # and prepareParsedPatch() subroutines of this package.
- #
- # The corresponding values are--
- #
- # copiedFromPath: the path from which the file was copied if the diff
- # is a copy.
- # executableBitDelta: the value 1 or -1 if the executable bit was added or
- # removed from the target file, respectively.
- # indexPath: the path of the target file. For SVN-formatted diffs,
- # this is the same as the path in the "Index:" line.
- # isBinary: the value 1 if the diff is for a binary file.
- # isDeletion: the value 1 if the diff is known from the header to be a deletion.
- # isGit: the value 1 if the diff is Git-formatted.
- # isNew: the value 1 if the dif is known from the header to be a new file.
- # isSvn: the value 1 if the diff is SVN-formatted.
- # sourceRevision: the revision number of the source, if it exists. This
- # is the same as the revision number the file was copied
- # from, in the case of a file copy.
- # svnConvertedText: the diff with some lines converted to SVN format.
- # Git-specific lines are preserved.
- # Parse one diff from a patch file created by svn-create-patch, and
- # advance the file handle so the last line read is the first line
- # of the next header block.
- #
- # This subroutine preserves any leading junk encountered before the header.
- #
- # Composition of an SVN diff
- #
- # There are three parts to an SVN diff: the header, the property change, and
- # the binary contents, in that order. Either the header or the property change
- # may be ommitted, but not both. If there are binary changes, then you always
- # have all three.
- #
- # Args:
- # $fileHandle: a file handle advanced to the first line of the next
- # header block. Leading junk is okay.
- # $line: the line last read from $fileHandle.
- # $optionsHashRef: a hash reference representing optional options to use
- # when processing a diff.
- # shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
- # instead of the line endings in the target file; the
- # value of 1 if svnConvertedText should use the line
- # endings in the diff.
- #
- # Returns ($diffHashRefs, $lastReadLine):
- # $diffHashRefs: A reference to an array of references to %diffHash hashes.
- # See the %diffHash documentation above.
- # $lastReadLine: the line last read from $fileHandle
- sub parseDiff($$;$)
- {
- # FIXME: Adjust this method so that it dies if the first line does not
- # match the start of a diff. This will require a change to
- # parsePatch() so that parsePatch() skips over leading junk.
- my ($fileHandle, $line, $optionsHashRef) = @_;
- my $headerStartRegEx = $svnDiffStartRegEx; # SVN-style header for the default
- my $headerHashRef; # Last header found, as returned by parseDiffHeader().
- my $svnPropertiesHashRef; # Last SVN properties diff found, as returned by parseSvnDiffProperties().
- my $svnText;
- my $indexPathEOL;
- my $numTextChunks = 0;
- while (defined($line)) {
- if (!$headerHashRef && ($line =~ $gitDiffStartRegEx)) {
- # Then assume all diffs in the patch are Git-formatted. This
- # block was made to be enterable at most once since we assume
- # all diffs in the patch are formatted the same (SVN or Git).
- $headerStartRegEx = $gitDiffStartRegEx;
- }
- if ($line =~ $svnPropertiesStartRegEx) {
- my $propertyPath = $1;
- if ($svnPropertiesHashRef || $headerHashRef && ($propertyPath ne $headerHashRef->{indexPath})) {
- # This is the start of the second diff in the while loop, which happens to
- # be a property diff. If $svnPropertiesHasRef is defined, then this is the
- # second consecutive property diff, otherwise it's the start of a property
- # diff for a file that only has property changes.
- last;
- }
- ($svnPropertiesHashRef, $line) = parseSvnDiffProperties($fileHandle, $line);
- next;
- }
- if ($line !~ $headerStartRegEx) {
- # Then we are in the body of the diff.
- my $isChunkRange = defined(parseChunkRange($line));
- $numTextChunks += 1 if $isChunkRange;
- my $nextLine = <$fileHandle>;
- my $willAddNewLineAtEndOfFile = defined($nextLine) && $nextLine =~ /^\\ No newline at end of file$/;
- if ($willAddNewLineAtEndOfFile) {
- # Diff(1) always emits a LF character preceeding the line "\ No newline at end of file".
- # We must preserve both the added LF character and the line ending of this sentinel line
- # or patch(1) will complain.
- $svnText .= $line . $nextLine;
- $line = <$fileHandle>;
- next;
- }
- if ($indexPathEOL && !$isChunkRange) {
- # The chunk range is part of the body of the diff, but its line endings should't be
- # modified or patch(1) will complain. So, we only modify non-chunk range lines.
- $line =~ s/\r\n|\r|\n/$indexPathEOL/g;
- }
- $svnText .= $line;
- $line = $nextLine;
- next;
- } # Otherwise, we found a diff header.
- if ($svnPropertiesHashRef || $headerHashRef) {
- # Then either we just processed an SVN property change or this
- # is the start of the second diff header of this while loop.
- last;
- }
- ($headerHashRef, $line) = parseDiffHeader($fileHandle, $line);
- if (!$optionsHashRef || !$optionsHashRef->{shouldNotUseIndexPathEOL}) {
- # FIXME: We shouldn't query the file system (via firstEOLInFile()) to determine the
- # line endings of the file indexPath. Instead, either the caller to parseDiff()
- # should provide this information or parseDiff() should take a delegate that it
- # can use to query for this information.
- $indexPathEOL = firstEOLInFile($headerHashRef->{indexPath}) if !$headerHashRef->{isNew} && !$headerHashRef->{isBinary};
- }
- $svnText .= $headerHashRef->{svnConvertedText};
- }
- my @diffHashRefs;
- if ($headerHashRef->{shouldDeleteSource}) {
- my %deletionHash;
- $deletionHash{indexPath} = $headerHashRef->{copiedFromPath};
- $deletionHash{isDeletion} = 1;
- push @diffHashRefs, \%deletionHash;
- }
- if ($headerHashRef->{copiedFromPath}) {
- my %copyHash;
- $copyHash{copiedFromPath} = $headerHashRef->{copiedFromPath};
- $copyHash{indexPath} = $headerHashRef->{indexPath};
- $copyHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
- if ($headerHashRef->{isSvn}) {
- $copyHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
- }
- push @diffHashRefs, \%copyHash;
- }
- # Note, the order of evaluation for the following if conditional has been explicitly chosen so that
- # it evaluates to false when there is no headerHashRef (e.g. a property change diff for a file that
- # only has property changes).
- if ($headerHashRef->{isCopyWithChanges} || (%$headerHashRef && !$headerHashRef->{copiedFromPath})) {
- # Then add the usual file modification.
- my %diffHash;
- # FIXME: We should expand this code to support other properties. In the future,
- # parseSvnDiffProperties may return a hash whose keys are the properties.
- if ($headerHashRef->{isSvn}) {
- # SVN records the change to the executable bit in a separate property change diff
- # that follows the contents of the diff, except for binary diffs. For binary
- # diffs, the property change diff follows the diff header.
- $diffHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
- } elsif ($headerHashRef->{isGit}) {
- # Git records the change to the executable bit in the header of a diff.
- $diffHash{executableBitDelta} = $headerHashRef->{executableBitDelta} if $headerHashRef->{executableBitDelta};
- }
- $diffHash{indexPath} = $headerHashRef->{indexPath};
- $diffHash{isBinary} = $headerHashRef->{isBinary} if $headerHashRef->{isBinary};
- $diffHash{isDeletion} = $headerHashRef->{isDeletion} if $headerHashRef->{isDeletion};
- $diffHash{isGit} = $headerHashRef->{isGit} if $headerHashRef->{isGit};
- $diffHash{isNew} = $headerHashRef->{isNew} if $headerHashRef->{isNew};
- $diffHash{isSvn} = $headerHashRef->{isSvn} if $headerHashRef->{isSvn};
- if (!$headerHashRef->{copiedFromPath}) {
- # If the file was copied, then we have already incorporated the
- # sourceRevision information into the change.
- $diffHash{sourceRevision} = $headerHashRef->{sourceRevision} if $headerHashRef->{sourceRevision};
- }
- # FIXME: Remove the need for svnConvertedText. See the %diffHash
- # code comments above for more information.
- #
- # Note, we may not always have SVN converted text since we intend
- # to deprecate it in the future. For example, a property change
- # diff for a file that only has property changes will not return
- # any SVN converted text.
- $diffHash{svnConvertedText} = $svnText if $svnText;
- $diffHash{numTextChunks} = $numTextChunks if $svnText && !$headerHashRef->{isBinary};
- push @diffHashRefs, \%diffHash;
- }
- if (!%$headerHashRef && $svnPropertiesHashRef) {
- # A property change diff for a file that only has property changes.
- my %propertyChangeHash;
- $propertyChangeHash{executableBitDelta} = $svnPropertiesHashRef->{executableBitDelta} if $svnPropertiesHashRef->{executableBitDelta};
- $propertyChangeHash{indexPath} = $svnPropertiesHashRef->{propertyPath};
- $propertyChangeHash{isSvn} = 1;
- push @diffHashRefs, \%propertyChangeHash;
- }
- return (\@diffHashRefs, $line);
- }
- # Parse an SVN property change diff from the given file handle, and advance
- # the handle so the last line read is the first line after this diff.
- #
- # For the case of an SVN binary diff, the binary contents will follow the
- # the property changes.
- #
- # This subroutine dies if the first line does not begin with "Property changes on"
- # or if the separator line that follows this line is missing.
- #
- # Args:
- # $fileHandle: advanced so the last line read from the handle is the first
- # line of the footer to parse. This line begins with
- # "Property changes on".
- # $line: the line last read from $fileHandle.
- #
- # Returns ($propertyHashRef, $lastReadLine):
- # $propertyHashRef: a hash reference representing an SVN diff footer.
- # propertyPath: the path of the target file.
- # executableBitDelta: the value 1 or -1 if the executable bit was added or
- # removed from the target file, respectively.
- # $lastReadLine: the line last read from $fileHandle.
- sub parseSvnDiffProperties($$)
- {
- my ($fileHandle, $line) = @_;
- $_ = $line;
- my %footer;
- if (/$svnPropertiesStartRegEx/) {
- $footer{propertyPath} = $1;
- } else {
- die("Failed to find start of SVN property change, \"Property changes on \": \"$_\"");
- }
- # We advance $fileHandle two lines so that the next line that
- # we process is $svnPropertyStartRegEx in a well-formed footer.
- # A well-formed footer has the form:
- # Property changes on: FileA
- # ___________________________________________________________________
- # Added: svn:executable
- # + *
- $_ = <$fileHandle>; # Not defined if end-of-file reached.
- my $separator = "_" x 67;
- if (defined($_) && /^$separator[\r\n]+$/) {
- $_ = <$fileHandle>;
- } else {
- die("Failed to find separator line: \"$_\".");
- }
- # FIXME: We should expand this to support other SVN properties
- # (e.g. return a hash of property key-values that represents
- # all properties).
- #
- # Notice, we keep processing until we hit end-of-file or some
- # line that does not resemble $svnPropertyStartRegEx, such as
- # the empty line that precedes the start of the binary contents
- # of a patch, or the start of the next diff (e.g. "Index:").
- my $propertyHashRef;
- while (defined($_) && /$svnPropertyStartRegEx/) {
- ($propertyHashRef, $_) = parseSvnProperty($fileHandle, $_);
- if ($propertyHashRef->{name} eq "svn:executable") {
- # Notice, for SVN properties, propertyChangeDelta is always non-zero
- # because a property can only be added or removed.
- $footer{executableBitDelta} = $propertyHashRef->{propertyChangeDelta};
- }
- }
- return(\%footer, $_);
- }
- # Parse the next SVN property from the given file handle, and advance the handle so the last
- # line read is the first line after the property.
- #
- # This subroutine dies if the first line is not a valid start of an SVN property,
- # or the property is missing a value, or the property change type (e.g. "Added")
- # does not correspond to the property value type (e.g. "+").
- #
- # Args:
- # $fileHandle: advanced so the last line read from the handle is the first
- # line of the property to parse. This should be a line
- # that matches $svnPropertyStartRegEx.
- # $line: the line last read from $fileHandle.
- #
- # Returns ($propertyHashRef, $lastReadLine):
- # $propertyHashRef: a hash reference representing a SVN property.
- # name: the name of the property.
- # value: the last property value. For instance, suppose the property is "Modified".
- # Then it has both a '-' and '+' property value in that order. Therefore,
- # the value of this key is the value of the '+' property by ordering (since
- # it is the last value).
- # propertyChangeDelta: the value 1 or -1 if the property was added or
- # removed, respectively.
- # $lastReadLine: the line last read from $fileHandle.
- sub parseSvnProperty($$)
- {
- my ($fileHandle, $line) = @_;
- $_ = $line;
- my $propertyName;
- my $propertyChangeType;
- if (/$svnPropertyStartRegEx/) {
- $propertyChangeType = $1;
- $propertyName = $2;
- } else {
- die("Failed to find SVN property: \"$_\".");
- }
- $_ = <$fileHandle>; # Not defined if end-of-file reached.
- if (defined($_) && defined(parseChunkRange($_, "##"))) {
- # FIXME: We should validate the chunk range line that is part of an SVN 1.7
- # property diff. For now, we ignore this line.
- $_ = <$fileHandle>;
- }
- # The "svn diff" command neither inserts newline characters between property values
- # nor between successive properties.
- #
- # As of SVN 1.7, "svn diff" may insert "\ No newline at end of property" after a
- # property value that doesn't end in a newline.
- #
- # FIXME: We do not support property values that contain tailing newline characters
- # as it is difficult to disambiguate these trailing newlines from the empty
- # line that precedes the contents of a binary patch.
- my $propertyValue;
- my $propertyValueType;
- while (defined($_) && /$svnPropertyValueStartRegEx/) {
- # Note, a '-' property may be followed by a '+' property in the case of a "Modified"
- # or "Name" property. We only care about the ending value (i.e. the '+' property)
- # in such circumstances. So, we take the property value for the property to be its
- # last parsed property value.
- #
- # FIXME: We may want to consider strictly enforcing a '-', '+' property ordering or
- # add error checking to prevent '+', '+', ..., '+' and other invalid combinations.
- $propertyValueType = $1;
- ($propertyValue, $_) = parseSvnPropertyValue($fileHandle, $_);
- $_ = <$fileHandle> if defined($_) && /$svnPropertyValueNoNewlineRegEx/;
- }
- if (!$propertyValue) {
- die("Failed to find the property value for the SVN property \"$propertyName\": \"$_\".");
- }
- my $propertyChangeDelta;
- if ($propertyValueType eq "+" || $propertyValueType eq "Merged") {
- $propertyChangeDelta = 1;
- } elsif ($propertyValueType eq "-" || $propertyValueType eq "Reverse-merged") {
- $propertyChangeDelta = -1;
- } else {
- die("Not reached.");
- }
- # We perform a simple validation that an "Added" or "Deleted" property
- # change type corresponds with a "+" and "-" value type, respectively.
- my $expectedChangeDelta;
- if ($propertyChangeType eq "Added") {
- $expectedChangeDelta = 1;
- } elsif ($propertyChangeType eq "Deleted") {
- $expectedChangeDelta = -1;
- }
- if ($expectedChangeDelta && $propertyChangeDelta != $expectedChangeDelta) {
- die("The final property value type found \"$propertyValueType\" does not " .
- "correspond to the property change type found \"$propertyChangeType\".");
- }
- my %propertyHash;
- $propertyHash{name} = $propertyName;
- $propertyHash{propertyChangeDelta} = $propertyChangeDelta;
- $propertyHash{value} = $propertyValue;
- return (\%propertyHash, $_);
- }
- # Parse the value of an SVN property from the given file handle, and advance
- # the handle so the last line read is the first line after the property value.
- #
- # This subroutine dies if the first line is an invalid SVN property value line
- # (i.e. a line that does not begin with " +" or " -").
- #
- # Args:
- # $fileHandle: advanced so the last line read from the handle is the first
- # line of the property value to parse. This should be a line
- # beginning with " +" or " -".
- # $line: the line last read from $fileHandle.
- #
- # Returns ($propertyValue, $lastReadLine):
- # $propertyValue: the value of the property.
- # $lastReadLine: the line last read from $fileHandle.
- sub parseSvnPropertyValue($$)
- {
- my ($fileHandle, $line) = @_;
- $_ = $line;
- my $propertyValue;
- my $eol;
- if (/$svnPropertyValueStartRegEx/) {
- $propertyValue = $2; # Does not include the end-of-line character(s).
- $eol = $POSTMATCH;
- } else {
- die("Failed to find property value beginning with '+', '-', 'Merged', or 'Reverse-merged': \"$_\".");
- }
- while (<$fileHandle>) {
- if (/^[\r\n]+$/ || /$svnPropertyValueStartRegEx/ || /$svnPropertyStartRegEx/ || /$svnPropertyValueNoNewlineRegEx/) {
- # Note, we may encounter an empty line before the contents of a binary patch.
- # Also, we check for $svnPropertyValueStartRegEx because a '-' property may be
- # followed by a '+' property in the case of a "Modified" or "Name" property.
- # We check for $svnPropertyStartRegEx because it indicates the start of the
- # next property to parse.
- last;
- }
- # Temporarily strip off any end-of-line characters. We add the end-of-line characters
- # from the previously processed line to the start of this line so that the last line
- # of the property value does not end in end-of-line characters.
- s/([\n\r]+)$//;
- $propertyValue .= "$eol$_";
- $eol = $1;
- }
- return ($propertyValue, $_);
- }
- # Parse a patch file created by svn-create-patch.
- #
- # Args:
- # $fileHandle: A file handle to the patch file that has not yet been
- # read from.
- # $optionsHashRef: a hash reference representing optional options to use
- # when processing a diff.
- # shouldNotUseIndexPathEOL: whether to use the line endings in the diff instead
- # instead of the line endings in the target file; the
- # value of 1 if svnConvertedText should use the line
- # endings in the diff.
- #
- # Returns:
- # @diffHashRefs: an array of diff hash references.
- # See the %diffHash documentation above.
- sub parsePatch($;$)
- {
- my ($fileHandle, $optionsHashRef) = @_;
- my $newDiffHashRefs;
- my @diffHashRefs; # return value
- my $line = <$fileHandle>;
- while (defined($line)) { # Otherwise, at EOF.
- ($newDiffHashRefs, $line) = parseDiff($fileHandle, $line, $optionsHashRef);
- push @diffHashRefs, @$newDiffHashRefs;
- }
- return @diffHashRefs;
- }
- # Prepare the results of parsePatch() for use in svn-apply and svn-unapply.
- #
- # Args:
- # $shouldForce: Whether to continue processing if an unexpected
- # state occurs.
- # @diffHashRefs: An array of references to %diffHashes.
- # See the %diffHash documentation above.
- #
- # Returns $preparedPatchHashRef:
- # copyDiffHashRefs: A reference to an array of the $diffHashRefs in
- # @diffHashRefs that represent file copies. The original
- # ordering is preserved.
- # nonCopyDiffHashRefs: A reference to an array of the $diffHashRefs in
- # @diffHashRefs that do not represent file copies.
- # The original ordering is preserved.
- # sourceRevisionHash: A reference to a hash of source path to source
- # revision number.
- sub prepareParsedPatch($@)
- {
- my ($shouldForce, @diffHashRefs) = @_;
- my %copiedFiles;
- # Return values
- my @copyDiffHashRefs = ();
- my @nonCopyDiffHashRefs = ();
- my %sourceRevisionHash = ();
- for my $diffHashRef (@diffHashRefs) {
- my $copiedFromPath = $diffHashRef->{copiedFromPath};
- my $indexPath = $diffHashRef->{indexPath};
- my $sourceRevision = $diffHashRef->{sourceRevision};
- my $sourcePath;
- if (defined($copiedFromPath)) {
- # Then the diff is a copy operation.
- $sourcePath = $copiedFromPath;
- # FIXME: Consider printing a warning or exiting if
- # exists($copiedFiles{$indexPath}) is true -- i.e. if
- # $indexPath appears twice as a copy target.
- $copiedFiles{$indexPath} = $sourcePath;
- push @copyDiffHashRefs, $diffHashRef;
- } else {
- # Then the diff is not a copy operation.
- $sourcePath = $indexPath;
- push @nonCopyDiffHashRefs, $diffHashRef;
- }
- if (defined($sourceRevision)) {
- if (exists($sourceRevisionHash{$sourcePath}) &&
- ($sourceRevisionHash{$sourcePath} != $sourceRevision)) {
- if (!$shouldForce) {
- die "Two revisions of the same file required as a source:\n".
- " $sourcePath:$sourceRevisionHash{$sourcePath}\n".
- " $sourcePath:$sourceRevision";
- }
- }
- $sourceRevisionHash{$sourcePath} = $sourceRevision;
- }
- }
- my %preparedPatchHash;
- $preparedPatchHash{copyDiffHashRefs} = \@copyDiffHashRefs;
- $preparedPatchHash{nonCopyDiffHashRefs} = \@nonCopyDiffHashRefs;
- $preparedPatchHash{sourceRevisionHash} = \%sourceRevisionHash;
- return \%preparedPatchHash;
- }
- # Return localtime() for the project's time zone, given an integer time as
- # returned by Perl's time() function.
- sub localTimeInProjectTimeZone($)
- {
- my $epochTime = shift;
- # Change the time zone temporarily for the localtime() call.
- my $savedTimeZone = $ENV{'TZ'};
- $ENV{'TZ'} = $changeLogTimeZone;
- my @localTime = localtime($epochTime);
- if (defined $savedTimeZone) {
- $ENV{'TZ'} = $savedTimeZone;
- } else {
- delete $ENV{'TZ'};
- }
- return @localTime;
- }
- # Set the reviewer and date in a ChangeLog patch, and return the new patch.
- #
- # Args:
- # $patch: a ChangeLog patch as a string.
- # $reviewer: the name of the reviewer, or undef if the reviewer should not be set.
- # $epochTime: an integer time as returned by Perl's time() function.
- sub setChangeLogDateAndReviewer($$$)
- {
- my ($patch, $reviewer, $epochTime) = @_;
- my @localTime = localTimeInProjectTimeZone($epochTime);
- my $newDate = strftime("%Y-%m-%d", @localTime);
- my $firstChangeLogLineRegEx = qr#(\n\+)\d{4}-[^-]{2}-[^-]{2}( )#;
- $patch =~ s/$firstChangeLogLineRegEx/$1$newDate$2/;
- if (defined($reviewer)) {
- # We include a leading plus ("+") in the regular expression to make
- # the regular expression less likely to match text in the leading junk
- # for the patch, if the patch has leading junk.
- $patch =~ s/(\n\+.*)NOBODY \(OOPS!\)/$1$reviewer/;
- }
- return $patch;
- }
- # If possible, returns a ChangeLog patch equivalent to the given one,
- # but with the newest ChangeLog entry inserted at the top of the
- # file -- i.e. no leading context and all lines starting with "+".
- #
- # If given a patch string not representable as a patch with the above
- # properties, it returns the input back unchanged.
- #
- # WARNING: This subroutine can return an inequivalent patch string if
- # both the beginning of the new ChangeLog file matches the beginning
- # of the source ChangeLog, and the source beginning was modified.
- # Otherwise, it is guaranteed to return an equivalent patch string,
- # if it returns.
- #
- # Applying this subroutine to ChangeLog patches allows svn-apply to
- # insert new ChangeLog entries at the top of the ChangeLog file.
- # svn-apply uses patch with --fuzz=3 to do this. We need to apply
- # this subroutine because the diff(1) command is greedy when matching
- # lines. A new ChangeLog entry with the same date and author as the
- # previous will match and cause the diff to have lines of starting
- # context.
- #
- # This subroutine has unit tests in VCSUtils_unittest.pl.
- #
- # Returns $changeLogHashRef:
- # $changeLogHashRef: a hash reference representing a change log patch.
- # patch: a ChangeLog patch equivalent to the given one, but with the
- # newest ChangeLog entry inserted at the top of the file, if possible.
- sub fixChangeLogPatch($)
- {
- my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
- $patch =~ s|test_expectations.txt:|TestExpectations:|g;
- $patch =~ /(\r?\n)/;
- my $lineEnding = $1;
- my @lines = split(/$lineEnding/, $patch);
- my $i = 0; # We reuse the same index throughout.
- # Skip to beginning of first chunk.
- for (; $i < @lines; ++$i) {
- if (substr($lines[$i], 0, 1) eq "@") {
- last;
- }
- }
- my $chunkStartIndex = ++$i;
- my %changeLogHashRef;
- # Optimization: do not process if new lines already begin the chunk.
- if (substr($lines[$i], 0, 1) eq "+") {
- $changeLogHashRef{patch} = $patch;
- return \%changeLogHashRef;
- }
- # Skip to first line of newly added ChangeLog entry.
- # For example, +2009-06-03 Eric Seidel <eric@webkit.org>
- my $dateStartRegEx = '^\+(\d{4}-\d{2}-\d{2})' # leading "+" and date
- . '\s+(.+)\s+' # name
- . '<([^<>]+)>$'; # e-mail address
- for (; $i < @lines; ++$i) {
- my $line = $lines[$i];
- my $firstChar = substr($line, 0, 1);
- if ($line =~ /$dateStartRegEx/) {
- last;
- } elsif ($firstChar eq " " or $firstChar eq "+") {
- next;
- }
- $changeLogHashRef{patch} = $patch; # Do not change if, for example, "-" or "@" found.
- return \%changeLogHashRef;
- }
- if ($i >= @lines) {
- $changeLogHashRef{patch} = $patch; # Do not change if date not found.
- return \%changeLogHashRef;
- }
- my $dateStartIndex = $i;
- # Rewrite overlapping lines to lead with " ".
- my @overlappingLines = (); # These will include a leading "+".
- for (; $i < @lines; ++$i) {
- my $line = $lines[$i];
- if (substr($line, 0, 1) ne "+") {
- last;
- }
- push(@overlappingLines, $line);
- $lines[$i] = " " . substr($line, 1);
- }
- # Remove excess ending context, if necessary.
- my $shouldTrimContext = 1;
- for (; $i < @lines; ++$i) {
- my $firstChar = substr($lines[$i], 0, 1);
- if ($firstChar eq " ") {
- next;
- } elsif ($firstChar eq "@") {
- last;
- }
- $shouldTrimContext = 0; # For example, if "+" or "-" encountered.
- last;
- }
- my $deletedLineCount = 0;
- if ($shouldTrimContext) { # Also occurs if end of file reached.
- splice(@lines, $i - @overlappingLines, @overlappingLines);
- $deletedLineCount = @overlappingLines;
- }
- # Work backwards, shifting overlapping lines towards front
- # while checking that patch stays equivalent.
- for ($i = $dateStartIndex - 1; @overlappingLines && $i >= $chunkStartIndex; --$i) {
- my $line = $lines[$i];
- if (substr($line, 0, 1) ne " ") {
- next;
- }
- my $text = substr($line, 1);
- my $newLine = pop(@overlappingLines);
- if ($text ne substr($newLine, 1)) {
- $changeLogHashRef{patch} = $patch; # Unexpected difference.
- return \%changeLogHashRef;
- }
- $lines[$i] = "+$text";
- }
- # If @overlappingLines > 0, this is where we make use of the
- # assumption that the beginning of the source file was not modified.
- splice(@lines, $chunkStartIndex, 0, @overlappingLines);
- # Update the date start index as it may have changed after shifting
- # the overlapping lines towards the front.
- for ($i = $chunkStartIndex; $i < $dateStartIndex; ++$i) {
- $dateStartIndex = $i if $lines[$i] =~ /$dateStartRegEx/;
- }
- splice(@lines, $chunkStartIndex, $dateStartIndex - $chunkStartIndex); # Remove context of later entry.
- $deletedLineCount += $dateStartIndex - $chunkStartIndex;
- # Update the initial chunk range.
- my $chunkRangeHashRef = parseChunkRange($lines[$chunkStartIndex - 1]);
- if (!$chunkRangeHashRef) {
- # FIXME: Handle errors differently from ChangeLog files that
- # are okay but should not be altered. That way we can find out
- # if improvements to the script ever become necessary.
- $changeLogHashRef{patch} = $patch; # Error: unexpected patch string format.
- return \%changeLogHashRef;
- }
- my $oldSourceLineCount = $chunkRangeHashRef->{lineCount};
- my $oldTargetLineCount = $chunkRangeHashRef->{newLineCount};
- my $sourceLineCount = $oldSourceLineCount + @overlappingLines - $deletedLineCount;
- my $targetLineCount = $oldTargetLineCount + @overlappingLines - $deletedLineCount;
- $lines[$chunkStartIndex - 1] = "@@ -1,$sourceLineCount +1,$targetLineCount @@";
- $changeLogHashRef{patch} = join($lineEnding, @lines) . "\n"; # patch(1) expects an extra trailing newline.
- return \%changeLogHashRef;
- }
- # This is a supporting method for runPatchCommand.
- #
- # Arg: the optional $args parameter passed to runPatchCommand (can be undefined).
- #
- # Returns ($patchCommand, $isForcing).
- #
- # This subroutine has unit tests in VCSUtils_unittest.pl.
- sub generatePatchCommand($)
- {
- my ($passedArgsHashRef) = @_;
- my $argsHashRef = { # Defaults
- ensureForce => 0,
- shouldReverse => 0,
- options => []
- };
-
- # Merges hash references. It's okay here if passed hash reference is undefined.
- @{$argsHashRef}{keys %{$passedArgsHashRef}} = values %{$passedArgsHashRef};
-
- my $ensureForce = $argsHashRef->{ensureForce};
- my $shouldReverse = $argsHashRef->{shouldReverse};
- my $options = $argsHashRef->{options};
- if (! $options) {
- $options = [];
- } else {
- $options = [@{$options}]; # Copy to avoid side effects.
- }
- my $isForcing = 0;
- if (grep /^--force$/, @{$options}) {
- $isForcing = 1;
- } elsif ($ensureForce) {
- push @{$options}, "--force";
- $isForcing = 1;
- }
- if ($shouldReverse) { # No check: --reverse should never be passed explicitly.
- push @{$options}, "--reverse";
- }
- @{$options} = sort(@{$options}); # For easier testing.
- my $patchCommand = join(" ", "patch -p0", @{$options});
- return ($patchCommand, $isForcing);
- }
- # Apply the given patch using the patch(1) command.
- #
- # On success, return the resulting exit status. Otherwise, exit with the
- # exit status. If "--force" is passed as an option, however, then never
- # exit and always return the exit status.
- #
- # Args:
- # $patch: a patch string.
- # $repositoryRootPath: an absolute path to the repository root.
- # $pathRelativeToRoot: the path of the file to be patched, relative to the
- # repository root. This should normally be the path
- # found in the patch's "Index:" line. It is passed
- # explicitly rather than reparsed from the patch
- # string for optimization purposes.
- # This is used only for error reporting. The
- # patch command gleans the actual file to patch
- # from the patch string.
- # $args: a reference to a hash of optional arguments. The possible
- # keys are --
- # ensureForce: whether to ensure --force is passed (defaults to 0).
- # shouldReverse: whether to pass --reverse (defaults to 0).
- # options: a reference to an array of options to pass to the
- # patch command. The subroutine passes the -p0 option
- # no matter what. This should not include --reverse.
- #
- # This subroutine has unit tests in VCSUtils_unittest.pl.
- sub runPatchCommand($$$;$)
- {
- my ($patch, $repositoryRootPath, $pathRelativeToRoot, $args) = @_;
- my ($patchCommand, $isForcing) = generatePatchCommand($args);
- # Temporarily change the working directory since the path found
- # in the patch's "Index:" line is relative to the repository root
- # (i.e. the same as $pathRelativeToRoot).
- my $cwd = Cwd::getcwd();
- chdir $repositoryRootPath;
- open PATCH, "| $patchCommand" or die "Could not call \"$patchCommand\" for file \"$pathRelativeToRoot\": $!";
- print PATCH $patch;
- close PATCH;
- my $exitStatus = exitStatus($?);
- chdir $cwd;
- if ($exitStatus && !$isForcing) {
- print "Calling \"$patchCommand\" for file \"$pathRelativeToRoot\" returned " .
- "status $exitStatus. Pass --force to ignore patch failures.\n";
- exit $exitStatus;
- }
- return $exitStatus;
- }
- # Merge ChangeLog patches using a three-file approach.
- #
- # This is used by resolve-ChangeLogs when it's operated as a merge driver
- # and when it's used to merge conflicts after a patch is applied or after
- # an svn update.
- #
- # It's also used for traditional rejected patches.
- #
- # Args:
- # $fileMine: The merged version of the file. Also known in git as the
- # other branch's version (%B) or "ours".
- # For traditional patch rejects, this is the *.rej file.
- # $fileOlder: The base version of the file. Also known in git as the
- # ancestor version (%O) or "base".
- # For traditional patch rejects, this is the *.orig file.
- # $fileNewer: The current version of the file. Also known in git as the
- # current version (%A) or "theirs".
- # For traditional patch rejects, this is the original-named
- # file.
- #
- # Returns 1 if merge was successful, else 0.
- sub mergeChangeLogs($$$)
- {
- my ($fileMine, $fileOlder, $fileNewer) = @_;
- my $traditionalReject = $fileMine =~ /\.rej$/ ? 1 : 0;
- local $/ = undef;
- my $patch;
- if ($traditionalReject) {
- open(DIFF, "<", $fileMine) or die $!;
- $patch = <DIFF>;
- close(DIFF);
- rename($fileMine, "$fileMine.save");
- rename($fileOlder, "$fileOlder.save");
- } else {
- open(DIFF, "diff -u -a --binary \"$fileOlder\" \"$fileMine\" |") or die $!;
- $patch = <DIFF>;
- close(DIFF);
- }
- unlink("${fileNewer}.orig");
- unlink("${fileNewer}.rej");
- open(PATCH, "| patch --force --fuzz=3 --binary \"$fileNewer\" > " . File::Spec->devnull()) or die $!;
- if ($traditionalReject) {
- print PATCH $patch;
- } else {
- my $changeLogHash = fixChangeLogPatch($patch);
- print PATCH $changeLogHash->{patch};
- }
- close(PATCH);
- my $result = !exitStatus($?);
- # Refuse to merge the patch if it did not apply cleanly
- if (-e "${fileNewer}.rej") {
- unlink("${fileNewer}.rej");
- if (-f "${fileNewer}.orig") {
- unlink($fileNewer);
- rename("${fileNewer}.orig", $fileNewer);
- }
- } else {
- unlink("${fileNewer}.orig");
- }
- if ($traditionalReject) {
- rename("$fileMine.save", $fileMine);
- rename("$fileOlder.save", $fileOlder);
- }
- return $result;
- }
- sub gitConfig($)
- {
- return unless $isGit;
- my ($config) = @_;
- my $result = `git config $config`;
- chomp $result;
- return $result;
- }
- sub changeLogSuffix()
- {
- my $rootPath = determineVCSRoot();
- my $changeLogSuffixFile = File::Spec->catfile($rootPath, ".changeLogSuffix");
- return "" if ! -e $changeLogSuffixFile;
- open FILE, $changeLogSuffixFile or die "Could not open $changeLogSuffixFile: $!";
- my $changeLogSuffix = <FILE>;
- chomp $changeLogSuffix;
- close FILE;
- return $changeLogSuffix;
- }
- sub changeLogFileName()
- {
- return "ChangeLog" . changeLogSuffix()
- }
- sub changeLogNameError($)
- {
- my ($message) = @_;
- print STDERR "$message\nEither:\n";
- print STDERR " set CHANGE_LOG_NAME in your environment\n";
- print STDERR " OR pass --name= on the command line\n";
- print STDERR " OR set REAL_NAME in your environment";
- print STDERR " OR git users can set 'git config user.name'\n";
- exit(1);
- }
- sub changeLogName()
- {
- my $name = $ENV{CHANGE_LOG_NAME} || $ENV{REAL_NAME} || gitConfig("user.name") || (split /\s*,\s*/, (getpwuid $<)[6])[0];
- changeLogNameError("Failed to determine ChangeLog name.") unless $name;
- # getpwuid seems to always succeed on windows, returning the username instead of the full name. This check will catch that case.
- changeLogNameError("'$name' does not contain a space! ChangeLogs should contain your full name.") unless ($name =~ /\S\s\S/);
- return $name;
- }
- sub changeLogEmailAddressError($)
- {
- my ($message) = @_;
- print STDERR "$message\nEither:\n";
- print STDERR " set CHANGE_LOG_EMAIL_ADDRESS in your environment\n";
- print STDERR " OR pass --email= on the command line\n";
- print STDERR " OR set EMAIL_ADDRESS in your environment\n";
- print STDERR " OR git users can set 'git config user.email'\n";
- exit(1);
- }
- sub changeLogEmailAddress()
- {
- my $emailAddress = $ENV{CHANGE_LOG_EMAIL_ADDRESS} || $ENV{EMAIL_ADDRESS} || gitConfig("user.email");
- changeLogEmailAddressError("Failed to determine email address for ChangeLog.") unless $emailAddress;
- changeLogEmailAddressError("Email address '$emailAddress' does not contain '\@' and is likely invalid.") unless ($emailAddress =~ /\@/);
- return $emailAddress;
- }
- # http://tools.ietf.org/html/rfc1924
- sub decodeBase85($)
- {
- my ($encoded) = @_;
- my %table;
- my @characters = ('0'..'9', 'A'..'Z', 'a'..'z', '!', '#', '$', '%', '&', '(', ')', '*', '+', '-', ';', '<', '=', '>', '?', '@', '^', '_', '`', '{', '|', '}', '~');
- for (my $i = 0; $i < 85; $i++) {
- $table{$characters[$i]} = $i;
- }
- my $decoded = '';
- my @encodedChars = $encoded =~ /./g;
- for (my $encodedIter = 0; defined($encodedChars[$encodedIter]);) {
- my $digit = 0;
- for (my $i = 0; $i < 5; $i++) {
- $digit *= 85;
- my $char = $encodedChars[$encodedIter];
- $digit += $table{$char};
- $encodedIter++;
- }
- for (my $i = 0; $i < 4; $i++) {
- $decoded .= chr(($digit >> (3 - $i) * 8) & 255);
- }
- }
- return $decoded;
- }
- sub decodeGitBinaryChunk($$)
- {
- my ($contents, $fullPath) = @_;
- # Load this module lazily in case the user don't have this module
- # and won't handle git binary patches.
- require Compress::Zlib;
- my $encoded = "";
- my $compressedSize = 0;
- while ($contents =~ /^([A-Za-z])(.*)$/gm) {
- my $line = $2;
- next if $line eq "";
- die "$fullPath: unexpected size of a line: $&" if length($2) % 5 != 0;
- my $actualSize = length($2) / 5 * 4;
- my $encodedExpectedSize = ord($1);
- my $expectedSize = $encodedExpectedSize <= ord("Z") ? $encodedExpectedSize - ord("A") + 1 : $encodedExpectedSize - ord("a") + 27;
- die "$fullPath: unexpected size of a line: $&" if int(($expectedSize + 3) / 4) * 4 != $actualSize;
- $compressedSize += $expectedSize;
- $encoded .= $line;
- }
- my $compressed = decodeBase85($encoded);
- $compressed = substr($compressed, 0, $compressedSize);
- return Compress::Zlib::uncompress($compressed);
- }
- sub decodeGitBinaryPatch($$)
- {
- my ($contents, $fullPath) = @_;
- # Git binary patch has two chunks. One is for the normal patching
- # and another is for the reverse patching.
- #
- # Each chunk a line which starts from either "literal" or "delta",
- # followed by a number which specifies decoded size of the chunk.
- #
- # Then, content of the chunk comes. To decode the content, we
- # need decode it with base85 first, and then zlib.
- my $gitPatchRegExp = '(literal|delta) ([0-9]+)\n([A-Za-z0-9!#$%&()*+-;<=>?@^_`{|}~\\n]*?)\n\n';
- if ($contents !~ m"\nGIT binary patch\n$gitPatchRegExp$gitPatchRegExp\Z") {
- die "$fullPath: unknown git binary patch format"
- }
- my $binaryChunkType = $1;
- my $binaryChunkExpectedSize = $2;
- my $encodedChunk = $3;
- my $reverseBinaryChunkType = $4;
- my $reverseBinaryChunkExpectedSize = $5;
- my $encodedReverseChunk = $6;
- my $binaryChunk = decodeGitBinaryChunk($encodedChunk, $fullPath);
- my $binaryChunkActualSize = length($binaryChunk);
- my $reverseBinaryChunk = decodeGitBinaryChunk($encodedReverseChunk, $fullPath);
- my $reverseBinaryChunkActualSize = length($reverseBinaryChunk);
- die "$fullPath: unexpected size of the first chunk (expected $binaryChunkExpectedSize but was $binaryChunkActualSize" if ($binaryChunkType eq "literal" and $binaryChunkExpectedSize != $binaryChunkActualSize);
- die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkType eq "literal" and $reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
- return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
- }
- sub readByte($$)
- {
- my ($data, $location) = @_;
-
- # Return the byte at $location in $data as a numeric value.
- return ord(substr($data, $location, 1));
- }
- # The git binary delta format is undocumented, except in code:
- # - https://github.com/git/git/blob/master/delta.h:get_delta_hdr_size is the source
- # of the algorithm in decodeGitBinaryPatchDeltaSize.
- # - https://github.com/git/git/blob/master/patch-delta.c:patch_delta is the source
- # of the algorithm in applyGitBinaryPatchDelta.
- sub decodeGitBinaryPatchDeltaSize($)
- {
- my ($binaryChunk) = @_;
-
- # Source and destination buffer sizes are stored in 7-bit chunks at the
- # start of the binary delta patch data. The highest bit in each byte
- # except the last is set; the remaining 7 bits provide the next
- # chunk of the size. The chunks are stored in ascending significance
- # order.
- my $cmd;
- my $size = 0;
- my $shift = 0;
- for (my $i = 0; $i < length($binaryChunk);) {
- $cmd = readByte($binaryChunk, $i++);
- $size |= ($cmd & 0x7f) << $shift;
- $shift += 7;
- if (!($cmd & 0x80)) {
- return ($size, $i);
- }
- }
- }
- sub applyGitBinaryPatchDelta($$)
- {
- my ($binaryChunk, $originalContents) = @_;
-
- # Git delta format consists of two headers indicating source buffer size
- # and result size, then a series of commands. Each command is either
- # a copy-from-old-version (the 0x80 bit is set) or a copy-from-delta
- # command. Commands are applied sequentially to generate the result.
- #
- # A copy-from-old-version command encodes an offset and size to copy
- # from in subsequent bits, while a copy-from-delta command consists only
- # of the number of bytes to copy from the delta.
- # We don't use these values, but we need to know how big they are so that
- # we can skip to the diff data.
- my ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
- $binaryChunk = substr($binaryChunk, $bytesUsed);
- ($size, $bytesUsed) = decodeGitBinaryPatchDeltaSize($binaryChunk);
- $binaryChunk = substr($binaryChunk, $bytesUsed);
- my $out = "";
- for (my $i = 0; $i < length($binaryChunk); ) {
- my $cmd = ord(substr($binaryChunk, $i++, 1));
- if ($cmd & 0x80) {
- # Extract an offset and size from the delta data, then copy
- # $size bytes from $offset in the original data into the output.
- my $offset = 0;
- my $size = 0;
- if ($cmd & 0x01) { $offset = readByte($binaryChunk, $i++); }
- if ($cmd & 0x02) { $offset |= readByte($binaryChunk, $i++) << 8; }
- if ($cmd & 0x04) { $offset |= readByte($binaryChunk, $i++) << 16; }
- if ($cmd & 0x08) { $offset |= readByte($binaryChunk, $i++) << 24; }
- if ($cmd & 0x10) { $size = readByte($binaryChunk, $i++); }
- if ($cmd & 0x20) { $size |= readByte($binaryChunk, $i++) << 8; }
- if ($cmd & 0x40) { $size |= readByte($binaryChunk, $i++) << 16; }
- if ($size == 0) { $size = 0x10000; }
- $out .= substr($originalContents, $offset, $size);
- } elsif ($cmd) {
- # Copy $cmd bytes from the delta data into the output.
- $out .= substr($binaryChunk, $i, $cmd);
- $i += $cmd;
- } else {
- die "unexpected delta opcode 0";
- }
- }
- return $out;
- }
- sub escapeSubversionPath($)
- {
- my ($path) = @_;
- $path .= "@" if $path =~ /@/;
- return $path;
- }
- sub runCommand(@)
- {
- my @args = @_;
- my $pid = open(CHILD, "-|");
- if (!defined($pid)) {
- die "Failed to fork(): $!";
- }
- if ($pid) {
- # Parent process
- my $childStdout;
- while (<CHILD>) {
- $childStdout .= $_;
- }
- close(CHILD);
- my %childOutput;
- $childOutput{exitStatus} = exitStatus($?);
- $childOutput{stdout} = $childStdout if $childStdout;
- return \%childOutput;
- }
- # Child process
- # FIXME: Consider further hardening of this function, including sanitizing the environment.
- exec { $args[0] } @args or die "Failed to exec(): $!";
- }
- sub gitCommitForSVNRevision
- {
- my ($svnRevision) = @_;
- my $command = "git svn find-rev r" . $svnRevision;
- $command = "LC_ALL=C $command" if !isWindows();
- my $gitHash = `$command`;
- if (!defined($gitHash)) {
- $gitHash = "unknown";
- warn "Unable to determine GIT commit from SVN revision";
- } else {
- chop($gitHash);
- }
- return $gitHash;
- }
- sub listOfChangedFilesBetweenRevisions
- {
- my ($sourceDir, $firstRevision, $lastRevision) = @_;
- my $command;
- if ($firstRevision eq "unknown" or $lastRevision eq "unknown") {
- return ();
- }
- # Some VCS functions don't work from within the build dir, so always
- # go to the source dir first.
- my $cwd = Cwd::getcwd();
- chdir $sourceDir;
- if (isGit()) {
- my $firstCommit = gitCommitForSVNRevision($firstRevision);
- my $lastCommit = gitCommitForSVNRevision($lastRevision);
- $command = "git diff --name-status $firstCommit..$lastCommit";
- } elsif (isSVN()) {
- $command = "svn diff --summarize -r $firstRevision:$lastRevision";
- }
- my @result = ();
- if ($command) {
- my $diffOutput = `$command`;
- $diffOutput =~ s/^[A-Z]\s+//gm;
- @result = split(/[\r\n]+/, $diffOutput);
- }
- chdir $cwd;
- return @result;
- }
- 1;
|