Role-Tiny-1.003002/000755 000765 000024 00000000000 12211777211 014043 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/Changes000644 000765 000024 00000013053 12211777175 015351 0ustar00gknopstaff000000 000000 Revision history for Role-Tiny 1.003002 2013-09-04 - abbreviate generated package names if they are longer than perl can handle (RT#83248) - add explicit dependency on the version of Exporter that added 'import' 1.003001 2013-07-14 - fix test accidentally requiring Class::Method::Modifiers 1.003000 2013-07-14 - allow composing roles simultaneously that mutually require each other (RT#82711) - Fix _concrete_methods_of returning non-CODE entries - fix broken implementation of method conflict resolution (Perlmonks#1041015) - add is_role method for checking if a given package is a role - drop minimum perl version - code tests just fine on 5.6.1 and 5.6.2 1.002005 2013-02-01 - complain loudly if Class::Method::Modifiers is too old (and skip tests) - don't use $_ as loop variable when calling arbitrary code 1.002004 2012-11-02 - remove accidentally-introduced strictures.pm usage 1.002003 2012-10-29 - fix method modifier breakage on 5.10.0 1.002002 2012-10-28 - skip t/around-does.t when Class::Method::Modifiers is not installed (RT#80310) 1.002001 2012-10-26 - t/does-Moo.t moved to 'xt' (RT#80290) - don't die when looking for 'DOES' on perl < 5.10 (RT#80402) 1.002000 2012-10-19 - load class in addition to roles when using create_class_from_roles - fix module name in Makefile.PL (RT#78591) - when classes consume roles, override their DOES method (RT#79747) - method modifiers can be used for 'does' and 'DOES' 1.001005 2012-07-18 - localize UNIVERSAL::can change to avoid confusing TB2 - properly report roles consumed by superclasses 1.001004 2012-07-12 - remove strictures.pm from the test supplied by mmcleric so we install again - when applying runtime roles include roles from original class in new class ( fixes ::does_role checks) 1.001003 2012-06-19 - correctly apply modifiers with role composition - check for conflicts during role-to-object application (test from mmcleric) - add an explicit return to all exported subs so people don't accidentally rely on the return value - store coderefs as well as their refaddrs to protect against crazy 1.001002 2012-05-05 - alter duplication test to not provoke Class::Method::Modifiers loading 1.001001 2012-04-27 - remove strictures from one last test file 1.001000 2012-04-27 - Documentation improvements, no code changes 1.000_901 2012-04-12 - Fix MANIFEST inclusion of Role::Basic composition 1.000_900 2012-04-11 - Add composition with tests stolen from Role::Basic 1.000001 2012-04-03 - Document that Class::Method::Modifiers must be depended on separately - Update tests so that they skip correctly without C::M::M - Add a SEE ALSO section 1.000000 2012-03-29 - Remove redundant code in create_class_with_roles - Minor doc fix to does_role - Split Role::Tiny out into its own dist Changes below this line are from when Role::Tiny was still bundled with Moo: - Fix a bug where coercions weren't called on lazy default/builder returns - Switch Moo::Utils to using Module::Runtime, and add the 5.8 %INC leakage fix into Role::Tiny's _load_module to provide partial parity - Update incompatibilities with Moose documentation - Remove Sub::Quote's outstanding queue since it doesn't actually slow things down to do it this way and makes debugging easier. - Revert 'local $@' around require calls to avoid triggering Unknown Error - Explicitly require Role::Tiny in Role::Tiny::With (RT#70446) - Fix spurious 'once' warnings under perl -w 0.009013 2011-12-23 - fix up Class::XSAccessor version check to be more robust - improved documentation - fix failures on perls < 5.8.3 - fix test failures on cygwin 0.009012 2011-11-15 - make Method::Generate::Constructor handle $obj->new - fix bug where constants containing a reference weren't handled correctly (ref(\[]) is 'REF' not 'SCALAR', ref(\v1) is 'VSTRING') 0.009011 2011-10-03 - add support for DEMOLISH - add support for BUILDARGS 0.009010 2011-07-20 - missing new files for Role::Tiny::With 0.009009 2011-07-20 - remove the big scary warning because we seem to be mostly working now - perl based getter dies if @_ > 1 (XSAccessor already did) - add Role::Tiny::With for use in classes - automatically generate constructors in subclasses when required so that subclasses with a BUILD method but no attributes get it honoured - add coerce handling 0.009008 2011-06-03 - transfer fix to _load_module to Role::Tiny and make a note it's an inline - Bring back 5.8.1 compat 0.009007 2011-02-25 - I botched the copyright. re-disting. 0.009006 2011-02-25 - handle non-lazy default and builder when init_arg is undef - add copyright and license info for downstream packagers - weak ref checking for Sub::Quote to avoid bugs on refaddr reuse - Switch composed role names to be a valid package name 0.9.5 Tue Jan 11 2011 - Fix clobberage of runtime-installed wrappers by Sub::Defer - Fix nonMoo constructor firing through multiple layers of Moo - Fix bug where nonMoo is mistakenly detected given a Moo superclass with no attributes (and hence no own constructor) 0.9.4 Mon Dec 13 2010 - Automatic detection on non-Moo superclasses 0.9.3 Sun Dec 5 2010 - Fix _load_module to deal with pre-existing subpackages 0.9.2 Wed Nov 17 2010 - Add explanation of Moo's existence - Change @ISA setting mechanism to deal with a big in 5.10.0's get_linear_isa - Change 5.10 checks to >= to not try and load MRO::Compat on 5.10.0 - Make 'perl -Moo' DTRT 0.9.1 Tue Nov 16 2010 - Initial release Role-Tiny-1.003002/lib/000755 000765 000024 00000000000 12211777211 014611 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/maint/000755 000765 000024 00000000000 12211777211 015153 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/Makefile.PL000644 000765 000024 00000002455 12211730471 016020 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.006; use ExtUtils::MakeMaker; (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; my %BUILD_DEPS = ( 'Test::More' => 0.96, 'Test::Fatal' => 0.003, ); # have to do this since old EUMM dev releases miss the eval $VERSION line my $mymeta = eval($ExtUtils::MakeMaker::VERSION) >= 6.57_02; my $mymeta_works = eval($ExtUtils::MakeMaker::VERSION) >= 6.57_07; WriteMakefile( NAME => 'Role::Tiny', VERSION_FROM => 'lib/Role/Tiny.pm', PREREQ_PM => { Exporter => '5.57', ($] >= 5.010 ? () : ('MRO::Compat' => 0)), ($mymeta_works ? () : (%BUILD_DEPS)), }, $mymeta_works ? (BUILD_REQUIRES => \%BUILD_DEPS) : (), ($mymeta && !$mymeta_works ? (NO_MYMETA => 1) : ()), -f 'META.yml' ? () : (META_MERGE => { 'meta-spec' => { version => 2 }, no_index => { directory => [ 'xt' ] }, resources => { # r/w: gitmo@git.shadowcat.co.uk:Role-Tiny.git repository => { url => 'git://git.shadowcat.co.uk/gitmo/Role-Tiny.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Role-Tiny.git', type => 'git', }, bugtracker => { mailto => 'bug-Role-Tiny@rt.cpan.org', web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny', }, }, }), ); Role-Tiny-1.003002/MANIFEST000644 000765 000024 00000001671 12211777212 015202 0ustar00gknopstaff000000 000000 Changes lib/Role/Tiny.pm lib/Role/Tiny/With.pm maint/bump-version maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/around-does.t t/compose-modifiers.t t/concrete-methods.t t/does.t t/lib/Bar.pm t/lib/Baz.pm t/method-conflicts.t t/modifiers.t t/namespace-clean.t t/role-basic-00-load.t t/role-basic-basic.t t/role-basic-bugs.t t/role-basic-composition.t t/role-basic-exceptions.t t/role-basic/lib/My/Does/Basic.pm t/role-basic/lib/My/Example.pm t/role-basic/lib/MyTests.pm t/role-basic/lib/TestMethods.pm t/role-basic/lib/Try/Tiny.pm t/role-duplication.t t/role-long-package-name.t t/role-tiny-composition.t t/role-tiny-with.t t/role-tiny.t t/role-with-inheritance.t t/subclass.t xt/does-Moo.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Role-Tiny-1.003002/META.json000644 000765 000024 00000002362 12211777211 015467 0ustar00gknopstaff000000 000000 { "abstract" : "Roles. Like a nouvelle cuisine portion size slice of Moose.", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.74, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Role-Tiny", "no_index" : { "directory" : [ "t", "inc", "xt" ] }, "prereqs" : { "build" : { "requires" : { "Test::Fatal" : "0.003", "Test::More" : "0.96" } }, "runtime" : { "requires" : { "Exporter" : "5.57" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Role-Tiny@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny" }, "repository" : { "type" : "git", "url" : "git://git.shadowcat.co.uk/gitmo/Role-Tiny.git", "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Role-Tiny.git" } }, "version" : "1.003002" } Role-Tiny-1.003002/META.yml000644 000765 000024 00000001235 12211777211 015315 0ustar00gknopstaff000000 000000 --- abstract: 'Roles. Like a nouvelle cuisine portion size slice of Moose.' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::Fatal: 0.003 Test::More: 0.96 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.74, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Role-Tiny no_index: directory: - t - inc - xt requires: Exporter: 5.57 resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny repository: git://git.shadowcat.co.uk/gitmo/Role-Tiny.git version: 1.003002 Role-Tiny-1.003002/README000644 000765 000024 00000014111 12211777212 014722 0ustar00gknopstaff000000 000000 NAME Role::Tiny - Roles. Like a nouvelle cuisine portion size slice of Moose. 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 Moo::Role. DESCRIPTION "Role::Tiny" is a minimalist role composition tool. ROLE COMPOSITION Role composition can be thought of as much more clever and meaningful multiple inheritance. The basics of this implementation of roles is: * If a method is already defined on a class, that method will not be composed in from the role. * If a method that the role "requires" to be implemented is not implemented, role application will fail loudly. Unlike Class::C3, where the last 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. IMPORTED SUBROUTINES requires requires qw(foo bar); Declares a list of methods that must be defined to compose role. with with 'Some::Role1'; with 'Some::Role1', 'Some::Role2'; Composes another role into the current role (or class via Role::Tiny::With). 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. before before foo => sub { ... }; See "before method(s) => sub { ... }" in Class::Method::Modifiers for full documentation. Note that since you are not required to use method modifiers, Class::Method::Modifiers is lazily loaded and we do not declare it as a dependency. If your Role::Tiny role uses modifiers you must depend on both Class::Method::Modifiers and Role::Tiny. around around foo => sub { ... }; See "around method(s) => sub { ... }" in Class::Method::Modifiers for full documentation. Note that since you are not required to use method modifiers, Class::Method::Modifiers is lazily loaded and we do not declare it as a dependency. If your Role::Tiny role uses modifiers you must depend on both Class::Method::Modifiers and Role::Tiny. after after foo => sub { ... }; See "after method(s) => sub { ... }" in Class::Method::Modifiers for full documentation. Note that since you are not required to use method modifiers, Class::Method::Modifiers is lazily loaded and we do not declare it as a dependency. If your Role::Tiny role uses modifiers you must depend on both Class::Method::Modifiers and Role::Tiny. SUBROUTINES 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 "DOES" method for your class. However, if "any" class in your class' inheritance hierarchy provides "DOES", then Role::Tiny will not override it. METHODS apply_roles_to_package Role::Tiny->apply_roles_to_package( 'Some::Package', 'Some::Role', 'Some::Other::Role' ); Composes role with package. See also Role::Tiny::With. 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. 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. is_role Role::Tiny->is_role('Some::Role1') Returns true if the given package is a role. SEE ALSO Role::Tiny is the attribute-less subset of Moo::Role; Moo::Role is a meta-protocol-less subset of the king of role systems, Moose::Role. If you don't want method modifiers and do want to be forcibly restricted to a single role application per class, Ovid's Role::Basic exists. But Stevan Little (the Moose author) and I don't find the additional restrictions to be amazingly helpful in most cases; Role::Basic's choices are more a guide to what you should prefer doing, to our mind, rather than something that needs to be enforced. AUTHOR mst - Matt S. Trout (cpan:MSTROUT) 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) COPYRIGHT Copyright (c) 2010-2012 the Role::Tiny "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. Role-Tiny-1.003002/t/000755 000765 000024 00000000000 12211777211 014306 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/xt/000755 000765 000024 00000000000 12211777211 014476 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/xt/does-Moo.t000644 000765 000024 00000002034 12076372331 016347 0ustar00gknopstaff000000 000000 use Test::More; BEGIN { plan skip_all => 'requires Moo' unless eval { require Moo; require Moo::Role; 1 }; plan tests => 14; } BEGIN { package Local::Role1; use Moo::Role; } BEGIN { package Local::Role2; use Moo::Role; } BEGIN { package Local::Class1; use Moo; with qw( Local::Role1 Local::Role2 ); } BEGIN { package Local::Class2; use Moo; with qw( Local::Role1 ); with qw( Local::Role2 ); } BEGIN { package Local::Class3; use Moo; with qw( Local::Role1 ); with qw( Local::Role2 ); sub DOES { my ($proto, $role) = @_; return 1 if $role eq 'Local::Role3'; return $proto->does($role); } } for my $c (1 .. 3) { my $class = "Local::Class$c"; for my $r (1 .. 2) { my $role = "Local::Role$r"; ok($class->does($role), "$class\->does($role)"); ok($class->DOES($role), "$class\->DOES($role)"); } } { my $class = "Local::Class3"; my $role = "Local::Role3"; ok( ! $class->does($role), "$class\->does($role)"); ok( $class->DOES($role), "$class\->DOES($role)"); } Role-Tiny-1.003002/t/around-does.t000644 000765 000024 00000001157 12105037142 016711 0ustar00gknopstaff000000 000000 use Test::More; BEGIN { plan skip_all => "Class::Method::Modifiers not installed or too old" unless eval "use Class::Method::Modifiers 1.05; 1"; } my $pass; my $pass2; BEGIN { package Local::Role; use Role::Tiny; around does => sub { my ($orig, $self, @args) = @_; $pass++; return $self->$orig(@args); }; around DOES => sub { my ($orig, $self, @args) = @_; $pass2++; return $self->$orig(@args); }; } BEGIN { package Local::Class; use Role::Tiny::With; with 'Local::Role'; } ok(Local::Class->does('Local::Role')); ok($pass); ok(Local::Class->DOES('Local::Role')); ok($pass2); done_testing(); Role-Tiny-1.003002/t/compose-modifiers.t000644 000765 000024 00000003327 12207107533 020123 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; BEGIN { plan skip_all => "Class::Method::Modifiers not installed or too old" unless eval "use Class::Method::Modifiers 1.05; 1"; } { package One; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Two; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Three; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Four; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package BaseClass; sub foo { __PACKAGE__ } } foreach my $combo ( [ qw(One Two Three Four) ], [ qw(Two Four Three) ], [ qw(One Two) ] ) { my $combined = Role::Tiny->create_class_with_roles('BaseClass', @$combo); is_deeply( [ $combined->foo ], [ reverse(@$combo), 'BaseClass' ], "${combined} ok" ); my $object = bless({}, 'BaseClass'); Role::Tiny->apply_roles_to_object($object, @$combo); is(ref($object), $combined, 'Object reblessed into correct class'); } { package Five; use Role::Tiny; requires 'bar'; around bar => sub { my $orig = shift; $orig->(@_) }; } { is eval { package WithFive; use Role::Tiny::With; use base 'BaseClass'; with 'Five'; }, undef, "composing an around modifier fails when method doesn't exist"; like $@, qr/Can't apply Five to WithFive - missing bar/, ' ... with correct error message'; } { is eval { Role::Tiny->create_class_with_roles('BaseClass', 'Five'); }, undef, "composing an around modifier fails when method doesn't exist"; like $@, qr/Can't apply Five to .* - missing bar/, ' ... with correct error message'; } done_testing; Role-Tiny-1.003002/t/concrete-methods.t000644 000765 000024 00000001211 12207107533 017730 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; { package MyRole1; sub before_role {} use Role::Tiny; no warnings 'once'; our $GLOBAL1 = 1; sub after_role {} } { package MyClass1; no warnings 'once'; our $GLOBAL1 = 1; sub method {} } my $role_methods = Role::Tiny->_concrete_methods_of('MyRole1'); is_deeply([sort keys %$role_methods], ['after_role'], 'only subs after Role::Tiny import are methods' ); my $class_methods = Role::Tiny->_concrete_methods_of('MyClass1'); is_deeply([sort keys %$class_methods], ['method'], 'only subs from non-Role::Tiny packages are methods' ); done_testing; Role-Tiny-1.003002/t/does.t000644 000765 000024 00000001752 12076372331 015435 0ustar00gknopstaff000000 000000 use Test::More tests => 14; BEGIN { package Local::Role1; use Role::Tiny; } BEGIN { package Local::Role2; use Role::Tiny; } BEGIN { package Local::Class1; use Role::Tiny::With; with qw( Local::Role1 Local::Role2 ); } BEGIN { package Local::Class2; use Role::Tiny::With; with qw( Local::Role1 ); with qw( Local::Role2 ); } BEGIN { package Local::Class3; use Role::Tiny::With; with qw( Local::Role1 ); with qw( Local::Role2 ); sub DOES { my ($proto, $role) = @_; return 1 if $role eq 'Local::Role3'; return $proto->Role::Tiny::does_role($role); } } for my $c (1 .. 3) { my $class = "Local::Class$c"; for my $r (1 .. 2) { my $role = "Local::Role$r"; ok($class->does($role), "$class\->does($role)"); ok($class->DOES($role), "$class\->DOES($role)"); } } { my $class = "Local::Class3"; my $role = "Local::Role3"; ok( ! $class->does($role), "$class\->does($role)"); ok( $class->DOES($role), "$class\->DOES($role)"); } Role-Tiny-1.003002/t/lib/000755 000765 000024 00000000000 12211777211 015054 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/t/method-conflicts.t000644 000765 000024 00000001566 12207107533 017744 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package Local::R1; use Role::Tiny; sub method { 1 }; } { package Local::R2; use Role::Tiny; sub method { 2 }; } # Need to use stringy eval, so not Test::Fatal $@ = undef; ok( !eval(q{ package Local::C1; use Role::Tiny::With; with qw(Local::R1 Local::R2); 1; }), 'method conflict dies', ); like( $@, qr{^Due to a method name conflict between roles 'Local::R. and Local::R.', the method 'method' must be implemented by 'Local::C1'}, '... with correct error message', ); $@ = undef; ok( eval(q{ package Local::C2; use Role::Tiny::With; with qw(Local::R1 Local::R2); sub method { 3 }; 1; }), '... but can be resolved', ); is( "Local::C2"->method, 3, "... which works properly", ); done_testing;Role-Tiny-1.003002/t/modifiers.t000644 000765 000024 00000002222 12105037142 016444 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; BEGIN { plan skip_all => "Class::Method::Modifiers not installed or too old" unless eval "use Class::Method::Modifiers 1.05; 1"; } BEGIN { package MyRole; use Role::Tiny; around foo => sub { my $orig = shift; join ' ', 'role foo', $orig->(@_) }; } BEGIN { package ExtraRole; use Role::Tiny; } BEGIN { package MyClass; sub foo { 'class foo' } } BEGIN { package ExtraClass; use Role::Tiny::With; with qw(MyRole ExtraRole); sub foo { 'class foo' } } BEGIN { package BrokenRole; use Role::Tiny; around 'broken modifier' => sub { my $orig = shift; $orig->(@_) }; } sub try_apply_to { my $to = shift; exception { Role::Tiny->apply_role_to_package($to, 'MyRole') } } is(try_apply_to('MyClass'), undef, 'role applies cleanly'); is(MyClass->foo, 'role foo class foo', 'method modifier'); is(ExtraClass->foo, 'role foo class foo', 'method modifier with composition'); ok(exception { my $new_class = Role::Tiny->create_class_with_roles('MyClass', 'BrokenRole'); }, 'exception caught creating class with broken modifier in a role'); done_testing; Role-Tiny-1.003002/t/namespace-clean.t000644 000765 000024 00000000637 12076372331 017520 0ustar00gknopstaff000000 000000 use Test::More; BEGIN { eval { require namespace::autoclean ; 1 } or plan skip_all => 'test requires namespace::autoclean'; } BEGIN { package Local::Role; use Role::Tiny; sub foo { 1 }; } BEGIN { package Local::Class; use namespace::autoclean; use Role::Tiny::With; with qw( Local::Role ); }; can_ok 'Local::Class', 'foo'; can_ok 'Local::Class', 'does'; done_testing(); Role-Tiny-1.003002/t/role-basic/000755 000765 000024 00000000000 12211777211 016326 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/t/role-basic-00-load.t000644 000765 000024 00000000260 12076372331 017646 0ustar00gknopstaff000000 000000 use Test::More tests => 1; BEGIN { use_ok( 'Role::Tiny' ) || BAIL_OUT "Could not load Role::Tiny: $!"; } diag( "Testing Role::Tiny $Role::Tiny::VERSION, Perl $], $^X" ); Role-Tiny-1.003002/t/role-basic-basic.t000644 000765 000024 00000000437 12207107533 017575 0ustar00gknopstaff000000 000000 use Test::More tests => 3; use lib 'lib', 't/role-basic/lib'; use_ok 'My::Example' or BAIL_OUT 'Could not load test module My::Example'; can_ok 'My::Example', 'no_conflict'; is +My::Example->no_conflict, 'My::Does::Basic::no_conflict', '... and it should return the correct value'; Role-Tiny-1.003002/t/role-basic-bugs.t000644 000765 000024 00000003741 12207107533 017455 0ustar00gknopstaff000000 000000 use lib 'lib', 't/role-basic/lib', 't/lib'; use MyTests; # multiple roles with the same role { package RoleC; use Role::Tiny; sub baz { 'baz' } package RoleB; use Role::Tiny; with 'RoleC'; sub bar { 'bar' } package RoleA; use Role::Tiny; with 'RoleC'; sub foo { 'foo' } package Foo; use strict; use warnings; use Role::Tiny 'with'; ::is( ::exception { with 'RoleA', 'RoleB'; }, undef, 'Composing multiple roles which use the same role should not have conflicts' ); sub new { bless {} => shift } my $object = Foo->new; foreach my $method (qw/foo bar baz/) { ::can_ok $object, $method; ::is $object->$method, $method, '... and all methods should be composed in correctly'; } } { no warnings 'redefine'; local *UNIVERSAL::can = sub { 1 }; eval <<' END'; package Can::Can; use Role::Tiny 'with'; with 'A::NonExistent::Role'; END } { my $error = $@ || ''; like $error, qr{^Can't locate A/NonExistent/Role.pm}, 'If ->can always returns true, we should still not think we loaded the role' or diag "Error found: $error"; } { package Role1; use Role::Tiny; package Role2; use Role::Tiny; package Frew; use strict; use warnings; sub new { bless {} => shift } my $object = Frew->new; ::ok(!Role::Tiny::does_role($object, 'Role1'), 'no Role1 yet'); ::ok(!Role::Tiny::does_role($object, 'Role2'), 'no Role2 yet'); Role::Tiny->apply_roles_to_object($object, 'Role1'); ::ok(Role::Tiny::does_role($object, "Role1"), 'Role1 consumed'); ::ok(!Role::Tiny::does_role($object, 'Role2'), 'no Role2 yet'); Role::Tiny->apply_roles_to_object($object, 'Role2'); ::ok(Role::Tiny::does_role($object, "Role1"), 'Role1 consumed'); ::ok(Role::Tiny::does_role($object, 'Role2'), 'Role2 consumed'); } can_ok(Role::Tiny->create_class_with_roles(qw(Bar Baz))->new, qw(bar baz)); done_testing; Role-Tiny-1.003002/t/role-basic-composition.t000644 000765 000024 00000010707 12207107533 021060 0ustar00gknopstaff000000 000000 use lib 'lib', 't/role-basic/lib'; use MyTests; require Role::Tiny; { package My::Does::Basic1; use Role::Tiny; requires 'turbo_charger'; sub method { return __PACKAGE__ . " method"; } } { package My::Does::Basic2; use Role::Tiny; requires 'turbo_charger'; sub method2 { return __PACKAGE__ . " method2"; } } eval <<'END_PACKAGE'; package My::Class1; use Role::Tiny 'with'; with qw( My::Does::Basic1 My::Does::Basic2 ); sub turbo_charger {} END_PACKAGE ok !$@, 'We should be able to use two roles with the same requirements' or die $@; { package My::Does::Basic3; use Role::Tiny; with 'My::Does::Basic2'; sub method3 { return __PACKAGE__ . " method3"; } } eval <<'END_PACKAGE'; package My::Class2; use Role::Tiny 'with'; with qw( My::Does::Basic3 ); sub new { bless {} => shift } sub turbo_charger {} END_PACKAGE ok !$@, 'We should be able to use roles which consume roles' or die $@; can_ok 'My::Class2', 'method2'; is My::Class2->method2, 'My::Does::Basic2 method2', '... and it should be the correct method'; can_ok 'My::Class2', 'method3'; is My::Class2->method3, 'My::Does::Basic3 method3', '... and it should be the correct method'; ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes'; ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'), '... and should do roles which its roles consumes'; ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'), '... but not roles which it never consumed'; my $object = My::Class2->new; ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes'; ok $object->Role::Tiny::does_role('My::Does::Basic2'), '... and should do roles which its roles consumes'; ok !$object->Role::Tiny::does_role('My::Does::Basic1'), '... but not roles which it never consumed'; { { package Role::Which::Imports; use Role::Tiny allow => 'TestMethods'; use TestMethods qw(this that); } { package Class::With::ImportingRole; use Role::Tiny 'with'; with 'Role::Which::Imports'; sub new { bless {} => shift } } my $o = Class::With::ImportingRole->new; foreach my $method (qw/this that/) { can_ok $o, $method; ok $o->$method($method), '... and calling "allow"ed methods should succeed'; is $o->$method, $method, '... and it should function correctly'; } } { { package Role::WithImportsOnceRemoved; use Role::Tiny; with 'Role::Which::Imports'; } { package Class::With::ImportingRole2; use Role::Tiny 'with'; $ENV{DEBUG} = 1; with 'Role::WithImportsOnceRemoved'; sub new { bless {} => shift } } ok my $o = Class::With::ImportingRole2->new, 'We should be able to use roles which compose roles which import'; foreach my $method (qw/this that/) { can_ok $o, $method; ok $o->$method($method), '... and calling "allow"ed methods should succeed'; is $o->$method, $method, '... and it should function correctly'; } } { { package Method::Role1; use Role::Tiny; sub method1 { } requires 'method2'; } { package Method::Role2; use Role::Tiny; sub method2 { } requires 'method1'; } my $success = eval q{ package Class; use Role::Tiny::With; with 'Method::Role1', 'Method::Role2'; 1; }; is $success, 1, 'composed mutually dependent methods successfully' or diag "Error: $@"; } SKIP: { skip "Class::Method::Modifiers not installed or too old", 1 unless eval "use Class::Method::Modifiers 1.05; 1"; { package Modifier::Role1; use Role::Tiny; sub foo { } before 'bar', sub {}; } { package Modifier::Role2; use Role::Tiny; sub bar { } before 'foo', sub {}; } my $success = eval q{ package Class; use Role::Tiny::With; with 'Modifier::Role1', 'Modifier::Role2'; 1; }; is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@"; } { { package Base::Role; use Role::Tiny; requires qw/method1 method2/; } { package Sub::Role1; use Role::Tiny; with 'Base::Role'; sub method1 {} } { package Sub::Role2; use Role::Tiny; with 'Base::Role'; sub method2 {} } my $success = eval q{ package Diamant::Class; use Role::Tiny::With; with qw/Sub::Role1 Sub::Role2/; 1; }; is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@"; } done_testing; Role-Tiny-1.003002/t/role-basic-exceptions.t000644 000765 000024 00000003135 12207107533 020673 0ustar00gknopstaff000000 000000 use lib 'lib', 't/role-basic/lib'; use MyTests; require Role::Tiny; { package My::Does::Basic; use Role::Tiny; requires 'turbo_charger'; sub conflict { return "My::Does::Basic::conflict"; } } eval <<'END_PACKAGE'; package My::Bad::Requirement; use Role::Tiny::With; with 'My::Does::Basic'; # requires turbo_charger END_PACKAGE like $@, qr/missing turbo_charger/, 'Trying to use a role without providing required methods should fail'; { { package My::Conflict; use Role::Tiny; sub conflict {}; } eval <<' END_PACKAGE'; package My::Bad::MethodConflicts; use Role::Tiny::With; with qw(My::Does::Basic My::Conflict); sub turbo_charger {} END_PACKAGE like $@, qr/.*/, 'Trying to use multiple roles with the same method should fail'; } { { package Role1; use Role::Tiny; requires 'missing_method'; sub method1 { 'method1' } } { package Role2; use Role::Tiny; with 'Role1'; sub method2 { 'method2' } } eval <<" END"; package My::Class::Missing1; use Role::Tiny::With; with 'Role2'; END like $@, qr/missing missing_method/, 'Roles composed from roles should propogate requirements upwards'; } { { package Role3; use Role::Tiny; requires qw(this that); } eval <<" END"; package My::Class::Missing2; use Role::Tiny::With; with 'Role3'; END like $@, qr/missing this, that/, 'Roles should be able to require multiple methods'; } done_testing; Role-Tiny-1.003002/t/role-duplication.t000644 000765 000024 00000000502 12207107533 017741 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; { package Role; use Role::Tiny; sub foo { my $orig = shift; 1 + $orig->(@_) }; package BaseClass; sub foo { 1 } } eval { Role::Tiny->create_class_with_roles('BaseClass', qw(Role Role)); }; like $@, qr/Duplicated/, 'duplicate role detected'; done_testing; Role-Tiny-1.003002/t/role-long-package-name.t000644 000765 000024 00000002130 12207643061 020674 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; # using Role::Tiny->apply_roles_to_object with too many roles, # It makes 'Identifier too long' error in string 'eval'. # And, Moo uses string eval. { package R::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA; use Role::Tiny; package R::BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB; use Role::Tiny; package R::CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC; use Role::Tiny; package R::DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD; use Role::Tiny; package R::EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE; use Role::Tiny; } { package Foo; sub new { bless {}, shift } } my $foo = Foo->new(); for (qw( R::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA R::BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB R::CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC R::DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD R::EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE )) { Role::Tiny->apply_roles_to_object($foo, $_); } my $pkg = ref $foo; note $pkg; eval "package $pkg;"; ok(!$@) or diag $@; done_testing; Role-Tiny-1.003002/t/role-tiny-composition.t000644 000765 000024 00000000642 12076372331 020763 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; { package R1; use Role::Tiny; sub foo {} $INC{"R1.pm"} = __FILE__; } { package R2; use Role::Tiny; sub foo {} $INC{"R2.pm"} = __FILE__; } { package X; sub new { bless {} => shift } } ok(exception { Role::Tiny->apply_roles_to_object(X->new, "R1", "R2") }, 'apply conflicting roles to object'); done_testing; Role-Tiny-1.003002/t/role-tiny-with.t000644 000765 000024 00000000724 12076372331 017374 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; BEGIN { package MyRole; use Role::Tiny; sub bar { 'role bar' } sub baz { 'role baz' } } BEGIN { package MyClass; use Role::Tiny::With; with 'MyRole'; sub foo { 'class foo' } sub baz { 'class baz' } } is(MyClass->foo, 'class foo', 'method from class no override'); is(MyClass->bar, 'role bar', 'method from role'); is(MyClass->baz, 'class baz', 'method from class'); done_testing; Role-Tiny-1.003002/t/role-tiny.t000644 000765 000024 00000004234 12207107533 016417 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; BEGIN { package MyRole; use Role::Tiny; requires qw(req1 req2); sub bar { 'role bar' } sub baz { 'role baz' } } BEGIN { package MyClass; use constant SIMPLE => 'simple'; use constant REF_CONST => [ 'ref_const' ]; use constant VSTRING_CONST => v1; sub req1 { } sub req2 { } sub foo { 'class foo' } sub baz { 'class baz' } } BEGIN { package ExtraClass; sub req1 { } sub req2 { } sub req3 { } sub foo { } sub baz { 'class baz' } } BEGIN { package IntermediaryRole; use Role::Tiny; requires 'req3'; } BEGIN { package NoMethods; package OneMethod; sub req1 { } } BEGIN { package ExtraRole; use Role::Tiny; sub extra1 { 'role extra' } } sub try_apply_to { my $to = shift; exception { Role::Tiny->apply_role_to_package($to, 'MyRole') } } is(try_apply_to('MyClass'), undef, 'role applies cleanly'); is(MyClass->bar, 'role bar', 'method from role'); is(MyClass->baz, 'class baz', 'method from class'); ok(MyClass->does('MyRole'), 'class does role'); ok(!MyClass->does('IntermediaryRole'), 'class does not do non-applied role'); ok(!MyClass->does('Random'), 'class does not do non-role'); like(try_apply_to('NoMethods'), qr/req1, req2/, 'error for both methods'); like(try_apply_to('OneMethod'), qr/req2/, 'error for one method'); is exception { Role::Tiny->apply_role_to_package('IntermediaryRole', 'MyRole'); Role::Tiny->apply_role_to_package('ExtraClass', 'IntermediaryRole'); }, undef, 'No errors applying roles'; ok(ExtraClass->does('MyRole'), 'ExtraClass does MyRole'); ok(ExtraClass->does('IntermediaryRole'), 'ExtraClass does IntermediaryRole'); is(ExtraClass->bar, 'role bar', 'method from role'); is(ExtraClass->baz, 'class baz', 'method from class'); my $new_class; is exception { $new_class = Role::Tiny->create_class_with_roles('MyClass', 'ExtraRole'); }, undef, 'No errors creating class with roles'; isa_ok($new_class, 'MyClass'); is($new_class->extra1, 'role extra', 'method from role'); ok(Role::Tiny->is_role('MyRole'), 'is_role true for roles'); ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes'); done_testing; Role-Tiny-1.003002/t/role-with-inheritance.t000644 000765 000024 00000001026 12076372331 020676 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; { package R1; use Role::Tiny; } { package R2; use Role::Tiny; } { package C1; use Role::Tiny::With; with 'R1'; } { package C2; use Role::Tiny::With; our @ISA=('C1'); with 'R2'; } ok Role::Tiny::does_role('C1','R1'), "Parent does own role"; ok !Role::Tiny::does_role('C1','R2'), "Parent does not do child's role"; ok Role::Tiny::does_role('C2','R1'), "Child does base's role"; ok Role::Tiny::does_role('C2','R2'), "Child does own role"; done_testing(); Role-Tiny-1.003002/t/subclass.t000644 000765 000024 00000004575 12207107533 016324 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; my $backcompat_called; { package RoleExtension; use base 'Role::Tiny'; sub apply_single_role_to_package { my $me = shift; $me->SUPER::apply_single_role_to_package(@_); $backcompat_called++; } } { package RoleExtension2; use base 'Role::Tiny'; sub role_application_steps { $_[0]->SUPER::role_application_steps; } sub apply_single_role_to_package { my $me = shift; $me->SUPER::apply_single_role_to_package(@_); $backcompat_called++; } } { package Role1; $INC{'Role1.pm'} = __FILE__; use Role::Tiny; sub sub1 {} } { package Role2; $INC{'Role2.pm'} = __FILE__; use Role::Tiny; sub sub2 {} } { package Class1; RoleExtension->apply_roles_to_package(__PACKAGE__, 'Role1', 'Role2'); } is $backcompat_called, 2, 'overridden apply_single_role_to_package called for backcompat'; $backcompat_called = 0; { package Class2; RoleExtension2->apply_roles_to_package(__PACKAGE__, 'Role1', 'Role2'); } is $backcompat_called, 0, 'overridden role_application_steps prevents backcompat attempt'; { package RoleExtension3; use base 'Role::Tiny'; sub _composable_package_for { my ($self, $role) = @_; my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; return $composed_name if $Role::Tiny::COMPOSED{role}{$composed_name}; no strict 'refs'; *{"${composed_name}::extra_sub"} = sub {}; $self->SUPER::_composable_package_for($role); } } { package Class2; sub foo {} } { package Role3; $INC{'Role3.pm'} = __FILE__; use Role::Tiny; requires 'extra_sub'; } ok eval { RoleExtension3->create_class_with_roles('Class2', 'Role3') }, 'requires is satisfied by subs generated by _composable_package_for'; { package Role4; $INC{'Role4.pm'} = __FILE__; use Role::Tiny; requires 'extra_sub2'; } ok !eval { RoleExtension3->create_class_with_roles('Class2', 'Role4'); }, 'requires checked properly during create_class_with_roles'; SKIP: { skip "Class::Method::Modifiers not installed or too old", 1 unless eval "use Class::Method::Modifiers 1.05; 1"; package Role5; $INC{'Role5.pm'} = __FILE__; use Role::Tiny; around extra_sub2 => sub { my $orig = shift; $orig->(@_); }; ::ok !eval { RoleExtension3->create_class_with_roles('Class3', 'Role4'); }, 'requires checked properly during create_class_with_roles'; } done_testing; Role-Tiny-1.003002/t/role-basic/lib/000755 000765 000024 00000000000 12211777211 017074 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/t/role-basic/lib/My/000755 000765 000024 00000000000 12211777211 017461 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/t/role-basic/lib/MyTests.pm000644 000765 000024 00000001321 12076372331 021042 0ustar00gknopstaff000000 000000 package MyTests; use strict; use warnings; use Test::More (); use Try::Tiny; sub import { my $class = shift; my $caller = caller; no strict 'refs'; *{"${caller}::exception"} = \&exception; local $" = ", "; use Data::Dumper; $Data::Dumper::Terse = 1; @_ = Dumper(@_); eval <<" END"; package $caller; no strict; use Test::More @_; END die $@ if $@; } sub exception (&) { my ($code) = @_; return try { $code->(); return undef; } catch { return $_ if $_; my $problem = defined $_ ? 'false' : 'undef'; Carp::confess("$problem exception caught by Test::Fatal::exception"); }; } 1; Role-Tiny-1.003002/t/role-basic/lib/TestMethods.pm000644 000765 000024 00000000733 12076372331 021703 0ustar00gknopstaff000000 000000 package TestMethods; use strict; use warnings; sub import { my ( $class, @methods ) = @_; my $target = caller; foreach my $method (@methods) { my $fq_method = $target . "::$method"; no strict 'refs'; *$fq_method = sub { local *__ANON__ = "__ANON__$fq_method"; my $self = shift; return $self->{$method} unless @_; $self->{$method} = shift; return $self; }; } } 1; Role-Tiny-1.003002/t/role-basic/lib/Try/000755 000765 000024 00000000000 12211777211 017652 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/t/role-basic/lib/Try/Tiny.pm000644 000765 000024 00000034072 12076372331 021144 0ustar00gknopstaff000000 000000 # PAUSE doesn't seem to case about this in t/role-basic/lib, but just in case ... package # Hide from PAUSE Try::Tiny; use strict; #use warnings; use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA); BEGIN { require Exporter; @ISA = qw(Exporter); } $VERSION = "0.09"; $VERSION = eval $VERSION; @EXPORT = @EXPORT_OK = qw(try catch finally); $Carp::Internal{+__PACKAGE__}++; # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list # context & not a scalar one sub try (&;@) { my ( $try, @code_refs ) = @_; # we need to save this here, the eval block will be in scalar context due # to $failed my $wantarray = wantarray; my ( $catch, @finally ); # find labeled blocks in the argument list. # catch and finally tag the blocks by blessing a scalar reference to them. foreach my $code_ref (@code_refs) { next unless $code_ref; my $ref = ref($code_ref); if ( $ref eq 'Try::Tiny::Catch' ) { $catch = ${$code_ref}; } elsif ( $ref eq 'Try::Tiny::Finally' ) { push @finally, ${$code_ref}; } else { use Carp; confess("Unknown code ref type given '${ref}'. Check your usage & try again"); } } # save the value of $@ so we can set $@ back to it in the beginning of the eval my $prev_error = $@; my ( @ret, $error, $failed ); # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's # not perfect, but we could provide a list of additional errors for # $catch->(); { # localize $@ to prevent clobbering of previous value by a successful # eval. local $@; # failed will be true if the eval dies, because 1 will not be returned # from the eval body $failed = not eval { $@ = $prev_error; # evaluate the try block in the correct context if ( $wantarray ) { @ret = $try->(); } elsif ( defined $wantarray ) { $ret[0] = $try->(); } else { $try->(); }; return 1; # properly set $fail to false }; # copy $@ to $error; when we leave this scope, local $@ will revert $@ # back to its previous value $error = $@; } # set up a scope guard to invoke the finally block at the end my @guards = map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) } @finally; # at this point $failed contains a true value if the eval died, even if some # destructor overwrote $@ as the eval was unwinding. if ( $failed ) { # if we got an error, invoke the catch block. if ( $catch ) { # This works like given($error), but is backwards compatible and # sets $_ in the dynamic scope for the body of C<$catch> for ($error) { return $catch->($error); } # in case when() was used without an explicit return, the C # loop will be aborted and there's no useful return value } return; } else { # no failure, $@ is back to what it was, everything is fine return $wantarray ? @ret : $ret[0]; } } sub catch (&;@) { my ( $block, @rest ) = @_; return ( bless(\$block, 'Try::Tiny::Catch'), @rest, ); } sub finally (&;@) { my ( $block, @rest ) = @_; return ( bless(\$block, 'Try::Tiny::Finally'), @rest, ); } { package # hide from PAUSE Try::Tiny::ScopeGuard; sub _new { shift; bless [ @_ ]; } sub DESTROY { my @guts = @{ shift() }; my $code = shift @guts; $code->(@guts); } } __PACKAGE__ __END__ =pod =head1 NAME Try::Tiny - minimal try/catch with proper localization of $@ =head1 SYNOPSIS # handle errors with a catch handler try { die "foo"; } catch { warn "caught error: $_"; # not $@ }; # just silence errors try { die "foo"; }; =head1 DESCRIPTION This module provides bare bones C/C/C statements that are designed to minimize common mistakes with eval blocks, and NOTHING else. This is unlike L which provides a nice syntax and avoids adding another call stack layer, and supports calling C from the try block to return from the parent subroutine. These extra features come at a cost of a few dependencies, namely L and L which are occasionally problematic, and the additional catch filtering uses L type constraints which may not be desirable either. The main focus of this module is to provide simple and reliable error handling for those having a hard time installing L, but who still want to write correct C blocks without 5 lines of boilerplate each time. It's designed to work as correctly as possible in light of the various pathological edge cases (see L) and to be compatible with any style of error values (simple strings, references, objects, overloaded objects, etc). If the try block dies, it returns the value of the last statement executed in the catch block, if there is one. Otherwise, it returns C in scalar context or the empty list in list context. The following two examples both assign C<"bar"> to C<$x>. my $x = try { die "foo" } catch { "bar" }; my $x = eval { die "foo" } || "bar"; You can add finally blocks making the following true. my $x; try { die 'foo' } finally { $x = 'bar' }; try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' }; Finally blocks are always executed making them suitable for cleanup code which cannot be handled using local. You can add as many finally blocks to a given try block as you like. =head1 EXPORTS All functions are exported by default using L. If you need to rename the C, C or C keyword consider using L to get L's flexibility. =over 4 =item try (&;@) Takes one mandatory try subroutine, an optional catch subroutine & finally subroutine. The mandatory subroutine is evaluated in the context of an C block. If no error occurred the value from the first block is returned, preserving list/scalar context. If there was an error and the second subroutine was given it will be invoked with the error in C<$_> (localized) and as that block's first and only argument. C<$@> does B contain the error. Inside the C block it has the same value it had before the C block was executed. Note that the error may be false, but if that happens the C block will still be invoked. Once all execution is finished then the finally block if given will execute. =item catch (&;$) Intended to be used in the second argument position of C. Returns a reference to the subroutine it was given but blessed as C which allows try to decode correctly what to do with this code reference. catch { ... } Inside the catch block the caught error is stored in C<$_>, while previous value of C<$@> is still available for use. This value may or may not be meaningful depending on what happened before the C, but it might be a good idea to preserve it in an error stack. For code that captures C<$@> when throwing new errors (i.e. L), you'll need to do: local $@ = $_; =item finally (&;$) try { ... } catch { ... } finally { ... }; Or try { ... } finally { ... }; Or even try { ... } finally { ... } catch { ... }; Intended to be the second or third element of C. Finally blocks are always executed in the event of a successful C or if C is run. This allows you to locate cleanup code which cannot be done via C e.g. closing a file handle. When invoked, the finally block is passed the error that was caught. If no error was caught, it is passed nothing. In other words, the following code does just what you would expect: try { die_sometimes(); } catch { # ...code run in case of error } finally { if (@_) { print "The try block died with: @_\n"; } else { print "The try block ran without error.\n"; } }; B. C will not do anything about handling possible errors coming from code located in these blocks. In the same way C blesses the code reference this subroutine does the same except it bless them as C. =back =head1 BACKGROUND There are a number of issues with C. =head2 Clobbering $@ When you run an eval block and it succeeds, C<$@> will be cleared, potentially clobbering an error that is currently being caught. This causes action at a distance, clearing previous errors your caller may have not yet handled. C<$@> must be properly localized before invoking C in order to avoid this issue. More specifically, C<$@> is clobbered at the beginning of the C, which also makes it impossible to capture the previous error before you die (for instance when making exception objects with error stacks). For this reason C will actually set C<$@> to its previous value (before the localization) in the beginning of the C block. =head2 Localizing $@ silently masks errors Inside an eval block C behaves sort of like: sub die { $@ = $_[0]; return_undef_from_eval(); } This means that if you were polite and localized C<$@> you can't die in that scope, or your error will be discarded (printing "Something's wrong" instead). The workaround is very ugly: my $error = do { local $@; eval { ... }; $@; }; ... die $error; =head2 $@ might not be a true value This code is wrong: if ( $@ ) { ... } because due to the previous caveats it may have been unset. C<$@> could also be an overloaded error object that evaluates to false, but that's asking for trouble anyway. The classic failure mode is: sub Object::DESTROY { eval { ... } } eval { my $obj = Object->new; die "foo"; }; if ( $@ ) { } In this case since C is not localizing C<$@> but still uses C, it will set C<$@> to C<"">. The destructor is called when the stack is unwound, after C sets C<$@> to C<"foo at Foo.pm line 42\n">, so by the time C is evaluated it has been cleared by C in the destructor. The workaround for this is even uglier than the previous ones. Even though we can't save the value of C<$@> from code that doesn't localize, we can at least be sure the eval was aborted due to an error: my $failed = not eval { ... return 1; }; This is because an C that caught a C will always return a false value. =head1 SHINY SYNTAX Using Perl 5.10 you can use L. The C block is invoked in a topicalizer context (like a C block), but note that you can't return a useful value from C using the C blocks without an explicit C. This is somewhat similar to Perl 6's C blocks. You can use it to concisely match errors: try { require Foo; } catch { when (/^Can't locate .*?\.pm in \@INC/) { } # ignore default { die $_ } }; =head1 CAVEATS =over 4 =item * C<@_> is not available within the C block, so you need to copy your arglist. In case you want to work with argument values directly via C<@_> aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference: sub foo { my ( $self, @args ) = @_; try { $self->bar(@args) } } or sub bar_in_place { my $self = shift; my $args = \@_; try { $_ = $self->bar($_) for @$args } } =item * C returns from the C block, not from the parent sub (note that this is also how C works, but not how L works): sub bar { try { return "foo" }; return "baz"; } say bar(); # "baz" =item * C introduces another caller stack frame. L is not used. L will not report this when using full stack traces, though, because C<%Carp::Internal> is used. This lack of magic is considered a feature. =item * The value of C<$_> in the C block is not guaranteed to be the value of the exception thrown (C<$@>) in the C block. There is no safe way to ensure this, since C may be used unhygenically in destructors. The only guarantee is that the C will be called if an exception is thrown. =item * The return value of the C block is not ignored, so if testing the result of the expression for truth on success, be sure to return a false value from the C block: my $obj = try { MightFail->new; } catch { ... return; # avoid returning a true value; }; return unless $obj; =item * C<$SIG{__DIE__}> is still in effect. Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of C blocks, since it isn't people have grown to rely on it. Therefore in the interests of compatibility, C does not disable C<$SIG{__DIE__}> for the scope of the error throwing code. =item * Lexical C<$_> may override the one set by C. For example Perl 5.10's C form uses a lexical C<$_>, creating some confusing behavior: given ($foo) { when (...) { try { ... } catch { warn $_; # will print $foo, not the error warn $_[0]; # instead, get the error like this } } } =back =head1 SEE ALSO =over 4 =item L Much more feature complete, more convenient semantics, but at the cost of implementation complexity. =item L Automatic error throwing for builtin functions and more. Also designed to work well with C/C. =item L A lightweight role for rolling your own exception classes. =item L Exception object implementation with a C statement. Does not localize C<$@>. =item L Provides a C statement, but properly calling C is your responsibility. The C keyword pushes C<$@> onto an error stack, avoiding some of the issues with C<$@>, but you still need to localize to prevent clobbering. =back =head1 LIGHTNING TALK I gave a lightning talk about this module, you can see the slides (Firefox only): L Or read the source: L =head1 VERSION CONTROL L =head1 AUTHOR Yuval Kogman Enothingmuch@woobling.orgE =head1 COPYRIGHT Copyright (c) 2009 Yuval Kogman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the MIT license. =cut Role-Tiny-1.003002/t/role-basic/lib/My/Does/000755 000765 000024 00000000000 12211777211 020353 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/t/role-basic/lib/My/Example.pm000644 000765 000024 00000000243 12076372331 021414 0ustar00gknopstaff000000 000000 package My::Example; use Role::Tiny 'with'; with 'My::Does::Basic'; sub new { bless {} => shift } sub turbo_charger {} $My::Example::foo = 1; sub foo() {} 1; Role-Tiny-1.003002/t/role-basic/lib/My/Does/Basic.pm000644 000765 000024 00000000211 12076372331 021727 0ustar00gknopstaff000000 000000 package My::Does::Basic; use Role::Tiny; requires 'turbo_charger'; sub no_conflict { return "My::Does::Basic::no_conflict"; } 1; Role-Tiny-1.003002/t/lib/Bar.pm000644 000765 000024 00000000076 12076372331 016124 0ustar00gknopstaff000000 000000 package Bar; sub new { bless {} => shift } sub bar { 1 } 1; Role-Tiny-1.003002/t/lib/Baz.pm000644 000765 000024 00000000061 12076372331 016126 0ustar00gknopstaff000000 000000 package Baz; use Role::Tiny; sub baz { 1 } 1; Role-Tiny-1.003002/maint/bump-version000755 000765 000024 00000001440 12170664345 017535 0ustar00gknopstaff000000 000000 #!/usr/bin/env perl use strict; use warnings FATAL => 'all'; use autodie; chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}')); my @parts = split /\./, $LATEST; my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts); my %bump_part = (major => 0, minor => 1, bugfix => 2); my $bump_this = $bump_part{$ARGV[0]||'bugfix'}; die "no idea which part to bump - $ARGV[0] means nothing to me" unless defined($bump_this); my @new_parts = @parts; $new_parts[$bump_this]++; my $NEW_DECIMAL = sprintf('%i.%03i%03i', @new_parts); warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL\n"; my $PM_FILE = 'lib/Moo.pm'; my $file = do { local (@ARGV, $/) = ($PM_FILE); <> }; $file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/; open my $out, '>', $PM_FILE; print $out $file; Role-Tiny-1.003002/maint/Makefile.PL.include000644 000765 000024 00000000426 12211430426 020543 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; use ExtUtils::MakeMaker 6.68 (); author 'mst - Matt S. Trout (cpan:MSTROUT) '; manifest_include 't/role-basic' => qr/.*\.pm$/; 1; Role-Tiny-1.003002/lib/Role/000755 000765 000024 00000000000 12211777211 015512 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/lib/Role/Tiny/000755 000765 000024 00000000000 12211777211 016435 5ustar00gknopstaff000000 000000 Role-Tiny-1.003002/lib/Role/Tiny.pm000644 000765 000024 00000043511 12211775715 017006 0ustar00gknopstaff000000 000000 package Role::Tiny; sub _getglob { \*{$_[0]} } sub _getstash { \%{"$_[0]::"} } use strict; use warnings FATAL => 'all'; our $VERSION = '1.003002'; # 1.3.2 $VERSION = eval $VERSION; our %INFO; our %APPLIED_TO; our %COMPOSED; our %COMPOSITE_INFO; # Module state workaround totally stolen from Zefram's Module::Runtime. BEGIN { *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; } 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 $INFO{$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 }; } 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 $INFO{$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); bless($object, $me->create_class_with_roles($class, @roles)); $object; } 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 $INFO{$role}; } if ($] >= 5.010) { require mro; } else { require MRO::Compat; } 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}}; delete $conflicts{$_} for keys %{ $me->_concrete_methods_of($to) }; 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; } # 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 my $info = $INFO{$role}; (keys %{$me->_concrete_methods_of($role)}, @{$info->{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'; *{_getglob "${to}::${i}"} = $methods->{$i}; } $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 $INFO{$to}; # add does() only if they don't have one *{_getglob "${to}::does"} = \&does_role 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) = @_; Role::Tiny::does_role($proto, $role) or $proto->$existing($role); }; no warnings 'redefine'; *{_getglob "${to}::DOES"} = $new_sub; } sub does_role { my ($proto, $role) = @_; if ($] >= 5.010) { require mro; } else { require MRO::Compat; } 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}; } 1; =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. =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 SEE ALSO L is the attribute-less subset of L; L is a meta-protocol-less subset of the king of role systems, L. If you don't want method modifiers and do want to be forcibly restricted to a single role application per class, Ovid's L exists. But Stevan Little (the L author) and I don't find the additional restrictions to be amazingly helpful in most cases; L's choices are more a guide to what you should prefer doing, to our mind, rather than something that needs to be enforced. =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) =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 Role-Tiny-1.003002/lib/Role/Tiny/With.pm000644 000765 000024 00000001306 12173277266 017722 0ustar00gknopstaff000000 000000 package Role::Tiny::With; use strict; use warnings FATAL => 'all'; 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