view release on metacpan or  search on metacpan

bin/patch  view on Meta::CPAN

    ];
    exit EX_SUCCESS;
}

sub type_conflict {
    my $opts = shift;
    my @types;
    my $i = 0;
    for (qw(context ed normal unified)) {
        push @types, '--' . $_ if $opts->{$_};
    }
    if (scalar(@types) > 1) {
        warn "$0: incompatible input type specifiers: @types\n";
        exit EX_FAILURE;
    }
    return;
}

sub ifdef_id_check {
    my $id = shift;
    return if (length($id) != 0 && $id =~ m/\A[A-Za-z]\w*\Z/);
    warn "$0: argument to -D is not an identifier\n";
    exit EX_FAILURE;
}

my ($patchfile, @options);

if (@ARGV) {
    require Getopt::Long;
    Getopt::Long::Configure(qw/
        bundling
        no_ignore_case
    /);

    # List of supported options and acceptable arguments.
    my @desc = qw/
        suffix|b=s              force|f                 reject-file|r=s
        prefix|B=s              batch|t                 reverse|R
        context|c               fuzz|F=i                silent|quiet|s
        check|dry-run|C         ignore-whitespace|l     skip|S
        directory|d=s           normal|n                unified|u
        ifdef|D=s               forward|N               version|v
        ed|e                    output|o=s              version-control|V=s
        remove-empty-files|E    strip|p=i
    /;

    # Each patch may have its own set of options.  These are separated by
    # a '+' on the command line.
    my @opts;
    for (@ARGV, '+') {  # Now '+' terminated instead of separated...
        if ($_ eq '+') {
            push @options, [splice @opts, 0];
        } else {
            push @opts, $_;
        }
    }

    # Parse each set of options into a hash.
    my $next = 0;
    for (@options) {
        local @ARGV = @$_;
        my %opts;
        Getopt::Long::GetOptions(\%opts, @desc) or die("Bad options\n");
        type_conflict(\%opts);
        ifdef_id_check($opts{'ifdef'}) if defined $opts{'ifdef'};
        $opts{origfile} = shift;
        $_ = \%opts;
        $patchfile = shift unless $next++;
        version() if $opts{'version'};
    }
}

$patchfile = '-' unless defined $patchfile;

my $patch = Patch->new(@options);

if (defined $patch->{'directory'}) {
    unless (chdir $patch->{'directory'}) {
        die "failed to change to directory '$patch->{directory}': $!\n";
    }
}
if (defined $patch->{'fuzz'} && $patch->{'fuzz'} < 0) {
    die "$0: fuzz factor is negative: $patch->{fuzz}\n";
}
tie *PATCH, Pushback => $patchfile or die "Can't open '$patchfile': $!";

# Extract patches from patchfile.  We unread/pushback lines by printing to
# the PATCH filehandle:  'print PATCH'
PATCH:
while (<PATCH>) {
    if (/^(\s*)(\@\@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? \@\@(.*)\n)/) {
        # UNIFIED DIFF
        my ($space, $range, $i_start, $i_lines, $o_start, $o_lines) =
           ($1,     $2,     $3,       $4 || 1,  $5,       $6 || 1);
        $patch->bless('unified') or next PATCH;
        my @hunk;
        my %saw = map {$_, 0} split //, ' +-';
        my $re = qr/^$space([ +-])/;
        while (<PATCH>) {
            unless (s/$re/$1/) {
                $patch->note("Short hunk ignored.\n");
                $patch->reject($range, @hunk);
                print PATCH;
                next  PATCH;
            }
            push @hunk, $_;
            $saw{$1}++;
            last if $saw{'-'} + $saw{' '} == $i_lines
                 && $saw{'+'} + $saw{' '} == $o_lines;
        }
        $patch->apply($i_start, $o_start, @hunk)
            or $patch->reject($range, @hunk);
    } elsif (/^(\s*)\*{15}$/) {
        # CONTEXT DIFF
        my $space = $1;
        $_ = <PATCH>;
        unless (/^$space(\*\*\* (\d+)(?:,(\d+))? \*\*\*\*\n)/) {
            print PATCH;
            next  PATCH;
        }
        my ($i_range, $i_start, $i_end, @i_hunk) = ($1, $2, $3 || $2);