File Coverage

blib/lib/Sub/HandlesVia.pm
Criterion Covered Total %
statement 62 62 100.0
branch 20 30 66.6
condition 32 48 66.6
subroutine 12 12 100.0
pod 0 1 0.0
total 126 153 82.3


line stmt bran cond sub pod time code
1 95     95   14241046 use 5.008;
  95         896  
2 95     95   586 use strict;
  95         241  
  95         2305  
3 95     95   510 use warnings;
  95         215  
  95         4579  
4              
5             package Sub::HandlesVia;
6              
7 95     95   43131 use Exporter::Shiny qw( delegations );
  95         431059  
  95         699  
8              
9             our $AUTHORITY = 'cpan:TOBYINK';
10             our $VERSION = '0.046';
11              
12             sub _generate_delegations {
13 4     4   352 my ($me, $name, $args, $globals) = (shift, @_);
14            
15 4         15 my $target = $globals->{into};
16 4 50       18 !defined $target and die;
17 4 50       15 ref $target and die;
18              
19 4         14 my $toolkit = $me->detect_toolkit($target);
20 4     6   40 return sub { $toolkit->install_delegations(target => $target, @_) };
  6         3062  
21             }
22              
23             sub _exporter_validate_opts {
24 299     299   19277335 my ($me, $globals) = (shift, @_);
25              
26 299         965 my $target = $globals->{into};
27 299 50       1416 !defined $target and die;
28 299 50       1255 ref $target and die;
29              
30 299         1094 my $toolkit = $me->detect_toolkit($target);
31 299 100       4457 $toolkit->setup_for($target) if $toolkit->can('setup_for');
32             }
33              
34             sub detect_toolkit {
35 303     303 0 1372 my $toolkit = sprintf(
36             '%s::Toolkit::%s',
37             __PACKAGE__,
38             shift->_detect_framework(@_),
39             );
40 303 50       21860 eval "require $toolkit" or Exporter::Tiny::_croak($@);
41 303         1806 return $toolkit;
42             }
43              
44             sub _detect_framework {
45 304     304   1068 my ($me, $target) = (shift, @_);
46            
47             # Need to ask Role::Tiny too because Moo::Role will pretend
48             # that Moose::Role and Mouse::Role roles are Moo::Role roles!
49             #
50 304 100 100     1746 if ($INC{'Moo/Role.pm'}
      66        
51             and Role::Tiny->is_role($target)
52             and Moo::Role->is_role($target)) {
53 3         171 return 'Moo';
54             }
55            
56 301 50 66     2397 if ($INC{'Moo.pm'}
      33        
57             and $Moo::MAKERS{$target}
58             and $Moo::MAKERS{$target}{is_class}) {
59 105         744 return 'Moo';
60             }
61            
62 196 100 66     1988 if ($INC{'Moose/Role.pm'}
      100        
63             and $target->can('meta')
64             and $target->meta->isa('Moose::Meta::Role')) {
65 3         111 return 'Moose';
66             }
67            
68 193 50 66     3778 if ($INC{'Moose.pm'}
      66        
69             and $target->can('meta')
70             and $target->meta->isa('Moose::Meta::Class')) {
71 86         2468 return 'Moose';
72             }
73              
74 107 100 66     1702 if ($INC{'Mouse/Role.pm'}
      100        
75             and $target->can('meta')
76             and $target->meta->isa('Mouse::Meta::Role')) {
77 4         139 return 'Mouse';
78             }
79            
80 103 50 66     2451 if ($INC{'Mouse.pm'}
      66        
81             and $target->can('meta')
82             and $target->meta->isa('Mouse::Meta::Class')) {
83 85         1761 return 'Mouse';
84             }
85            
86             {
87 95     95   48623 no warnings;
  95         255  
  95         17179  
88 18 50 66     98 if ($INC{'Object/Pad.pm'}
      66        
      33        
89             and 'Object::Pad'->VERSION ge 0.67
90 2         12 and do { require Object::Pad::MOP::Class; 1 }
  2         9  
91 2         13 and eval { Object::Pad::MOP::Class->for_class($target) } ) {
92 2         327 require Scalar::Util;
93 2         42 my $META = Object::Pad::MOP::Class->for_class($target);
94 2 50 33     175 return 'ObjectPad'
95             if Scalar::Util::blessed($META) && $META->isa('Object::Pad::MOP::Class');
96             }
97             }
98            
99             {
100 95     95   788 no strict 'refs';
  95         286  
  95         3590  
  18         35  
  16         26  
101 95     95   625 no warnings 'once';
  95         270  
  95         14435  
102 16 100       30 if ( ${"$target\::USES_MITE"} ) {
  16         110  
103 10         79 return 'Mite';
104             }
105             }
106            
107 6         39 return 'Plain';
108             }
109              
110             1;
111              
112             __END__
113              
114             =pod
115              
116             =encoding utf-8
117              
118             =head1 NAME
119              
120             Sub::HandlesVia - alternative handles_via implementation
121              
122             =head1 SYNOPSIS
123              
124             package Kitchen {
125             use Moo;
126             use Sub::HandlesVia;
127             use Types::Standard qw( ArrayRef Str );
128            
129             has food => (
130             is => 'ro',
131             isa => ArrayRef[Str],
132             handles_via => 'Array',
133             default => sub { [] },
134             handles => {
135             'add_food' => 'push',
136             'find_food' => 'grep',
137             },
138             );
139             }
140              
141             my $kitchen = Kitchen->new;
142             $kitchen->add_food('Bacon');
143             $kitchen->add_food('Eggs');
144             $kitchen->add_food('Sausages');
145             $kitchen->add_food('Beans');
146            
147             my @foods = $kitchen->find_food(sub { /^B/i });
148              
149             =head1 DESCRIPTION
150              
151             If you've used L<Moose>'s native attribute traits, or L<MooX::HandlesVia>
152             before, you should have a fairly good idea what this does.
153              
154             Why re-invent the wheel? Well, this is an implementation that should work
155             okay with Moo, Moose, Mouse, and any other OO toolkit you throw at it.
156             One ring to rule them all, so to speak.
157              
158             For details of how to use it, see the manual.
159              
160             =over
161              
162             =item L<Sub::HandlesVia::Manual::WithMoo>
163              
164             How to use Sub::HandlesVia with L<Moo> and L<Moo::Role>.
165              
166             =item L<Sub::HandlesVia::Manual::WithMoose>
167              
168             How to use Sub::HandlesVia with L<Moose> and L<Moose::Role>.
169              
170             =item L<Sub::HandlesVia::Manual::WithMouse>
171              
172             How to use Sub::HandlesVia with L<Mouse> and L<Mouse::Role>.
173              
174             =item L<Sub::HandlesVia::Manual::WithMite>
175              
176             How to use Sub::HandlesVia with L<Mite>.
177              
178             =item L<Sub::HandlesVia::Manual::WithClassTiny>
179              
180             How to use Sub::HandlesVia with L<Class::Tiny>.
181              
182             =item L<Sub::HandlesVia::Manual::WithObjectPad>
183              
184             How to use Sub::HandlesVia with L<Object::Pad> classes.
185              
186             =item L<Sub::HandlesVia::Manual::WithGeneric>
187              
188             How to use Sub::HandlesVia with other OO toolkits, and hand-written
189             Perl classes.
190              
191             =back
192              
193             Note: as Sub::HandlesVia needs to detect which toolkit you are using, and
194             often needs to detect whether your package is a class or a role, it needs
195             to be loaded I<after> Moo/Moose/Mouse/etc. Your C<< use Moo >> or
196             C<< use Moose::Role >> or whatever needs to be I<before> your
197             C<< use Sub::HandlesVia >>.
198              
199             =head1 BUGS
200              
201             Please report any bugs to
202             L<https://github.com/tobyink/p5-sub-handlesvia/issues>.
203              
204             (There are known bugs for Moose native types that do coercion.)
205              
206             =head1 SEE ALSO
207              
208             Guides for use with different OO toolkits:
209             L<Sub::HandlesVia::Manual::WithMoo>,
210             L<Sub::HandlesVia::Manual::WithMoose>,
211             L<Sub::HandlesVia::Manual::WithMouse>,
212             L<Sub::HandlesVia::Manual::WithMite>,
213             L<Sub::HandlesVia::Manual::WithClassTiny>,
214             L<Sub::HandlesVia::Manual::WithObjectPad>,
215             L<Sub::HandlesVia::Manual::WithGeneric>.
216              
217             Documentation for delegatable methods:
218             L<Sub::HandlesVia::HandlerLibrary::Array>,
219             L<Sub::HandlesVia::HandlerLibrary::Blessed>,
220             L<Sub::HandlesVia::HandlerLibrary::Bool>,
221             L<Sub::HandlesVia::HandlerLibrary::Code>,
222             L<Sub::HandlesVia::HandlerLibrary::Counter>,
223             L<Sub::HandlesVia::HandlerLibrary::Hash>,
224             L<Sub::HandlesVia::HandlerLibrary::Number>,
225             L<Sub::HandlesVia::HandlerLibrary::Scalar>, and
226             L<Sub::HandlesVia::HandlerLibrary::String>.
227              
228             Other implementations of the same concept:
229             L<Moose::Meta::Attribute::Native>, L<MouseX::NativeTraits>, and
230             L<MooX::HandlesVia> with L<Data::Perl>.
231              
232             Comparison of those: L<Sub::HandlesVia::Manual::Comparison>
233              
234             L<Sub::HandlesVia::Declare> is a helper for declaring Sub::HandlesVia
235             delegations at compile-time, useful for L<Object::Pad> and (to a lesser
236             extent) L<Class::Tiny>.
237              
238             =head1 AUTHOR
239              
240             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
241              
242             =head1 COPYRIGHT AND LICENCE
243              
244             This software is copyright (c) 2020, 2022 by Toby Inkster.
245              
246             This is free software; you can redistribute it and/or modify it under
247             the same terms as the Perl 5 programming language system itself.
248              
249             =head1 DISCLAIMER OF WARRANTIES
250              
251             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
252             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
253             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
254