@@ -1,14 +1,21 @@
Revision history for Role-Tiny
-1.003002 2013-09-04
+1.003003 - 2014-03-15
+ - overloads specified as method names rather than subrefs are now applied
+ properly
+ - allow superclass to provide conflicting methods (RT#91054)
+ - use ->is_role internally to check if a package is a role
+ - document that Role::Tiny applies strict and fatal warnings
+
+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
+1.003001 - 2013-07-14
- fix test accidentally requiring Class::Method::Modifiers
-1.003000 2013-07-14
+1.003000 - 2013-07-14
- allow composing roles simultaneously that mutually require each other
(RT#82711)
- Fix _concrete_methods_of returning non-CODE entries
@@ -17,67 +24,67 @@ Revision history for Role-Tiny
- 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
+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
+1.002004 - 2012-11-02
- remove accidentally-introduced strictures.pm usage
-1.002003 2012-10-29
+1.002003 - 2012-10-29
- fix method modifier breakage on 5.10.0
-1.002002 2012-10-28
+1.002002 - 2012-10-28
- skip t/around-does.t when Class::Method::Modifiers is not installed
(RT#80310)
-1.002001 2012-10-26
+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
+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
+1.001005 - 2012-07-18
- localize UNIVERSAL::can change to avoid confusing TB2
- properly report roles consumed by superclasses
-1.001004 2012-07-12
+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
+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
+1.001002 - 2012-05-05
- alter duplication test to not provoke Class::Method::Modifiers loading
-1.001001 2012-04-27
+1.001001 - 2012-04-27
- remove strictures from one last test file
-1.001000 2012-04-27
+1.001000 - 2012-04-27
- Documentation improvements, no code changes
-1.000_901 2012-04-12
+1.000_901 - 2012-04-12
- Fix MANIFEST inclusion of Role::Basic composition
-1.000_900 2012-04-11
+1.000_900 - 2012-04-11
- Add composition with tests stolen from Role::Basic
-1.000001 2012-04-03
+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
+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
@@ -94,25 +101,25 @@ Changes below this line are from when Role::Tiny was still bundled with Moo:
- Explicitly require Role::Tiny in Role::Tiny::With (RT#70446)
- Fix spurious 'once' warnings under perl -w
-0.009013 2011-12-23
+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
+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
+0.009011 - 2011-10-03
- add support for DEMOLISH
- add support for BUILDARGS
-0.009010 2011-07-20
+0.009010 - 2011-07-20
- missing new files for Role::Tiny::With
-0.009009 2011-07-20
+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
@@ -120,14 +127,14 @@ Changes below this line are from when Role::Tiny was still bundled with Moo:
subclasses with a BUILD method but no attributes get it honoured
- add coerce handling
-0.009008 2011-06-03
+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
+0.009007 - 2011-02-25
- I botched the copyright. re-disting.
-0.009006 2011-02-25
+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
@@ -8,13 +8,18 @@ MANIFEST This list of files
t/around-does.t
t/compose-modifiers.t
t/concrete-methods.t
+t/create-hook.t
t/does.t
t/lib/Bar.pm
t/lib/Baz.pm
+t/lib/BrokenModule.pm
+t/lib/FalseModule.pm
+t/lib/TrackLoad.pm
+t/load-module.t
t/method-conflicts.t
t/modifiers.t
t/namespace-clean.t
-t/role-basic-00-load.t
+t/overload.t
t/role-basic-basic.t
t/role-basic-bugs.t
t/role-basic-composition.t
@@ -4,7 +4,7 @@
"mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.74, CPAN::Meta::Converter version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 6.9, CPAN::Meta::Converter version 2.140640",
"license" : [
"perl_5"
],
@@ -16,20 +16,35 @@
"no_index" : {
"directory" : [
"t",
- "inc",
"xt"
]
},
"prereqs" : {
"build" : {
- "requires" : {
- "Test::Fatal" : "0.003",
- "Test::More" : "0.96"
+ "requires" : {}
+ },
+ "configure" : {
+ "requires" : {}
+ },
+ "develop" : {
+ "recommends" : {
+ "Moo" : "0",
+ "namespace::clean" : "0"
}
},
"runtime" : {
+ "recommends" : {
+ "Class::Method::Modifiers" : "1.05"
+ },
+ "requires" : {
+ "Exporter" : "5.57",
+ "perl" : "5.006"
+ }
+ },
+ "test" : {
"requires" : {
- "Exporter" : "5.57"
+ "Test::Fatal" : "0.003",
+ "Test::More" : "0.96"
}
}
},
@@ -39,11 +54,15 @@
"mailto" : "bug-Role-Tiny@rt.cpan.org",
"web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny"
},
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
"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"
- }
+ },
+ "x_IRC" : "irc://irc.perl.org/#moose"
},
- "version" : "1.003002"
+ "version" : "1.003003"
}
@@ -3,23 +3,28 @@ abstract: 'Roles. Like a nouvelle cuisine portion size slice of Moose.'
author:
- 'mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>'
build_requires:
- Test::Fatal: 0.003
- Test::More: 0.96
+ Test::Fatal: '0.003'
+ Test::More: '0.96'
+configure_requires: {}
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.74, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 6.9, CPAN::Meta::Converter version 2.140640'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Role-Tiny
no_index:
directory:
- t
- - inc
- xt
+recommends:
+ Class::Method::Modifiers: '1.05'
requires:
- Exporter: 5.57
+ Exporter: '5.57'
+ perl: '5.006'
resources:
+ IRC: irc://irc.perl.org/#moose
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny
+ license: http://dev.perl.org/licenses/
repository: git://git.shadowcat.co.uk/gitmo/Role-Tiny.git
-version: 1.003002
+version: '1.003003'
@@ -1,45 +1,94 @@
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,
+my %META = (
+ name => 'Role-Tiny',
+ license => 'perl_5',
+ prereqs => {
+ configure => { requires => {
+ } },
+ build => { requires => {
+ } },
+ test => { requires => {
+ 'Test::More' => 0.96,
+ 'Test::Fatal' => 0.003,
+ } },
+ runtime => {
+ requires => {
+ perl => 5.006,
+ Exporter => '5.57',
+ },
+ recommends => {
+ 'Class::Method::Modifiers' => 1.05,
+ },
+ },
+ develop => { recommends => {
+ 'namespace::clean' => 0,
+ Moo => 0,
+ } },
+ },
+ 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',
+ },
+ x_IRC => 'irc://irc.perl.org/#moose',
+ license => [ 'http://dev.perl.org/licenses/' ],
+ },
+ no_index => {
+ directory => [ 't', 'xt' ]
+ },
);
-# 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',
+my %MM_ARGS = (
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',
- },
- },
- }),
+ }
);
+
+##############################################################################
+require ExtUtils::MakeMaker;
+(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
+
+# have to do this since old EUMM dev releases miss the eval $VERSION line
+my $eumm_version = eval $ExtUtils::MakeMaker::VERSION;
+my $mymeta = $eumm_version >= 6.57_02;
+my $mymeta_broken = $mymeta && $eumm_version < 6.57_07;
+
+($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g;
+($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g;
+$MM_ARGS{LICENSE} = $META{license}
+ if $eumm_version >= 6.30;
+$MM_ARGS{NO_MYMETA} = 1
+ if $mymeta_broken;
+$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
+ unless -f 'META.yml';
+
+for (qw(configure build test runtime)) {
+ my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES';
+ my $r = $MM_ARGS{$key} = {
+ %{$META{prereqs}{$_}{requires}},
+ %{delete $MM_ARGS{$key} || {}},
+ };
+ defined $r->{$_} or delete $r->{$_} for keys %$r;
+}
+
+$MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0;
+
+delete $MM_ARGS{MIN_PERL_VERSION}
+ if $eumm_version < 6.47_01;
+$MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}}
+ if $eumm_version < 6.63_03;
+$MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}}
+ if $eumm_version < 6.55_01;
+delete $MM_ARGS{CONFIGURE_REQUIRES}
+ if $eumm_version < 6.51_03;
+
+ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS);
@@ -107,6 +107,14 @@ IMPORTED SUBROUTINES
dependency. If your Role::Tiny role uses modifiers you must depend on
both Class::Method::Modifiers and Role::Tiny.
+ Strict and Warnings
+ In addition to importing subroutines, using "Role::Tiny" applies strict
+ and fatal warnings to the caller. It's possible to disable these if
+ desired:
+
+ use Role::Tiny;
+ use warnings NONFATAL => 'all';
+
SUBROUTINES
does_role
if (Role::Tiny::does_role($foo, 'Some::Role')) {
@@ -154,16 +162,16 @@ METHODS
Returns true if the given package is a role.
+CAVEATS
+ * 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.
+
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.
+ Ovid's Role::Basic provides roles with a similar scope, but without
+ method modifiers, and having some extra usage restrictions.
AUTHOR
mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
@@ -194,6 +202,8 @@ CONTRIBUTORS
tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
+ haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
+
COPYRIGHT
Copyright (c) 2010-2012 the Role::Tiny "AUTHOR" and "CONTRIBUTORS" as
listed above.
@@ -2,6 +2,10 @@ package Role::Tiny::With;
use strict;
use warnings FATAL => 'all';
+
+our $VERSION = '1.003003';
+$VERSION = eval $VERSION;
+
use Role::Tiny ();
use Exporter 'import';
@@ -6,18 +6,20 @@ sub _getstash { \%{"$_[0]::"} }
use strict;
use warnings FATAL => 'all';
-our $VERSION = '1.003002'; # 1.3.2
+our $VERSION = '1.003003';
$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 {
@@ -43,7 +45,7 @@ sub import {
my $me = shift;
strict->import;
warnings->import(FATAL => 'all');
- return if $INFO{$target}; # already exported into this package
+ return if $me->is_role($target); # already exported into this package
$INFO{$target}{is_role} = 1;
# get symbol table reference
my $stash = _getstash($target);
@@ -71,6 +73,7 @@ sub import {
@{$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 {
@@ -83,7 +86,7 @@ sub apply_single_role_to_package {
_load_module($role);
die "This is apply_role_to_package" if ref($to);
- die "${role} is not a Role::Tiny" unless $INFO{$role};
+ die "${role} is not a Role::Tiny" unless $me->is_role($role);
foreach my $step ($me->role_application_steps) {
$me->$step($to, $role);
@@ -100,8 +103,9 @@ 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;
+ # 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';
@@ -139,19 +143,15 @@ sub create_class_with_roles {
foreach my $role (@roles) {
_load_module($role);
- die "${role} is not a Role::Tiny" unless $INFO{$role};
+ die "${role} is not a Role::Tiny" unless $me->is_role($role);
}
- if ($] >= 5.010) {
- require mro;
- } else {
- require MRO::Compat;
- }
+ require(_MRO_MODULE);
my $composite_info = $me->_composite_info_for(@roles);
my %conflicts = %{$composite_info->{conflicts}};
if (keys %conflicts) {
- my $fail =
+ my $fail =
join "\n",
map {
"Method name conflict for '$_' between roles "
@@ -198,9 +198,11 @@ sub apply_roles_to_package {
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) };
+ my @have = grep $to->can($_), keys %conflicts;
+ delete @conflicts{@have};
+
if (keys %conflicts) {
- my $fail =
+ my $fail =
join "\n",
map {
"Due to a method name conflict between roles "
@@ -210,6 +212,15 @@ sub apply_roles_to_package {
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()
@@ -327,8 +338,8 @@ sub _concrete_methods_of {
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}||[]});
+ die "${role} is not a Role::Tiny" unless $me->is_role($role);
+ (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
}
sub _install_methods {
@@ -350,9 +361,23 @@ sub _install_methods {
foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
no warnings 'once';
- *{_getglob "${to}::${i}"} = $methods->{$i};
+ 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;
+
+ my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
+ next
+ unless defined $overload;
+
+ *$glob = \$overload;
}
-
+
$me->_install_does($to);
}
@@ -385,15 +410,16 @@ sub _install_single_modifier {
my $FALLBACK = sub { 0 };
sub _install_does {
my ($me, $to) = @_;
-
+
# only add does() method to classes
- return if $INFO{$to};
-
+ return if $me->is_role($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));
-
+
+ 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) = @_;
@@ -405,11 +431,7 @@ sub _install_does {
sub does_role {
my ($proto, $role) = @_;
- if ($] >= 5.010) {
- require mro;
- } else {
- require MRO::Compat;
- }
+ require(_MRO_MODULE);
foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) {
return 1 if exists $APPLIED_TO{$class}{$role};
}
@@ -418,10 +440,11 @@ sub does_role {
sub is_role {
my ($me, $role) = @_;
- return !!$INFO{$role};
+ return !!($INFO{$role} && $INFO{$role}{is_role});
}
1;
+__END__
=encoding utf-8
@@ -507,7 +530,7 @@ Declares a list of methods that must be defined to compose role.
Composes another role into the current role (or class via L<Role::Tiny::With>).
If you have conflicts and want to resolve them in favour of Some::Role1 you
-can instead write:
+can instead write:
with 'Some::Role1';
with 'Some::Role2';
@@ -551,6 +574,15 @@ L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
both L<Class::Method::Modifiers> and L<Role::Tiny>.
+=head2 Strict and Warnings
+
+In addition to importing subroutines, using C<Role::Tiny> applies L<strict> and
+L<fatal warnings|perllexwarn/Fatal Warnings> to the caller. It's possible to
+disable these if desired:
+
+ use Role::Tiny;
+ use warnings NONFATAL => 'all';
+
=head1 SUBROUTINES
=head2 does_role
@@ -604,17 +636,22 @@ New class is returned.
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<Role::Tiny> is the attribute-less subset of L<Moo::Role>; L<Moo::Role> is
a meta-protocol-less subset of the king of role systems, L<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 L<Role::Basic> exists. But
-Stevan Little (the L<Moose> author) and I don't find the additional
-restrictions to be amazingly helpful in most cases; L<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.
+Ovid's L<Role::Basic> provides roles with a similar scope, but without method
+modifiers, and having some extra usage restrictions.
=head1 AUTHOR
@@ -646,6 +683,8 @@ ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
+haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
+
=head1 COPYRIGHT
Copyright (c) 2010-2012 the Role::Tiny L</AUTHOR> and L</CONTRIBUTORS>
@@ -1,7 +1,9 @@
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 ();
+use ExtUtils::MakeMaker;
+ExtUtils::MakeMaker->VERSION(6.68)
+ unless $ENV{CONTINUOUS_INTEGRATION};
author 'mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>';
@@ -7,6 +7,9 @@ use autodie;
chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}'));
my @parts = split /\./, $LATEST;
+if (@parts == 2) {
+ @parts[1,2] = $parts[1] =~ /(\d{1,3})(\d{1,3})/;
+}
my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts);
@@ -20,17 +23,24 @@ die "no idea which part to bump - $ARGV[0] means nothing to me"
my @new_parts = @parts;
$new_parts[$bump_this]++;
+$new_parts[$_] = 0 for ($bump_this+1 .. 2);
my $NEW_DECIMAL = sprintf('%i.%03i%03i', @new_parts);
warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL\n";
-my $PM_FILE = 'lib/Moo.pm';
+for my $PM_FILE (qw(
+ lib/Moo.pm
+ lib/Moo/Role.pm
+ lib/Sub/Defer.pm
+ lib/Sub/Quote.pm
+)) {
+ my $file = do { local (@ARGV, $/) = ($PM_FILE); <> };
-my $file = do { local (@ARGV, $/) = ($PM_FILE); <> };
+ $file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/
+ or die "unable to bump version number in $PM_FILE";
-$file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/;
+ open my $out, '>', $PM_FILE;
-open my $out, '>', $PM_FILE;
-
-print $out $file;
+ print $out $file;
+}
@@ -27,8 +27,16 @@ 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 @role_method_list = Role::Tiny->methods_provided_by('MyRole1');
+is_deeply(\@role_method_list, ['after_role'],
+ 'methods_provided_by gives method list' );
+
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' );
+like exception { Role::Tiny->methods_provided_by('MyClass1') },
+ qr/is not a Role::Tiny/,
+ 'methods_provided_by refuses to work on classes';
+
done_testing;
@@ -0,0 +1,26 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Role::Tiny ();
+
+my $last_role;
+push @Role::Tiny::ON_ROLE_CREATE, sub {
+ ($last_role) = @_;
+};
+
+eval q{
+ package MyRole;
+ use Role::Tiny;
+};
+
+is $last_role, 'MyRole', 'role create hook was run';
+
+eval q{
+ package MyRole2;
+ use Role::Tiny;
+};
+
+is $last_role, 'MyRole2', 'role create hook was run again';
+
+done_testing;
@@ -0,0 +1,6 @@
+package BrokenModule;
+use strict;
+use warnings;
+
+my $f = blorp;
+1;
@@ -0,0 +1,3 @@
+package FalseModule;
+
+0;
@@ -0,0 +1,4 @@
+package TrackLoad;
+our $LOADED;
+$LOADED++;
+1;
@@ -0,0 +1,32 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+use Test::Fatal;
+
+use Role::Tiny ();
+
+use lib 't/lib';
+
+{
+ package TrackLoad;
+ our $LOADED = 0;
+}
+
+Role::Tiny::_load_module('TrackLoad');
+is $TrackLoad::LOADED, 0, 'modules not loaded if symbol table entries exist';
+
+eval { Role::Tiny::_load_module('BrokenModule') };
+like "$@", qr/Compilation failed/,
+ 'broken modules throw errors';
+eval { require BrokenModule };
+like "$@", qr/Compilation failed/,
+ ' ... and still fail if required again';
+
+eval { Role::Tiny::_load_module('FalseModule') };
+like "$@", qr/did not return a true value/,
+ 'modules returning false throw errors';
+eval { require FalseModule };
+like "$@", qr/did not return a true value/,
+ ' ... and still fail if required again';
+
+done_testing;
@@ -45,6 +45,19 @@ BEGIN {
around 'broken modifier' => sub { my $orig = shift; $orig->(@_) };
}
+BEGIN {
+ package MyRole2;
+ use Role::Tiny;
+ with 'MyRole';
+}
+
+BEGIN {
+ package ExtraClass2;
+ use Role::Tiny::With;
+ with 'MyRole2';
+ sub foo { 'class foo' }
+}
+
sub try_apply_to {
my $to = shift;
exception { Role::Tiny->apply_role_to_package($to, 'MyRole') }
@@ -54,6 +67,9 @@ 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');
+is(ExtraClass2->foo, 'role foo class foo',
+ 'method modifier with role composed into role');
+
ok(exception {
my $new_class = Role::Tiny->create_class_with_roles('MyClass', 'BrokenRole');
}, 'exception caught creating class with broken modifier in a role');
@@ -0,0 +1,73 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+BEGIN {
+ package MyRole;
+ use Role::Tiny;
+
+ sub as_string { "welp" }
+ sub as_num { 219 }
+ use overload
+ '""' => \&as_string,
+ '0+' => 'as_num',
+ bool => sub(){0},
+ fallback => 1;
+}
+
+BEGIN {
+ package MyClass;
+ use Role::Tiny::With;
+ with 'MyRole';
+ sub new { bless {}, shift }
+}
+
+BEGIN {
+ package MyClass2;
+ use overload
+ fallback => 0,
+ '""' => 'class_string',
+ '0+' => sub { 42 },
+ ;
+ use Role::Tiny::With;
+ with 'MyRole';
+ sub new { bless {}, shift }
+ sub class_string { 'yarp' }
+}
+
+BEGIN {
+ package MyClass3;
+ sub new { bless {}, shift }
+}
+
+{
+ my $o = MyClass->new;
+ is "$o", 'welp', 'subref overload';
+ is sprintf('%d', $o), 219, 'method name overload';
+ ok !$o, 'anon subref overload';
+}
+
+{
+ my $o = MyClass2->new;
+ eval { my $f = 0+$o };
+ like $@, qr/no method found/, 'fallback value not overwritten';
+ is "$o", 'yarp', 'method name overload not overwritten';
+ is sprintf('%d', $o), 42, 'subref overload not overwritten';
+}
+
+{
+ my @o = (MyClass3->new) x 2;
+ my $copy = '';
+ for my $o (@o) {
+ Role::Tiny->apply_roles_to_object($o, 'MyRole')
+ unless $copy;
+ local $TODO = 'magic not applied to all ref copies on perl < 5.8.9'
+ if $copy && $] < 5.008009;
+ is "$o", 'welp', 'subref overload applied to instance'.$copy;
+ is sprintf('%d', $o), 219, 'method name overload applied to instance'.$copy;
+ ok !$o, 'anon subref overload applied to instance'.$copy;
+ $copy ||= ' copy';
+ }
+}
+
+done_testing;
@@ -1,7 +0,0 @@
-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" );
@@ -201,4 +201,35 @@ SKIP: {
is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@";
}
+{
+ {
+ package My::Does::Conflict;
+ use Role::Tiny;
+
+ sub method {
+ return __PACKAGE__ . " method";
+ }
+ }
+ {
+ package My::Class::Base;
+
+ sub turbo_charger {
+ return __PACKAGE__ . " turbo charger";
+ }
+ sub method {
+ return __PACKAGE__ . " method";
+ }
+ }
+ my $success = eval q{
+ package My::Class::Child;
+ use base 'My::Class::Base';
+ use Role::Tiny::With;
+ with qw/My::Does::Basic1 My::Does::Conflict/;
+ 1;
+ };
+ is $success, 1, 'role conflict resolved by superclass method' or diag "Error: $@";
+ can_ok 'My::Class::Child', 'method';
+ is My::Class::Child->method, 'My::Class::Base method', 'inherited method prevails';
+}
+
done_testing;
@@ -35,8 +35,8 @@ for (qw(
}
my $pkg = ref $foo;
-note $pkg;
eval "package $pkg;";
-ok(!$@) or diag $@;
+is $@, '', 'package name usable by perl'
+ or diag "package: $pkg";
done_testing;