From 9a0ad8eb085db81bee913516f774bba1ee853c60 Mon Sep 17 00:00:00 2001 From: Gaal Yahas Date: Mon, 20 Mar 2006 22:20:12 +0200 Subject: [PATCH] initial import of Template::Patch 0.01 from CPAN git-cpan-module: Template::Patch git-cpan-version: 0.01 --- Build.PL | 23 +++++ Changes | 5 + MANIFEST.SKIP | 8 ++ README | 42 +++++++++ bin/metapatch | 212 ++++++++++++++++++++++++++++++++++++++++++ lib/Template/Patch.pm | 183 ++++++++++++++++++++++++++++++++++++ t/00-load.t | 9 ++ t/01-basic.t | 40 ++++++++ t/basic1.mp | 4 + t/boilerplate.t | 48 ++++++++++ t/pod-coverage.t | 7 ++ t/pod.t | 6 ++ 12 files changed, 587 insertions(+) create mode 100644 Build.PL create mode 100644 Changes create mode 100644 MANIFEST.SKIP create mode 100644 README create mode 100644 bin/metapatch create mode 100644 lib/Template/Patch.pm create mode 100644 t/00-load.t create mode 100644 t/01-basic.t create mode 100644 t/basic1.mp create mode 100644 t/boilerplate.t create mode 100644 t/pod-coverage.t create mode 100644 t/pod.t diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..60a65ad --- /dev/null +++ b/Build.PL @@ -0,0 +1,23 @@ +use strict; +use warnings; +use Module::Build; + +my $builder = Module::Build->new( + module_name => 'Template::Patch', + license => 'perl', + dist_author => 'Gaal Yahas ', + dist_version_from => 'lib/Template/Patch.pm', + build_requires => { + 'Test::More' => 0, + 'Test::Exception' => 0, + }, + requires => { + 'Template' => 0, + 'Template::Extract' => 0, + }, + script_files => [ qw< bin/metapatch/ > ], + sign => 1, + add_to_cleanup => [ 'Template-Patch-*' ], +); + +$builder->create_build_script(); diff --git a/Changes b/Changes new file mode 100644 index 0000000..ba476c3 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Template-Patch + +0.01 2006-03-20 + First version, released on an unsuspecting world. + diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..22dd3b8 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,8 @@ +\.vim$ +\.cvsignore +\.swp$ +^_build +^blib +^Build$ +Template-Patch-.*\.tar\.gz +\.bak$ diff --git a/README b/README new file mode 100644 index 0000000..28e076a --- /dev/null +++ b/README @@ -0,0 +1,42 @@ +Template-Patch + +Parameterized patch tool. + +Install like many CPAN modules. metapatch is the tool you should be looking at. + +INSTALLATION + +To install this module, run the following commands: + + perl Build.PL + ./Build + ./Build test + ./Build install + + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the perldoc command. + + perldoc Template::Patch + +You can also look for information at: + + Search CPAN + http://search.cpan.org/dist/Template-Patch + + CPAN Request Tracker: + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Template-Patch + + AnnoCPAN, annotated CPAN documentation: + http://annocpan.org/dist/Template-Patch + + CPAN Ratings: + http://cpanratings.perl.org/d/Template-Patch + +COPYRIGHT AND LICENCE + +Copyright (C) 2006 Gaal Yahas + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. diff --git a/bin/metapatch b/bin/metapatch new file mode 100644 index 0000000..3617b02 --- /dev/null +++ b/bin/metapatch @@ -0,0 +1,212 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use Getopt::Long; + +use Template::Patch; + +GetOptions \our %Conf, qw(patch|p=s); + +my $p = Template::Patch->new_from_file($Conf{patch}); + +my $input = slurp_in(); +$p->extract($input); +$p->patch; + +$p->print; + +exit 0; + +sub slurp_in { local $/; <> } + +# vim: ts=4 et : + +__END__ + +=head1 NAME + +metapatch - Apply parameterized patches + +=head1 SYNOPSIS + + $ 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; + +=head1 DESCRIPTION + +C and C are fine tools for applying changes to files. But +sometimes you need to apply a change that cannot be expressed with one +diff, for example, you have some parts that differ among files but which +you wish to preserve: + + # file1 + + sub init { + info "init called"; + # ... + + # file2 + + sub init { + info "init called (and oh, this is file2)"; + # ... + +Suppose you want to go over all your init functions, and change the C +calls to C. You don't want to blindly C +because you may have legitimate info prints elsewhere in the files that you +wish to leave alone. You can't blindly patch C to use +C, because the text of the log message isn't identical. You I +write a simple parser that looks for the first log message after an C +call, but that's coding; and you I do this with a regexp, but that's +not very nice to maintain. + +C lets you write I describing your intended +change. It uses L and L to describe +what an interesting change would be. Because the input is first processed +with L, you can access a dictionary of extracted values +by name when describing your output. This can improve readability of your +patch by giving names to data you rearrange or just pass through. It can +also be used for fancy templating stuff like repeating an interesting +line from the input several times in the output. + +The metapatch for performing the change described above is: + + <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + sub init { + info [% message %] + >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + sub init { + debug [% message %] + +=head1 METAPATCH FORMAT + +A I (typically with the extension C<.mp>) has three +sections. Two separators (of twenty C<< < >>s and twenty C<< > >>s in +turn) keep them apart. (The separator lines may have more than twenty +characters, everything after the first 20 is ignored until the line +end.) XXX: this is stupid. If you have a better idea, please let me know. + +The first section (which may be empty) contains metapatch configuration +directives. See the Configuration section for details. + +The second ("IN") section (after the C<< < >> separator) contains +a TT2 template of expected text in the input file. It is fed to +L, and variables extracted are kept around. + +The third ("OUT") section (after the C<< > >> separator) contains a TT2 +template of replacement text that goes in the output. Any TT2 directives +are allowed. In particular, you may use variables extracted in the "IN" +section. + +=head2 Configuration + +Configuration directives are optional. If they appear, they must be in +C format, one per line. Blanks and lines starting with C<#> +are ignored. + +By default, the metapatch is not anchored. This means that implicitly, +it is surrounded by C<[% pre %] ... [% post %]> variables, which are +then emitted as-is in the output. + +To force your template to the beginning of the text, set the +C configuration parameter. + +To force your template to the end of the text, set the C +configuration parameter. + +=head1 TODO + +All these need more design. + +=over 4 + +=item * Repeat matches in IN + +=item * Can several unrelated and order-indifferent chunks of mp live together in one file? + +=item * The metapatch format is silly + +=back + +=head1 SEE ALSO + +=over 4 + +=item * L + +=item * L + +=item * L + +=back + +=head1 AUTHOR + +Gaal Yahas, C<< >> + +=head1 CAVEATS + +This tool and the included L module are in early stages +of gathering ideas and coming up with a good interface. They work (and have +saved me time), but expect change in the interfaces. + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. +I will be notified, and then you'll automatically be notified of progress on +your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Template::Patch + +You can also look for information at: + +=over 4 + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * RT: CPAN's request tracker + +L + +=item * Search CPAN + +L + +=back + +=head1 ACKNOWLEDGEMENTS + +Thanks to Audrey Tang for sausage machine (and general) havoc. + +=head1 COPYRIGHT & LICENSE + +Copyright 2006 Gaal Yahas, all rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; # End of Template::Patch diff --git a/lib/Template/Patch.pm b/lib/Template/Patch.pm new file mode 100644 index 0000000..77763ac --- /dev/null +++ b/lib/Template/Patch.pm @@ -0,0 +1,183 @@ +package Template::Patch; + +use warnings; +use strict; + +use Template::Extract; +use Template; + +use base 'Class::Accessor::Ref'; + +our $VERSION = '0.01'; + +BEGIN { + my @accs = (qw/ inp outp vars output _ext _tt conf/); + __PACKAGE__->mk_accessors(@accs); + __PACKAGE__->mk_refaccessors(@accs); + } + +=head1 NAME + +Template::Patch - Apply parameterized patches + +=head1 SYNOPSIS + + $ 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; + +=head1 DESCRIPTION + +Please see L for documentation. This module is experimental and +the API here is subject to change. + +=head1 FUNCTIONS + +This isn't very streamlined yet, and is subject to change. + +=cut + +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 => {} } ); + + 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 + ); + #::YY($self->vars); +} + +sub patch { + my($self) = @_; + $self->_tt( Template->new ); + $self->_tt->process( \$self->outp, $self->vars, $self->_ref_output ) +} + +sub print { print $_[0]->output } + +sub ::Y { require YAML::Syck; YAML::Syck::Dump(@_) } +sub ::YY { require Carp; Carp::confess(::Y(@_)) } + +=head1 SEE ALSO + +=over 4 + +=item L + +=item L + +=item L + +=back + +=head1 AUTHOR + +Gaal Yahas, C<< >> + +=head1 CAVEATS + +This module and the included C tool are in early stages of +gathering ideas and coming up with a good interface. They work (and have +saved me time), but expect change in the interfaces. + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. +I will be notified, and then you'll automatically be notified of progress on +your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Template::Patch + +You can also look for information at: + +=over 4 + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * RT: CPAN's request tracker + +L + +=item * Search CPAN + +L + +=back + +=head1 ACKNOWLEDGEMENTS + +Thanks to Audrey Tang for sausage machine (and general) havoc. + +=head1 COPYRIGHT & LICENSE + +Copyright 2006 Gaal Yahas, all rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; # End of Template::Patch diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..e2c3200 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Template::Patch' ); +} + +diag( "Testing Template::Patch $Template::Patch::VERSION, Perl $], $^X" ); diff --git a/t/01-basic.t b/t/01-basic.t new file mode 100644 index 0000000..8e2c117 --- /dev/null +++ b/t/01-basic.t @@ -0,0 +1,40 @@ +#!perl -T + +use File::Spec; +use Test::Exception; + +use Test::More tests => 7; + +our $FS = "File::Spec"; + +BEGIN { + use_ok( 'Template::Patch' ); +} + +diag( "Testing Template::Patch $Template::Patch::VERSION, Perl $], $^X" ); + +dies_ok { Template::Patch->new_from_file("no_such_file") } + "can't read from metapatch file that doesn't exist"; + +my $tp; + +lives_ok { $tp = Template::Patch->new_from_file($FS->catfile(qw/t basic1.mp/)); } + "construct patch object with .mp file"; + +isa_ok $tp, "Template::Patch", "has correct type"; + +my $doc = <<'.'; +I went to the doctor and guess what he told me. + +Say AAAHHH! +. + +lives_ok { $tp->extract($doc) } "patch extraction lives"; + +lives_ok { $tp->patch($doc) } "patch application lives"; + +(my $expected = $doc) =~ s/AAA/BBB/; + +is $tp->output, $expected, "patch applied correctly"; + +# vim: ts=4 et : diff --git a/t/basic1.mp b/t/basic1.mp new file mode 100644 index 0000000..857b37e --- /dev/null +++ b/t/basic1.mp @@ -0,0 +1,4 @@ +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +AAA[% etc %] +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +BBB[% etc %] diff --git a/t/boilerplate.t b/t/boilerplate.t new file mode 100644 index 0000000..61704c2 --- /dev/null +++ b/t/boilerplate.t @@ -0,0 +1,48 @@ +#!perl -T + +use strict; +use warnings; +use Test::More tests => 3; + +sub not_in_file_ok { + my ($filename, %regex) = @_; + open my $fh, "<", $filename + or die "couldn't open $filename for reading: $!"; + + my %violated; + + while (my $line = <$fh>) { + while (my ($desc, $regex) = each %regex) { + if ($line =~ $regex) { + push @{$violated{$desc}||=[]}, $.; + } + } + } + + if (%violated) { + fail("$filename contains boilerplate text"); + diag "$_ appears on lines @{$violated{$_}}" for keys %violated; + } else { + pass("$filename contains no boilerplate text"); + } +} + +not_in_file_ok(README => + "The README is used..." => qr/The README is used/, + "'version information here'" => qr/to provide version information/, +); + +not_in_file_ok(Changes => + "placeholder date/time" => qr(Date/time) +); + +sub module_boilerplate_ok { + my ($module) = @_; + not_in_file_ok($module => + 'the great new $MODULENAME' => qr/ - The great new /, + 'boilerplate description' => qr/Quick summary of what the module/, + 'stub function definition' => qr/function[12]/, + ); +} + +module_boilerplate_ok('lib/Template/Patch.pm'); diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..87bc8b2 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,7 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; +plan skip_all => "Test::Pod::Coverage is a little too draconic for my taste" unless $ENV{BITE_THE_BULLET}; +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..976d7cd --- /dev/null +++ b/t/pod.t @@ -0,0 +1,6 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; +all_pod_files_ok();