=head1 NAME

Package::Butcher - When you absolutely B<have> to load that damned package.

=head1 ALPHA CODE

You've been warned. It also has an embarrassingly poor test suite. It was
hacked together in an emergency while sitting in a hospital waiting for my
daughter to be born. Sue me.

=head1 VERSION

Version 0.01

=cut

=head1 SYNOPSIS

   my $butcher = Package::Butcher->new(
       {
           package     => 'Dummy',
           do_not_load => [qw/Cannot::Load Cannot::Load2 NoSuch::List::MoreUtils/],
           predeclare  => 'uniq',
           subs => {
               this     => sub { 7 },
               that     => sub { 3 },
               existing => sub { 'replaced existing' },
           },
           method_chains => [
               [
                   'Cannot::Load' => qw/foo bar baz this that/ => sub {
                       my $args = join ', ' => @_;
                       return "end chain: $args";
                   },
               ],
           ],
       }
   );
   $butcher->use(@optional_import_list);

=head1 DESCRIPTION

Sometimes you need to load a module which won't otherwise load. Unit testing
is a good reason. Unfortunately, some modules are just very, very difficult to
load. This module is a nasty hack with a name designed to make this clear.
It's here to provide a standard set of tools to let you load these problem
modules.

=head1 USAGE

To use this module, let's consider the following awful module:

   package Dummy;

   use strict;
   use Cannot::Load;
   use NoSuch::List::MoreUtils 'uniq';
   use DBI;

   use base 'Exporter';
   our @EXPORT_OK = qw(existing);

   sub existing { 'should never see this' }

   # this strange construct forces a syntax error
   sub filter {
       uniq map {lc} split /\W+/, shift;
   }

   sub employees {
       my @connect =
         ( 'dbi:Pg:dbname=ourdb', '', '', { AutoCommit => 0 } );
       return DBI->connect(@connect)
         ->selectall_arrayref(
           'SELECT id, name, position FROM employees ORDER BY id');
   }

   sub recipes {
       my @connect = ( 'dbi:Pg:dbname=ourdb', '', '', { AutoCommit => 0 } );
       return DBI->connect(@connect)
         ->selectall_arrayref('SELECT id, name FROM recipes');
   }

   1;

You probably cannot load this. You don't have C<Cannot::Load> or
C<NoSuch::List::MoreUtils> available. What's worse, even if you try to stub
them out and fake this, the C<employees> and C<recipes>  methods might be
frustrating.  We'll use this as an example of how to use C<Package::Butcher>.

=head1 METHODS

=head2 C<new>

The constructor for C<Package::Butcher> takes a hashref with several allowed
keys. For example, the following will allow the C<Dummy> package above to
load:

   my $dummy = Package::Butcher->new({
       package => 'Dummy',
       do_not_load =>
         [qw/Cannot::Load NoSuch::List::MoreUtils DBI/],
       predeclare => 'uniq',
       subs       => {
           existing       => sub { 'replaced existing' },
           reverse_string => sub {
               my $arg = shift;
               return scalar reverse $arg;
           },
       },
       method_chains => [
           [
               'Cannot::Load' => qw/foo bar baz this that/ => sub {
                   my $args = join ', ' => @_;
                   return "end chain: $args";
               },
           ],
           [
               'DBI' => qw/connect selectall_arrayref/ => sub {
                   my $sql = shift;
                   return (
                       $sql =~ /\brecipes\b/
                       ? [
                           [qw/1 bob secretary/],
                           [qw/2 alice ceo/],
                           [qw/3 ovid idiot/],
                         ]
                       : [ [ 1, 'Tartiflette' ], [ 2, 'Eggs Benedict' ], ];
                },
            ],
       ],
   });

Here are the allowed keys to the constructor:

=over 4

=item * C<package>

The name of the package to be butchered.

package => 'Hard::To::Load::Package'

=item * C<do_not_load>

Packages which must not be loaded. This is useful when there are a bunch of
C<use> or C<require> statements in the code which cause the target code to try
and load packages which may not be loadable.

do_not_load => [
   'Apache::Never::Loads',
   'Module::I::Do::Not::Have::Installed',
   'Win32::Anything',
]

=item * C<predeclare>

Sometimes you need to simply predeclare a method or subroutine to ensure it
parses correctly, even if you don't need to execute that function (for
example, if you're replacing a subroutine which contains the offending code).
To do this, you can simply "predeclare a function or arrayref of functions
with optional prototypes.

predeclare => [ 'uniq (@)', 'some_other_function' ]

=item * C<subs>

This should point to a hashref of subroutine names and sub bodies. These will
be added to the package, overwriting any subroutines already there:

subs => {
    existing       => sub { 'replaced existing' },
    reverse_string => sub {
        my $arg = shift;
        return scalar reverse $arg;
    },
},

Note that any subroutinine listed in the C<subs> section will automatically be
predeclared.

=item * C<method_chains>

Method "chains" are frequent in bad code (and even in some good code). This is
when you see a class with a list of chained methods getting called. For
example:

return DBI->connect(@connect)
  ->selectall_arrayref(
    'SELECT id, name, position FROM employees ORDER BY id');

The butcher allows you to declare a method chain and a subref which will be
executed. The structure is like this:

method_chains => [
   [ $class1, @list_of_methods1, sub { @body } ],
   [ $class2, @list_of_methods2, sub { @body } ],
   [ $class3, @list_of_methods3, sub { @body } ],
],

For the DBI example above, assuming this was the only method chain in the
code, you would have something like:

method_chains => [
   [ 'DBI', qw/connect selectall_arrayref/, \&some_sub ],
],

See C<Package::Butcher::Inflator> code to see how this works.

=item * C<import_on_use>

This defaults to false and you should hopefully not need it.

As a general rule, if you call C<< $butcher->use >>, the package's C<import>
method will be called I<after> you use the class to allow us to inject the new
code before importing. This means that if a class exports a 'foo' method and
you've replaced it with your own, you are generally guaranteed to get your
replacement when you call:

$butcher->use('foo');

However, if you class requires that the C<import> method be called at the at
time the class is "use"d, then you can specify this in the constructor:

import_on_use => 1,

=back

=head2 C<use>

my $butcher = Package::Butcher->new({ package ... });
$butcher->use(@import_list);

Once constructed, this method will "use" the package in question. You may pass
it the same import list that the package you're butchering takes. Note that if
you override C<import>, you're on your own.

=head2 C<require>

my $butcher = Package::Butcher->new({ package ... });
$butcher->require;

Like use, but does a C<require>.

=head1 AUTHOR

Curtis 'Ovid' Poe, C<< <ovid at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-package-butcher at
rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Package-Butcher>.  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 Package::Butcher


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Package-Butcher>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Package-Butcher>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Package-Butcher>

=item * Search CPAN

L<http://search.cpan.org/dist/Package-Butcher/>

=back

=head1 ACKNOWLEDGEMENTS

Flavio Glock for help with a parsing error.

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Curtis 'Ovid' Poe.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1;

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.