Template::Patch - Apply parameterized patches

    $ metapatch --patch mychanges.mp < oldfile > newfile

    # or, programmatically:

    use Template::Patch;

    my $tp = Template::Patch->parse_patch_file($metapatch_file);
    $tp->extract($source);
    $tp->patch;
    $tp->print;

    perldoc Template::Patch

package Template::Patch;

use warnings;
use strict;

use Template::Extract;
use Template;

use base 'Class::Accessor::Ref';

our $VERSION = '0.03';

BEGIN {
    my @accs = (qw/ inp outp vars routput rinput _ext _tt conf/); 
    __PACKAGE__->mk_accessors(@accs);
    __PACKAGE__->mk_refaccessors(@accs);
 }

sub new_from_file {
    my($class, $pfile) = @_;
    my($to, $from);

    die "$0: must supply --patch arg" unless defined $pfile;

    my $self = $class->new( { vars => {},
            conf => {}, routput => do{\my $output_port} } );

    open my $fh, "<", $pfile or die "$0: open: $pfile: $!";
    while (<$fh>) {
        if (!$from) {
            $from++, next if /^<{20}/;
            next if /^#/;
            $self->conf->{$1} = $2 if /([^:]+) \s* : \s* (.*?) \s* $/x;
        }

        $to++, next if /^>{20}/;

        ${ $self->get_ref($to ? 'outp' : 'inp' ) } .= $_;
    }
    die "$0: $pfile: no output template" unless $self->outp;


    # conf-related fixups
       # xxx: higher-order this, ew
    if (! $self->conf->{'anchor-start'}) {
        for my $tname (qw/ inp outp /) {
            my $tref = $self->get_ref($tname);
            $$tref = "[% pre %]" . $$tref;
        }
    }
    if (! $self->conf->{'anchor-end'}) {
        for my $tname (qw/ inp outp /) {
            my $tref = $self->get_ref($tname);
            chomp $$tref;
            $$tref .= "[% post %]";
        }
    }

    #::YY($self);
    return $self;
}

sub extract {
    my($self, $input) = @_;
    $self->_ext( Template::Extract->new );
    $self->_ext->extract(
            $self->inp,         # input template
            $input,             # actual data to parse
            $self->vars,        # dictionary for extracted data
        );
    # we need to keep a ref to input around for the case where no extraction
    # was successful.
    $self->rinput(\$input);
    #::YY($self->vars);
}

sub patch {
    my($self) = @_;

    # if the dictionary is empty, extract didn't find anything.
    # copy over the input, so we don't emit just a broken template.
    # XXX: copy or ref?
    if (0 == keys %{ $self->vars }) {
        $self->routput( $self->rinput );
        return;
    }

    $self->_tt( Template->new );
    $self->_tt->process( \$self->outp, $self->vars, $self->routput )
}

sub print { print ${ $_[0]->routput } }

#sub ::Y  { require YAML::Syck; YAML::Syck::Dump(@_) }
#sub ::YY { require Carp; Carp::confess(::Y(@_)) }

1; # End of Template::Patch