view release on metacpan or  search on metacpan

inc/bin/patch  view on Meta::CPAN

    # 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 @_;
    $self->note("Skipping patch...\n");
    $self->{skip}++;
    goto SKIP;
}

# Let user know what's happening.
sub note {
    my $self = shift;
    print @_ 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;