/usr/share/perl5/Class/MakeMethods/Composite/Universal.pm is in libclass-makemethods-perl 1.01-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | =head1 NAME
Class::MakeMethods::Composite::Universal - Composite Method Tricks
=head1 SYNOPSIS
Class::MakeMethods::Composite::Universal->make_patch(
-TargetClass => 'SomeClass::OverYonder',
name => 'foo',
pre_rules => [
sub {
my $method = pop;
warn "Arguments for foo:", @_
}
]
post_rules => [
sub {
warn "Result of foo:", Class::MakeMethods::Composite->CurrentResults
}
]
);
=head1 DESCRIPTION
The Composite::Universal suclass of MakeMethods provides some generally-applicable types of methods based on Class::MakeMethods::Composite.
=cut
package Class::MakeMethods::Composite::Universal;
$VERSION = 1.000;
use strict;
use Class::MakeMethods::Composite '-isasubclass';
use Carp;
########################################################################
=head1 METHOD GENERATOR TYPES
=head2 patch
The patch ruleset generates composites whose core behavior is based on an existing subroutine.
Here's a sample usage:
sub foo {
my $count = shift;
return 'foo' x $count;
}
Class::MakeMethods::Composite::Universal->make(
-ForceInstall => 1,
patch => {
name => 'foo',
pre_rules => [
sub {
my $method = pop @_;
if ( ! scalar @_ ) {
@{ $method->{args} } = ( 2 );
}
},
sub {
my $method = pop @_;
my $count = shift;
if ( $count > 99 ) {
Carp::confess "Won't foo '$count' -- that's too many!"
}
},
],
post_rules => [
sub {
my $method = pop @_;
if ( ref $method->{result} eq 'SCALAR' ) {
${ $method->{result} } =~ s/oof/oozle-f/g;
} elsif ( ref $method->{result} eq 'ARRAY' ) {
map { s/oof/oozle-f/g } @{ $method->{result} };
}
}
],
},
);
=cut
use vars qw( %PatchFragments );
sub patch {
(shift)->_build_composite( \%PatchFragments, @_ );
}
%PatchFragments = (
'' => [
'+init' => sub {
my $method = pop @_;
my $origin = ( $Class::MethodMaker::CONTEXT{TargetClass} || '' ) .
'::' . $method->{name};
no strict 'refs';
$method->{patch_original} = *{ $origin }{CODE}
or croak "No subroutine $origin() to patch";
},
'do' => sub {
my $method = pop @_;
my $sub = $method->{patch_original};
&$sub( @_ );
},
],
);
=head2 make_patch
A convenient wrapper for C<make()> and the C<patch> method generator.
Provides the '-ForceInstall' flag, which is required to ensure that the patched subroutine replaces the original.
For example, one could add logging to an existing method as follows:
Class::MakeMethods::Composite::Universal->make_patch(
-TargetClass => 'SomeClass::OverYonder',
name => 'foo',
pre_rules => [
sub {
my $method = pop;
warn "Arguments for foo:", @_
}
]
post_rules => [
sub {
warn "Result of foo:", Class::MakeMethods::Composite->CurrentResults
}
]
);
=cut
sub make_patch {
(shift)->make( -ForceInstall => 1, patch => { @_ } );
}
########################################################################
=head1 SEE ALSO
See L<Class::MakeMethods> for general information about this distribution.
See L<Class::MakeMethods::Composite> for more about this family of subclasses.
=cut
1;
|