Role-Tiny
view release on metacpan or search on metacpan
Revision history for Role-Tiny
2.002004 - 2021-01-24
- restore requiring base class when using create_class_with_roles, which was
accidentally lost in 2.002_000 (RT#134075)
2.002003 - 2021-01-11
- set dynamic_config to 0 and x_static_install to 1
- fixed filenames in dependents author test to not use colons
- removed MRO::Compat from prereqs as it is no longer used
- marked Class::Method::Modifiers as a hard developer dependency rather than
a recommended developer dependency
- rewrote test for namespace cleaning to not require namespace::clean, and
moved it from an author test to a normal test
- removed namespace::autoclean from developer prereqs
2.002_002 - 2021-01-03
- refactored some internals for subclasses to use
- methods_provided_by will ensure the module is loaded before checking for
methods
2.002_001 - 2020-12-27
- fix tests when Class::Method::Modifiers is not installed
2.002_000 - 2020-12-23
- Refactored create_class_with_roles to not use "composable packages". This
was an optimization for when a role is used in many different uses of
create_class_with_roles, but required an entirely separate implementation,
which did not have fully compatible behavior. It would also result in
methods using modifiers being slower.
- Add documentation for what methods will be composed from a role
(RT#133363)
- Fix backwards compatibility with older versions of Moo when interacting
with Moose.
- Treat modifiers as required methods during create_class_with_roles.
- Fixed methods being no longer composed after they participated in an
allowed conflict.
- Dropped use of MRO::Compat.
- Test cleanups for checking requires during create_class_with_roles.
- Additional tests to confirm internal role application steps can be fully
qualified.
- Fix Pod links to Class::Method::Modifiers
- Tweaks to author tests
- Additional tests for working with older Moo versions
- Additional tests for module loading
- Allow method modifiers to be specified with an array reference of method
names, rather than a list. This now matches how the corresponding
Class::Method::Modifiers subs can be called.
2.001004 - 2019-10-25
- fix methods being excluded from composition if they previously existed in
the composing role (RT#130811)
- fix role application overwriting subs that are not considered methods
- fix helper subs created by a Role::Tiny extension (like Moo::Role)
sometimes being teated as methods
2.001003 - 2019-10-09
- releasing as stable
2.001_002 - 2019-10-06
- fix methods from roles composed via create_class_with_roles being treated
differently from roles composed directly (RT#128470)
- fix constants being included in the methods provided by a role if they
were created before importing Role::Tiny but used after importing
- fix prototype handling test on cperl
2.001001 - 2019-10-01
- added tests for make_role
2.001_000 - 2019-09-19
- refactored method tracking to allow easier extending (such as by Moo)
- added make_role method to make a package into a role, but without
exporting any subs into it
- refactored sub exporting to allow extensions to do different things with
the subs
2.000_009 - 2019-09-06
- fix composing roles into packages that have stub subs in them
- treat constants consistently with all other subs, no matter where they are
defined
2.000008 - 2019-08-05
- reverting all changes from 2.000007 due to failures on some perl versions
and a number of downstream users. The changes will be reintroduced in a
fixed form in a future version.
2.000007 - 2019-07-31
- fix composing roles into packages that have stub subs in them
- exclude all constant subs from method list
2.000006 - 2017-11-08
- account for code references stored directly in stash (for perl 5.28)
- work around hint leakage when loading modules in perl 5.8 and 5.10.1
2.000005 - 2016-11-01
- revert change to MRO::Compat usage
2.000004 - 2016-10-31
- Fix consuming stubs from roles (RT#116674).
- Fix error message when applying conflicting roles to an object.
- Drop prerequisite on MRO::Compat on perl 5.8.
2.000003 - 2016-04-21
- don't install subs if importing into a package that is already a role. This
can happen if the module previously imported Moo::Role.
2.000002 - 2016-04-19
- restore compatibility with Moo versions pre 1.004_003
- delay loading Class::Method::Modifiers until applying modifiers to a package
- use croak rather than die for reporting errors
- apply method modifiers only once, even if they are applied via multiple
composition paths (RT#106668)
2.000001 - 2015-04-24
- fix generating invalid package names with single colons when abbreviating
long package names (RT#103310)
- don't run module interaction tests for user installs
2.000000 - 2015-02-26
* Incompatible Changes
- Role::Tiny no longer applies fatal warnings to roles created with it.
strict and non-fatal warnings will continue to be applied.
1.003004 - 2014-10-22
- allow does_role to be overridden by Moo::Role
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
- 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
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2021 by mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>.
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Artistic License 1.0 ---
This software is Copyright (c) 2021 by mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>.
This is free software, licensed under:
The Artistic License 1.0
The Artistic License
Preamble
The intent of this document is to state the conditions under which a Package
may be copied, such that the Copyright Holder maintains some semblance of
artistic control over the development of the package, while giving the users of
the package the right to use and distribute the Package in a more-or-less
customary fashion, plus the right to make reasonable modifications.
Definitions:
- "Package" refers to the collection of files distributed by the Copyright
Holder, and derivatives of that collection of files created through
textual modification.
- "Standard Version" refers to such a Package if it has not been modified,
or has been modified in accordance with the wishes of the Copyright
Holder.
- "Copyright Holder" is whoever is named in the copyright or copyrights for
the package.
- "You" is you, if you're thinking about copying or distributing this Package.
- "Reasonable copying fee" is whatever you can justify on the basis of media
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or an
equivalent medium, or placing the modifications on a major archive site
such as ftp.uu.net, or by allowing the Copyright Holder to include your
modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict with
standard executables, which must also be provided, and provide a separate
manual page for each non-standard executable that clearly documents how it
differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or executable
form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where to
get the Standard Version.
b) accompany the distribution with the machine-readable source of the Package
with your modifications.
c) accompany any non-standard executables with their corresponding Standard
Version executables, giving the non-standard executables non-standard
names, and clearly documenting the differences in manual pages (or
equivalent), together with instructions on where to get the Standard
Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this Package. You
may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
Changes
lib/Role/Tiny.pm
lib/Role/Tiny/With.pm
maint/Makefile.PL.include
Makefile.PL
MANIFEST This list of files
t/concrete-methods.t
t/create-hook.t
t/does.t
t/extend-role-tiny.t
t/extend.t
t/lib/BrokenModule.pm
t/lib/ExistingModule.pm
t/lib/FalseModule.pm
t/lib/TrueModule.pm
t/load-module.t
t/make-role.t
t/method-conflicts.t
t/namespace-clean.t
t/overload.t
t/proto.t
t/role-basic-basic.t
t/role-basic-bugs.t
t/role-basic-composition.t
t/role-basic-exceptions.t
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/stub.t
t/subclass.t
xt/around-does.t
xt/compose-modifiers.t
xt/dependents.t
xt/dependents/Moo-isa-assign.patch
xt/dependents/Moo-sort-sub-quote.patch
xt/modifiers.t
xt/recompose-modifier.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)
LICENSE LICENSE file (added by Distar)
{
"abstract" : "Roles: a nouvelle cuisine portion size slice of Moose",
"author" : [
"mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.58, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Role-Tiny",
"no_index" : {
"directory" : [
"t",
"xt"
]
},
"prereqs" : {
"build" : {},
"configure" : {},
"develop" : {
"requires" : {
"Class::Method::Modifiers" : "1.05"
}
},
"runtime" : {
"recommends" : {
"Class::Method::Modifiers" : "1.05"
},
"requires" : {
"Exporter" : "5.57",
"perl" : "5.006"
}
},
"test" : {
"requires" : {
"Test::More" : "0.88"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"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://github.com/moose/Role-Tiny.git",
"web" : "https://github.com/moose/Role-Tiny"
},
"x_IRC" : "irc://irc.perl.org/#moose"
},
"version" : "2.002004",
"x_serialization_backend" : "JSON::PP version 4.04",
"x_static_install" : 1
}
---
abstract: 'Roles: a nouvelle cuisine portion size slice of Moose'
author:
- 'mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>'
build_requires:
Test::More: '0.88'
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 7.58, CPAN::Meta::Converter version 2.150010'
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
- xt
recommends:
Class::Method::Modifiers: '1.05'
requires:
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://github.com/moose/Role-Tiny.git
version: '2.002004'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
x_static_install: 1
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use 5.006;
my %META = (
name => 'Role-Tiny',
prereqs => {
test => { requires => {
'Test::More' => '0.88',
} },
runtime => {
requires => {
'perl' => '5.006',
'Exporter' => '5.57',
},
recommends => {
'Class::Method::Modifiers' => '1.05',
},
},
develop => {
requires => {
'Class::Method::Modifiers' => '1.05',
},
},
},
resources => {
repository => {
url => 'git://github.com/moose/Role-Tiny.git',
web => 'https://github.com/moose/Role-Tiny',
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' ]
},
dynamic_config => 0,
x_static_install => 1,
);
my $xt = $ENV{EXTENDED_TESTING} && do {
my %x_prereqs = (
%{ $META{prereqs}{develop}{requires} },
);
local $@;
!grep !eval {
my $module = $_;
my $v = $x_prereqs{$module};
(my $file = "$module.pm") =~ s{::}{/}g;
require $file;
$module->VERSION($v)
if $v;
1;
}, sort keys %x_prereqs;
};
my %MM_ARGS = (
($xt ? (
test => { TESTS => 't/*.t xt/*.t' },
):()),
);
## BOILERPLATE ###############################################################
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;
$META{license} = [ $META{license} ]
if $META{license} && !ref $META{license};
$MM_ARGS{LICENSE} = $META{license}[0]
if $META{license} && $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);
## END BOILERPLATE ###########################################################
NAME
Role::Tiny - Roles: a nouvelle cuisine portion size slice of Moose
SYNOPSIS
package Some::Role;
use Role::Tiny;
sub foo { ... }
sub bar { ... }
around baz => sub { ... };
1;
elsewhere
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. A method inherited by a class gets
overridden by the role's method of the same name, though.
* 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.
ROLE METHODS
All subs created after importing Role::Tiny will be considered methods
to be composed. For example:
package MyRole;
use List::Util qw(min);
sub mysub { }
use Role::Tiny;
use List::Util qw(max);
sub mymethod { }
In this role, "max" and "mymethod" will be included when composing
MyRole, and "min" and "mysub" will not. For additional control,
namespace::clean can be used to exclude undesired subs from roles.
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.
Strict and Warnings
In addition to importing subroutines, using "Role::Tiny" applies strict
and warnings to the caller.
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
make_role
Role::Tiny->make_role('Some::Role');
Makes a package into a role, but does not export any subs into it.
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. Note that the object's methods get overridden by
the role's ones with the same names.
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.
CAVEATS
* On perl 5.8.8 and earlier, applying a role to an object won't apply
any overloads from the role to other copies of the object.
* On perl 5.16 and earlier, applying a role to a class won't apply any
overloads from the role to any existing instances of the class.
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.
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>
CONTRIBUTORS
dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
Mithaldu - Christian Walde (cpan:MITHALDU)
<walde.christian@googlemail.com>
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>
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.
lib/Role/Tiny.pm view on Meta::CPAN
package Role::Tiny;
use strict;
use warnings;
our $VERSION = '2.002004';
$VERSION =~ tr/_//d;
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};
*_WORK_AROUND_HINT_LEAKAGE
= "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
? sub(){1} : sub(){0};
*_CONSTANTS_DEFLATE = "$]" >= 5.012 && "$]" < 5.020 ? sub(){1} : sub(){0};
}
sub _getglob { no strict 'refs'; \*{$_[0]} }
sub _getstash { no strict 'refs'; \%{"$_[0]::"} }
sub croak {
require Carp;
no warnings 'redefine';
*croak = \&Carp::croak;
goto &Carp::croak;
}
sub Role::Tiny::__GUARD__::DESTROY {
delete $INC{$_[0]->[0]} if @{$_[0]};
}
sub _load_module {
my ($module) = @_;
(my $file = "$module.pm") =~ s{::}{/}g;
return 1
if $INC{$file};
# 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 !/::\z/, keys %{_getstash($module)};
my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
&& bless([ $file ], 'Role::Tiny::__GUARD__');
local %^H if _WORK_AROUND_HINT_LEAKAGE;
require $file;
pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
return 1;
}
sub _require_module {
_load_module($_[1]);
}
sub _all_subs {
my ($me, $package) = @_;
my $stash = _getstash($package);
return {
map {;
no strict 'refs';
# this is an ugly hack to populate the scalar slot of any globs, to
# prevent perl from converting constants back into scalar refs in the
# stash when they are used (perl 5.12 - 5.18). scalar slots on their own
# aren't detectable through pure perl, so this seems like an acceptable
# compromise.
${"${package}::${_}"} = ${"${package}::${_}"}
if _CONSTANTS_DEFLATE;
$_ => \&{"${package}::${_}"}
}
grep exists &{"${package}::${_}"},
grep !/::\z/,
keys %$stash
};
}
sub import {
my $target = caller;
my $me = shift;
strict->import;
warnings->import;
my $non_methods = $me->_non_methods($target);
$me->_install_subs($target, @_);
$me->make_role($target);
$me->_mark_new_non_methods($target, $non_methods)
if $non_methods && %$non_methods;
return;
}
sub _mark_new_non_methods {
my ($me, $target, $old_non_methods) = @_;
my $non_methods = $INFO{$target}{non_methods};
my $subs = $me->_all_subs($target);
for my $sub (keys %$subs) {
if ( exists $old_non_methods->{$sub} && $non_methods->{$sub} != $subs->{$sub} ) {
$non_methods->{$sub} = $subs->{$sub};
}
}
return;
}
sub make_role {
my ($me, $target) = @_;
return if $me->is_role($target);
$INFO{$target}{is_role} = 1;
my $non_methods = $me->_all_subs($target);
delete @{$non_methods}{grep /\A\(/, keys %$non_methods};
$INFO{$target}{non_methods} = $non_methods;
# a role does itself
$APPLIED_TO{$target} = { $target => undef };
foreach my $hook (@ON_ROLE_CREATE) {
$hook->($target);
}
}
sub _install_subs {
my ($me, $target) = @_;
return if $me->is_role($target);
my %install = $me->_gen_subs($target);
*{_getglob("${target}::${_}")} = $install{$_}
for sort keys %install;
return;
}
sub _gen_subs {
my ($me, $target) = @_;
(
(map {;
my $type = $_;
$type => sub {
my $code = pop;
my @names = ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;
push @{$INFO{$target}{modifiers}||=[]}, [ $type, @names, $code ];
return;
};
} qw(before after around)),
requires => sub {
push @{$INFO{$target}{requires}||=[]}, @_;
return;
},
with => sub {
$me->apply_roles_to_package($target, @_);
return;
},
);
}
sub role_application_steps {
qw(
_install_methods
_check_requires
_install_modifiers
_copy_applied_list
);
}
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) = @_;
my $class = ref($object);
# on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter
# directly, so at least the variable passed to us will get any magic applied
bless($_[1], $me->create_class_with_roles($class, @roles));
}
my $role_suffix = 'A000';
sub _composite_name {
my ($me, $superclass, @roles) = @_;
my $new_name = $superclass . '__WITH__' . join '__AND__', @roles;
if (length($new_name) > 252) {
$new_name = $COMPOSED{abbrev}{$new_name} ||= do {
my $abbrev = substr $new_name, 0, 250 - length $role_suffix;
$abbrev =~ s/(?<!:):$//;
$abbrev.'__'.$role_suffix++;
};
}
return $new_name;
}
sub create_class_with_roles {
my ($me, $superclass, @roles) = @_;
$me->_require_module($superclass);
$me->_check_roles(@roles);
my $new_name = $me->_composite_name($superclass, @roles);
return $new_name
if $COMPOSED{class}{$new_name};
return $me->_build_class_with_roles($new_name, $superclass, @roles);
}
sub _build_class_with_roles {
my ($me, $new_name, $superclass, @roles) = @_;
$COMPOSED{base}{$new_name} = $superclass;
@{*{_getglob("${new_name}::ISA")}} = ( $superclass );
$me->apply_roles_to_package($new_name, @roles);
$COMPOSED{class}{$new_name} = 1;
return $new_name;
}
sub _check_roles {
my ($me, @roles) = @_;
croak "No roles supplied!" unless @roles;
my %seen;
if (my @dupes = grep 1 == $seen{$_}++, @roles) {
croak "Duplicated roles: ".join(', ', @dupes);
}
foreach my $role (@roles) {
$me->_require_module($role);
croak "${role} is not a ${me}" unless $me->is_role($role);
}
}
our %BACKCOMPAT_HACK;
$BACKCOMPAT_HACK{+__PACKAGE__} = 0;
sub _want_backcompat_hack {
my $me = shift;
return $BACKCOMPAT_HACK{$me}
if exists $BACKCOMPAT_HACK{$me};
no warnings 'uninitialized';
$BACKCOMPAT_HACK{$me} =
$me->can('apply_single_role_to_package') != \&apply_single_role_to_package
&& $me->can('role_application_steps') == \&role_application_steps
}
our $IN_APPLY_ROLES;
sub apply_single_role_to_package {
return
if $IN_APPLY_ROLES;
local $IN_APPLY_ROLES = 1;
my ($me, $to, $role) = @_;
$me->apply_roles_to_package($to, $role);
}
sub apply_role_to_package {
my ($me, $to, $role) = @_;
$me->apply_roles_to_package($to, $role);
}
sub apply_roles_to_package {
my ($me, $to, @roles) = @_;
croak "Can't apply roles to object with apply_roles_to_package"
if ref $to;
$me->_check_roles(@roles);
my @have_conflicts;
my %role_methods;
if (@roles > 1) {
my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
@have_conflicts = grep $to->can($_), keys %conflicts;
delete @conflicts{@have_conflicts};
if (keys %conflicts) {
my $class = $COMPOSED{base}{$to} || $to;
my $fail =
join "\n",
map {
"Due to a method name conflict between roles "
.join(' and ', map "'$_'", sort values %{$conflicts{$_}})
.", the method '$_' must be implemented by '$class'"
} sort keys %conflicts;
croak $fail;
}
%role_methods = map +($_ => $me->_concrete_methods_of($_)), @roles;
}
if (!$IN_APPLY_ROLES and _want_backcompat_hack($me)) {
local $IN_APPLY_ROLES = 1;
foreach my $role (@roles) {
$me->apply_single_role_to_package($to, $role);
}
}
my $role_methods;
foreach my $step ($me->role_application_steps) {
foreach my $role (@roles) {
# 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.
$role_methods = $role_methods{$role} and (
(local @{$role_methods}{@have_conflicts}),
(delete @{$role_methods}{@have_conflicts}),
);
$me->$step($to, $role);
}
}
$APPLIED_TO{$to}{join('|',@roles)} = 1;
}
sub _composite_info_for {
my ($me, @roles) = @_;
$COMPOSITE_INFO{join('|', sort @roles)} ||= do {
my %methods;
foreach my $role (@roles) {
my $this_methods = $me->_concrete_methods_of($role);
$methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
}
delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
+{ conflicts => \%methods }
};
}
sub _check_requires {
my ($me, $to, $name, $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 {
croak "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
}
}
}
sub _non_methods {
my ($me, $role) = @_;
my $info = $INFO{$role} or return {};
my %non_methods = %{ $info->{non_methods} || {} };
# this is only for backwards compatibility with older Moo, which
# reimplements method tracking rather than calling our method
my %not_methods = reverse %{ $info->{not_methods} || {} };
return \%non_methods unless keys %not_methods;
my $subs = $me->_all_subs($role);
for my $sub (grep !/\A\(/, keys %$subs) {
my $code = $subs->{$sub};
if (exists $not_methods{$code}) {
$non_methods{$sub} = $code;
}
}
return \%non_methods;
}
sub _concrete_methods_of {
my ($me, $role) = @_;
my $info = $INFO{$role};
return $info->{methods}
if $info && $info->{methods};
my $non_methods = $me->_non_methods($role);
my $subs = $me->_all_subs($role);
for my $sub (keys %$subs) {
if ( exists $non_methods->{$sub} && $non_methods->{$sub} == $subs->{$sub} ) {
delete $subs->{$sub};
}
}
if ($info) {
$info->{methods} = $subs;
}
return $subs;
}
sub methods_provided_by {
my ($me, $role) = @_;
$me->_require_module($role);
croak "${role} is not a ${me}" unless $me->is_role($role);
sort (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
}
sub _install_methods {
my ($me, $to, $role) = @_;
my $methods = $me->_concrete_methods_of($role);
my %existing_methods;
@existing_methods{keys %{ $me->_all_subs($to) }} = ();
# _concrete_methods_of caches its result on roles. that cache needs to be
# invalidated after applying roles
delete $INFO{$to}{methods} if $INFO{$to};
foreach my $i (keys %$methods) {
next
if exists $existing_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)
|| (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
my $overload = ${ _getglob "${role}::${i}" };
next
unless defined $overload;
*$glob = \$overload;
}
$me->_install_does($to);
}
sub _install_modifiers {
my ($me, $to, $name) = @_;
return unless my $modifiers = $INFO{$name}{modifiers};
my $info = $INFO{$to};
my $existing = ($info ? $info->{modifiers} : $COMPOSED{modifiers}{$to}) ||= [];
my @modifiers = grep {
my $modifier = $_;
!grep $_ == $modifier, @$existing;
} @{$modifiers||[]};
push @$existing, @modifiers;
if (!$info) {
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 {
require Class::Method::Modifiers;
Class::Method::Modifiers->VERSION(1.05);
1;
} ? 0 : $@;
};
$vcheck_error and die $vcheck_error;
Class::Method::Modifiers::install_modifier(@args);
}
my $FALLBACK = sub { 0 };
sub _install_does {
my ($me, $to) = @_;
# only add does() method to classes
return if $me->is_role($to);
my $does = $me->can('does_role');
# add does() only if they don't have one
*{_getglob "${to}::does"} = $does unless $to->can('does');
return
if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
my $new_sub = sub {
my ($proto, $role) = @_;
$proto->$does($role) or $proto->$existing($role);
};
no warnings 'redefine';
return *{_getglob "${to}::DOES"} = $new_sub;
}
# optimize for newer perls
require mro
if "$]" >= 5.009_005;
if (defined &mro::get_linear_isa) {
*_linear_isa = \&mro::get_linear_isa;
}
else {
my $e;
{
local $@;
# this routine is simplified and not fully compatible with mro::get_linear_isa
# but for our use the order doesn't matter, so we don't need to care
eval <<'END_CODE' or $e = $@;
sub _linear_isa($;$) {
if (defined &mro::get_linear_isa) {
no warnings 'redefine', 'prototype';
*_linear_isa = \&mro::get_linear_isa;
goto &mro::get_linear_isa;
}
my @check = shift;
my @lin;
my %found;
while (defined(my $check = shift @check)) {
push @lin, $check;
no strict 'refs';
unshift @check, grep !$found{$_}++, @{"$check\::ISA"};
}
return \@lin;
}
1;
END_CODE
}
die $e if defined $e;
}
sub does_role {
my ($proto, $role) = @_;
foreach my $class (@{_linear_isa(ref($proto)||$proto)}) {
return 1 if exists $APPLIED_TO{$class}{$role};
}
return 0;
}
sub is_role {
my ($me, $role) = @_;
return !!($INFO{$role} && (
$INFO{$role}{is_role}
# these are for backward compatibility with older Moo that overrode some
# methods without calling the originals, thus not getting is_role set
|| $INFO{$role}{requires}
|| $INFO{$role}{not_methods}
|| $INFO{$role}{non_methods}
));
}
1;
__END__
=encoding utf-8
=head1 NAME
Role::Tiny - Roles: a nouvelle cuisine portion size slice of Moose
=head1 SYNOPSIS
package Some::Role;
use Role::Tiny;
sub foo { ... }
sub bar { ... }
around baz => sub { ... };
1;
elsewhere
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<Moo::Role>.
=head1 DESCRIPTION
C<Role::Tiny> 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. A method inherited by a class gets overridden by the role's
method of the same name, though.
=item *
If a method that the role L</requires> to be implemented is not implemented,
role application will fail loudly.
=back
Unlike L<Class::C3>, where the B<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.
=head2 ROLE METHODS
All subs created after importing Role::Tiny will be considered methods to be
composed. For example:
package MyRole;
use List::Util qw(min);
sub mysub { }
use Role::Tiny;
use List::Util qw(max);
sub mymethod { }
In this role, C<max> and C<mymethod> will be included when composing MyRole,
and C<min> and C<mysub> will not. For additional control, L<namespace::clean>
can be used to exclude undesired subs from roles.
=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<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.
=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<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 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<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 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<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<warnings> to the caller.
=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<DOES> method
for your class. However, if C<any> class in your class' inheritance
hierarchy provides C<DOES>, then Role::Tiny will not override it.
=head1 METHODS
=head2 make_role
Role::Tiny->make_role('Some::Role');
Makes a package into a role, but does not export any subs into it.
=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<Role::Tiny::With>.
=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. Note that the object's methods get overridden by the role's
ones with the same names.
=head2 create_class_with_roles
Role::Tiny->create_class_with_roles('Some::Base', qw(Some::Role1 Some::Role2));
Creates a new class based on base, with the roles composed into it in order.
New class is returned.
=head2 is_role
Role::Tiny->is_role('Some::Role1')
Returns true if the given package is a role.
=head1 CAVEATS
=over 4
=item * On perl 5.8.8 and earlier, applying a role to an object won't apply any
overloads from the role to other copies of the object.
=item * On perl 5.16 and earlier, applying a role to a class won't apply any
overloads from the role to any existing instances of the class.
=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>.
Ovid's L<Role::Basic> provides roles with a similar scope, but without method
modifiers, and having some extra usage restrictions.
=head1 AUTHOR
mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
=head1 CONTRIBUTORS
dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
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>
as listed above.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself.
=cut
lib/Role/Tiny/With.pm view on Meta::CPAN
package Role::Tiny::With;
use strict;
use warnings;
our $VERSION = '2.002004';
$VERSION =~ tr/_//d;
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<Role::Tiny> is a minimalist role composition tool. C<Role::Tiny::With>
provides a C<with> function to compose such roles.
=head1 AUTHORS
See L<Role::Tiny> for authors.
=head1 COPYRIGHT AND LICENSE
See L<Role::Tiny> for the copyright and license.
=cut
maint/Makefile.PL.include view on Meta::CPAN
BEGIN { -e 'Distar' or system qw(git clone https://github.com/p5sagit/Distar.git) }
use lib 'Distar/lib';
use Distar;
use ExtUtils::MakeMaker;
ExtUtils::MakeMaker->VERSION(6.68)
unless $ENV{CONTINUOUS_INTEGRATION};
author 'mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>';
manifest_include 'xt/dependents', '.patch';
1;
t/concrete-methods.t view on Meta::CPAN
use strict;
use warnings;
no warnings 'once';
use Test::More;
BEGIN {
package MyRole1;
our $before_scalar = 1;
sub before_sub {}
sub before_sub_blessed {}
sub before_stub;
sub before_stub_proto ($);
use constant before_constant => 1;
use constant before_constant_list => (4, 5);
use constant before_constant_glob => 1;
our $before_constant_glob = 1;
use constant before_constant_inflate => 1;
use constant before_constant_list_inflate => (4, 5);
use constant before_constant_deflate => 1;
# subs stored directly in the stash are meant to be supported in perl 5.22+,
# but until 5.26.1 they have a risk of segfaulting. perl itself won't ever
# install subs in exactly this form, so we're safe to just dodge the issue
# in the test and not account for it in Role::Tiny itself.
BEGIN {
if ("$]" >= 5.026001) {
$MyRole1::{'blorf'} = sub { 'blorf' };
}
}
use Role::Tiny;
no warnings 'once';
our $after_scalar = 1;
sub after_sub {}
sub after_sub_blessed {}
sub after_stub;
sub after_stub_proto ($);
use constant after_constant => 1;
use constant after_constant_list => (4, 5);
use constant after_constant_glob => 1;
our $after_constant_glob = 1;
use constant after_constant_inflate => (my $f = 1);
use constant after_constant_list_inflate => (4, 5);
for (
\&before_constant_inflate,
\&before_constant_list_inflate,
\&after_constant_inflate,
\&after_constant_list_inflate,
) {}
my $deflated = before_constant_deflate;
bless \&before_sub_blessed;
bless \&after_sub_blessed;
}
{
package MyClass1;
no warnings 'once';
our $GLOBAL1 = 1;
sub method {}
}
my @methods = qw(
after_sub
after_sub_blessed
after_stub
after_stub_proto
after_constant
after_constant_list
after_constant_glob
after_constant_inflate
after_constant_list_inflate
);
my $type = ref $MyRole1::{'blorf'};
my $role_methods = Role::Tiny->_concrete_methods_of('MyRole1');
is_deeply([sort keys %$role_methods], [sort @methods],
'only subs after Role::Tiny import are methods' );
# only created on 5.26, but types will still match
is ref $MyRole1::{'blorf'}, $type,
'_concrete_methods_of does not inflate subrefs in stash';
my @role_method_list = Role::Tiny->methods_provided_by('MyRole1');
is_deeply([sort @role_method_list], [sort @methods],
'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' );
eval { Role::Tiny->methods_provided_by('MyClass1') };
like $@,
qr/is not a Role::Tiny/,
'methods_provided_by refuses to work on classes';
{
package Look::Out::Here::Comes::A::Role;
use Role::Tiny;
sub its_a_method { 1 }
}
{
package And::Another::One;
sub its_a_method { 2 }
use Role::Tiny;
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_ };
with 'Look::Out::Here::Comes::A::Role';
::is join('', @warnings), '',
'non-methods not overwritten by role composition';
}
{
package RoleLikeOldMoo;
use Role::Tiny;
sub not_a_method { 1 }
# simulate what older versions of Moo do to mark non-methods
$Role::Tiny::INFO{+__PACKAGE__}{not_methods}{$_} = $_
for \¬_a_method;
}
is_deeply [Role::Tiny->methods_provided_by('RoleLikeOldMoo')], [],
'subs marked in not_methods (like old Moo) are excluded from method list';
done_testing;
t/create-hook.t view on Meta::CPAN
use strict;
use warnings;
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;
use strict;
use warnings;
use Test::More;
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)");
}
done_testing;
t/extend-role-tiny.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
BEGIN {
package My::Role::Tiny::Extension;
$INC{'My/Role/Tiny/Extension.pm'} = __FILE__;
use Role::Tiny ();
our @ISA = qw(Role::Tiny);
my %lie;
sub _install_subs {
my $me = shift;
my ($role) = @_;
local $lie{$role} = 1;
$me->SUPER::_install_subs(@_);
}
sub is_role {
my ($me, $role) = @_;
return 0
if $lie{$role};
$me->SUPER::is_role($role);
}
}
my @warnings;
BEGIN {
package My::Thing::Using::Extended::Role;
My::Role::Tiny::Extension->import;
local $SIG{__WARN__} = sub { push @warnings, @_ };
My::Role::Tiny::Extension->import;
}
my $methods = My::Role::Tiny::Extension->_concrete_methods_of('My::Thing::Using::Extended::Role');
is join(', ', sort keys %$methods), '',
'subs installed when creating a role are not methods';
# there will be warnings but we don't care about them
done_testing;
use strict;
use warnings;
use Test::More;
my %apply_steps;
BEGIN {
package MyRoleTinyExtension;
use Role::Tiny ();
our @ISA = qw(Role::Tiny);
sub role_application_steps {
my $self = shift;
return (
'role_apply_before',
$self->SUPER::role_application_steps(@_),
'Fully::Qualified::role_apply_after',
);
};
sub role_apply_before {
my ($self, $to, $role) = @_;
::ok !Role::Tiny::does_role($to, $role),
"$role not applied to $to yet";
$apply_steps{$to}{$role}{before}++;
}
sub Fully::Qualified::role_apply_after {
my ($self, $to, $role) = @_;
::ok +Role::Tiny::does_role($to, $role),
"$role applied to $to";
$apply_steps{$to}{$role}{after}++;
}
}
{
package ExtendedRole;
MyRoleTinyExtension->import;
sub added_sub {}
}
{
package ApplyTo;
MyRoleTinyExtension->apply_role_to_package(__PACKAGE__, 'ExtendedRole');
}
is $apply_steps{'ApplyTo'}{'ExtendedRole'}{before}, 1,
'before step was run';
is $apply_steps{'ApplyTo'}{'ExtendedRole'}{after}, 1,
'after step was run';
done_testing;
t/lib/BrokenModule.pm view on Meta::CPAN
package BrokenModule;
use strict;
use warnings;
my $f = blorp;
1;
t/lib/ExistingModule.pm view on Meta::CPAN
package ExistingModule;
our $LOADED;
$LOADED++;
1;
t/lib/FalseModule.pm view on Meta::CPAN
package FalseModule;
0;
t/lib/TrueModule.pm view on Meta::CPAN
package TrueModule;
our $LOADED;
$LOADED++;
1;
t/load-module.t view on Meta::CPAN
use strict;
use warnings;
no warnings 'once';
use Test::More;
use Role::Tiny ();
use lib 't/lib';
Role::Tiny::_load_module('TrueModule');
is do {
no strict 'refs';
${"TrueModule::LOADED"}
}, 1, 'normal module loaded properly';
{
package ExistingModule;
our $LOADED = 0;
}
Role::Tiny::_load_module('ExistingModule');
is do {
no strict 'refs';
${"ExistingModule::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;
t/make-role.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use Role::Tiny ();
Role::Tiny->make_role('Foo');
{
no warnings 'once';
*Foo::foo = sub {42};
}
ok( Role::Tiny->is_role('Foo'), 'Foo is_role');
for my $m (qw(requires with before around after)) {
ok( !Foo->can($m), "Foo cannot '$m'" );
}
Role::Tiny->apply_roles_to_package('FooFoo', 'Foo');
can_ok 'FooFoo', 'foo';
done_testing;
t/method-conflicts.t view on Meta::CPAN
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 };
}
ok(
!eval {
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',
);
ok(
eval {
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;
t/namespace-clean.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use B ();
sub is_method {
my ($ns, $sub) = @_;
no strict 'refs';
my $cv = B::svref_2object(\&{"${ns}::${sub}"});
return
if !$cv->isa('B::CV');
my $gv = $cv->GV;
return
if $gv->isa('B::SPECIAL');
my $pack = $gv->STASH->NAME
or return;
return (
$pack eq $ns
|| ($pack eq 'constant' && $gv->name eq '__ANON__')
);
}
BEGIN {
package Local::Role;
use Role::Tiny;
sub foo { 1 };
}
BEGIN {
package Local::Class;
use Role::Tiny::With;
with qw( Local::Role );
BEGIN {
# poor man's namespace::autoclean
no strict 'refs';
my @subs = grep defined &$_, keys %Local::Class::;
my @imports = grep !::is_method(__PACKAGE__, $_), @subs;
delete @Local::Class::{@imports};
}
}
ok !defined &Local::Class::with, 'imports are cleaned';
can_ok 'Local::Class', 'foo';
can_ok 'Local::Class', 'does';
BEGIN {
package Local::Role2;
use Role::Tiny;
# poor man's namespace::clean
my @subs;
BEGIN {
no strict 'refs';
@subs = grep defined &$_, keys %Local::Role2::
}
delete @Local::Role2::{@subs};
sub foo { 1 };
}
BEGIN {
package Local::Role2;
use Role::Tiny;
}
# this may not be ideal, but we'll test it since it is done explicitly
ok !defined &Local::Role2::with, 'subs are not re-exported';
done_testing;
t/overload.t view on Meta::CPAN
use strict;
use warnings;
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 $orig = MyClass3->new;
my $copy = $orig;
Role::Tiny->apply_roles_to_object($orig, 'MyRole');
for my $o ($orig, $copy) {
my $copied = \$o == \$copy ? ' copy' : '';
local $TODO = 'magic not applied to all ref copies on perl < 5.8.9'
if $copied && "$]" < 5.008009;
is "$o", 'welp', 'subref overload applied to instance'.$copied;
is sprintf('%d', $o), 219, 'method name overload applied to instance'.$copied;
ok !$o, 'anon subref overload applied to instance'.$copied;
}
}
{
my $o = MyClass3->new;
Role::Tiny->apply_roles_to_package('MyClass3', 'MyRole');
local $TODO = 'magic not applied to existing objects on perl < 5.18'
if "$]" < 5.018;
is "$o", 'welp', 'subref overload applied to class with instance';
is sprintf('%d', $o), 219, 'method name overload applied to class with instance';
ok !$o, 'anon subref overload applied to class with instance';
}
done_testing;
use strict;
use warnings;
use Test::More;
my $invalid_prototypes;
BEGIN {
package TestExporter1;
$INC{"TestExporter1.pm"} = 1;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(guff welp farb tube truck);
sub guff { rand(1) }
sub welp () { rand(1) }
sub farb ($) { rand(1) }
no warnings;
eval q{
sub tube (plaf) { rand(1) }
sub truck (-1) { rand(1) }
1;
} and $invalid_prototypes = 1;
}
BEGIN {
package TestRole1;
use Role::Tiny;
use TestExporter1;
}
BEGIN {
package SomeClass;
use Role::Tiny::With;
use TestExporter1;
with 'TestRole1';
eval { guff };
::is $@, '',
'composing matching function with no prototype works';
eval { welp };
::is $@, '',
'composing matching function with empty prototype works';
eval { farb 1 };
::is $@, '',
'composing matching function with ($) prototype works';
if ($invalid_prototypes) {
eval { &tube };
::is $@, '',
'composing matching function with invalid prototype works';
eval { &truck };
::is $@, '',
'composing matching function with invalid -1 prototype works';
}
}
done_testing;
t/role-basic-basic.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
BEGIN {
package My::Does::Basic;
$INC{'My/Does/Basic.pm'} = 1;
use Role::Tiny;
requires 'turbo_charger';
sub no_conflict {
return "My::Does::Basic::no_conflict";
}
}
BEGIN {
package My::Example;
$INC{'My/Example.pm'} = 1;
use Role::Tiny 'with';
with 'My::Does::Basic';
sub new { bless {} => shift }
sub turbo_charger {}
$My::Example::foo = 1;
sub foo() {}
}
use 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';
done_testing;
t/role-basic-bugs.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
# 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';
eval {
with 'RoleA', 'RoleB';
1;
} or $@ ||= 'unknown error';
::is $@, '',
'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';
}
{
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');
}
BEGIN {
package Bar;
$INC{'Bar.pm'} = __FILE__;
sub new { bless {} => shift }
sub bar { 1 }
}
BEGIN {
package Baz;
$INC{'Baz.pm'} = __FILE__;
use Role::Tiny;
sub baz { 1 }
}
can_ok(Role::Tiny->create_class_with_roles(qw(Bar Baz))->new, qw(bar baz));
done_testing;
t/role-basic-composition.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
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 GenAccessors;
BEGIN { $INC{'GenAccessors.pm'} = __FILE__ }
sub import {
my ( $class, @methods ) = @_;
my $target = caller;
foreach my $method (@methods) {
no strict 'refs';
*{"${target}::${method}"} = sub {
@_ > 1 ? $_[0]->{$method} = $_[1] : $_[0]->{$method};
};
}
}
}
{
{
package Role::Which::Imports;
use Role::Tiny;
use GenAccessors 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';
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: $@";
}
{
{
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';
$success = eval q{
package My::Class::Child2;
use base 'My::Class::Base';
use Role::Tiny::With;
with qw/My::Does::Basic1/;
1;
};
is $success, 1, 'role composed after conflict resolution' or diag "Error: $@";
can_ok 'My::Class::Child2', 'method';
is My::Class::Child2->method, 'My::Does::Basic1 method', 'role method applied';
}
done_testing;
t/role-basic-exceptions.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
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;
t/role-duplication.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
BEGIN {
package Role1; use Role::Tiny;
sub foo1 { 1 }
}
BEGIN {
package Role2; use Role::Tiny;
sub foo2 { 2 }
}
BEGIN {
package BaseClass;
sub foo { 0 }
}
eval {
Role::Tiny->create_class_with_roles(
'BaseClass',
qw(Role2 Role1 Role1 Role2 Role2),
);
};
like $@, qr/\ADuplicated roles: Role1, Role2 /,
'duplicate roles detected';
BEGIN {
package AnotherRole;
use Role::Tiny;
with 'Role1';
}
BEGIN {
package AnotherClass;
use Role::Tiny::With;
with 'AnotherRole';
delete $AnotherClass::{foo1};
with 'AnotherRole';
}
ok +AnotherClass->can('foo1'),
'reapplying roles re-adds missing methods';
done_testing;
( run in 2.079 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )