File Coverage

blib/lib/Role/Tiny.pm
Criterion Covered Total %
statement 273 278 98.2
branch 88 102 86.2
condition 45 68 66.1
subroutine 46 47 97.8
pod 6 11 54.5
total 458 506 90.5


line stmt bran cond sub pod time code
1             package Role::Tiny;
2 27     27   1606614 use strict;
  27         253  
  27         712  
3 27     27   119 use warnings;
  27         45  
  27         6152  
4              
5             our $VERSION = '2.002004';
6             $VERSION =~ tr/_//d;
7              
8             our %INFO;
9             our %APPLIED_TO;
10             our %COMPOSED;
11             our %COMPOSITE_INFO;
12             our @ON_ROLE_CREATE;
13              
14             # Module state workaround totally stolen from Zefram's Module::Runtime.
15              
16             BEGIN {
17 27 50   27   245 *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
18             *_WORK_AROUND_HINT_LEAKAGE
19             = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
20 27 50 33     237 ? sub(){1} : sub(){0};
21 27 50 33     1097 *_CONSTANTS_DEFLATE = "$]" >= 5.012 && "$]" < 5.020 ? sub(){1} : sub(){0};
22             }
23              
24 27     27   162 sub _getglob { no strict 'refs'; \*{$_[0]} }
  27     713   52  
  27         1452  
  713         755  
  713         3318  
25 27     27   158 sub _getstash { no strict 'refs'; \%{"$_[0]::"} }
  27     578   49  
  27         1695  
  578         589  
  578         2350  
26              
27             sub croak {
28 8     8 0 41 require Carp;
29 27     27   158 no warnings 'redefine';
  27         52  
  27         8061  
30 8         29 *croak = \&Carp::croak;
31 8         1427 goto &Carp::croak;
32             }
33              
34             sub Role::Tiny::__GUARD__::DESTROY {
35 0 0   0   0 delete $INC{$_[0]->[0]} if @{$_[0]};
  0         0  
36             }
37              
38             sub _load_module {
39 279     279   2599 my ($module) = @_;
40 279         901 (my $file = "$module.pm") =~ s{::}{/}g;
41             return 1
42 279 100       639 if $INC{$file};
43              
44             # can't just ->can('can') because a sub-package Foo::Bar::Baz
45             # creates a 'Baz::' key in Foo::Bar's symbol table
46             return 1
47 266 100       295 if grep !/::\z/, keys %{_getstash($module)};
  266         385  
48 4         9 my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
49             && bless([ $file ], 'Role::Tiny::__GUARD__');
50 4         4 local %^H if _WORK_AROUND_HINT_LEAKAGE;
51 4         965 require $file;
52 1         12 pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
53 1         3 return 1;
54             }
55              
56             sub _require_module {
57 275     275   460 _load_module($_[1]);
58             }
59              
60             sub _all_subs {
61 312     312   487 my ($me, $package) = @_;
62 312         440 my $stash = _getstash($package);
63             return {
64             map {;
65 27     27   213 no strict 'refs';
  27         42  
  27         33136  
66             # this is an ugly hack to populate the scalar slot of any globs, to
67             # prevent perl from converting constants back into scalar refs in the
68             # stash when they are used (perl 5.12 - 5.18). scalar slots on their own
69             # aren't detectable through pure perl, so this seems like an acceptable
70             # compromise.
71 1237         1293 ${"${package}::${_}"} = ${"${package}::${_}"}
72             if _CONSTANTS_DEFLATE;
73 1237         1212 $_ => \&{"${package}::${_}"}
  1237         3059  
74             }
75 312         1272 grep exists &{"${package}::${_}"},
  1614         2821  
76             grep !/::\z/,
77             keys %$stash
78             };
79             }
80              
81             sub import {
82 91     91   8466 my $target = caller;
83 91         130 my $me = shift;
84 91         417 strict->import;
85 91         758 warnings->import;
86 91         206 my $non_methods = $me->_non_methods($target);
87 91         242 $me->_install_subs($target, @_);
88 91         221 $me->make_role($target);
89 91 100 66     416 $me->_mark_new_non_methods($target, $non_methods)
90             if $non_methods && %$non_methods;
91 91         15062 return;
92             }
93              
94             sub _mark_new_non_methods {
95 2     2   5 my ($me, $target, $old_non_methods) = @_;
96              
97 2         3 my $non_methods = $INFO{$target}{non_methods};
98              
99 2         5 my $subs = $me->_all_subs($target);
100 2         6 for my $sub (keys %$subs) {
101 6 100 66     40 if ( exists $old_non_methods->{$sub} && $non_methods->{$sub} != $subs->{$sub} ) {
102 5         11 $non_methods->{$sub} = $subs->{$sub};
103             }
104             }
105              
106 2         7 return;
107             }
108              
109             sub make_role {
110 92     92 1 242 my ($me, $target) = @_;
111              
112 92 100       211 return if $me->is_role($target);
113 90         242 $INFO{$target}{is_role} = 1;
114              
115 90         185 my $non_methods = $me->_all_subs($target);
116 90         322 delete @{$non_methods}{grep /\A\(/, keys %$non_methods};
  90         164  
117 90         167 $INFO{$target}{non_methods} = $non_methods;
118              
119             # a role does itself
120 90         186 $APPLIED_TO{$target} = { $target => undef };
121 90         198 foreach my $hook (@ON_ROLE_CREATE) {
122 2         14 $hook->($target);
123             }
124             }
125              
126             sub _install_subs {
127 91     91   154 my ($me, $target) = @_;
128 91 100       183 return if $me->is_role($target);
129 90         216 my %install = $me->_gen_subs($target);
130 450         972 *{_getglob("${target}::${_}")} = $install{$_}
131 90         531 for sort keys %install;
132 90         424 return;
133             }
134              
135             sub _gen_subs {
136 90     90   163 my ($me, $target) = @_;
137             (
138             (map {;
139 270         365 my $type = $_;
140             $type => sub {
141 15     15   6431 my $code = pop;
142 15 100       61 my @names = ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;
  1         2  
143 15   100     20 push @{$INFO{$target}{modifiers}||=[]}, [ $type, @names, $code ];
  15         99  
144 15         192 return;
145 270         1733 };
146             } qw(before after around)),
147             requires => sub {
148 13   50 13   4299 push @{$INFO{$target}{requires}||=[]}, @_;
  13         87  
149 13         152 return;
150             },
151             with => sub {
152 22     22   4463 $me->apply_roles_to_package($target, @_);
153 21         139 return;
154             },
155 90         149 );
156             }
157              
158             sub role_application_steps {
159 121     121 0 291 qw(
160             _install_methods
161             _check_requires
162             _install_modifiers
163             _copy_applied_list
164             );
165             }
166              
167             sub _copy_applied_list {
168 130     130   213 my ($me, $to, $role) = @_;
169             # copy our role list into the target's
170 130   100     168 @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
  130         727  
  130         335  
171             }
172              
173             sub apply_roles_to_object {
174 43     43 1 10006 my ($me, $object, @roles) = @_;
175 43         65 my $class = ref($object);
176             # on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter
177             # directly, so at least the variable passed to us will get any magic applied
178 43         82 bless($_[1], $me->create_class_with_roles($class, @roles));
179             }
180              
181             my $role_suffix = 'A000';
182             sub _composite_name {
183 53     53   86 my ($me, $superclass, @roles) = @_;
184              
185 53         134 my $new_name = $superclass . '__WITH__' . join '__AND__', @roles;
186              
187 53 100       108 if (length($new_name) > 252) {
188 7   33     22 $new_name = $COMPOSED{abbrev}{$new_name} ||= do {
189 7         15 my $abbrev = substr $new_name, 0, 250 - length $role_suffix;
190 7         15 $abbrev =~ s/(?<!:):$//;
191 7         32 $abbrev.'__'.$role_suffix++;
192             };
193             }
194 53         95 return $new_name;
195             }
196              
197             sub create_class_with_roles {
198 57     57 1 7410 my ($me, $superclass, @roles) = @_;
199              
200 57         131 $me->_require_module($superclass);
201 57         161 $me->_check_roles(@roles);
202              
203 53         108 my $new_name = $me->_composite_name($superclass, @roles);
204              
205             return $new_name
206 53 100       122 if $COMPOSED{class}{$new_name};
207              
208 50         91 return $me->_build_class_with_roles($new_name, $superclass, @roles);
209             }
210              
211             sub _build_class_with_roles {
212 50     50   99 my ($me, $new_name, $superclass, @roles) = @_;
213              
214 50         123 $COMPOSED{base}{$new_name} = $superclass;
215 50         61 @{*{_getglob("${new_name}::ISA")}} = ( $superclass );
  50         53  
  50         111  
216 50         309 $me->apply_roles_to_package($new_name, @roles);
217 45         82 $COMPOSED{class}{$new_name} = 1;
218 45         175 return $new_name;
219             }
220              
221             sub _check_roles {
222 183     183   298 my ($me, @roles) = @_;
223 183 100       526 croak "No roles supplied!" unless @roles;
224              
225 181         232 my %seen;
226 181 100       698 if (my @dupes = grep 1 == $seen{$_}++, @roles) {
227 1         6 croak "Duplicated roles: ".join(', ', @dupes);
228             }
229              
230 180         288 foreach my $role (@roles) {
231 215         438 $me->_require_module($role);
232 214 100       549 croak "${role} is not a ${me}" unless $me->is_role($role);
233             }
234             }
235              
236             our %BACKCOMPAT_HACK;
237             $BACKCOMPAT_HACK{+__PACKAGE__} = 0;
238             sub _want_backcompat_hack {
239 121     121   189 my $me = shift;
240             return $BACKCOMPAT_HACK{$me}
241 121 100       455 if exists $BACKCOMPAT_HACK{$me};
242 27     27   192 no warnings 'uninitialized';
  27         83  
  27         45378  
243 3   100     49 $BACKCOMPAT_HACK{$me} =
244             $me->can('apply_single_role_to_package') != \&apply_single_role_to_package
245             && $me->can('role_application_steps') == \&role_application_steps
246             }
247              
248             our $IN_APPLY_ROLES;
249             sub apply_single_role_to_package {
250             return
251 2 50   2 0 12 if $IN_APPLY_ROLES;
252 0         0 local $IN_APPLY_ROLES = 1;
253              
254 0         0 my ($me, $to, $role) = @_;
255 0         0 $me->apply_roles_to_package($to, $role);
256             }
257              
258             sub apply_role_to_package {
259 9     9 0 2293 my ($me, $to, $role) = @_;
260 9         30 $me->apply_roles_to_package($to, $role);
261             }
262              
263             sub apply_roles_to_package {
264 127     127 1 4438 my ($me, $to, @roles) = @_;
265 127 100       298 croak "Can't apply roles to object with apply_roles_to_package"
266             if ref $to;
267              
268 126         313 $me->_check_roles(@roles);
269              
270 124         186 my @have_conflicts;
271             my %role_methods;
272              
273 124 100       260 if (@roles > 1) {
274 19         27 my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
  19         63  
275 19         79 @have_conflicts = grep $to->can($_), keys %conflicts;
276 19         36 delete @conflicts{@have_conflicts};
277              
278 19 100       60 if (keys %conflicts) {
279 3   66     12 my $class = $COMPOSED{base}{$to} || $to;
280             my $fail =
281             join "\n",
282             map {
283 3         9 "Due to a method name conflict between roles "
284 3         7 .join(' and ', map "'$_'", sort values %{$conflicts{$_}})
  3         31  
285             .", the method '$_' must be implemented by '$class'"
286             } sort keys %conflicts;
287 3         102 croak $fail;
288             }
289              
290 16         50 %role_methods = map +($_ => $me->_concrete_methods_of($_)), @roles;
291             }
292              
293 121 100 66     386 if (!$IN_APPLY_ROLES and _want_backcompat_hack($me)) {
294 1         4 local $IN_APPLY_ROLES = 1;
295 1         2 foreach my $role (@roles) {
296 2         8 $me->apply_single_role_to_package($to, $role);
297             }
298             }
299              
300 121         174 my $role_methods;
301 121         254 foreach my $step ($me->role_application_steps) {
302 468         4173 foreach my $role (@roles) {
303             # conflicting methods are supposed to be treated as required by the
304             # composed role. we don't have an actual composed role, but because
305             # we know the target class already provides them, we can instead
306             # pretend that the roles don't do for the duration of application.
307             $role_methods = $role_methods{$role} and (
308 140         186 (local @{$role_methods}{@have_conflicts}),
309 544 100       3057 (delete @{$role_methods}{@have_conflicts}),
  140         159  
310             );
311              
312 544         1246 $me->$step($to, $role);
313             }
314             }
315 111         7911 $APPLIED_TO{$to}{join('|',@roles)} = 1;
316             }
317              
318             sub _composite_info_for {
319 19     19   98 my ($me, @roles) = @_;
320 19   66     120 $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
321 16         27 my %methods;
322 16         31 foreach my $role (@roles) {
323 35         75 my $this_methods = $me->_concrete_methods_of($role);
324 35         141 $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
325             }
326 16         45 delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
  18         160  
327 16         85 +{ conflicts => \%methods }
328             };
329             }
330              
331             sub _check_requires {
332 140     140   310 my ($me, $to, $name, $requires) = @_;
333 140   100     735 $requires ||= $INFO{$name}{requires} || [];
      33        
334 140 100       550 if (my @requires_fail = grep !$to->can($_), @$requires) {
335             # role -> role, add to requires, role -> class, error out
336 13 100       40 if (my $to_info = $INFO{$to}) {
337 5   100     8 push @{$to_info->{requires}||=[]}, @requires_fail;
  5         24  
338             } else {
339 8         427 croak "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
340             }
341             }
342             }
343              
344             sub _non_methods {
345 170     170   308 my ($me, $role) = @_;
346 170 100       455 my $info = $INFO{$role} or return {};
347              
348 80 50       121 my %non_methods = %{ $info->{non_methods} || {} };
  80         508  
349              
350             # this is only for backwards compatibility with older Moo, which
351             # reimplements method tracking rather than calling our method
352 80 100       153 my %not_methods = reverse %{ $info->{not_methods} || {} };
  80         384  
353 80 100       377 return \%non_methods unless keys %not_methods;
354              
355 1         2 my $subs = $me->_all_subs($role);
356 1         6 for my $sub (grep !/\A\(/, keys %$subs) {
357 6         7 my $code = $subs->{$sub};
358 6 100       12 if (exists $not_methods{$code}) {
359 1         2 $non_methods{$sub} = $code;
360             }
361             }
362              
363 1         4 return \%non_methods;
364             }
365              
366             sub _concrete_methods_of {
367 215     215   959 my ($me, $role) = @_;
368 215         284 my $info = $INFO{$role};
369              
370             return $info->{methods}
371 215 100 100     1306 if $info && $info->{methods};
372              
373 79         184 my $non_methods = $me->_non_methods($role);
374              
375 79         203 my $subs = $me->_all_subs($role);
376 79         298 for my $sub (keys %$subs) {
377 476 100 66     1215 if ( exists $non_methods->{$sub} && $non_methods->{$sub} == $subs->{$sub} ) {
378 398         551 delete $subs->{$sub};
379             }
380             }
381              
382 79 100       216 if ($info) {
383 78         142 $info->{methods} = $subs;
384             }
385 79         197 return $subs;
386             }
387              
388             sub methods_provided_by {
389 3     3 0 2128 my ($me, $role) = @_;
390 3         9 $me->_require_module($role);
391 3 100       9 croak "${role} is not a ${me}" unless $me->is_role($role);
392 2 50       3 sort (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
  2         4  
  2         17  
393             }
394              
395             sub _install_methods {
396 140     140   243 my ($me, $to, $role) = @_;
397              
398 140         263 my $methods = $me->_concrete_methods_of($role);
399              
400 140         174 my %existing_methods;
401 140         171 @existing_methods{keys %{ $me->_all_subs($to) }} = ();
  140         253  
402              
403             # _concrete_methods_of caches its result on roles. that cache needs to be
404             # invalidated after applying roles
405 140 100       483 delete $INFO{$to}{methods} if $INFO{$to};
406              
407 140         275 foreach my $i (keys %$methods) {
408             next
409 106 100       232 if exists $existing_methods{$i};
410              
411 85         200 my $glob = _getglob "${to}::${i}";
412 85         197 *$glob = $methods->{$i};
413              
414             # overloads using method names have the method stored in the scalar slot
415             # and &overload::nil in the code slot.
416             next
417             unless $i =~ /^\(/
418             && ((defined &overload::nil && $methods->{$i} == \&overload::nil)
419 85 50 66     302 || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
      66        
420              
421 9         12 my $overload = ${ _getglob "${role}::${i}" };
  9         19  
422             next
423 9 50       26 unless defined $overload;
424              
425 9         21 *$glob = \$overload;
426             }
427              
428 140         304 $me->_install_does($to);
429             }
430              
431             sub _install_modifiers {
432 132     132   222 my ($me, $to, $name) = @_;
433 132 100       339 return unless my $modifiers = $INFO{$name}{modifiers};
434 33         46 my $info = $INFO{$to};
435 33 100 100     162 my $existing = ($info ? $info->{modifiers} : $COMPOSED{modifiers}{$to}) ||= [];
436             my @modifiers = grep {
437 35         45 my $modifier = $_;
438 35         118 !grep $_ == $modifier, @$existing;
439 33 50       60 } @{$modifiers||[]};
  33         81  
440 33         70 push @$existing, @modifiers;
441              
442 33 100       76 if (!$info) {
443 26         48 foreach my $modifier (@modifiers) {
444 26         827 $me->_install_single_modifier($to, @$modifier);
445             }
446             }
447             }
448              
449             my $vcheck_error;
450              
451             sub _install_single_modifier {
452 26     26   63 my ($me, @args) = @_;
453 26 100       56 defined($vcheck_error) or $vcheck_error = do {
454 6         9 local $@;
455 6 50       10 eval {
456 6         570 require Class::Method::Modifiers;
457 6         1798 Class::Method::Modifiers->VERSION(1.05);
458 6         36 1;
459             } ? 0 : $@;
460             };
461 26 50       81 $vcheck_error and die $vcheck_error;
462 26         76 Class::Method::Modifiers::install_modifier(@args);
463             }
464              
465             my $FALLBACK = sub { 0 };
466             sub _install_does {
467 140     140   230 my ($me, $to) = @_;
468              
469             # only add does() method to classes
470 140 100       307 return if $me->is_role($to);
471              
472 115         530 my $does = $me->can('does_role');
473             # add does() only if they don't have one
474 115 100       869 *{_getglob "${to}::does"} = $does unless $to->can('does');
  60         201  
475              
476             return
477 115 100 50     1084 if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
      66        
478              
479 59   33     262 my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
480             my $new_sub = sub {
481 5     5   36 my ($proto, $role) = @_;
482 5 50       13 $proto->$does($role) or $proto->$existing($role);
483 59         260 };
484 27     27   245 no warnings 'redefine';
  27         112  
  27         8524  
485 59         159 return *{_getglob "${to}::DOES"} = $new_sub;
  59         192  
486             }
487              
488             # optimize for newer perls
489             require mro
490             if "$]" >= 5.009_005;
491              
492             if (defined &mro::get_linear_isa) {
493             *_linear_isa = \&mro::get_linear_isa;
494             }
495             else {
496             my $e;
497             {
498             local $@;
499             # this routine is simplified and not fully compatible with mro::get_linear_isa
500             # but for our use the order doesn't matter, so we don't need to care
501             eval <<'END_CODE' or $e = $@;
502             sub _linear_isa($;$) {
503             if (defined &mro::get_linear_isa) {
504             no warnings 'redefine', 'prototype';
505             *_linear_isa = \&mro::get_linear_isa;
506             goto &mro::get_linear_isa;
507             }
508              
509             my @check = shift;
510             my @lin;
511              
512             my %found;
513             while (defined(my $check = shift @check)) {
514             push @lin, $check;
515             no strict 'refs';
516             unshift @check, grep !$found{$_}++, @{"$check\::ISA"};
517             }
518              
519             return \@lin;
520             }
521              
522             1;
523             END_CODE
524             }
525             die $e if defined $e;
526             }
527              
528             sub does_role {
529 38     38 1 5966 my ($proto, $role) = @_;
530 38   66     55 foreach my $class (@{_linear_isa(ref($proto)||$proto)}) {
  38         210  
531 41 100       202 return 1 if exists $APPLIED_TO{$class}{$role};
532             }
533 10         48 return 0;
534             }
535              
536             sub is_role {
537 541     541 1 1244 my ($me, $role) = @_;
538             return !!($INFO{$role} && (
539             $INFO{$role}{is_role}
540             # these are for backward compatibility with older Moo that overrode some
541             # methods without calling the originals, thus not getting is_role set
542             || $INFO{$role}{requires}
543             || $INFO{$role}{not_methods}
544             || $INFO{$role}{non_methods}
545 541   66     2554 ));
546             }
547              
548             1;
549             __END__
550              
551             =encoding utf-8
552              
553             =head1 NAME
554              
555             Role::Tiny - Roles: a nouvelle cuisine portion size slice of Moose
556              
557             =head1 SYNOPSIS
558              
559             package Some::Role;
560              
561             use Role::Tiny;
562              
563             sub foo { ... }
564              
565             sub bar { ... }
566              
567             around baz => sub { ... };
568              
569             1;
570              
571             elsewhere
572              
573             package Some::Class;
574              
575             use Role::Tiny::With;
576              
577             # bar gets imported, but not foo
578             with 'Some::Role';
579              
580             sub foo { ... }
581              
582             # baz is wrapped in the around modifier by Class::Method::Modifiers
583             sub baz { ... }
584              
585             1;
586              
587             If you wanted attributes as well, look at L<Moo::Role>.
588              
589             =head1 DESCRIPTION
590              
591             C<Role::Tiny> is a minimalist role composition tool.
592              
593             =head1 ROLE COMPOSITION
594              
595             Role composition can be thought of as much more clever and meaningful multiple
596             inheritance. The basics of this implementation of roles is:
597              
598             =over 2
599              
600             =item *
601              
602             If a method is already defined on a class, that method will not be composed in
603             from the role. A method inherited by a class gets overridden by the role's
604             method of the same name, though.
605              
606             =item *
607              
608             If a method that the role L</requires> to be implemented is not implemented,
609             role application will fail loudly.
610              
611             =back
612              
613             Unlike L<Class::C3>, where the B<last> class inherited from "wins," role
614             composition is the other way around, where the class wins. If multiple roles
615             are applied in a single call (single with statement), then if any of their
616             provided methods clash, an exception is raised unless the class provides
617             a method since this conflict indicates a potential problem.
618              
619             =head2 ROLE METHODS
620              
621             All subs created after importing Role::Tiny will be considered methods to be
622             composed. For example:
623              
624             package MyRole;
625             use List::Util qw(min);
626             sub mysub { }
627             use Role::Tiny;
628             use List::Util qw(max);
629             sub mymethod { }
630              
631             In this role, C<max> and C<mymethod> will be included when composing MyRole,
632             and C<min> and C<mysub> will not. For additional control, L<namespace::clean>
633             can be used to exclude undesired subs from roles.
634              
635             =head1 IMPORTED SUBROUTINES
636              
637             =head2 requires
638              
639             requires qw(foo bar);
640              
641             Declares a list of methods that must be defined to compose role.
642              
643             =head2 with
644              
645             with 'Some::Role1';
646              
647             with 'Some::Role1', 'Some::Role2';
648              
649             Composes another role into the current role (or class via L<Role::Tiny::With>).
650              
651             If you have conflicts and want to resolve them in favour of Some::Role1 you
652             can instead write:
653              
654             with 'Some::Role1';
655             with 'Some::Role2';
656              
657             If you have conflicts and want to resolve different conflicts in favour of
658             different roles, please refactor your codebase.
659              
660             =head2 before
661              
662             before foo => sub { ... };
663              
664             See L<< Class::Method::Modifiers/before method(s) => sub { ... }; >> for full
665             documentation.
666              
667             Note that since you are not required to use method modifiers,
668             L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
669             a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
670             both L<Class::Method::Modifiers> and L<Role::Tiny>.
671              
672             =head2 around
673              
674             around foo => sub { ... };
675              
676             See L<< Class::Method::Modifiers/around method(s) => sub { ... }; >> for full
677             documentation.
678              
679             Note that since you are not required to use method modifiers,
680             L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
681             a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
682             both L<Class::Method::Modifiers> and L<Role::Tiny>.
683              
684             =head2 after
685              
686             after foo => sub { ... };
687              
688             See L<< Class::Method::Modifiers/after method(s) => sub { ... }; >> for full
689             documentation.
690              
691             Note that since you are not required to use method modifiers,
692             L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
693             a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
694             both L<Class::Method::Modifiers> and L<Role::Tiny>.
695              
696             =head2 Strict and Warnings
697              
698             In addition to importing subroutines, using C<Role::Tiny> applies L<strict> and
699             L<warnings> to the caller.
700              
701             =head1 SUBROUTINES
702              
703             =head2 does_role
704              
705             if (Role::Tiny::does_role($foo, 'Some::Role')) {
706             ...
707             }
708              
709             Returns true if class has been composed with role.
710              
711             This subroutine is also installed as ->does on any class a Role::Tiny is
712             composed into unless that class already has an ->does method, so
713              
714             if ($foo->does('Some::Role')) {
715             ...
716             }
717              
718             will work for classes but to test a role, one must use ::does_role directly.
719              
720             Additionally, Role::Tiny will override the standard Perl C<DOES> method
721             for your class. However, if C<any> class in your class' inheritance
722             hierarchy provides C<DOES>, then Role::Tiny will not override it.
723              
724             =head1 METHODS
725              
726             =head2 make_role
727              
728             Role::Tiny->make_role('Some::Role');
729              
730             Makes a package into a role, but does not export any subs into it.
731              
732             =head2 apply_roles_to_package
733              
734             Role::Tiny->apply_roles_to_package(
735             'Some::Package', 'Some::Role', 'Some::Other::Role'
736             );
737              
738             Composes role with package. See also L<Role::Tiny::With>.
739              
740             =head2 apply_roles_to_object
741              
742             Role::Tiny->apply_roles_to_object($foo, qw(Some::Role1 Some::Role2));
743              
744             Composes roles in order into object directly. Object is reblessed into the
745             resulting class. Note that the object's methods get overridden by the role's
746             ones with the same names.
747              
748             =head2 create_class_with_roles
749              
750             Role::Tiny->create_class_with_roles('Some::Base', qw(Some::Role1 Some::Role2));
751              
752             Creates a new class based on base, with the roles composed into it in order.
753             New class is returned.
754              
755             =head2 is_role
756              
757             Role::Tiny->is_role('Some::Role1')
758              
759             Returns true if the given package is a role.
760              
761             =head1 CAVEATS
762              
763             =over 4
764              
765             =item * On perl 5.8.8 and earlier, applying a role to an object won't apply any
766             overloads from the role to other copies of the object.
767              
768             =item * On perl 5.16 and earlier, applying a role to a class won't apply any
769             overloads from the role to any existing instances of the class.
770              
771             =back
772              
773             =head1 SEE ALSO
774              
775             L<Role::Tiny> is the attribute-less subset of L<Moo::Role>; L<Moo::Role> is
776             a meta-protocol-less subset of the king of role systems, L<Moose::Role>.
777              
778             Ovid's L<Role::Basic> provides roles with a similar scope, but without method
779             modifiers, and having some extra usage restrictions.
780              
781             =head1 AUTHOR
782              
783             mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
784              
785             =head1 CONTRIBUTORS
786              
787             dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
788              
789             frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
790              
791             hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
792              
793             jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
794              
795             ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
796              
797             chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
798              
799             ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
800              
801             doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
802              
803             perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
804              
805             Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
806              
807             ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
808              
809             tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
810              
811             haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
812              
813             =head1 COPYRIGHT
814              
815             Copyright (c) 2010-2012 the Role::Tiny L</AUTHOR> and L</CONTRIBUTORS>
816             as listed above.
817              
818             =head1 LICENSE
819              
820             This library is free software and may be distributed under the same terms
821             as perl itself.
822              
823             =cut