line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Object::Tap; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
14753
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
5
|
1
|
|
|
1
|
|
5
|
use base qw(Exporter); |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
160
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '1.000006'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our @EXPORT = qw($_tap); |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $_tap = sub { |
12
|
|
|
|
|
|
|
my ($obj, $call, @args) = @_; |
13
|
|
|
|
|
|
|
$obj->$call(@args) for $obj; |
14
|
|
|
|
|
|
|
$obj |
15
|
|
|
|
|
|
|
}; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
1; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Object::Tap - Tap into a series of method calls to alter an object |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Instead of writing - |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $thing = My::Class->new(...); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
$thing->set_foo(1); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
you can instead write - |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
use Object::Tap; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $thing = My::Class->new(...)->$_tap(sub { $_[0]->set_foo(1) }); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
We also alias $_ to $_[0] within the subroutine so: |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $thing = My::Class->new(...)->$_tap(sub { $_->set_foo(1) }); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
also works. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
To realise why this might be useful, consider instead - |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
My::App->new(...)->$_tap(...)->run; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
where a variable is thereby not required at all. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
You can also pass extra args - |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
$obj->$_tap(sub { warn "Got arg: $_[1]" }, 'arg'); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
or use a method name instead of a sub ref - |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my $thing = My::Class->new(...)->$_tap(set_foo => 1); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
For a 'real' example of how that might be used, one could create and |
58
|
|
|
|
|
|
|
initialize an L object in one go using - |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $te = HTML::TableExtract->new->$_tap(parse => $html); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 AUTHOR |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
mst - Matt S. Trout (cpan:MSTROUT) |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
None yet. Well volunteered? :) |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 COPYRIGHT |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Copyright (c) 2014 the Object::Tap L and L |
73
|
|
|
|
|
|
|
as listed above. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 LICENSE |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
This library is free software and may be distributed under the same terms |
78
|
|
|
|
|
|
|
as perl itself. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut |