view release on metacpan or  search on metacpan

inc/bin/patch  view on Meta::CPAN

        # 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;