view release on metacpan or  search on metacpan

inc/bin/patch  view on Meta::CPAN

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

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