File Coverage

blib/lib/Method/Utils.pm
Criterion Covered Total %
statement 44 44 100.0
branch 9 10 90.0
condition 4 9 44.4
subroutine 13 13 100.0
pod 4 4 100.0
total 74 80 92.5


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2011-2014 -- leonerd@leonerd.org.uk
5              
6             package Method::Utils;
7              
8 5     5   109145 use strict;
  5         12  
  5         178  
9 5     5   25 use warnings;
  5         11  
  5         240  
10              
11             our $VERSION = '0.03';
12              
13 5     5   31 use Exporter 'import';
  5         10  
  5         1438  
14              
15             our @EXPORT_OK = qw(
16             maybe
17             possibly
18              
19             inwardly
20             outwardly
21             );
22              
23             require mro;
24              
25             =head1 NAME
26              
27             C - functional-style utilities for method calls
28              
29             =cut
30              
31             =head1 SYNOPSIS
32              
33             use Method::Utils qw( maybe possibly inwardly );
34              
35             $obj->${maybe "do_thing"}(@args);
36             # equivalent to
37             # $obj->do_thing(@args) if defined $obj;
38              
39             $obj->${possibly "do_another"}(@args);
40             # equivalent to
41             # $obj->do_another(@args) if $obj->can( "do_another" );
42              
43             $obj->${inwardly "do_all_these"}();
44             # invokes the method on every subclass in 'mro' order
45              
46             =cut
47              
48             =head1 FUNCTIONS
49              
50             All of the following functions are intended to be used as method call
51             modifiers. That is, they return a C reference to a C reference
52             which allows them to be used in the following syntax
53              
54             $ball->${possibly "bounce"}( "10 metres" );
55              
56             Since the returned double-reference can be dereferenced by C<${ }> to obtain
57             the C reference directly, it can be used to create new methods. For
58             example:
59              
60             *bounce_if_you_can = ${possibly "bounce"};
61              
62             This is especially useful for creating methods in base classes which
63             distribute across all the classes in a class heirarchy; for example
64              
65             *DESTROY = ${inwardly "COLLAPSE"};
66              
67             =cut
68              
69             =head2 maybe $method
70              
71             Invokes the named method on the object or class, if one is provided, and
72             return what it returned. If invoked on C, returns C in scalar
73             context or the empty list in list context.
74              
75             C<$method> here may also be a double-ref to a C, such as returned by
76             the remaining utility functions given below. In this case, it will be
77             dereferenced automatically, allowing you to conveniently perform
78              
79             $obj->${maybe possibly 'method'}( @args )
80              
81             =cut
82              
83             sub maybe
84             {
85 5     5 1 1418 my $mth = shift;
86 5 100 66     30 $mth = $$mth if ref $mth eq "REF" and ref $$mth eq "CODE";
87             \sub {
88 5     5   7 my $self = shift;
89 5 100       23 defined $self or return;
90 3         13 $self->$mth( @_ );
91 5         28 };
92             }
93              
94             =head2 possibly $method
95              
96             Invokes the named method on the object or class and return what it returned,
97             if it exists. If the method does not exist, returns C in scalar context
98             or the empty list in list context.
99              
100             =cut
101              
102             sub possibly
103             {
104 11     11 1 5500 my $mth = shift;
105             \sub {
106 10     10   15 my $self = shift;
107 10 100       88 return unless $self->can( $mth );
108 5         19 $self->$mth( @_ );
109 11         72 };
110             }
111              
112             =head2 inwardly $method
113              
114             =head2 outwardly $method
115              
116             Invokes the named method on the object or class for I class that
117             provides such a method in the C<@ISA> heirarchy, not just the first one that
118             is found. C searches all the classes in L order, finding the
119             class itself first and then its superclasses. C runs in reverse,
120             starting its search at the base-most superclass, searching upward before
121             finally ending at the class itself.
122              
123             =cut
124              
125             sub inwardly
126             {
127 2     2 1 14 my $mth = shift;
128             \sub {
129 2     2   5 my $self = shift;
130 2   33     3 foreach my $class ( @{ mro::get_linear_isa( ref $self || $self ) } ) {
  2         22  
131 5     5   32 no strict 'refs';
  5         19  
  5         768  
132 11 100       51 defined &{$class."::$mth"} or next;
  11         51  
133 9         14 &{$class."::$mth"}( $self, @_ );
  9         33  
134             }
135             }
136 2         15 }
137              
138             sub outwardly
139             {
140 1     1 1 4 my $mth = shift;
141             \sub {
142 1     1   3 my $self = shift;
143 1   33     2 foreach my $class ( reverse @{ mro::get_linear_isa( ref $self || $self ) } ) {
  1         16  
144 5     5   24 no strict 'refs';
  5         8  
  5         498  
145 6 50       27 defined &{$class."::$mth"} or next;
  6         25  
146 6         10 &{$class."::$mth"}( $self, @_ );
  6         20  
147             }
148             }
149 1         8 }
150              
151             =head1 TODO
152              
153             =over 4
154              
155             =item *
156              
157             Consider C, which would C-wrap the call, returning
158             C/empty if it failed.
159              
160             =item *
161              
162             Consider better ways to combine more of these. E.g. C
163             would C-wrap each subclass call. C without C would
164             fail if no class provides the method.
165              
166             =back
167              
168             =cut
169              
170             =head1 SEE ALSO
171              
172             =over 4
173              
174             =item *
175              
176             L - Madness With Methods
177              
178             =back
179              
180             =cut
181              
182             =head1 AUTHOR
183              
184             Paul Evans
185              
186             =cut
187              
188             0x55AA;