nix-archive-1(type directoryentry(namelibnode(type directoryentry(nameperl5node(type directoryentry(name site_perlnode(type directoryentry(name5.36.0node(type directoryentry(nameRolenode(type directoryentry(nameTinynode(type directoryentry(nameWith.pmnode(typeregularcontentspackage Role::Tiny::With; use strict; use warnings FATAL => 'all'; our $VERSION = '1.003004'; $VERSION = eval $VERSION; use Role::Tiny (); use Exporter 'import'; our @EXPORT = qw( with ); sub with { my $target = caller; Role::Tiny->apply_roles_to_package($target, @_) } 1; =head1 NAME Role::Tiny::With - Neat interface for consumers of Role::Tiny roles =head1 SYNOPSIS package Some::Class; use Role::Tiny::With; with 'Some::Role'; # The role is now mixed in =head1 DESCRIPTION C is a minimalist role composition tool. C provides a C function to compose such roles. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut ))))entry(nameTiny.pmnode(typeregularcontentsLpackage Role::Tiny; sub _getglob { \*{$_[0]} } sub _getstash { \%{"$_[0]::"} } use strict; use warnings FATAL => 'all'; our $VERSION = '1.003004'; $VERSION = eval $VERSION; our %INFO; our %APPLIED_TO; our %COMPOSED; our %COMPOSITE_INFO; our @ON_ROLE_CREATE; # Module state workaround totally stolen from Zefram's Module::Runtime. BEGIN { *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"}; } sub Role::Tiny::__GUARD__::DESTROY { delete $INC{$_[0]->[0]} if @{$_[0]}; } sub _load_module { (my $proto = $_[0]) =~ s/::/\//g; $proto .= '.pm'; return 1 if $INC{$proto}; # can't just ->can('can') because a sub-package Foo::Bar::Baz # creates a 'Baz::' key in Foo::Bar's symbol table return 1 if grep !/::$/, keys %{_getstash($_[0])||{}}; my $guard = _WORK_AROUND_BROKEN_MODULE_STATE && bless([ $proto ], 'Role::Tiny::__GUARD__'); require $proto; pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE; return 1; } sub import { my $target = caller; my $me = shift; strict->import; warnings->import(FATAL => 'all'); return if $me->is_role($target); # already exported into this package $INFO{$target}{is_role} = 1; # get symbol table reference my $stash = _getstash($target); # install before/after/around subs foreach my $type (qw(before after around)) { *{_getglob "${target}::${type}"} = sub { require Class::Method::Modifiers; push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ]; return; }; } *{_getglob "${target}::requires"} = sub { push @{$INFO{$target}{requires}||=[]}, @_; return; }; *{_getglob "${target}::with"} = sub { $me->apply_roles_to_package($target, @_); return; }; # grab all *non-constant* (stash slot is not a scalarref) subs present # in the symbol table and store their refaddrs (no need to forcibly # inflate constant subs into real subs) with a map to the coderefs in # case of copying or re-use my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash); @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; # a role does itself $APPLIED_TO{$target} = { $target => undef }; $_->($target) for @ON_ROLE_CREATE; } sub role_application_steps { qw(_install_methods _check_requires _install_modifiers _copy_applied_list); } sub apply_single_role_to_package { my ($me, $to, $role) = @_; _load_module($role); die "This is apply_role_to_package" if ref($to); die "${role} is not a Role::Tiny" unless $me->is_role($role); foreach my $step ($me->role_application_steps) { $me->$step($to, $role); } } sub _copy_applied_list { my ($me, $to, $role) = @_; # copy our role list into the target's @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = (); } sub apply_roles_to_object { my ($me, $object, @roles) = @_; die "No roles supplied!" unless @roles; my $class = ref($object); # on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter # directly, so at least the variable passed to us will get any magic applied bless($_[1], $me->create_class_with_roles($class, @roles)); } my $role_suffix = 'A000'; sub _composite_name { my ($me, $superclass, @roles) = @_; my $new_name = join( '__WITH__', $superclass, my $compose_name = join '__AND__', @roles ); if (length($new_name) > 252) { $new_name = $COMPOSED{abbrev}{$new_name} ||= substr($new_name, 0, 250 - length $role_suffix).'__'.$role_suffix++; } return wantarray ? ($new_name, $compose_name) : $new_name; } sub create_class_with_roles { my ($me, $superclass, @roles) = @_; die "No roles supplied!" unless @roles; _load_module($superclass); { my %seen; $seen{$_}++ for @roles; if (my @dupes = grep $seen{$_} > 1, @roles) { die "Duplicated roles: ".join(', ', @dupes); } } my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles); return $new_name if $COMPOSED{class}{$new_name}; foreach my $role (@roles) { _load_module($role); die "${role} is not a Role::Tiny" unless $me->is_role($role); } require(_MRO_MODULE); my $composite_info = $me->_composite_info_for(@roles); my %conflicts = %{$composite_info->{conflicts}}; if (keys %conflicts) { my $fail = join "\n", map { "Method name conflict for '$_' between roles " ."'".join(' and ', sort values %{$conflicts{$_}})."'" .", cannot apply these simultaneously to an object." } keys %conflicts; die $fail; } my @composable = map $me->_composable_package_for($_), reverse @roles; # some methods may not exist in the role, but get generated by # _composable_package_for (Moose accessors via Moo). filter out anything # provided by the composable packages, excluding the subs we generated to # make modifiers work. my @requires = grep { my $method = $_; !grep $_->can($method) && !$COMPOSED{role}{$_}{modifiers_only}{$method}, @composable } @{$composite_info->{requires}}; $me->_check_requires( $superclass, $compose_name, \@requires ); *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ]; @{$APPLIED_TO{$new_name}||={}}{ map keys %{$APPLIED_TO{$_}}, @roles } = (); $COMPOSED{class}{$new_name} = 1; return $new_name; } # preserved for compat, and apply_roles_to_package calls it to allow an # updated Role::Tiny to use a non-updated Moo::Role sub apply_role_to_package { shift->apply_single_role_to_package(@_) } sub apply_roles_to_package { my ($me, $to, @roles) = @_; return $me->apply_role_to_package($to, $roles[0]) if @roles == 1; my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}}; my @have = grep $to->can($_), keys %conflicts; delete @conflicts{@have}; if (keys %conflicts) { my $fail = join "\n", map { "Due to a method name conflict between roles " ."'".join(' and ', sort values %{$conflicts{$_}})."'" .", the method '$_' must be implemented by '${to}'" } keys %conflicts; die $fail; } # conflicting methods are supposed to be treated as required by the # composed role. we don't have an actual composed role, but because # we know the target class already provides them, we can instead # pretend that the roles don't do for the duration of application. my @role_methods = map $me->_concrete_methods_of($_), @roles; # separate loops, since local ..., delete ... for ...; creates a scope local @{$_}{@have} for @role_methods; delete @{$_}{@have} for @role_methods; # the if guard here is essential since otherwise we accidentally create # a $INFO for something that isn't a Role::Tiny (or Moo::Role) because # autovivification hates us and wants us to die() if ($INFO{$to}) { delete $INFO{$to}{methods}; # reset since we're about to add methods } # backcompat: allow subclasses to use apply_single_role_to_package # to apply changes. set a local var so ours does nothing. our %BACKCOMPAT_HACK; if($me ne __PACKAGE__ and exists $BACKCOMPAT_HACK{$me} ? $BACKCOMPAT_HACK{$me} : $BACKCOMPAT_HACK{$me} = $me->can('role_application_steps') == \&role_application_steps && $me->can('apply_single_role_to_package') != \&apply_single_role_to_package ) { foreach my $role (@roles) { $me->apply_single_role_to_package($to, $role); } } else { foreach my $step ($me->role_application_steps) { foreach my $role (@roles) { $me->$step($to, $role); } } } $APPLIED_TO{$to}{join('|',@roles)} = 1; } sub _composite_info_for { my ($me, @roles) = @_; $COMPOSITE_INFO{join('|', sort @roles)} ||= do { foreach my $role (@roles) { _load_module($role); } my %methods; foreach my $role (@roles) { my $this_methods = $me->_concrete_methods_of($role); $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods; } my %requires; @requires{map @{$INFO{$_}{requires}||[]}, @roles} = (); delete $requires{$_} for keys %methods; delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods; +{ conflicts => \%methods, requires => [keys %requires] } }; } sub _composable_package_for { my ($me, $role) = @_; my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; return $composed_name if $COMPOSED{role}{$composed_name}; $me->_install_methods($composed_name, $role); my $base_name = $composed_name.'::_BASE'; # force stash to exist so ->can doesn't complain _getstash($base_name); # Not using _getglob, since setting @ISA via the typeglob breaks # inheritance on 5.10.0 if the stash has previously been accessed an # then a method called on the class (in that order!), which # ->_install_methods (with the help of ->_install_does) ends up doing. { no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); } my $modifiers = $INFO{$role}{modifiers}||[]; my @mod_base; my @modifiers = grep !$composed_name->can($_), do { my %h; @h{map @{$_}[1..$#$_-1], @$modifiers} = (); keys %h }; foreach my $modified (@modifiers) { push @mod_base, "sub ${modified} { shift->next::method(\@_) }"; } my $e; { local $@; eval(my $code = join "\n", "package ${base_name};", @mod_base); $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@; } die $e if $e; $me->_install_modifiers($composed_name, $role); $COMPOSED{role}{$composed_name} = { modifiers_only => { map { $_ => 1 } @modifiers }, }; return $composed_name; } sub _check_requires { my ($me, $to, $name, $requires) = @_; return unless my @requires = @{$requires||$INFO{$name}{requires}||[]}; if (my @requires_fail = grep !$to->can($_), @requires) { # role -> role, add to requires, role -> class, error out if (my $to_info = $INFO{$to}) { push @{$to_info->{requires}||=[]}, @requires_fail; } else { die "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail); } } } sub _concrete_methods_of { my ($me, $role) = @_; my $info = $INFO{$role}; # grab role symbol table my $stash = _getstash($role); # reverse so our keys become the values (captured coderefs) in case # they got copied or re-used since my $not_methods = { reverse %{$info->{not_methods}||{}} }; $info->{methods} ||= +{ # grab all code entries that aren't in the not_methods list map { my $code = *{$stash->{$_}}{CODE}; ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) } grep !ref($stash->{$_}), keys %$stash }; } sub methods_provided_by { my ($me, $role) = @_; die "${role} is not a Role::Tiny" unless $me->is_role($role); (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]}); } sub _install_methods { my ($me, $to, $role) = @_; my $info = $INFO{$role}; my $methods = $me->_concrete_methods_of($role); # grab target symbol table my $stash = _getstash($to); # determine already extant methods of target my %has_methods; @has_methods{grep +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}), keys %$stash } = (); foreach my $i (grep !exists $has_methods{$_}, keys %$methods) { no warnings 'once'; my $glob = _getglob "${to}::${i}"; *$glob = $methods->{$i}; # overloads using method names have the method stored in the scalar slot # and &overload::nil in the code slot. next unless $i =~ /^\(/ && ((defined &overload::nil && $methods->{$i} == \&overload::nil) || (defined &overload::_nil && $methods->{$i} == \&overload::_nil)); my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} }; next unless defined $overload; *$glob = \$overload; } $me->_install_does($to); } sub _install_modifiers { my ($me, $to, $name) = @_; return unless my $modifiers = $INFO{$name}{modifiers}; if (my $info = $INFO{$to}) { push @{$info->{modifiers}}, @{$modifiers||[]}; } else { foreach my $modifier (@{$modifiers||[]}) { $me->_install_single_modifier($to, @$modifier); } } } my $vcheck_error; sub _install_single_modifier { my ($me, @args) = @_; defined($vcheck_error) or $vcheck_error = do { local $@; eval { Class::Method::Modifiers->VERSION(1.05); 1 } ? 0 : $@ }; $vcheck_error and die $vcheck_error; Class::Method::Modifiers::install_modifier(@args); } my $FALLBACK = sub { 0 }; sub _install_does { my ($me, $to) = @_; # only add does() method to classes return if $me->is_role($to); my $does = $me->can('does_role'); # add does() only if they don't have one *{_getglob "${to}::does"} = $does unless $to->can('does'); return if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0); my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK; my $new_sub = sub { my ($proto, $role) = @_; $proto->$does($role) or $proto->$existing($role); }; no warnings 'redefine'; *{_getglob "${to}::DOES"} = $new_sub; } sub does_role { my ($proto, $role) = @_; require(_MRO_MODULE); foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) { return 1 if exists $APPLIED_TO{$class}{$role}; } return 0; } sub is_role { my ($me, $role) = @_; return !!($INFO{$role} && $INFO{$role}{is_role}); } 1; __END__ =encoding utf-8 =head1 NAME Role::Tiny - Roles. Like a nouvelle cuisine portion size slice of Moose. =head1 SYNOPSIS package Some::Role; use Role::Tiny; sub foo { ... } sub bar { ... } around baz => sub { ... } 1; else where package Some::Class; use Role::Tiny::With; # bar gets imported, but not foo with 'Some::Role'; sub foo { ... } # baz is wrapped in the around modifier by Class::Method::Modifiers sub baz { ... } 1; If you wanted attributes as well, look at L. =head1 DESCRIPTION C is a minimalist role composition tool. =head1 ROLE COMPOSITION Role composition can be thought of as much more clever and meaningful multiple inheritance. The basics of this implementation of roles is: =over 2 =item * If a method is already defined on a class, that method will not be composed in from the role. =item * If a method that the role L to be implemented is not implemented, role application will fail loudly. =back Unlike L, where the B class inherited from "wins," role composition is the other way around, where the class wins. If multiple roles are applied in a single call (single with statement), then if any of their provided methods clash, an exception is raised unless the class provides a method since this conflict indicates a potential problem. =head1 IMPORTED SUBROUTINES =head2 requires requires qw(foo bar); Declares a list of methods that must be defined to compose role. =head2 with with 'Some::Role1'; with 'Some::Role1', 'Some::Role2'; Composes another role into the current role (or class via L). If you have conflicts and want to resolve them in favour of Some::Role1 you can instead write: with 'Some::Role1'; with 'Some::Role2'; If you have conflicts and want to resolve different conflicts in favour of different roles, please refactor your codebase. =head2 before before foo => sub { ... }; See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full documentation. Note that since you are not required to use method modifiers, L is lazily loaded and we do not declare it as a dependency. If your L role uses modifiers you must depend on both L and L. =head2 around around foo => sub { ... }; See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full documentation. Note that since you are not required to use method modifiers, L is lazily loaded and we do not declare it as a dependency. If your L role uses modifiers you must depend on both L and L. =head2 after after foo => sub { ... }; See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full documentation. Note that since you are not required to use method modifiers, L is lazily loaded and we do not declare it as a dependency. If your L role uses modifiers you must depend on both L and L. =head2 Strict and Warnings In addition to importing subroutines, using C applies L and L to the caller. It's possible to disable these if desired: use Role::Tiny; use warnings NONFATAL => 'all'; =head1 SUBROUTINES =head2 does_role if (Role::Tiny::does_role($foo, 'Some::Role')) { ... } Returns true if class has been composed with role. This subroutine is also installed as ->does on any class a Role::Tiny is composed into unless that class already has an ->does method, so if ($foo->does('Some::Role')) { ... } will work for classes but to test a role, one must use ::does_role directly. Additionally, Role::Tiny will override the standard Perl C method for your class. However, if C class in your class' inheritance hierarchy provides C, then Role::Tiny will not override it. =head1 METHODS =head2 apply_roles_to_package Role::Tiny->apply_roles_to_package( 'Some::Package', 'Some::Role', 'Some::Other::Role' ); Composes role with package. See also L. =head2 apply_roles_to_object Role::Tiny->apply_roles_to_object($foo, qw(Some::Role1 Some::Role2)); Composes roles in order into object directly. Object is reblessed into the resulting class. =head2 create_class_with_roles Role::Tiny->create_class_with_roles('Some::Base', qw(Some::Role1 Some::Role2)); Creates a new class based on base, with the roles composed into it in order. New class is returned. =head2 is_role Role::Tiny->is_role('Some::Role1') Returns true if the given package is a role. =head1 CAVEATS =over 4 =item * On perl 5.8.8 and earlier, applying a role to an object won't apply any overloads from the role to all copies of the object. =back =head1 SEE ALSO L is the attribute-less subset of L; L is a meta-protocol-less subset of the king of role systems, L. Ovid's L provides roles with a similar scope, but without method modifiers, and having some extra usage restrictions. =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) =head1 CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) =head1 COPYRIGHT Copyright (c) 2010-2012 the Role::Tiny L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. =cut ))))entry(nameaarch64-linux-thread-multinode(type directoryentry(nameautonode(type directoryentry(nameRolenode(type directoryentry(nameTinynode(type directoryentry(name .packlistnode(typeregularcontents/gnu/store/02vq94g0882lc7iycicc2mxgbk96v9rg-perl-role-tiny-1.003004/lib/perl5/site_perl/5.36.0/Role/Tiny.pm /gnu/store/02vq94g0882lc7iycicc2mxgbk96v9rg-perl-role-tiny-1.003004/lib/perl5/site_perl/5.36.0/Role/Tiny/With.pm /gnu/store/02vq94g0882lc7iycicc2mxgbk96v9rg-perl-role-tiny-1.003004/share/man/man3/Role::Tiny.3 /gnu/store/02vq94g0882lc7iycicc2mxgbk96v9rg-perl-role-tiny-1.003004/share/man/man3/Role::Tiny::With.3 ))))))))))))))))))entry(namesharenode(type directoryentry(namemannode(type directoryentry(nameman3node(type directoryentry(nameRole::Tiny.3.zstnode(typeregularcontents*(/d)$pZ<0i9`DD#"Iv,o9ȕٿdL nϢb1µtg]fdG*x|nEY1 H;* [A꼍1yuott)\_/Ƅ Ǝ/zr,,PhהLTvQRGa9bhNSU}Q@Œ(DjpHCɋ4>E?rQR XT:)#$ˤG q9 ֆeX2cgm}vln- X ,So (X1S8$Lp.CZ0HN"ꒉxڝ?"ycʐ%!_!qFq"ZS?z7y6DgQHI)iSZQ+2+`g,߱/O",uڌW!g򌼓Ͷq阑;9cG 2L:G< J)E]0"4LܞәEyu/ V1#9BIߔctBdž I7|*Ț t5䐢 TSy rX1222"hQ BFH[3H1񈖝){7TI~ U឴L,BHB7'pod*`l8_% Y mulx^X$!7J^K7񧔫2,e'B >,B%t÷JtK L~o iII^軄C㧆R1 0H[giH^E8Ap>9*xnTWBȏL սԴݫOkrO6ԝۭjleq1Zɴ lG0:qA(Q uC (SDb#(*n"'M>A) S畐 ~/L(c%%@hubh7kGXɰh"P< d 4M|n>flm,aM6]j{~8WfQk XN)+>GOv"h7I>:cHC+~vխe޾RA|t+2>Hur$}xZ;X:\jSpM!E׆>&"l `-3+UCi|9Cf`)^}:Dzԓ`.e)BLUeC^ {YdR\G׀DۢzPsH̐lpO,t.kxBH&BZZ+d+ū(lJc &Y/?1e˙KЯ*T{^$:Mj9 eNlⳫ ifÝӺnQ)7jB+ }l4ܤ׳,7n>…<ܛ!R>yIP.URӒ==T1B@sM=v %c9 .M ZA!hu""`BomsN -Xz(ņ9`Nu?4Voq<Ĉ6t)J-BXH  PjczSuƎݍW'*,%Կn̙S! _a<enPi܀m~6s^o>;s튚c˶1|rqy~A"#_uCTG(rMj^.=W^RkT"T2{XKhqu_ddK; rǦHxe!|ln0 QB(lॾɆC uQu[*U̧u\X@AaRI V>->A|̎ݗR4Lc0ũ2sdO >vxD/1=5b=1vr5b(D$Īe}"Ǚ{V',Ad[l0Uۋa1cҙ>ǴW {>%5gT+Ǒj 0*&# jo.rjPGst߲#>QU-GDtCI^7$s)s\Bd7 Is9Pi r`"m d^^8%t>k^ N Uq7`1JJYC_l*$RMrhנ0oJ&CP.ȹ?Hj5F;}AFv&b0 ΁q!l/E9π ǒS_Nt5HpO$zOXr싐!% WiUwGJGw(mmNl"q52&^♛ <~d)Ma'Mmר0;e@dָq&*pv,$IP`l+yR0SidA{xݑ;I#OWDbAhN<kRҾm5ۧue@ベE8,8bc{NmN!FJm y~nLN2*h|+zt3MhӞ Xhx7R~M5QL|N7!mYt!@^1 CE r17wUpŗ` %WbwXEYTWm&)))))))))