#!/usr/bin/perl
=begin metadata
Name: patch
Description: apply a diff file to an original
Author: Tim Gim Yee, tim.gim.yee@gmail.com
License: perl
=end metadata
=cut
#
# patch - apply a diff file to an original
#
use strict;
use File::Temp qw();
use constant EX_SUCCESS => 0;
use constant EX_REJECTS => 1;
use constant EX_FAILURE => 2;
my $VERSION = '0.33';
$|++;
sub version {
print split /^ /m, qq[
This is patch $VERSION written in Perl.
Copyright (c) 1999 Moogle Stuffy Software. All rights reserved.
You may play with this software in accordance with the
Perl Artistic License.
];
exit EX_SUCCESS;
}
sub type_conflict {
my $opts = shift;
my @types;
my $i = 0;
for (qw(context ed normal unified)) {
push @types, '--' . $_ if $opts->{$_};
}
if (scalar(@types) > 1) {
warn "$0: incompatible input type specifiers: @types\n";
exit EX_FAILURE;
}
return;
}
my ($patchfile, @options);
if (@ARGV) {
require Getopt::Long;
Getopt::Long::Configure(qw/
bundling
no_ignore_case
/);
# List of supported options and acceptable arguments.
my @desc = qw/
suffix|b=s force|f reject-file|r=s
prefix|B=s batch|t reverse|R
context|c fuzz|F=i silent|quiet|s
check|dry-run|C ignore-whitespace|l skip|S
directory|d=s normal|n unified|u
ifdef|D=s forward|N version|v
ed|e output|o=s version-control|V=s
remove-empty-files|E strip|p=i
/;
# Each patch may have its own set of options. These are separated by
# a '+' on the command line.
my @opts;
for (@ARGV, '+') { # Now '+' terminated instead of separated...
if ($_ eq '+') {
push @options, [splice @opts, 0];
} else {
push @opts, $_;
}
}
# Parse each set of options into a hash.
my $next = 0;
for (@options) {
local @ARGV = @$_;
my %opts;
Getopt::Long::GetOptions(\%opts, @desc) or die("Bad options\n");
type_conflict(\%opts);
$opts{origfile} = shift;
$_ = \%opts;
$patchfile = shift unless $next++;
version() if $opts{'version'};
}
}
$patchfile = '-' unless defined $patchfile;
my $patch = Patch->new(@options);
if (defined $patch->{'directory'}) {
unless (chdir $patch->{'directory'}) {
die "failed to change to directory '$patch->{directory}': $!\n";
}
}
if (defined $patch->{'fuzz'} && $patch->{'fuzz'} < 0) {
die "$0: fuzz factor is negative: $patch->{fuzz}\n";
}
tie *PATCH, Pushback => $patchfile or die "Can't open '$patchfile': $!";
# Extract patches from patchfile. We unread/pushback lines by printing to
# the PATCH filehandle: 'print PATCH'
PATCH:
while (<PATCH>) {
if (/^(\s*)(\@\@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? \@\@(.*)\n)/) {
# UNIFIED DIFF
my ($space, $range, $i_start, $i_lines, $o_start, $o_lines) =
($1, $2, $3, $4 || 1, $5, $6 || 1);
$patch->bless('unified') or next PATCH;
my @hunk;
my %saw = map {$_, 0} split //, ' +-';
my $re = qr/^$space([ +-])/;
while (<PATCH>) {
unless (s/$re/$1/) {
$patch->note("Short hunk ignored.\n");
$patch->reject($range, @hunk);
print PATCH;
next PATCH;
}
push @hunk, $_;
$saw{$1}++;
last if $saw{'-'} + $saw{' '} == $i_lines
&& $saw{'+'} + $saw{' '} == $o_lines;
}
$patch->apply($i_start, $o_start, @hunk)
or $patch->reject($range, @hunk);
} elsif (/^(\s*)\*{15}$/) {
# CONTEXT DIFF
my $space = $1;
$_ = <PATCH>;
unless (/^$space(\*\*\* (\d+)(?:,(\d+))? \*\*\*\*\n)/) {
print PATCH;
next PATCH;
}
my ($i_range, $i_start, $i_end, @i_hunk) = ($1, $2, $3 || $2);
my ($o_range, $o_start, $o_end, @o_hunk);
$patch->bless('context') or next PATCH;
my $o_hunk = qr/^$space(--- (\d+)(?:,(\d+))? ----\n)/;
my $re = qr/^$space([ !-] )/;
$_ = <PATCH>;
if (/$o_hunk/) {
($o_range, $o_start, $o_end) = ($1, $2, $3 || $2);
} else {
print PATCH;
for ($i_start..$i_end) {
$_ = <PATCH>;
unless (s/$re/$1/) {
$patch->note("Short hunk ignored.\n");
$patch->reject($i_range, @i_hunk);
print PATCH;
next PATCH;
}
push @i_hunk, $_;
}
$_ = <PATCH>;
unless (/$o_hunk/) {
$patch->note("Short hunk ignored...no second line range.\n");
$patch->reject($i_range, @i_hunk);
print PATCH;
next PATCH;
}
($o_range, $o_start, $o_end) = ($1, $2, $3 || $2);
}
$re = qr/^$space([ !+] )/;
$_ = <PATCH>;
if (/^$space\*{15}$/) {
print PATCH;
} else {
print PATCH;
for ($o_start..$o_end) {
$_ = <PATCH>;
unless (s/$re/$1/) {
$patch->note("Short hunk ignored.\n");
$patch->reject($i_range, @i_hunk, $o_range, @o_hunk);
print PATCH;
next PATCH;
}
push @o_hunk, $_;
}
}
$patch->apply($i_start, $o_start, \@i_hunk, \@o_hunk)
or $patch->reject($i_range, @i_hunk, $o_range, @o_hunk);
} elsif (/^(\s*)((\d+)(?:,(\d+))?([acd])(\d+)(?:,(\d+))?\n)/) {
# NORMAL DIFF
my ($space, $range, $i_start, $i_end, $cmd, $o_start, $o_end) =
($1, $2, $3, $4 || $3, $5, $6, $7 || $6);
$patch->bless('normal') or next PATCH;
my (@d_hunk, @a_hunk);
my $d_re = qr/^$space< /;
my $a_re = qr/^$space> /;
if ($cmd eq 'c' || $cmd eq 'd') {
for ($i_start..$i_end) {
$_ = <PATCH>;
unless (s/$d_re//) {
$patch->note("Short hunk ignored.\n");
$patch->reject($range, @d_hunk);
print PATCH;
next PATCH;
}
push @d_hunk, $_;
}
}
if ($cmd eq 'c') {
$_ = <PATCH>;
unless ($_ eq "---\n") {
$patch->note("Short hunk ignored...no '---' separator.\n");
$patch->reject($range, @d_hunk);
print PATCH;
next PATCH;
}
}
if ($cmd eq 'c' || $cmd eq 'a') {
for ($o_start..$o_end) {
$_ = <PATCH>;
unless (s/$a_re//) {
$patch->note("Short hunk ignored.\n");
$patch->reject($range, @d_hunk, "---\n", @a_hunk);
print PATCH;
next PATCH;
}
push @a_hunk, $_;
}
}
$patch->apply($i_start, $o_start, $cmd, \@d_hunk, \@a_hunk)
or $patch->reject($range, @d_hunk, "---\n", @a_hunk);
} elsif (/^(\s*)\d+(?:,\d+)?[acd]$/) {
# ED SCRIPT
my $space = qr/^$1/;
$patch->bless('ed') or next PATCH;
print PATCH;
my @cmd;
ED:
while (<PATCH>) {
unless (s/$space// && m!^\d+(?:,\d+)?([acd]|s\Q/^\.\././\E)$!) {
print PATCH;
last ED;
}
push @cmd, [$_];
$1 =~ /^[ac]$/ or next;
while (<PATCH>) {
unless (s/$space//) {
print PATCH;
last ED;
}
push @{$cmd[-1]}, $_;
last if /^\.$/;
}
}
$patch->apply(@cmd) or $patch->reject(map @$_, @cmd);
} else {
# GARBAGE
$patch->garbage($_);
}
}
close PATCH;
if (ref $patch eq 'Patch') {
die "Hmm... I can't seem to find a patch in there anywhere.\n";
} else {
$patch->end;
}
$patch->note("done\n");
exit($patch->error ? EX_REJECTS : EX_SUCCESS);
END {
close STDOUT || die "$0: can't close stdout: $!\n";
$? = EX_FAILURE if $? == 255; # from die
}
package
Patch; # hide from PAUSE
use vars qw/$ERROR/;
# Class data.
BEGIN {
$ERROR = 0;
}
# Simple throw/catch error handling.
sub throw {
$@ = join '', @_;
$@ .= sprintf " at %s line %d\n", (caller)[1..2] unless $@ =~ /\n\z/;
goto CATCH;
}
# Prints a prompt message and returns response.
{
my $TERM;
sub prompt {
unless ($TERM) {
# From commit 5c9f32cb374a034c1ad4b9e02a9b9ee2014b9b5c:
#
# with strawberry perl under windows 7 (and likely elsewhere)
# the default tends to be to use Term::ReadLine::Perl, which
# doesn't work well on windows. Force it to T::RL::Stub instead
local $ENV{PERL_RL} = $ENV{PERL_RL} || 'stub' if $^O eq 'MSWin32';
require Term::ReadLine;
$TERM = Term::ReadLine->new('patch');
}
$TERM->readline(join '', @_);
}
}
# Constructs a Patch object.
sub new {
my $class = shift;
my %copy = %{$_[0]} if ref $_[0];
bless {
%copy,
options => [@_],
garbage => [],
rejects => [],
}, $class;
}
# Blesses object into a subclass.
sub bless {
my $type = pop;
my $class = "Patch::\u$type";
my ($options, $garbage) = @{$_[0]}{'options', 'garbage'};
# New hunk, same patch.
$_[0]{hunk}++, return 1 if $_[0]->isa($class) && ! @$garbage;
# Clean up previous Patch object first.
$_[0]->end;
# Get options/switches for new patch.
my $self = @$options > 1 ? shift @$options :
@$options == 1 ? { %{$options->[0]} } :
{};
bless $self, $class;
# 'options' and 'garbage' are probably better off as class
# data. Why didn't I do that before? But it's not broken
# so I'm not fixing it.
$self->{options} = $options; # @options
$self->{garbage} = []; # garbage lines
$self->{i_pos} = 0; # current position in 'in' file
$self->{o_pos} = 0; # just for symmetry
$self->{i_lines} = 0; # lines read in 'in' file
$self->{o_lines} = 0; # lines written to 'out' file
$self->{hunk} = 1; # current hunk number
$self->{rejects} = []; # save rejected hunks here
$self->{'fuzz'} = 2 unless defined $self->{'fuzz'};
$self->{ifdef} = '' unless defined $self->{ifdef};
# Skip patch?
$self->{skip} and $self->skip;
# -c, -e, -n, -u
$self->{$_} and $type eq $_ || $self->skip("Not a $_ diff!\n")
for qw/context ed normal unified/;
# Speculate to user.
my $n = $type eq 'ed' ? 'n' : '';
$self->note("Hmm... Looks like a$n $type diff to me...\n");
# Get original file to patch...
my $orig = $self->{origfile}; # ...from -o
unless (defined $orig) {
$orig = $self->rummage($garbage); # ...from leading garbage
if (defined $orig) {
$self->note(
"The text leading up to this was:\n",
"--------------------------\n",
map("|$_", @$garbage),
"--------------------------\n",
);
} else {
$self->skip if $self->{force} || $self->{batch};
$orig = prompt ('File to patch: '); # ...from user
}
}
# Make sure original file exists.
if (-e $orig && ! -f $orig) {
$self->skip("File '$orig' is not a regular file\n");
} elsif ($self->{'force'} || $self->{'batch'}) {
-e $orig or $self->skip;
} else {
until (-e $orig) {
$self->skip unless prompt (
'No file found--skip this patch? [n] '
) =~ /^[yY]/;
$orig = prompt (
'File to patch: '
);
}
}
my $to_stdout = 0;
my ($in, $out);
# Create backup file. I have no clue what Plan A is really supposed to be.
if ($self->{check}) {
$self->note("Checking patch against file $orig using Plan C...\n");
($in, $out) = ($orig, '');
} elsif (defined $self->{output}) {
$to_stdout = 1 if $self->{output} eq '-';
if (!$to_stdout && -d $self->{'output'}) {
die "$0: output file '$self->{output}' is a directory\n";
}
$self->note("Patching file $orig using Plan B...\n");
local $_ = $self->{output};
unless ($to_stdout) {
$self->skip if -e && not rename $_, $self->backup($_) and
$self->{force} || $self->{batch} || prompt (
'Failed to backup output file--skip this patch? [n] '
) =~ /^[yY]/;
}
($in, $out) = ($orig, $self->{output});
} else {
$self->note("Patching file $orig using Plan A...\n");
my $back = $self->backup($orig);
if (rename $orig, $back) {
($in, $out) = ($back, $orig);
} else {
$self->skip unless $self->{force} || $self->{batch} or prompt (
'Failed to backup original file--skip this patch? [n] '
) !~ /^[yY]/;
($in, $out) = ($orig, $orig);
}
}
# Open original file.
my $in_fh;
open $in_fh, '<', $in
or $self->skip("Cannot open input file '$in': $!\n");
binmode $in_fh;
$self->{'i_fh'} = $in_fh;
$self->{'i_file'} = $in;
# Open output file.
if ($self->{check}) {
$self->{'o_fh'} = $self->{'d_fh'} = File::Temp->new();
} elsif ($to_stdout) {
$self->{'o_fh'} = *STDOUT;
$self->{'o_file'} = '-';
$self->{'d_fh'} = length $self->{'ifdef'} ? *STDOUT : File::Temp->new;
} else {
my $out_fh;
open $out_fh, '+>', $out
or $self->skip("Cannot open output file '$out': $!\n");
binmode $out_fh;
$|++, select $_ for select $out_fh;
$self->{'o_fh'} = $out_fh;
$self->{'o_file'} = $out;
$self->{'d_fh'} = length $self->{'ifdef'} ? $out_fh : File::Temp->new();
}
$self->{'reject-file'} = "$out.rej" unless defined $self->{'reject-file'};
# Check for 'Prereq:' line.
unless ($self->{force}) {
my $prereq = (map /^Prereq:\s*(\S+)/, @$garbage)[-1];
if (defined $prereq) {
$prereq = qr/\b$prereq\b/;
my $found;
while (<IN>) {
$found++, last if /$prereq/;
}
seek IN, 0, 0 or $self->skip("Couldn't seek INFILE: $!\n");
$self->skip if not $found and $self->{batch} || prompt (
'File does not match "Prereq: $1"--skip this patch? [n] '
) =~ /^[yY]/;
}
}
SKIP:
$_[0] = $self;
}
# Skip current patch.
sub skip {
my $self = shift;
$self->note(@_) if @_;
$self->note("Skipping patch...\n");
$self->{skip}++;
goto SKIP;
}
# Let user know what's happening.
sub note {
my $self = shift;
print { *STDERR } @_ unless $self->{silent} || $self->{skip};
}
# Add to lines of leading garbage.
sub garbage {
push @{shift->{garbage}}, @_;
}
# Add to rejected hunks.
sub reject {
push @{shift->{rejects}}, [@_];
}
# Total number of hunks rejected.
sub error {
$ERROR;
}
# End of patch clean up.
sub end {
my $self = shift;
my $class = ref $self;
return if $class eq 'Patch';
return $self->restore_file if $self->{skip};
$self->print_tail if $class ne 'Patch::Ed';
$self->print_rejects;
$self->remove_empty_files;
}
# Restore file from backup.
sub restore_file {
my $self = shift;
my $in = $self->{i_file} or return;
my $out = $self->{o_file} or return;
close $self->{i_fh};
close $self->{o_fh};
rename $in, $out or print "Couldn't restore file from backup '$in': $!";
}
# Output any lines left in input handle.
sub print_tail {
my $self = shift;
print {$self->{o_fh}} readline $self->{i_fh};
}
# Output rejected hunks to reject file.
sub print_rejects {
my $self = shift;
my @rej = @{$self->{rejects}};
$ERROR += @rej;
@rej or return;
$self->note(
@rej . " out of $self->{hunk} hunks ignored--saving rejects to ",
"$self->{'reject-file'}\n\n"
);
if (open REJ, '>', $self->{'reject-file'}) {
print REJ map @$_, @rej;
close REJ;
} else {
$self->note("Couldn't open reject file: $!\n");
}
}
# Remove empty files... d'uh
sub remove_empty_files {
my $self = shift;
$self->{'remove-empty-files'} or return;
close $self->{o_fh};
defined && -z and $self->note(
unlink($_)
? "Removed empty file '$_'.\n"
: "Can't remove empty file '$_': $!\n"
) for $self->{o_file};
}
# Go through leading garbage looking for name of file to patch.
sub rummage {
my ($self, $garbage) = @_;
for (reverse @$garbage) {
/^Index:\s*(\S+)/ or next;
my $file = $self->strip($1);
-e $file or next;
return $file;
}
return;
}
# Strip slashes from path.
sub strip {
my $self = shift;
my $path = shift;
$path = $_ unless defined $path;
local $^W;
if (not exists $self->{strip}) {
unless ($path =~ m!^/!) {
$path =~ m!^(.*/)?(.+)$!;
$path = $2 unless -e $1;
}
} elsif ($self->{strip} > 0) {
my $i = $self->{strip};
$path =~ s![^/]*/!! while $i--;
}
$path;
}
# Create a backup file from options.
sub backup {
my ($self, $file) = @_;
$file =
$self->{prefix} ? "$self->{prefix}$file" :
$self->{'version-control'} ? $self->version_control_backup(
$file, $self->{'version-control'}) :
$self->{suffix} ? "$file$self->{suffix}" :
$ENV{VERSION_CONTROL} ? $self->version_control_backup(
$file, $ENV{VERSION_CONTROL}) :
$ENV{SIMPLE_BACKUP_SUFFIX} ? "$file$ENV{SIMPLE_BACKUP_SUFFIX}" :
"$file.orig"; # long filename
my ($name, $extension) = $file =~ /^(.+)\.([^.]+)$/
? ($1, $2)
: ($file, '');
my $ext = $extension;
while (-e $file) {
if ($ext !~ s/([a-z])/\U$1/) {
$ext = $extension;
$name =~ s/.// or die "Couldn't create a good backup filename.\n";
}
$file = "$name.$ext";
}
$file;
}
# Create a backup file using version control.
sub version_control_backup {
my ($self, $file, $version) = @_;
if ($version =~ /^(?:ne|s)/) { # never|simple
$file .= $self->suffix_backup;
} else {
opendir DIR, '.' or die "Can't open dir '.': $!";
my $re = qr/^\Q$file\E\.~(\d+)~$/;
my @files = map /$re/, readdir DIR;
close DIR;
if (@files) { # version number already exists
my $next = 1 + (sort {$a <=> $b} @files)[-1];
$file .= ".~$next~";
} else { # t|numbered # nil|existing
$file .= $version =~ /^(?:t|nu)/ ? '.~1~' : $self->suffix_backup;
}
}
$file;
}
# Create a backup file using suffix.
sub suffix_backup {
my $self = shift;
return $self->{suffix} if $self->{suffix};
return $ENV{SIMPLE_BACKUP_SUFFIX} if $ENV{SIMPLE_BACKUP_SUFFIX};
return '.orig';
}
# Apply a patch hunk. The default assumes a unified diff.
sub apply {
my ($self, $i_start, $o_start, @hunk) = @_;
$self->{skip} and throw('SKIP...ignore this patch');
if ($self->{reverse}) {
my $not = { qw/ + - - + / };
s/^([+-])/$not->{$1}/ for @hunk;
}
my @context = map /^[ -](.*)/s, @hunk;
my $position;
my $fuzz = 0;
if (@context) {
# Find a place to apply hunk where context matches.
for (0..$self->{fuzz}) {
my ($pos, $lines) = ($self->{i_pos}, 0);
while (1) {
($pos, $lines) = $self->index(\@context, $pos, $lines) or last;
my $line = $self->{i_lines} + $lines + 1;
if ($line >= $i_start) {
my $off = $line - $i_start;
$position = [$lines, $off]
unless $position && $position->[-1] < $off;
last;
}
$position = [$lines, $i_start - $line];
$pos++, $lines = 1;
}
last if $position;
last unless $hunk[0] =~ /^ / && shift @hunk
or $hunk[-1] =~ /^ / && pop @hunk;
@context = map /^[ -](.*)/s, @hunk or last;
$fuzz++;
}
# If there's nowhere to apply the first hunk, we check if it is
# a reversed patch.
if ($self->{hunk} == 1) {
if ($self->{reverse_check}) {
$self->{reverse_check} = 0;
if ($position) {
unless ($self->{batch}) {
local $_ = prompt (
'Reversed (or previously applied) patch detected!',
' Assume -R? [y] '
);
if (/^[nN]/) {
$self->{reverse} = 0;
$position = 0;
prompt ('Apply anyway? [n] ') =~ /^[yY]/
or throw('SKIP...ignore this patch');
}
}
} else {
throw('SKIP...ignore this patch') if $self->{forward};
}
}
}
$position or throw("Couldn't find anywhere to put hunk.\n");
} else {
# No context. Use given position.
$position = [$i_start - $self->{i_lines} - 1]
}
my $in = $self->{i_fh};
my $out = $self->{o_fh};
my $def = $self->{d_fh};
my $ifdef = $self->{ifdef};
# Make sure we're where we left off.
seek $in, $self->{i_pos}, 0 or throw("Couldn't seek INFILE: $!");
my $line = $self->{o_lines} + $position->[0] + 1;
my $off = $line - $o_start;
# Set to new position.
$self->{i_lines} += $position->[0];
$self->{o_lines} += $position->[0];
print $out scalar <$in> while $position->[0]--;
# Apply hunk.
my $was = ' ';
for (@hunk) {
/^([ +-])(.*)/s;
my $cmd = substr $_, 0, 1, '';
if ($cmd eq '-') {
$cmd eq $was or print $def "#ifndef $ifdef\n";
print $def scalar <$in>;
$self->{i_lines}++;
} elsif ($cmd eq '+') {
$cmd eq $was or print $def $was eq ' ' ?
"#ifdef $ifdef\n" :
"#else\n";
print $out $_;
$self->{o_lines}++;
} else {
$cmd eq $was or print $def "#endif /* $ifdef */\n";
print $out scalar <$in>;
$self->{i_lines}++;
$self->{o_lines}++;
}
$was = $cmd;
}
$was eq ' ' or print $def "#endif /* $ifdef */\n";
# Keep track of where we leave off.
$self->{i_pos} = tell $in;
# Report success to user.
$self->note("Hunk #$self->{hunk} succeeded at $line.\n");
$self->note(" Offset: $off\n") if $off;
$self->note(" Fuzz: $fuzz\n") if $fuzz;
return 1;
# Or report failure.
CATCH:
$self->{skip}++ if $@ =~ /^SKIP/;
$self->note( $self->{skip}
? "Hunk #$self->{hunk} ignored at $o_start.\n"
: "Hunk #$self->{hunk} failed--$@"
);
return;
}
# Find where an array of lines matches in a file after a given position.
# $match => [array of lines]
# $pos => search after this position and...
# $lines => ...after this many lines after $pos
# Returns the position of the match and the number of lines between the
# starting and matching positions.
sub index {
my ($self, $match, $pos, $lines) = @_;
my $in = $self->{i_fh};
seek($in, $pos, 0) or throw("Couldn't seek INFILE [$in, 0, $pos]: $!");
<$in> while $lines--;
if ($self->{'ignore-whitespace'}) {
s/\s+/ /g for @$match;
}
my $tell = tell $in;
my $line = 0;
while (<$in>) {
s/\s+/ /g if $self->{'ignore-whitespace'};
if ($_ eq $match->[0]) {
my $fail;
for (1..$#$match) {
my $line = <$in>;
$line =~ s/\s+/ /g if $self->{'ignore-whitespace'};
$line eq $match->[$_] or $fail++, last;
}
if ($fail) {
seek($in, $tell, 0) or throw("Couldn't seek INFILE: $!");
<$in>;
} else {
return ($tell, $line);
}
}
$line++;
$tell = tell $in;
}
return;
CATCH: $self->note($@), return;
}
package
Patch::Context; # hide from PAUSE
use base 'Patch';
# Convert hunk to unified diff, then apply.
sub apply {
my ($self, $i_start, $o_start, $i_hunk, $o_hunk) = @_;
my @hunk;
my @i_hunk = @$i_hunk;
my @o_hunk = @$o_hunk;
s/^(.) /$1/ for @i_hunk, @o_hunk;
while (@i_hunk and @o_hunk) {
my ($i, $o) = (shift @i_hunk, shift @o_hunk);
if ($i eq $o) {
push @hunk, $i;
next;
}
while ($i =~ s/^[!-]/-/) {
push @hunk, $i;
$i = shift @i_hunk;
}
while ($o =~ s/^[!+]/+/) {
push @hunk, $o;
$o = shift @o_hunk;
}
push @hunk, $i;
}
push @hunk, @i_hunk, @o_hunk;
$self->SUPER::apply($i_start, $o_start, @hunk);
}
# Check for filename in diff header, then in 'Index:' line.
sub rummage {
my ($self, $garbage) = @_;
my @files = grep -e, map $self->strip,
map /^\s*(?:\*\*\*|---) (\S+)/, @$garbage[-1, -2];
my $file =
@files == 1 ? $files[0] :
@files == 2 ? $files[length $files[0] > length $files[1]] :
$self->SUPER::rummage($garbage);
return $file;
}
package
Patch::Ed; # hide from PAUSE
use base 'Patch';
# Pipe ed script to ed or try to manually process.
sub apply {
my ($self, @cmd) = @_;
$self->{skip} and throw('SKIP...ignore this patch');
my $out = $self->{o_fh};
$self->{check} and goto PLAN_J;
# We start out by adding a magic line to our output. If this line
# is still there after piping to ed, then ed failed. We do this
# because win32 will silently fail if there is no ed program.
my $magic = "#!/i/want/a/moogle/stuffy\n";
print $out $magic;
# Pipe to ed.
eval {
open ED, '|-', 'ed', '-s', $self->{'i_file'} or die "Couldn't fork ed: $!";
print ED map @$_, @cmd or die "Couldn't print ed: $!";
print ED "wq $self->{o_file}\n" or die "Couldn't print ed: $!";
close ED or die "Couldn't close ed: $?";
};
# Did pipe to ed work?
seek($out, 0, 0) or throw("Couldn't seek OUT: $!");
my $testline = <$out>;
if (!$@ && $testline ne $magic) {
$self->note("Hunk #$self->{hunk} succeeded at 1.\n");
return 1;
}
# Erase any trace of magic line.
truncate($out, 0) or throw("Couldn't truncate OUT: $!");
seek($out, 0, 0) or throw("Couldn't seek OUT: $!");
# Try to apply ed script by hand.
$self->note("Pipe to ed failed. Switching to Plan J...\n");
PLAN_J:
# Pre-process each ed command. Ed diffs are reversed (so that each
# command doesn't end up changing the line numbers of subsequent
# commands). But we need to apply diffs in a forward direction because
# our filehandles are oriented that way. So we calculate the @offset
# in line number that this will cause as we go.
my @offset;
for (my $i = 0; $i < @cmd; $i++) {
my @hunk = @{$cmd[$i]};
shift(@hunk) =~ m!^(\d+)(?:,(\d+))?([acds])!
or throw('Unable to parse ed script');
my ($start, $end, $cmd) = ($1, $2 || $1, $3);
# We don't parse substitution commands and assume they all mean
# s/\.\././ even if they really mean s/\s+// or such. And we
# blindly apply the command to the previous hunk.
if ($cmd eq 's') {
$cmd[$i] = '';
s/\.\././ for @{$cmd[$i-1][3]};
next;
}
# Remove '.' line used to terminate hunks.
pop @hunk if $cmd =~ /^[ac]/;
# Calculate where we actually start and end by removing any offsets.
my ($s, $e) = ($start, $end);
for (@offset) {
$start > $_->[0] or next;
$s -= $_->[1];
$e -= $_->[1];
}
# Add to the total offset.
push @offset, [$start, map {
/^c/ ? scalar @hunk - ($end + 1 - $start) :
/^a/ ? scalar @hunk :
/^d/ ? $end + 1 - $start :
0
} $cmd];
# Post-processed command.
$cmd[$i] = [$s, $e, $cmd, \@hunk, $i];
}
# Sort based on calculated start positions or on original order.
# Substitution commands have already been applied and are ignored.
@cmd = sort {
$a->[0] <=> $b->[0] || $a->[-1] <=> $b->[-1]
} grep ref, @cmd;
my $in = $self->{i_fh};
my $def = $self->{d_fh};
my $ifdef = $self->{ifdef};
# Apply each command.
for (@cmd) {
my ($start, $end, $cmd, $hunk) = @$_;
if ($cmd eq 'a') {
my $diff = $start - $self->{i_lines};
print $out scalar <$in> while $diff--;
print $def "#ifdef $ifdef\n";
print $out @$hunk;
$self->{i_lines} = $start;
} elsif ($cmd eq 'd') {
my $diff = $start - $self->{i_lines} - 1;
print $out scalar <$in> while $diff--;
print $def "#ifndef $ifdef\n";
print $def scalar <$in> for $start..$end;
$self->{i_lines} = $end;
} elsif ($cmd eq 'c') {
my $diff = $start - $self->{i_lines} - 1;
print $out scalar <$in> while $diff--;
print $def "#ifndef $ifdef\n";
print $def scalar <$in> for $start..$end;
print $def "#else\n";
print $out @$hunk;
$self->{i_lines} = $end;
}
print $def "#endif /* $ifdef */\n";
}
# Output any lines left in input handle.
print $out readline $in;
# Report success to user.
for (my $i = 0; $i < @cmd; $i++) {
$self->note(
'Hunk #', $i+1, ' succeeded at ',
$cmd[$i - not ref $cmd[$i]][0], "\n",
);
}
return 1;
# Or report failure.
CATCH:
$self->{skip}++ if $@ =~ /^SKIP/;
$self->note( $self->{skip}
? "Hunk #$self->{hunk} ignored at 1.\n"
: "Hunk #$self->{hunk} failed--$@"
);
return;
}
package
Patch::Normal; # hide from PAUSE
use base 'Patch';
# Convert hunk to unified diff, then apply.
sub apply {
my ($self, $i_start, $o_start, $cmd, $d_hunk, $a_hunk) = @_;
$i_start++ if $cmd eq 'a';
$o_start++ if $cmd eq 'd';
my @hunk;
push @hunk, map "-$_", @$d_hunk;
push @hunk, map "+$_", @$a_hunk;
$self->SUPER::apply($i_start, $o_start, @hunk);
}
package
Patch::Unified; # hide from PAUSE
use base 'Patch';
# Check for filename in diff header, then in 'Index:' line.
sub rummage {
my ($self, $garbage) = @_;
my @files = grep -e, map $self->strip,
map /^\s*(?:---|\+\+\+) (\S+)/, @$garbage[-1, -2];
my $file =
@files == 1 ? $files[0] :
@files == 2 ? $files[length $files[0] > length $files[1]] :
$self->SUPER::rummage($garbage);
return $file;
}
package
Pushback; # hide from PAUSE
# Create filehandles that can unread or push lines back into queue.
sub TIEHANDLE {
my ($class, $file) = @_;
my $fh;
if ($file eq '-') {
$fh = *STDIN;
} else {
if (-d $file) {
die "$0: '$file' is a directory\n";
}
unless (open $fh, '<', $file) {
die "$0: failed to open '$file': $!\n";
}
}
bless [$fh], $class;
}
sub READLINE {
my $self = shift;
@$self == 1 ? readline $self->[0] : pop @$self;
}
sub PRINT {
my $self = shift;
$self->[1] = shift;
}
sub CLOSE {
my $self = shift;
$self = undef;
}
__END__
=head1 NAME
patch - apply a diff file to an original
=head1 SYNOPSIS
B<patch> [options] [origfile [patchfile]] [+ [options] [origfile]]...
but usually just
B<patch> E<lt>patchfile
=head1 DESCRIPTION
I<Patch> will take a patch file containing any of the four
forms of difference listing produced by the I<diff> program
and apply those differences to an original file, producing
a patched version. By default, the patched version is put
in place of the original, with the original file backed up
to the same name with the extension ".orig" [see L<"note 1">],
or as specified
by the B<-b>, B<-B>, or B<-V> switches. The extension used for
making backup files may also be specified in the
B<SIMPLE_BACKUP_SUFFIX> environment variable, which is overridden
by above switches.
If the backup file already exists, B<patch> creates a new
backup file name by changing the first lowercase letter in
the last component of the file's name into uppercase. If
there are no more lowercase letters in the name, it
removes the first character from the name. It repeats
this process until it comes up with a backup file that
does not already exist.
You may also specify where you want the output to go with
a B<-o> switch; if that file already exists, it is backed up
first.
If I<patchfile> is omitted, or is a hyphen, the patch will be
read from standard input.
Upon startup, patch will attempt to determine the type of
the diff listing, unless over-ruled by a B<-c>, B<-e>, B<-n>, or
B<-u> switch. Context diffs [see L<"note 2">], unified diffs,
and normal diffs are applied by the I<patch> program itself,
while ed diffs are simply fed to the I<ed> editor via a pipe
[see L<"note 3">].
I<Patch> will try to skip any leading garbage, apply the
diff, and then skip any trailing garbage. Thus you could
feed an article or message containing a diff listing to
I<patch>, and it should work. If the entire diff is indented
by a consistent amount, this will be taken into account.
With context diffs, and to a lesser extent with normal
diffs, I<patch> can detect when the line numbers mentioned in
the patch are incorrect, and will attempt to find the
correct place to apply each hunk of the patch. A linear search
is made for a place where all lines of the context match.
The hunk is applied at the place nearest the line number
mentioned in the diff [see L<"note 4">].
If no such
place is found, and it's a context diff, and the maximum
fuzz factor is set to 1 or more, then another scan takes
place ignoring the first and last line of context. If
that fails, and the maximum fuzz factor is set to 2 or
more, the first two and last two lines of context are
ignored, and another scan is made. (The default maximum
fuzz factor is 2.) If I<patch> cannot find a place to
install that hunk of the patch, it will put the hunk out
to a reject file, which normally is the name of the output
file plus ".rej" [see L<"note 1">]. The format of the
rejected hunk remains unchanged [see L<"note 5">].
As each hunk is completed, you will be told whether the
hunk succeeded or failed, and which line (in the new file)
I<patch> thought the hunk should go on. If this is different
from the line number specified in the diff you will be
told the offset. A single large offset MAY be an indication
that a hunk was installed in the wrong place. You
will also be told if a fuzz factor was used to make the
match, in which case you should also be slightly suspicious.
If no original file is specified on the command line,
I<patch> will try to figure out from the leading garbage what
the name of the file to edit is. In the header of a context
diff, the filename is found from lines beginning with
"***" or "---", with the shortest name of an existing file
winning. Only context diffs have lines like that, but if
there is an "Index:" line in the leading garbage, I<patch>
will try to use the filename from that line. The context
diff header takes precedence over an Index line. If no
filename can be intuited from the leading garbage, you
will be asked for the name of the file to patch.
No attempt is made to look up SCCS or RCS files [see L<"note 6">].
Additionally, if the leading garbage contains a "Prereq: "
line, I<patch> will take the first word from the
prerequisites line (normally a version number) and check
the input file to see if that word can be found. If not,
I<patch> will ask for confirmation before proceeding.
The upshot of all this is that you should be able to say,
while in a news interface, the following:
| patch -d /usr/src/local/blurfl
and patch a file in the blurfl directory directly from the
article containing the patch.
If the patch file contains more than one patch, I<patch> will
try to apply each of them as if they came from separate
patch files. This means, among other things, that it is
assumed that the name of the file to patch must be determined
for each diff listing, and that the garbage before
each diff listing will be examined for interesting things
such as filenames and revision level, as mentioned previously.
You can give switches (and another original file
name) for the second and subsequent patches by separating
the corresponding argument lists by a '+'. (The argument
list for a second or subsequent patch may not specify a
new patch file, however.)
I<Patch> recognizes the following switches:
=over
=item -b or --suffix
causes the next argument to be interpreted as the
backup extension, to be used in place of ".orig"
[see L<"note 1">].
=item -B or --prefix
causes the next argument to be interpreted as a prefix
to the backup file name. If this argument is
specified any argument from B<-b> will be ignored.
=item -c or --context
forces I<patch> to interpret the patch file as a context
diff.
=item -C or --check or --dry-run
checks that the patch would apply cleanly, but does
not modify anything.
=item -d or --directory
causes I<patch> to interpret the next argument as a
directory, and cd to it before doing anything else.
=item -D or --ifdef
causes I<patch> to use the "#ifdef...#endif" construct
to mark changes. The argument following will be used
as the differentiating symbol.
=item -e or --ed
forces I<patch> to interpret the patch file as an ed
script.
=item -E or --remove-empty-files
causes I<patch> to remove output files that are empty
after the patches have been applied.
=item -f or --force
forces I<patch> to assume that the user knows exactly
what he or she is doing, and to not ask any questions.
It assumes the following: skip patches for
which a file to patch can't be found; patch files
even though they have the wrong version for the
``Prereq:'' line in the patch; and assume that
patches are not reversed even if they look like they
are. This option does not suppress commentary; use
B<-s> for that.
=item -t or --batch
similar to B<-f>, in that it suppresses questions, but
makes some different assumptions: skip patches for
which a file to patch can't be found (the same as
B<-f>); skip patches for which the file has the wrong
version for the ``Prereq:'' line in the patch; and
assume that patches are reversed if they look like
they are.
=item -Fnumber or --fuzz number
sets the maximum fuzz factor. This switch only
applies to context diffs, and causes I<patch> to ignore
up to that many lines in looking for places to
install a hunk. Note that a larger fuzz factor
increases the odds of a faulty patch. The default
fuzz factor is 2, and it may not be set to more than
the number of lines of context in the context diff,
ordinarily 3.
=item -l or --ignore-whitespace
causes the pattern matching to be done loosely, in
case the tabs and spaces have been munged in your
input file. Any sequence of whitespace in the pattern
line will match any sequence in the input file.
Normal characters must still match exactly. Each
line of the context must still match a line in the
input file.
=item -n or --normal
forces I<patch> to interpret the patch file as a normal
diff.
=item -N or --forward
causes I<patch> to ignore patches that it thinks are
reversed or already applied. See also B<-R .>
=item -o or --output
causes the next argument to be interpreted as the
output file name.
=item -pnumber or --strip number
sets the pathname strip count, which controls how
pathnames found in the patch file are treated, in
case the you keep your files in a different directory
than the person who sent out the patch. The strip
count specifies how many slashes are to be stripped
from the front of the pathname. (Any intervening
directory names also go away.) For example, supposing
the filename in the patch file was
/i/want/a/moogle/stuffy
setting B<-p> or B<-p0> gives the entire pathname
unmodified, B<-p1> gives
i/want/a/moogle/stuff
without the leading slash, B<-p4> gives
moogle/stuffy
and not specifying B<-p> at all just gives you
"stuffy", unless all of the directories in the
leading path (i/want/a/moogle) exist and that
path is relative, in which case you get the entire
pathname unmodified. Whatever you end up with is
looked for either in the current directory, or the
directory specified by the B<-d> switch.
=item -r or --reject-file
causes the next argument to be interpreted as the
reject file name.
=item -R or --reverse
tells I<patch> that this patch was created with the old
and new files swapped. (Yes, I'm afraid that does
happen occasionally, human nature being what it is.)
I<Patch> will attempt to swap each hunk around before
applying it. Rejects will come out in the swapped
format. The B<-R> switch will not work with ed diff
scripts because there is too little information to
reconstruct the reverse operation.
If the first hunk of a patch fails, I<patch> will
reverse the hunk to see if it can be applied that
way. If it can, you will be asked if you want to
have the B<-R> switch set. If it can't, the patch will
continue to be applied normally. (Note: this method
cannot detect a reversed patch if it is a normal diff
and if the first command is an append (i.e. it should
have been a delete) since appends always succeed, due
to the fact that a null context will match anywhere.
Luckily, most patches add or change lines rather than
delete them, so most reversed normal diffs will begin
with a delete, which will fail, triggering the
heuristic.)
=item -s or --quiet or --silent
makes I<patch> do its work silently, unless an error
occurs.
=item -S or --skip
causes I<patch> to ignore this patch from the patch
file, but continue on looking for the next patch in
the file. Thus
patch -S + -S + < patchfile
will ignore the first and second of three patches.
=item -u or --unified
forces I<patch> to interpret the patch file as a unified
context diff (a unidiff).
=item -v or --version
causes I<patch> to print out its revision header and
patch level.
=item -V or --version-control
causes the next argument to be interpreted as a
method for creating backup file names. The type of
backups made can also be given in the B<VERSION>I<_>B<CONTROL>
environment variable, which is overridden by this
option. The B<-B> option overrides this option, causing
the prefix to always be used for making backup file
names. The value of the B<VERSION>I<_>B<CONTROL> environment
variable and the argument to the B<-V> option are like
the GNU Emacs `version-control' variable; they also
recognize synonyms that are more descriptive. The
valid values are (unique abbreviations are accepted):
=over
=item `t' or `numbered'
Always make numbered backups.
=item `nil' or `existing'
Make numbered backups of files that already
have them, simple backups of the others. This
is the default.
=item `never' or `simple'
Always make simple backups.
=back
=back
=head1 ENVIRONMENT
B<SIMPLE_BACKUP_SUFFIX>
Extension to use for backup file names instead of
".orig" or "~".
B<VERSION_CONTROL>
Selects when numbered backup files are made.
B<PERL_RL>
Used by Term::Readline to select implementation. Unless set,
I<patch> will use Term::Readline::Stub on Windows.
=head1 SEE ALSO
diff(1), ed(1)
=head1 NOTES FOR PATCH SENDERS
There are several things you should bear in mind if you
are going to be sending out patches. First, you can save
people a lot of grief by keeping a patchlevel.h file which
is patched to increment the patch level as the first diff
in the patch file you send out. If you put a Prereq: line
in with the patch, it won't let them apply patches out of
order without some warning. Second, make sure you've
specified the filenames right, either in a context diff
header, or with an Index: line. If you are patching
something in a subdirectory, be sure to tell the patch user to
specify a B<-p> switch as needed. Third, you can create a
file by sending out a diff that compares a null file to
the file you want to create. This will only work if the
file you want to create doesn't exist already in the target
directory. Fourth, take care not to send out reversed
patches, since it makes people wonder whether they already
applied the patch. Fifth, while you may be able to get
away with putting 582 diff listings into one file, it is
probably wiser to group related patches into separate
files in case something goes haywire.
=head1 DIAGNOSTICS
Too many to list here, but generally indicative that I<patch>
couldn't parse your patch file.
The message "Hmm..." indicates that there is unprocessed
text in the patch file and that I<patch> is attempting to
intuit whether there is a patch in that text and, if so,
what kind of patch it is.
=head1 EXIT STATUS
The patch utility exits with status of 0 if the input diff
was applied successfully. If part of the input was rejected
an exit status of 1 is used. Exit status 2 indicates an error
occurred.
=head1 CAVEATS
I<Patch> cannot tell if the line numbers are off in an ed
script, and can only detect bad line numbers in a normal
diff when it finds a "change" or a "delete" command. A
context diff using fuzz factor 3 may have the same problem.
Until a suitable interactive interface is added, you
should probably do a context diff in these cases to see if
the changes made sense. Of course, compiling without
errors is a pretty good indication that the patch worked,
but not always.
I<Patch> usually produces the correct results, even when it
has to do a lot of guessing. However, the results are
guaranteed to be correct only when the patch is applied to
exactly the same version of the file that the patch was
generated from.
=head1 BUGS
Could be smarter about partial matches, excessively
deviant offsets and swapped code, but that would take an
extra pass.
Check patch mode ( B<-C>) will fail if you try to check
several patches in succession that build on each other. The
whole code of I<patch> would have to be restructured to keep
temporary files around so that it can handle this situation.
If code has been duplicated (for instance with
#ifdef OLDCODE ... #else ... #endif), I<patch> is incapable
of patching both versions, and, if it works at all, will likely
patch the wrong one, and tell you that it succeeded to
boot.
If you apply a patch you've already applied, I<patch> will
think it is a reversed patch, and offer to un-apply the
patch. This could be construed as a feature.
=head1 COMPATIBILITY
The perl implementation of patch is based on but not entire compatible with the
documentation for GNU patch version 2.1:
=head2 note 1
On systems that do not support long filenames,
GNU patch uses the extension "~" for backup files and the extension "#" for
reject files.
How to know if a system support long filenames?
=head2 note 2
Only new-style context diffs are supported.
What does old-style context diff look like?
=head2 note 3
If the pipe to ed fails, B<patch> will attempt to apply the ed script on its
own.
=head2 note 4
This algorithm differs from the one described in the documentation for GNU
patch, which scans forwards and backwards from the line number mentioned in the
diff (plus any offset used in applying the previous hunk).
=head2 note 5
Rejected hunks in GNU patch all come out as context diffs regardless of the
input diff, and the lines numbers reflect the approximate location GNU patch
thinks the failed hunks belong in the new file rather than the old one.
=head2 note 6
If the original file cannot be found or is read-only, but a suitable SCCS or RCS
file is handy, GNU patch will attempt to get or check out the file.
=head1 AUTHOR
The Perl implementation of I<patch> was written by Tim Gim Yee,
I<tim.gim.yee@gmail.com>.
=head1 COPYRIGHT and LICENSE
This program is copyright (c) Tim Gim Yee 1999.
This program is free and open software. You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.
You may use this documentation under the auspices of the GNU General Public
License.
=cut