Alien-wxWidgets

 view release on metacpan or  search on metacpan

inc/bin/patch  view on Meta::CPAN

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;

inc/bin/patch  view on Meta::CPAN

    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;

inc/bin/patch  view on Meta::CPAN

                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};
                }
            } else {
                unless ($position || $self->{reverse} || $self->{force}) {
                    $self->{reverse_check} = 1;
                    $self->{reverse} = 1;
                    shift;
                    return $self->apply(@_);
                }
            }
        }
        $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]--;

inc/bin/patch  view on Meta::CPAN

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

inc/bin/patch  view on Meta::CPAN

package Patch::Ed;

BEGIN { Patch->import }

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

inc/bin/patch  view on Meta::CPAN

        close ED                             or die "Couldn't close ed: $?";
    };

    # Did pipe to ed work?
    unless ($@ or <$out> 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;