Alien-wxWidgets
view release on metacpan or search on metacpan
inc/bin/patch view on Meta::CPAN
exit;
}
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|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 debug|x=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 = @$_;
Getopt::Long::GetOptions(\my %opts, @desc);
$opts{origfile} = shift;
$_ = \%opts;
$patchfile = shift unless $next++;
}
}
$patchfile = '-' unless defined $patchfile;
my $patch = Patch->new(@options);
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') {
$patch->note("Hmm... I can't seem to find a patch in there anywhere.\n");
} else {
$patch->end;
}
$patch->note("done\n");
exit $patch->error ? 1 : 0;
END {
close STDOUT || die "$0: can't close stdout: $!\n";
$? = 1 if $? == 255; # from die
}
package Patch;
use vars qw/$ERROR/;
# Class data.
BEGIN {
$ERROR = 0;
}
sub import {
no strict 'refs';
*{caller() . '::throw'} = \&throw;
@{caller() . '::ISA'} = 'Patch';
}
# 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.
sub prompt {
print @_;
local $_ = <STDIN>;
chomp;
$_;
}
# 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->{fuzz} >= 0;
$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");
# Change directories.
for ($self->{directory}) {
defined or last;
chdir $_ or $self->skip("Can't chdir '$_': $!\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 ($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: '
inc/bin/patch view on Meta::CPAN
return if $self->{skip};
$self->print_rejects;
$self->remove_empty_files;
}
package Patch::Normal;
BEGIN { Patch->import }
# 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;
BEGIN { Patch->import }
# 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;
# Create filehandles that can unread or push lines back into queue.
sub TIEHANDLE {
my ($class, $file) = @_;
local *FH;
open *FH, "< $file" or return;
binmode FH;
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;
}
package Dev::Null;
# Create filehandles that go nowhere.
sub TIEHANDLE { bless \my $null }
sub PRINT {}
sub PRINTF {}
sub WRITE {}
sub READLINE {''}
sub READ {''}
sub GETC {''}
__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>I<_>B<BACKUP>I<_>B<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
( run in 1.076 second using v1.01-cache-2.11-cpan-9581c071862 )