Moo-2.000002/000755 000765 000024 00000000000 12554434147 012761 5ustar00gknopstaff000000 000000 Moo-2.000002/Changes000644 000765 000024 00000047436 12554434127 014270 0ustar00gknopstaff000000 000000 Revision history for Moo 2.000002 - 2015-07-24 - BUILDARGS will now always be called on object creation, even if no attributes exist - fix required attributes with spaces or other odd characters in init_arg - fix (is => 'lazy', required => 1, init_arg => undef), which previously didn't think it provided a builder - under 'no Moo::sification', prevent automatic Moose metaclass inflation from ->meta calls - don't load Moo::Role for a ->does check if no roles could exist - make global destruction test more robust from outside interference - fix false default values satisfying required attributes - Fix Moose attribute delegation to a Moo class via a wildcard - work around case where Sub::Util is loadable but doesn't provide Sub::Util::set_subname - skip thread tests on perl 5.8.4 and below where threads are extremely unreliable - Allow stub methods (e.g. sub foo;) to be overwritten by accessors or other generated methods. (RT#103804) 2.000001 - 2015-03-16 - Fix how we pick between Sub::Name and Sub::Util if they are both loaded. This fixes how we interact with Moose in some cases. (RT#102729) (GH#15) 2.000000 - 2015-03-02 * Incompatible Changes - Fatal warnings and the other additional checks from the strictures module will no longer be applied to modules using Moo or Moo::Role. We now only apply strict and (non-fatal) warnings, matching the behavior of Moose. - Classes without attributes used to store everything passed to ->new in the object. This has been fixed to not store anything in the object, making it consistent with classes that had attributes. - Moo will now pass __no_BUILD__ to parent constructors when inheriting from a Moose or Class::Tiny class, to prevent them from calling BUILD functions. Moo calls the BUILD functions itself, which previously led to them being called multiple times. - Attempting to replace an existing constructor, or modify one that has been used, will throw an error. This includes adding attributes. Previously, this would result in some attributes being silently ignored by the constructor. - If a class's @ISA is modified without using 'extends' in a way that affects object construction, Moo will detect this and throw an error. This can happen in code that uses ->load_components from Class::C3::Componentised, which is common in DBIx::Class modules. * Bug Fixes - Fix calling class methods on Moo::HandleMoose::FakeMetaClass, such as modules scanning all classes * Miscellaneous - use Sub::Util instead of Sub::Name if available 1.007000 - 2015-01-21 - fix Moose metaclass inflation of Method::Generate::Constructor (RT#101111) - clarify behavior of clearers for non-lazy attribute defaults - add Sub::Defer::undefer_package to undefer all subs from a given package - existing attributes will no longer be overwritten when composing roles. Previously, the attribute configuration used by the constructor would be overridden, but the attribute methods would not be. This caused a mismatch in attribute behavior. - link to Type::Tiny in docs rather than MooX::Types::MooseLike - document exports of Sub::Defer - fix capture_unroll usage in inlinify example - fix needless re-assigning of variables in generated Sub::Quote subs - fix global destruction test to work when perl path has spaces 1.006001 - 2014-10-22 - Name the ->DOES method installed by Role::Tiny - don't apply threading workarounds on non-threaded perls, even if module for it is loaded by something - avoid loading base.pm and just set @ISA manually - fix some Pod links to Class::Method::Modifiers - fix applying roles with multiple attributes with defaults to objects (RT#99217) - fix Moose inheriting from a Moo class that inherits from a non-M* class when the Moose class is not made immutable - fix ->does method on Moose child classes of Moo classes 1.006000 - 2014-08-16 - support coerce => 1 in attributes, taking the coercion from the isa option if it is an object that supports the coerce or coercion method. - add attribute information to type check errors by trapping with an eval rather than overriding the global __DIE__ handler - bump Module::Runtime prerequisite to fix error messages when there is a missing module used by a role loaded using 'with' or similar (rt#97669) 1.005000 - 2014-06-10 - add qsub to Sub::Quote as a prototyped alternative to quote_sub, accepting only the sub body - avoid testing UTF-8 on perl 5.6 1.004006 - 2014-05-27 - fix quotify for characters in the \x80-\xFF range when used under the utf8 pragma. Also fixes some cases of constructor generation with the pragma. 1.004005 - 2014-05-23 - releasing 1.004_004 as stable 1.004_004 - 2014-05-12 - stop internally depending on Moo::Object::new including all inputs in constructed object - be more careful when munging code for inlining - fix maintaining source of quoted sub for lifetime of sub - redo foreign C3 compatibility, fixing constructors without changing behavior for Moo constructors - don't build Moose metaclass when checking Moo classes with ->is_role - include Sub::Name in recommendations metadata 1.004_003 - 2014-04-13 - always maintain source of quoted subs for the lifetime of the sub - fix Sub::Quote and Sub::Defer leaking memory - Class::XSAccessor is now listed as a recommended prerequisite - fix generating a subclass with roles when using a non-standard accessor - use alternate quoting routine, which is faster and saves memory by not loading B.pm - fix default of undef - fix inheriting from a class with a prototype on new - use ->is_role internally to check if a package is a role - minimise Role::Tiny coupling outside Moo::Role - fix calling parent constructor when C3 multiple inheritance is in use (such as when combining with DBIx::Class) - return true from Moo::Role->is_role for all loaded Moose roles - improved test coverage - fix strictures author test when PERL_STRICTURES_EXTRA is set - remove Dist::CheckConflicts prerequisite and replace with a test to report known broken downstream modules - fix x_breaks metadata 1.004002 - 2013-12-31 - fix type inflation in threads when types are inserted by manually stringifying the type first (like Type::Tiny) - add undefer_all to Sub::Defer 1.004001 - 2013-12-27 - fix repository links in pod - add missing changelog entry regarding strictures to 1.004000 release 1.004000 - 2013-12-26 - strictures will now be applied to modules using Moo just as if they included "use strictures" directly. This means that strictures extra checks will now apply to code in checkouts. - fix handling of type inflation when used with threads - don't include meta method when consuming Mouse roles - inhale Moose roles for has attr => ( handles => "RoleName" ) - provide useful error if attribute defined as required but with init_arg => undef - document that BUILDARGS isn't called when there are no attributes - omit sub imported before use Moo from Moose method inflation - check for FOREIGNBUILDARGS only once per class instead of on each instantiation - take advantage of XS predicates from newer versions of Class::XSAccessor - always try to load superclasses and roles, and only fall back on the heuristic of checking for subs if the file doesn't exist - fix handling of attributes with names that aren't valid identifiers - Quoted subs now preserve the package and pragmas from their calling code - the official Moo git repository has moved to the Moose organization on GitHub: https://github.com/moose/Moo 1.003001 - 2013-09-10 - abbreviate class names from created by create_class_with_roles if they are too long for perl to handle (RT#83248) - prevent destructors from failing in global destruction for certain combinations of Moo and Moose classes subclassing each other (RT#87810) - clarify in docs that Sub::Quote's captured variables are copies, not aliases - fix infinite recursion if an isa check fails due to another isa check (RT#87575) - fix Sub::Quote and Sub::Defer under threads (RT#87043) - better diagnostics when bad parameters given to has 1.003000 - 2013-07-15 - fix composing roles that require methods provided by the other (RT#82711) - document optional use of Class::XSAccessor with caveats - fix constructor generated when creating a class with create_class_with_roles when the superclass constructor hasn't been generated yet - fix extending the constructor generator using Moo classes/roles - non-lazy attribute defaults are used when applying a role to an object - updated META files to list prerequisites in proper phases - $Method::Generate::Accessor::CurrentAttribute hashref contains information about attribute currently being processed (available to exception objects thrown by "isa" and "coerce") - properly die when composing a module that isn't a Role - fix passing attribute parameters for traits when inflating to Moose - fix inflating method modifiers applied to multiple methods - fix documentation for Sub::Quote::capture_unroll - add documentation noting Sub::Quote's use of strictures - fix FOREIGNBUILDARGS not being called if no attributes created 1.002000 - 2013-05-04 - add 'moosify' attribute key to provide code for inflating to Moose - fix warnings about unknown attribute parameters on metaclass inflation - don't pass 'handles' down when doing 'has +' to avoid unDWIMmy explosions - throw a useful exception when typemap doesn't return a value - avoid localising @_ when not required for Sub::Quote - successfully inflate a metaclass for attributeless classes (RT#86415) - fix false default values used with non-lazy accessors - stop built values that fail isa checks still getting stored in the object - stop lazy+weak_ref accessors re-building their value on every call - make lazy+weak_ref accessors return undef if built value isn't already stored elsewhere (Moose compatibility) - stop isa checks being called on every access for lazy attributes - bump Devel::GlobalDestruction dependency to fix warning on cleanup when run under -c (RT#78617) - document Moose type constraint creation for roles and classes (actually fixed in 1.001000) 1.001000 - 2013-03-16 - add support for FOREIGNBUILDARGS when inheriting from non-Moo classes - non-ref default values are allowed without using a sub - has will refuse to overwrite locally defined subs with generated accessors. - added more meta resources and added more support relevant links into the POD documentation - clarify in docs that default and built values won't call triggers (RT#82310) - expand is => 'lazy' doc to make it clear that you can make rw lazy attributes if you really want to - handles => "RoleName" tries to load the module - fix delegation to false/undef attributes (RT#83361) 1.000008 - 2013-02-06 - Re-export on 'use Moo' after 'no Moo' - Export meta() into roles (but mark as non-method to avoid composing it) - Don't generate an accessor for rw attributes if reader+writer both set - Support builder => sub {} ala MooseX::AttributeShortcuts - Fix 'no Moo;' to preserve non-sub package variables - Switch to testing for Mouse::Util->can('find_meta') to avoid exploding on ancient Mouse installs - Fix loading order bug that results in _install_coderef being treated as indirect object notation 1.000007 - 2012-12-15 - Correctly handle methods dragged along by role composition - Die if Moo and Moo::Role are imported into the same package 1.000006 - 2012-11-16 - Don't use $_ as loop variable when calling arbitrary code (RT#81072) - Bump Role::Tiny prereq to fix method modifier breakage on 5.10.0 1.000005 - 2012-10-23 - fix POD typo (RT#80060) - include init_arg name in constructor errors (RT#79596) - bump Class::Method::Modifiers dependency to avoid warnings on 5.8 1.000004 - 2012-10-03 - allow 'has \@attributes' like Moose does 1.000003 - 2012-08-09 - make setter for weak_ref attributes return the value 1.000002 - 2012-08-04 - remove Devel::GlobalDestruction fallback inlining because we can now depend on 0.08 which uses Sub::Exporter::Progressive - honour BUILDARGS when calling $meta->new_object on behalf of Moose - throw an error on invalid builder (RT#78479) - fix stupid typo in new Sub::Quote section 1.000001 - 2012-07-21 - documentation tweaks and cleanup - ignore required when default or builder is present - document Moo versus Any::Moose in brief with article link - remove quote_sub from SYNOPSIS and has docs, expand Sub::Quote section - localize @_ when inlining quote_sub'ed isa checks (fixes lazy+isa+default) - ensure constructor gets regenerated if forced early by metaclass inflation 1.000000 - 2012-07-18 - clean up doc language and expand on Moo and Moose - error prefixes for isa and coerce exceptions - unmark Moo and Moose as experimental since it's relatively solid now - convert isa and coerce info from external role attributes - clear method cache after metaclass generation to fix autoclean bug 0.091014 - 2012-07-16 - load overload.pm explicitly for overload::StrVal 0.091013 - 2012-07-15 - useful and detailed errors for coerce in attrib generation 0.091012 - 2012-07-15 - useful and detailed errors for default checker in attrib generation - throw an error when trying to extend a role 0.091011 - 2012-06-27 - re-add #web-simple as development IRC - don't assume Scalar::Util is imported into the current package 0.091010 - 2012-06-26 - isa checks on builders - additional quote_sub docs - remove multi-populate code to fix exists/defined new() bug - document move to #moose and include repository metadata - no Moo and no Moo::Role - squelch used only once warnings for $Moo::HandleMoose::MOUSE - MooClass->meta - subconstructor handling for Moose classes 0.091009 - 2012-06-20 - squelch redefine warnings in the coderef installation code 0.091008 - 2012-06-19 - bump Role::Tiny dependency to get working modifiers under composition - handle "has '+foo'" for attrs from superclass or consumed role - document override -> around translation - use D::GD if installed rather than re-adding it as a requirement 0.091007 - 2012-05-17 - remove stray reference to Devel::GlobalDestruction 0.091006 - 2012-05-16 - drop a couple of dependencies by minor releases we don't strictly need 0.091005 - 2012-05-14 - temporary switch to an inlined in_global_destruction to avoid needing to fatpack Sub::Exporter for features we don't use - re-order is documentation to give readonly styles more prominence - a weakened value should still be returned on set (fixes lazy + weak_ref) - add an explicit return to all exported subs so people don't accidentally rely on the return value 0.091004 - 2012-05-07 - also inhale from Mouse - clarify how isa and coerce interact - support isa and coerce together for Moose - guard _accessor_maker_for calls in Moo::Role in case Moo isn't loaded - reset handlemoose state on mutation in case somebody reified the metaclass too early 0.091003 - 2012-05-06 - improve attribute option documentation - update the incompatibilities section since we're less incompatible now - fix coderef naming to avoid confusing autoclean 0.091002 - 2012-05-05 - exclude union roles and same-role-as-self from metaclass inflation - inhale Moose roles before checking for composition conflicts - enable Moo::sification if only Moo::Role is loaded and not Moo - preserve attribute ordering - factor out accessor generation code a bit more to enable extension 0.091001 - 2012-05-02 - bump Role::Tiny dependency to require de-strictures-ed version - fix test failure where Class::XSAccessor is not available 0.091000 - 2012-04-27 - document MX::AttributeShortcuts 009+ support - documentation for the metaclass inflation code - better error message for broken BUILDARGS - provide 'no Moo::sification' to forcibly disable metaclass inflation - switch to Devel::GlobalDestruction to correctly disarm the Moo::sification trigger under threads - make extends after has work - name subs if Sub::Name is available for better stracktraces - undefer all subs before creating a concrete Moose metaclass - fix bug in _load_module where global vars could cause mis-detection of the module already being loaded 0.009_017 - 2012-04-16 - mangle constructor meta-method on inflation so make_immutable works - fix possible infinite loop caused by subconstructor code 0.009_016 - 2012-04-12 - don't accidentally load Moo::HandleMoose during global destruction - better docs for trigger (and initializer's absence) 0.009_015 - 2012-04-11 - Complete support for MooseX::AttributeShortcuts 0.009 - Allow Moo classes to compose Moose roles - Introduce Moo::HandleMoose, which should allow Moo classes and roles to be treated as Moose classes/roles. Supported so far: - Some level of attributes and methods for both classes and roles - Required methods in roles - Method modifiers in roles (they're already applied in classes) - Type constraints 0.009014 - 2012-03-29 - Split Role::Tiny out into its own dist - 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 Moo-2.000002/lib/000755 000765 000024 00000000000 12554434146 013526 5ustar00gknopstaff000000 000000 Moo-2.000002/maint/000755 000765 000024 00000000000 12554434146 014070 5ustar00gknopstaff000000 000000 Moo-2.000002/Makefile.PL000644 000765 000024 00000010374 12554014037 014730 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.006; my %META = ( name => 'Moo', license => 'perl_5', prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, } }, build => { requires => { } }, test => { requires => { 'Test::More' => 0.94, 'Test::Fatal' => 0.003, }, recommends => { 'CPAN::Meta' => 0, 'CPAN::Meta::Requirements' => 0, }, }, runtime => { requires => { 'Class::Method::Modifiers' => 1.10, # for RT#80194 'Module::Runtime' => 0.014, # for RT#86394 'Role::Tiny' => 2, 'Devel::GlobalDestruction' => 0.11, # for RT#78617 'Scalar::Util' => 0, 'perl' => 5.006, 'Exporter' => 5.57, # Import 'import' }, recommends => { 'Class::XSAccessor' => 1.18, 'Sub::Name' => 0, 'strictures' => 2, }, }, develop => { requires => { 'strictures' => 2, 'indirect' => 0, 'multidimensional' => 0, 'bareword::filehandles' => 0, 'Moose' => 0, 'Mouse' => 0, 'namespace::clean' => 0, 'namespace::autoclean' => 0, 'MooseX::Types::Common::Numeric' => 0, 'Type::Tiny' => 0, 'Class::Tiny' => 1.001, }, }, }, resources => { repository => { url => 'https://github.com/moose/Moo.git', web => 'https://github.com/moose/Moo', type => 'git', }, x_IRC => 'irc://irc.perl.org/#moose', bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Moo', mailto => 'bug-Moo@rt.cpan.org', }, license => [ 'http://dev.perl.org/licenses/' ], }, no_index => { directory => [ 't', 'xt' ] }, x_breaks => { 'HTML::Restrict' => '== 2.1.5', 'MySQL::Workbench::Parser' => '<= 0.05', 'MooX::Emulate::Class::Accessor::Fast' => '<= 0.02', 'WebService::Shutterstock' => '<= 0.006', 'File::DataClass' => '<= 0.54.1', 'App::Commando' => '<= 0.012', }, x_authority => 'cpan:MSTROUT', ); my %MM_ARGS = ( PREREQ_PM => { ($] >= 5.008 ? () : ('Task::Weaken' => 0)), ($] >= 5.010 ? () : ('MRO::Compat' => 0)), }, ); { package MY; !-f 'META.yml' and $^O ne 'MSWin32' and eval q{ sub test_via_harness { my($self, $perl, $tests) = @_; return $self->SUPER::test_via_harness("MOO_FATAL_WARNINGS=1 $perl", $tests); } }; sub postamble { <<"POSTAMBLE"; fulltest: test \tMOO_XS_DISABLE=1 \$(MAKE) test POSTAMBLE } } ## 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 ########################################################### Moo-2.000002/MANIFEST000644 000765 000024 00000007146 12554434147 014122 0ustar00gknopstaff000000 000000 Changes lib/Method/Generate/Accessor.pm lib/Method/Generate/BuildAll.pm lib/Method/Generate/Constructor.pm lib/Method/Generate/DemolishAll.pm lib/Method/Inliner.pm lib/Moo.pm lib/Moo/_mro.pm lib/Moo/_strictures.pm lib/Moo/_Utils.pm lib/Moo/HandleMoose.pm lib/Moo/HandleMoose/_TypeMap.pm lib/Moo/HandleMoose/FakeMetaClass.pm lib/Moo/Object.pm lib/Moo/Role.pm lib/Moo/sification.pm lib/oo.pm lib/Sub/Defer.pm lib/Sub/Quote.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/accessor-coerce.t t/accessor-default.t t/accessor-generator-extension.t t/accessor-handles.t t/accessor-isa.t t/accessor-mixed.t t/accessor-pred-clear.t t/accessor-reader-writer.t t/accessor-roles.t t/accessor-shortcuts.t t/accessor-trigger.t t/accessor-weaken-pre-5_8_3.t t/accessor-weaken.t t/buildall-subconstructor.t t/buildall.t t/buildargs-error.t t/buildargs.t t/coerce-1.t t/compose-conflicts.t t/compose-non-role.t t/compose-roles.t t/constructor-modify.t t/demolish-basics.t t/demolish-bugs-eats_exceptions.t t/demolish-bugs-eats_mini.t t/demolish-global_destruction.t t/demolish-throw.t t/does.t t/extend-constructor.t t/extends-non-moo.t t/extends-role.t t/foreignbuildargs.t t/global_underscore.t t/has-array.t t/has-before-extends.t t/has-plus.t t/init-arg.t t/isa-interfere.t t/lazy_isa.t t/lib/base_class.pm t/lib/ClassicObject.pm t/lib/ClobberUnderscore.pm t/lib/ComplexWriter.pm t/lib/ExtRobot.pm t/lib/INCModule.pm t/lib/MooObjectWithDelegate.pm t/lib/sub_class.pm t/lib/UnderscoreClass.pm t/lib/UnderscoreRole.pm t/load_module.t t/load_module_error.t t/load_module_role_tiny.t t/method-generate-accessor.t t/method-generate-constructor.t t/modify_lazy_handlers.t t/moo-accessors.t t/moo-c3.t t/moo-object.t t/moo-utils-_name_coderef.t t/moo-utils.t t/moo.t t/mutual-requires.t t/no-build.t t/no-moo.t t/non-moo-extends-c3.t t/non-moo-extends.t t/not-both.t t/overloaded-coderefs.t t/strictures.t t/sub-and-handles.t t/sub-defer-threads.t t/sub-defer.t t/sub-quote-threads.t t/sub-quote.t t/subconstructor.t t/undef-bug.t t/use-after-no.t t/zzz-check-breaks.t xt/class-tiny.t xt/fakemetaclass.t xt/global-destruct-jenga-helper.pl xt/global-destruct-jenga.t xt/handle_moose.t xt/implicit-moose-types.t xt/inflate-our-classes.t xt/jenga.t xt/lib/ExampleMooRole.pm xt/lib/ExampleMooRoleWithAttribute.pm xt/lib/ExampleMooseRoleOne.pm xt/lib/ExampleMooseRoleTwo.pm xt/lib/withautoclean/Class.pm xt/lib/withautoclean/R1.pm xt/moo-attr-handles-moose-role.t xt/moo-consume-moose-role-coerce.t xt/moo-consume-moose-role-multiple.t xt/moo-consume-mouse-role-coerce.t xt/moo-does-moose-role.t xt/moo-inflate.t xt/moo-object-meta-can.t xt/moo-role-types.t xt/moo-roles-into-moose-class-attr-override-with-autoclean.t xt/moo-roles-into-moose-class.t xt/moo-sification-handlemoose.t xt/moo-sification-meta.t xt/moo-sification.t xt/moose-accessor-isa.t xt/moose-autoclean-lazy-attr-builders.t xt/moose-consume-moo-role-after-consumed-by-moo.t xt/moose-consume-moo-role-no-moo-loaded.t xt/moose-does-moo-role.t xt/moose-extend-moo.t xt/moose-handles-moo-class.t xt/moose-inflate-error-recurse.t xt/moose-lazy.t xt/moose-method-modifiers.t xt/moose-override-attribute-from-moo-role.t xt/moose-override-attribute-with-plus-syntax.t xt/more-jenga.t xt/role-tiny-inflate.t xt/super-jenga.t xt/test-my-dependents.t xt/type-inflate-coercion.t xt/type-inflate-threads.t xt/type-inflate-type-tiny.t xt/type-inflate.t xt/type-tiny-coerce.t xt/withautoclean.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) Moo-2.000002/META.json000644 000765 000024 00000005245 12554434147 014410 0ustar00gknopstaff000000 000000 { "abstract" : "Minimalist Object Orientation (with Moose compatibility)", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Moo", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Class::Tiny" : "1.001", "Moose" : "0", "MooseX::Types::Common::Numeric" : "0", "Mouse" : "0", "Type::Tiny" : "0", "bareword::filehandles" : "0", "indirect" : "0", "multidimensional" : "0", "namespace::autoclean" : "0", "namespace::clean" : "0", "strictures" : "2" } }, "runtime" : { "recommends" : { "Class::XSAccessor" : "1.18", "Sub::Name" : "0", "strictures" : "2" }, "requires" : { "Class::Method::Modifiers" : "1.1", "Devel::GlobalDestruction" : "0.11", "Exporter" : "5.57", "Module::Runtime" : "0.014", "Role::Tiny" : "2", "Scalar::Util" : "0", "perl" : "5.006" } }, "test" : { "recommends" : { "CPAN::Meta" : "0", "CPAN::Meta::Requirements" : "0" }, "requires" : { "Test::Fatal" : "0.003", "Test::More" : "0.94" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Moo@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Moo" }, "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/moose/Moo.git", "web" : "https://github.com/moose/Moo" }, "x_IRC" : "irc://irc.perl.org/#moose" }, "version" : "2.000002", "x_authority" : "cpan:MSTROUT", "x_breaks" : { "App::Commando" : "<= 0.012", "File::DataClass" : "<= 0.54.1", "HTML::Restrict" : "== 2.1.5", "MooX::Emulate::Class::Accessor::Fast" : "<= 0.02", "MySQL::Workbench::Parser" : "<= 0.05", "WebService::Shutterstock" : "<= 0.006" } } Moo-2.000002/META.yml000644 000765 000024 00000002330 12554434146 014227 0ustar00gknopstaff000000 000000 --- abstract: 'Minimalist Object Orientation (with Moose compatibility)' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::Fatal: '0.003' Test::More: '0.94' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Moo no_index: directory: - t - xt recommends: Class::XSAccessor: '1.18' Sub::Name: '0' strictures: '2' requires: Class::Method::Modifiers: '1.1' Devel::GlobalDestruction: '0.11' Exporter: '5.57' Module::Runtime: '0.014' Role::Tiny: '2' Scalar::Util: '0' perl: '5.006' resources: IRC: irc://irc.perl.org/#moose bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Moo license: http://dev.perl.org/licenses/ repository: https://github.com/moose/Moo.git version: '2.000002' x_authority: cpan:MSTROUT x_breaks: App::Commando: '<= 0.012' File::DataClass: '<= 0.54.1' HTML::Restrict: '== 2.1.5' MooX::Emulate::Class::Accessor::Fast: '<= 0.02' MySQL::Workbench::Parser: '<= 0.05' WebService::Shutterstock: '<= 0.006' Moo-2.000002/README000644 000765 000024 00000060570 12554434147 013651 0ustar00gknopstaff000000 000000 NAME Moo - Minimalist Object Orientation (with Moose compatibility) SYNOPSIS package Cat::Food; use Moo; use strictures 2; use namespace::clean; sub feed_lion { my $self = shift; my $amount = shift || 1; $self->pounds( $self->pounds - $amount ); } has taste => ( is => 'ro', ); has brand => ( is => 'ro', isa => sub { die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ' }, ); has pounds => ( is => 'rw', isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 }, ); 1; And elsewhere: my $full = Cat::Food->new( taste => 'DELICIOUS.', brand => 'SWEET-TREATZ', pounds => 10, ); $full->feed_lion; say $full->pounds; DESCRIPTION "Moo" is an extremely light-weight Object Orientation system. It allows one to concisely define objects and roles with a convenient syntax that avoids the details of Perl's object system. "Moo" contains a subset of Moose and is optimised for rapid startup. "Moo" avoids depending on any XS modules to allow for simple deployments. The name "Moo" is based on the idea that it provides almost -- but not quite -- two thirds of Moose. Unlike Mouse this module does not aim at full compatibility with Moose's surface syntax, preferring instead to provide full interoperability via the metaclass inflation capabilities described in "MOO AND MOOSE". For a full list of the minor differences between Moose and Moo's surface syntax, see "INCOMPATIBILITIES WITH MOOSE". WHY MOO EXISTS If you want a full object system with a rich Metaprotocol, Moose is already wonderful. But if you don't want to use Moose, you may not want "less metaprotocol" like Mouse offers, but you probalby want "no metaprotocol", which is what Moo provides. "Moo" is ideal for some situations where deployment or startup time precludes using Moose and Mouse: a command line or CGI script where fast startup is essential code designed to be deployed as a single file via App::FatPacker a CPAN module that may be used by others in the above situations "Moo" maintains transparent compatibility with Moose so if you install and load Moose you can use Moo clases and roles in Moose code without modification. Moo -- Minimal Object Orientation -- aims to make it smooth to upgrade to Moose when you need more than the minimal features offered by Moo. MOO AND MOOSE If Moo detects Moose being loaded, it will automatically register metaclasses for your Moo and Moo::Role packages, so you should be able to use them in Moose code without modification. Moo will also create Moose type constraints for Moo classes and roles, so that in Moose classes "isa => 'MyMooClass'" and "isa => 'MyMooRole'" work the same as for Moose classes and roles. Extending a Moose class or consuming a Moose::Role will also work. Extending a Mouse class or consuming a Mouse::Role will also work. But note that we don't provide Mouse metaclasses or metaroles so the other way around doesn't work. This feature exists for Any::Moose users porting to Moo; enabling Mouse users to use Moo classes is not a priority for us. This means that there is no need for anything like Any::Moose for Moo code - Moo and Moose code should simply interoperate without problem. To handle Mouse code, you'll likely need an empty Moo role or class consuming or extending the Mouse stuff since it doesn't register true Moose metaclasses like Moo does. If you need to disable the metaclass creation, add: no Moo::sification; to your code before Moose is loaded, but bear in mind that this switch is global and turns the mechanism off entirely so don't put this in library code. MOO AND CLASS::XSACCESSOR If a new enough version of Class::XSAccessor is available, it will be used to generate simple accessors, readers, and writers for better performance. Simple accessors are those without lazy defaults, type checks/coercions, or triggers. Readers and writers generated by Class::XSAccessor will behave slightly differently: they will reject attempts to call them with the incorrect number of parameters. MOO VERSUS ANY::MOOSE Any::Moose will load Mouse normally, and Moose in a program using Moose - which theoretically allows you to get the startup time of Mouse without disadvantaging Moose users. Sadly, this doesn't entirely work, since the selection is load order dependent - Moo's metaclass inflation system explained above in "MOO AND MOOSE" is significantly more reliable. So if you want to write a CPAN module that loads fast or has only pure perl dependencies but is also fully usable by Moose users, you should be using Moo. For a full explanation, see the article which explains the differing strategies in more detail and provides a direct example of where Moo succeeds and Any::Moose fails. IMPORTED METHODS new Foo::Bar->new( attr1 => 3 ); or Foo::Bar->new({ attr1 => 3 }); BUILDARGS sub BUILDARGS { my ( $class, @args ) = @_; unshift @args, "attr1" if @args % 2 == 1; return { @args }; } Foo::Bar->new( 3 ); The default implementation of this method accepts a hash or hash reference of named parameters. If it receives a single argument that isn't a hash reference it throws an error. You can override this method in your class to handle other types of options passed to the constructor. This method should always return a hash reference of named options. FOREIGNBUILDARGS If you are inheriting from a non-Moo class, the arguments passed to the parent class constructor can be manipulated by defining a "FOREIGNBUILDARGS" method. It will receive the same arguments as "BUILDARGS", and should return a list of arguments to pass to the parent class constructor. BUILD Define a "BUILD" method on your class and the constructor will automatically call the "BUILD" method from parent down to child after the object has been instantiated. Typically this is used for object validation or possibly logging. DEMOLISH If you have a "DEMOLISH" method anywhere in your inheritance hierarchy, a "DESTROY" method is created on first object construction which will call "$instance->DEMOLISH($in_global_destruction)" for each "DEMOLISH" method from child upwards to parents. Note that the "DESTROY" method is created on first construction of an object of your class in order to not add overhead to classes without "DEMOLISH" methods; this may prove slightly surprising if you try and define your own. does if ($foo->does('Some::Role1')) { ... } Returns true if the object composes in the passed role. IMPORTED SUBROUTINES extends extends 'Parent::Class'; Declares a base class. Multiple superclasses can be passed for multiple inheritance but please consider using roles instead. The class will be loaded but no errors will be triggered if the class can't be found and there are already subs in the class. Calling extends more than once will REPLACE your superclasses, not add to them like 'use base' would. with with 'Some::Role1'; or with 'Some::Role1', 'Some::Role2'; Composes one or more Moo::Role (or Role::Tiny) roles into the current class. An error will be raised if these roles cannot be composed because they have conflicting method definitions. The roles will be loaded using the same mechansim as "extends" uses. has has attr => ( is => 'ro', ); Declares an attribute for the class. package Foo; use Moo; has 'attr' => ( is => 'ro' ); package Bar; use Moo; extends 'Foo'; has '+attr' => ( default => sub { "blah" }, ); Using the "+" notation, it's possible to override an attribute. The options for "has" are as follows: * "is" required, may be "ro", "lazy", "rwp" or "rw". "ro" stands for "read-only" and generates an accessor that dies if you attempt to write to it - i.e. a getter only - by defaulting "reader" to the name of the attribute. "lazy" generates a reader like "ro", but also sets "lazy" to 1 and "builder" to "_build_${attribute_name}" to allow on-demand generated attributes. This feature was my attempt to fix my incompetence when originally designing "lazy_build", and is also implemented by MooseX::AttributeShortcuts. There is, however, nothing to stop you using "lazy" and "builder" yourself with "rwp" or "rw" - it's just that this isn't generally a good idea so we don't provide a shortcut for it. "rwp" stands for "read-write protected" and generates a reader like "ro", but also sets "writer" to "_set_${attribute_name}" for attributes that are designed to be written from inside of the class, but read-only from outside. This feature comes from MooseX::AttributeShortcuts. "rw" stands for "read-write" and generates a normal getter/setter by defaulting the "accessor" to the name of the attribute specified. * "isa" Takes a coderef which is used to validate the attribute. Unlike Moose, Moo does not include a basic type system, so instead of doing "isa => 'Num'", one should do use Scalar::Util qw(looks_like_number); ... isa => sub { die "$_[0] is not a number!" unless looks_like_number $_[0] }, Note that the return value for "isa" is discarded. Only if the sub dies does type validation fail. Sub::Quote aware Since Moo does not run the "isa" check before "coerce" if a coercion subroutine has been supplied, "isa" checks are not structural to your code and can, if desired, be omitted on non-debug builds (although if this results in an uncaught bug causing your program to break, the Moo authors guarantee nothing except that you get to keep both halves). If you want Moose compatible or MooseX::Types style named types, look at Type::Tiny. To cause your "isa" entries to be automatically mapped to named Moose::Meta::TypeConstraint objects (rather than the default behaviour of creating an anonymous type), set: $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub { require MooseX::Types::Something; return MooseX::Types::Something::TypeName(); }; Note that this example is purely illustrative; anything that returns a Moose::Meta::TypeConstraint object or something similar enough to it to make Moose happy is fine. * "coerce" Takes a coderef which is meant to coerce the attribute. The basic idea is to do something like the following: coerce => sub { $_[0] % 2 ? $_[0] : $_[0] + 1 }, Note that Moo will always execute your coercion: this is to permit "isa" entries to be used purely for bug trapping, whereas coercions are always structural to your code. We do, however, apply any supplied "isa" check after the coercion has run to ensure that it returned a valid value. Sub::Quote aware If the "isa" option is a blessed object providing a "coerce" or "coercion" method, then the "coerce" option may be set to just 1. * "handles" Takes a string handles => 'RobotRole' Where "RobotRole" is a role that defines an interface which becomes the list of methods to handle. Takes a list of methods handles => [ qw( one two ) ] Takes a hashref handles => { un => 'one', } * "trigger" Takes a coderef which will get called any time the attribute is set. This includes the constructor, but not default or built values. The coderef will be invoked against the object with the new value as an argument. If you set this to just 1, it generates a trigger which calls the "_trigger_${attr_name}" method on $self. This feature comes from MooseX::AttributeShortcuts. Note that Moose also passes the old value, if any; this feature is not yet supported. Sub::Quote aware * "default" Takes a coderef which will get called with $self as its only argument to populate an attribute if no value for that attribute was supplied to the constructor. Alternatively, if the attribute is lazy, "default" executes when the attribute is first retrieved if no value has yet been provided. If a simple scalar is provided, it will be inlined as a string. Any non-code reference (hash, array) will result in an error - for that case instead use a code reference that returns the desired value. Note that if your default is fired during new() there is no guarantee that other attributes have been populated yet so you should not rely on their existence. Sub::Quote aware * "predicate" Takes a method name which will return true if an attribute has a value. If you set this to just 1, the predicate is automatically named "has_${attr_name}" if your attribute's name does not start with an underscore, or "_has_${attr_name_without_the_underscore}" if it does. This feature comes from MooseX::AttributeShortcuts. * "builder" Takes a method name which will be called to create the attribute - functions exactly like default except that instead of calling $default->($self); Moo will call $self->$builder; The following features come from MooseX::AttributeShortcuts: If you set this to just 1, the builder is automatically named "_build_${attr_name}". If you set this to a coderef or code-convertible object, that variable will be installed under "$class::_build_${attr_name}" and the builder set to the same name. * "clearer" Takes a method name which will clear the attribute. If you set this to just 1, the clearer is automatically named "clear_${attr_name}" if your attribute's name does not start with an underscore, or "_clear_${attr_name_without_the_underscore}" if it does. This feature comes from MooseX::AttributeShortcuts. NOTE: If the attribute is "lazy", it will be regenerated from "default" or "builder" the next time it is accessed. If it is not lazy, it will be "undef". * "lazy" Boolean. Set this if you want values for the attribute to be grabbed lazily. This is usually a good idea if you have a "builder" which requires another attribute to be set. * "required" Boolean. Set this if the attribute must be passed on object instantiation. * "reader" The name of the method that returns the value of the attribute. If you like Java style methods, you might set this to "get_foo" * "writer" The value of this attribute will be the name of the method to set the value of the attribute. If you like Java style methods, you might set this to "set_foo". * "weak_ref" Boolean. Set this if you want the reference that the attribute contains to be weakened. Use this when circular references, which cause memory leaks, are possible. * "init_arg" Takes the name of the key to look for at instantiation time of the object. A common use of this is to make an underscored attribute have a non-underscored initialization name. "undef" means that passing the value in on instantiation is ignored. * "moosify" Takes either a coderef or array of coderefs which is meant to transform the given attributes specifications if necessary when upgrading to a Moose role or class. You shouldn't need this by default, but is provided as a means of possible extensibility. before before foo => sub { ... }; See "before method(s) => sub { ... };" in Class::Method::Modifiers for full documentation. around around foo => sub { ... }; See "around method(s) => sub { ... };" in Class::Method::Modifiers for full documentation. after after foo => sub { ... }; See "after method(s) => sub { ... };" in Class::Method::Modifiers for full documentation. SUB QUOTE AWARE "quote_sub" in Sub::Quote allows us to create coderefs that are "inlineable," giving us a handy, XS-free speed boost. Any option that is Sub::Quote aware can take advantage of this. To do this, you can write use Sub::Quote; use Moo; use namespace::clean; has foo => ( is => 'ro', isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 }) ); which will be inlined as do { local @_ = ($_[0]->{foo}); die "Not <3" unless $_[0] < 3; } or to avoid localizing @_, has foo => ( is => 'ro', isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 }) ); which will be inlined as do { my ($val) = ($_[0]->{foo}); die "Not <3" unless $val < 3; } See Sub::Quote for more information, including how to pass lexical captures that will also be compiled into the subroutine. CLEANING UP IMPORTS Moo will not clean up imported subroutines for you; you will have to do that manually. The recommended way to do this is to declare your imports first, then "use Moo", then "use namespace::clean". Anything imported before namespace::clean will be scrubbed. Anything imported or declared after will be still be available. package Record; use Digest::MD5 qw(md5_hex); use Moo; use namespace::clean; has name => (is => 'ro', required => 1); has id => (is => 'lazy'); sub _build_id { my ($self) = @_; return md5_hex($self->name); } 1; If you were to import "md5_hex" after namespace::clean you would be able to call "->md5_hex()" on your "Record" instances (and it probably wouldn't do what you expect!). Moo::Roles behave slightly differently. Since their methods are composed into the consuming class, they can do a little more for you automatically. As long as you declare your imports before calling "use Moo::Role", those imports and the ones Moo::Role itself provides will not be composed into consuming classes so there's usually no need to use namespace::clean. On namespace::autoclean: Older versions of namespace::autoclean would inflate Moo classes to full Moose classes, losing the benefits of Moo. If you want to use namespace::autoclean with a Moo class, make sure you are using version 0.16 or newer. INCOMPATIBILITIES WITH MOOSE There is no built-in type system. "isa" is verified with a coderef; if you need complex types, Type::Tiny can provide types, type libraries, and will work seamlessly with both Moo and Moose. Type::Tiny can be considered the successor to MooseX::Types and provides a similar API, so that you can write use Types::Standard; has days_to_live => (is => 'ro', isa => Int); "initializer" is not supported in core since the author considers it to be a bad idea and Moose best practices recommend avoiding it. Meanwhile "trigger" or "coerce" are more likely to be able to fulfill your needs. There is no meta object. If you need this level of complexity you need Moose - Moo is small because it explicitly does not provide a metaprotocol. However, if you load Moose, then Class::MOP::class_of($moo_class_or_role) will return an appropriate metaclass pre-populated by Moo. No support for "super", "override", "inner", or "augment" - the author considers augment to be a bad idea, and override can be translated: override foo => sub { ... super(); ... }; around foo => sub { my ($orig, $self) = (shift, shift); ... $self->$orig(@_); ... }; The "dump" method is not provided by default. The author suggests loading Devel::Dwarn into "main::" (via "perl -MDevel::Dwarn ..." for example) and using "$obj->$::Dwarn()" instead. "default" only supports coderefs and plain scalars, because passing a hash or array reference as a default is almost always incorrect since the value is then shared between all objects using that default. "lazy_build" is not supported; you are instead encouraged to use the "is => 'lazy'" option supported by Moo and MooseX::AttributeShortcuts. "auto_deref" is not supported since the author considers it a bad idea and it has been considered best practice to avoid it for some time. "documentation" will show up in a Moose metaclass created from your class but is otherwise ignored. Then again, Moose ignores it as well, so this is arguably not an incompatibility. Since "coerce" does not require "isa" to be defined but Moose does require it, the metaclass inflation for coerce alone is a trifle insane and if you attempt to subtype the result will almost certainly break. "BUILDARGS" is not triggered if your class does not have any attributes. Without attributes, "BUILDARGS" return value would be ignored, so we just skip calling the method instead. Handling of warnings: when you "use Moo" we enable strict and warnings, in a similar way to Moose. The authors recommend the use of "strictures", which enables FATAL warnings, and several extra pragmas when used in development: indirect, multidimensional, and bareword::filehandles. Additionally, Moo supports a set of attribute option shortcuts intended to reduce common boilerplate. The set of shortcuts is the same as in the Moose module MooseX::AttributeShortcuts as of its version 0.009+. So if you: package MyClass; use Moo; use strictures 2; The nearest Moose invocation would be: package MyClass; use Moose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; or, if you're inheriting from a non-Moose class, package MyClass; use Moose; use MooseX::NonMoose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; Finally, Moose requires you to call __PACKAGE__->meta->make_immutable; at the end of your class to get an inlined (i.e. not horribly slow) constructor. Moo does it automatically the first time ->new is called on your class. ("make_immutable" is a no-op in Moo to ease migration.) An extension MooX::late exists to ease translating Moose packages to Moo by providing a more Moose-like interface. SUPPORT Users' IRC: #moose on irc.perl.org Development and contribution IRC: #web-simple on irc.perl.org Bugtracker: Git repository: Git browser: AUTHOR mst - Matt S. Trout (cpan:MSTROUT) CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) mattp - Matt Phillips (cpan:MATTP) bluefeet - Aran Deltac (cpan:BLUEFEET) bubaflub - Bob Kuo (cpan:BUBAFLUB) ether = Karen Etheridge (cpan:ETHER) COPYRIGHT Copyright (c) 2010-2015 the Moo "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. See . Moo-2.000002/t/000755 000765 000024 00000000000 12554434146 013223 5ustar00gknopstaff000000 000000 Moo-2.000002/xt/000755 000765 000024 00000000000 12554434146 013413 5ustar00gknopstaff000000 000000 Moo-2.000002/xt/class-tiny.t000644 000765 000024 00000000604 12554014037 015657 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Class::Tiny 1.001; my %build; { package MyClass; use Class::Tiny qw(name); sub BUILD { $build{+__PACKAGE__}++; } } { package MySubClass; use Moo; extends 'MyClass'; sub BUILD { $build{+__PACKAGE__}++; } has 'attr1' => (is => 'ro'); } MySubClass->new; is $build{MyClass}, 1; is $build{MySubClass}, 1; done_testing; Moo-2.000002/xt/fakemetaclass.t000644 000765 000024 00000001545 12554014037 016401 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Moo::HandleMoose::FakeMetaClass; sub Foo::bar { 'bar' } my $fake = bless { name => 'Foo' }, 'Moo::HandleMoose::FakeMetaClass'; my $bar = $fake->get_method('bar'); is $bar->body, \&Foo::bar, 'able to call moose meta methods'; my $fm = 'Moo::HandleMoose::FakeMetaClass'; is exception { my $can = $fm->can('can'); is $can, \&Moo::HandleMoose::FakeMetaClass::can, 'can usable as class method'; ok $fm->isa($fm), 'isa usable as class method'; local $Moo::HandleMoose::FakeMetaClass::VERSION = 5; is $fm->VERSION, 5, 'VERSION usable as class method'; }, undef, 'no errors calling isa, can, or VERSION'; like exception { $fm->missing_method; }, qr/Can't call missing_method without object instance/, 'nonexistent methods give correct error when called on class'; done_testing; Moo-2.000002/xt/global-destruct-jenga-helper.pl000644 000765 000024 00000000365 12554014037 021377 0ustar00gknopstaff000000 000000 use Moo::_strictures; use lib 'lib'; { package BaseClass; use Moo; } { package Subclass; use Moose; extends 'BaseClass'; __PACKAGE__->meta->make_immutable; } { package Blorp; use Moo; extends 'Subclass'; } our $o = Blorp->new; Moo-2.000002/xt/global-destruct-jenga.t000644 000765 000024 00000000356 12554014037 017752 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; my $out = `"$^X" xt/global-destruct-jenga-helper.pl 2>&1`; my $err = $?; is $out, '', 'no error output from global destruct of jenga object'; is $err, 0, 'process ended successfully'; done_testing; Moo-2.000002/xt/handle_moose.t000644 000765 000024 00000003042 12554014037 016225 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::Fatal; BEGIN { require "t/moo-accessors.t"; } require Moose; my $meta = Class::MOP::get_metaclass_by_name('Foo'); my $attr; ok($attr = $meta->get_attribute('one'), 'Meta-attribute exists'); is($attr->get_read_method, 'one', 'Method name'); is($attr->get_read_method_ref->body, Foo->can('one'), 'Right method'); is(Foo->new(one => 1, THREE => 3)->one, 1, 'Accessor still works'); is( Foo->meta->get_attribute('one')->get_read_method, 'one', 'Method name via ->meta' ); $meta = Moose::Meta::Class->initialize('Spoon'); $meta->superclasses('Moose::Object'); Moose::Util::apply_all_roles($meta, 'Bar'); my $spoon = Spoon->new(four => 4); is($spoon->four, 4, 'Role application ok'); { package MooRequiresFour; use Moo::Role; requires 'four'; package MooRequiresGunDog; use Moo::Role; requires 'gun_dog'; } is exception { Moose::Util::apply_all_roles($meta, 'MooRequiresFour'); }, undef, 'apply role with satisified requirement'; ok exception { Moose::Util::apply_all_roles($meta, 'MooRequiresGunDog'); }, 'apply role with unsatisified requirement'; { package WithNonMethods; use Scalar::Util qw(looks_like_number); use Moo; my $meta = Class::MOP::get_metaclass_by_name(__PACKAGE__); ::ok(!$meta->has_method('looks_like_number'), 'imported sub before use Moo not included in inflated metaclass'); } { package AnotherMooseRole; use Moose::Role; has attr1 => (is => 'ro'); } ok(Moo::Role->is_role('AnotherMooseRole'), 'Moose roles are Moo::Role->is_role'); done_testing; Moo-2.000002/xt/implicit-moose-types.t000644 000765 000024 00000001166 12554014037 017671 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Moose::Util::TypeConstraints qw(find_type_constraint); { package TestRole; use Moo::Role; } { package TestClass; use Moo; with 'TestRole'; } my $o = TestClass->new; foreach my $name (qw(TestClass TestRole)) { ok !find_type_constraint($name), "No $name constraint created without Moose loaded"; } note "Loading Moose"; require Moose; foreach my $name (qw(TestClass TestRole)) { my $tc = find_type_constraint($name); isa_ok $tc, 'Moose::Meta::TypeConstraint', "$name constraint" and ok $tc->check($o), "TestClass object passes $name constraint"; } done_testing; Moo-2.000002/xt/inflate-our-classes.t000644 000765 000024 00000001101 12554014037 017442 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Moo::HandleMoose; use Module::Runtime qw(use_module); foreach my $class (qw( Method::Generate::Accessor Method::Generate::Constructor Method::Generate::BuildAll Method::Generate::DemolishAll )) { my @warnings; local $SIG{__WARN__} = sub { push @warnings, $_[0] }; is exception { Moo::HandleMoose::inject_real_metaclass_for(use_module($class)) }, undef, "No exceptions inflating $class"; ok !@warnings, "No warnings inflating $class" or diag "Got warnings: @warnings"; } done_testing; Moo-2.000002/xt/jenga.t000644 000765 000024 00000001367 12554014037 014664 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Tower1; use Moo; has 'attr1' => (is => 'ro', required => 1); package Tower2; use Moose; extends 'Tower1'; has 'attr2' => (is => 'ro', required => 1); __PACKAGE__->meta->make_immutable; package Tower3; use Moo; extends 'Tower2'; has 'attr3' => (is => 'ro', required => 1); package Tower4; use Moose; extends 'Tower3'; has 'attr4' => (is => 'ro', required => 1); __PACKAGE__->meta->make_immutable; } foreach my $num (1..4) { my $class = "Tower${num}"; my @attrs = map "attr$_", 1..$num; my %args = map +($_ => "${_}_value"), @attrs; my $obj = $class->new(%args); is($obj->{$_}, "${_}_value", "Attribute $_ ok for $class") for @attrs; } done_testing; Moo-2.000002/xt/lib/000755 000765 000024 00000000000 12554434146 014161 5ustar00gknopstaff000000 000000 Moo-2.000002/xt/moo-attr-handles-moose-role.t000644 000765 000024 00000000762 12554014037 021033 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package MooseRole; use Moose::Role; sub warble { "warble" } $INC{"MooseRole.pm"} = __FILE__; } { package MooseClass; use Moose; with 'MooseRole'; } { package MooClass; use Moo; has attr => ( is => 'ro', handles => 'MooseRole', ); } my $o = MooClass->new(attr => MooseClass->new); isa_ok( $o, 'MooClass' ); can_ok( $o, 'warble' ); is( $o->warble, "warble", 'Delegated method called correctly' ); done_testing; Moo-2.000002/xt/moo-consume-moose-role-coerce.t000644 000765 000024 00000001035 12462016515 021347 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package RoleOne; use Moose::Role; use Moose::Util::TypeConstraints; use namespace::autoclean; subtype 'Foo', as 'Int'; coerce 'Foo', from 'Str', via { 3 }; has foo => ( is => 'rw', isa => 'Foo', coerce => 1, clearer => '_clear_foo', ); } { package Class; use Moo; # Works if use Moose.. use namespace::clean -except => 'meta'; with 'RoleOne'; } my $i = Class->new( foo => 'bar' ); is $i->foo, 3; done_testing; Moo-2.000002/xt/moo-consume-moose-role-multiple.t000644 000765 000024 00000000713 12554014037 021743 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package RoleOne; use Moose::Role; has foo => ( is => 'rw' ); } { package RoleTwo; use Moose::Role; has bar => ( is => 'rw' ); } { package SomeClass; use Moo; with 'RoleOne', 'RoleTwo'; } my $i = SomeClass->new( foo => 'bar', bar => 'baz' ); is $i->foo, 'bar', "attribute from first role is correct"; is $i->bar, 'baz', "attribute from second role is correct"; done_testing; Moo-2.000002/xt/moo-consume-mouse-role-coerce.t000644 000765 000024 00000001031 12462016515 021351 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package RoleOne; use Mouse::Role; use Mouse::Util::TypeConstraints; use namespace::clean; subtype 'Foo', as 'Int'; coerce 'Foo', from 'Str', via { 3 }; has foo => ( is => 'rw', isa => 'Foo', coerce => 1, clearer => '_clear_foo', ); } { package Class; use Moo; # Works if use Moose.. use namespace::clean -except => 'meta'; with 'RoleOne'; } my $i = Class->new( foo => 'bar' ); is $i->foo, 3; done_testing; Moo-2.000002/xt/moo-does-moose-role.t000644 000765 000024 00000010554 12554014037 017377 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; BEGIN { package Ker; use Moo::Role; sub has_ker {} } BEGIN { package Splat; use Moose::Role; requires 'monkey'; sub punch { 1 } sub jab { 0 } around monkey => sub { 'OW' }; has trap => (is => 'ro', default => sub { -1 }); sub has_splat {} } BEGIN { package KerSplat; use Moo::Role; with qw/ Ker Splat /; } BEGIN { package Splat2; use Mouse::Role; requires 'monkey'; sub punch { 1 } sub jab { 0 } around monkey => sub { 'OW' }; has trap => (is => 'ro', default => sub { -1 }); sub has_splat {} } BEGIN { package KerSplat2; use Moo::Role; with qw/ Ker Splat2 /; } BEGIN { package Splattered; use Moo; sub monkey { 'WHAT' } with 'Splat'; sub jab { 3 } } BEGIN { package Splattered2; use Moo; sub monkey { 'WHAT' } with 'Splat2'; sub jab { 3 } } BEGIN { package Ker::Splattered; use Moo; sub monkey { 'WHAT' } with qw/ Ker Splat /; sub jab { 3 } } BEGIN { package Ker::Splattered2; use Moo; sub monkey { 'WHAT' } with qw/ Ker Splat2 /; sub jab { 3 } } BEGIN { package KerSplattered; use Moo; sub monkey { 'WHAT' } with qw/ KerSplat /; sub jab { 3 } } BEGIN { package KerSplattered2; use Moo; sub monkey { 'WHAT' } with qw/ KerSplat2 /; sub jab { 3 } } BEGIN { package Plunk; use Moo::Role; has pp => (is => 'rw', moosify => sub { my $spec = shift; $spec->{documentation} = 'moosify'; }); } BEGIN { package Plank; use Moo; use Sub::Quote; has vv => (is => 'rw', moosify => [quote_sub(q| $_[0]->{documentation} = 'moosify'; |), sub { $_[0]->{documentation} = $_[0]->{documentation}.' foo'; }]); } BEGIN { package Plunker; use Moose; with 'Plunk'; } BEGIN { package Planker; use Moose; extends 'Plank'; } BEGIN { package Plonk; use Moo; has kk => (is => 'rw', moosify => [sub { $_[0]->{documentation} = 'parent'; }]); } BEGIN { package Plonker; use Moo; extends 'Plonk'; has '+kk' => (moosify => sub { my $spec = shift; $spec->{documentation} .= 'child'; }); } BEGIN{ local $SIG{__WARN__} = sub { fail "warning: $_[0]" }; package SplatteredMoose; use Moose; extends 'Splattered'; } foreach my $s ( Splattered->new, Splattered2->new, Ker::Splattered->new, Ker::Splattered2->new, KerSplattered->new, KerSplattered2->new, SplatteredMoose->new ) { can_ok($s, 'punch') and is($s->punch, 1, 'punch'); can_ok($s, 'jab') and is($s->jab, 3, 'jab'); can_ok($s, 'monkey') and is($s->monkey, 'OW', 'monkey'); can_ok($s, 'trap') and is($s->trap, -1, 'trap'); } foreach my $c (qw/ Ker::Splattered Ker::Splattered2 KerSplattered KerSplattered2 /) { can_ok($c, 'has_ker'); can_ok($c, 'has_splat'); } is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs'); is(Planker->meta->find_attribute_by_name('vv')->documentation, 'moosify foo', 'moosify modifies attr specs as array'); is( Plonker->meta->find_attribute_by_name('kk')->documentation, 'parentchild', 'moosify applies for overridden attributes with roles'); is ref Splattered2->meta, 'Moo::HandleMoose::FakeMetaClass', 'Mouse::Role meta method not copied'; { package MooseAttrTrait; use Moose::Role; has 'extra_attr' => (is => 'ro'); has 'extra_attr_noinit' => (is => 'ro', init_arg => undef); } { local $SIG{__WARN__} = sub { fail "warning: $_[0]" }; package UsingMooseTrait; use Moo; has one => ( is => 'ro', traits => ['MooseAttrTrait'], extra_attr => 'one', extra_attr_noinit => 'two', ); } ok( UsingMooseTrait->meta ->find_attribute_by_name('one')->can('extra_attr'), 'trait was properly applied'); is( UsingMooseTrait->meta->find_attribute_by_name('one') ->extra_attr, 'one', 'trait attributes maintain values'); { package NeedTrap; use Moo::Role; requires 'trap'; } is exception { package Splattrap; use Moo; sub monkey {} with qw(Splat NeedTrap); }, undef, 'requires satisfied by Moose attribute composed at the same time'; { package HasMonkey; use Moo; sub monkey {} } is exception { Moo::Role->create_class_with_roles('HasMonkey', 'Splat', 'NeedTrap'); }, undef, ' ... and when created by create_class_with_roles'; done_testing; Moo-2.000002/xt/moo-inflate.t000644 000765 000024 00000000622 12554014037 016003 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package MooClass; use Moo; } use Moose (); use Moo::Role (); ok !$Moo::HandleMoose::DID_INJECT{'MooClass'}, "No metaclass generated for Moo class on initial Moose load"; Moo::Role->is_role('MooClass'); ok !$Moo::HandleMoose::DID_INJECT{'MooClass'}, "No metaclass generated for Moo class after testing with ->is_role"; done_testing; Moo-2.000002/xt/moo-object-meta-can.t000644 000765 000024 00000002575 12554014037 017323 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Moo::Object; # See RT#84615 ok( Moo::Object->can('meta'), 'Moo::Object can meta'); is( exception { Moo::Object->meta->can('can') } , undef, "Moo::Object->meta->can doesn't explode" ); { package Example; use base 'Moo::Object'; } ok( Example->can('meta'), 'Example can meta'); is( exception { Example->meta->can('can') } , undef, "Example->meta->can doesn't explode" ); # Haarg++ noting that previously, this *also* would have died due to its absence from %Moo::Makers; { package Example_2; use Moo; has 'attr' => ( is => ro =>, ); $INC{'Example_2.pm'} = 1; } { package Example_3; use base "Example_2"; } ok( Example_2->can('meta'), 'Example_2 can meta') and do { return unless ok( Example_2->meta->can('get_all_attributes'), 'Example_2 meta can get_all_attributes' ); my (@attributes) = Example_2->meta->get_all_attributes; is( scalar @attributes, 1, 'Has one attribute' ); }; ok( Example_3->can('meta'), 'Example_3 can meta') and do { return unless is( exception { Example_3->meta->can('can') } , undef, "Example_3->meta->can doesn't explode" ); return unless ok( Example_3->meta->can('get_all_attributes'), 'Example_3 meta can get_all_attributes' ); my (@attributes) = Example_3->meta->get_all_attributes; is( scalar @attributes, 1, 'Has one attribute' ); }; done_testing; Moo-2.000002/xt/moo-role-types.t000644 000765 000024 00000003171 12462016515 016467 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; { package TestClientClass; use Moo; use namespace::clean -except => 'meta'; sub consume {} } { package TestBadClientClass; use Moo; use namespace::clean -except => 'meta'; sub not_consume {} } { package TestRole; use Moo::Role; use Sub::Quote; use namespace::clean -except => 'meta'; has output_to => ( isa => quote_sub(q{ use Scalar::Util (); die $_[0] . "Does not have a ->consume method" unless Scalar::Util::blessed($_[0]) && $_[0]->can('consume'); }), is => 'ro', required => 1, coerce => quote_sub(q{ use Scalar::Util (); if (Scalar::Util::blessed($_[0]) && $_[0]->can('consume')) { $_[0]; } else { my %stuff = %{$_[0]}; my $class = delete($stuff{class}); $class->new(%stuff); } }), ); } { package TestMooClass; use Moo; with 'TestRole'; } { package TestMooseClass; use Moose; with 'TestRole'; } foreach my $name (qw/ TestMooClass TestMooseClass /) { my $i = $name->new(output_to => TestClientClass->new()); ok $i->output_to->can('consume'); $i = $name->new(output_to => { class => 'TestClientClass' }); ok $i->output_to->can('consume'); }; foreach my $name (qw/ TestMooClass TestMooseClass /) { ok !exception { TestBadClientClass->new }; ok exception { $name->new(output_to => TestBadClientClass->new()) }; ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) }; } done_testing; Moo-2.000002/xt/moo-roles-into-moose-class-attr-override-with-autoclean.t000644 000765 000024 00000000404 12462016515 026405 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/ $Bin /; use lib "$Bin/lib"; { package Bax; use Moose; with qw/ ExampleMooRoleWithAttribute /; has '+output_to' => ( required => 1, ); } ok 1; done_testing; Moo-2.000002/xt/moo-roles-into-moose-class.t000644 000765 000024 00000002666 12516547731 020723 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use Moo::Role; # if we autoclean here there's nothing left and then load_class tries # to require Foo during Moose application and everything breaks. } { package Bar; use Moo::Role; use namespace::autoclean; has attr => ( is => 'ro' ); sub thing {} } { package Baz; use Moose; no Moose; ::ok(!__PACKAGE__->can('has'), 'No has function after no Moose;'); Moose::with('Baz', 'Bar'); } ::is(Baz->can('thing'), Bar->can('thing'), 'Role copies method correctly'); ::ok(Baz->can('attr'), 'Attr accessor correct'); ::ok(!Bar->can('has'), 'Moo::Role sugar removed by autoclean'); ::ok(!Bar->can('with'), 'Role::Tiny sugar removed by autoclean'); ::ok(!Baz->can('has'), 'Sugar not copied'); { package Bax; use Moose; with qw/ Foo Bar /; } { package Baw; use Moo::Role; has attr => ( is => 'ro', traits => ['Array'], default => sub { [] }, handles => { push_attr => 'push', }, ); } { package Buh; use Moose; with 'Baw'; } is exception { Buh->new->push_attr(1); }, undef, 'traits in role attributes are inflated properly'; { package Blorp; use Moo::Role; has attr => (is => 'ro'); } is +Blorp->meta->get_attribute('attr')->name, 'attr', 'role metaclass inflatable via ->meta'; done_testing; Moo-2.000002/xt/moo-sification-handlemoose.t000644 000765 000024 00000000541 12554014037 021005 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; BEGIN { package Foo; use Moo; has one => (is => 'ro'); } use Moo::HandleMoose; require Moo::sification; like exception { Moo::sification->unimport }, qr/Can't disable Moo::sification after inflation has been done/, 'Moo::sification can\'t be disabled after inflation'; done_testing; Moo-2.000002/xt/moo-sification-meta.t000644 000765 000024 00000002264 12554014037 017441 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; BEGIN { package Foo; use Moo; has one => (is => 'ro'); } no Moo::sification; is exception { Foo->meta->make_immutable }, undef, 'make_immutable allowed under no Moo::sification'; like exception { Foo->meta->get_methods_list }, qr/^Can't inflate Moose metaclass with Moo::sification disabled/, 'meta methods blocked under no Moo::sification'; is exception { is +Foo->meta->can('can'), \&Moo::HandleMoose::FakeMetaClass::can, '->meta->can falls back to default under no Moo::sification'; }, undef, '->meta->can works under no Moo::sification'; is exception { ok +Foo->meta->isa('Moo::HandleMoose::FakeMetaClass'), '->meta->isa falls back to default under no Moo::sification'; }, undef, '->meta->isa works under no Moo::sification'; like exception { Foo->meta->get_methods_list }, qr/^Can't inflate Moose metaclass with Moo::sification disabled/, 'meta methods blocked under no Moo::sification'; require Moo::HandleMoose; like exception { Moo::HandleMoose->import }, qr/^Can't inflate Moose metaclass with Moo::sification disabled/, 'Moo::HandleMoose->import blocked under no Moo::sification'; done_testing; Moo-2.000002/xt/moo-sification.t000644 000765 000024 00000000423 12554014037 016510 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; BEGIN { package Foo; use Moo; has one => (is => 'ro'); } no Moo::sification; use Moose; use Class::MOP; is Class::MOP::get_metaclass_by_name('Foo'), undef, 'no metaclass for Moo class after no Moo::sification'; done_testing; Moo-2.000002/xt/moose-accessor-isa.t000644 000765 000024 00000002707 12554014037 017273 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package FrewWithIsa; use Moo::Role; use Sub::Quote; has frooh => ( is => 'rw', isa => sub { die 'not int' unless $_[0] =~ /^\d$/ }, ); has frew => ( is => 'rw', isa => quote_sub(q{ die 'not int' unless $_[0] =~ /^\d$/ }), ); package Bar; use Moose; with 'FrewWithIsa'; package OffByOne; use Moo::Role; has off_by_one => (is => 'rw', coerce => sub { $_[0] + 1 }); package Baz; use Moo; with 'OffByOne'; package Quux; use Moose; with 'OffByOne'; __PACKAGE__->meta->make_immutable; } is(exception { Bar->new(frooh => 1, frew => 1); }, undef, 'creation of valid Bar'); ok exception { Bar->new(frooh => 'silly', frew => 1); }, 'creation of invalid Bar validated by coderef'; ok exception { Bar->new(frooh => 1, frew => 'goose'); }, 'creation of invalid Bar validated by quoted sub'; sub test_off_by_one { my ($class, $type) = @_; my $obo = $class->new(off_by_one => 1); is($obo->off_by_one, 2, "Off by one (new) ($type)"); $obo->off_by_one(41); is($obo->off_by_one, 42, "Off by one (set) ($type)"); } test_off_by_one('Baz', 'Moo'); test_off_by_one('Quux', 'Moose'); my $coerce_constraint = Quux->meta->get_attribute('off_by_one') ->type_constraint->constraint; like exception { $coerce_constraint->() }, qr/This is not going to work/, 'generated constraint is not a null constraint'; done_testing; Moo-2.000002/xt/moose-autoclean-lazy-attr-builders.t000644 000765 000024 00000001101 12462016515 022412 0ustar00gknopstaff000000 000000 use strict; use warnings; # when using an Moose object and namespace::autoclean # lazy attributes that get a value on initialize still # have their builders run { package MyMooseObject; use Moose; } { package BadObject; use Moo; # use MyMooseObject <- this is inferred here use namespace::autoclean; has attr => ( is => 'lazy' ); sub _build_attr {2} } use Test::More; # use BadObject <- this is inferred here is( BadObject->new( attr => 1 )->attr, 1, q{namespace::autoclean doesn't run builders with default}, ); done_testing; Moo-2.000002/xt/moose-consume-moo-role-after-consumed-by-moo.t000644 000765 000024 00000000523 12554014037 024223 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use lib 'xt/lib'; BEGIN { $::ExampleMooRole_LOADED = 0 } BEGIN { package ExampleMooConsumer; use Moo; with "ExampleMooRole"; } BEGIN { package ExampleMooseConsumer; use Moose; with "ExampleMooRole"; } is $::ExampleMooRole_LOADED, 1, "role loaded only once"; done_testing; Moo-2.000002/xt/moose-consume-moo-role-no-moo-loaded.t000644 000765 000024 00000000271 12462016515 022542 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package ExampleRole; use Moo::Role; } { package ExampleClass; use Moose; with 'ExampleRole'; } ok 1; done_testing; Moo-2.000002/xt/moose-does-moo-role.t000644 000765 000024 00000002403 12554014037 017371 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package MooParentRole; use Moo::Role; sub parent_role_method { 1 }; package MooRole; use Moo::Role; with 'MooParentRole'; sub role_method { 1 }; package MooRoledMooClass; use Moo; with 'MooRole'; has 'some_attr' => (is => 'ro'); package MooRoledMooseClass; use Moose; with 'MooRole'; has 'some_attr' => (is => 'ro'); package MooseParent; use Moose; has e => ( is => 'ro', required => 1, does => 'MooRole', ); package MooParent; use Moo; has e => ( is => 'ro', required => 1, does => 'MooRole', ); } for my $parent (qw(MooseParent MooParent)) { for my $child (qw(MooRoledMooClass MooRoledMooseClass)) { is(exception { my $o = $parent->new( e => $child->new(), ); ok( $o->e->does("MooParentRole"), "$child does parent MooRole" ); can_ok( $o->e, "role_method" ); can_ok( $o->e, "parent_role_method" ); ok($o->e->meta->has_method('role_method'), 'Moose knows about role_method'); ok($o->e->meta->has_method('parent_role_method'), 'Moose knows about parent_role_method'); }, undef); } } done_testing; Moo-2.000002/xt/moose-extend-moo.t000644 000765 000024 00000003231 12554011547 016772 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { package Parent; use Moo; has message => ( is => 'ro', required => 1 ), } BEGIN { package Child; use Moose; extends 'Parent'; use Moose::Util::TypeConstraints; use namespace::clean; # <-- essential has message => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { 'overridden message sub here' }, ); } # without namespace::clean, gives the (non-fatal) warning: # You are overwriting a locally defined function (message) with an accessor # ...because Moose::Util::TypeConstraints exports a 'message' sub! my $obj = Child->new(message => 'custom message'); is($obj->message, 'custom message', 'accessor works'); BEGIN { package Role1; use Moo::Role; } BEGIN { package Role2; use Moose::Role; } BEGIN { package Class1; use Moo; with 'Role1'; } BEGIN { package Class2; use Moose; extends 'Class1'; with 'Role2'; } ok +Class2->does('Role1'), "Moose child does parent's composed roles"; ok +Class2->does('Role2'), "Moose child does child's composed roles"; BEGIN { package NonMooParent; sub new { bless {}, $_[0]; } } BEGIN { package MooChild; use Moo; extends 'NonMooParent'; has attr1 => (is => 'ro'); with 'Role1'; } BEGIN { package MooseChild; use Moose; extends 'MooChild'; with 'Role2'; has attr2 => (is => 'ro'); } is exception { MooseChild->new }, undef, 'NonMoo->Moo->Moose(mutable) works'; MooseChild->meta->make_immutable; is exception { MooseChild->new }, undef, 'NonMoo->Moo->Moose(immutable) works'; ok +MooseChild->does('Role2'), "Moose child does parent's composed roles with non-Moo ancestor"; done_testing; Moo-2.000002/xt/moose-handles-moo-class.t000644 000765 000024 00000000500 12554014037 020215 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use Moo; sub sub1 { 1 } } { package Bar; use Moose; ::is ::exception { has attr => ( is => 'ro', isa => 'Foo', handles => qr/.*/, ); }, undef, 'regex handles in Moose with Moo class isa'; } done_testing; Moo-2.000002/xt/moose-inflate-error-recurse.t000644 000765 000024 00000000671 12554014037 021134 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Moose (); BEGIN { package Role1; use Moo::Role; has attr1 => (is => 'ro', lazy => 1); } BEGIN { package Class1; use Moo; with 'Role1'; } BEGIN { package SomeMooseClass; use Moose; ::like( ::exception { with 'Role1' }, qr/You cannot have a lazy attribute/, 'reasonable error rather than deep recursion for inflating invalid attr', ); } done_testing; Moo-2.000002/xt/moose-lazy.t000644 000765 000024 00000003112 12554014037 015665 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package LazyFrew; our $default_ran = 0; our $quoted_default_ran = 0; our $builder_ran = 0; use Moo::Role; use Sub::Quote; has frooh => ( is => 'rw', default => sub { $default_ran = 1; 'test frooh' }, lazy => 1, ); has frew => ( is => 'rw', default => quote_sub(q{ $$quoted_default_ran = 1; 'test frew' }, { '$quoted_default_ran' => \\$quoted_default_ran }), lazy => 1, ); has frioux => ( is => 'rw', builder => 'build_frioux', lazy => 1, ); sub build_frioux { $builder_ran = 1; 'test frioux' } package Bar; use Moose; with 'LazyFrew'; } my $x = Bar->new; ok(!$LazyFrew::default_ran, 'default has not run yet'); ok(!$LazyFrew::quoted_default_ran, 'quoted default has not run yet'); ok(!$LazyFrew::builder_ran, 'builder has not run yet'); is($x->frooh, 'test frooh', 'frooh defaulted correctly'); ok($LazyFrew::default_ran, 'default ran'); ok(!$LazyFrew::quoted_default_ran, 'quoted default has not run yet'); ok(!$LazyFrew::builder_ran, 'builder has not run yet'); is($x->frew, 'test frew', 'frew defaulted correctly'); ok($LazyFrew::default_ran, 'default ran'); ok($LazyFrew::quoted_default_ran, 'quoted default ran'); ok(!$LazyFrew::builder_ran, 'builder has not run yet'); is($x->frioux, 'test frioux', 'frioux built correctly'); ok($LazyFrew::default_ran, 'default ran'); ok($LazyFrew::quoted_default_ran, 'quoted default ran'); ok($LazyFrew::builder_ran, 'builder ran'); done_testing; Moo-2.000002/xt/moose-method-modifiers.t000644 000765 000024 00000002254 12554014037 020153 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package ModifyFoo; use Moo::Role; our $before_ran = 0; our $around_ran = 0; our $after_ran = 0; before foo => sub { $before_ran = 1 }; after foo => sub { $after_ran = 1 }; around foo => sub { my ($orig, $self, @rest) = @_; $self->$orig(@rest); $around_ran = 1; }; package Bar; use Moose; with 'ModifyFoo'; sub foo { } } my $bar = Bar->new; ok(!$ModifyFoo::before_ran, 'before has not run yet'); ok(!$ModifyFoo::after_ran, 'after has not run yet'); ok(!$ModifyFoo::around_ran, 'around has not run yet'); $bar->foo; ok($ModifyFoo::before_ran, 'before ran'); ok($ModifyFoo::after_ran, 'after ran'); ok($ModifyFoo::around_ran, 'around ran'); { package ModifyMultiple; use Moo::Role; our $before = 0; before 'foo', 'bar' => sub { $before++; }; package Baz; use Moose; with 'ModifyMultiple'; sub foo {} sub bar {} } my $baz = Baz->new; my $pre = $ModifyMultiple::before; $baz->foo; is $ModifyMultiple::before, $pre+1, "before applies to first of multiple subs"; $baz->bar; is $ModifyMultiple::before, $pre+2, "before applies to second of multiple subs"; done_testing; Moo-2.000002/xt/moose-override-attribute-from-moo-role.t000644 000765 000024 00000001043 12462016515 023220 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; { package MyRole; use Moo::Role; has foo => ( is => 'ro', required => 1, ); } { package MyClass; use Moose; with 'MyRole'; has '+foo' => ( isa => 'Str', ); } is( exception { MyClass->new(foo => 'bar') }, undef, 'construct' ); ok( exception { MyClass->new(foo => []) }, 'no construct, constraint works' ); ok( exception { MyClass->new() }, 'no construct - require still works' ); done_testing; Moo-2.000002/xt/moose-override-attribute-with-plus-syntax.t000644 000765 000024 00000002013 12462016515 024004 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; { package MooParent; use Moo; has foo => ( is => 'ro', default => sub { 'MooParent' }, ); } { package MooseChild; use Moose; extends 'MooParent'; has '+foo' => ( default => 'MooseChild', ); } { package MooseChild2; use Moose; extends 'MooParent'; has '+foo' => ( default => 'MooseChild2', ); __PACKAGE__->meta->make_immutable } { package MooChild; use Moo; extends 'MooParent'; has '+foo' => ( default => sub { 'MooChild' }, ); } is( MooseChild->new->foo, 'MooseChild', 'default value in Moose child' ); is( MooseChild2->new->foo, 'MooseChild2', 'default value in Moose child' ); is(exception { local $SIG{__WARN__} = sub { die $_[0] }; ok(MooChild->meta->has_attribute('foo'), 'inflated metaclass has overridden attribute'); }, undef, 'metaclass inflation of plus override works without warnings'); done_testing; Moo-2.000002/xt/more-jenga.t000644 000765 000024 00000000530 12462016515 015614 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/ $Bin /; use lib "$Bin/lib"; { package ExampleRole; use Moo::Role; requires 'foo'; with qw/ ExampleMooseRoleOne ExampleMooseRoleTwo /; } { package ExampleClass; use Moose; with 'ExampleRole'; sub foo {} } ok 1; done_testing; Moo-2.000002/xt/role-tiny-inflate.t000644 000765 000024 00000001346 12554014037 017137 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; eval q{ package TinyRole; $INC{'TinyRole.pm'} = __FILE__; use Role::Tiny; sub role_tiny_method { 219 } 1; } or die $@; require Moo::Role; require Moose; eval q{ package TinyRoleAfterMoo; $INC{'TinyRoleAfterMoo.pm'} = __FILE__; use Role::Tiny; sub role_tiny_after_method { 42 } 1; } or die $@; eval q{ package Some::Moose::Class; use Moose; 1; } or die $@; eval q{ package Some::Moose::Class; with 'TinyRole'; }; $@ =~ s/\n.*//s; is $@, '', 'Moose can consume Role::Tiny created before Moo loaded'; eval q{ package Some::Moose::Class; with 'TinyRoleAfterMoo'; }; $@ =~ s/\n.*//s; is $@, '', 'Moose can consume Role::Tiny created after Moo loaded'; done_testing; Moo-2.000002/xt/super-jenga.t000644 000765 000024 00000001156 12554014037 016014 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Tower1; use Mouse; has 'attr1' => (is => 'ro', required => 1); package Tower2; use Moo; extends 'Tower1'; has 'attr2' => (is => 'ro', required => 1); package Tower3; use Moose; extends 'Tower2'; has 'attr3' => (is => 'ro', required => 1); __PACKAGE__->meta->make_immutable; } foreach my $num (1..3) { my $class = "Tower${num}"; my @attrs = map "attr$_", 1..$num; my %args = map +($_ => "${_}_value"), @attrs; my $obj = $class->new(%args); is($obj->{$_}, "${_}_value", "Attribute $_ ok for $class") for @attrs; } done_testing; Moo-2.000002/xt/test-my-dependents.t000644 000765 000024 00000023561 12554014037 017331 0ustar00gknopstaff000000 000000 use Test::More; BEGIN { plan skip_all => <<'END_HELP' unless $ENV{MOO_TEST_MD} || @ARGV; This test will not run unless you set MOO_TEST_MD to a true value. Valid values are: all Test every dist which depends on Moose except those that we know cannot be tested. This is a lot of distros (hundreds). Dist::1,Dist::2,... Test the individual dists listed. MooX Test all Moo extension distros. 1 Run the default tests. We pick 200 random dists and test them. END_HELP } use Test::DependentModules qw( test_module ); use JSON::PP; use HTTP::Tiny; use List::Util (); use Cwd (); use Getopt::Long (); use Config; my @extra_libs = do { my @libs = `"$^X" -le"print for \@INC"`; chomp @libs; my %libs; @libs{@libs} = (); map { Cwd::abs_path($_) } grep { !exists $libs{$_} } @INC; }; $ENV{PERL5LIB} = join($Config{path_sep}, @extra_libs, $ENV{PERL5LIB}||()); Getopt::Long::GetOptions( 'show' => \(my $show), 'all' => \(my $all), 'save-skip=s' => \(my $save_skip), 'skip-file=s' => \(my $skip_file), 'count=s' => \(my $count), 'moox' => \(my $moox), ); my @pick = @ARGV; if (my $env = $ENV{MOO_TEST_MD}) { if ($env eq 'MooX') { $moox = 1; } elsif ($env eq 'all') { $all = 1; } elsif ($env =~ /^\d+$/) { $count = $env; } else { @pick = split /,/, $env; s/^\s+//, s/\s+$// for @pick; } } # avoid any modules that depend on these my @bad_prereqs = qw(Gtk2 Padre Wx); my $res = decode_json(HTTP::Tiny->new->post( 'http://api.metacpan.org/v0/search/reverse_dependencies/Moo', { content => encode_json({ query => { filtered => { query => { "match_all" => {} }, filter => { and => [ { term => { 'release.status' => 'latest' } }, { term => { 'release.authorized' => \1 } }, { not => { filter => { or => [ map { { term => { 'dependency.module' => $_ } } } @bad_prereqs, ], } } } ], }, }, }, size => 5000, fields => ['distribution', 'provides', 'metadata.provides'], }) }, )->{content}); my %bad_dist; my $sec_reason; my %skip; my %todo; my $hash; my $skip_fh; if ($skip_file) { open $skip_fh, '<', $skip_file or die "can't open $skip_file: $!"; } else { $skip_fh = \*DATA; } while (my $line = <$skip_fh>) { chomp $line; next unless $line =~ /\S/; if ( $line =~ /^#\s*(\w+)(?::\s*(.*?)\s*)?$/ ) { die "Invalid action in DATA section ($1)" unless $1 eq 'SKIP' || $1 eq 'TODO'; $hash = $1 eq 'SKIP' ? \%skip : \%todo; $sec_reason = $2; } my ( $dist, $reason ) = $line =~ /^(\S*)\s*(?:#\s*(.*?)\s*)?$/; next unless defined $dist && length $dist; $hash->{$dist} = $reason ? "$sec_reason: $reason" : $reason; } my %todo_module; my %skip_module; my %dists; my @modules; for my $hit (@{ $res->{hits}{hits} }) { my $dist = $hit->{fields}{distribution}; my $module = (sort { length $a <=> length $b || $a cmp $b } do { if (my $provides = $hit->{fields}{provides}) { ref $provides ? @$provides : ($provides); } elsif (my $provides = $hit->{fields}{'metadata.provides'}) { keys %$provides; } else { (my $module = $dist) =~ s/-/::/g; ($module); } })[0]; $todo_module{$module} = $todo{$dist} if exists $todo{$dist}; $skip_module{$module} = $skip{$dist} if exists $skip{$dist}; if ($dist =~ /^(Task|Bundle|Acme)-/) { $skip_module{$module} = "not testing $1 dist"; } $dists{$module} = $dist; push @modules, $module; $module; } @modules = sort @modules; if ( $moox ) { @modules = grep /^MooX(?:$|::)/, @modules; } elsif ( $count ) { $count = $count == 1 ? 200 : $count; diag(<<"EOF"); Picking $count random dependents to test. Set MOO_TEST_MD=all to test all dependents or MOO_TEST_MD=MooX to test extension modules only. EOF @modules = grep { !exists $skip_modules{$_} } List::Util::shuffle(@modules); @modules = @modules[0 .. $count-1]; } elsif ( @pick ) { my %modules = map { $_ => 1 } @modules; if (my @unknown = grep { !$modules{$_} } @pick) { die "Unknown modules: @unknown"; } delete @skip_modules{@pick}; @modules = @pick; } if ($show) { print "Dependents:\n"; print " $_\n" for @modules; exit; } my $skip_report; if ($save_skip) { open $skip_report, '>', $save_skip or die "can't open $save_skip: $!"; print { $skip_report } "# SKIP: saved failures\n" } plan tests => scalar @modules; for my $module (@modules) { SKIP: { local $TODO = $todo_module{$module} || '???' if exists $todo_module{$module}; skip "$module - " . ($skip_module{$module} || '???'), 1 if exists $skip_module{$module}; test_module($module); if ($skip_report) { my $last = (Test::More->builder->details)[-1]; if (! $last->{ok}) { my $name = $last->{name}; $name =~ s/\s.*//; $name =~ s/^\Q$dists{$module}-//; print { $skip_report } "$dists{$module} # $name\n"; } } } } __DATA__ # TODO: broken App-Presto # 0.009 Dancer2-Session-Sereal # 0.001 Mail-GcalReminder # 0.1 DBIx-Class-IndexSearch-Dezi # 0.05 Tak # 0.001003 HTML-Zoom-Parser-HH5P # 0.002 Farabi # 0.44 MooX-Types-CLike # 0.92 Net-Easypost # 0.09 OAuth2-Google-Plus # 0.02 Protocol-Star-Linemode # 1.0.0 Vim-X # 0.2.0 WWW-eNom # v1.2.8 - the internet changes WebService-Cryptsy # 1.008003 Dancer2-Plugin-REST # 0.21 Config-GitLike # 1.13 WWW-ThisIsMyJam # v0.1.0 Dancer2-Session-JSON # 0.001 App-Kit # 0.26 - db test segfaults Data-Record-Serialize # 0.05 - dbi test fails # TODO: broken prereqs Dancer-Plugin-FontSubset # 0.1.2 - Font::TTF::Scripts::Name App-Unicheck-Modules-MySQL # 0.02 - DBD::mysql Video-PlaybackMachine # 0.09 - needs X11::FullScreen Games-Snake # 0.000001 - SDL Data-SimplePassword # 0.10 - Crypt::Random, Math::Pari Dancer2-Plugin-Queue # 0.004 - Dancer2 0.08 MarpaX-Grammar-GraphViz2 # 1.00 - GraphViz2 Nitesi # 0.0094 - Crypt::Random, Math::Pari POEx-ZMQ3 # 0.060003 - ZMQ::LibZMQ3 Unicorn-Manager # 0.006009 - Net::Interface Wight-Chart # 0.003 - Wight Yakuake-Sessions # 0.11.1 - Net::DBus Jedi-Plugin-Auth # 0.01 - Jedi Minilla # v0.14.1 Perinci-CmdLine # 0.85 - via SHARYANTO Perinci-To-Text # 0.22 - via SHARYANTO Perinci-Sub-To-Text # 0.24 - via SHARYANTO Software-Release-Watch # 0.01 - via SHARYANTO Software-Release-Watch-SW-wordpress # 0.01 - via Software::Release::Watch Org-To-HTML # 0.11 - via Perinci::* # TODO: undeclared prereqs Catmandu-Inspire # v0.24 - Furl # TODO: broken by perl 5.18 App-DBCritic # 0.020 - smartmatch (GH #9) Authen-HTTP-Signature # 0.02 - smartmatch (rt#88854) DBICx-Backend-Move # 1.000010 - smartmatch (rt#88853) Ruby-VersionManager # 0.004003 - smartmatch (rt#88852) Text-Keywords # 0.900 - smartmatch (rt#84339) WebService-HabitRPG # 0.21 - smartmatch (rt#88399) Net-Icecast2 # 0.005 - hash order via PHP::HTTPBuildQuery (rt#81570) POE-Component-ProcTerminator # 0.03 - hash order via Log::Fu (rt#88851) Plugin-Tiny # 0.012 - hash order Firebase # 0.0201 - hash order # TODO: broken by Regexp::Grammars (perl 5.18) Language-Expr # 0.19 Org-To-HTML # 0.07 - via Language::Expr Perinci-Access-Simple-Server # 0.12 # TODO: invalid prereqs Catmandu-Z3950 # 0.03 - ZOOM missing Dancer2-Session-JSON # 0.001 - Dancer2 bad version requirement Business-CPI-Gateway-Moip # 0.05 - Business::CPI::Buyer Business-OnlinePayment-IPayment # 0.05 - XML::Compile::WSDL11 WebService-BambooHR # 0.04 - LWP::Online WWW-AdServeApache2-HttpEquiv # 1.00r - unlisted dep Geo::IP WWW-AdServer # 1.01 - unlisted dep Geo::IP CatalystX-Usul # 0.17.1 - issues in prereq chain Dancer2-Template-Haml # 0.04 - unlisted dep Text::Haml # SKIP: misc Apache2-HttpEquiv # 1.00 - prereq Apache2::Const GeoIP2 # 0.040000 - prereq Math::Int128 (requires gcc 4.4) Graphics-Potrace # 0.72 - external dependency GraphViz2 # 2.19 - external dependency Linux-AtaSmart # OS specific MaxMind-DB-Reader # 0.040003 - prereq Math::Int128 (requires gcc 4.4) MaxMind-DB-Common # 0.031002 - prereq Math::Int128 (requires gcc 4.4) Net-Works # 0.12 - prereq Math::Int128 (requires gcc 4.4) PortageXS # 0.3.1 - external dependency and broken prereq (Shell::EnvImporter) XML-GrammarBase # v0.2.2 - prereq XML::LibXSLT (hard to install) Forecast-IO # 0.21 - interactive tests Net-OpenVPN-Launcher # 0.1 - external dependency (and broken test) App-PerlWatcher-Level # 0.13 - depends on Linux::Inotify2 Graph-Easy-Marpa # 2.00 - GraphVis2 Net-OAuth-LP # 0.016 - relies on external service Message-Passing-ZeroMQ # 0.007 - external dependency Net-Docker # 0.002003 - external dependency App-PerlWatcher-Watcher-FileTail # 0.18 - Linux::Inotify2 switchman # 1.05 - Linux::MemInfo Juno # 0.009 - never finishes Zucchini # 0.0.21 - broken by File::Rsync ZMQ-FFI # 0.12 - libzmq MaxMind-DB-Reader-XS # 0.060003 - external lib libmaxminddb Cave-Wrapper # 0.01100100 - external program cave Tropo # 0.16 - openssl >= 1.0.0? # TODO: broken by Moo change Math-Rational-Approx # RT#84035 App-Services # RT#85255 Hg-Lib # pending release Moo-2.000002/xt/type-inflate-coercion.t000644 000765 000024 00000002652 12554014037 017776 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; sub ArrayRef { my $type = sub { die unless ref $_[0] && ref $_[0] eq 'ARRAY'; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { require Moose::Util::TypeConstraints; Moose::Util::TypeConstraints::find_type_constraint("ArrayRef"); }; return ($type, @_); } { package ClassWithTypes; $INC{'ClassWithTypes.pm'} = __FILE__; use Moo; has split_comma => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split /,/, $_[0] ] } ); has split_space => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split / /, $_[0] ] } ); has bad_coerce => (is => 'ro', isa => ::ArrayRef, coerce => sub { $_[0] } ); } my $o = ClassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); is_deeply $o->split_comma, ['a','b c','d'], 'coerce with prebuilt type works'; is_deeply $o->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; { package MooseSubclassWithTypes; use Moose; extends 'ClassWithTypes'; } my $o2 = MooseSubclassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); is_deeply $o2->split_comma, ['a','b c','d'], 'moose subclass has correct coercion'; is_deeply $o2->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; like exception { MooseSubclassWithTypes->new(bad_coerce => 1) }, qr/Validation failed for 'ArrayRef' with value/, 'inflated type has correct name'; done_testing; Moo-2.000002/xt/type-inflate-threads.t000644 000765 000024 00000002630 12554014037 017623 0ustar00gknopstaff000000 000000 use Config; BEGIN { unless ($Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } } use threads; use Moo::_strictures; use Test::More; use Type::Tiny; my $str = sub { die unless defined $_[0] && !ref $_[0]; }; no warnings 'once'; $Moo::HandleMoose::TYPE_MAP{$str} = sub { require Moose::Util::TypeConstraints; Moose::Util::TypeConstraints::find_type_constraint("Str"); }; my $int = Type::Tiny->new( name => "Integer", constraint => sub { /^(?:-?[1-9][0-9]*|0)$|/ }, message => sub { "$_ isn't an integer" }, ); require Moo; is(threads->create(sub { my $type = $str; eval q{ package TypeOMatic; use Moo; has str_type => ( is => 'ro', isa => $type, ); 1; } or die $@; require Moose; my $meta = Class::MOP::class_of('TypeOMatic'); my $str_name = $meta->get_attribute("str_type")->type_constraint->name; $str_name; })->join, 'Str', 'Type created outside thread properly inflated'); is(threads->create(sub { my $type = $int; eval q{ package TypeOMatic; use Moo; has int_type => ( is => 'ro', isa => $type, ); 1; } or die $@; require Moose; my $meta = Class::MOP::class_of('TypeOMatic'); my $int_class = ref $meta->get_attribute("int_type")->type_constraint; $int_class; })->join, 'Type::Tiny', 'Type::Tiny created outside thread inflates to self'); done_testing; Moo-2.000002/xt/type-inflate-type-tiny.t000644 000765 000024 00000001304 12554014037 020130 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package TypeOMatic; use Moo::Role; use Sub::Quote; use Moo::HandleMoose (); use Types::Standard qw(Str); has consumed_type => ( is => 'ro', isa => Str, ); package TypeOMatic::Consumer; # do this as late as possible to simulate "real" behaviour use Moo::HandleMoose; use Moose; use Types::Standard qw(Str); with 'TypeOMatic'; has direct_type => ( is => 'ro', isa => Str, ); } my $meta = Class::MOP::class_of('TypeOMatic::Consumer'); for my $attr (qw(consumed_type direct_type)) { my $type = $meta->get_attribute($attr)->type_constraint; isa_ok($type, 'Type::Tiny'); is($type->name, 'Str'); } done_testing; Moo-2.000002/xt/type-inflate.t000644 000765 000024 00000003515 12554014037 016176 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package TypeOMatic; use Moo::Role; use Sub::Quote; use Moo::HandleMoose (); sub Str { my $type = sub { die unless defined $_[0] && !ref $_[0]; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { require Moose::Util::TypeConstraints; Moose::Util::TypeConstraints::find_type_constraint("Str"); }; return ($type, @_); } sub PositiveInt { my $type = sub { die unless defined $_[0] && !ref $_[0] && $_[0] =~ /^-?\d+/; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { require Moose::Util::TypeConstraints; require MooseX::Types::Common::Numeric; Moose::Util::TypeConstraints::find_type_constraint( "MooseX::Types::Common::Numeric::PositiveInt"); }; return ($type, @_); } has named_type => ( is => 'ro', isa => Str, ); has named_external_type => ( is => 'ro', isa => PositiveInt, ); package TypeOMatic::Consumer; # do this as late as possible to simulate "real" behaviour use Moo::HandleMoose; use Moose; with 'TypeOMatic'; } my $meta = Class::MOP::class_of('TypeOMatic::Consumer'); my ($str, $positive_int) = map $meta->get_attribute($_)->type_constraint->name, qw(named_type named_external_type); is($str, 'Str', 'Built-in Moose type ok'); is( $positive_int, 'MooseX::Types::Common::Numeric::PositiveInt', 'External (MooseX::Types type) ok' ); local $@; eval q { package Fooble; use Moo; my $isa = sub { 1 }; $Moo::HandleMoose::TYPE_MAP{$isa} = sub { $isa }; has barble => (is => "ro", isa => $isa); __PACKAGE__->meta->get_attribute("barble"); }; like( $@, qr/^error inflating attribute 'barble' for package 'Fooble': \$TYPE_MAP\{CODE\(\w+?\)\} did not return a valid type constraint/, 'error message for incorrect type constraint inflation', ); done_testing; Moo-2.000002/xt/type-tiny-coerce.t000644 000765 000024 00000000531 12554014037 016770 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Goo; use Moo; use Types::Standard qw(Int Num); has foo => ( is => 'ro', isa => Int->plus_coercions(Num, q{ int($_) }), coerce => 1, ); } my $obj = Goo->new( foo => 3.14159, ); is($obj->foo, '3', 'Type::Tiny coercion applied with coerce => 1'); done_testing; Moo-2.000002/xt/withautoclean.t000644 000765 000024 00000000361 12462016515 016441 0ustar00gknopstaff000000 000000 use strict; use warnings; use FindBin qw/ $Bin /; use lib "$Bin/lib"; use Test::More; use_ok 'withautoclean::Class'; my $o = withautoclean::Class->new(_ctx => 1); $o->_clear_ctx; is $o->_ctx, undef, 'modified method works'; done_testing; Moo-2.000002/xt/lib/ExampleMooRole.pm000644 000765 000024 00000000127 12462016251 017376 0ustar00gknopstaff000000 000000 package ExampleMooRole; use Moo::Role; $::ExampleMooRole_LOADED++; no Moo::Role; 1; Moo-2.000002/xt/lib/ExampleMooRoleWithAttribute.pm000644 000765 000024 00000000521 12462016251 022114 0ustar00gknopstaff000000 000000 package ExampleMooRoleWithAttribute;; use Moo::Role; # Note that autoclean here is the key bit! # It causes the metaclass to be loaded and used before the 'has' fires # so Moo needs to blow it away again at that point so the attribute gets # added use namespace::autoclean; has output_to => ( is => 'ro', required => 1, ); 1; Moo-2.000002/xt/lib/ExampleMooseRoleOne.pm000644 000765 000024 00000000063 12462016251 020367 0ustar00gknopstaff000000 000000 package ExampleMooseRoleOne; use Moose::Role; 1; Moo-2.000002/xt/lib/ExampleMooseRoleTwo.pm000644 000765 000024 00000000063 12462016251 020417 0ustar00gknopstaff000000 000000 package ExampleMooseRoleTwo; use Moose::Role; 1; Moo-2.000002/xt/lib/withautoclean/000755 000765 000024 00000000000 12554434146 017030 5ustar00gknopstaff000000 000000 Moo-2.000002/xt/lib/withautoclean/Class.pm000644 000765 000024 00000000146 12462016251 020423 0ustar00gknopstaff000000 000000 package withautoclean::Class; use Moo; with 'withautoclean::R1'; before _clear_ctx => sub { }; 1; Moo-2.000002/xt/lib/withautoclean/R1.pm000644 000765 000024 00000000554 12462016251 017643 0ustar00gknopstaff000000 000000 package withautoclean::R1; use Moo::Role; # Doing this (or loading a class which is built with Moose) # and then loading autoclean - everything breaks... use Moose (); use namespace::autoclean; # Wouldn't happen normally, but is likely to as you part-port something. has _ctx => ( is => 'ro', default => sub { }, clearer => '_clear_ctx', ); 1; Moo-2.000002/t/accessor-coerce.t000644 000765 000024 00000005355 12554014037 016451 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use lib "t/lib"; use ComplexWriter; sub run_for { my $class = shift; my $obj = $class->new(plus_three => 1); is($obj->plus_three, 4, "initial value set (${class})"); $obj->plus_three(4); is($obj->plus_three, 7, 'Value changes after set'); } sub run_with_default_for { my $class = shift; my $obj = $class->new(); is($obj->plus_three, 4, "initial value set (${class})"); $obj->plus_three(4); is($obj->plus_three, 7, 'Value changes after set'); } { package Foo; use Moo; has plus_three => ( is => 'rw', coerce => sub { $_[0] + 3 } ); } run_for 'Foo'; { package Bar; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', coerce => quote_sub q{ my ($x) = @_; $x + 3 } ); } run_for 'Bar'; { package Baz; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', coerce => quote_sub( q{ my ($value) = @_; $value + $plus }, { '$plus' => \3 } ) ); } run_for 'Baz'; { package Biff; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', coerce => quote_sub( q{ die 'could not add three!' }, ) ); } like exception { Biff->new(plus_three => 1) }, qr/coercion for "plus_three" failed: could not add three!/, 'Exception properly thrown'; { package Foo2; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => sub { $_[0] + 3 } ); } run_with_default_for 'Foo2'; { package Bar2; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub q{ my ($x) = @_; $x + 3 } ); } run_with_default_for 'Bar2'; { package Baz2; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub( q{ my ($value) = @_; $value + $plus }, { '$plus' => \3 } ) ); } run_with_default_for 'Baz2'; { package Biff2; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub( q{ die 'could not add three!' }, ) ); } like exception { Biff2->new() }, qr/could not add three!/, 'Exception properly thrown'; { package Foo3; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => sub { $_[0] + 3 }, lazy => 1, ); } run_with_default_for 'Foo3'; { package Bar3; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub(q{ my ($x) = @_; $x + 3 }), lazy => 1, ); } run_with_default_for 'Bar3'; ComplexWriter->test_with("coerce"); done_testing; Moo-2.000002/t/accessor-default.t000644 000765 000024 00000006035 12554014037 016631 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; my $c_ran; { package Foo; use Sub::Quote; use Moo; has one => (is => 'ro', lazy => 1, default => quote_sub q{ {} }); has two => (is => 'ro', lazy => 1, builder => '_build_two'); sub _build_two { {} } has three => (is => 'ro', default => quote_sub q{ {} }); has four => (is => 'ro', builder => '_build_four'); sub _build_four { {} } has five => (is => 'ro', init_arg => undef, default => sub { {} }); has six => (is => 'ro', builder => 1); sub _build_six { {} } has seven => (is => 'ro', required => 1, default => quote_sub q{ {} }); has eight => (is => 'ro', builder => '_build_eight', coerce => sub { $c_ran = 1; $_[0] }); sub _build_eight { {} } has nine => (is => 'lazy', coerce => sub { $c_ran = 1; $_[0] }); sub _build_nine { {} } has ten => (is => 'lazy', default => 5 ); has eleven => (is => 'ro', default => 5 ); has twelve => (is => 'lazy', default => 0 ); has thirteen => (is => 'ro', default => 0 ); has fourteen => (is => 'ro', required => 1, builder => '_build_fourteen'); sub _build_fourteen { {} } has fifteen => (is => 'lazy', default => undef); # DIE handler was leaking into defaults when coercion is on. has default_with_coerce => ( is => 'rw', coerce => sub { return $_[0] }, default => sub { eval { die "blah\n" }; return $@; } ); has default_no_coerce => ( is => 'rw', default => sub { eval { die "blah\n" }; return $@; } ); } sub check { my ($attr, @h) = @_; is_deeply($h[$_], {}, "${attr}: empty hashref \$h[$_]") for 0..1; isnt($h[0],$h[1], "${attr}: not the same hashref"); } check one => map Foo->new->one, 1..2; check two => map Foo->new->two, 1..2; check three => map Foo->new->{three}, 1..2; check four => map Foo->new->{four}, 1..2; check five => map Foo->new->{five}, 1..2; check six => map Foo->new->{six}, 1..2; check seven => map Foo->new->{seven}, 1..2; check fourteen => map Foo->new->{fourteen}, 1..2; check eight => map Foo->new->{eight}, 1..2; ok($c_ran, 'coerce defaults'); $c_ran = 0; check nine => map Foo->new->nine, 1..2; ok($c_ran, 'coerce lazy default'); is(Foo->new->ten, 5, 'non-ref default'); is(Foo->new->eleven, 5, 'eager non-ref default'); is(Foo->new->twelve, 0, 'false non-ref default'); is(Foo->new->thirteen, 0, 'eager false non-ref default'); my $foo = Foo->new; is($foo->fifteen, undef, 'undef default'); ok(exists $foo->{fifteen}, 'undef default is stored'); is( Foo->new->default_with_coerce, "blah\n", "exceptions in defaults not modified with coerce" ); is( Foo->new->default_no_coerce, "blah\n", "exceptions in defaults not modified without coerce" ); { package Bar; use Moo; has required_false_default => (is => 'ro', required => 1, default => 0); ::is ::exception { has required_is_lazy_no_init_arg => ( is => 'lazy', required => 1, init_arg => undef, ); }, undef, 'is => lazy satisfies requires'; } is exception { Bar->new }, undef, 'required attributes with false defaults work'; done_testing; Moo-2.000002/t/accessor-generator-extension.t000644 000765 000024 00000004321 12554014037 021201 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; BEGIN { package Method::Generate::Accessor::Role::ArrayRefInstance; use Moo::Role; sub _generate_simple_get { my ($self, $me, $name, $spec) = @_; "${me}->[${\$spec->{index}}]"; } sub _generate_core_set { my ($self, $me, $name, $spec, $value) = @_; "${me}->[${\$spec->{index}}] = $value"; } sub _generate_simple_has { my ($self, $me, $name, $spec) = @_; "defined ${me}->[${\$spec->{index}}]"; } sub _generate_simple_clear { my ($self, $me, $name, $spec) = @_; "undef(${me}->[${\$spec->{index}}])"; } sub generate_multi_set { my ($self, $me, $to_set, $from, $specs) = @_; "\@{${me}}[${\join ', ', map $specs->{$_}{index}, @$to_set}] = $from"; } sub _generate_xs { my ($self, $type, $into, $name, $slot, $spec) = @_; require Class::XSAccessor::Array; Class::XSAccessor::Array->import( class => $into, $type => { $name => $spec->{index} } ); $into->can($name); } sub default_construction_string { '[]' } sub MooX::ArrayRef::import { Moo::Role->apply_roles_to_object( Moo->_accessor_maker_for(scalar caller), 'Method::Generate::Accessor::Role::ArrayRefInstance' ); } $INC{"MooX/ArrayRef.pm"} = 1; } { package ArrayTest1; use Moo; use MooX::ArrayRef; has one => (is => 'ro'); has two => (is => 'ro'); has three => (is => 'ro'); } my $o = ArrayTest1->new(one => 1, two => 2, three => 3); is_deeply([ @$o ], [ 1, 2, 3 ], 'Basic object ok'); { package ArrayTest2; use Moo; extends 'ArrayTest1'; has four => (is => 'ro'); } $o = ArrayTest2->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object ok'); { package ArrayTestRole; use Moo::Role; has four => (is => 'ro'); package ArrayTest3; use Moo; extends 'ArrayTest1'; with 'ArrayTestRole'; } $o = ArrayTest3->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object w/role'); my $c = Moo::Role->create_class_with_roles('ArrayTest1', 'ArrayTestRole'); $o = $c->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Generated subclass object w/role'); done_testing; Moo-2.000002/t/accessor-handles.t000644 000765 000024 00000004242 12554014037 016621 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use lib "t/lib"; { package Baz; use Moo; sub beep {'beep'} sub is_passed_undefined { !defined($_[0]) ? 'bar' : 'fail' } } { package Robot; use Moo::Role; requires 'smash'; $INC{"Robot.pm"} = 1; } { package Foo; use Moo; with 'Robot'; sub one {1} sub two {2} sub smash {'smash'} sub yum {$_[1]} } { package Bar; use Moo; has foo => ( is => 'ro', handles => [ qw(one two) ] ); has foo2 => ( is => 'ro', handles => { un => 'one' } ); has foo3 => ( is => 'ro', handles => 'Robot' ); has foo4 => ( is => 'ro', handles => { eat_curry => [ yum => 'Curry!' ], }); has foo5 => ( is => 'ro', handles => 'ExtRobot' ); has foo6 => ( is => 'rw', handles => { foobot => '${\\Baz->can("beep")}'}, default => sub { 0 } ); has foo7 => ( is => 'rw', handles => { foobar => '${\\Baz->can("is_passed_undefined")}'}, default => sub { undef } ); } my $bar = Bar->new( foo => Foo->new, foo2 => Foo->new, foo3 => Foo->new, foo4 => Foo->new, foo5 => Baz->new ); is $bar->one, 1, 'handles works'; is $bar->two, 2, 'handles works for more than one method'; is $bar->un, 1, 'handles works for aliasing a method'; is $bar->smash, 'smash', 'handles works for a role'; is $bar->beep, 'beep', 'handles loads roles'; is $bar->eat_curry, 'Curry!', 'handles works for currying'; is $bar->foobot, 'beep', 'asserter checks for existence not truth, on false value'; is $bar->foobar, 'bar', 'asserter checks for existence not truth, on undef '; ok(my $e = exception { package Baz; use Moo; has foo => ( is => 'ro', handles => 'Robot' ); sub smash { 1 }; }, 'handles will not overwrite locally defined method'); like $e, qr{You cannot overwrite a locally defined method \(smash\) with a delegation}, '... and has correct error message'; is exception { package Buzz; use Moo; has foo => ( is => 'ro', handles => 'Robot' ); sub smash; }, undef, 'handles can overwrite predeclared subs'; ok(exception { package Fuzz; use Moo; has foo => ( is => 'ro', handles => $bar ); }, 'invalid handles throws exception'); done_testing; Moo-2.000002/t/accessor-isa.t000644 000765 000024 00000010503 12554014037 015754 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use lib "t/lib"; use ComplexWriter; sub run_for { my $class = shift; my $obj = $class->new(less_than_three => 1); is($obj->less_than_three, 1, "initial value set (${class})"); like( exception { $obj->less_than_three(4) }, qr/isa check for "less_than_three" failed: 4 is not less than three/, "exception thrown on bad set (${class})" ); is($obj->less_than_three, 1, "initial value remains after bad set (${class})"); my $ret; is( exception { $ret = $obj->less_than_three(2) }, undef, "no exception on correct set (${class})" ); is($ret, 2, "correct setter return (${class})"); is($obj->less_than_three, 2, "correct getter return (${class})"); is(exception { $class->new }, undef, "no exception with no value (${class})"); like( exception { $class->new(less_than_three => 12) }, qr/isa check for "less_than_three" failed: 12 is not less than three/, "exception thrown on bad constructor arg (${class})" ); } { package Foo; use Moo; has less_than_three => ( is => 'rw', isa => sub { die "$_[0] is not less than three" unless $_[0] < 3 } ); } run_for 'Foo'; { package Bar; use Sub::Quote; use Moo; has less_than_three => ( is => 'rw', isa => quote_sub q{ my ($x) = @_; die "$x is not less than three" unless $x < 3 } ); } run_for 'Bar'; { package Baz; use Sub::Quote; use Moo; has less_than_three => ( is => 'rw', isa => quote_sub( q{ my ($value) = @_; die "$value is not less than ${word}" unless $value < $limit }, { '$limit' => \3, '$word' => \'three' } ) ); } run_for 'Baz'; my $lt3; { package LazyFoo; use Sub::Quote; use Moo; has less_than_three => ( is => 'lazy', isa => quote_sub(q{ die "$_[0] is not less than three" unless $_[0] < 3 }) ); sub _build_less_than_three { $lt3 } } $lt3 = 4; my $lazyfoo = LazyFoo->new; like( exception { $lazyfoo->less_than_three }, qr/isa check for "less_than_three" failed: 4 is not less than three/, "exception thrown on bad builder return value (LazyFoo)" ); $lt3 = 2; is( exception { $lazyfoo->less_than_three }, undef, 'Corrected builder value on existing object returned ok' ); is(LazyFoo->new->less_than_three, 2, 'Correct builder value returned ok'); { package Fizz; use Moo; has attr1 => ( is => 'ro', isa => sub { no warnings 'once'; my $attr = $Method::Generate::Accessor::CurrentAttribute; die bless [@$attr{'name', 'init_arg', 'step'}], 'MyException'; }, init_arg => 'attr_1', ); } my $e = exception { Fizz->new(attr_1 => 5) }; is( ref($e), 'MyException', 'Exception objects passed though correctly', ); is($e->[0], 'attr1', 'attribute name available in isa check'); is($e->[1], 'attr_1', 'attribute init_arg available in isa check'); is($e->[2], 'isa check', 'step available in isa check'); { my $called; local $SIG{__DIE__} = sub { $called++; die $_[0] }; my $e = exception { Fizz->new(attr_1 => 5) }; ok($called, '__DIE__ handler called if set') } { package ClassWithDeadlyIsa; use Moo; has foo => (is => 'ro', isa => sub { die "nope" }); package ClassUsingDeadlyIsa; use Moo; has bar => (is => 'ro', coerce => sub { ClassWithDeadlyIsa->new(foo => $_[0]) }); } like exception { ClassUsingDeadlyIsa->new(bar => 1) }, qr/isa check for "foo" failed: nope/, 'isa check within isa check produces correct exception'; ComplexWriter->test_with("isa"); { package ClassWithEvilDestroy; sub new { bless {}, $_[0] } sub DESTROY { eval { 1; # nop }; } package ClassWithEvilException; use Moo; has foo => (is => 'rw', isa => sub { local $@; die "welp"; }); has bar => (is => 'rw', isa => sub { my $o = ClassWithEvilDestroy->new; die "welp"; }); my $error; has baz => (is => 'rw', isa => sub { ::is $@, $error, '$@ unchanged inside isa'; 1; }); my $o = ClassWithEvilException->new; ::like ::exception { $o->foo(1) }, qr/isa check for "foo" failed:/, 'got proper exception with localized $@'; ::like ::exception { $o->bar(1) }, qr/isa check for "bar" failed:/, 'got proper exception with eval in DESTROY'; eval { die "blah\n" }; $error = $@; $o->baz(1); ::is $@, $error, '$@ unchanged after successful isa'; } done_testing; Moo-2.000002/t/accessor-mixed.t000644 000765 000024 00000001700 12554014037 016305 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; my @result; { package Foo; use Moo; my @isa = (isa => sub { push @result, 'isa', $_[0] }); my @trigger = (trigger => sub { push @result, 'trigger', $_[1] }); sub _mkdefault { my $val = shift; (default => sub { push @result, 'default', $val; $val; }) } has a1 => ( is => 'rw', @isa ); has a2 => ( is => 'rw', @isa, @trigger ); has a3 => ( is => 'rw', @isa, @trigger ); has a4 => ( is => 'rw', @trigger, _mkdefault('a4') ); has a5 => ( is => 'rw', @trigger, _mkdefault('a5') ); has a6 => ( is => 'rw', @isa, @trigger, _mkdefault('a6') ); has a7 => ( is => 'rw', @isa, @trigger, _mkdefault('a7') ); } my $foo = Foo->new(a1 => 'a1', a2 => 'a2', a4 => 'a4', a6 => 'a6'); is_deeply( \@result, [ qw(isa a1 isa a2 trigger a2 trigger a4 default a5 isa a6 trigger a6 default a7 isa a7) ], 'Stuff fired in expected order' ); done_testing; Moo-2.000002/t/accessor-pred-clear.t000644 000765 000024 00000001403 12554014037 017215 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Foo; use Moo; my @params = (is => 'ro', lazy => 1, default => sub { 3 }); has one => (@params, predicate => 'has_one', clearer => 'clear_one'); has $_ => (@params, clearer => 1, predicate => 1) for qw( bar _bar ); } my $foo = Foo->new; for ( qw( one bar _bar ) ) { my ($lead, $middle) = ('_' x /^_/, '_' x !/^_/); my $predicate = $lead . "has$middle$_"; my $clearer = $lead . "clear$middle$_"; ok(!$foo->$predicate, 'empty'); is($foo->$_, 3, 'lazy default'); ok($foo->$predicate, 'not empty now'); is($foo->$clearer, 3, 'clearer returns value'); ok(!$foo->$predicate, 'clearer empties'); is($foo->$_, 3, 'default re-fired'); ok($foo->$predicate, 'not empty again'); } done_testing; Moo-2.000002/t/accessor-reader-writer.t000644 000765 000024 00000002676 12554014037 017770 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; my @result; { package Foo; use Moo; has one => ( is => 'rw', reader => 'get_one', writer => 'set_one', ); sub one {'sub'} has two => ( is => 'lazy', default => sub { 2 }, reader => 'get_two', ); has three => ( is => 'rwp', reader => 'get_three', writer => 'set_three', ); } { package Bar; use Moo; has two => ( is => 'rw', accessor => 'TWO', ); } my $foo = Foo->new(one => 'lol'); my $bar = Bar->new(two => '...'); is( $foo->get_one, 'lol', 'reader works' ); $foo->set_one('rofl'); is( $foo->get_one, 'rofl', 'writer works' ); is( $foo->one, 'sub', 'reader+writer = no accessor' ); is( $foo->get_two, 2, 'lazy doesn\'t override reader' ); is( $foo->can('two'), undef, 'reader+ro = no accessor' ); ok( $foo->can('get_three'), 'rwp doesn\'t override reader'); ok( $foo->can('set_three'), 'rwp doesn\'t override writer'); ok( exception { $foo->get_one('blah') }, 'reader dies on write' ); is( $bar->TWO, '...', 'accessor works for reading' ); $bar->TWO('!!!'); is( $bar->TWO, '!!!', 'accessor works for writing' ); { package Baz; use Moo; ::is(::exception { has '@three' => ( is => 'lazy', default => sub { 3 }, reader => 'three', ); }, undef, 'declaring non-identifier attribute with proper reader works'); } is( Baz->new->three, 3, '... and reader works'); done_testing; Moo-2.000002/t/accessor-roles.t000644 000765 000024 00000003273 12554014037 016332 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Sub::Quote; { package One; use Moo; has one => (is => 'ro', default => sub { 'one' }); package One::P1; use Moo::Role; has two => (is => 'ro', default => sub { 'two' }); package One::P2; use Moo::Role; has three => (is => 'ro', default => sub { 'three' }); has four => (is => 'ro', lazy => 1, default => sub { 'four' }, predicate => 1); package One::P3; use Moo::Role; has '+three' => (is => 'ro', default => sub { 'three' }); } my $combined = Moo::Role->create_class_with_roles('One', qw(One::P1 One::P2)); isa_ok $combined, "One"; ok $combined->does($_), "Does $_" for qw(One::P1 One::P2); ok !$combined->does('One::P3'), 'Does not One::P3'; my $c = $combined->new; is $c->one, "one", "attr default set from class"; is $c->two, "two", "attr default set from role"; is $c->three, "three", "attr default set from role"; { package Deux; use Moo; with 'One::P1'; ::like( ::exception { has two => (is => 'ro', default => sub { 'II' }); }, qr{^You cannot overwrite a locally defined method \(two\) with a reader}, 'overwriting accesssors with roles fails' ); } { package Two; use Moo; with 'One::P1'; has '+two' => (is => 'ro', default => sub { 'II' }); } is(Two->new->two, 'II', "overwriting accessors using +attr works"); my $o = One->new; Moo::Role->apply_roles_to_object($o, 'One::P2'); is($o->three, 'three', 'attr default set from role applied to object'); ok(!$o->has_four, 'lazy attr default not set on apply'); $o = $combined->new(three => '3'); Moo::Role->apply_roles_to_object($o, 'One::P3'); is($o->three, '3', 'attr default not used when already set when role applied to object'); done_testing; Moo-2.000002/t/accessor-shortcuts.t000644 000765 000024 00000002061 12554014037 017236 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; my $test = "test"; my $lazy_default = "lazy_default"; { package Foo; use Moo; has rwp => (is => 'rwp'); has lazy => (is => 'lazy'); sub _build_lazy { $test } has lazy_default => (is => 'lazy', default => sub { $lazy_default }); } my $foo = Foo->new; # rwp { is $foo->rwp, undef, "rwp value starts out undefined"; ok exception { $foo->rwp($test) }, "rwp is read_only"; is exception { $foo->_set_rwp($test) }, undef, "rwp can be set by writer"; is $foo->rwp, $test, "rwp value was set by writer"; } # lazy { is $foo->{lazy}, undef, "lazy value storage is undefined"; is $foo->lazy, $test, "lazy value returns test value when called"; ok exception { $foo->lazy($test) }, "lazy is read_only"; } # lazy + default { is $foo->{lazy_default}, undef, "lazy_default value storage is undefined"; is $foo->lazy_default, $lazy_default, "lazy_default value returns test value when called"; ok exception { $foo->lazy_default($test) }, "lazy_default is read_only"; } done_testing; Moo-2.000002/t/accessor-trigger.t000644 000765 000024 00000003161 12554014037 016645 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use lib "t/lib"; use ComplexWriter; our @tr; sub run_for { my $class = shift; @tr = (); my $obj = $class->new; ok(!@tr, "${class}: trigger not fired with no value"); $obj = $class->new(one => 1); is_deeply(\@tr, [ 1 ], "${class}: trigger fired on new"); my $res = $obj->one(2); is_deeply(\@tr, [ 1, 2 ], "${class}: trigger fired on set"); is($res, 2, "${class}: return from set ok"); is($obj->one, 2, "${class}: return from accessor ok"); is_deeply(\@tr, [ 1, 2 ], "${class}: trigger not fired for accessor as get"); } { package Foo; use Moo; has one => (is => 'rw', trigger => sub { push @::tr, $_[1] }); } run_for 'Foo'; { package Bar; use Sub::Quote; use Moo; has one => (is => 'rw', trigger => quote_sub q{ push @::tr, $_[1] }); } run_for 'Bar'; { package Baz; use Sub::Quote; use Moo; has one => ( is => 'rw', trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr }) ); } run_for 'Baz'; { package Default; use Sub::Quote; use Moo; has one => ( is => 'rw', trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr }), default => sub { 0 } ); } run_for 'Default'; { package LazyDefault; use Sub::Quote; use Moo; has one => ( is => 'rw', trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr }), default => sub { 0 }, lazy => 1 ); } run_for 'LazyDefault'; { package Shaz; use Moo; has one => (is => 'rw', trigger => 1 ); sub _trigger_one { push @::tr, $_[1] } } run_for 'Shaz'; ComplexWriter->test_with("trigger"); done_testing; Moo-2.000002/t/accessor-weaken-pre-5_8_3.t000644 000765 000024 00000000322 12554014037 020047 0ustar00gknopstaff000000 000000 use Moo::_strictures; BEGIN { $ENV{MOO_TEST_PRE_583} = 1; } (my $real_test = __FILE__) =~ s/-pre-5_8_3//; unless (defined do $real_test) { die "$real_test: $@" if $@; die "$real_test: $!" if $!; } Moo-2.000002/t/accessor-weaken.t000644 000765 000024 00000004057 12554014037 016461 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Moo::_Utils; ok(Moo::_Utils::lt_5_8_3, "pretending to be pre-5.8.3") if $ENV{MOO_TEST_PRE_583}; { package Foo; use Moo; has one => (is => 'rw', weak_ref => 1); has four=> (is => 'rw', weak_ref => 1, writer => 'set_four'); package Foo2; use Moo; our $preexist = {}; has one => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { $preexist }); has two => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { {} }); } my $ref = {}; my $foo = Foo->new(one => $ref); is($foo->one, $ref, 'value present'); ok(Scalar::Util::isweak($foo->{one}), 'value weakened'); undef $ref; ok(!defined $foo->{one}, 'weak value gone'); my $foo2 = Foo2->new; ok(my $ref2 = $foo2->one, 'external value returned'); is($foo2->one, $ref2, 'value maintained'); ok(Scalar::Util::isweak($foo2->{one}), 'value weakened'); is($foo2->one($ref2), $ref2, 'value returned from setter'); undef $ref2; ok(!defined $foo->{one}, 'weak value gone'); is($foo2->two, undef, 'weak+lazy ref not returned'); is($foo2->{two}, undef, 'internal value not set'); my $ref3 = {}; is($foo2->two($ref3), $ref3, 'value returned from setter'); undef $ref3; ok(!defined $foo->{two}, 'weak value gone'); my $ref4 = {}; my $foo4 = Foo->new; $foo4->set_four($ref4); is($foo4->four, $ref4, 'value present'); ok(Scalar::Util::isweak($foo4->{four}), 'value weakened'); undef $ref4; ok(!defined $foo4->{four}, 'weak value gone'); # test readonly SVs sub mk_ref { \ 'yay' }; my $foo_ro = eval { Foo->new(one => mk_ref()) }; if ($] < 5.008003) { like( $@, qr/\QReference to readonly value in "one" can not be weakened on Perl < 5.8.3/, 'Expected exception thrown on old perls' ); } elsif ($^O eq 'cygwin' and $] < 5.012000) { SKIP: { skip 'Static coderef reaping seems nonfunctional on cygwin < 5.12', 1 } } else { is(${$foo_ro->one},'yay', 'value present'); ok(Scalar::Util::isweak($foo_ro->{one}), 'value weakened'); { no warnings 'redefine'; *mk_ref = sub {} } ok (!defined $foo_ro->{one}, 'optree reaped, ro static value gone'); } done_testing; Moo-2.000002/t/buildall-subconstructor.t000644 000765 000024 00000003236 12554014037 020272 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; my @ran; { package Foo; use Moo; sub BUILD { push @ran, 'Foo' } package Bar; use Moo; extends 'Foo'; sub BUILD { push @ran, 'Bar' } package Baz; use Moo; extends 'Bar'; package Quux; use Moo; extends 'Baz'; sub BUILD { push @ran, 'Quux' } } { package Fleem; use Moo; extends 'Quux'; has 'foo' => (is => 'ro'); sub BUILD { push @ran, $_[0]->foo, $_[1]->{bar} } } { package Odd1; use Moo; has 'odd1' => (is => 'ro'); sub BUILD { push @ran, 'Odd1' } package Odd2; use Moo; extends 'Odd1'; package Odd3; use Moo; extends 'Odd2'; has 'odd3' => (is => 'ro'); sub BUILD { push @ran, 'Odd3' } } { package Sub1; use Moo; has 'foo' => (is => 'ro'); package Sub2; use Moo; extends 'Sub1'; sub BUILD { push @ran, "sub2" } } my @tests = ( 'Foo' => { ran => [qw( Foo )], }, 'Bar' => { ran => [qw( Foo Bar )], }, 'Baz' => { ran => [qw( Foo Bar )], }, 'Quux' => { ran => [qw( Foo Bar Quux )], }, 'Fleem' => { ran => [qw( Foo Bar Quux Fleem1 Fleem2 )], args => [ foo => 'Fleem1', bar => 'Fleem2' ], }, 'Odd1' => { ran => [qw( Odd1 )], }, 'Odd2' => { ran => [qw( Odd1 )], }, 'Odd3' => { ran => [qw( Odd1 Odd3 )], args => [ odd1 => 1, odd3 => 3 ], }, 'Sub1' => { ran => [], }, 'Sub2' => { ran => [qw( sub2 )], }, ); while ( my ($class, $conf) = splice(@tests,0,2) ) { my $o = $class->new( @{ $conf->{args} || [] } ); isa_ok($o, $class); is_deeply(\@ran, $conf->{ran}, 'BUILDs ran in order'); @ran = (); } done_testing; Moo-2.000002/t/buildall.t000644 000765 000024 00000003020 12554014037 015164 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; my @ran; { package Foo; use Moo; sub BUILD { push @ran, 'Foo' } package Bar; use Moo; extends 'Foo'; sub BUILD { push @ran, 'Bar' } package Baz; use Moo; extends 'Bar'; package Quux; use Moo; extends 'Baz'; sub BUILD { push @ran, 'Quux' } } { package Fleem; use Moo; extends 'Quux'; has 'foo' => (is => 'ro'); sub BUILD { push @ran, $_[0]->foo, $_[1]->{bar} } } { package Odd1; use Moo; has 'odd1' => (is => 'ro'); sub BUILD { push @ran, 'Odd1' } package Odd2; use Moo; extends 'Odd1'; package Odd3; use Moo; extends 'Odd2'; has 'odd3' => (is => 'ro'); sub BUILD { push @ran, 'Odd3' } } { package Sub1; use Moo; has 'foo' => (is => 'ro'); package Sub2; use Moo; extends 'Sub1'; sub BUILD { push @ran, "sub2" } } my $o = Quux->new; is(ref($o), 'Quux', 'object returned'); is_deeply(\@ran, [ qw(Foo Bar Quux) ], 'BUILDs ran in order'); @ran = (); $o = Fleem->new(foo => 'Fleem1', bar => 'Fleem2'); is(ref($o), 'Fleem', 'object with inline constructor returned'); is_deeply(\@ran, [ qw(Foo Bar Quux Fleem1 Fleem2) ], 'BUILDs ran in order'); @ran = (); $o = Odd3->new(odd1 => 1, odd3 => 3); is(ref($o), 'Odd3', 'Odd3 object constructed'); is_deeply(\@ran, [ qw(Odd1 Odd3) ], 'BUILDs ran in order'); @ran = (); $o = Sub2->new; is(ref($o), 'Sub2', 'Sub2 object constructed'); is_deeply(\@ran, [ qw(sub2) ], 'BUILD ran'); @ran = (); $o = Sub2->new(__no_BUILD__ => 1); is_deeply(\@ran, [], '__no_BUILD__ surpresses BUILD running'); done_testing; Moo-2.000002/t/buildargs-error.t000644 000765 000024 00000000574 12554014037 016512 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package Foo; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); sub BUILDARGS { my ($self, $args) = @_; return %$args } } like( exception { Foo->new({ bar => 1, baz => 1 }) }, qr/BUILDARGS did not return a hashref/, 'Sensible error message' ); done_testing; Moo-2.000002/t/buildargs.t000644 000765 000024 00000006274 12554171504 015371 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Qux; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); package Quux; use Moo; extends qw(Qux); } { package t::non_moo; sub new { my ($class, $arg) = @_; bless { attr => $arg }, $class; } sub attr { shift->{attr} } package t::ext_non_moo::with_attr; use Moo; extends qw( t::non_moo ); has 'attr2' => ( is => 'ro' ); sub BUILDARGS { my ( $class, @args ) = @_; shift @args if @args % 2 == 1; return { @args }; } } { package Foo; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); sub BUILDARGS { my ( $class, @args ) = @_; unshift @args, "bar" if @args % 2 == 1; return $class->SUPER::BUILDARGS(@args); } package Bar; use Moo; extends qw(Foo); } { package Baz; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); around BUILDARGS => sub { my $orig = shift; my ( $class, @args ) = @_; unshift @args, "bar" if @args % 2 == 1; return $class->$orig(@args); }; package Biff; use Moo; extends qw(Baz); } foreach my $class (qw(Foo Bar Baz Biff)) { is( $class->new->bar, undef, "no args" ); is( $class->new( bar => 42 )->bar, 42, "normal args" ); is( $class->new( 37 )->bar, 37, "single arg" ); { my $o = $class->new(bar => 42, baz => 47); is($o->bar, 42, '... got the right bar'); is($o->baz, 47, '... got the right baz'); } { my $o = $class->new(42, baz => 47); is($o->bar, 42, '... got the right bar'); is($o->baz, 47, '... got the right baz'); } } foreach my $class (qw(Qux Quux)) { my $o = $class->new(bar => 42, baz => 47); is($o->bar, 42, '... got the right bar'); is($o->baz, 47, '... got the right baz'); eval { $class->new( 37 ); }; like( $@, qr/Single parameters to new\(\) must be a HASH ref/, "new() requires a list or a HASH ref" ); eval { $class->new( [ 37 ] ); }; like( $@, qr/Single parameters to new\(\) must be a HASH ref/, "new() requires a list or a HASH ref" ); eval { $class->new( bar => 42, baz => 47, 'quux' ); }; like( $@, qr/You passed an odd number of arguments/, "new() requires a list or a HASH ref" ); } my $non_moo = t::non_moo->new( 'bar' ); my $ext_non_moo = t::ext_non_moo::with_attr->new( 'bar', attr2 => 'baz' ); is $non_moo->attr, 'bar', "non-moo accepts params"; is $ext_non_moo->attr, 'bar', "extended non-moo passes params"; is $ext_non_moo->attr2, 'baz', "extended non-moo has own attributes"; { package NoAttr; use Moo; before BUILDARGS => sub { our $buildargs_called++; }; } eval { NoAttr->BUILDARGS( 37 ); }; like( $@, qr/Single parameters to new\(\) must be a HASH ref/, "default BUILDARGS requires a list or a HASH ref" ); $NoAttr::buildargs_called = 0; my $noattr = NoAttr->new({ foo => 'bar' }); is $noattr->{foo}, undef, 'without attributes, no params are stored'; is $NoAttr::buildargs_called, 1, 'BUILDARGS called even without attributes'; done_testing; Moo-2.000002/t/coerce-1.t000644 000765 000024 00000003415 12554014037 015002 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package IntConstraint; use Moo; use overload '&{}' => sub { shift->constraint }, fallback => 1; has constraint => ( is => 'ro', default => sub { sub { $_[0] eq int $_[0] or die } }, ); sub check { my $self = shift; !!eval { $self->constraint->(@_); 1 } } } # First supported interface for coerce=>1. # The type constraint provides an $isa->coerce($value) method. { package IntConstraint::WithCoerceMethod; use Moo; extends qw(IntConstraint); sub coerce { my $self = shift; int($_[0]); } } # First supported interface for coerce=>1. # The type constraint provides an $isa->coercion method # providing a coderef such that $coderef->($value) coerces. { package IntConstraint::WithCoercionMethod; use Moo; extends qw(IntConstraint); has coercion => ( is => 'ro', default => sub { sub { int($_[0]) } }, ); } { package Goo; use Moo; ::like(::exception { has foo => ( is => 'ro', isa => sub { $_[0] eq int $_[0] }, coerce => 1, ); }, qr/Invalid coercion/, 'coerce => 1 not allowed when isa has no coercion'); ::like(::exception { has foo => ( is => 'ro', isa => IntConstraint->new, coerce => 1, ); }, qr/Invalid coercion/, 'coerce => 1 not allowed when isa has no coercion'); has bar => ( is => 'ro', isa => IntConstraint::WithCoercionMethod->new, coerce => 1, ); has baz => ( is => 'ro', isa => IntConstraint::WithCoerceMethod->new, coerce => 1, ); } my $obj = Goo->new( bar => 3.14159, baz => 3.14159, ); is($obj->bar, '3', '$isa->coercion'); is($obj->baz, '3', '$isa->coerce'); done_testing; Moo-2.000002/t/compose-conflicts.t000644 000765 000024 00000007262 12554014037 017037 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; BEGIN { package MethodRole; use Moo::Role; sub method { __PACKAGE__ } } BEGIN { package MethodRole2; use Moo::Role; sub method { __PACKAGE__ } } BEGIN { package MethodClassOver; use Moo; sub method { __PACKAGE__ } with 'MethodRole'; } BEGIN { is +MethodClassOver->new->method, 'MethodClassOver', 'class methods override role methods'; } BEGIN { package MethodRole2; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ } ); } BEGIN { package MethodClassAndRoleAndRole; use Moo; with 'MethodRole'; with 'MethodRole2'; } BEGIN { my $o = is +MethodClassAndRoleAndRole->new->method, 'MethodRole', 'composed methods override later composed methods'; } BEGIN { package MethodClassAndRoles; use Moo; ::like ::exception { with 'MethodRole', 'MethodRole2'; }, qr/^Due to a method name conflict between roles/, 'composing roles with conflicting methods fails'; } BEGIN { package MethodRoleOver; use Moo::Role; sub method { __PACKAGE__ } with 'MethodRole'; } BEGIN { package MethodClassAndRoleOver; use Moo; with 'MethodRoleOver'; } BEGIN { is +MethodClassAndRoleOver->new->method, 'MethodRoleOver', 'composing role methods override composed role methods'; } BEGIN { package MethodClassOverAndRoleOver; use Moo; sub method { __PACKAGE__ } with 'MethodRoleOver'; } BEGIN { is +MethodClassOverAndRoleOver->new->method, 'MethodClassOverAndRoleOver', 'class methods override role and role composed methods'; } BEGIN { package AttrRole; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ } ); } BEGIN { package AttrClassOver; use Moo; has attr => (is => 'rw', coerce => sub { __PACKAGE__ }); with 'AttrRole'; } BEGIN { my $o = AttrClassOver->new(attr => 1); is $o->attr, 'AttrClassOver', 'class attributes override role attributes in constructor'; $o->attr(1); is $o->attr, 'AttrClassOver', 'class attributes override role attributes in accessors'; } BEGIN { package AttrRole2; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ } ); } BEGIN { package AttrClassAndRoleAndRole; use Moo; with 'AttrRole'; with 'AttrRole2'; } BEGIN { my $o = AttrClassAndRoleAndRole->new(attr => 1); is $o->attr, 'AttrRole', 'composed attributes override later composed attributes in constructor'; $o->attr(1); is $o->attr, 'AttrRole', 'composed attributes override later composed attributes in accessors'; } BEGIN { package AttrClassAndRoles; use Moo; ::like ::exception { with 'AttrRole', 'AttrRole2'; }, qr/^Due to a method name conflict between roles/, 'composing roles with conflicting attributes fails'; } BEGIN { package AttrRoleOver; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ }); with 'AttrRole'; } BEGIN { package AttrClassAndRoleOver; use Moo; with 'AttrRoleOver'; } BEGIN { my $o = AttrClassAndRoleOver->new(attr => 1); is $o->attr, 'AttrRoleOver', 'composing role attributes override composed role attributes in constructor'; $o->attr(1); is $o->attr, 'AttrRoleOver', 'composing role attributes override composed role attributes in accessors'; } BEGIN { package AttrClassOverAndRoleOver; use Moo; has attr => (is => 'rw', coerce => sub { __PACKAGE__ }); with 'AttrRoleOver'; } BEGIN { my $o = AttrClassOverAndRoleOver->new(attr => 1); is $o->attr, 'AttrClassOverAndRoleOver', 'class attributes override role and role composed attributes in constructor'; $o->attr(1); is $o->attr, 'AttrClassOverAndRoleOver', 'class attributes override role and role composed attributes in accessors'; } done_testing; Moo-2.000002/t/compose-non-role.t000644 000765 000024 00000000376 12554014037 016603 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; $INC{'MyRole.pm'} = __FILE__; { package MyClass; use Moo; ::like(::exception { with 'MyRole'; }, qr/MyRole is not a Moo::Role/, 'error when composing non-role package'); } done_testing; Moo-2.000002/t/compose-roles.t000644 000765 000024 00000006440 12554014037 016174 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package One; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Two; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Three; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Four; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Base; sub foo { __PACKAGE__ } } foreach my $combo ( [ qw(One Two Three Four) ], [ qw(Two Four Three) ], [ qw(One Two) ] ) { my $combined = Role::Tiny->create_class_with_roles('Base', @$combo); is_deeply( [ $combined->foo ], [ reverse(@$combo), 'Base' ], "${combined} ok" ); my $object = bless({}, 'Base'); Role::Tiny->apply_roles_to_object($object, @$combo); is(ref($object), $combined, 'Object reblessed into correct class'); } { package RoleWithAttr; use Moo::Role; has attr1 => (is => 'ro', default => -1); package RoleWithAttr2; use Moo::Role; has attr2 => (is => 'ro', default => -2); package ClassWithAttr; use Moo; has attr3 => (is => 'ro', default => -3); } Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2'); my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3); is($o->attr1, 1, 'attribute from role works'); is($o->attr2, 2, 'attribute from role 2 works'); is($o->attr3, 3, 'attribute from base class works'); { package SubClassWithoutAttr; use Moo; extends 'ClassWithAttr'; } my $o2 = Moo::Role->create_class_with_roles( 'SubClassWithoutAttr', 'RoleWithAttr')->new; is($o2->attr3, -3, 'constructor includes base class'); is($o2->attr2, -2, 'constructor includes role'); { package AccessorExtension; use Moo::Role; around 'generate_method' => sub { my $orig = shift; my $me = shift; my ($into, $name) = @_; $me->$orig(@_); no strict 'refs'; *{"${into}::_${name}_marker"} = sub { }; }; } { package RoleWithReq; use Moo::Role; requires '_attr1_marker'; } is exception { package ClassWithExtension; use Moo; Moo::Role->apply_roles_to_object( Moo->_accessor_maker_for(__PACKAGE__), 'AccessorExtension'); with qw(RoleWithAttr RoleWithReq); }, undef, 'apply_roles_to_object correctly calls accessor generator'; { package EmptyClass; use Moo; } { package RoleWithReq2; use Moo::Role; requires 'attr2'; } is exception { Moo::Role->create_class_with_roles( 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr2'); }, undef, 'create_class_with_roles accepts attributes for requirements'; like exception { Moo::Role->create_class_with_roles( 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr'); }, qr/Can't apply .* missing attr2/, 'create_class_with_roles accepts attributes for requirements'; { package RoleWith2Attrs; use Moo::Role; has attr1 => (is => 'ro', default => -1); has attr2 => (is => 'ro', default => -2); } foreach my $combo ( [qw(RoleWithAttr RoleWithAttr2)], [qw(RoleWith2Attrs)], ) { is exception { my $o = Moo::Role->apply_roles_to_object( EmptyClass->new, @$combo); is($o->attr1, -1, 'first attribute works'); is($o->attr2, -2, 'second attribute works'); }, undef, "apply_roles_to_object with multiple attrs with defaults (@$combo)"; } done_testing; Moo-2.000002/t/constructor-modify.t000644 000765 000024 00000005157 12554014037 017263 0ustar00gknopstaff000000 000000 use Moo::_strictures; no warnings 'once'; use Test::More; use Test::Fatal; BEGIN { package ClassBakedNew; use Moo; has attr1 => (is => 'ro'); __PACKAGE__->new; ::like ::exception { has attr2 => (is => 'ro'); }, qr/Constructor for ClassBakedNew has been inlined/, 'error when adding attributes with undeferred constructor'; } BEGIN { package ClassExistingNew; use Moo; no warnings 'once'; sub new { our $CALLED++; bless {}, $_[0]; } ::like ::exception { has attr1 => (is => 'ro'); }, qr/Unknown constructor for ClassExistingNew already exists/, 'error when adding attributes with foreign constructor'; } BEGIN { package ClassDeferredNew; use Moo; no warnings 'once'; use Sub::Quote; quote_sub __PACKAGE__ . '::new' => q{ our $CALLED++; bless {}, $_[0]; }; ::like ::exception { has attr1 => (is => 'ro'); }, qr/Unknown constructor for ClassDeferredNew already exists/, 'error when adding attributes with foreign deferred constructor'; } BEGIN { package ClassWithModifier; use Moo; no warnings 'once'; has attr1 => (is => 'ro'); around new => sub { our $CALLED++; my $orig = shift; goto $orig; }; ::like ::exception { has attr2 => (is => 'ro'); }, qr/Constructor for ClassWithModifier has been replaced with an unknown sub/, 'error when adding attributes after applying modifier to constructor'; } BEGIN { package Role1; use Moo::Role; has attr1 => (is => 'ro'); } BEGIN { package ClassWithRoleAttr; use Moo; no warnings 'once'; around new => sub { our $CALLED++; my $orig = shift; goto $orig; }; ::like ::exception { with 'Role1'; }, qr/Unknown constructor for ClassWithRoleAttr already exists/, 'error when adding role with attribute after applying modifier to constructor'; } BEGIN { package RoleModifyNew; use Moo::Role; no warnings 'once'; around new => sub { our $CALLED++; my $orig = shift; goto $orig; }; } BEGIN { package ClassWithModifyRole; use Moo; no warnings 'once'; with 'RoleModifyNew'; ::like ::exception { has attr1 => (is => 'ro'); }, qr/Unknown constructor for ClassWithModifyRole already exists/, 'error when adding attributes after applying modifier to constructor via role'; } BEGIN { package AClass; use Moo; has attr1 => (is => 'ro'); } BEGIN { package ClassWithParent; use Moo; has attr2 => (is => 'ro'); __PACKAGE__->new; ::like ::exception { extends 'AClass'; }, qr/Constructor for ClassWithParent has been inlined/, 'error when changing parent with undeferred constructor'; } done_testing; Moo-2.000002/t/demolish-basics.t000644 000765 000024 00000001543 12554014037 016452 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; our @demolished; package Foo; use Moo; sub DEMOLISH { my $self = shift; push @::demolished, __PACKAGE__; } package Foo::Sub; use Moo; extends 'Foo'; sub DEMOLISH { my $self = shift; push @::demolished, __PACKAGE__; } package Foo::Sub::Sub; use Moo; extends 'Foo::Sub'; sub DEMOLISH { my $self = shift; push @::demolished, __PACKAGE__; } package main; { my $foo = Foo->new; } is_deeply(\@demolished, ['Foo'], "Foo demolished properly"); @demolished = (); { my $foo_sub = Foo::Sub->new; } is_deeply(\@demolished, ['Foo::Sub', 'Foo'], "Foo::Sub demolished properly"); @demolished = (); { my $foo_sub_sub = Foo::Sub::Sub->new; } is_deeply(\@demolished, ['Foo::Sub::Sub', 'Foo::Sub', 'Foo'], "Foo::Sub::Sub demolished properly"); @demolished = (); done_testing; Moo-2.000002/t/demolish-bugs-eats_exceptions.t000644 000765 000024 00000007106 12554014037 021342 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use FindBin; my $FilePath = sub { die "does not pass the type constraint" if $_[0] eq '/' }; { package Baz; use Moo; has 'path' => ( is => 'ro', isa => $FilePath, required => 1, ); sub BUILD { my ( $self, $params ) = @_; die $params->{path} . " does not exist" unless -e $params->{path}; } # Defining this causes the FIRST call to Baz->new w/o param to fail, # if no call to ANY Moo::Object->new was done before. sub DEMOLISH { my ( $self ) = @_; } } { package Qee; use Moo; has 'path' => ( is => 'ro', isa => $FilePath, required => 1, ); sub BUILD { my ( $self, $params ) = @_; die $params->{path} . " does not exist" unless -e $params->{path}; } # Defining this causes the FIRST call to Qee->new w/o param to fail... # if no call to ANY Moo::Object->new was done before. sub DEMOLISH { my ( $self ) = @_; } } { package Foo; use Moo; has 'path' => ( is => 'ro', isa => $FilePath, required => 1, ); sub BUILD { my ( $self, $params ) = @_; die $params->{path} . " does not exist" unless -e $params->{path}; } # Having no DEMOLISH, everything works as expected... } check_em ( 'Baz' ); # 'Baz plain' will fail, aka NO error check_em ( 'Qee' ); # ok check_em ( 'Foo' ); # ok check_em ( 'Qee' ); # 'Qee plain' will fail, aka NO error check_em ( 'Baz' ); # ok check_em ( 'Foo' ); # ok check_em ( 'Foo' ); # ok check_em ( 'Baz' ); # ok ! check_em ( 'Qee' ); # ok sub check_em { my ( $pkg ) = @_; my ( %param, $obj ); # Uncomment to see, that it is really any first call. # Subsequents calls will not fail, aka giving the correct error. { local $@; my $obj = eval { $pkg->new; }; ::like( $@, qr/Missing required argument/, "... $pkg plain" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new(); }; ::like( $@, qr/Missing required argument/, "... $pkg empty" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( notanattr => 1 ); }; ::like( $@, qr/Missing required argument/, "... $pkg undef" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( %param ); }; ::like( $@, qr/Missing required argument/, "... $pkg undef param" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( path => '/' ); }; ::like( $@, qr/does not pass the type constraint/, "... $pkg root path forbidden" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( path => '/this_path/does/not_exist' ); }; ::like( $@, qr/does not exist/, "... $pkg non existing path" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( path => $FindBin::Bin ); }; ::is( $@, '', "... $pkg no error" ); ::isa_ok( $obj, $pkg ); ::isa_ok( $obj, 'Moo::Object' ); ::is( $obj->path, $FindBin::Bin, "... $pkg got the right value" ); } } done_testing; Moo-2.000002/t/demolish-bugs-eats_mini.t000644 000765 000024 00000002414 12554014037 020112 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package Foo; use Moo; has 'bar' => ( is => 'ro', required => 1, ); # Defining this causes the FIRST call to Baz->new w/o param to fail, # if no call to ANY Moo::Object->new was done before. sub DEMOLISH { my ( $self ) = @_; # ... Moo (kinda) eats exceptions in DESTROY/DEMOLISH"; } } { my $obj = eval { Foo->new; }; like( $@, qr/Missing required arguments/, "... Foo plain" ); is( $obj, undef, "... the object is undef" ); } { package Bar; sub new { die "Bar died"; } sub DESTROY { die "Vanilla Perl eats exceptions in DESTROY too"; } } { my $obj = eval { Bar->new; }; like( $@, qr/Bar died/, "... Bar plain" ); is( $obj, undef, "... the object is undef" ); } { package Baz; use Moo; sub DEMOLISH { $? = 0; } } { local $@ = 42; local $? = 84; { Baz->new; } is( $@, 42, '$@ is still 42 after object is demolished without dying' ); is( $?, 84, '$? is still 84 after object is demolished without dying' ); local $@ = 0; { Baz->new; } is( $@, 0, '$@ is still 0 after object is demolished without dying' ); } done_testing; Moo-2.000002/t/demolish-global_destruction.t000644 000765 000024 00000001560 12554014037 021070 0ustar00gknopstaff000000 000000 use Moo::_strictures; no warnings 'once'; use POSIX (); $| = 1; our $fail = 2; our $tests = 0; sub ok { my ($ok, $message) = @_; print +($ok ? '' : 'not ') . 'ok ' . ++$tests . ($message ? " - $message" : '') . "\n"; return $ok; } print "1..2\n"; BEGIN { package Foo; use Moo; sub DEMOLISH { my $self = shift; my ($igd) = @_; ::ok( !$igd, 'in_global_destruction state is passed to DEMOLISH properly (false)' ) and $fail-- ; } } { my $foo = Foo->new; } END { $? = $fail } BEGIN { package Bar; use Moo; sub DEMOLISH { my $self = shift; my ($igd) = @_; ::ok( $igd, 'in_global_destruction state is passed to DEMOLISH properly (true)' ) and $fail--; POSIX::_exit($fail); } } our $bar = Bar->new; Moo-2.000002/t/demolish-throw.t000644 000765 000024 00000002060 12554014037 016344 0ustar00gknopstaff000000 000000 sub clean_die { use warnings; die @_; } use Moo::_strictures; use Test::More; use Test::Fatal; { package Foo; use Moo; sub DEMOLISH { die "Error in DEMOLISH"; } } my @warnings; my @looped_exceptions; my $o = Foo->new; { local $SIG{__WARN__} = sub { push @warnings, $_[0]; }; # make sure we don't loop infinitely my $last_die; local $SIG{__DIE__} = sub { my $location = join(':', caller); if ($last_die && $last_die eq $location) { push @looped_exceptions, $_[0]; clean_die(@_); } $last_die = $location; }; { no warnings FATAL => 'misc'; use warnings 'misc'; undef $o; # if undef is the last statement in a block, its effect is delayed until # after the block is cleaned up (and our warning settings won't be applied) 1; } } like $warnings[0], qr/\(in cleanup\) Error in DEMOLISH/, 'error in DEMOLISH converted to warning'; is scalar @warnings, 1, 'no other warnings generated'; is scalar @looped_exceptions, 0, 'no infinitely looping exception in DESTROY'; done_testing; Moo-2.000002/t/does.t000644 000765 000024 00000001336 12554014037 014336 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; BEGIN { package TestParent; use Moo; } BEGIN { package TestClass; use Moo; extends 'TestParent'; has attr1 => (is => 'ro'); } BEGIN { ok !TestClass->does('TestRole'), "->does returns false for arbitrary role"; ok !$INC{'Moo/Role.pm'}, "Moo::Role not loaded by does"; } BEGIN { package TestRole; use Moo::Role; has attr2 => (is => 'ro'); } BEGIN { package TestClass; with 'TestRole'; } BEGIN { ok +TestClass->does('TestRole'), "->does returns true for composed role"; ok +TestClass->DOES('TestRole'), "->DOES returns true for composed role"; ok +TestClass->DOES('TestParent'), "->DOES returns true for parent class"; } done_testing; Moo-2.000002/t/extend-constructor.t000644 000765 000024 00000001013 12554014037 017246 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; BEGIN { package Role::For::Constructor; use Moo::Role; has extra_param => (is => 'ro'); } BEGIN { package Some::Class; use Moo; BEGIN { my $con = Moo->_constructor_maker_for(__PACKAGE__); Moo::Role->apply_roles_to_object($con, 'Role::For::Constructor'); } } { package Some::SubClass; use Moo; extends 'Some::Class'; ::is(::exception { has bar => (is => 'ro'); }, undef, 'extending constructor generator works'); } done_testing; Moo-2.000002/t/extends-non-moo.t000644 000765 000024 00000003072 12554014037 016435 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package t::moo::extends_non_moo::base; sub new { my ($proto, $args) = @_; bless $args, $proto; } sub to_app { (shift)->{app}; } package t::moo::extends_non_moo::middle; use base qw(t::moo::extends_non_moo::base); sub wrap { my($class, $app) = @_; $class->new({app => $app}) ->to_app; } package t::moo::extends_non_moo::moo; use Moo; extends 't::moo::extends_non_moo::middle'; package t::moo::extends_non_moo::moo_with_attr; use Moo; extends 't::moo::extends_non_moo::middle'; has 'attr' => (is=>'ro'); package t::moo::extends_non_moo::second_level_moo; use Moo; extends 't::moo::extends_non_moo::moo_with_attr'; has 'attr2' => (is=>'ro'); } ok my $app = 100, 'prepared $app'; ok $app = t::moo::extends_non_moo::middle->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; ok $app = t::moo::extends_non_moo::moo->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; ok $app = t::moo::extends_non_moo::moo_with_attr->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; ok $app = t::moo::extends_non_moo::second_level_moo->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; { package BadPrototype; sub new () { bless {}, shift } } { package ExtendBadPrototype; use Moo; ::is(::exception { extends 'BadPrototype'; has attr1 => (is => 'ro'); }, undef, 'extending class with prototype on new'); } done_testing(); Moo-2.000002/t/extends-role.t000644 000765 000024 00000000342 12554014037 016011 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package MyRole; use Moo::Role; } { package MyClass; use Moo; ::isnt ::exception { extends "MyRole"; }, undef, "Can't extend role"; } done_testing; Moo-2.000002/t/foreignbuildargs.t000644 000765 000024 00000002304 12554014037 016726 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package t::non_moo_strict; sub new { my ($class, $arg) = @_; die "invalid arguments: " . join(',', @_[2..$#_]) if @_ > 2; bless { attr => $arg }, $class; } sub attr { shift->{attr} } package t::ext_non_moo_strict::with_attr; use Moo; extends qw( t::non_moo_strict ); has 'attr2' => ( is => 'ro' ); sub FOREIGNBUILDARGS { my ($class, %args) = @_; return $args{attr}; } package t::ext_non_moo_strict::without_attr; use Moo; extends qw( t::non_moo_strict ); sub FOREIGNBUILDARGS { my ($class, %args) = @_; return $args{attr2}; } } my $non_moo = t::non_moo_strict->new( 'bar' ); my $ext_non_moo = t::ext_non_moo_strict::with_attr->new( attr => 'bar', attr2 => 'baz' ); my $ext_non_moo2 = t::ext_non_moo_strict::without_attr->new( attr => 'bar', attr2 => 'baz' ); is $non_moo->attr, 'bar', "non-moo accepts params"; is $ext_non_moo->attr, 'bar', "extended non-moo passes params"; is $ext_non_moo->attr2, 'baz', "extended non-moo has own attributes"; is $ext_non_moo2->attr, 'baz', "extended non-moo passes params"; done_testing; Moo-2.000002/t/global_underscore.t000644 000765 000024 00000000341 12462016515 017071 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use lib qw(t/lib); use_ok('UnderscoreClass'); is( UnderscoreClass->c1, 'c1', ); is( UnderscoreClass->r1, 'r1', ); is( ClobberUnderscore::h1(), 'h1', ); done_testing; Moo-2.000002/t/has-array.t000644 000765 000024 00000002123 12554014037 015266 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; is(exception { package Local::Test::Role1; use Moo::Role; has [qw/ attr1 attr2 /] => (is => 'ro'); }, undef, 'has \@attrs works in roles'); is(exception { package Local::Test::Class1; use Moo; with 'Local::Test::Role1'; has [qw/ attr3 attr4 /] => (is => 'ro'); }, undef, 'has \@attrs works in classes'); my $obj = new_ok 'Local::Test::Class1' => [ attr1 => 1, attr2 => 2, attr3 => 3, attr4 => 4, ]; can_ok( $obj, qw( attr1 attr2 attr3 attr4 ), ); like(exception { package Local::Test::Role2; use Moo::Role; has [qw/ attr1 attr2 /] => (is => 'ro', 'isa'); }, qr/^Invalid options for 'attr1', 'attr2' attribute\(s\): even number of arguments expected, got 3/, 'correct exception when has given bad parameters in role'); like(exception { package Local::Test::Class2; use Moo; has [qw/ attr3 attr4 /] => (is => 'ro', 'isa'); }, qr/^Invalid options for 'attr3', 'attr4' attribute\(s\): even number of arguments expected, got 3/, 'correct exception when has given bad parameters in class'); done_testing; Moo-2.000002/t/has-before-extends.t000644 000765 000024 00000000552 12554014037 017066 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Fail1; use Moo; has 'attr1' => (is => 'ro'); package Fail2; use Moo; has 'attr2' => (is => 'ro'); extends 'Fail1'; } my $new = Fail2->new({ attr1 => 'value1', attr2 => 'value2' }); is($new->attr1, 'value1', 'inherited attr ok'); is($new->attr2, 'value2', 'subclass attr ok'); done_testing; Moo-2.000002/t/has-plus.t000644 000765 000024 00000002265 12554014037 015142 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package RollyRole; use Moo::Role; has f => (is => 'ro', default => sub { 0 }); } { package ClassyClass; use Moo; has f => (is => 'ro', default => sub { 1 }); } { package UsesTheRole; use Moo; with 'RollyRole'; } { package UsesTheRole2; use Moo; with 'RollyRole'; has '+f' => (default => sub { 2 }); } { package ExtendsTheClass; use Moo; extends 'ClassyClass'; has '+f' => (default => sub { 3 }); } { package BlowsUp; use Moo; ::like(::exception { has '+f' => () }, qr/\Qhas '+f'/, 'Kaboom'); } { package ClassyClass2; use Moo; has d => (is => 'ro', default => sub { 4 }); } { package MultiClass; use Moo; extends 'ClassyClass', 'ClassyClass2'; ::is(::exception { has '+f' => (); }, undef, 'extend attribute from first parent'); ::like(::exception { has '+d' => (); }, qr/no d attribute already exists/, 'can\'t extend attribute from second parent'); } is(UsesTheRole->new->f, 0, 'role attr'); is(ClassyClass->new->f, 1, 'class attr'); is(UsesTheRole2->new->f, 2, 'role attr with +'); is(ExtendsTheClass->new->f, 3, 'class attr with +'); done_testing; Moo-2.000002/t/init-arg.t000644 000765 000024 00000003642 12554014037 015120 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; { package Foo; use Moo; has optional => ( is => 'rw', init_arg => 'might_have', isa => sub { die "isa" if $_[0] % 2 }, default => sub { 7 }, ); has lazy => ( is => 'rw', init_arg => 'workshy', isa => sub { die "aieee" if $_[0] % 2 }, default => sub { 7 }, lazy => 1, ); } like( exception { Foo->new }, qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/, "isa default" ); like( exception { Foo->new(might_have => 3) }, qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/, "isa init_arg", ); is( exception { Foo->new(might_have => 2) }, undef, "isa init_arg ok" ); my $foo = Foo->new(might_have => 2); like( exception { $foo->optional(3) }, qr/\Aisa check for "optional" failed:/, "isa accessor", ); like( exception { $foo->lazy }, qr/\Aisa check for "lazy" failed:/, "lazy accessor", ); like( exception { $foo->lazy(3) }, qr/\Aisa check for "lazy" failed:/, "lazy set isa fail", ); is( exception { $foo->lazy(4) }, undef, "lazy set isa ok", ); like( exception { Foo->new(might_have => 2, workshy => 3) }, qr/\Aisa check for "lazy" \(constructor argument: "workshy"\) failed:/, "lazy init_arg", ); { package Bar; use Moo; has sane_key_name => ( is => 'rw', init_arg => 'stupid key name', isa => sub { die "isa" if $_[0] % 2 }, required => 1 ); has sane_key_name2 => ( is => 'rw', init_arg => 'complete\nnonsense\\\'key', isa => sub { die "isa" if $_[0] % 2 }, required => 1 ); } my $bar; is( exception { $bar= Bar->new( 'stupid key name' => 4, 'complete\nnonsense\\\'key' => 6 ) }, undef, 'requiring init_arg with spaces and insanity', ); is( $bar->sane_key_name, 4, 'key renamed correctly' ); is( $bar->sane_key_name2, 6, 'key renamed correctly' ); done_testing; Moo-2.000002/t/isa-interfere.t000644 000765 000024 00000001137 12554014037 016140 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Moo (); BEGIN { package BaseClass; sub new { my $class = shift; my $self = bless {}, $class; return $self; } } BEGIN { package ExtraClass; sub new { my $class = shift; $class->next::method(@_); } } BEGIN { package ChildClass; use Moo; extends 'BaseClass'; unshift our @ISA, 'ExtraClass'; } like exception { ChildClass->new; }, qr/Expected parent constructor of ChildClass expected to be BaseClass, but found ExtraClass/, 'Interfering with @ISA after using extends triggers error'; done_testing; Moo-2.000002/t/lazy_isa.t000644 000765 000024 00000003105 12554014037 015213 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; my $isa_called = 0; { package FooISA; use Moo; my $isa = sub { $isa_called++; die "I want to die" unless $_[0] eq 'live'; }; has a_lazy_attr => ( is => 'ro', isa => $isa, lazy => 1, builder => '_build_attr', ); has non_lazy => ( is => 'ro', isa => $isa, builder => '_build_attr', ); sub _build_attr { 'die' } } ok my $lives = FooISA->new(a_lazy_attr=>'live', non_lazy=>'live'), 'expect to live when both attrs are set to live in init'; my $called_pre = $isa_called; $lives->a_lazy_attr; is $called_pre, $isa_called, 'isa is not called on access when value already exists'; like( exception { FooISA->new(a_lazy_attr=>'live', non_lazy=>'die') }, qr/I want to die/, 'expect to die when non lazy is set to die in init', ); like( exception { FooISA->new(a_lazy_attr=>'die', non_lazy=>'die') }, qr/I want to die/, 'expect to die when non lazy and lazy is set to die in init', ); like( exception { FooISA->new(a_lazy_attr=>'die', non_lazy=>'live') }, qr/I want to die/, 'expect to die when lazy is set to die in init', ); like( exception { FooISA->new() }, qr/I want to die/, 'expect to die when both lazy and non lazy are allowed to default', ); like( exception { FooISA->new(a_lazy_attr=>'live') }, qr/I want to die/, 'expect to die when lazy is set to live but non lazy is allowed to default', ); is( exception { FooISA->new(non_lazy=>'live') }, undef, 'ok when non lazy is set to something valid but lazy is allowed to default', ); done_testing; Moo-2.000002/t/lib/000755 000765 000024 00000000000 12554434146 013771 5ustar00gknopstaff000000 000000 Moo-2.000002/t/load_module.t000644 000765 000024 00000000653 12554014037 015671 0ustar00gknopstaff000000 000000 # this test is replicated to t/load_module_role_tiny.t for Role::Tiny # work around RT#67692 use Moo::_Utils; use Moo::_strictures; use Test::More; use t::lib::INCModule; local @INC = (sub { return unless $_[1] eq 'Foo/Bar.pm'; inc_module("package Foo::Bar; sub baz { 1 } 1"); }, @INC); { package Foo::Bar::Baz; sub quux { } } _load_module("Foo::Bar"); ok(eval { Foo::Bar->baz }, 'Loaded module ok'); done_testing; Moo-2.000002/t/load_module_error.t000644 000765 000024 00000000330 12554014037 017072 0ustar00gknopstaff000000 000000 use Moo::_strictures; package load_module_error; use Test::More; use lib 't/lib'; eval "use sub_class;"; ok $@, "got a crash"; unlike $@, qr/Unknown error/, "it came with a useful error message"; done_testing; Moo-2.000002/t/load_module_role_tiny.t000644 000765 000024 00000000630 12554014037 017750 0ustar00gknopstaff000000 000000 # this test is replicated to t/load_module.t for Moo::_Utils use Role::Tiny (); use Moo::_strictures; use Test::More; use t::lib::INCModule; local @INC = (sub { return unless $_[1] eq 'Foo/Bar.pm'; inc_module("package Foo::Bar; sub baz { 1 } 1"); }, @INC); { package Foo::Bar::Baz; sub quux { } } Role::Tiny::_load_module("Foo::Bar"); ok(eval { Foo::Bar->baz }, 'Loaded module ok'); done_testing; Moo-2.000002/t/method-generate-accessor.t000644 000765 000024 00000012152 12554014037 020252 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Method::Generate::Accessor; use Sub::Quote 'quote_sub'; my $gen = Method::Generate::Accessor->new; { package Foo; use Moo; } { package WithOverload; use overload '&{}' => sub { sub { 5 } }, fallback => 1; sub new { bless {} } } $gen->generate_method('Foo' => 'one' => { is => 'ro' }); $gen->generate_method('Foo' => 'two' => { is => 'rw' }); like( exception { $gen->generate_method('Foo' => 'three' => {}) }, qr/Must have an is/, 'No is rejected' ); like( exception { $gen->generate_method('Foo' => 'three' => { is => 'purple' }) }, qr/Unknown is purple/, 'is purple rejected' ); is(exception { $gen->generate_method('Foo' => 'three' => { is => 'bare', predicate => 1 }); }, undef, 'generating bare accessor works'); ok(Foo->can('has_three'), 'bare accessor will still generate predicate'); like( exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', coerce => 5 }) }, qr/Invalid coerce/, "coerce - scalar rejected" ); is( exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', default => 5 }) }, undef, "default - non-ref scalar accepted" ); foreach my $setting (qw( default coerce )) { like( exception { $gen->generate_method('Foo' => 'five' => { allow_overwrite => 1, is => 'ro', $setting => [] }) }, qr/Invalid $setting/, "$setting - arrayref rejected" ); like( exception { $gen->generate_method('Foo' => 'five' => { allow_overwrite => 1, is => 'ro', $setting => Foo->new }) }, qr/Invalid $setting/, "$setting - non-code-convertible object rejected" ); is( exception { $gen->generate_method('Foo' => 'six' => { allow_overwrite => 1, is => 'ro', $setting => sub { 5 } }) }, undef, "$setting - coderef accepted" ); is( exception { $gen->generate_method('Foo' => 'seven' => { allow_overwrite => 1, is => 'ro', $setting => bless sub { 5 } => 'Blah' }) }, undef, "$setting - blessed sub accepted" ); is( exception { $gen->generate_method('Foo' => 'eight' => { allow_overwrite => 1, is => 'ro', $setting => WithOverload->new }) }, undef, "$setting - object with overloaded ->() accepted" ); like( exception { $gen->generate_method('Foo' => 'nine' => { allow_overwrite => 1, is => 'ro', $setting => bless {} => 'Blah' }) }, qr/Invalid $setting/, "$setting - object rejected" ); } is( exception { $gen->generate_method('Foo' => 'ten' => { is => 'ro', builder => '_build_ten' }) }, undef, 'builder - string accepted', ); is( exception { $gen->generate_method('Foo' => 'eleven' => { is => 'ro', builder => sub {} }) }, undef, 'builder - coderef accepted' ); like( exception { $gen->generate_method('Foo' => 'twelve' => { is => 'ro', builder => 'build:twelve' }) }, qr/Invalid builder/, 'builder - invalid name rejected', ); is( exception { $gen->generate_method('Foo' => 'thirteen' => { is => 'ro', builder => 'build::thirteen' }) }, undef, 'builder - fully-qualified name accepted', ); is( exception { $gen->generate_method('Foo' => 'fifteen' => { is => 'lazy', builder => sub {15} }) }, undef, 'builder - coderef accepted' ); is( exception { $gen->generate_method('Foo' => 'sixteen' => { is => 'lazy', builder => quote_sub q{ 16 } }) }, undef, 'builder - quote_sub accepted' ); ok !$gen->is_simple_attribute('attr', { builder => 'build_attr' }), "attribute with builder isn't simple"; ok $gen->is_simple_attribute('attr', { clearer => 'clear_attr' }), "attribute with clearer is simple"; { my ($code, $cap) = $gen->generate_get_default('$self', 'attr', { default => 5 }); is eval $code, 5, 'non-ref default code works'; is_deeply $cap, {}, 'non-ref default has no captures'; } { my ($code, $cap) = $gen->generate_simple_get('$self', 'attr', { default => 1 }); my $self = { attr => 5 }; is eval $code, 5, 'simple get code works'; is_deeply $cap, {}, 'simple get code has no captures'; } { my ($code, $cap) = $gen->generate_coerce('attr', '$value', quote_sub q{ $_[0] + 1 }); my $value = 5; is eval $code, 6, 'coerce from quoted sub code works'; is_deeply $cap, {}, 'coerce from quoted sub has no captures'; } { my ($code, $cap) = $gen->generate_trigger('attr', '$self', '$value', quote_sub q{ $_[0]{trigger} = $_[1] }); my $self = {}; my $value = 5; eval $code; is $self->{trigger}, 5, 'trigger from quoted sub code works'; is_deeply $cap, {}, 'trigger from quoted sub has no captures'; } { my ($code, $cap) = $gen->generate_isa_check('attr', '$value', quote_sub q{ die "bad value: $_[0]" unless $_[0] && $_[0] == 5 }); my $value = 4; eval $code; like $@, qr/bad value: 4/, 'isa from quoted sub code works'; is_deeply $cap, {}, 'isa from quoted sub has no captures'; } my $foo = Foo->new; $foo->{one} = 1; is($foo->one, 1, 'ro reads'); ok(exception { $foo->one(-3) }, 'ro dies on write attempt'); is($foo->one, 1, 'ro does not write'); is($foo->two, undef, 'rw reads'); $foo->two(-3); is($foo->two, -3, 'rw writes'); is($foo->fifteen, 15, 'builder installs code sub'); is($foo->_build_fifteen, 15, 'builder installs code sub under the correct name'); is($foo->sixteen, 16, 'builder installs quote_sub'); done_testing; Moo-2.000002/t/method-generate-constructor.t000644 000765 000024 00000003465 12554014037 021044 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Method::Generate::Constructor; use Method::Generate::Accessor; my $gen = Method::Generate::Constructor->new( accessor_generator => Method::Generate::Accessor->new ); $gen->generate_method('Foo', 'new', { one => { }, two => { init_arg => undef }, three => { init_arg => 'THREE' } }); my $first = Foo->new({ one => 1, two => 2, three => -75, THREE => 3, four => 4, }); is_deeply( { %$first }, { one => 1, three => 3 }, 'init_arg handling ok' ); $gen->generate_method('Bar', 'new' => { one => { required => 1 }, three => { init_arg => 'THREE', required => 1 } }); like( exception { Bar->new }, qr/Missing required arguments: THREE, one/, 'two missing args reported correctly' ); like( exception { Bar->new(THREE => 3) }, qr/Missing required arguments: one/, 'one missing arg reported correctly' ); is( exception { Bar->new(one => 1, THREE => 3) }, undef, 'pass with both required args' ); is( exception { Bar->new({ one => 1, THREE => 3 }) }, undef, 'hashrefs also supported' ); is( exception { $first->new(one => 1, THREE => 3) }, undef, 'calling ->new on an object works' ); like( exception { $gen->register_attribute_specs('seventeen' => { is => 'ro', init_arg => undef, required => 1 }) }, qr/You cannot have a required attribute/, 'required not allowed with init_arg undef' ); is( exception { $gen->register_attribute_specs('eighteen' => { is => 'ro', init_arg => undef, required => 1, default => 'foo' }) }, undef, 'required allowed with init_arg undef if given a default' ); is ref($gen->current_constructor('Bar')), 'CODE', 'can find constructor'; { package Baz; sub baz {}; } is $gen->current_constructor('Baz'), undef, 'nonexistent constructor returns undef'; done_testing; Moo-2.000002/t/modify_lazy_handlers.t000644 000765 000024 00000000573 12554014037 017614 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use lib qw(t/lib); BEGIN { use_ok 'MooObjectWithDelegate' }; { package MooObjectWithDelegate; around 'connect', sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . 'c'; }; } ok my $moo_object = MooObjectWithDelegate->new, 'got object'; is $moo_object->connect, 'abc', 'got abc'; done_testing; Moo-2.000002/t/moo-accessors.t000644 000765 000024 00000001446 12554014037 016163 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Foo; use Moo; has one => (is => 'ro'); has two => (is => 'rw', init_arg => undef); has three => (is => 'ro', init_arg => 'THREE', required => 1); package Bar; use Moo::Role; has four => (is => 'ro'); package Baz; use Moo; extends 'Foo'; with 'Bar'; has five => (is => 'rw'); } my $foo = Foo->new( one => 1, THREE => 3 ); is_deeply( { %$foo }, { one => 1, three => 3 }, 'simple class ok' ); my $baz = Baz->new( one => 1, THREE => 3, four => 4, five => 5, ); is_deeply( { %$baz }, { one => 1, three => 3, four => 4, five => 5 }, 'subclass with role ok' ); ok(eval { Foo->meta->make_immutable }, 'make_immutable returns true'); ok(!$INC{"Moose.pm"}, "Didn't load Moose"); done_testing unless caller; Moo-2.000002/t/moo-c3.t000644 000765 000024 00000001364 12554014037 014502 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package MyClassRoot; use Moo; has root => (is => 'ro'); } { package MyClassLeft; use Moo; extends 'MyClassRoot'; has left => (is => 'ro'); } { package MyClassRight; use Moo; extends 'MyClassRoot'; has right => (is => 'ro'); } { package MyClassChild; use Moo; extends 'MyClassLeft', 'MyClassRight'; has child => (is => 'ro'); } my $o = MyClassChild->new(root => 1, left => 2, right => 3, child => 4); is $o->root, 1, 'constructor populates root class attribute'; is $o->left, 2, 'constructor populates left parent attribute'; is $o->right, undef, 'constructor doesn\'t populate right parent attribute'; is $o->child, 4, 'constructor populates child class attribute'; done_testing; Moo-2.000002/t/moo-object.t000644 000765 000024 00000002745 12554014037 015447 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; no warnings 'once'; { package MyClass; use base 'Moo::Object'; } { package MyClass2; use base 'Moo::Object'; sub BUILD { } } is_deeply +MyClass->BUILDARGS({foo => 'bar'}), {foo => 'bar'}, 'BUILDARGS: hashref accepted'; is_deeply +MyClass->BUILDARGS(foo => 'bar'), {foo => 'bar'}, 'BUILDARGS: hash accepted'; like exception { MyClass->BUILDARGS('foo') }, qr/Single parameters to new\(\) must be a HASH ref/, 'BUILDARGS: non-hashref single element rejected'; like exception { MyClass->BUILDARGS(foo => 'bar', 5) }, qr/You passed an odd number of arguments/, 'BUILDARGS: odd number of elements rejected'; is +MyClass->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored when no BUILD exists'; my $built = 0; *MyClass::BUILD = sub { $built++ }; is +MyClass->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored second time when no BUILD exists'; is $built, 0, 'BUILD only checked for once'; is +MyClass2->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored when BUILD exists'; is +MyClass2->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored second time when BUILD exists'; { my $meta = MyClass->meta; $meta->make_immutable; is $INC{'Moo/HandleMoose.pm'}, undef, "->meta->make_immutable doesn't load HandleMoose"; $meta->DESTROY; } is $INC{'Moo/HandleMoose.pm'}, undef, "destroying fake metaclass doesn't load HandleMoose"; done_testing; Moo-2.000002/t/moo-utils-_name_coderef.t000644 000765 000024 00000000661 12554014037 020100 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; BEGIN { no warnings 'redefine'; $INC{'Sub/Name.pm'} = 1; defined &Sub::Name::subname or *Sub::Name::subname = sub {}; $INC{'Sub/Util.pm'} = 1; defined &Sub::Util::set_subname or *Sub::Util::set_subname = sub {}; } use Moo::_Utils; ok( Moo::_Utils::can_haz_subname || Moo::_Utils::can_haz_subutil, "one of can_haz_subname or can_haz_subutil set with both loaded" ); done_testing; Moo-2.000002/t/moo-utils.t000644 000765 000024 00000001425 12554014037 015333 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Moo::_Utils; use t::lib::INCModule; my %files = ( 'Broken/Class.pm' => q{ use strict; use warnings; my $f = flub; }, ); unshift @INC, sub { my $out = $files{$_[1]} or return; return inc_module($out); }; { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; is exception { ok !_maybe_load_module('Broken::Class'), '_maybe_load_module returns false for broken modules'; }, undef, "_maybe_load_module doesn't die on broken modules"; like $warn[0], qr/Broken::Class exists but failed to load with error/, '_maybe_load_module errors become warnings'; _maybe_load_module('Broken::Class'); is scalar @warn, 1, '_maybe_load_module only warns once per module'; } done_testing; Moo-2.000002/t/moo.t000644 000765 000024 00000002041 12554014037 014170 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package MyClass0; BEGIN { our @ISA = 'ZeroZero' } use Moo; } BEGIN { is( $INC{'Moo/Object.pm'}, undef, 'Object.pm not loaded if not required' ); } { package MyClass1; use Moo; } is_deeply( [ @MyClass1::ISA ], [ 'Moo::Object' ], 'superclass defaulted' ); { package MyClass2; use base qw(MyClass1); use Moo; } is_deeply( [ @MyClass2::ISA ], [ 'MyClass1' ], 'prior superclass left alone' ); { package MyClass3; use Moo; extends 'MyClass2'; } is_deeply( [ @MyClass3::ISA ], [ 'MyClass2' ], 'extends sets superclass' ); { package WhatTheFlyingFornication; sub wtff {} } { package MyClass4; use Moo; extends 'WhatTheFlyingFornication'; extends qw(MyClass2 MyClass3); } is_deeply( [ @MyClass4::ISA ], [ qw(MyClass2 MyClass3) ], 'extends overwrites' ); { package MyClass5; use Moo; sub foo { 'foo' } around foo => sub { my $orig = shift; $orig->(@_).' with around' }; } is(MyClass5->foo, 'foo with around', 'method modifier'); done_testing; Moo-2.000002/t/mutual-requires.t000644 000765 000024 00000001517 12462016515 016552 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; is exception { package RoleA; use Moo::Role; requires 'method_b'; requires 'attr_b'; sub method_a {} has attr_a => (is => 'ro'); }, undef, 'define role a'; is exception { package RoleB; use Moo::Role; requires 'method_a'; requires 'attr_a'; sub method_b {} has attr_b => (is => 'ro'); }, undef, 'define role a'; is exception { package RoleC; use Moo::Role; with 'RoleA', 'RoleB'; 1; }, undef, 'compose roles with mutual requires into role'; is exception { package PackageWithPrecomposed; use Moo; with 'RoleC'; 1; }, undef, 'compose precomposed roles into package'; is exception { package PackageWithCompose; use Moo; with 'RoleA', 'RoleB'; 1; }, undef, 'compose roles with mutual requires into package'; done_testing; Moo-2.000002/t/no-build.t000644 000765 000024 00000002627 12554014037 015121 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Moo::_mro; BEGIN { package Class::Diminutive; sub new { my $class = shift; my $args = $class->BUILDARGS(@_); my $no_build = delete $args->{__no_BUILD__}; my $self = bless { %$args }, $class; $self->BUILDALL unless $no_build; return $self; } sub BUILDARGS { my $class = shift; my %args = @_ % 2 ? %{$_[0]} : @_; return \%args; } sub BUILDALL { my $self = shift; my $class = ref $self; my @builds = grep { defined } map {; no strict 'refs'; *{$_.'::BUILD'}{CODE} } @{mro::get_linear_isa($class)}; for my $build (@builds) { $self->$build; } } } BEGIN { package TestClass1; our @ISA = ('Class::Diminutive'); sub BUILD { $_[0]->{build_called}++; } sub BUILDARGS { my $class = shift; my $args = $class->SUPER::BUILDARGS(@_); $args->{no_build_used} = $args->{__no_BUILD__}; return $args; } } my $o = TestClass1->new; is $o->{build_called}, 1, 'mini class builder working'; BEGIN { package TestClass2; use Moo; extends 'TestClass1'; } my $o2 = TestClass2->new; is $o2->{build_called}, 1, 'BUILD still called when extending mini class builder'; is $o2->{no_build_used}, 1, '__no_BUILD__ was passed to mini builder'; my $o3 = TestClass2->new({__no_BUILD__ => 1}); is $o3->{build_called}, undef, '__no_BUILD__ inhibits Moo calling BUILD'; done_testing; Moo-2.000002/t/no-moo.t000644 000765 000024 00000003474 12554014037 014615 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package Spoon; use Moo; no warnings 'redefine'; sub has { "has!" } no Moo; } { package Roller; use Moo::Role; no warnings 'redefine'; sub with { "with!" } no Moo::Role; } { package NoMooClass; no warnings 'redefine'; sub has { "has!" } my %stash = %{Moo::_Utils::_getstash(__PACKAGE__)}; Moo->unimport; my %stash2 = %{Moo::_Utils::_getstash(__PACKAGE__)}; main::is_deeply(\%stash, \%stash2, "stash of non-Moo class remains untouched"); } { package GlobalConflict; use Moo; no warnings 'redefine'; sub has { "has!" } no Moo; our $around = "has!"; no Moo; } { package RollerTiny; use Role::Tiny; no warnings 'redefine'; sub with { "with!" } my %stash = %{Moo::_Utils::_getstash(__PACKAGE__)}; Moo::Role->unimport; my %stash2 = %{Moo::_Utils::_getstash(__PACKAGE__)}; main::is_deeply(\%stash, \%stash2, "stash of non-Moo role remains untouched"); } { package GlobalConflict2; use Moo; no warnings 'redefine'; our $after = "has!"; sub has { $after } no Moo; } ok(!Spoon->can('extends'), 'extends cleaned'); is(Spoon->has, "has!", 'has left alone'); ok(!Roller->can('has'), 'has cleaned'); is(Roller->with, "with!", 'with left alone'); is(NoMooClass->has, "has!", 'has left alone'); ok(!GlobalConflict->can('extends'), 'extends cleaned'); is(GlobalConflict->has, "has!", 'has left alone'); { no warnings 'once'; is($GlobalConflict::around, "has!", 'package global left alone'); } ok(RollerTiny->can('around'), 'around left alone'); is(RollerTiny->with, "with!", 'with left alone'); ok(!GlobalConflict2->can('extends'), 'extends cleaned'); is(GlobalConflict2->has, "has!", 'has left alone'); { no warnings 'once'; is($GlobalConflict2::after, "has!", 'package global left alone'); } done_testing; Moo-2.000002/t/non-moo-extends-c3.t000644 000765 000024 00000001723 12554014037 016741 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Moo (); { package Foo; use mro 'c3'; sub new { my ($class, $rest) = @_; return bless {%$rest}, $class; } } { package Foo::AddCD; use base 'Foo'; sub new { my ($class, $rest) = @_; $rest->{c} = 'd'; return $class->next::method($rest); } } { package Foo::AddEF; use base 'Foo'; sub new { my ($class, $rest) = @_; $rest->{e} = 'f'; return $class->next::method($rest); } } { package Foo::Parent; use Moo; use mro 'c3'; extends 'Foo::AddCD', 'Foo'; } { package Foo::Parent::Child; use Moo; use mro 'c3'; extends 'Foo::AddEF', 'Foo::Parent'; } my $foo = Foo::Parent::Child->new({a => 'b'}); ok exists($foo->{a}) && $foo->{a} eq 'b', 'has basic attrs'; ok exists($foo->{c}) && $foo->{c} eq 'd', 'AddCD works'; ok exists($foo->{e}) && $foo->{e} eq 'f', 'AddEF works'; done_testing; Moo-2.000002/t/non-moo-extends.t000644 000765 000024 00000001761 12554014037 016440 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package ClassA; use Moo; has 'foo' => ( is => 'ro'); has built => (is => 'rw', default => 0); sub BUILD { $_[0]->built($_[0]->built+1); } } { package ClassB; our @ISA = 'ClassA'; sub blorp {}; sub new { $_[0]->SUPER::new(@_[1..$#_]); } } { package ClassC; use Moo; extends 'ClassB'; has bar => (is => 'ro'); } { package ClassD; our @ISA = 'ClassC'; } my $o = ClassD->new(foo => 1, bar => 2); isa_ok $o, 'ClassD'; is $o->foo, 1, 'superclass attribute has correct value'; is $o->bar, 2, 'subclass attribute has correct value'; is $o->built, 1, 'BUILD called correct number of times'; { package ClassE; sub new { return ClassF->new; } } { package ClassF; use Moo; extends 'Moo::Object', 'ClassE'; } { my $o = eval { ClassF->new }; ok $o, 'explicit inheritence from Moo::Object works around broken constructor' or diag $@; isa_ok $o, 'ClassF'; } done_testing; Moo-2.000002/t/not-both.t000644 000765 000024 00000001357 12554014037 015141 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; # Compile-time exceptions, so need stringy eval; hence not Test::Fatal. { local $@; ok !eval q { package ZZZ; use Role::Tiny; use Moo; 1; }, "can't import Moo into a Role::Tiny role"; like $@, qr{Cannot import Moo into a role}, " ... with correct error message"; } { local $@; ok !eval q { package XXX; use Moo; use Moo::Role; 1; }, "can't import Moo::Role into a Moo class"; like $@, qr{Cannot import Moo::Role into a Moo class}, " ... with correct error message"; } { local $@; ok !eval q { package YYY; use Moo::Role; use Moo; 1; }, "can't import Moo into a Moo role"; like $@, qr{Cannot import Moo into a role}, " ... with correct error message"; } done_testing; Moo-2.000002/t/overloaded-coderefs.t000644 000765 000024 00000003746 12462016515 017330 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; my $codified = 0; { package Dark::Side; use overload q[&{}] => sub { $codified++; shift->to_code }, fallback => 1; sub new { my $class = shift; my $code = shift; bless \$code, $class; } sub to_code { my $self = shift; eval "sub { $$self }"; } } { package The::Force; use Sub::Quote; use base 'Dark::Side'; sub to_code { my $self = shift; return quote_sub $$self; } } my $darkside = Dark::Side->new('my $dummy = "join the dark side"; $_[0] * 2'); is($darkside->(6), 12, 'check Dark::Side coderef'); my $theforce = The::Force->new('my $dummy = "use the force Luke"; $_[0] * 2'); is($theforce->(6), 12, 'check The::Force coderef'); my $luke = The::Force->new('my $z = "I am your father"'); { package Doubleena; use Moo; has a => (is => "rw", coerce => $darkside, isa => sub { 1 }); has b => (is => "rw", coerce => $theforce, isa => $luke); } my $o = Doubleena->new(a => 11, b => 12); is($o->a, 22, 'non-Sub::Quoted inlined coercion overload works'); is($o->b, 24, 'Sub::Quoted inlined coercion overload works'); my $codified_before = $codified; $o->a(5); is($codified_before, $codified, "repeated calls to accessor don't re-trigger overload"); use B::Deparse; my $constructor = B::Deparse->new->coderef2text(Doubleena->can('new')); like($constructor, qr{use the force Luke}, 'Sub::Quoted coercion got inlined'); unlike($constructor, qr{join the dark side}, 'non-Sub::Quoted coercion was not inlined'); like($constructor, qr{I am your father}, 'Sub::Quoted isa got inlined'); require Scalar::Util; is( Scalar::Util::refaddr($luke), Scalar::Util::refaddr( Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"isa"} ), '$spec->{isa} reference is not mutated', ); is( Scalar::Util::refaddr($theforce), Scalar::Util::refaddr( Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"coerce"} ), '$spec->{coerce} reference is not mutated', ); done_testing; Moo-2.000002/t/strictures.t000644 000765 000024 00000001473 12554014037 015615 0ustar00gknopstaff000000 000000 BEGIN { delete $ENV{MOO_FATAL_WARNINGS} } use strict; use warnings; use Test::More; $INC{'strictures.pm'} = __FILE__; my $strictures = 0; my $version; sub strictures::VERSION { $version = $_[1]; 2;; } sub strictures::import { $strictures++; strict->import; warnings->import(FATAL => 'all'); } local $SIG{__WARN__} = sub {}; eval q{ use Moo::_strictures; 0 + "string"; }; is $strictures, 0, 'strictures not imported without MOO_FATAL_WARNINGS'; is $@, '', 'warnings not fatal without MOO_FATAL_WARNINGS'; $ENV{MOO_FATAL_WARNINGS} = 1; eval q{ use Moo::_strictures; 0 + "string"; }; is $strictures, 1, 'strictures imported with MOO_FATAL_WARNINGS'; is $version, 2, 'strictures version 2 requested with MOO_FATAL_WARNINGS'; like $@, qr/isn't numeric/, 'warnings fatal with MOO_FATAL_WARNINGS'; done_testing; Moo-2.000002/t/sub-and-handles.t000644 000765 000024 00000003221 12554014037 016344 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package DelegateBar; use Moo; sub bar { 'unextended!' } package Does::DelegateToBar; use Moo::Role; has _barrer => ( is => 'ro', default => sub { DelegateBar->new }, handles => { _bar => 'bar' }, ); sub get_barrer { $_[0]->_barrer } package ConsumesDelegateToBar; use Moo; with 'Does::DelegateToBar'; has bong => ( is => 'ro' ); package Does::OverrideDelegate; use Moo::Role; sub _bar { 'extended' } package First; use Moo; extends 'ConsumesDelegateToBar'; with 'Does::OverrideDelegate'; has '+_barrer' => ( is => 'rw' ); package Second; use Moo; extends 'ConsumesDelegateToBar'; sub _bar { 'extended' } has '+_barrer' => ( is => 'rw' ); package Fourth; use Moo; extends 'ConsumesDelegateToBar'; sub _bar { 'extended' } has '+_barrer' => ( is => 'rw', handles => { _baz => 'bar' }, ); package Third; use Moo; extends 'ConsumesDelegateToBar'; with 'Does::OverrideDelegate'; has '+_barrer' => ( is => 'rw', handles => { _baz => 'bar' }, ); } is(First->new->_bar, 'extended', 'overriding delegate method with role works'); is(Fourth->new->_bar, 'extended', '... even when you specify other delegates in subclass'); is(Fourth->new->_baz, 'unextended!', '... and said other delegate still works'); is(Second->new->_bar, 'extended', 'overriding delegate method directly works'); is(Third->new->_bar, 'extended', '... even when you specify other delegates in subclass'); is(Third->new->_baz, 'unextended!', '... and said other delegate still works'); done_testing; Moo-2.000002/t/sub-defer-threads.t000644 000765 000024 00000001720 12554014037 016705 0ustar00gknopstaff000000 000000 use Config; BEGIN { unless ($Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } if ($] <= 5.008004) { print "1..0 # SKIP threads not reliable enough on perl <= 5.8.4\n"; exit 0; } } use threads; use Moo::_strictures; use Test::More; use Sub::Defer; my %made; my $one_defer = defer_sub 'Foo::one' => sub { die "remade - wtf" if $made{'Foo::one'}; $made{'Foo::one'} = sub { 'one' }; }; ok(threads->create(sub { my $info = Sub::Defer::defer_info($one_defer); my $name = $info && $info->[0] || '[undef]'; my $ok = $name eq 'Foo::one'; if (!$ok) { print STDERR "# Bad sub name when undeferring: $name\n"; } return $ok ? 1234 : 0; })->join == 1234, 'able to retrieve info in thread'); ok(threads->create(sub { undefer_sub($one_defer); my $ok = $made{'Foo::one'} && $made{'Foo::one'} == \&Foo::one; return $ok ? 1234 : 0; })->join == 1234, 'able to undefer in thread'); done_testing; Moo-2.000002/t/sub-defer.t000644 000765 000024 00000007316 12554014037 015264 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Sub::Defer qw(defer_sub undefer_sub undefer_all undefer_package); my %made; my $one_defer = defer_sub 'Foo::one' => sub { die "remade - wtf" if $made{'Foo::one'}; $made{'Foo::one'} = sub { 'one' } }; my $two_defer = defer_sub 'Foo::two' => sub { die "remade - wtf" if $made{'Foo::two'}; $made{'Foo::two'} = sub { 'two' } }; is($one_defer, \&Foo::one, 'one defer installed'); is($two_defer, \&Foo::two, 'two defer installed'); is($one_defer->(), 'one', 'one defer runs'); is($made{'Foo::one'}, \&Foo::one, 'one made'); is($made{'Foo::two'}, undef, 'two not made'); is($one_defer->(), 'one', 'one (deferred) still runs'); is(Foo->one, 'one', 'one (undeferred) runs'); is(my $two_made = undefer_sub($two_defer), $made{'Foo::two'}, 'make two'); is exception { undefer_sub($two_defer) }, undef, "repeated undefer doesn't regenerate"; is($two_made, \&Foo::two, 'two installed'); is($two_defer->(), 'two', 'two (deferred) still runs'); is($two_made->(), 'two', 'two (undeferred) runs'); my $three = sub { 'three' }; is(undefer_sub($three), $three, 'undefer non-deferred is a no-op'); my $four_defer = defer_sub 'Foo::four' => sub { sub { 'four' } }; is($four_defer, \&Foo::four, 'four defer installed'); # somebody somewhere wraps up around the deferred installer no warnings qw/redefine/; my $orig = Foo->can('four'); *Foo::four = sub { $orig->() . ' with a twist'; }; is(Foo->four, 'four with a twist', 'around works'); is(Foo->four, 'four with a twist', 'around has not been destroyed by first invocation'); my $one_all_defer = defer_sub 'Foo::one_all' => sub { $made{'Foo::one_all'} = sub { 'one_all' } }; my $two_all_defer = defer_sub 'Foo::two_all' => sub { $made{'Foo::two_all'} = sub { 'two_all' } }; is( $made{'Foo::one_all'}, undef, 'one_all not made' ); is( $made{'Foo::two_all'}, undef, 'two_all not made' ); undefer_all(); is( $made{'Foo::one_all'}, \&Foo::one_all, 'one_all made by undefer_all' ); is( $made{'Foo::two_all'}, \&Foo::two_all, 'two_all made by undefer_all' ); defer_sub 'Bar::one' => sub { $made{'Bar::one'} = sub { 'one' } }; defer_sub 'Bar::two' => sub { $made{'Bar::two'} = sub { 'two' } }; defer_sub 'Bar::Baz::one' => sub { $made{'Bar::Baz::one'} = sub { 'one' } }; undefer_package('Bar'); is( $made{'Bar::one'}, \&Bar::one, 'one made by undefer_package' ); is( $made{'Bar::two'}, \&Bar::two, 'two made by undefer_package' ); is( $made{'Bar::Baz::one'}, undef, 'sub-package not undefered by undefer_package' ); { my $foo = defer_sub undef, sub { sub { 'foo' } }; my $foo_string = "$foo"; undef $foo; is Sub::Defer::defer_info($foo_string), undef, "deferred subs don't leak"; Sub::Defer->CLONE; ok !exists $Sub::Defer::DEFERRED{$foo_string}, 'CLONE cleans out expired entries'; } { my $foo = defer_sub undef, sub { sub { 'foo' } }; my $foo_string = "$foo"; Sub::Defer->CLONE; undef $foo; is Sub::Defer::defer_info($foo_string), undef, "CLONE doesn't strengthen refs"; } { my $foo = defer_sub undef, sub { sub { 'foo' } }; my $foo_string = "$foo"; my $foo_info = Sub::Defer::defer_info($foo_string); undef $foo; is exception { Sub::Defer->CLONE }, undef, 'CLONE works when quoted info saved externally'; ok exists $Sub::Defer::DEFERRED{$foo_string}, 'CLONE keeps entries that had info saved externally'; } { my $foo = defer_sub undef, sub { sub { 'foo' } }; my $foo_string = "$foo"; my $foo_info = $Sub::Defer::DEFERRED{$foo_string}; undef $foo; is exception { Sub::Defer->CLONE }, undef, 'CLONE works when quoted info kept alive externally'; ok !exists $Sub::Defer::DEFERRED{$foo_string}, 'CLONE removes expired entries that were kept alive externally'; } done_testing; Moo-2.000002/t/sub-quote-threads.t000644 000765 000024 00000002233 12554014037 016755 0ustar00gknopstaff000000 000000 use Config; BEGIN { unless ($Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } if ($] <= 5.008004) { print "1..0 # SKIP threads not reliable enough on perl <= 5.8.4\n"; exit 0; } } use threads; use Moo::_strictures; use Test::More; use Sub::Quote; my $one = quote_sub q{ BEGIN { $::EVALED{'one'} = 1 } 42 }; my $one_code = quoted_from_sub($one)->[1]; my $two = quote_sub q{ BEGIN { $::EVALED{'two'} = 1 } 3 + $x++ } => { '$x' => \do { my $x = 0 } }; is(threads->create(sub { my $quoted = quoted_from_sub($one); $quoted && $quoted->[1]; })->join, $one_code, 'able to retrieve quoted sub in thread'); my $u_one = unquote_sub $one; is(threads->create(sub { $one->() })->join, 42, 'One (quoted version)'); is(threads->create(sub { $u_one->() })->join, 42, 'One (unquoted version)'); my $r = threads->create(sub { my @r; push @r, $two->(); push @r, unquote_sub($two)->(); push @r, $two->(); \@r; })->join; is($r->[0], 3, 'Two in thread (quoted version)'); is($r->[1], 4, 'Two in thread (unquoted version)'); is($r->[2], 5, 'Two in thread (quoted version again)'); done_testing; Moo-2.000002/t/sub-quote.t000644 000765 000024 00000014302 12554014037 015325 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; use Test::Fatal; use Sub::Quote qw(quote_sub quoted_from_sub unquote_sub qsub capture_unroll inlinify); our %EVALED; my $one = quote_sub q{ BEGIN { $::EVALED{'one'} = 1 } 42 }; my $two = quote_sub q{ BEGIN { $::EVALED{'two'} = 1 } 3 + $x++ } => { '$x' => \do { my $x = 0 } }; ok(!keys %EVALED, 'Nothing evaled yet'); my $u_one = unquote_sub $one; is_deeply( [ sort keys %EVALED ], [ qw(one) ], 'subs one evaled' ); is($one->(), 42, 'One (quoted version)'); is($u_one->(), 42, 'One (unquoted version)'); is($two->(), 3, 'Two (quoted version)'); is(unquote_sub($two)->(), 4, 'Two (unquoted version)'); is($two->(), 5, 'Two (quoted version again)'); my $three = quote_sub 'Foo::three' => q{ $x = $_[1] if $_[1]; die +(caller(0))[3] if @_ > 2; return $x; } => { '$x' => \do { my $x = 'spoon' } }; is(Foo->three, 'spoon', 'get ok (named method)'); is(Foo->three('fork'), 'fork', 'set ok (named method)'); is(Foo->three, 'fork', 're-get ok (named method)'); like( exception { Foo->three(qw(full cutlery set)) }, qr/Foo::three/, 'exception contains correct name' ); quote_sub 'Foo::four' => q{ return 5; }; my $quoted = quoted_from_sub(\&Foo::four); like $quoted->[1], qr/return 5;/, 'can get quoted from installed sub'; Foo::four(); my $quoted2 = quoted_from_sub(\&Foo::four); like $quoted2->[1], qr/return 5;/, "can still get quoted from installed sub after undefer"; undef $quoted; my $broken_quoted = quote_sub q{ return 5<; }; like( exception { $broken_quoted->() }, qr/Eval went very, very wrong/, "quoted sub with syntax error dies when called" ); sub in_main { 1 } is exception { quote_sub(q{ in_main(); })->(); }, undef, 'context preserved in quoted sub'; { no strict 'refs'; is exception { quote_sub(q{ my $foo = "some_variable"; $$foo; })->(); }, undef, 'hints are preserved'; } { my $foo = quote_sub '{}'; my $foo_string = "$foo"; undef $foo; is quoted_from_sub($foo_string), undef, "quoted subs don't leak"; Sub::Quote->CLONE; ok !exists $Sub::Quote::QUOTED{$foo_string}, 'CLONE cleans out expired entries'; } { my $foo = quote_sub '{}'; my $foo_string = "$foo"; Sub::Quote->CLONE; undef $foo; is quoted_from_sub($foo_string), undef, "CLONE doesn't strengthen refs"; } { my $foo = quote_sub '{}'; my $foo_string = "$foo"; my $foo_info = quoted_from_sub($foo_string); undef $foo; is exception { Sub::Quote->CLONE }, undef, 'CLONE works when quoted info saved externally'; ok exists $Sub::Quote::QUOTED{$foo_string}, 'CLONE keeps entries that had info saved'; } { my $foo = quote_sub '{}'; my $foo_string = "$foo"; my $foo_info = $Sub::Quote::QUOTED{$foo_string}; undef $foo; is exception { Sub::Quote->CLONE }, undef, 'CLONE works when quoted info kept alive externally'; ok !exists $Sub::Quote::QUOTED{$foo_string}, 'CLONE removes expired entries that were kept alive externally'; } { my $foo = quote_sub '{}'; my $foo_string = "$foo"; my $sub = unquote_sub $foo; my $sub_string = "$sub"; Sub::Quote->CLONE; ok quoted_from_sub($sub_string), 'CLONE maintains entries referenced by unquoted sub'; undef $sub; ok quoted_from_sub($foo_string)->[3], 'unquoted sub still available if quoted sub exists'; } { my $foo = quote_sub '{}'; my $foo_string = "$foo"; my $foo2 = unquote_sub $foo; undef $foo; my $foo_info = Sub::Quote::quoted_from_sub($foo_string); is $foo_info, undef, 'quoted data not maintained for quoted sub deleted after being unquoted'; is quoted_from_sub($foo2)->[3], $foo2, 'unquoted sub still included in quote info'; } use Data::Dumper; my $dump = sub { local $Data::Dumper::Terse = 1; my $d = Data::Dumper::Dumper($_[0]); $d =~ s/\s+$//; $d; }; my @strings = (0, 1, "\x00", "a", "\xFC", "\x{1F4A9}"); my $eval = sub { eval Sub::Quote::quotify($_[0])}; my @failed = grep { my $o = $eval->($_); !defined $o || $o ne $_ } @strings; ok !@failed, "evaling quotify returns same value for all strings" or diag "Failed strings: " . join(' ', map { $dump->($_) } @failed); SKIP: { skip "working utf8 pragma not available", 1 if $] < 5.008000; my $eval_utf8 = eval 'sub { use utf8; eval Sub::Quote::quotify($_[0]) }'; my @failed_utf8 = grep { my $o = $eval_utf8->($_); !defined $o || $o ne $_ } @strings; ok !@failed_utf8, "evaling quotify under utf8 returns same value for all strings" or diag "Failed strings: " . join(' ', map { $dump->($_) } @failed_utf8); } my @stuff = (qsub q{ print "hello"; }, 1, 2); is scalar @stuff, 3, 'qsub only accepts a single parameter'; my $captures = { '$x' => \1, '$y' => \2, }; my $prelude = capture_unroll '$captures', $captures, 4; my $out = eval $prelude . '[ $x, $y ]'; is "$@", '', 'capture_unroll produces valid code'; is_deeply $out, [ 1, 2 ], 'unrolled variables get correct values'; { my $inlined_code = inlinify q{ my ($x, $y) = @_; [ $x, $y ]; }, '$x, $y', $prelude; my $out = eval $inlined_code; is "$@", '', 'inlinify produces valid code' or diag "code:\n$inlined_code"; is_deeply $out, [ 1, 2 ], 'inlinified code get correct values'; unlike $inlined_code, qr/my \(\$x, \$y\) = \@_;/, "matching variables aren't reassigned"; } { no warnings 'once'; $Bar::baz = 3; my $inlined_code = inlinify q{ package Bar; my ($x, $y) = @_; [ $x, $y, our $baz ]; }, '$x, $y', $prelude; my $out = eval $inlined_code; is "$@", '', 'inlinify produces valid code' or diag "code:\n$inlined_code"; is_deeply $out, [ 1, 2, 3 ], 'inlinified code get correct values'; unlike $inlined_code, qr/my \(\$x, \$y\) = \@_;/, "matching variables aren't reassigned"; } { my $inlined_code = inlinify q{ my ($d, $f) = @_; [ $d, $f ]; }, '$x, $y', $prelude; my $out = eval $inlined_code; is "$@", '', 'inlinify with unmatched params produces valid code' or diag "code:\n$inlined_code"; is_deeply $out, [ 1, 2 ], 'inlinified code get correct values'; } { my $inlined_code = inlinify q{ my $z = $_[0]; $z; }, '$y', $prelude; my $out = eval $inlined_code; is "$@", '', 'inlinify with out @_ produces valid code' or diag "code:\n$inlined_code"; is $out, 2, 'inlinified code get correct values'; } done_testing; Moo-2.000002/t/subconstructor.t000644 000765 000024 00000000320 12554014037 016473 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; { package SubCon1; use Moo; has foo => (is => 'ro'); package SubCon2; our @ISA = qw(SubCon1); } ok(SubCon2->new, 'constructor completes'); done_testing; Moo-2.000002/t/undef-bug.t000644 000765 000024 00000000277 12462016515 015264 0ustar00gknopstaff000000 000000 use Test::More tests => 1; package Foo; use Moo; has this => (is => 'ro'); package main; my $foo = Foo->new; ok not(exists($foo->{this})), "new objects don't have undef attributes"; Moo-2.000002/t/use-after-no.t000644 000765 000024 00000000766 12554014037 015717 0ustar00gknopstaff000000 000000 use Moo::_strictures; use Test::More; ok eval q{ package Spoon; use Moo; has foo => ( is => 'ro' ); no Moo; use Moo; has foo2 => ( is => 'ro' ); no Moo; 1; }, "subs imported on 'use Moo;' after 'no Moo;'" or diag $@; ok eval q{ package Roller; use Moo::Role; has foo => ( is => 'ro' ); no Moo::Role; use Moo::Role; has foo2 => ( is => 'ro' ); no Moo::Role; 1; }, "subs imported on 'use Moo::Role;' after 'no Moo::Role;'" or diag $@; done_testing; Moo-2.000002/t/zzz-check-breaks.t000644 000765 000024 00000002660 12554014037 016562 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; my $meta_file; BEGIN { eval { require CPAN::Meta } or plan skip_all => 'CPAN::Meta required for checking breakages'; eval { require CPAN::Meta::Requirements } or plan skip_all => 'CPAN::Meta::Requirements required for checking breakages'; ($meta_file) = grep -f, qw(MYMETA.json MYMETA.yml META.json META.yml) or plan skip_all => 'no META file exists'; } use ExtUtils::MakeMaker; use Module::Runtime qw(module_notional_filename); my $meta = CPAN::Meta->load_file($meta_file)->as_struct; my $req = CPAN::Meta::Requirements->from_string_hash( $meta->{x_breaks} ); pass 'checking breakages...'; my @breaks; for my $module ($req->required_modules) { my ($pm_file) = grep -e, map $_.'/'.module_notional_filename($module), @INC; next unless $pm_file; my $version = MM->parse_version($pm_file); next unless defined $version; (my $check_version = $version) =~ s/_//; if ($req->accepts_module($module, $version)) { my $broken_v = $req->requirements_for_module($module); $broken_v = ">= $broken_v" unless $broken_v =~ /\A\s*(?:==|>=|>|<=|<|!=)/; push @breaks, [$module, $check_version, $broken_v]; } } if (@breaks) { diag "Installing Moo $meta->{version} will break these modules:\n\n" . (join '', map { "$_->[0] (found version $_->[1])\n" . " Broken versions: $_->[2]\n" } @breaks) . "\nYou should now update these modules!"; } done_testing; Moo-2.000002/t/lib/base_class.pm000644 000765 000024 00000000061 12554014037 016414 0ustar00gknopstaff000000 000000 package base_class; use Moo; extends "marp"; 1; Moo-2.000002/t/lib/ClassicObject.pm000644 000765 000024 00000000175 12462016251 017031 0ustar00gknopstaff000000 000000 package ClassicObject; sub new { my ($class, %args) = @_; bless \%args, 'ClassicObject'; } sub connect { 'a' } 1; Moo-2.000002/t/lib/ClobberUnderscore.pm000644 000765 000024 00000000071 12462016251 017716 0ustar00gknopstaff000000 000000 package ClobberUnderscore; sub h1 { 'h1' }; undef $_; 1; Moo-2.000002/t/lib/ComplexWriter.pm000644 000765 000024 00000000564 12462016251 017127 0ustar00gknopstaff000000 000000 package ComplexWriter; use Moo; use Test::More; use Test::Fatal; has "t_$_" => ( is => 'rwp', $_ => sub { die 'triggered' }, writer => "set_t_$_", ) for qw(coerce isa trigger); sub test_with { my ($class, $option) = @_; my $writer = "set_t_$option"; like exception { __PACKAGE__->new->$writer( 4 ) }, qr/triggered/, "$option triggered via writer"; } 1; Moo-2.000002/t/lib/ExtRobot.pm000644 000765 000024 00000000070 12462016251 016061 0ustar00gknopstaff000000 000000 package ExtRobot; use Moo::Role; requires 'beep'; 1; Moo-2.000002/t/lib/INCModule.pm000644 000765 000024 00000000711 12554014037 016076 0ustar00gknopstaff000000 000000 package t::lib::INCModule; use Moo::_strictures; use base qw(Exporter); our @EXPORT = qw(inc_module); BEGIN { *_HAS_PERLIO = $] >= 5.008 ? sub(){1} : sub(){0}; } sub inc_module { my $code = $_[0]; if (_HAS_PERLIO) { open my $fh, '<', \$code or die "error loading module: $!"; return $fh; } else { return sub { return 0 unless length $code; $code =~ s/^([^\n]*\n?)//; $_ = $1; return 1; }; } } 1; Moo-2.000002/t/lib/MooObjectWithDelegate.pm000644 000765 000024 00000000726 12462016251 020473 0ustar00gknopstaff000000 000000 package MooObjectWithDelegate; use ClassicObject; use Scalar::Util (); use Moo; has 'delegated' => ( is => 'ro', isa => sub { do { $_[0] && Scalar::Util::blessed($_[0]) } or die "Not an Object!"; }, lazy => 1, builder => '_build_delegated', handles => [qw/connect/], ); sub _build_delegated { my $self = shift; return ClassicObject->new; } around 'connect', sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . 'b'; }; 1; Moo-2.000002/t/lib/sub_class.pm000644 000765 000024 00000000064 12554014037 016276 0ustar00gknopstaff000000 000000 package sub_class; use Moo; extends 'base_class'; Moo-2.000002/t/lib/UnderscoreClass.pm000644 000765 000024 00000000117 12462016251 017414 0ustar00gknopstaff000000 000000 package UnderscoreClass; use Moo; with qw(UnderscoreRole); sub c1 { 'c1' }; 1; Moo-2.000002/t/lib/UnderscoreRole.pm000644 000765 000024 00000000122 12462016251 017244 0ustar00gknopstaff000000 000000 package UnderscoreRole; use Moo::Role; use ClobberUnderscore; sub r1 { 'r1' }; 1; Moo-2.000002/maint/Makefile.PL.include000644 000765 000024 00000000540 12470257726 017467 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar 0.001; use ExtUtils::MakeMaker 6.57_10 (); author 'mst - Matt S. Trout (cpan:MSTROUT) '; manifest_include t => 'global-destruction-helper.pl'; manifest_include xt => 'global-destruct-jenga-helper.pl'; 1; Moo-2.000002/lib/Method/000755 000765 000024 00000000000 12554434146 014746 5ustar00gknopstaff000000 000000 Moo-2.000002/lib/Moo/000755 000765 000024 00000000000 12554434146 014260 5ustar00gknopstaff000000 000000 Moo-2.000002/lib/Moo.pm000644 000765 000024 00000074712 12554434121 014622 0ustar00gknopstaff000000 000000 package Moo; use Moo::_strictures; use Moo::_Utils; our $VERSION = '2.000002'; $VERSION = eval $VERSION; require Moo::sification; Moo::sification->import; our %MAKERS; sub _install_tracked { my ($target, $name, $code) = @_; $MAKERS{$target}{exports}{$name} = $code; _install_coderef "${target}::${name}" => "Moo::${name}" => $code; } sub import { my $target = caller; my $class = shift; _set_loaded(caller); strict->import; warnings->import; if ($INC{'Role/Tiny.pm'} and Role::Tiny->is_role($target)) { die "Cannot import Moo into a role"; } $MAKERS{$target} ||= {}; _install_tracked $target => extends => sub { $class->_set_superclasses($target, @_); $class->_maybe_reset_handlemoose($target); return; }; _install_tracked $target => with => sub { require Moo::Role; Moo::Role->apply_roles_to_package($target, @_); $class->_maybe_reset_handlemoose($target); }; _install_tracked $target => has => sub { my $name_proto = shift; my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto; if (@_ % 2 != 0) { require Carp; Carp::croak("Invalid options for " . join(', ', map "'$_'", @name_proto) . " attribute(s): even number of arguments expected, got " . scalar @_) } my %spec = @_; foreach my $name (@name_proto) { # Note that when multiple attributes specified, each attribute # needs a separate \%specs hashref my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; $class->_constructor_maker_for($target) ->register_attribute_specs($name, $spec_ref); $class->_accessor_maker_for($target) ->generate_method($target, $name, $spec_ref); $class->_maybe_reset_handlemoose($target); } return; }; foreach my $type (qw(before after around)) { _install_tracked $target => $type => sub { require Class::Method::Modifiers; _install_modifier($target, $type, @_); return; }; } return if $MAKERS{$target}{is_class}; # already exported into this package my $stash = _getstash($target); my @not_methods = map { *$_{CODE}||() } grep !ref($_), values %$stash; @{$MAKERS{$target}{not_methods}={}}{@not_methods} = @not_methods; $MAKERS{$target}{is_class} = 1; { no strict 'refs'; @{"${target}::ISA"} = do { require Moo::Object; ('Moo::Object'); } unless @{"${target}::ISA"}; } if ($INC{'Moo/HandleMoose.pm'}) { Moo::HandleMoose::inject_fake_metaclass_for($target); } } sub unimport { my $target = caller; _unimport_coderefs($target, $MAKERS{$target}); } sub _set_superclasses { my $class = shift; my $target = shift; foreach my $superclass (@_) { _load_module($superclass); if ($INC{'Role/Tiny.pm'} && Role::Tiny->is_role($superclass)) { require Carp; Carp::croak("Can't extend role '$superclass'"); } } # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA @{*{_getglob("${target}::ISA")}{ARRAY}} = @_; if (my $old = delete $Moo::MAKERS{$target}{constructor}) { $old->assert_constructor; delete _getstash($target)->{new}; Moo->_constructor_maker_for($target) ->register_attribute_specs(%{$old->all_attribute_specs}); } elsif (!$target->isa('Moo::Object')) { Moo->_constructor_maker_for($target); } no warnings 'once'; # piss off. -- mst $Moo::HandleMoose::MOUSE{$target} = [ grep defined, map Mouse::Util::find_meta($_), @_ ] if Mouse::Util->can('find_meta'); } sub _maybe_reset_handlemoose { my ($class, $target) = @_; if ($INC{"Moo/HandleMoose.pm"}) { Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target); } } sub _accessor_maker_for { my ($class, $target) = @_; return unless $MAKERS{$target}; $MAKERS{$target}{accessor} ||= do { my $maker_class = do { if (my $m = do { require Sub::Defer; if (my $defer_target = (Sub::Defer::defer_info($target->can('new'))||[])->[0] ) { my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/); $MAKERS{$pkg} && $MAKERS{$pkg}{accessor}; } else { undef; } }) { ref($m); } else { require Method::Generate::Accessor; 'Method::Generate::Accessor' } }; $maker_class->new; } } sub _constructor_maker_for { my ($class, $target) = @_; return unless $MAKERS{$target}; $MAKERS{$target}{constructor} ||= do { require Method::Generate::Constructor; require Sub::Defer; my %construct_opts = ( package => $target, accessor_generator => $class->_accessor_maker_for($target), subconstructor_handler => ( ' if ($Moo::MAKERS{$class}) {'."\n" .' if ($Moo::MAKERS{$class}{constructor}) {'."\n" .' return $class->'.$target.'::SUPER::new(@_);'."\n" .' }'."\n" .' '.$class.'->_constructor_maker_for($class);'."\n" .' return $class->new(@_)'.";\n" .' } elsif ($INC{"Moose.pm"} and my $meta = Class::MOP::get_metaclass_by_name($class)) {'."\n" .' return $meta->new_object('."\n" .' $class->can("BUILDARGS") ? $class->BUILDARGS(@_)'."\n" .' : $class->Moo::Object::BUILDARGS(@_)'."\n" .' );'."\n" .' }'."\n" ), ); my $con; my @isa = @{mro::get_linear_isa($target)}; shift @isa; if (my ($parent_new) = grep { *{_getglob($_.'::new')}{CODE} } @isa) { if ($parent_new eq 'Moo::Object') { # no special constructor needed } elsif (my $makers = $MAKERS{$parent_new}) { $con = $makers->{constructor}; $construct_opts{construction_string} = $con->construction_string if $con; } elsif ($parent_new->can('BUILDALL')) { $construct_opts{construction_builder} = sub { my $inv = $target->can('BUILDARGS') ? '' : 'Moo::Object::'; 'do {' .' my $args = $class->'.$inv.'BUILDARGS(@_);' .' $args->{__no_BUILD__} = 1;' .' $class->'.$target.'::SUPER::new($args);' .'}' }; } else { $construct_opts{construction_builder} = sub { '$class->'.$target.'::SUPER::new(' .($target->can('FOREIGNBUILDARGS') ? '$class->FOREIGNBUILDARGS(@_)' : '@_') .')' }; } } ($con ? ref($con) : 'Method::Generate::Constructor') ->new(%construct_opts) ->install_delayed ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}}) } } sub _concrete_methods_of { my ($me, $role) = @_; my $makers = $MAKERS{$role}; # grab role symbol table my $stash = _getstash($role); # reverse so our keys become the values (captured coderefs) in case # they got copied or re-used since my $not_methods = { reverse %{$makers->{not_methods}||{}} }; +{ # grab all code entries that aren't in the not_methods list map { my $code = *{$stash->{$_}}{CODE}; ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) } grep !ref($stash->{$_}), keys %$stash }; } 1; __END__ =pod =encoding utf-8 =head1 NAME Moo - Minimalist Object Orientation (with Moose compatibility) =head1 SYNOPSIS package Cat::Food; use Moo; use strictures 2; use namespace::clean; sub feed_lion { my $self = shift; my $amount = shift || 1; $self->pounds( $self->pounds - $amount ); } has taste => ( is => 'ro', ); has brand => ( is => 'ro', isa => sub { die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ' }, ); has pounds => ( is => 'rw', isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 }, ); 1; And elsewhere: my $full = Cat::Food->new( taste => 'DELICIOUS.', brand => 'SWEET-TREATZ', pounds => 10, ); $full->feed_lion; say $full->pounds; =head1 DESCRIPTION C is an extremely light-weight Object Orientation system. It allows one to concisely define objects and roles with a convenient syntax that avoids the details of Perl's object system. C contains a subset of L and is optimised for rapid startup. C avoids depending on any XS modules to allow for simple deployments. The name C is based on the idea that it provides almost -- but not quite -- two thirds of L. Unlike L this module does not aim at full compatibility with L's surface syntax, preferring instead to provide full interoperability via the metaclass inflation capabilities described in L. For a full list of the minor differences between L and L's surface syntax, see L. =head1 WHY MOO EXISTS If you want a full object system with a rich Metaprotocol, L is already wonderful. But if you don't want to use L, you may not want "less metaprotocol" like L offers, but you probalby want "no metaprotocol", which is what Moo provides. C is ideal for some situations where deployment or startup time precludes using L and L: =over 2 =item a command line or CGI script where fast startup is essential =item code designed to be deployed as a single file via L =item a CPAN module that may be used by others in the above situations =back C maintains transparent compatibility with L so if you install and load L you can use Moo clases and roles in L code without modification. Moo -- Minimal Object Orientation -- aims to make it smooth to upgrade to L when you need more than the minimal features offered by Moo. =head1 MOO AND MOOSE If L detects L being loaded, it will automatically register metaclasses for your L and L packages, so you should be able to use them in L code without modification. L will also create L for L classes and roles, so that in Moose classes C<< isa => 'MyMooClass' >> and C<< isa => 'MyMooRole' >> work the same as for L classes and roles. Extending a L class or consuming a L will also work. Extending a L class or consuming a L will also work. But note that we don't provide L metaclasses or metaroles so the other way around doesn't work. This feature exists for L users porting to L; enabling L users to use L classes is not a priority for us. This means that there is no need for anything like L for Moo code - Moo and Moose code should simply interoperate without problem. To handle L code, you'll likely need an empty Moo role or class consuming or extending the L stuff since it doesn't register true L metaclasses like L does. If you need to disable the metaclass creation, add: no Moo::sification; to your code before Moose is loaded, but bear in mind that this switch is global and turns the mechanism off entirely so don't put this in library code. =head1 MOO AND CLASS::XSACCESSOR If a new enough version of L is available, it will be used to generate simple accessors, readers, and writers for better performance. Simple accessors are those without lazy defaults, type checks/coercions, or triggers. Readers and writers generated by L will behave slightly differently: they will reject attempts to call them with the incorrect number of parameters. =head1 MOO VERSUS ANY::MOOSE L will load L normally, and L in a program using L - which theoretically allows you to get the startup time of L without disadvantaging L users. Sadly, this doesn't entirely work, since the selection is load order dependent - L's metaclass inflation system explained above in L is significantly more reliable. So if you want to write a CPAN module that loads fast or has only pure perl dependencies but is also fully usable by L users, you should be using L. For a full explanation, see the article L which explains the differing strategies in more detail and provides a direct example of where L succeeds and L fails. =head1 IMPORTED METHODS =head2 new Foo::Bar->new( attr1 => 3 ); or Foo::Bar->new({ attr1 => 3 }); =head2 BUILDARGS sub BUILDARGS { my ( $class, @args ) = @_; unshift @args, "attr1" if @args % 2 == 1; return { @args }; } Foo::Bar->new( 3 ); The default implementation of this method accepts a hash or hash reference of named parameters. If it receives a single argument that isn't a hash reference it throws an error. You can override this method in your class to handle other types of options passed to the constructor. This method should always return a hash reference of named options. =head2 FOREIGNBUILDARGS If you are inheriting from a non-Moo class, the arguments passed to the parent class constructor can be manipulated by defining a C method. It will receive the same arguments as C, and should return a list of arguments to pass to the parent class constructor. =head2 BUILD Define a C method on your class and the constructor will automatically call the C method from parent down to child after the object has been instantiated. Typically this is used for object validation or possibly logging. =head2 DEMOLISH If you have a C method anywhere in your inheritance hierarchy, a C method is created on first object construction which will call C<< $instance->DEMOLISH($in_global_destruction) >> for each C method from child upwards to parents. Note that the C method is created on first construction of an object of your class in order to not add overhead to classes without C methods; this may prove slightly surprising if you try and define your own. =head2 does if ($foo->does('Some::Role1')) { ... } Returns true if the object composes in the passed role. =head1 IMPORTED SUBROUTINES =head2 extends extends 'Parent::Class'; Declares a base class. Multiple superclasses can be passed for multiple inheritance but please consider using L instead. The class will be loaded but no errors will be triggered if the class can't be found and there are already subs in the class. Calling extends more than once will REPLACE your superclasses, not add to them like 'use base' would. =head2 with with 'Some::Role1'; or with 'Some::Role1', 'Some::Role2'; Composes one or more L (or L) roles into the current class. An error will be raised if these roles cannot be composed because they have conflicting method definitions. The roles will be loaded using the same mechansim as C uses. =head2 has has attr => ( is => 'ro', ); Declares an attribute for the class. package Foo; use Moo; has 'attr' => ( is => 'ro' ); package Bar; use Moo; extends 'Foo'; has '+attr' => ( default => sub { "blah" }, ); Using the C<+> notation, it's possible to override an attribute. The options for C are as follows: =over 2 =item * C B, may be C, C, C or C. C stands for "read-only" and generates an accessor that dies if you attempt to write to it - i.e. a getter only - by defaulting C to the name of the attribute. C generates a reader like C, but also sets C to 1 and C to C<_build_${attribute_name}> to allow on-demand generated attributes. This feature was my attempt to fix my incompetence when originally designing C, and is also implemented by L. There is, however, nothing to stop you using C and C yourself with C or C - it's just that this isn't generally a good idea so we don't provide a shortcut for it. C stands for "read-write protected" and generates a reader like C, but also sets C to C<_set_${attribute_name}> for attributes that are designed to be written from inside of the class, but read-only from outside. This feature comes from L. C stands for "read-write" and generates a normal getter/setter by defaulting the C to the name of the attribute specified. =item * C Takes a coderef which is used to validate the attribute. Unlike L, Moo does not include a basic type system, so instead of doing C<< isa => 'Num' >>, one should do use Scalar::Util qw(looks_like_number); ... isa => sub { die "$_[0] is not a number!" unless looks_like_number $_[0] }, Note that the return value for C is discarded. Only if the sub dies does type validation fail. L Since L does B run the C check before C if a coercion subroutine has been supplied, C checks are not structural to your code and can, if desired, be omitted on non-debug builds (although if this results in an uncaught bug causing your program to break, the L authors guarantee nothing except that you get to keep both halves). If you want L compatible or L style named types, look at L. To cause your C entries to be automatically mapped to named L objects (rather than the default behaviour of creating an anonymous type), set: $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub { require MooseX::Types::Something; return MooseX::Types::Something::TypeName(); }; Note that this example is purely illustrative; anything that returns a L object or something similar enough to it to make L happy is fine. =item * C Takes a coderef which is meant to coerce the attribute. The basic idea is to do something like the following: coerce => sub { $_[0] % 2 ? $_[0] : $_[0] + 1 }, Note that L will always execute your coercion: this is to permit C entries to be used purely for bug trapping, whereas coercions are always structural to your code. We do, however, apply any supplied C check after the coercion has run to ensure that it returned a valid value. L If the C option is a blessed object providing a C or C method, then the C option may be set to just C<1>. =item * C Takes a string handles => 'RobotRole' Where C is a L that defines an interface which becomes the list of methods to handle. Takes a list of methods handles => [ qw( one two ) ] Takes a hashref handles => { un => 'one', } =item * C Takes a coderef which will get called any time the attribute is set. This includes the constructor, but not default or built values. The coderef will be invoked against the object with the new value as an argument. If you set this to just C<1>, it generates a trigger which calls the C<_trigger_${attr_name}> method on C<$self>. This feature comes from L. Note that Moose also passes the old value, if any; this feature is not yet supported. L =item * C Takes a coderef which will get called with $self as its only argument to populate an attribute if no value for that attribute was supplied to the constructor. Alternatively, if the attribute is lazy, C executes when the attribute is first retrieved if no value has yet been provided. If a simple scalar is provided, it will be inlined as a string. Any non-code reference (hash, array) will result in an error - for that case instead use a code reference that returns the desired value. Note that if your default is fired during new() there is no guarantee that other attributes have been populated yet so you should not rely on their existence. L =item * C Takes a method name which will return true if an attribute has a value. If you set this to just C<1>, the predicate is automatically named C if your attribute's name does not start with an underscore, or C<_has_${attr_name_without_the_underscore}> if it does. This feature comes from L. =item * C Takes a method name which will be called to create the attribute - functions exactly like default except that instead of calling $default->($self); Moo will call $self->$builder; The following features come from L: If you set this to just C<1>, the builder is automatically named C<_build_${attr_name}>. If you set this to a coderef or code-convertible object, that variable will be installed under C<$class::_build_${attr_name}> and the builder set to the same name. =item * C Takes a method name which will clear the attribute. If you set this to just C<1>, the clearer is automatically named C if your attribute's name does not start with an underscore, or C<_clear_${attr_name_without_the_underscore}> if it does. This feature comes from L. B If the attribute is C, it will be regenerated from C or C the next time it is accessed. If it is not lazy, it will be C. =item * C B. Set this if you want values for the attribute to be grabbed lazily. This is usually a good idea if you have a L which requires another attribute to be set. =item * C B. Set this if the attribute must be passed on object instantiation. =item * C The name of the method that returns the value of the attribute. If you like Java style methods, you might set this to C =item * C The value of this attribute will be the name of the method to set the value of the attribute. If you like Java style methods, you might set this to C. =item * C B. Set this if you want the reference that the attribute contains to be weakened. Use this when circular references, which cause memory leaks, are possible. =item * C Takes the name of the key to look for at instantiation time of the object. A common use of this is to make an underscored attribute have a non-underscored initialization name. C means that passing the value in on instantiation is ignored. =item * C Takes either a coderef or array of coderefs which is meant to transform the given attributes specifications if necessary when upgrading to a Moose role or class. You shouldn't need this by default, but is provided as a means of possible extensibility. =back =head2 before before foo => sub { ... }; See L<< Class::Method::Modifiers/before method(s) => sub { ... }; >> for full documentation. =head2 around around foo => sub { ... }; See L<< Class::Method::Modifiers/around method(s) => sub { ... }; >> for full documentation. =head2 after after foo => sub { ... }; See L<< Class::Method::Modifiers/after method(s) => sub { ... }; >> for full documentation. =head1 SUB QUOTE AWARE L allows us to create coderefs that are "inlineable," giving us a handy, XS-free speed boost. Any option that is L aware can take advantage of this. To do this, you can write use Sub::Quote; use Moo; use namespace::clean; has foo => ( is => 'ro', isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 }) ); which will be inlined as do { local @_ = ($_[0]->{foo}); die "Not <3" unless $_[0] < 3; } or to avoid localizing @_, has foo => ( is => 'ro', isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 }) ); which will be inlined as do { my ($val) = ($_[0]->{foo}); die "Not <3" unless $val < 3; } See L for more information, including how to pass lexical captures that will also be compiled into the subroutine. =head1 CLEANING UP IMPORTS L will not clean up imported subroutines for you; you will have to do that manually. The recommended way to do this is to declare your imports first, then C, then C. Anything imported before L will be scrubbed. Anything imported or declared after will be still be available. package Record; use Digest::MD5 qw(md5_hex); use Moo; use namespace::clean; has name => (is => 'ro', required => 1); has id => (is => 'lazy'); sub _build_id { my ($self) = @_; return md5_hex($self->name); } 1; If you were to import C after L you would be able to call C<< ->md5_hex() >> on your C instances (and it probably wouldn't do what you expect!). Ls behave slightly differently. Since their methods are composed into the consuming class, they can do a little more for you automatically. As long as you declare your imports before calling C, those imports and the ones L itself provides will not be composed into consuming classes so there's usually no need to use L. B:> Older versions of L would inflate Moo classes to full L classes, losing the benefits of Moo. If you want to use L with a Moo class, make sure you are using version 0.16 or newer. =head1 INCOMPATIBILITIES WITH MOOSE There is no built-in type system. C is verified with a coderef; if you need complex types, L can provide types, type libraries, and will work seamlessly with both L and L. L can be considered the successor to L and provides a similar API, so that you can write use Types::Standard; has days_to_live => (is => 'ro', isa => Int); C is not supported in core since the author considers it to be a bad idea and Moose best practices recommend avoiding it. Meanwhile C or C are more likely to be able to fulfill your needs. There is no meta object. If you need this level of complexity you need L - Moo is small because it explicitly does not provide a metaprotocol. However, if you load L, then Class::MOP::class_of($moo_class_or_role) will return an appropriate metaclass pre-populated by L. No support for C, C, C, or C - the author considers augment to be a bad idea, and override can be translated: override foo => sub { ... super(); ... }; around foo => sub { my ($orig, $self) = (shift, shift); ... $self->$orig(@_); ... }; The C method is not provided by default. The author suggests loading L into C (via C for example) and using C<$obj-E$::Dwarn()> instead. L only supports coderefs and plain scalars, because passing a hash or array reference as a default is almost always incorrect since the value is then shared between all objects using that default. C is not supported; you are instead encouraged to use the C<< is => 'lazy' >> option supported by L and L. C is not supported since the author considers it a bad idea and it has been considered best practice to avoid it for some time. C will show up in a L metaclass created from your class but is otherwise ignored. Then again, L ignores it as well, so this is arguably not an incompatibility. Since C does not require C to be defined but L does require it, the metaclass inflation for coerce alone is a trifle insane and if you attempt to subtype the result will almost certainly break. C is not triggered if your class does not have any attributes. Without attributes, C return value would be ignored, so we just skip calling the method instead. Handling of warnings: when you C we enable strict and warnings, in a similar way to Moose. The authors recommend the use of C, which enables FATAL warnings, and several extra pragmas when used in development: L, L, and L. Additionally, L supports a set of attribute option shortcuts intended to reduce common boilerplate. The set of shortcuts is the same as in the L module L as of its version 0.009+. So if you: package MyClass; use Moo; use strictures 2; The nearest L invocation would be: package MyClass; use Moose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; or, if you're inheriting from a non-Moose class, package MyClass; use Moose; use MooseX::NonMoose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; Finally, Moose requires you to call __PACKAGE__->meta->make_immutable; at the end of your class to get an inlined (i.e. not horribly slow) constructor. Moo does it automatically the first time ->new is called on your class. (C is a no-op in Moo to ease migration.) An extension L exists to ease translating Moose packages to Moo by providing a more Moose-like interface. =head1 SUPPORT Users' IRC: #moose on irc.perl.org =for :html L<(click for instant chatroom login)|http://chat.mibbit.com/#moose@irc.perl.org> Development and contribution IRC: #web-simple on irc.perl.org =for :html L<(click for instant chatroom login)|http://chat.mibbit.com/#web-simple@irc.perl.org> Bugtracker: L Git repository: L Git browser: L =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) =head1 CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) mattp - Matt Phillips (cpan:MATTP) bluefeet - Aran Deltac (cpan:BLUEFEET) bubaflub - Bob Kuo (cpan:BUBAFLUB) ether = Karen Etheridge (cpan:ETHER) =head1 COPYRIGHT Copyright (c) 2010-2015 the Moo L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. See L. =cut Moo-2.000002/lib/oo.pm000644 000765 000024 00000002261 12554014037 014473 0ustar00gknopstaff000000 000000 package oo; use Moo::_strictures; use Moo::_Utils; sub moo { print <<'EOMOO'; ______ < Moo! > ------ \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || EOMOO exit 0; } BEGIN { my $package; sub import { moo() if $0 eq '-'; $package = $_[1] || 'Class'; if ($package =~ /^\+/) { $package =~ s/^\+//; _load_module($package); } } use Filter::Simple sub { s/^/package $package;\nuse Moo;\n/; } } 1; __END__ =head1 NAME oo - syntactic sugar for Moo oneliners =head1 SYNOPSIS perl -Moo=Foo -e 'has bar => ( is => q[ro], default => q[baz] ); print Foo->new->bar' # loads an existing class and re-"opens" the package definition perl -Moo=+My::Class -e 'print __PACKAGE__->new->bar' =head1 DESCRIPTION oo.pm is a simple source filter that adds C to the beginning of your script, intended for use on the command line via the -M option. =head1 SUPPORT See L for support and contact information. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Moo-2.000002/lib/Sub/000755 000765 000024 00000000000 12554434146 014257 5ustar00gknopstaff000000 000000 Moo-2.000002/lib/Sub/Defer.pm000644 000765 000024 00000010024 12554434121 015630 0ustar00gknopstaff000000 000000 package Sub::Defer; use Moo::_strictures; use Exporter qw(import); use Moo::_Utils qw(_getglob _install_coderef); use Scalar::Util qw(weaken); our $VERSION = '2.000002'; $VERSION = eval $VERSION; our @EXPORT = qw(defer_sub undefer_sub undefer_all); our @EXPORT_OK = qw(undefer_package); our %DEFERRED; sub undefer_sub { my ($deferred) = @_; my ($target, $maker, $undeferred_ref) = @{ $DEFERRED{$deferred}||return $deferred }; return ${$undeferred_ref} if ${$undeferred_ref}; ${$undeferred_ref} = my $made = $maker->(); # make sure the method slot has not changed since deferral time if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') { no warnings 'redefine'; # I believe $maker already evals with the right package/name, so that # _install_coderef calls are not necessary --ribasushi *{_getglob($target)} = $made; } $DEFERRED{$made} = $DEFERRED{$deferred}; weaken $DEFERRED{$made} unless $target; return $made; } sub undefer_all { undefer_sub($_) for keys %DEFERRED; return; } sub undefer_package { my $package = shift; my @subs = grep { $DEFERRED{$_}[0] =~ /^${package}::[^:]+$/ } keys %DEFERRED; undefer_sub($_) for @subs; return; } sub defer_info { my ($deferred) = @_; my $info = $DEFERRED{$deferred||''} or return undef; [ @$info ]; } sub defer_sub { my ($target, $maker) = @_; my $undeferred; my $deferred_info; my $deferred = sub { $undeferred ||= undefer_sub($deferred_info->[3]); goto &$undeferred; }; $deferred_info = [ $target, $maker, \$undeferred, $deferred ]; weaken($deferred_info->[3]); weaken($DEFERRED{$deferred} = $deferred_info); _install_coderef($target => $deferred) if defined $target; return $deferred; } sub CLONE { %DEFERRED = map { defined $_ && $_->[3] ? ($_->[3] => $_) : () } values %DEFERRED; foreach my $info (values %DEFERRED) { weaken($info) unless $info->[0] && ${$info->[2]}; } } 1; __END__ =head1 NAME Sub::Defer - defer generation of subroutines until they are first called =head1 SYNOPSIS use Sub::Defer; my $deferred = defer_sub 'Logger::time_since_first_log' => sub { my $t = time; sub { time - $t }; }; Logger->time_since_first_log; # returns 0 and replaces itself Logger->time_since_first_log; # returns time - $t =head1 DESCRIPTION These subroutines provide the user with a convenient way to defer creation of subroutines and methods until they are first called. =head1 SUBROUTINES =head2 defer_sub my $coderef = defer_sub $name => sub { ... }; This subroutine returns a coderef that encapsulates the provided sub - when it is first called, the provided sub is called and is -itself- expected to return a subroutine which will be goto'ed to on subsequent calls. If a name is provided, this also installs the sub as that name - and when the subroutine is undeferred will re-install the final version for speed. Exported by default. =head2 undefer_sub my $coderef = undefer_sub \&Foo::name; If the passed coderef has been L this will "undefer" it. If the passed coderef has not been deferred, this will just return it. If this is confusing, take a look at the example in the L. Exported by default. =head2 undefer_all undefer_all(); This will undefer all defered subs in one go. This can be very useful in a forking environment where child processes would each have to undefer the same subs. By calling this just before you start forking children you can undefer all currently deferred subs in the parent so that the children do not have to do it. Note this may bake the behavior of some subs that were intended to calculate their behavior later, so it shouldn't be used midway through a module load or class definition. Exported by default. =head2 undefer_package undefer_package($package); This undefers all defered subs in a package. Not exported by default. =head1 SUPPORT See L for support and contact information. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Moo-2.000002/lib/Sub/Quote.pm000644 000765 000024 00000021744 12554434121 015713 0ustar00gknopstaff000000 000000 package Sub::Quote; sub _clean_eval { eval $_[0] } use Moo::_strictures; use Sub::Defer qw(defer_sub); use Scalar::Util qw(weaken); use Exporter qw(import); use B (); BEGIN { *_HAVE_PERLSTRING = defined &B::perlstring ? sub(){1} : sub(){0}; } our $VERSION = '2.000002'; $VERSION = eval $VERSION; our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub qsub); our @EXPORT_OK = qw(quotify capture_unroll inlinify); our %QUOTED; sub quotify { ! defined $_[0] ? 'undef()' : _HAVE_PERLSTRING ? B::perlstring($_[0]) : qq["\Q$_[0]\E"]; } sub capture_unroll { my ($from, $captures, $indent) = @_; join( '', map { /^([\@\%\$])/ or die "capture key should start with \@, \% or \$: $_"; (' ' x $indent).qq{my ${_} = ${1}{${from}->{${\quotify $_}}};\n}; } keys %$captures ); } sub inlinify { my ($code, $args, $extra, $local) = @_; my $do = 'do { '.($extra||''); if ($code =~ s/^(\s*package\s+([a-zA-Z0-9:]+);)//) { $do .= $1; } if ($code =~ s{ \A((?:\#\ BEGIN\ quote_sub\ PRELUDE\n.*?\#\ END\ quote_sub\ PRELUDE\n)?\s*) (^\s*) my \s* \(([^)]+)\) \s* = \s* \@_; }{}xms) { my ($pre, $indent, $code_args) = ($1, $2, $3); $do .= $pre; if ($code_args ne $args) { $do .= $indent . 'my ('.$code_args.') = ('.$args.'); '; } } elsif ($local || $args ne '@_') { $do .= ($local ? 'local ' : '').'@_ = ('.$args.'); '; } $do.$code.' }'; } sub quote_sub { # HOLY DWIMMERY, BATMAN! # $name => $code => \%captures => \%options # $name => $code => \%captures # $name => $code # $code => \%captures => \%options # $code my $options = (ref($_[-1]) eq 'HASH' and ref($_[-2]) eq 'HASH') ? pop : {}; my $captures = ref($_[-1]) eq 'HASH' ? pop : undef; undef($captures) if $captures && !keys %$captures; my $code = pop; my $name = $_[0]; my ($package, $hints, $bitmask, $hintshash) = (caller(0))[0,8,9,10]; my $context ="# BEGIN quote_sub PRELUDE\n" ."package $package;\n" ."BEGIN {\n" ." \$^H = ".quotify($hints).";\n" ." \${^WARNING_BITS} = ".quotify($bitmask).";\n" ." \%^H = (\n" . join('', map " ".quotify($_)." => ".quotify($hintshash->{$_}).",", keys %$hintshash) ." );\n" ."}\n" ."# END quote_sub PRELUDE\n"; $code = "$context$code"; my $quoted_info; my $unquoted; my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub { $unquoted if 0; unquote_sub($quoted_info->[4]); }; $quoted_info = [ $name, $code, $captures, \$unquoted, $deferred ]; weaken($quoted_info->[3]); weaken($quoted_info->[4]); weaken($QUOTED{$deferred} = $quoted_info); return $deferred; } sub quoted_from_sub { my ($sub) = @_; my $quoted_info = $QUOTED{$sub||''} or return undef; my ($name, $code, $captured, $unquoted, $deferred) = @{$quoted_info}; $unquoted &&= $$unquoted; if (($deferred && $deferred eq $sub) || ($unquoted && $unquoted eq $sub)) { return [ $name, $code, $captured, $unquoted, $deferred ]; } return undef; } sub unquote_sub { my ($sub) = @_; my $quoted = $QUOTED{$sub} or return undef; my $unquoted = $quoted->[3]; unless ($unquoted && $$unquoted) { my ($name, $code, $captures) = @$quoted; my $make_sub = "{\n"; my %captures = $captures ? %$captures : (); $captures{'$_UNQUOTED'} = \$unquoted; $captures{'$_QUOTED'} = \$quoted; $make_sub .= capture_unroll("\$_[1]", \%captures, 2); $make_sub .= ( $name # disable the 'variable $x will not stay shared' warning since # we're not letting it escape from this scope anyway so there's # nothing trying to share it ? " no warnings 'closure';\n sub ${name} {\n" : " \$\$_UNQUOTED = sub {\n" ); $make_sub .= " \$_QUOTED if 0;\n"; $make_sub .= " \$_UNQUOTED if 0;\n"; $make_sub .= $code; $make_sub .= " }".($name ? '' : ';')."\n"; if ($name) { $make_sub .= " \$\$_UNQUOTED = \\&${name}\n"; } $make_sub .= "}\n1;\n"; $ENV{SUB_QUOTE_DEBUG} && warn $make_sub; { no strict 'refs'; local *{$name} if $name; my ($success, $e); { local $@; $success = _clean_eval($make_sub, \%captures); $e = $@; } unless ($success) { die "Eval went very, very wrong:\n\n${make_sub}\n\n$e"; } weaken($QUOTED{$$unquoted} = $quoted); } } $$unquoted; } sub qsub ($) { goto "e_sub; } sub CLONE { %QUOTED = map { defined $_ ? ( $_->[3] && ${$_->[3]} ? (${ $_->[3] } => $_) : (), $_->[4] ? ($_->[4] => $_) : (), ) : () } values %QUOTED; weaken($_) for values %QUOTED; } 1; __END__ =head1 NAME Sub::Quote - efficient generation of subroutines via string eval =head1 SYNOPSIS package Silly; use Sub::Quote qw(quote_sub unquote_sub quoted_from_sub); quote_sub 'Silly::kitty', q{ print "meow" }; quote_sub 'Silly::doggy', q{ print "woof" }; my $sound = 0; quote_sub 'Silly::dagron', q{ print ++$sound % 2 ? 'burninate' : 'roar' }, { '$sound' => \$sound }; And elsewhere: Silly->kitty; # meow Silly->doggy; # woof Silly->dagron; # burninate Silly->dagron; # roar Silly->dagron; # burninate =head1 DESCRIPTION This package provides performant ways to generate subroutines from strings. =head1 SUBROUTINES =head2 quote_sub my $coderef = quote_sub 'Foo::bar', q{ print $x++ . "\n" }, { '$x' => \0 }; Arguments: ?$name, $code, ?\%captures, ?\%options C<$name> is the subroutine where the coderef will be installed. C<$code> is a string that will be turned into code. C<\%captures> is a hashref of variables that will be made available to the code. The keys should be the full name of the variable to be made available, including the sigil. The values should be references to the values. The variables will contain copies of the values. See the L's C for an example using captures. =head3 options =over 2 =item * no_install B. Set this option to not install the generated coderef into the passed subroutine name on undefer. =back =head2 unquote_sub my $coderef = unquote_sub $sub; Forcibly replace subroutine with actual code. If $sub is not a quoted sub, this is a no-op. =head2 quoted_from_sub my $data = quoted_from_sub $sub; my ($name, $code, $captures, $compiled_sub) = @$data; Returns original arguments to quote_sub, plus the compiled version if this sub has already been unquoted. Note that $sub can be either the original quoted version or the compiled version for convenience. =head2 inlinify my $prelude = capture_unroll '$captures', { '$x' => 1, '$y' => 2, }, 4; my $inlined_code = inlinify q{ my ($x, $y) = @_; print $x + $y . "\n"; }, '$x, $y', $prelude; Takes a string of code, a string of arguments, a string of code which acts as a "prelude", and a B representing whether or not to localize the arguments. =head2 quotify my $quoted_value = quotify $value; Quotes a single (non-reference) scalar value for use in a code string. Numbers aren't treated specially and will be quoted as strings, but undef will quoted as C. =head2 capture_unroll my $prelude = capture_unroll '$captures', { '$x' => 1, '$y' => 2, }, 4; Arguments: $from, \%captures, $indent Generates a snippet of code which is suitable to be used as a prelude for L. C<$from> is a string will be used as a hashref in the resulting code. The keys of C<%captures> are the names of the variables and the values are ignored. C<$indent> is the number of spaces to indent the result by. =head2 qsub my $hash = { coderef => qsub q{ print "hello"; }, other => 5, }; Arguments: $code Works exactly like L, but includes a prototype to only accept a single parameter. This makes it easier to include in hash structures or lists. =head1 CAVEATS Much of this is just string-based code-generation, and as a result, a few caveats apply. =head2 return Calling C from a quote_sub'ed sub will not likely do what you intend. Instead of returning from the code you defined in C, it will return from the overall function it is composited into. So when you pass in: quote_sub q{ return 1 if $condition; $morecode } It might turn up in the intended context as follows: sub foo { do { return 1 if $condition; $morecode }; } Which will obviously return from foo, when all you meant to do was return from the code context in quote_sub and proceed with running important code b. =head2 pragmas C preserves the environment of the code creating the quoted subs. This includes the package, strict, warnings, and any other lexical pragmas. This is done by prefixing the code with a block that sets up a matching environment. When inlining C subs, care should be taken that user pragmas won't effect the rest of the code. =head1 SUPPORT See L for support and contact information. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Moo-2.000002/lib/Moo/_mro.pm000644 000765 000024 00000000162 12554014037 015542 0ustar00gknopstaff000000 000000 package Moo::_mro; use Moo::_strictures; if ($] >= 5.010) { require mro; } else { require MRO::Compat; } 1; Moo-2.000002/lib/Moo/_strictures.pm000644 000765 000024 00000000420 12554014037 017151 0ustar00gknopstaff000000 000000 package Moo::_strictures; use strict; use warnings; sub import { if ($ENV{MOO_FATAL_WARNINGS}) { require strictures; strictures->VERSION(2); @_ = ('strictures'); goto &strictures::import; } else { strict->import; warnings->import; } } 1; Moo-2.000002/lib/Moo/_Utils.pm000644 000765 000024 00000007164 12554014037 016056 0ustar00gknopstaff000000 000000 package Moo::_Utils; no warnings 'once'; # guard against -w sub _getglob { \*{$_[0]} } sub _getstash { \%{"$_[0]::"} } use constant lt_5_8_3 => ( $] < 5.008003 or $ENV{MOO_TEST_PRE_583} ) ? 1 : 0; use constant can_haz_subutil => ( $INC{"Sub/Util.pm"} || ( !$INC{"Sub/Name.pm"} && eval { require Sub::Util } ) ) && defined &Sub::Util::set_subname; use constant can_haz_subname => ( $INC{"Sub/Name.pm"} || ( !$INC{"Sub/Util.pm"} && eval { require Sub::Name } ) ) && defined &Sub::Name::subname; use Moo::_strictures; use Module::Runtime qw(use_package_optimistically module_notional_filename); use Devel::GlobalDestruction (); use Exporter qw(import); use Moo::_mro; use Config; our @EXPORT = qw( _getglob _install_modifier _load_module _maybe_load_module _get_linear_isa _getstash _install_coderef _name_coderef _unimport_coderefs _in_global_destruction _set_loaded ); sub _in_global_destruction (); *_in_global_destruction = \&Devel::GlobalDestruction::in_global_destruction; sub _install_modifier { my ($into, $type, $name, $code) = @_; if (my $to_modify = $into->can($name)) { # CMM will throw for us if not require Sub::Defer; Sub::Defer::undefer_sub($to_modify); } Class::Method::Modifiers::install_modifier(@_); } our %MAYBE_LOADED; sub _load_module { my $module = $_[0]; my $file = module_notional_filename($module); use_package_optimistically($module); return 1 if $INC{$file}; my $error = $@ || "Can't locate $file"; # can't just ->can('can') because a sub-package Foo::Bar::Baz # creates a 'Baz::' key in Foo::Bar's symbol table my $stash = _getstash($module)||{}; return 1 if grep +(!ref($_) and *$_{CODE}), values %$stash; return 1 if $INC{"Moose.pm"} && Class::MOP::class_of($module) or Mouse::Util->can('find_meta') && Mouse::Util::find_meta($module); die $error; } sub _maybe_load_module { my $module = $_[0]; return $MAYBE_LOADED{$module} if exists $MAYBE_LOADED{$module}; if(! eval { use_package_optimistically($module) }) { warn "$module exists but failed to load with error: $@"; } elsif ( $INC{module_notional_filename($module)} ) { return $MAYBE_LOADED{$module} = 1; } return $MAYBE_LOADED{$module} = 0; } sub _set_loaded { $INC{Module::Runtime::module_notional_filename($_[0])} ||= $_[1]; } sub _get_linear_isa { return mro::get_linear_isa($_[0]); } sub _install_coderef { my ($glob, $code) = (_getglob($_[0]), _name_coderef(@_)); no warnings 'redefine'; if (*{$glob}{CODE}) { *{$glob} = $code; } # perl will sometimes warn about mismatched prototypes coming from the # inheritance cache, so disable them if we aren't redefining a sub else { no warnings 'prototype'; *{$glob} = $code; } } sub _name_coderef { shift if @_ > 2; # three args is (target, name, sub) can_haz_subutil ? Sub::Util::set_subname(@_) : can_haz_subname ? Sub::Name::subname(@_) : $_[1]; } sub _unimport_coderefs { my ($target, $info) = @_; return unless $info and my $exports = $info->{exports}; my %rev = reverse %$exports; my $stash = _getstash($target); foreach my $name (keys %$exports) { if ($stash->{$name} and defined(&{$stash->{$name}})) { if ($rev{$target->can($name)}) { my $old = delete $stash->{$name}; my $full_name = join('::',$target,$name); # Copy everything except the code slot back into place (e.g. $has) foreach my $type (qw(SCALAR HASH ARRAY IO)) { next unless defined(*{$old}{$type}); no strict 'refs'; *$full_name = *{$old}{$type}; } } } } } if ($Config{useithreads}) { require Moo::HandleMoose::_TypeMap; } 1; Moo-2.000002/lib/Moo/HandleMoose/000755 000765 000024 00000000000 12554434146 016456 5ustar00gknopstaff000000 000000 Moo-2.000002/lib/Moo/HandleMoose.pm000644 000765 000024 00000016505 12554014037 017014 0ustar00gknopstaff000000 000000 package Moo::HandleMoose; use Moo::_strictures; no warnings 'once'; use Moo::_Utils; use Sub::Quote qw(quotify); our %TYPE_MAP; our $SETUP_DONE; sub import { return if $SETUP_DONE; inject_all(); $SETUP_DONE = 1; } sub inject_all { die "Can't inflate Moose metaclass with Moo::sification disabled" if $Moo::sification::disabled; require Class::MOP; inject_fake_metaclass_for($_) for grep $_ ne 'Moo::Object', do { no warnings 'once'; keys %Moo::MAKERS }; inject_fake_metaclass_for($_) for keys %Moo::Role::INFO; require Moose::Meta::Method::Constructor; @Moo::HandleMoose::FakeConstructor::ISA = 'Moose::Meta::Method::Constructor'; @Moo::HandleMoose::FakeMeta::ISA = 'Moose::Meta::Method::Meta'; } sub maybe_reinject_fake_metaclass_for { my ($name) = @_; our %DID_INJECT; if (delete $DID_INJECT{$name}) { unless ($Moo::Role::INFO{$name}) { Moo->_constructor_maker_for($name)->install_delayed; } inject_fake_metaclass_for($name); } } sub inject_fake_metaclass_for { my ($name) = @_; require Class::MOP; require Moo::HandleMoose::FakeMetaClass; Class::MOP::store_metaclass_by_name( $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass') ); require Moose::Util::TypeConstraints; if ($Moo::Role::INFO{$name}) { Moose::Util::TypeConstraints::find_or_create_does_type_constraint($name); } else { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($name); } } { package Moo::HandleMoose::FakeConstructor; sub _uninlined_body { \&Moose::Object::new } } sub inject_real_metaclass_for { my ($name) = @_; our %DID_INJECT; return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name}; require Moose; require Moo; require Moo::Role; require Scalar::Util; Class::MOP::remove_metaclass_by_name($name); my ($am_role, $am_class, $meta, $attr_specs, $attr_order) = do { if (my $info = $Moo::Role::INFO{$name}) { my @attr_info = @{$info->{attributes}||[]}; (1, 0, Moose::Meta::Role->initialize($name), { @attr_info }, [ @attr_info[grep !($_ % 2), 0..$#attr_info] ] ) } elsif ( my $cmaker = Moo->_constructor_maker_for($name) ) { my $specs = $cmaker->all_attribute_specs; (0, 1, Moose::Meta::Class->initialize($name), $specs, [ sort { $specs->{$a}{index} <=> $specs->{$b}{index} } keys %$specs ] ); } else { # This codepath is used if $name does not exist in $Moo::MAKERS (0, 0, Moose::Meta::Class->initialize($name), {}, [] ) } }; foreach my $spec (values %$attr_specs) { if (my $inflators = delete $spec->{moosify}) { $_->($spec) for @$inflators; } } my %methods = %{($am_role ? 'Moo::Role' : 'Moo')->_concrete_methods_of($name)}; # if stuff gets added afterwards, _maybe_reset_handlemoose should # trigger the recreation of the metaclass but we need to ensure the # Moo::Role cache is cleared so we don't confuse Moo itself. if (my $info = $Moo::Role::INFO{$name}) { delete $info->{methods}; } # needed to ensure the method body is stable and get things named Sub::Defer::undefer_sub($_) for grep defined, values %methods; my @attrs; { # This local is completely not required for roles but harmless local @{_getstash($name)}{keys %methods}; my %seen_name; foreach my $name (@$attr_order) { $seen_name{$name} = 1; my %spec = %{$attr_specs->{$name}}; my %spec_map = ( map { $_->name => $_->init_arg||$_->name } ( (grep { $_->has_init_arg } $meta->attribute_metaclass->meta->get_all_attributes), grep { exists($_->{init_arg}) ? defined($_->init_arg) : 1 } map { my $meta = Moose::Util::resolve_metatrait_alias('Attribute', $_) ->meta; map $meta->get_attribute($_), $meta->get_attribute_list } @{$spec{traits}||[]} ) ); # have to hard code this because Moose's role meta-model is lacking $spec_map{traits} ||= 'traits'; $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp'; my $coerce = $spec{coerce}; if (my $isa = $spec{isa}) { my $tc = $spec{isa} = do { if (my $mapped = $TYPE_MAP{$isa}) { my $type = $mapped->(); unless ( Scalar::Util::blessed($type) && $type->isa("Moose::Meta::TypeConstraint") ) { die "error inflating attribute '$name' for package '$_[0]': " ."\$TYPE_MAP{$isa} did not return a valid type constraint'"; } $coerce ? $type->create_child_type(name => $type->name) : $type; } else { Moose::Meta::TypeConstraint->new( constraint => sub { eval { &$isa; 1 } } ); } }; if ($coerce) { $tc->coercion(Moose::Meta::TypeCoercion->new) ->_compiled_type_coercion($coerce); $spec{coerce} = 1; } } elsif ($coerce) { my $attr = quotify($name); my $tc = Moose::Meta::TypeConstraint->new( constraint => sub { die "This is not going to work" }, inlined => sub { 'my $r = $_[42]{'.$attr.'}; $_[42]{'.$attr.'} = 1; $r' }, ); $tc->coercion(Moose::Meta::TypeCoercion->new) ->_compiled_type_coercion($coerce); $spec{isa} = $tc; $spec{coerce} = 1; } %spec = map { $spec_map{$_} => $spec{$_} } grep { exists $spec_map{$_} } keys %spec; push @attrs, $meta->add_attribute($name => %spec); } foreach my $mouse (do { our %MOUSE; @{$MOUSE{$name}||[]} }) { foreach my $attr ($mouse->get_all_attributes) { my %spec = %{$attr}; delete @spec{qw( associated_class associated_methods __METACLASS__ provides curries )}; my $name = delete $spec{name}; next if $seen_name{$name}++; push @attrs, $meta->add_attribute($name => %spec); } } } foreach my $meth_name (keys %methods) { my $meth_code = $methods{$meth_name}; $meta->add_method($meth_name, $meth_code) if $meth_code; } if ($am_role) { my $info = $Moo::Role::INFO{$name}; $meta->add_required_methods(@{$info->{requires}}); foreach my $modifier (@{$info->{modifiers}}) { my ($type, @args) = @$modifier; my $code = pop @args; $meta->${\"add_${type}_method_modifier"}($_, $code) for @args; } } elsif ($am_class) { foreach my $attr (@attrs) { foreach my $method (@{$attr->associated_methods}) { $method->{body} = $name->can($method->name); } } bless( $meta->find_method_by_name('new'), 'Moo::HandleMoose::FakeConstructor', ); my $meta_meth; if ( $meta_meth = $meta->find_method_by_name('meta') and $meta_meth->body == \&Moo::Object::meta ) { bless($meta_meth, 'Moo::HandleMoose::FakeMeta'); } # a combination of Moo and Moose may bypass a Moo constructor but still # use a Moo DEMOLISHALL. We need to make sure this is loaded before # global destruction. require Method::Generate::DemolishAll; } $meta->add_role(Class::MOP::class_of($_)) for grep !/\|/ && $_ ne $name, # reject Foo|Bar and same-role-as-self do { no warnings 'once'; keys %{$Moo::Role::APPLIED_TO{$name}} }; $DID_INJECT{$name} = 1; $meta; } 1; Moo-2.000002/lib/Moo/Object.pm000644 000765 000024 00000003763 12554171201 016023 0ustar00gknopstaff000000 000000 package Moo::Object; use Moo::_strictures; our %NO_BUILD; our %NO_DEMOLISH; our $BUILD_MAKER; our $DEMOLISH_MAKER; sub new { my $class = shift; unless (exists $NO_DEMOLISH{$class}) { unless ($NO_DEMOLISH{$class} = !$class->can('DEMOLISH')) { ($DEMOLISH_MAKER ||= do { require Method::Generate::DemolishAll; Method::Generate::DemolishAll->new })->generate_method($class); } } my $proto = $class->BUILDARGS(@_); $NO_BUILD{$class} and return bless({}, $class); $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class}; $NO_BUILD{$class} ? bless({}, $class) : bless({}, $class)->BUILDALL($proto); } # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync sub BUILDARGS { my $class = shift; if ( scalar @_ == 1 ) { unless ( defined $_[0] && ref $_[0] eq 'HASH' ) { die "Single parameters to new() must be a HASH ref" ." data => ". $_[0] ."\n"; } return { %{ $_[0] } }; } elsif ( @_ % 2 ) { die "The new() method for $class expects a hash reference or a" . " key/value list. You passed an odd number of arguments\n"; } else { return {@_}; } } sub BUILDALL { my $self = shift; $self->${\(($BUILD_MAKER ||= do { require Method::Generate::BuildAll; Method::Generate::BuildAll->new })->generate_method(ref($self)))}(@_); } sub DEMOLISHALL { my $self = shift; $self->${\(($DEMOLISH_MAKER ||= do { require Method::Generate::DemolishAll; Method::Generate::DemolishAll->new })->generate_method(ref($self)))}(@_); } sub does { return !!0 unless ($INC{'Moose/Role.pm'} || $INC{'Role/Tiny.pm'}); require Moo::Role; my $does = Moo::Role->can("does_role"); { no warnings 'redefine'; *does = $does } goto &$does; } # duplicated in Moo::Role sub meta { require Moo::HandleMoose::FakeMetaClass; my $class = ref($_[0])||$_[0]; bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass'); } 1; Moo-2.000002/lib/Moo/Role.pm000644 000765 000024 00000033257 12554434121 015522 0ustar00gknopstaff000000 000000 package Moo::Role; use Moo::_strictures; use Moo::_Utils; use Role::Tiny (); our @ISA = qw(Role::Tiny); our $VERSION = '2.000002'; $VERSION = eval $VERSION; require Moo::sification; Moo::sification->import; BEGIN { *INFO = \%Role::Tiny::INFO; *APPLIED_TO = \%Role::Tiny::APPLIED_TO; *ON_ROLE_CREATE = \@Role::Tiny::ON_ROLE_CREATE; } our %INFO; our %APPLIED_TO; our %APPLY_DEFAULTS; our @ON_ROLE_CREATE; sub _install_tracked { my ($target, $name, $code) = @_; $INFO{$target}{exports}{$name} = $code; _install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code; } sub import { my $target = caller; my ($me) = @_; _set_loaded(caller); strict->import; warnings->import; if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) { die "Cannot import Moo::Role into a Moo class"; } $INFO{$target} ||= {}; # get symbol table reference my $stash = _getstash($target); _install_tracked $target => has => sub { my $name_proto = shift; my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto; if (@_ % 2 != 0) { require Carp; Carp::croak("Invalid options for " . join(', ', map "'$_'", @name_proto) . " attribute(s): even number of arguments expected, got " . scalar @_) } my %spec = @_; foreach my $name (@name_proto) { my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; ($INFO{$target}{accessor_maker} ||= do { require Method::Generate::Accessor; Method::Generate::Accessor->new })->generate_method($target, $name, $spec_ref); push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref; $me->_maybe_reset_handlemoose($target); } }; # install before/after/around subs foreach my $type (qw(before after around)) { _install_tracked $target => $type => sub { require Class::Method::Modifiers; push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ]; $me->_maybe_reset_handlemoose($target); }; } _install_tracked $target => requires => sub { push @{$INFO{$target}{requires}||=[]}, @_; $me->_maybe_reset_handlemoose($target); }; _install_tracked $target => with => sub { $me->apply_roles_to_package($target, @_); $me->_maybe_reset_handlemoose($target); }; return if $me->is_role($target); # already exported into this package $INFO{$target}{is_role} = 1; *{_getglob("${target}::meta")} = $me->can('meta'); # grab all *non-constant* (stash slot is not a scalarref) subs present # in the symbol table and store their refaddrs (no need to forcibly # inflate constant subs into real subs) - also add '' to here (this # is used later) with a map to the coderefs in case of copying or re-use my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash); @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; # a role does itself $APPLIED_TO{$target} = { $target => undef }; $_->($target) for @ON_ROLE_CREATE; } push @ON_ROLE_CREATE, sub { my $target = shift; if ($INC{'Moo/HandleMoose.pm'}) { Moo::HandleMoose::inject_fake_metaclass_for($target); } }; # duplicate from Moo::Object sub meta { require Moo::HandleMoose::FakeMetaClass; my $class = ref($_[0])||$_[0]; bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass'); } sub unimport { my $target = caller; _unimport_coderefs($target, $INFO{$target}); } sub _maybe_reset_handlemoose { my ($class, $target) = @_; if ($INC{"Moo/HandleMoose.pm"}) { Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target); } } sub methods_provided_by { my ($self, $role) = @_; _load_module($role); $self->_inhale_if_moose($role); die "${role} is not a Moo::Role" unless $self->is_role($role); return $self->SUPER::methods_provided_by($role); } sub is_role { my ($self, $role) = @_; $self->_inhale_if_moose($role); $self->SUPER::is_role($role); } sub _inhale_if_moose { my ($self, $role) = @_; my $meta; if (!$self->SUPER::is_role($role) and ( $INC{"Moose.pm"} and $meta = Class::MOP::class_of($role) and ref $meta ne 'Moo::HandleMoose::FakeMetaClass' and $meta->isa('Moose::Meta::Role') ) or ( Mouse::Util->can('find_meta') and $meta = Mouse::Util::find_meta($role) and $meta->isa('Mouse::Meta::Role') ) ) { my $is_mouse = $meta->isa('Mouse::Meta::Role'); $INFO{$role}{methods} = { map +($_ => $role->can($_)), grep $role->can($_), grep !($is_mouse && $_ eq 'meta'), grep !$meta->get_method($_)->isa('Class::MOP::Method::Meta'), $meta->get_method_list }; $APPLIED_TO{$role} = { map +($_->name => 1), $meta->calculate_all_roles }; $INFO{$role}{requires} = [ $meta->get_required_method_list ]; $INFO{$role}{attributes} = [ map +($_ => do { my $attr = $meta->get_attribute($_); my $spec = { %{ $is_mouse ? $attr : $attr->original_options } }; if ($spec->{isa}) { my $get_constraint = do { my $pkg = $is_mouse ? 'Mouse::Util::TypeConstraints' : 'Moose::Util::TypeConstraints'; _load_module($pkg); $pkg->can('find_or_create_isa_type_constraint'); }; my $tc = $get_constraint->($spec->{isa}); my $check = $tc->_compiled_type_constraint; $spec->{isa} = sub { &$check or die "Type constraint failed for $_[0]" }; if ($spec->{coerce}) { # Mouse has _compiled_type_coercion straight on the TC object $spec->{coerce} = $tc->${\( $tc->can('coercion')||sub { $_[0] } )}->_compiled_type_coercion; } } $spec; }), $meta->get_attribute_list ]; my $mods = $INFO{$role}{modifiers} = []; foreach my $type (qw(before after around)) { # Mouse pokes its own internals so we have to fall back to doing # the same thing in the absence of the Moose API method my $map = $meta->${\( $meta->can("get_${type}_method_modifiers_map") or sub { shift->{"${type}_method_modifiers"} } )}; foreach my $method (keys %$map) { foreach my $mod (@{$map->{$method}}) { push @$mods, [ $type => $method => $mod ]; } } } require Class::Method::Modifiers if @$mods; $INFO{$role}{inhaled_from_moose} = 1; $INFO{$role}{is_role} = 1; } } sub _maybe_make_accessors { my ($self, $target, $role) = @_; my $m; if ($INFO{$role} && $INFO{$role}{inhaled_from_moose} or $INC{"Moo.pm"} and $m = Moo->_accessor_maker_for($target) and ref($m) ne 'Method::Generate::Accessor') { $self->_make_accessors($target, $role); } } sub _make_accessors_if_moose { my ($self, $target, $role) = @_; if ($INFO{$role} && $INFO{$role}{inhaled_from_moose}) { $self->_make_accessors($target, $role); } } sub _make_accessors { my ($self, $target, $role) = @_; my $acc_gen = ($Moo::MAKERS{$target}{accessor} ||= do { require Method::Generate::Accessor; Method::Generate::Accessor->new }); my $con_gen = $Moo::MAKERS{$target}{constructor}; my @attrs = @{$INFO{$role}{attributes}||[]}; while (my ($name, $spec) = splice @attrs, 0, 2) { # needed to ensure we got an index for an arrayref based generator if ($con_gen) { $spec = $con_gen->all_attribute_specs->{$name}; } $acc_gen->generate_method($target, $name, $spec); } } sub role_application_steps { qw(_handle_constructor _maybe_make_accessors), $_[0]->SUPER::role_application_steps; } sub apply_roles_to_package { my ($me, $to, @roles) = @_; foreach my $role (@roles) { _load_module($role); $me->_inhale_if_moose($role); die "${role} is not a Moo::Role" unless $me->is_role($role); } $me->SUPER::apply_roles_to_package($to, @roles); } sub apply_single_role_to_package { my ($me, $to, $role) = @_; _load_module($role); $me->_inhale_if_moose($role); die "${role} is not a Moo::Role" unless $me->is_role($role); $me->SUPER::apply_single_role_to_package($to, $role); } sub create_class_with_roles { my ($me, $superclass, @roles) = @_; my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles); return $new_name if $Role::Tiny::COMPOSED{class}{$new_name}; foreach my $role (@roles) { _load_module($role); $me->_inhale_if_moose($role); } my $m; if ($INC{"Moo.pm"} and $m = Moo->_accessor_maker_for($superclass) and ref($m) ne 'Method::Generate::Accessor') { # old fashioned way time. *{_getglob("${new_name}::ISA")} = [ $superclass ]; $Moo::MAKERS{$new_name} = {is_class => 1}; $me->apply_roles_to_package($new_name, @roles); _set_loaded($new_name, (caller)[1]); return $new_name; } $me->SUPER::create_class_with_roles($superclass, @roles); foreach my $role (@roles) { die "${role} is not a Moo::Role" unless $me->is_role($role); } $Moo::MAKERS{$new_name} = {is_class => 1}; $me->_handle_constructor($new_name, $_) for @roles; _set_loaded($new_name, (caller)[1]); return $new_name; } sub apply_roles_to_object { my ($me, $object, @roles) = @_; my $new = $me->SUPER::apply_roles_to_object($object, @roles); _set_loaded(ref $new, (caller)[1]); my $apply_defaults = $APPLY_DEFAULTS{ref $new} ||= do { my %attrs = map { @{$INFO{$_}{attributes}||[]} } @roles; if ($INC{'Moo.pm'} and keys %attrs and my $con_gen = Moo->_constructor_maker_for(ref $new) and my $m = Moo->_accessor_maker_for(ref $new)) { require Sub::Quote; my $specs = $con_gen->all_attribute_specs; my $assign = "{no warnings 'void';\n"; my %captures; foreach my $name ( keys %attrs ) { my $spec = $specs->{$name}; if ($m->has_eager_default($name, $spec)) { my ($has, $has_cap) = $m->generate_simple_has('$_[0]', $name, $spec); my ($code, $pop_cap) = $m->generate_use_default('$_[0]', $name, $spec, $has); $assign .= $code . ";\n"; @captures{keys %$has_cap, keys %$pop_cap} = (values %$has_cap, values %$pop_cap); } } $assign .= "}"; Sub::Quote::quote_sub($assign, \%captures); } else { sub {}; } }; $new->$apply_defaults; return $new; } sub _composable_package_for { my ($self, $role) = @_; my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; return $composed_name if $Role::Tiny::COMPOSED{role}{$composed_name}; $self->_make_accessors_if_moose($composed_name, $role); $self->SUPER::_composable_package_for($role); } sub _install_single_modifier { my ($me, @args) = @_; _install_modifier(@args); } sub _install_does { my ($me, $to) = @_; # If Role::Tiny actually installed the DOES, give it a name my $new = $me->SUPER::_install_does($to) or return; return _name_coderef("${to}::DOES", $new); } sub does_role { my ($proto, $role) = @_; return 1 if Role::Tiny::does_role($proto, $role); my $meta; if ($INC{'Moose.pm'} and $meta = Class::MOP::class_of($proto) and ref $meta ne 'Moo::HandleMoose::FakeMetaClass' and $meta->can('does_role') ) { return $meta->does_role($role); } return 0; } sub _handle_constructor { my ($me, $to, $role) = @_; my $attr_info = $INFO{$role} && $INFO{$role}{attributes}; return unless $attr_info && @$attr_info; my $info = $INFO{$to}; my $con = $INC{"Moo.pm"} && Moo->_constructor_maker_for($to); my %existing = $info ? @{$info->{attributes} || []} : $con ? %{$con->all_attribute_specs || {}} : (); my @attr_info = map { @{$attr_info}[$_, $_+1] } grep { ! $existing{$attr_info->[$_]} } map { 2 * $_ } 0..@$attr_info/2-1; if ($info) { push @{$info->{attributes}||=[]}, @attr_info; } elsif ($con) { # shallow copy of the specs since the constructor will assign an index $con->register_attribute_specs(map ref() ? { %$_ } : $_, @attr_info); } } 1; __END__ =head1 NAME Moo::Role - Minimal Object Orientation support for Roles =head1 SYNOPSIS package My::Role; use Moo::Role; use strictures 2; sub foo { ... } sub bar { ... } has baz => ( is => 'ro', ); 1; And elsewhere: package Some::Class; use Moo; use strictures 2; # bar gets imported, but not foo with('My::Role'); sub foo { ... } 1; =head1 DESCRIPTION C builds upon L, so look there for most of the documentation on how this works. The main addition here is extra bits to make the roles more "Moosey;" which is to say, it adds L. =head1 IMPORTED SUBROUTINES See L for all the other subroutines that are imported by this module. =head2 has has attr => ( is => 'ro', ); Declares an attribute for the class to be composed into. See L for all options. =head1 CLEANING UP IMPORTS L cleans up its own imported methods and any imports declared before the C statement automatically. Anything imported after C will be composed into consuming packages. A package that consumes this role: package My::Role::ID; use Digest::MD5 qw(md5_hex); use Moo::Role; use Digest::SHA qw(sha1_hex); requires 'name'; sub as_md5 { my ($self) = @_; return md5_hex($self->name); } sub as_sha1 { my ($self) = @_; return sha1_hex($self->name); } 1; ..will now have a C<< $self->sha1_hex() >> method available to it that probably does not do what you expect. On the other hand, a call to C<< $self->md5_hex() >> will die with the helpful error message: C. See L for more details. =head1 SUPPORT See L for support and contact information. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Moo-2.000002/lib/Moo/sification.pm000644 000765 000024 00000001246 12554014037 016742 0ustar00gknopstaff000000 000000 package Moo::sification; use Moo::_strictures; no warnings 'once'; use Devel::GlobalDestruction qw(in_global_destruction); sub unimport { die "Can't disable Moo::sification after inflation has been done" if $Moo::HandleMoose::SETUP_DONE; our $disabled = 1; } sub Moo::HandleMoose::AuthorityHack::DESTROY { unless (our $disabled or in_global_destruction) { require Moo::HandleMoose; Moo::HandleMoose->import; } } sub import { return if our $setup_done; if ($INC{"Moose.pm"}) { require Moo::HandleMoose; Moo::HandleMoose->import; } else { $Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack'); } $setup_done = 1; } 1; Moo-2.000002/lib/Moo/HandleMoose/_TypeMap.pm000644 000765 000024 00000003051 12554014037 020522 0ustar00gknopstaff000000 000000 package Moo::HandleMoose::_TypeMap; use Moo::_strictures; package Moo::HandleMoose; our %TYPE_MAP; package Moo::HandleMoose::_TypeMap; use Scalar::Util (); use Config; our %WEAK_TYPES; sub _str_to_ref { my $in = shift; return $in if ref $in; if ($in =~ /(?:^|=)[A-Z]+\(0x([0-9a-zA-Z]+)\)$/) { my $id = do { no warnings 'portable'; hex "$1" }; require B; my $sv = bless \$id, 'B::SV'; my $ref = eval { $sv->object_2svref }; if (!defined $ref) { die <<'END_ERROR'; Moo initialization encountered types defined in a parent thread - ensure that Moo is require()d before any further thread spawns following a type definition. END_ERROR } return $ref; } return $in; } sub TIEHASH { bless {}, $_[0] } sub STORE { my ($self, $key, $value) = @_; my $type = _str_to_ref($key); $WEAK_TYPES{$type} = $type; Scalar::Util::weaken($WEAK_TYPES{$type}) if ref $type; $self->{$key} = $value; } sub FETCH { $_[0]->{$_[1]} } sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } sub NEXTKEY { each %{$_[0]} } sub EXISTS { exists $_[0]->{$_[1]} } sub DELETE { delete $_[0]->{$_[1]} } sub CLEAR { %{$_[0]} = () } sub SCALAR { scalar %{$_[0]} } sub CLONE { my @types = map { defined $WEAK_TYPES{$_} ? ($WEAK_TYPES{$_} => $TYPE_MAP{$_}) : () } keys %TYPE_MAP; %WEAK_TYPES = (); %TYPE_MAP = @types; } sub DESTROY { my %types = %{$_[0]}; untie %TYPE_MAP; %TYPE_MAP = %types; } if ($Config{useithreads}) { my @types = %TYPE_MAP; tie %TYPE_MAP, __PACKAGE__; %TYPE_MAP = @types; } 1; Moo-2.000002/lib/Moo/HandleMoose/FakeMetaClass.pm000644 000765 000024 00000001570 12554014037 021453 0ustar00gknopstaff000000 000000 package Moo::HandleMoose::FakeMetaClass; use Moo::_strictures; sub DESTROY { } sub AUTOLOAD { my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/); my $self = shift; die "Can't call $meth without object instance" if !ref $self; die "Can't inflate Moose metaclass with Moo::sification disabled" if $Moo::sification::disabled; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->$meth(@_) } sub can { my $self = shift; return $self->SUPER::can(@_) if !ref $self or $Moo::sification::disabled; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->can(@_) } sub isa { my $self = shift; return $self->SUPER::isa(@_) if !ref $self or $Moo::sification::disabled; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->isa(@_) } sub make_immutable { $_[0] } 1; Moo-2.000002/lib/Method/Generate/000755 000765 000024 00000000000 12554434146 016500 5ustar00gknopstaff000000 000000 Moo-2.000002/lib/Method/Inliner.pm000644 000765 000024 00000002576 12554014037 016707 0ustar00gknopstaff000000 000000 package Method::Inliner; use Moo::_strictures; use Text::Balanced qw(extract_bracketed); use Sub::Quote (); sub slurp { do { local (@ARGV, $/) = $_[0]; <> } } sub splat { open my $out, '>', $_[1] or die "can't open $_[1]: $!"; print $out $_[0] or die "couldn't write to $_[1]: $!"; } sub inlinify { my $file = $_[0]; my @chunks = split /(^sub.*?^}$)/sm, slurp $file; warn join "\n--\n", @chunks; my %code; foreach my $chunk (@chunks) { if (my ($name, $body) = $chunk =~ /^sub (\S+) {\n(.*)\n}$/s ) { $code{$name} = $body; } } foreach my $chunk (@chunks) { my ($me) = $chunk =~ /^sub.*{\n my \((\$\w+).*\) = \@_;\n/ or next; my $meq = quotemeta $me; #warn $meq, $chunk; my $copy = $chunk; my ($fixed, $rest); while ($copy =~ s/^(.*?)${meq}->(\S+)(?=\()//s) { my ($front, $name) = ($1, $2); ((my $body), $rest) = extract_bracketed($copy, '()'); warn "spotted ${name} - ${body}"; if ($code{$name}) { warn "replacing"; s/^\(//, s/\)$// for $body; $body = "${me}, ".$body; $fixed .= $front.Sub::Quote::inlinify($code{$name}, $body); } else { $fixed .= $front.$me.'->'.$name.$body; } #warn $fixed; warn $rest; $copy = $rest; } $fixed .= $rest if $fixed; warn $fixed if $fixed; $chunk = $fixed if $fixed; } print join '', @chunks; } 1; Moo-2.000002/lib/Method/Generate/Accessor.pm000644 000765 000024 00000046313 12554170766 020614 0ustar00gknopstaff000000 000000 package Method::Generate::Accessor; use Moo::_strictures; use Moo::_Utils; use Moo::Object (); our @ISA = qw(Moo::Object); use Sub::Quote qw(quote_sub quoted_from_sub quotify); use Scalar::Util 'blessed'; use overload (); use Module::Runtime qw(use_module); BEGIN { our $CAN_HAZ_XS = !$ENV{MOO_XS_DISABLE} && _maybe_load_module('Class::XSAccessor') && (eval { Class::XSAccessor->VERSION('1.07') }) ; our $CAN_HAZ_XS_PRED = $CAN_HAZ_XS && (eval { Class::XSAccessor->VERSION('1.17') }) ; } my $module_name_only = qr/\A$Module::Runtime::module_name_rx\z/; sub _die_overwrite { my ($pkg, $method, $type) = @_; die "You cannot overwrite a locally defined method ($method) with " . ( $type || 'an accessor' ); } sub generate_method { my ($self, $into, $name, $spec, $quote_opts) = @_; $spec->{allow_overwrite}++ if $name =~ s/^\+//; die "Must have an is" unless my $is = $spec->{is}; if ($is eq 'ro') { $spec->{reader} = $name unless exists $spec->{reader}; } elsif ($is eq 'rw') { $spec->{accessor} = $name unless exists $spec->{accessor} or ( $spec->{reader} and $spec->{writer} ); } elsif ($is eq 'lazy') { $spec->{reader} = $name unless exists $spec->{reader}; $spec->{lazy} = 1; $spec->{builder} ||= '_build_'.$name unless exists $spec->{default}; } elsif ($is eq 'rwp') { $spec->{reader} = $name unless exists $spec->{reader}; $spec->{writer} = "_set_${name}" unless exists $spec->{writer}; } elsif ($is ne 'bare') { die "Unknown is ${is}"; } if (exists $spec->{builder}) { if(ref $spec->{builder}) { $self->_validate_codulatable('builder', $spec->{builder}, "$into->$name", 'or a method name'); $spec->{builder_sub} = $spec->{builder}; $spec->{builder} = 1; } $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1; die "Invalid builder for $into->$name - not a valid method name" if $spec->{builder} !~ $module_name_only; } if (($spec->{predicate}||0) eq 1) { $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}"; } if (($spec->{clearer}||0) eq 1) { $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}"; } if (($spec->{trigger}||0) eq 1) { $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)'); } if (($spec->{coerce}||0) eq 1) { my $isa = $spec->{isa}; if (blessed $isa and $isa->can('coercion')) { $spec->{coerce} = $isa->coercion; } elsif (blessed $isa and $isa->can('coerce')) { $spec->{coerce} = sub { $isa->coerce(@_) }; } else { die "Invalid coercion for $into->$name - no appropriate type constraint"; } } foreach my $setting (qw( isa coerce )) { next if !exists $spec->{$setting}; $self->_validate_codulatable($setting, $spec->{$setting}, "$into->$name"); } if (exists $spec->{default}) { if (ref $spec->{default}) { $self->_validate_codulatable('default', $spec->{default}, "$into->$name", 'or a non-ref'); } } if (exists $spec->{moosify}) { if (ref $spec->{moosify} ne 'ARRAY') { $spec->{moosify} = [$spec->{moosify}]; } foreach my $spec (@{$spec->{moosify}}) { $self->_validate_codulatable('moosify', $spec, "$into->$name"); } } my %methods; if (my $reader = $spec->{reader}) { _die_overwrite($into, $reader, 'a reader') if !$spec->{allow_overwrite} && defined &{"${into}::${reader}"}; if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) { $methods{$reader} = $self->_generate_xs( getters => $into, $reader, $name, $spec ); } else { $self->{captures} = {}; $methods{$reader} = quote_sub "${into}::${reader}" => ' die "'.$reader.' is a read-only accessor" if @_ > 1;'."\n" .$self->_generate_get($name, $spec) => delete $self->{captures} ; } } if (my $accessor = $spec->{accessor}) { _die_overwrite($into, $accessor, 'an accessor') if !$spec->{allow_overwrite} && defined &{"${into}::${accessor}"}; if ( our $CAN_HAZ_XS && $self->is_simple_get($name, $spec) && $self->is_simple_set($name, $spec) ) { $methods{$accessor} = $self->_generate_xs( accessors => $into, $accessor, $name, $spec ); } else { $self->{captures} = {}; $methods{$accessor} = quote_sub "${into}::${accessor}" => $self->_generate_getset($name, $spec) => delete $self->{captures} ; } } if (my $writer = $spec->{writer}) { _die_overwrite($into, $writer, 'a writer') if !$spec->{allow_overwrite} && defined &{"${into}::${writer}"}; if ( our $CAN_HAZ_XS && $self->is_simple_set($name, $spec) ) { $methods{$writer} = $self->_generate_xs( setters => $into, $writer, $name, $spec ); } else { $self->{captures} = {}; $methods{$writer} = quote_sub "${into}::${writer}" => $self->_generate_set($name, $spec) => delete $self->{captures} ; } } if (my $pred = $spec->{predicate}) { _die_overwrite($into, $pred, 'a predicate') if !$spec->{allow_overwrite} && defined &{"${into}::${pred}"}; if (our $CAN_HAZ_XS && our $CAN_HAZ_XS_PRED) { $methods{$pred} = $self->_generate_xs( exists_predicates => $into, $pred, $name, $spec ); } else { $methods{$pred} = quote_sub "${into}::${pred}" => ' '.$self->_generate_simple_has('$_[0]', $name, $spec)."\n" ; } } if (my $pred = $spec->{builder_sub}) { _install_coderef( "${into}::$spec->{builder}" => $spec->{builder_sub} ); } if (my $cl = $spec->{clearer}) { _die_overwrite($into, $cl, 'a clearer') if !$spec->{allow_overwrite} && defined &{"${into}::${cl}"}; $methods{$cl} = quote_sub "${into}::${cl}" => $self->_generate_simple_clear('$_[0]', $name, $spec)."\n" ; } if (my $hspec = $spec->{handles}) { my $asserter = $spec->{asserter} ||= '_assert_'.$name; my @specs = do { if (ref($hspec) eq 'ARRAY') { map [ $_ => $_ ], @$hspec; } elsif (ref($hspec) eq 'HASH') { map [ $_ => ref($hspec->{$_}) ? @{$hspec->{$_}} : $hspec->{$_} ], keys %$hspec; } elsif (!ref($hspec)) { map [ $_ => $_ ], use_module('Moo::Role')->methods_provided_by(use_module($hspec)) } else { die "You gave me a handles of ${hspec} and I have no idea why"; } }; foreach my $delegation_spec (@specs) { my ($proxy, $target, @args) = @$delegation_spec; _die_overwrite($into, $proxy, 'a delegation') if !$spec->{allow_overwrite} && defined &{"${into}::${proxy}"}; $self->{captures} = {}; $methods{$proxy} = quote_sub "${into}::${proxy}" => $self->_generate_delegation($asserter, $target, \@args), delete $self->{captures} ; } } if (my $asserter = $spec->{asserter}) { $self->{captures} = {}; $methods{$asserter} = quote_sub "${into}::${asserter}" => $self->_generate_asserter($name, $spec), delete $self->{captures}; } \%methods; } sub is_simple_attribute { my ($self, $name, $spec) = @_; # clearer doesn't have to be listed because it doesn't # affect whether defined/exists makes a difference !grep $spec->{$_}, qw(lazy default builder coerce isa trigger predicate weak_ref); } sub is_simple_get { my ($self, $name, $spec) = @_; !($spec->{lazy} and (exists $spec->{default} or $spec->{builder})); } sub is_simple_set { my ($self, $name, $spec) = @_; !grep $spec->{$_}, qw(coerce isa trigger weak_ref); } sub has_default { my ($self, $name, $spec) = @_; $spec->{builder} or exists $spec->{default} or (($spec->{is}||'') eq 'lazy'); } sub has_eager_default { my ($self, $name, $spec) = @_; (!$spec->{lazy} and (exists $spec->{default} or $spec->{builder})); } sub _generate_get { my ($self, $name, $spec) = @_; my $simple = $self->_generate_simple_get('$_[0]', $name, $spec); if ($self->is_simple_get($name, $spec)) { $simple; } else { $self->_generate_use_default( '$_[0]', $name, $spec, $self->_generate_simple_has('$_[0]', $name, $spec), ); } } sub generate_simple_has { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_simple_has(@_); ($code, delete $self->{captures}); } sub _generate_simple_has { my ($self, $me, $name) = @_; "exists ${me}->{${\quotify $name}}"; } sub _generate_simple_clear { my ($self, $me, $name) = @_; " delete ${me}->{${\quotify $name}}\n" } sub generate_get_default { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_get_default(@_); ($code, delete $self->{captures}); } sub generate_use_default { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_use_default(@_); ($code, delete $self->{captures}); } sub _generate_use_default { my ($self, $me, $name, $spec, $test) = @_; my $get_value = $self->_generate_get_default($me, $name, $spec); if ($spec->{coerce}) { $get_value = $self->_generate_coerce( $name, $get_value, $spec->{coerce} ) } $test." ? \n" .$self->_generate_simple_get($me, $name, $spec)."\n:" .($spec->{isa} ? " do {\n my \$value = ".$get_value.";\n" ." ".$self->_generate_isa_check($name, '$value', $spec->{isa}).";\n" ." ".$self->_generate_simple_set($me, $name, $spec, '$value')."\n" ." }\n" : ' ('.$self->_generate_simple_set($me, $name, $spec, $get_value).")\n" ); } sub _generate_get_default { my ($self, $me, $name, $spec) = @_; if (exists $spec->{default}) { ref $spec->{default} ? $self->_generate_call_code($name, 'default', $me, $spec->{default}) : quotify $spec->{default}; } else { "${me}->${\$spec->{builder}}" } } sub generate_simple_get { my ($self, @args) = @_; $self->{captures} = {}; my $code = $self->_generate_simple_get(@args); ($code, delete $self->{captures}); } sub _generate_simple_get { my ($self, $me, $name) = @_; my $name_str = quotify $name; "${me}->{${name_str}}"; } sub _generate_set { my ($self, $name, $spec) = @_; if ($self->is_simple_set($name, $spec)) { $self->_generate_simple_set('$_[0]', $name, $spec, '$_[1]'); } else { my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)}; my $value_store = '$_[0]'; my $code; if ($coerce) { $value_store = '$value'; $code = "do { my (\$self, \$value) = \@_;\n" ." \$value = " .$self->_generate_coerce($name, $value_store, $coerce).";\n"; } else { $code = "do { my \$self = shift;\n"; } if ($isa_check) { $code .= " ".$self->_generate_isa_check($name, $value_store, $isa_check).";\n"; } my $simple = $self->_generate_simple_set('$self', $name, $spec, $value_store); if ($trigger) { my $fire = $self->_generate_trigger($name, '$self', $value_store, $trigger); $code .= " ".$simple.";\n ".$fire.";\n" ." $value_store;\n"; } else { $code .= " ".$simple.";\n"; } $code .= " }"; $code; } } sub generate_coerce { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_coerce(@_); ($code, delete $self->{captures}); } sub _attr_desc { my ($name, $init_arg) = @_; return quotify($name) if !defined($init_arg) or $init_arg eq $name; return quotify($name).' (constructor argument: '.quotify($init_arg).')'; } sub _generate_coerce { my ($self, $name, $value, $coerce, $init_arg) = @_; $self->_wrap_attr_exception( $name, "coercion", $init_arg, $self->_generate_call_code($name, 'coerce', "${value}", $coerce), 1, ); } sub generate_trigger { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_trigger(@_); ($code, delete $self->{captures}); } sub _generate_trigger { my ($self, $name, $obj, $value, $trigger) = @_; $self->_generate_call_code($name, 'trigger', "${obj}, ${value}", $trigger); } sub generate_isa_check { my ($self, @args) = @_; $self->{captures} = {}; my $code = $self->_generate_isa_check(@args); ($code, delete $self->{captures}); } sub _wrap_attr_exception { my ($self, $name, $step, $arg, $code, $want_return) = @_; my $prefix = quotify("${step} for "._attr_desc($name, $arg).' failed: '); "do {\n" .' local $Method::Generate::Accessor::CurrentAttribute = {'."\n" .' init_arg => '.quotify($arg).",\n" .' name => '.quotify($name).",\n" .' step => '.quotify($step).",\n" ." };\n" .($want_return ? ' my $_return;'."\n" : '') .' my $_error;'."\n" ." {\n" .' my $_old_error = $@;'."\n" ." if (!eval {\n" .' $@ = $_old_error;'."\n" .($want_return ? ' $_return ='."\n" : '') .' '.$code.";\n" ." 1;\n" ." }) {\n" .' $_error = $@;'."\n" .' if (!ref $_error) {'."\n" .' $_error = '.$prefix.'.$_error;'."\n" ." }\n" ." }\n" .' $@ = $_old_error;'."\n" ." }\n" .' die $_error if $_error;'."\n" .($want_return ? ' $_return;'."\n" : '') ."}\n" } sub _generate_isa_check { my ($self, $name, $value, $check, $init_arg) = @_; $self->_wrap_attr_exception( $name, "isa check", $init_arg, $self->_generate_call_code($name, 'isa_check', $value, $check) ); } sub _generate_call_code { my ($self, $name, $type, $values, $sub) = @_; $sub = \&{$sub} if blessed($sub); # coderef if blessed if (my $quoted = quoted_from_sub($sub)) { my $local = 1; if ($values eq '@_' || $values eq '$_[0]') { $local = 0; $values = '@_'; } my $code = $quoted->[1]; if (my $captures = $quoted->[2]) { my $cap_name = qq{\$${type}_captures_for_}.$self->_sanitize_name($name); $self->{captures}->{$cap_name} = \$captures; Sub::Quote::inlinify($code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6), $local); } else { Sub::Quote::inlinify($code, $values, undef, $local); } } else { my $cap_name = qq{\$${type}_for_}.$self->_sanitize_name($name); $self->{captures}->{$cap_name} = \$sub; "${cap_name}->(${values})"; } } sub _sanitize_name { my ($self, $name) = @_; $name =~ s/([_\W])/sprintf('_%x', ord($1))/ge; $name; } sub generate_populate_set { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_populate_set(@_); ($code, delete $self->{captures}); } sub _generate_populate_set { my ($self, $me, $name, $spec, $source, $test, $init_arg) = @_; if ($self->has_eager_default($name, $spec)) { my $get_indent = ' ' x ($spec->{isa} ? 6 : 4); my $get_default = $self->_generate_get_default( '$new', $name, $spec ); my $get_value = defined($spec->{init_arg}) ? "(\n${get_indent} ${test}\n" ."${get_indent} ? ${source}\n${get_indent} : " .$get_default ."\n${get_indent})" : $get_default; if ($spec->{coerce}) { $get_value = $self->_generate_coerce( $name, $get_value, $spec->{coerce}, $init_arg ) } ($spec->{isa} ? " {\n my \$value = ".$get_value.";\n " .$self->_generate_isa_check( $name, '$value', $spec->{isa}, $init_arg ).";\n" .' '.$self->_generate_simple_set($me, $name, $spec, '$value').";\n" ." }\n" : ' '.$self->_generate_simple_set($me, $name, $spec, $get_value).";\n" ) .($spec->{trigger} ? ' ' .$self->_generate_trigger( $name, $me, $self->_generate_simple_get($me, $name, $spec), $spec->{trigger} )." if ${test};\n" : '' ); } else { " if (${test}) {\n" .($spec->{coerce} ? " $source = " .$self->_generate_coerce( $name, $source, $spec->{coerce}, $init_arg ).";\n" : "" ) .($spec->{isa} ? " " .$self->_generate_isa_check( $name, $source, $spec->{isa}, $init_arg ).";\n" : "" ) ." ".$self->_generate_simple_set($me, $name, $spec, $source).";\n" .($spec->{trigger} ? " " .$self->_generate_trigger( $name, $me, $self->_generate_simple_get($me, $name, $spec), $spec->{trigger} ).";\n" : "" ) ." }\n"; } } sub _generate_core_set { my ($self, $me, $name, $spec, $value) = @_; my $name_str = quotify $name; "${me}->{${name_str}} = ${value}"; } sub _generate_simple_set { my ($self, $me, $name, $spec, $value) = @_; my $name_str = quotify $name; my $simple = $self->_generate_core_set($me, $name, $spec, $value); if ($spec->{weak_ref}) { require Scalar::Util; my $get = $self->_generate_simple_get($me, $name, $spec); # Perl < 5.8.3 can't weaken refs to readonly vars # (e.g. string constants). This *can* be solved by: # # &Internals::SvREADONLY($foo, 0); # Scalar::Util::weaken($foo); # &Internals::SvREADONLY($foo, 1); # # but requires Internal functions and is just too damn crazy # so simply throw a better exception my $weak_simple = "do { Scalar::Util::weaken(${simple}); no warnings 'void'; $get }"; Moo::_Utils::lt_5_8_3() ? <<"EOC" : $weak_simple; eval { Scalar::Util::weaken($simple); 1 } ? do { no warnings 'void'; $get } : do { if( \$@ =~ /Modification of a read-only value attempted/) { require Carp; Carp::croak( sprintf ( 'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3', $name_str, ) ); } else { die \$@; } } EOC } else { $simple; } } sub _generate_getset { my ($self, $name, $spec) = @_; q{(@_ > 1}."\n ? ".$self->_generate_set($name, $spec) ."\n : ".$self->_generate_get($name, $spec)."\n )"; } sub _generate_asserter { my ($self, $name, $spec) = @_; "do {\n" ." my \$val = ".$self->_generate_get($name, $spec).";\n" ." unless (".$self->_generate_simple_has('$_[0]', $name, $spec).") {\n" .qq! die "Attempted to access '${name}' but it is not set";\n! ." }\n" ." \$val;\n" ."}\n"; } sub _generate_delegation { my ($self, $asserter, $target, $args) = @_; my $arg_string = do { if (@$args) { # I could, I reckon, linearise out non-refs here using quotify # plus something to check for numbers but I'm unsure if it's worth it $self->{captures}{'@curries'} = $args; '@curries, @_'; } else { '@_'; } }; "shift->${asserter}->${target}(${arg_string});"; } sub _generate_xs { my ($self, $type, $into, $name, $slot) = @_; Class::XSAccessor->import( class => $into, $type => { $name => $slot }, replace => 1, ); $into->can($name); } sub default_construction_string { '{}' } sub _validate_codulatable { my ($self, $setting, $value, $into, $appended) = @_; my $invalid = "Invalid $setting '" . overload::StrVal($value) . "' for $into not a coderef"; $invalid .= " $appended" if $appended; unless (ref $value and (ref $value eq 'CODE' or blessed($value))) { die "$invalid or code-convertible object"; } unless (eval { \&$value }) { die "$invalid and could not be converted to a coderef: $@"; } 1; } 1; Moo-2.000002/lib/Method/Generate/BuildAll.pm000644 000765 000024 00000001577 12554014037 020531 0ustar00gknopstaff000000 000000 package Method::Generate::BuildAll; use Moo::_strictures; use Moo::Object (); our @ISA = qw(Moo::Object); use Sub::Quote qw(quote_sub quotify); use Moo::_Utils; sub generate_method { my ($self, $into) = @_; quote_sub "${into}::BUILDALL", join '', $self->_handle_subbuild($into), qq{ my \$self = shift;\n}, $self->buildall_body_for($into, '$self', '@_'), qq{ return \$self\n}; } sub _handle_subbuild { my ($self, $into) = @_; ' if (ref($_[0]) ne '.quotify($into).') {'."\n". ' return shift->Moo::Object::BUILDALL(@_)'.";\n". ' }'."\n"; } sub buildall_body_for { my ($self, $into, $me, $args) = @_; my @builds = grep *{_getglob($_)}{CODE}, map "${_}::BUILD", reverse @{mro::get_linear_isa($into)}; ' unless (('.$args.')[0]->{__no_BUILD__}) {'."\n" .join('', map qq{ ${me}->${_}(${args});\n}, @builds) ." }\n"; } 1; Moo-2.000002/lib/Method/Generate/Constructor.pm000644 000765 000024 00000016625 12554170766 021402 0ustar00gknopstaff000000 000000 package Method::Generate::Constructor; use Moo::_strictures; use Sub::Quote qw(quote_sub unquote_sub quotify); use Sub::Defer; use Moo::_Utils qw(_getstash _getglob); use Moo; sub register_attribute_specs { my ($self, @new_specs) = @_; $self->assert_constructor; my $specs = $self->{attribute_specs}||={}; while (my ($name, $new_spec) = splice @new_specs, 0, 2) { if ($name =~ s/^\+//) { die "has '+${name}' given but no ${name} attribute already exists" unless my $old_spec = $specs->{$name}; foreach my $key (keys %$old_spec) { if (!exists $new_spec->{$key}) { $new_spec->{$key} = $old_spec->{$key} unless $key eq 'handles'; } elsif ($key eq 'moosify') { $new_spec->{$key} = [ map { ref $_ eq 'ARRAY' ? @$_ : $_ } ($old_spec->{$key}, $new_spec->{$key}) ]; } } } if ($new_spec->{required} && !( $self->accessor_generator->has_default($name, $new_spec) || !exists $new_spec->{init_arg} || defined $new_spec->{init_arg} ) ) { die "You cannot have a required attribute (${name})" . " without a default, builder, or an init_arg"; } $new_spec->{index} = scalar keys %$specs unless defined $new_spec->{index}; $specs->{$name} = $new_spec; } $self; } sub all_attribute_specs { $_[0]->{attribute_specs} } sub accessor_generator { $_[0]->{accessor_generator} } sub construction_string { my ($self) = @_; $self->{construction_string} ||= $self->_build_construction_string; } sub buildall_generator { require Method::Generate::BuildAll; Method::Generate::BuildAll->new; } sub _build_construction_string { my ($self) = @_; my $builder = $self->{construction_builder}; $builder ? $self->$builder : 'bless(' .$self->accessor_generator->default_construction_string .', $class);' } sub install_delayed { my ($self) = @_; $self->assert_constructor; my $package = $self->{package}; my (undef, @isa) = @{mro::get_linear_isa($package)}; my $isa = join ',', @isa; $self->{deferred_constructor} = defer_sub "${package}::new" => sub { my (undef, @new_isa) = @{mro::get_linear_isa($package)}; if (join(',', @new_isa) ne $isa) { my ($expected_new) = grep { *{_getglob($_.'::new')}{CODE} } @isa; my ($found_new) = grep { *{_getglob($_.'::new')}{CODE} } @new_isa; if (($found_new||'') ne ($expected_new||'')) { $found_new ||= 'none'; $expected_new ||= 'none'; die "Expected parent constructor of $package expected to be" . " $expected_new, but found $found_new: changing the inheritance" . " chain (\@ISA) at runtime is unsupported"; } } unquote_sub $self->generate_method( $package, 'new', $self->{attribute_specs}, { no_install => 1 } ) }; $self; } sub current_constructor { my ($self, $package) = @_; return *{_getglob("${package}::new")}{CODE}; } sub assert_constructor { my ($self) = @_; my $package = $self->{package} or return 1; my $current = $self->current_constructor($package) or return 1; my $deferred = $self->{deferred_constructor} or die "Unknown constructor for $package already exists"; return 1 if $deferred == $current; my $current_deferred = (Sub::Defer::defer_info($current)||[])->[3]; if ($current_deferred && $current_deferred == $deferred) { die "Constructor for $package has been inlined and cannot be updated"; } die "Constructor for $package has been replaced with an unknown sub"; } sub generate_method { my ($self, $into, $name, $spec, $quote_opts) = @_; foreach my $no_init (grep !exists($spec->{$_}{init_arg}), keys %$spec) { $spec->{$no_init}{init_arg} = $no_init; } local $self->{captures} = {}; my $body = ' my $class = shift;'."\n" .' $class = ref($class) if ref($class);'."\n"; $body .= $self->_handle_subconstructor($into, $name); my $into_buildargs = $into->can('BUILDARGS'); if ( $into_buildargs && $into_buildargs != \&Moo::Object::BUILDARGS ) { $body .= $self->_generate_args_via_buildargs; } else { $body .= $self->_generate_args; } $body .= $self->_check_required($spec); $body .= ' my $new = '.$self->construction_string.";\n"; $body .= $self->_assign_new($spec); if ($into->can('BUILD')) { $body .= $self->buildall_generator->buildall_body_for( $into, '$new', '$args' ); } $body .= ' return $new;'."\n"; if ($into->can('DEMOLISH')) { require Method::Generate::DemolishAll; Method::Generate::DemolishAll->new->generate_method($into); } quote_sub "${into}::${name}" => $body, $self->{captures}, $quote_opts||{} ; } sub _handle_subconstructor { my ($self, $into, $name) = @_; if (my $gen = $self->{subconstructor_handler}) { ' if ($class ne '.quotify($into).') {'."\n". $gen. ' }'."\n"; } else { '' } } sub _cap_call { my ($self, $code, $captures) = @_; @{$self->{captures}}{keys %$captures} = values %$captures if $captures; $code; } sub _generate_args_via_buildargs { my ($self) = @_; q{ my $args = $class->BUILDARGS(@_);}."\n" .q{ die "BUILDARGS did not return a hashref" unless ref($args) eq 'HASH';} ."\n"; } # inlined from Moo::Object - update that first. sub _generate_args { my ($self) = @_; return <<'_EOA'; my $args; if ( scalar @_ == 1 ) { unless ( defined $_[0] && ref $_[0] eq 'HASH' ) { die "Single parameters to new() must be a HASH ref" ." data => ". $_[0] ."\n"; } $args = { %{ $_[0] } }; } elsif ( @_ % 2 ) { die "The new() method for $class expects a hash reference or a" . " key/value list. You passed an odd number of arguments\n"; } else { $args = {@_}; } _EOA } sub _assign_new { my ($self, $spec) = @_; my $ag = $self->accessor_generator; my %test; NAME: foreach my $name (sort keys %$spec) { my $attr_spec = $spec->{$name}; next NAME unless defined($attr_spec->{init_arg}) or $ag->has_eager_default($name, $attr_spec); $test{$name} = $attr_spec->{init_arg}; } join '', map { my $arg_key = quotify($test{$_}); my $test = "exists \$args->{$arg_key}"; my $source = "\$args->{$arg_key}"; my $attr_spec = $spec->{$_}; $self->_cap_call($ag->generate_populate_set( '$new', $_, $attr_spec, $source, $test, $test{$_}, )); } sort keys %test; } sub _check_required { my ($self, $spec) = @_; my @required_init = map $spec->{$_}{init_arg}, grep { my %s = %{$spec->{$_}}; # ignore required if default or builder set $s{required} and not($s{builder} or exists $s{default}) } sort keys %$spec; return '' unless @required_init; ' if (my @missing = grep !exists $args->{$_}, ' .join(', ', map quotify($_), @required_init).') {'."\n" .q{ die "Missing required arguments: ".join(', ', sort @missing);}."\n" ." }\n"; } # bootstrap our own constructor sub new { my $class = shift; delete _getstash(__PACKAGE__)->{new}; bless $class->BUILDARGS(@_), $class; } Moo->_constructor_maker_for(__PACKAGE__) ->register_attribute_specs( attribute_specs => { is => 'ro', reader => 'all_attribute_specs', }, accessor_generator => { is => 'ro' }, construction_string => { is => 'lazy' }, construction_builder => { is => 'bare' }, subconstructor_handler => { is => 'ro' }, package => { is => 'bare' }, ); 1; Moo-2.000002/lib/Method/Generate/DemolishAll.pm000644 000765 000024 00000002377 12554014037 021235 0ustar00gknopstaff000000 000000 package Method::Generate::DemolishAll; use Moo::_strictures; use Moo::Object (); our @ISA = qw(Moo::Object); use Sub::Quote qw(quote_sub quotify); use Moo::_Utils; sub generate_method { my ($self, $into) = @_; quote_sub "${into}::DEMOLISHALL", join '', $self->_handle_subdemolish($into), qq{ my \$self = shift;\n}, $self->demolishall_body_for($into, '$self', '@_'), qq{ return \$self\n}; quote_sub "${into}::DESTROY", join '', q! my $self = shift; my $e = do { local $?; local $@; require Devel::GlobalDestruction; eval { $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction); }; $@; }; # fatal warnings+die in DESTROY = bad times (perl rt#123398) no warnings FATAL => 'all'; use warnings 'all'; die $e if $e; # rethrow !; } sub demolishall_body_for { my ($self, $into, $me, $args) = @_; my @demolishers = grep *{_getglob($_)}{CODE}, map "${_}::DEMOLISH", @{mro::get_linear_isa($into)}; join '', map qq{ ${me}->${_}(${args});\n}, @demolishers; } sub _handle_subdemolish { my ($self, $into) = @_; ' if (ref($_[0]) ne '.quotify($into).') {'."\n". ' return shift->Moo::Object::DEMOLISHALL(@_)'.";\n". ' }'."\n"; } 1;