view release on metacpan or  search on metacpan

inc/bin/patch  view on Meta::CPAN

    $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: '
            );
        }
    }

    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}) {
        $self->note("Patching file $orig using Plan T...\n");
        local $_ = $self->{output};
        $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.
    local *IN;
    open IN, "< $in" or $self->skip("Couldn't open INFILE: $!\n");
    binmode IN;
    $self->{i_fh} = *IN;    # input filehandle
    $self->{i_file} = $in;  # input filename

    # Like /dev/null
    local *NULL;
    tie *NULL, 'Dev::Null';

    # Open output file.
    if ($self->{check}) {
        $self->{o_fh} = \*NULL;     # output filehandle
        $self->{d_fh} = \*NULL;     # ifdef filehandle
    } else {
        local *OUT;
        open OUT, "+> $out" or $self->skip("Couldn't open OUTFILE: $!\n");
        binmode OUT;
        $|++, select $_ for select OUT;
        $self->{o_fh}   = *OUT;
        $self->{o_file} = $out;
        $self->{d_fh}   = length $self->{ifdef} ? *OUT : \*NULL;
    }

    $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 @_;