diff options
Diffstat (limited to 'git-repository--apply-patch')
-rwxr-xr-x | git-repository--apply-patch | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/git-repository--apply-patch b/git-repository--apply-patch new file mode 100755 index 0000000..a4bdf8b --- /dev/null +++ b/git-repository--apply-patch @@ -0,0 +1,158 @@ +#!/usr/bin/perl + +# this script can be used instead of "/usr/bin/patch [options] -i xxx.patch" + + +use strict; +use warnings; + +my @argv = @ARGV; +my $verbose; + +my @patches; +while ($argv[-1] =~ /\.(patch|diff)$/) { + unshift @patches, pop @argv; +} + +@patches or die "git-repository--apply-patch can not work with compressed patches\n"; # happens when the patch is passed through stdin + +my @opts; +while (@argv) { + my $s = shift @argv; + if ($s eq '-b') { + # we don't want .xxx files + } elsif ($s eq '--suffix') { + # we don't want .xxx files + shift @argv; + } elsif ($s eq '-i') { + # ignore "-i" + } else { + push @opts, $s; + } +} + +# we really don't want .orig when using git (even when there are hunks) +push @opts, '--no-backup-if-mismatch'; + +foreach my $patch_file (@patches) { + my @header = get_patch_header($patch_file); + + if (grep { /^Subject:/ } @header) { + my $patch_file_ = fix_git_patch($patch_file); + system_("git am " . ($patch_file_ || $patch_file)); + $patch_file_ and unlink $patch_file_; + } else { + system_("patch @opts -i $patch_file"); + + my ($patch_name) = $patch_file =~ m!([^/]*)\.(patch|diff)$!; + + system_('git add .'); + git_commit(commit_line_from_patch_name($patch_name) . + (@header ? "\n\n" . join('', cleanup_patch_header(@header)) : ''), + # use the date of the patch for the commit: + (stat($patch_file))[9] . " +0000"); + } +} + +sub system_ { + my ($cmd) = @_; + print "$cmd\n" if $verbose; + system($cmd) == 0 or die "$cmd failed\n"; +} + +sub git_commit { + my ($msg, $date) = @_; + + $ENV{GIT_AUTHOR_DATE} = $date; + open(my $F, '| git commit -q --author="unknown <>" --file=-'); + print $F $msg; + close $F or die "git commit failed\n"; +} + +sub commit_line_from_patch_name { + my ($name) = @_; + + # remove prefix (eg: "libtool-1.5.26-xxx" => "xxx") + my $re_name = qr([a-z][\w+]*([_-][a-z][\w+]*)*)i; + my $re_rc = qr((rc\d*|RC\d+|beta\d*|pre\d*|p\d+|test)); + my $re_special_version = qr([a-z]([._-]$re_rc?)?|[._-]?$re_rc?|[a-z]); + $name =~ s/^ $re_name [._-] \d+ (\.\d+)+ $re_special_version [._-]//x; + + if (my $pkg_name = $ENV{PKG_NAME}) { + $name =~ s/^\Q$pkg_name\E[_-]//; + } + + # replace "-" (resp. "_") with spaces if there is no spaces nor "_" (resp. "-") + if ($name !~ /[\s_]/ && $name !~ /--/) { + $name =~ s/-/ /g; + } elsif ($name !~ /[\s-]/ && $name !~ /__/) { + $name =~ s/_/ /g; + } + $name; +} + +sub get_patch_header { + my ($file) = @_; + open(my $F, '<', $file) or die "can not open $file: $!\n"; + + my @header; + while (my $s = <$F>) { + last if $s =~ /^--- /; + push @header, $s; + } + pop @header while @header && $header[-1] !~ /^\s*$/; + + @header; +} + +sub cleanup_patch_header { + my (@header) = @_; + + my @r; + foreach (@header) { + s/^##\s// or last; + push @r, $_; + } + @r == @header and return @r; + + @header; +} + +# "git format-patch" and "git am" do not agree how to handle commit logs when +# the first line is not separated from the rest. +# eg: +# +# > Subject: [PATCH 01/34] Delay NSS initialization until actually used +# > - since NSS is allergic (ie becomes non-functional) after forking, delay +# > it's initialization until really needed, ie lazy init in rpmDigestInit() +# +# workarounding by transforming header to: +# +# > Subject: [PATCH 01/34] Delay NSS initialization until actually used +# > +# > - since NSS is allergic (ie becomes non-functional) after forking, delay +# > it's initialization until really needed, ie lazy init in rpmDigestInit() +sub fix_git_patch { + my ($file) = @_; + open(my $F, '<', $file) or die "can not open $file: $!\n"; + + my ($last_line, @l); + while (my $s = <$F>) { + push @l, $s; + + if ($s !~ /^\S+:\s/ && $last_line && $last_line =~ /^Subject:/) { + # argh, we are in the header, but the value is weird + # applying the fix + $l[-1] = "\n" . $l[-1]; + push @l, <$F>; + output("$file.tmp", @l); + return "$file.tmp"; + } elsif ($s =~ /^\s*$/ || $s =~ /^--- /) { + last; + } + $last_line = $s; + } + undef; +} + +sub output { my $f = shift; open(my $F, '>', $f) or die "output in file $f failed: $!\n"; print $F $_ foreach @_; 1 } |