summaryrefslogtreecommitdiffstats
path: root/WebKitTools/Scripts/VCSUtils.pm
diff options
context:
space:
mode:
Diffstat (limited to 'WebKitTools/Scripts/VCSUtils.pm')
-rw-r--r--WebKitTools/Scripts/VCSUtils.pm258
1 files changed, 213 insertions, 45 deletions
diff --git a/WebKitTools/Scripts/VCSUtils.pm b/WebKitTools/Scripts/VCSUtils.pm
index e1e0bc2..7638102 100644
--- a/WebKitTools/Scripts/VCSUtils.pm
+++ b/WebKitTools/Scripts/VCSUtils.pm
@@ -41,7 +41,10 @@ BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(
&canonicalizePath
+ &changeLogEmailAddress
+ &changeLogName
&chdirReturningRelativePath
+ &decodeGitBinaryPatch
&determineSVNRoot
&determineVCSRoot
&fixChangeLogPatch
@@ -298,6 +301,14 @@ sub canonicalizePath($)
return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
}
+sub removeEOL($)
+{
+ my ($line) = @_;
+
+ $line =~ s/[\r\n]+$//g;
+ return $line;
+}
+
sub svnStatus($)
{
my ($fullPath) = @_;
@@ -335,8 +346,6 @@ sub gitdiff2svndiff($)
$_ = shift @_;
if (m#^diff --git a/(.+) b/(.+)#) {
return "Index: $1";
- } elsif (m/^new file.*/) {
- return "";
} elsif (m#^index [0-9a-f]{7}\.\.[0-9a-f]{7} [0-9]{6}#) {
return "===================================================================";
} elsif (m#^--- a/(.+)#) {
@@ -347,56 +356,215 @@ sub gitdiff2svndiff($)
return $_;
}
+# The diff(1) command is greedy when matching lines, so a new ChangeLog entry will
+# have lines of context at the top of a patch when the existing entry has the same
+# date and author as the new entry. Alter the ChangeLog patch so
+# that the added lines ("+") in the patch always start at the beginning of the
+# patch and there are no initial lines of context.
sub fixChangeLogPatch($)
{
- my $patch = shift;
- my $contextLineCount = 3;
-
- return $patch if $patch !~ /\n@@ -1,(\d+) \+1,(\d+) @@\n( .*\n)+(\+.*\n)+( .*\n){$contextLineCount}$/m;
- my ($oldLineCount, $newLineCount) = ($1, $2);
- return $patch if $oldLineCount <= $contextLineCount;
-
- # The diff(1) command is greedy when matching lines, so a new ChangeLog entry will
- # have lines of context at the top of a patch when the existing entry has the same
- # date and author as the new entry. This nifty loop alters a ChangeLog patch so
- # that the added lines ("+") in the patch always start at the beginning of the
- # patch and there are no initial lines of context.
- my $newPatch;
- my $lineCountInState = 0;
- my $oldContentLineCountReduction = $oldLineCount - $contextLineCount;
- my $newContentLineCountWithoutContext = $newLineCount - $oldLineCount - $oldContentLineCountReduction;
- my ($stateHeader, $statePreContext, $stateNewChanges, $statePostContext) = (1..4);
- my $state = $stateHeader;
- foreach my $line (split(/\n/, $patch)) {
- $lineCountInState++;
- if ($state == $stateHeader && $line =~ /^@@ -1,$oldLineCount \+1,$newLineCount @\@$/) {
- $line = "@@ -1,$contextLineCount +1," . ($newLineCount - $oldContentLineCountReduction) . " @@";
- $lineCountInState = 0;
- $state = $statePreContext;
- } elsif ($state == $statePreContext && substr($line, 0, 1) eq " ") {
- $line = "+" . substr($line, 1);
- if ($lineCountInState == $oldContentLineCountReduction) {
- $lineCountInState = 0;
- $state = $stateNewChanges;
- }
- } elsif ($state == $stateNewChanges && substr($line, 0, 1) eq "+") {
- # No changes to these lines
- if ($lineCountInState == $newContentLineCountWithoutContext) {
- $lineCountInState = 0;
- $state = $statePostContext;
- }
- } elsif ($state == $statePostContext) {
- if (substr($line, 0, 1) eq "+" && $lineCountInState <= $oldContentLineCountReduction) {
- $line = " " . substr($line, 1);
- } elsif ($lineCountInState > $contextLineCount && substr($line, 0, 1) eq " ") {
- next; # Discard
+ my $patch = shift; # $patch will only contain patch fragments for ChangeLog.
+
+ $patch =~ /(\r?\n)/;
+ my $lineEnding = $1;
+ my @patchLines = split(/$lineEnding/, $patch);
+
+ # e.g. 2009-06-03 Eric Seidel <eric@webkit.org>
+ my $dateLineRegexpString = '^\+(\d{4}-\d{2}-\d{2})' # Consume the leading '+' and the date.
+ . '\s+(.+)\s+' # Consume the name.
+ . '<([^<>]+)>$'; # And finally the email address.
+
+ # Figure out where the patch contents start and stop.
+ my $patchHeaderIndex;
+ my $firstContentIndex;
+ my $trailingContextIndex;
+ my $dateIndex;
+ my $patchEndIndex = scalar(@patchLines);
+ for (my $index = 0; $index < @patchLines; ++$index) {
+ my $line = $patchLines[$index];
+ if ($line =~ /^\@\@ -\d+,\d+ \+\d+,\d+ \@\@$/) { # e.g. @@ -1,5 +1,18 @@
+ if ($patchHeaderIndex) {
+ $patchEndIndex = $index; # We only bother to fix up the first patch fragment.
+ last;
}
+ $patchHeaderIndex = $index;
}
- $newPatch .= $line . "\n";
+ $firstContentIndex = $index if ($patchHeaderIndex && !$firstContentIndex && $line =~ /^\+[^+]/); # Only match after finding patchHeaderIndex, otherwise we'd match "+++".
+ $dateIndex = $index if ($line =~ /$dateLineRegexpString/);
+ $trailingContextIndex = $index if ($firstContentIndex && !$trailingContextIndex && $line =~ /^ /);
}
+ my $contentLineCount = $trailingContextIndex - $firstContentIndex;
+ my $trailingContextLineCount = $patchEndIndex - $trailingContextIndex;
+
+ # If we didn't find a date line in the content then this is not a patch we should try and fix.
+ return $patch if (!$dateIndex);
+
+ # We only need to do anything if the date line is not the first content line.
+ return $patch if ($dateIndex == $firstContentIndex);
+
+ # Write the new patch.
+ my $totalNewContentLines = $contentLineCount + $trailingContextLineCount;
+ $patchLines[$patchHeaderIndex] = "@@ -1,$trailingContextLineCount +1,$totalNewContentLines @@"; # Write a new header.
+ my @repeatedLines = splice(@patchLines, $dateIndex, $trailingContextIndex - $dateIndex); # The date line and all the content after it that diff saw as repeated.
+ splice(@patchLines, $firstContentIndex, 0, @repeatedLines); # Move the repeated content to the top.
+ foreach my $line (@repeatedLines) {
+ $line =~ s/^\+/ /;
+ }
+ splice(@patchLines, $trailingContextIndex, $patchEndIndex, @repeatedLines); # Replace trailing context with the repeated content.
+ splice(@patchLines, $patchHeaderIndex + 1, $firstContentIndex - $patchHeaderIndex - 1); # Remove any leading context.
+
+ return join($lineEnding, @patchLines) . "\n"; # patch(1) expects an extra trailing newline.
+}
- return $newPatch;
+sub gitConfig($)
+{
+ return unless $isGit;
+
+ my ($config) = @_;
+
+ my $result = `git config $config`;
+ if (($? >> 8)) {
+ $result = `git repo-config $config`;
+ }
+ chomp $result;
+ return $result;
}
+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 =~ /\w \w/);
+
+ 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.
+ # The "delta" type chunks aren't supported by this function yet.
+ #
+ # 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 ($binaryChunkExpectedSize != $binaryChunkActualSize);
+ die "$fullPath: unexpected size of the second chunk (expected $reverseBinaryChunkExpectedSize but was $reverseBinaryChunkActualSize" if ($reverseBinaryChunkExpectedSize != $reverseBinaryChunkActualSize);
+
+ return ($binaryChunkType, $binaryChunk, $reverseBinaryChunkType, $reverseBinaryChunk);
+}
1;