MooseX-Role-Parameterized-1.02/000755 000765 000024 00000000000 12214101244 016756 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/.prove000644 000765 000024 00000014656 12214077137 020143 0ustar00sartakstaff000000 000000 --- generation: 15 last_run_time: 1378909791.10855 tests: t/001-parameters.t: elapsed: 0.0748600959777832 gen: 15 last_pass_time: 1378909790.28954 last_result: 0 last_run_time: 1378909790.28954 last_todo: 0 mtime: 1344974960 seq: 383 total_passes: 15 t/002-role-block.t: elapsed: 0.0628399848937988 gen: 15 last_pass_time: 1378909790.2353 last_result: 0 last_run_time: 1378909790.2353 last_todo: 0 mtime: 1344974960 seq: 382 total_passes: 15 t/003-apply.t: elapsed: 0.127992153167725 gen: 15 last_pass_time: 1378909790.35321 last_result: 0 last_run_time: 1378909790.35321 last_todo: 0 mtime: 1344974960 seq: 384 total_passes: 15 t/004-with.t: elapsed: 0.0274529457092285 gen: 15 last_pass_time: 1378909790.77127 last_result: 0 last_run_time: 1378909790.77127 last_todo: 0 mtime: 1344974960 seq: 394 total_passes: 15 t/005-with-parameterized.t: elapsed: 0.110534906387329 gen: 15 last_pass_time: 1378909790.43356 last_result: 0 last_run_time: 1378909790.43356 last_todo: 0 mtime: 1344974960 seq: 386 total_passes: 15 t/006-requires.t: elapsed: 0.159860849380493 gen: 15 last_pass_time: 1378909790.65758 last_result: 0 last_run_time: 1378909790.65758 last_todo: 0 mtime: 1344974960 seq: 391 total_passes: 15 t/007-excludes.t: elapsed: 0.10360312461853 gen: 15 last_pass_time: 1378909790.36747 last_result: 0 last_run_time: 1378909790.36747 last_todo: 0 mtime: 1344974960 seq: 385 total_passes: 15 t/008-method-modifers.t: elapsed: 0.0393459796905518 gen: 15 last_pass_time: 1378909790.93388 last_result: 0 last_run_time: 1378909790.93388 last_todo: 0 mtime: 1344974960 seq: 397 total_passes: 15 t/009-override-super.t: elapsed: 0.023993968963623 gen: 15 last_pass_time: 1378909791.09799 last_result: 0 last_run_time: 1378909791.09799 last_todo: 0 mtime: 1344974960 seq: 403 total_passes: 15 t/010-blessed-confess.t: elapsed: 0.000864028930664062 gen: 15 last_pass_time: 1378909791.07639 last_result: 0 last_run_time: 1378909791.07639 last_todo: 0 mtime: 1344974960 seq: 401 total_passes: 15 t/011-reference-parameters.t: elapsed: 0.0790660381317139 gen: 15 last_fail_time: 1378824464.76394 last_pass_time: 1378909790.0961 last_result: 0 last_run_time: 1378909790.0961 last_todo: 0 mtime: 1378824708 seq: 380 total_failures: 1 total_passes: 14 t/012-rename-role.t: elapsed: 0.0815939903259277 gen: 15 last_pass_time: 1378909790.80002 last_result: 0 last_run_time: 1378909790.80002 last_todo: 0 mtime: 1344974960 seq: 395 total_passes: 15 t/013-does.t: elapsed: 0.0869970321655273 gen: 15 last_pass_time: 1378909790.98264 last_result: 0 last_run_time: 1378909790.98264 last_todo: 0 mtime: 1344974960 seq: 399 total_passes: 15 t/014-compose-parameterizable.t: elapsed: 0.0202879905700684 gen: 15 last_pass_time: 1378909791.0954 last_result: 0 last_run_time: 1378909791.0954 last_todo: 0 mtime: 1344974960 seq: 402 total_passes: 15 t/015-compose-keywords.t: elapsed: 0.111944198608398 gen: 15 last_pass_time: 1378909790.84244 last_result: 0 last_run_time: 1378909790.84244 last_todo: 0 mtime: 1344974960 seq: 396 total_passes: 15 t/016-trait.t: elapsed: 0.0958268642425537 gen: 15 last_pass_time: 1378909790.75325 last_result: 0 last_run_time: 1378909790.75325 last_todo: 0 mtime: 1344974960 seq: 393 total_passes: 15 t/017-current_metaclass.t: elapsed: 0.0139307975769043 gen: 15 last_pass_time: 1378909790.67085 last_result: 0 last_run_time: 1378909790.67085 last_todo: 0 mtime: 1344974960 seq: 392 total_passes: 15 t/018-parameter-roles.t: elapsed: 0.00720810890197754 gen: 15 last_pass_time: 1378909790.59394 last_result: 0 last_run_time: 1378909790.59394 last_todo: 0 mtime: 1344974960 seq: 390 total_passes: 15 t/019-custom-metaclass.t: elapsed: 0.068591833114624 gen: 15 last_fail_time: 1378909175.06863 last_pass_time: 1378909790.06509 last_result: 0 last_run_time: 1378909790.06509 last_todo: 0 mtime: 1378909255 seq: 379 total_failures: 1 total_passes: 14 t/020-metaclass-reinitialize.t: elapsed: 0.029329776763916 gen: 15 last_pass_time: 1378909791.10525 last_result: 0 last_run_time: 1378909791.10525 last_todo: 0 mtime: 1344974960 seq: 404 total_passes: 15 t/021-parameter-trait.t: elapsed: 0.103820085525513 gen: 15 last_pass_time: 1378909790.99916 last_result: 0 last_run_time: 1378909790.99916 last_todo: 0 mtime: 1344974960 seq: 400 total_passes: 15 t/022-export-p-trait.t: elapsed: 0.0328009128570557 gen: 15 last_pass_time: 1378909790.95574 last_result: 0 last_run_time: 1378909790.95574 last_todo: 0 mtime: 1345806659 seq: 398 total_passes: 15 t/023-metarole-import-params.t: elapsed: 0.0504980087280273 gen: 15 last_fail_time: 1345806891.09215 last_pass_time: 1378909790.04814 last_result: 0 last_run_time: 1378909790.04814 last_todo: 0 mtime: 1345806910 seq: 378 total_failures: 1 total_passes: 13 t/100-erroneous-keywords.t: elapsed: 0.0813510417938232 gen: 15 last_pass_time: 1378909790.54289 last_result: 0 last_run_time: 1378909790.54289 last_todo: 0 mtime: 1344974960 seq: 389 total_passes: 15 t/101-alias-excludes.t: elapsed: 0.0675640106201172 gen: 15 last_pass_time: 1378909790.53165 last_result: 0 last_run_time: 1378909790.53165 last_todo: 0 mtime: 1344974960 seq: 388 total_passes: 15 t/102-nested.t: elapsed: 0.0721621513366699 gen: 15 last_pass_time: 1378909790.50542 last_result: 0 last_run_time: 1378909790.50542 last_todo: 0 mtime: 1344974960 seq: 387 total_passes: 15 t/150-composite-role-application.t: elapsed: 0.093533992767334 gen: 15 last_pass_time: 1378909790.17333 last_result: 0 last_run_time: 1378909790.17333 last_todo: 0 mtime: 1344974960 seq: 381 total_passes: 15 version: 1 ... MooseX-Role-Parameterized-1.02/Changes000644 000765 000024 00000012021 12214076541 020260 0ustar00sartakstaff000000 000000 Changes for MooseX-Role-Parameterized 1.02 September 11, 2013 * set %INC entries in test to avoid failures with Moose pre-2.11 (kentfrederic) https://github.com/sartak/MooseX-Role-Parameterized/pull/7 https://rt.cpan.org/Ticket/Display.html?id=88593 1.01 September 10, 2013 * removed use of deprecated Class::MOP::load_class (ether) 1.00 January 12, 2012 * MooseX::Role::Parameterized now depends on Moose 2.0300 released 2011-09-23 for its several core improvements, hence the major version number bump. * MXRP now uses the new meta_lookup feature added to Moose 2.0300 (specifically for MXRP) to avoid duplicating Moose-0.60-era Moose::Role sugar. This means the error messages you get are better, and there's a lot less ugly code in MXRP. * Remove alias/excludes special case errors. They have long since been replaced in core Moose by -alias and -excludes, and were finally removed in Moose 2.0200. * Expressly forbid using role { } inside role { } (which makes no sense but I suppose you could accidentally trigger it) * Documentation fix from cweyl@alumni.drew.edu https://github.com/sartak/MooseX-Role-Parameterized/pull/5 0.27 August 22, 2011 * Remove MooseX::Role::Parameterized::Meta::Parameter; instead, the default for parameters of (is => 'ro') is set by the "parameter" sugar. This removes an unnecessary metaclass and removes weird edge cases caused by it. Please please please report any breakage! 0.26 March 20, 2011 * make tests stop relying on a specific format for anon class/role names (doy) 0.25 March 4, 2011 * Move the reinitialization hook from Role to Trait so hardcore hackers (trait janitors) get the benefit too (doy) 0.24 March 1, 2011 * Made MXRP more extensible by hooking into the role metaobject reinitialization (doy) 0.23 December 25, 2010 * Merry Christmas! * Make MooseX::Role::Parameterized::Extending more instructive. Hopefully. 0.22 November 26, 2010 * The test suite now uses Test::Fatal instead of Test::Exception (Karen Etheridge). * Fix Test::More dependency (reported by Father Chrysostomos) [rt.cpan.org #63222] 0.21 November 15, 2010 * "package" arg can now tell generate_role to use a specific package (rjbs) 0.20 November 2, 2010 * Minor test refactoring to fix blead support [rt.perl.org #78244] 0.19 July 8, 2010 * Documentation improvements 0.18 March 10, 2010 * Improve the error message when you leave off the role {} block http://stackoverflow.com/questions/2418177/moose-and-error-messages-the-sun-and-the-moon/2418429 0.17 February 11, 2010 * MANIFEST fixes (Karen Etheridge) 0.16 February 4, 2010 * Allow specifying custom metaclasses for parameterized roles (Oliver Charles) * Documentation improvements (Oliver Charles, Sartak) 0.15 January 5, 2010 * Move the guts of MXRPMR::Parameterized into a trait. See http://www.nntp.perl.org/group/perl.moose/2010/01/msg1294.html (Sartak) 0.14 December 6, 2009 * Fix a nesting bug reported by nothingmuch with a test case provided by rafl (Sartak) * Parameterized roles now keep track of their genitor role (Sartak) * Delegate parameterizable->has_parameter to parameters->has_attribute (Sartak) 0.13 Sep 11, 2009 * Documentation improvements (Sartak) 0.12 Aug 15, 2009 * Add MooseX::Role::Parameterized->current_metaclass for forward compat (Sartak) * Various documentation improvements (Sartak) 0.11 Aug 9, 2009 * Explicitly test-require Test::Moose for Fedora packaging (RSRCHBOY) * Finally a sensible synopsis (Sartak) * More examples are always good :) (Sartak) 0.10 Jun 25, 2009 * Fix test that now warns in Moose (Sartak) 0.09 Jun 14, 2009 * Give all modules a version number (Sartak) 0.08 Jun 14, 2009 * Fix mis-packaging :) (Sartak) 0.07 Jun 14, 2009 * Leave the jules nest for github (Sartak) * Switch to Module::Install (Sartak) 0.06 May 12, 2009 * Fix long-standing role-role combination bug, reported by several users (Sartak) * Documentation improvements (Sartak) 0.05 Apr 24, 2009 * Use replace_constructor in Meta::Parameter's make_immutable (nothingmuch) * The & prototype hack has been obviated by Moose::Exporter goodness (rafl) * List examples of MooseX::Role::Parameterized roles (Sartak) 0.04 Jan 30, 2009 * The role block now receives as an argument the consuming class or role. 0.03 Jan 17, 2009 * Parameters now default to read-only, so that you no longer have to specify the extremely common case of: is => 'ro' 0.02 Dec 9, 2008 * Using keywords outside of the role block is now allowed and handled. * The role generated by the role block is now composed with its parent role. This is so you can have unparameterized components to your parameterized roles, and so that does_role returns true if you ask about the parent role (instead of the anonymous parameterized role). MooseX-Role-Parameterized-1.02/inc/000755 000765 000024 00000000000 12214101244 017527 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/000755 000765 000024 00000000000 12214101244 017524 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/Makefile.PL000644 000765 000024 00000000773 12213627406 020753 0ustar00sartakstaff000000 000000 # Load the Module::Install bundled in ./inc/ use inc::Module::Install; use Module::Install::GithubMeta; use Module::Install::ManifestSkip; use Module::Install::AutoManifest; # Define metadata name 'MooseX-Role-Parameterized'; all_from 'lib/MooseX/Role/Parameterized.pm'; githubmeta; requires 'Moose' => '2.0300'; requires 'Module::Runtime'; test_requires 'Test::Moose'; test_requires 'Test::More' => '0.96'; test_requires 'Test::Fatal'; manifest_skip; auto_manifest; WriteAll; MooseX-Role-Parameterized-1.02/MANIFEST000644 000765 000024 00000002516 12214101244 020113 0ustar00sartakstaff000000 000000 .prove Changes inc/Module/Install.pm inc/Module/Install/AutoManifest.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/GithubMeta.pm inc/Module/Install/Makefile.pm inc/Module/Install/ManifestSkip.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/MooseX/Role/Parameterized.pm lib/MooseX/Role/Parameterized/Extending.pod lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm lib/MooseX/Role/Parameterized/Meta/Role/Parameterized.pm lib/MooseX/Role/Parameterized/Meta/Trait/Parameterized.pm lib/MooseX/Role/Parameterized/Parameters.pm lib/MooseX/Role/Parameterized/Tutorial.pod Makefile.PL MANIFEST This list of files META.yml t/001-parameters.t t/002-role-block.t t/003-apply.t t/004-with.t t/005-with-parameterized.t t/006-requires.t t/007-excludes.t t/008-method-modifers.t t/009-override-super.t t/010-blessed-confess.t t/011-reference-parameters.t t/012-rename-role.t t/013-does.t t/014-compose-parameterizable.t t/015-compose-keywords.t t/016-trait.t t/017-current_metaclass.t t/018-parameter-roles.t t/019-custom-metaclass.t t/020-metaclass-reinitialize.t t/021-parameter-trait.t t/022-export-p-trait.t t/023-metarole-import-params.t t/100-erroneous-keywords.t t/101-alias-excludes.t t/102-nested.t t/150-composite-role-application.t t/lib/Bar.pm MooseX-Role-Parameterized-1.02/META.yml000644 000765 000024 00000001405 12214101215 020225 0ustar00sartakstaff000000 000000 --- abstract: 'roles with composition parameters' author: - 'Shawn M Moore, C' build_requires: ExtUtils::MakeMaker: 6.59 Test::Fatal: 0 Test::Moose: 0 Test::More: 0.96 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: MooseX-Role-Parameterized no_index: directory: - inc - t requires: Module::Runtime: 0 Moose: 2.0300 perl: 5.8.1 resources: homepage: https://github.com/sartak/MooseX-Role-Parameterized/tree license: http://dev.perl.org/licenses/ repository: git://github.com/sartak/MooseX-Role-Parameterized.git version: 1.02 MooseX-Role-Parameterized-1.02/t/000755 000765 000024 00000000000 12214101244 017221 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/t/001-parameters.t000644 000765 000024 00000003712 12012530160 022051 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; use MooseX::Role::Parameterized::Parameters; my $p = MooseX::Role::Parameterized::Parameters->new; can_ok($p => 'meta'); do { package MyRole::NoParameters; use MooseX::Role::Parameterized; }; my $parameters_metaclass = MyRole::NoParameters->meta->parameters_metaclass; is($parameters_metaclass->get_all_attributes, 0, "no parameters"); do { package MyRole::LengthParameter; use MooseX::Role::Parameterized; parameter length => ( isa => 'Int', required => 1, ); }; $parameters_metaclass = MyRole::LengthParameter->meta->parameters_metaclass; is($parameters_metaclass->get_all_attributes, 1, "exactly one parameter"); my $parameter = ($parameters_metaclass->get_all_attributes)[0]; is($parameter->name, 'length', "parameter name"); ok($parameter->is_required, "parameter is required"); ok(MyRole::LengthParameter->meta->has_parameter('length'), 'has_parameter'); ok(!MyRole::LengthParameter->meta->has_parameter('kjhef'), 'has_parameter'); like( exception { MyRole::LengthParameter->meta->construct_parameters; }, qr/^Attribute \(length\) is required/); $p = MyRole::LengthParameter->meta->construct_parameters( length => 5, ); is($p->length, 5, "correct length"); like( exception { $p->length(10); }, qr/^Cannot assign a value to a read-only accessor/); do { package MyRole::LengthParameter; use MooseX::Role::Parameterized; parameter ['first_name', 'last_name'] => ( is => 'rw', isa => 'Str', ); }; $parameters_metaclass = MyRole::LengthParameter->meta->parameters_metaclass; is($parameters_metaclass->get_all_attributes, 3, "three parameters"); for my $param_name ('first_name', 'last_name') { my $param = $parameters_metaclass->get_attribute($param_name); is($param->type_constraint, 'Str', "$param_name type constraint"); ok(!$param->is_required, "$param_name is optional"); } done_testing; MooseX-Role-Parameterized-1.02/t/002-role-block.t000644 000765 000024 00000004453 12012530160 021743 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; my ($parameters, %args); do { package MyPerson; use MooseX::Role::Parameterized; parameter default_age => ( is => 'rw', isa => 'Int', required => 1, ); role { ($parameters, %args) = @_; has age => ( default => $parameters->default_age, ); method birthday => sub { my $self = shift; return 2000 - $self->age; }; }; }; ok(MyPerson->meta->has_role_generator, "MyPerson has a role generator"); subtest "generation of an anonymous role" => sub { my $role = MyPerson->meta->generate_role( parameters => { default_age => 7, }, ); isa_ok($role, 'Moose::Meta::Role', 'generate_role created a role'); like($role->name, qr{ANON}, '...with an anonymous name'); is($role->parameters, $parameters, 'the generated role knows its parameters'); is($parameters->default_age, 7); is($args{operating_on}, $role, "we pass in the role metaclass that we're operating on"); my $age_attr = $role->get_attribute('age'); is($age_attr->{default}, 7, "role's age attribute has the right default"); my $birthday_method = $role->get_method('birthday'); is($birthday_method->name, 'birthday', "method name"); is($birthday_method->package_name, $role->name, "package name"); }; subtest "generating a role with a provided name" => sub { my $role = MyPerson->meta->generate_role( package => 'RJBS::Was::Here', parameters => { default_age => 10, }, ); isa_ok($role, 'Moose::Meta::Role', 'generate_role created a role'); is($role->name, 'RJBS::Was::Here', '...with the name we expected'); is($role->parameters, $parameters, 'the generated role knows its parameters'); is($parameters->default_age, 10); is($args{operating_on}, $role, "we pass in the role metaclass that we're operating on"); my $age_attr = $role->get_attribute('age'); is($age_attr->{default}, 10, "role's age attribute has the right default"); my $birthday_method = $role->get_method('birthday'); is($birthday_method->name, 'birthday', "method name"); is($birthday_method->package_name, $role->name, "package name"); }; done_testing; MooseX-Role-Parameterized-1.02/t/003-apply.t000644 000765 000024 00000010035 12012530160 021031 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; my %args; do { package MyRole::Storage; use MooseX::Role::Parameterized; use Moose::Util::TypeConstraints; parameter format => ( isa => (enum ['Dumper', 'Storable']), required => 1, ); parameter freeze_method => ( isa => 'Str', lazy => 1, default => sub { "freeze_" . shift->format }, ); parameter thaw_method => ( isa => 'Str', lazy => 1, default => sub { "thaw_" . shift->format }, ); role { my $p = shift; %args = @_; my $format = $p->format; my ($freezer, $thawer); if ($format eq 'Dumper') { require Data::Dumper; $freezer = \&Data::Dumper::Dumper; $thawer = sub { eval "@_" }; } elsif ($format eq 'Storable') { require Storable; $freezer = \&Storable::nfreeze; $thawer = \&Storable::thaw; } else { die "Unknown format ($format)"; } method $p->freeze_method => $freezer; method $p->thaw_method => $thawer; }; }; do { package MyClass::Dumper; use Moose; with 'MyRole::Storage' => { format => 'Dumper', }; }; can_ok('MyClass::Dumper' => qw(freeze_Dumper thaw_Dumper)); cant_ok('MyClass::Dumper' => qw(freeze_Storable thaw_Storable)); is($args{consumer}, MyClass::Dumper->meta, 'Role block receives consumer'); is(MyClass::Dumper->meta->roles->[0]->genitor, MyRole::Storage->meta, 'genitor'); do { package MyClass::Storable; use Moose; with 'MyRole::Storage' => { format => 'Storable', }; }; can_ok('MyClass::Storable' => qw(freeze_Storable thaw_Storable)); cant_ok('MyClass::Storable' => qw(freeze_Dumper thaw_Dumper)); is($args{consumer}, MyClass::Storable->meta, 'Role block receives consumer'); do { package MyClass::DumperRenamed; use Moose; with 'MyRole::Storage' => { format => 'Dumper', freeze_method => 'save', thaw_method => 'load', }; }; can_ok('MyClass::DumperRenamed' => qw(save load)); cant_ok('MyClass::DumperRenamed' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable)); is($args{consumer}, MyClass::DumperRenamed->meta, 'Role block receives consumer'); do { package MyClass::Both; use Moose; with 'MyRole::Storage' => { format => 'Dumper' }; with 'MyRole::Storage' => { format => 'Storable' }; }; can_ok('MyClass::Both' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable)); is($args{consumer}, MyClass::Both->meta, 'Role block receives consumer'); do { package MyClass::Three; use Moose; with 'MyRole::Storage' => { format => 'Dumper' }; with 'MyRole::Storage' => { format => 'Storable' }; with 'MyRole::Storage' => { format => 'Storable', freeze_method => 'store', thaw_method => 'dump', }; }; can_ok('MyClass::Three' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable store dump)); is($args{consumer}, MyClass::Three->meta, 'Role block receives consumer'); like( exception { package MyClass::Error::Required; use Moose; with 'MyRole::Storage'; }, qr/^Attribute \(format\) is required/); like( exception { package MyClass::Error::Invalid; use Moose; with 'MyRole::Storage' => { format => 'YAML', }; }, qr/^Attribute \(format\) does not pass the type constraint/); like( exception { package MyRole::Sans::Block; use MooseX::Role::Parameterized; parameter 'foo'; package MyClass::Error::BlocklessRole; use Moose; with 'MyRole::Sans::Block' => {}; }, qr/^\QA role generator is required to apply parameterized roles (did you forget the 'role { ... }' block in your parameterized role 'MyRole::Sans::Block'?)\E/); sub cant_ok { local $Test::Builder::Level = $Test::Builder::Level + 1; my $instance = shift; for my $method (@_) { ok(!$instance->can($method), "$instance cannot $method"); } } done_testing; MooseX-Role-Parameterized-1.02/t/004-with.t000644 000765 000024 00000002176 12012530160 020667 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyItem::Role::Wearable; use Moose::Role; has is_worn => ( is => 'rw', isa => 'Bool', default => 0, ); sub equip { shift->is_worn(1) } sub remove { shift->is_worn(0) } }; do { package MyItem::Role::Equippable; use MooseX::Role::Parameterized; parameter slot => ( isa => 'Str', required => 1, ); role { my $p = shift; with 'MyItem::Role::Wearable'; method slot => sub { $p->slot }; }; }; do { package MyItem::Helmet; use Moose; with 'MyItem::Role::Equippable' => { slot => 'head', }; }; do { package MyItem::Belt; use Moose; with 'MyItem::Role::Equippable' => { slot => 'waist', }; }; can_ok('MyItem::Helmet', qw/is_worn equip remove slot/); can_ok('MyItem::Belt', qw/is_worn equip remove slot/); my $visored = MyItem::Helmet->new(is_worn => 1); ok($visored->is_worn); is($visored->slot, 'head'); my $utility = MyItem::Belt->new; ok(!$utility->is_worn); is($utility->slot, 'waist'); done_testing; MooseX-Role-Parameterized-1.02/t/005-with-parameterized.t000644 000765 000024 00000003373 12012530160 023522 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyItem::Role::Wearable; use MooseX::Role::Parameterized; parameter is_worn_default => ( is => 'rw', isa => 'Bool', default => 1, ); role { my $p = shift; has is_worn => ( is => 'rw', isa => 'Bool', default => $p->is_worn_default, ); method equip => sub { shift->is_worn(1) }; method remove => sub { shift->is_worn(0) }; }; }; do { package MyItem::Role::Equippable; use MooseX::Role::Parameterized; parameter slot => ( isa => 'Str', required => 1, ); # XXX: UGH! We need some way of making this work I think.. parameter is_worn_default => ( is => 'rw', isa => 'Bool', default => 1, ); role { my $p = shift; with 'MyItem::Role::Wearable' => { is_worn_default => $p->is_worn_default, }; method slot => sub { $p->slot }; }; }; do { package MyItem::Helmet; use Moose; with 'MyItem::Role::Equippable' => { slot => 'head', is_worn_default => 0, }; }; do { package MyItem::Belt; use Moose; with 'MyItem::Role::Equippable' => { slot => 'waist', is_worn_default => 1, }; }; can_ok('MyItem::Helmet', qw/is_worn equip remove slot/); can_ok('MyItem::Belt', qw/is_worn equip remove slot/); my $feathered = MyItem::Helmet->new; ok(!$feathered->is_worn, "default for helmet is not worn"); is($feathered->slot, 'head'); my $chastity = MyItem::Belt->new; ok($chastity->is_worn, "default for belt is worn"); is($chastity->slot, 'waist'); done_testing; MooseX-Role-Parameterized-1.02/t/006-requires.t000644 000765 000024 00000003625 12012530160 021555 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; do { package MyRole::Requires; use MooseX::Role::Parameterized; parameter requires => ( is => 'rw', isa => 'Str', ); role { my $p = shift; requires $p->requires; }; }; my @keep_roles_alive; sub requires_names { map { my $role = MyRole::Requires->meta->generate_role( parameters => { requires => $_, }, ); push @keep_roles_alive, $role; $role->name; } @_ } { my ($role_name) = requires_names('alpha'); like( exception { Moose::Meta::Class->create_anon_class( roles => [ $role_name ], ); }, qr/'$role_name' requires the method 'alpha' to be implemented by '[\w:]+'/); } is (exception { Moose::Meta::Class->create_anon_class( methods => { alpha => sub {}, }, roles => [ requires_names('alpha') ], ); }, undef); { my ($role1, $role2) = requires_names('alpha', 'beta'); like( exception { Moose::Meta::Class->create_anon_class( methods => { alpha => sub {}, }, roles => [ $role1, $role2 ], ); }, qr/'$role1\|$role2' requires the method 'beta' to be implemented by '[\w:]+'/); } { my ($role1, $role2) = requires_names('alpha', 'beta'); like( exception { Moose::Meta::Class->create_anon_class( methods => { beta => sub {}, }, roles => [ $role1, $role2 ], ); }, qr/'$role1\|$role2' requires the method 'alpha' to be implemented by '[\w:]+'/); } is (exception { Moose::Meta::Class->create_anon_class( methods => { alpha => sub {}, beta => sub {}, }, roles => [ requires_names('alpha', 'beta') ], ); }, undef); done_testing; MooseX-Role-Parameterized-1.02/t/007-excludes.t000644 000765 000024 00000002240 12012530160 021523 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; do { package MyRole::Excluder; use MooseX::Role::Parameterized; parameter exclude => ( is => 'rw', isa => 'Str', ); role { my $p = shift; excludes $p->exclude; }; }; Moose::Meta::Role->create("Role::A"); Moose::Meta::Role->create("Role::B"); my @keep_roles_alive; sub excludes_roles { map { my $role = MyRole::Excluder->meta->generate_role( parameters => { exclude => $_, }, ); push @keep_roles_alive, $role; $role->name; } @_ } is (exception { Moose::Meta::Class->create_anon_class( roles => [ excludes_roles('Role::A') ], ); }, undef); { my ($role_name) = excludes_roles('Role::A'); like( exception { Moose::Meta::Class->create_anon_class( roles => [ 'Role::A', $role_name ], ); }, qr/^Conflict detected: Role $role_name excludes role 'Role::A'/); } is (exception { Moose::Meta::Class->create_anon_class( roles => [ 'Role::B', excludes_roles('Role::A') ], ); }, undef); done_testing; MooseX-Role-Parameterized-1.02/t/008-method-modifers.t000644 000765 000024 00000001734 12012530160 023005 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; my @calls; do { package MyRole::LogMethod; use MooseX::Role::Parameterized; parameter method => ( isa => 'Str', required => 1, ); role { my $p = shift; before $p->method => sub { push @calls, "calling " . $p->method }; after $p->method => sub { push @calls, "called " . $p->method }; around $p->method => sub { my $orig = shift; my $start = 0; # time $orig->(@_); my $end = 0; # time push @calls, "took " . ($end - $start) . " seconds"; }; }; }; do { package MyClass; use Moose; with 'MyRole::LogMethod' => { method => 'new', }; }; is_deeply([splice @calls], [], "no calls yet"); MyClass->new; is_deeply([splice @calls], ["calling new", "took 0 seconds", "called new"], "instrumented new"); done_testing; MooseX-Role-Parameterized-1.02/t/009-override-super.t000644 000765 000024 00000001343 12012530160 022667 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; my @calls; do { package MyRole::LogMethod; use MooseX::Role::Parameterized; parameter method => ( is => 'rw', isa => 'Str', required => 1, ); role { my $p = shift; override $p->method => sub { push @calls, "calling " . $p->method; super; push @calls, "called " . $p->method; }; }; }; do { package MyClass; use Moose; with 'MyRole::LogMethod' => { method => 'new', }; }; is_deeply([splice @calls], [], "no calls yet"); MyClass->new; is_deeply([splice @calls], ["calling new", "called new"], "instrumented new"); done_testing; MooseX-Role-Parameterized-1.02/t/010-blessed-confess.t000644 000765 000024 00000000372 12012530160 022764 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyRole; use MooseX::Role::Parameterized; ::is(\&confess, \&Carp::confess, 'confess'); ::is(\&blessed, \&Scalar::Util::blessed, 'blessed'); }; done_testing; MooseX-Role-Parameterized-1.02/t/011-reference-parameters.t000644 000765 000024 00000002633 12213631004 024011 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyRole::Delegator; use MooseX::Role::Parameterized; parameter handles => ( is => 'rw', required => 1, ); role { my $p = shift; has attr => ( is => 'rw', isa => 'MyClass::WithMethods', handles => $p->handles, ); }; }; do { package MyClass::WithMethods; use Moose; sub foo { "foo" } sub bar { "bar" } sub baz { "baz" } }; do { package MyArrayConsumer; use Moose; with 'MyRole::Delegator' => { handles => ['foo', 'bar'], }; }; can_ok(MyArrayConsumer => 'foo', 'bar'); cant_ok(MyArrayConsumer => 'baz'); do { package MyRegexConsumer; use Moose; with 'MyRole::Delegator' => { handles => qr/^ba/, }; }; can_ok(MyRegexConsumer => 'bar', 'baz'); cant_ok(MyRegexConsumer => 'foo'); do { package MyHashConsumer; use Moose; with 'MyRole::Delegator' => { handles => { my_foo => 'foo', his_baz => 'baz', }, }; }; can_ok(MyHashConsumer => 'my_foo', 'his_baz'); cant_ok(MyHashConsumer => qw/foo bar baz/); sub cant_ok { local $Test::Builder::Level = $Test::Builder::Level + 1; my $instance = shift; for my $method (@_) { ok(!$instance->can($method), "$instance cannot $method"); } } done_testing; MooseX-Role-Parameterized-1.02/t/012-rename-role.t000644 000765 000024 00000000607 12012530160 022116 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyRole; use MooseX::Role::Parameterized ( role => { -as => 'parameterized_role' }, 'method', ); parameterized_role { method ok => sub {}; }; }; my $role = MyRole->meta->generate_role; ok($role->has_method('ok'), "renaming the role block export works"); done_testing; MooseX-Role-Parameterized-1.02/t/013-does.t000644 000765 000024 00000001062 12012530160 020637 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Moose; { package MyPRole; use MooseX::Role::Parameterized; role {}; } { package MyClass; use Moose; with 'MyPRole', } my $generated_role = MyClass->meta->roles->[0]->name; does_ok( 'MyClass', $generated_role, 'class does the generate role' ); does_ok( 'MyClass', 'MyPRole', 'class does the parameterized role' ); cmp_ok( $generated_role->meta->get_roles->[0]->name, 'eq', 'MyPRole', 'generated role does the parameterized role' ); done_testing; MooseX-Role-Parameterized-1.02/t/014-compose-parameterizable.t000644 000765 000024 00000001100 12012530160 024511 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyRole; use MooseX::Role::Parameterized; parameter attribute => ( isa => 'Str', ); sub meth { 1 } role { my $p = shift; has $p->attribute => ( is => 'ro', ); }; }; do { package MyClass; use Moose; with 'MyRole' => { attribute => 'attr', }; }; ok(MyClass->can('attr'), "the parameterized attribute was composed"); ok(MyClass->can('meth'), "the unparameterized method was composed"); done_testing; MooseX-Role-Parameterized-1.02/t/015-compose-keywords.t000644 000765 000024 00000002162 12012530160 023223 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package OtherRole; use Moose::Role; }; do { package MyRole; use MooseX::Role::Parameterized; requires 'requirement'; excludes 'exclusion'; has attribute => (); method meth => sub {}; before meth => sub {}; after meth => sub {}; around meth => sub {}; sub regular_method {} override other_meth => sub { super }; with 'OtherRole'; role { } }; for my $meta (MyRole->meta, MyRole->meta->generate_role) { ok($meta->has_attribute('attribute'), 'has'); ok($meta->has_method('meth'), 'method'); ok($meta->has_method('regular_method'), 'sub'); is($meta->has_before_method_modifiers('meth'), 1, 'before'); is($meta->has_after_method_modifiers('meth'), 1, 'after'); is($meta->has_around_method_modifiers('meth'), 1, 'around'); is($meta->has_override_method_modifier('other_meth'), 1, 'override'); is($meta->does_role('OtherRole'), 1, 'with'); ok($meta->requires_method('requirement'), 'requires'); ok($meta->excludes_role('exclusion'), 'excludes'); } done_testing; MooseX-Role-Parameterized-1.02/t/016-trait.t000644 000765 000024 00000001705 12012530160 021037 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyTrait::Label; use MooseX::Role::Parameterized; parameter default => ( is => 'rw', isa => 'Str', ); role { my $p = shift; has label => ( is => 'rw', isa => 'Str', default => $p->default, ); }; }; do { package MyClass::LabeledURL; use Moose; has url => ( is => 'ro', traits => [ 'MyTrait::Label' => { default => 'yay' }, ], ); }; do { package MyClass::LabeledURL::Redux; use Moose; has 'url' => ( is => 'ro', traits => [ 'MyTrait::Label' => { default => 'yay' }, ], label => 'overridden', ); }; is(MyClass::LabeledURL->meta->get_attribute('url')->label, 'yay'); is(MyClass::LabeledURL::Redux->meta->get_attribute('url')->label, 'overridden'); done_testing; MooseX-Role-Parameterized-1.02/t/017-current_metaclass.t000644 000765 000024 00000002210 12012530160 023423 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package Labeled; use MooseX::Role::Parameterized; ::is(MooseX::Role::Parameterized->current_metaclass, undef, 'no metaclass yet'); parameter default => ( is => 'rw', isa => 'Str', ); ::is(MooseX::Role::Parameterized->current_metaclass, undef, 'no metaclass yet'); role { my $p = shift; my %args = @_; ::is(MooseX::Role::Parameterized->current_metaclass, $args{operating_on}, 'now we have a metaclass'); has label => ( is => 'rw', isa => 'Str', default => $p->default, ); ::is(MooseX::Role::Parameterized->current_metaclass, $args{operating_on}, 'now we have a metaclass'); }; ::is(MooseX::Role::Parameterized->current_metaclass, undef, 'no metaclass yet'); }; do { package Foo; use Moose; ::is(MooseX::Role::Parameterized->current_metaclass, undef, 'no metaclass yet'); with Labeled => { default => 'foo' }; ::is(MooseX::Role::Parameterized->current_metaclass, undef, 'metaclass is gone now'); }; done_testing; MooseX-Role-Parameterized-1.02/t/018-parameter-roles.t000644 000765 000024 00000002047 12012530160 023020 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More skip_all => "Not implemented yet"; #use Test::More; { package Test::Role; use MooseX::Role::Parameterized; parameter name => ( isa => "Str", is => "ro", required => 1, ); role { my $p = shift; method foo => sub { "hello " . $p->name }; has blech => ( isa => "Str", is => "ro", required => 1, ); }; package Test::Consumer; use MooseX::Role::Parameterized -parameter_roles => [ 'Test::Role' => { name => "foo" }, ]; role { my $p = shift; method parameters => sub { $p }; }; package Test::Class; use Moose; with 'Test::Consumer' => { blech => "yes" }; } my $obj = Test::Class->new; does_ok( $obj, "Test::Consumer" ); can_ok( $obj, "parameters" ); my $p = $obj->parameters; does_ok( $p, "Test::Role" ); can_ok( $p, "foo" ); can_ok( $p, "blech" ); is( $p->blech, "yes" ); is( $p->foo, "hello foo" ); done_testing; MooseX-Role-Parameterized-1.02/t/019-custom-metaclass.t000644 000765 000024 00000001714 12214076107 023215 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Moose; do { package MyTrait; use Moose::Role; }; BEGIN { do { package Parameterized; use Moose; $INC{'Parameterized.pm'} = 1; extends 'Moose::Meta::Role'; with 'MooseX::Role::Parameterized::Meta::Trait::Parameterized'; with 'MyTrait'; }; do { package Parameterizable; use Moose; $INC{'Parameterizable.pm'} = 1; extends 'MooseX::Role::Parameterized::Meta::Role::Parameterizable'; sub parameterized_role_metaclass { 'Parameterized' } }; } do { package MyRole; use MooseX::Role::Parameterized -metaclass => 'Parameterizable'; role { my ($params, %extra) = @_; ::does_ok($extra{operating_on}, 'MyTrait', 'parameterized role should do the MyTrait trait'); } }; do { package MyClass; use Moose; with 'MyRole'; }; MyClass->new; done_testing; MooseX-Role-Parameterized-1.02/t/020-metaclass-reinitialize.t000644 000765 000024 00000001651 12012530160 024351 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; BEGIN { require Moose; if (Moose->VERSION < 1.9900) { plan skip_all => "this test isn't relevant on Moose 1.x"; } } { package Foo::Meta::Role::Attribute; use Moose::Role; has foo => (is => 'ro'); } { package Foo::Exporter; use Moose::Exporter; Moose::Exporter->setup_import_methods( role_metaroles => { applied_attribute => ['Foo::Meta::Role::Attribute'], }, ); } { package Foo::Role; use MooseX::Role::Parameterized; role { my $p = shift; my %args = @_; Foo::Exporter->import({into => $args{operating_on}->name}); has foo => (is => 'ro', foo => 'bar'); }; } { package Foo; use Moose; with 'Foo::Role'; } { is(Foo->meta->find_attribute_by_name('foo')->foo, 'bar', "applied_attribute metaroles work"); } done_testing; MooseX-Role-Parameterized-1.02/t/021-parameter-trait.t000644 000765 000024 00000001472 12012530160 023012 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyTrait::Labeled; use Moose::Role; has label => ( is => 'ro', isa => 'Str', ); }; do { package P::Role; use MooseX::Role::Parameterized; parameter favorite => ( traits => ['MyTrait::Labeled'], label => 'FAVE', isa => 'Str', ); role { my $p = shift; method faves => sub { $p->meta->get_attribute('favorite')->label . ': ' . $p->favorite }; } }; do { package Class::P::d; use Moose; with 'P::Role' => { favorite => 'ether' }; }; do { package Other::Class::P::d; use Moose; with 'P::Role' => { favorite => 'karen' }; }; is(Class::P::d->faves, 'FAVE: ether'); is(Other::Class::P::d->faves, 'FAVE: karen'); done_testing; MooseX-Role-Parameterized-1.02/t/022-export-p-trait.t000644 000765 000024 00000002132 12214077631 022620 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; BEGIN { package MyTrait::Label; use MooseX::Role::Parameterized; parameter default => ( is => 'rw', isa => 'Str', ); role { my $p = shift; has label => ( is => 'rw', isa => 'Str', default => $p->default, ); }; }; BEGIN { package t::MooseX::LabeledAttributes; use Moose::Exporter; $INC{'t/MooseX/LabeledAttributes.pm'} = 1; Moose::Exporter->setup_import_methods( class_metaroles => { attribute => [ 'MyTrait::Label' => { default => 'no label' } ], }, ); } do { package MyClass::LabeledURL; use Moose; use t::MooseX::LabeledAttributes; has name => ( is => 'ro', ); has url => ( is => 'ro', label => 'overridden', ); no Moose; no t::MooseX::LabeledAttributes; }; my $meta = MyClass::LabeledURL->meta; is($meta->get_attribute('name')->label, 'no label'); is($meta->get_attribute('url')->label, 'overridden'); done_testing; MooseX-Role-Parameterized-1.02/t/023-metarole-import-params.t000644 000765 000024 00000002720 12015661076 024327 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More skip_all => "Not implemented yet"; BEGIN { package MyTrait::Label; use MooseX::Role::Parameterized; parameter default => ( is => 'rw', isa => 'Str', ); role { my $p = shift; has label => ( is => 'rw', isa => 'Str', default => $p->default, ); }; }; BEGIN { package t::MooseX::LabeledAttributes; use Moose::Exporter; $INC{'t/MooseX/LabeledAttributes.pm'} = 1; # what is the secret sauce? } do { package MyClass::LabeledURL; use Moose; use t::MooseX::LabeledAttributes default => 'no label'; has name => ( is => 'ro', ); has url => ( is => 'ro', label => 'overridden', ); no Moose; no t::MooseX::LabeledAttributes; }; do { package MyClass::LabeledPost; use Moose; use t::MooseX::LabeledAttributes default => 'TODO!'; has name => ( is => 'ro', ); has body => ( is => 'ro', label => 'nevermind...', ); no Moose; no t::MooseX::LabeledAttributes; }; my $url_meta = MyClass::LabeledURL->meta; is($meta->get_attribute('name')->label, 'no label'); is($meta->get_attribute('url')->label, 'overridden'); my $post_meta = MyClass::LabeledPost->meta; is($meta->get_attribute('name')->label, 'TODO!'); is($meta->get_attribute('body')->label, 'nevermind...'); done_testing; MooseX-Role-Parameterized-1.02/t/100-erroneous-keywords.t000644 000765 000024 00000001720 12012530160 023571 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; do { package MyRole::Storage; use MooseX::Role::Parameterized; ::like( ::exception { parameter() }, qr/^You must provide a name for the attribute/); role { ::like( ::exception { extends 'MyRole::Parameterized'; }, qr/^Roles do not support 'extends' \(you can use 'with' to specialize a role\)/); ::like( ::exception { inner() }, qr/^Roles cannot support 'inner'/); ::like( ::exception { augment() }, qr/^Roles cannot support 'augment'/); ::like( ::exception { parameter() }, qr/^'parameter' may not be used inside of the role block/); ::like( ::exception { role {} }, qr/^'role' may not be used inside of the role block/); }; }; Moose::Meta::Class->create_anon_class( roles => ['MyRole::Storage'], ); done_testing; MooseX-Role-Parameterized-1.02/t/101-alias-excludes.t000644 000765 000024 00000002010 12012530160 022600 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; do { package MyRole; use MooseX::Role::Parameterized; ::is( ::exception { parameter 'alias'; }, undef); ::is( ::exception { parameter 'excludes'; }, undef); role { } }; do { package MyClass; use Moose; ::is( ::exception { with MyRole => { alias => 1, }; }, undef); ::is( ::exception { with MyRole => { excludes => 1, }; }, undef); }; do { package OrdinaryRole; use MooseX::Role::Parameterized; sub code { 'originally code' } sub other_code { 'originally other_code' } role { } }; do { package OrdinaryClass; use Moose; with OrdinaryRole => { -alias => { code => 'new_code' }, -excludes => [ 'other_code' ], }; }; ok(!OrdinaryClass->can('other_code')); is(OrdinaryClass->code, 'originally code'); is(OrdinaryClass->new_code, 'originally code'); done_testing; MooseX-Role-Parameterized-1.02/t/102-nested.t000644 000765 000024 00000002311 12012530160 021164 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; use FindBin; use lib "$FindBin::Bin/lib"; { package Foo; use MooseX::Role::Parameterized; parameter 'outer' => ( default => 'yep..', ); role { with 'Bar', { include_is_bar => 0 }; method is_foo => sub { 1 }; }; } { package Foo::Class; use Moose; ::is( ::exception { with 'Foo'; }, undef); } { package Bar::Class; use Moose; ::is( ::exception { with 'Bar'; }, undef); } my $foo = Foo::Class->meta->roles->[0]; ok($foo->has_method('is_foo'), 'Foo got the "is_foo" method'); ok(!$foo->has_method('is_bar'), 'Foo did not get the "is_bar" method from Bar'); my $bar = Bar::Class->meta->roles->[0]; ok($bar->has_method('is_bar'), 'Bar got the "is_bar" method'); ok(!$bar->has_method('is_foo'), 'Bar does not get "is_foo"'); ok(Foo->meta->has_parameter('outer'), 'Foo has outer param'); ok(Bar->meta->has_parameter('include_is_bar'), 'Bar has include_is_bar param'); ok(!Foo->meta->has_parameter('include_is_bar'), 'Foo does not have include_is_bar param'); ok(!Bar->meta->has_parameter('outer'), 'Bar does not have outer param'); done_testing; MooseX-Role-Parameterized-1.02/t/150-composite-role-application.t000644 000765 000024 00000004546 12012530160 025163 0ustar00sartakstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; do { package MyCompositeRoleA; use MooseX::Role::Parameterized; parameter attribute => ( isa => 'Str', required => 1, ); role { my $p = shift; has $p->attribute => ( is => 'rw', ); }; }; do { package MyCompositeRoleB; use MooseX::Role::Parameterized; parameter accessor => ( isa => 'Str', required => 1, ); role { my $p = shift; has $p->accessor => ( is => 'rw', isa => 'Int', ); }; }; do { package MyDoubleConsumer; use Moose; with MyCompositeRoleA => { attribute => 'foo' }, MyCompositeRoleB => { accessor => 'bar' }; }; ok(MyDoubleConsumer->can('foo'), 'first role in composite applied successfully'); ok(MyDoubleConsumer->can('bar'), 'second role in composite applied successfully'); do { package MyExtendingRole; use MooseX::Role::Parameterized; parameter foo => ( isa => 'Int', ); role { my $p = shift; with 'MyCompositeRoleA', { attribute => 'bar' }; has foo => ( is => 'rw', default => sub { $p->foo }, ); }; }; do { package MyExtendedConsumer; use Moose; with MyCompositeRoleA => { attribute => 'baz' }, MyExtendingRole => { foo => 23 }; }; ok(MyExtendedConsumer->can('baz'), 'role composed directly applied successfully'); ok(MyExtendedConsumer->can('bar'), 'role composed through other role applied successfully'); is(eval { MyExtendedConsumer->new->foo }, 23, 'role composing other role applied successfully'); do { package MyRoleProxy; use MooseX::Role::Parameterized; parameter rolename => (isa => "Str"); parameter roleparams => (isa => "HashRef"); role { my $p = shift; with $p->rolename, $p->roleparams; }; }; do { package MyProxyConsumer; use Moose; with( MyRoleProxy => { rolename => 'MyCompositeRoleA', roleparams => { attribute => 'baz' }, }, MyCompositeRoleB => { accessor => 'qux', }, ); }; ok(MyProxyConsumer->can('baz'), 'proxied role got applied successfully'); ok(MyProxyConsumer->can('qux'), 'other role besides proxied one got applied successfully'); done_testing; MooseX-Role-Parameterized-1.02/t/lib/000755 000765 000024 00000000000 12214101244 017767 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/t/lib/Bar.pm000644 000765 000024 00000000344 12012530160 021031 0ustar00sartakstaff000000 000000 package Bar; use MooseX::Role::Parameterized; parameter include_is_bar => ( isa => 'Bool', default => 1, ); role { my $p = shift; if ($p->include_is_bar) { method is_bar => sub { 1 }; } }; 1; MooseX-Role-Parameterized-1.02/lib/MooseX/000755 000765 000024 00000000000 12214101244 020736 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/MooseX/Role/000755 000765 000024 00000000000 12214101244 021637 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/000755 000765 000024 00000000000 12214101244 024433 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized.pm000644 000765 000024 00000013076 12214076625 025016 0ustar00sartakstaff000000 000000 package MooseX::Role::Parameterized; use 5.008001; use Moose::Role (); use Moose::Exporter; use Carp 'confess'; use Moose::Util 'find_meta'; use MooseX::Role::Parameterized::Meta::Role::Parameterizable; our $VERSION = '1.02'; our $CURRENT_METACLASS; sub current_metaclass { $CURRENT_METACLASS } Moose::Exporter->setup_import_methods( also => 'Moose::Role', with_caller => ['parameter', 'role'], with_meta => ['method'], meta_lookup => sub { current_metaclass || find_meta(shift) }, ); sub parameter { my $caller = shift; confess "'parameter' may not be used inside of the role block" if current_metaclass && current_metaclass->genitor->name eq $caller; my $meta = find_meta($caller); my $names = shift; $names = [$names] if !ref($names); for my $name (@$names) { $meta->add_parameter($name => ( is => 'ro', @_, )); } } sub role (&) { my $caller = shift; my $role_generator = shift; confess "'role' may not be used inside of the role block" if current_metaclass && current_metaclass->genitor->name eq $caller; find_meta($caller)->role_generator($role_generator); } sub init_meta { my $self = shift; my %options = @_; $options{metaclass} ||= 'MooseX::Role::Parameterized::Meta::Role::Parameterizable'; return Moose::Role->init_meta(%options); } sub method { my $meta = shift; my $name = shift; my $body = shift; my $method = $meta->method_metaclass->wrap( package_name => $meta->name, name => $name, body => $body, ); $meta->add_method($name => $method); } 1; __END__ =head1 NAME MooseX::Role::Parameterized - roles with composition parameters =head1 SYNOPSIS package Counter; use MooseX::Role::Parameterized; parameter name => ( isa => 'Str', required => 1, ); role { my $p = shift; my $name = $p->name; has $name => ( is => 'rw', isa => 'Int', default => 0, ); method "increment_$name" => sub { my $self = shift; $self->$name($self->$name + 1); }; method "reset_$name" => sub { my $self = shift; $self->$name(0); }; }; package MyGame::Weapon; use Moose; with Counter => { name => 'enchantment' }; package MyGame::Wand; use Moose; with Counter => { name => 'zapped' }; =head1 L B If you're new here, please read L for a much gentler introduction. =head1 DESCRIPTION Your parameterized role consists of two new things: parameter declarations and a C block. Parameters are declared using the L keyword which very much resembles L. You can use any option that L accepts. The default value for the C option is C as that's a very common case. Use C<< is => 'bare' >> if you want no accessor. These parameters will get their values when the consuming class (or role) uses L. A parameter object will be constructed with these values, and passed to the C block. The C block then uses the usual L keywords to build up a role. You can shift off the parameter object to inspect what the consuming class provided as parameters. You use the parameters to customize your role however you wish. There are many possible implementations for parameterized roles (hopefully with a consistent enough API); I believe this to be the easiest and most flexible design. Coincidentally, Pugs originally had an eerily similar design. See L for some tips on how to extend this module. =head2 Why a parameters object? I've been asked several times "Why use a parameter I and not just a parameter I? That would eliminate the need to explicitly declare your parameters." The benefits of using an object are similar to the benefits of using Moose. You get an easy way to specify lazy defaults, type constraint, delegation, and so on. You get to use MooseX modules. You also get the usual introspective and intercessory abilities that come standard with the metaobject protocol. Ambitious users should be able to add traits to the parameters metaclass to further customize behavior. Please let me know if you're doing anything viciously complicated with this extension. :) =head1 CAVEATS You must use this syntax to declare methods in the role block: C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In return though you can use parameters I! =head1 AUTHOR Shawn M Moore, C =head1 SEE ALSO L L L L L L L L - this extension ported to JavaScript's Joose =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 Infinity Interactive This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Extending.pod000644 000765 000024 00000004045 12012530160 027066 0ustar00sartakstaff000000 000000 =pod =head1 NAME MooseX::Role::Parameterized::Extending - extending MooseX::Role::Parameterized roles =head1 DESCRIPTION There are heaps of useful modules in the C namespace that you can use to make your roles more powerful. However, they do not always work out of the box with L, but it's fairly straight-forward to achieve the functionality you desire. L was designed to be as extensible as the rest of L, and as such it is possible to apply custom traits to both the parameterizable role or the ordinary roles they generate. In this example, we will look at applying the fake trait C to a parameterizable role. First we need to define a new metaclass for our parameterizable role. package MyApp::Meta::Role::Parameterizable; use Moose; extends 'MooseX::Role::Parameterized::Meta::Role::Parameterizable'; with 'MooseX::MagicRole'; This is a class (observe that it uses L, not L) which extends the class which governs parameterizable roles. L is the metaclass that packages using L receive by default. Note that the class we are extending, L>|MooseX::Role::Parameterized::Meta::Role::Parameterizable>, is entirely distinct from the similarly-named class which governs the ordinary roles that parameterized roles generate. An instance of L>|MooseX::Role::Parameterized> represents a role with its parameters already bound. Now we can take advantage of our new subclass by specifying that we want to use C as our metaclass when importing L: package MyApp::Role; use MooseX::Role::Parameterized -metaclass => 'MyApp::Meta::Role::Parameterizable'; role { ... } And there you go! C now has the C trait applied. =cut MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Meta/000755 000765 000024 00000000000 12214101244 025321 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Parameters.pm000644 000765 000024 00000001170 12214076625 027111 0ustar00sartakstaff000000 000000 package MooseX::Role::Parameterized::Parameters; use Moose; our $VERSION = '1.02'; __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =head1 NAME MooseX::Role::Parameterized::Parameters - base class for parameters =head1 DESCRIPTION This is the base class for parameter objects. Currently empty, but I reserve the right to add things here. Each parameterizable role gets their own anonymous subclass of this; L actually operates on these anonymous subclasses. Each parameterized role gets their own instance of the anonymous subclass (owned by the parameterizable role). =cut MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Tutorial.pod000644 000765 000024 00000015403 12012530160 026744 0ustar00sartakstaff000000 000000 =pod =head1 NAME MooseX::Role::Parameterized::Tutorial - why and how =head1 MOTIVATION Roles are composable units of behavior. They are useful for factoring out functionality common to many classes from any part of your class hierarchy. See L for an introduction to L. While combining roles affords you a great deal of flexibility, individual roles have very little in the way of configurability. Core Moose provides C<-alias> for renaming methods and C<-excludes> for ignoring methods. These options are primarily for resolving role conflicts. Depending on how much of a purist you are, these options are I for resolving role conflicts. See L for more about C<-alias> and C<-excludes>. Because roles serve many different masters, they usually provide only the least common denominator of functionality. To empower roles further, more configurability than C<-alias> and C<-excludes> is required. Perhaps your role needs to know which method to call when it is done processing. Or what default value to use for its C attribute. Parameterized roles offer a solution to these (and other) kinds of problems. =head1 USAGE =head3 C The syntax of a class consuming a parameterized role has not changed from the standard C. You pass in parameters just like you pass in C<-alias> and C<-excludes> to ordinary roles (though your custom parameters do not get hyphens, since these are not core Moose composition parameters): with 'MyRole::InstrumentMethod' => { method_name => 'dbh_do', log_to => 'query.log', }; You can still combine parameterized roles. You just need to specify parameters immediately after the role they belong to: with ( 'My::Parameterized::Role' => { needs_better_example => 1, }, 'My::Other::Role', ); We, like Moose itself, use L to make sure that a list of role names and associated parameters is handled correctly. =head3 C Inside your parameterized role, you specify a set of parameters. This is exactly like specifying the attributes of a class. Instead of L you use the keyword C, but your parameters can use any options to C. parameter 'delegation' => ( isa => 'HashRef|ArrayRef|RegexpRef', predicate => 'has_delegation', ); You do have to declare what parameters you accept, just like you have to declare what attributes you accept for regular Moose objects. One departure from C is that we create a reader accessor for you by default. In other words, we assume C<< is => 'ro' >>. We create this reader for convenience because generally the parameterized role is the only consumer of the parameters object, so data hiding is not as important than in the general case of L. If you do not want an accessor, you can use C<< is => 'bare' >>. =head3 C C takes a block of code that will be used to generate your role with its parameters bound. Here is where you declare components that depend on parameters. You can declare attributes, methods, modifiers, etc. The first argument to the C is an object containing the parameters specified by C. You can access the parameters just like regular attributes on that object. Each time you compose this parameterized role, the C block will be executed. It will receive a new parameter object and produce an entirely new role. That's the whole point, after all. Due to limitations inherent in Perl, you must declare methods with C<< method name => sub { ... } >> instead of the usual C. Your methods may, of course, close over the parameter object. This means that your methods may use parameters however they wish! =head1 USES Ideally these will become fully-explained examples in something resembling L. But for now, only a braindump. =over 4 =item Configure a role's attributes You can rename methods with core Moose, but now you can rename attributes. You can now also choose type, default value, whether it's required, B, etc. parameter traits => ( isa => 'ArrayRef', default => sub { [] }, ); parameter type => ( isa => 'Str', default => 'Any', ); role { my $p = shift; has action => ( traits => $p->traits, isa => $p->type, ... ); } =item Inform a role of your class' attributes and methods Core roles can only require methods with specific names chosen by the role. Now your roles can demand that the class specifies a method name you wish the role to instrument, or which attributes to dump to a file. parameter instrument_method => ( isa => 'Str', required => 1, ); role { my $p = shift; around $p->instrument_method => sub { ... }; } =item Arbitrary execution choices Your role may be able to provide configuration in how the role's methods operate. For example, you can tell the role whether to save intermediate states. parameter save_intermediate => ( isa => 'Bool', default => 0, ); role { my $p = shift; method process => sub { ... if ($p->save_intermediate) { ... } ... }; } =item Deciding a backend Your role may be able to freeze and thaw your instances using L, L, L. Which backend to use can be a parameter. parameter format => ( isa => (enum ['Storable', 'YAML', 'JSON']), default => 'Storable', ); role { my $p = shift; if ($p->format eq 'Storable') { method freeze => \&Storable::freeze; method thaw => \&Storable::thaw; } elsif ($p->format eq 'YAML') { method freeze => \&YAML::Dump; method thaw => \&YAML::Load; } ... } =item Additional validation Ordinary roles can require that its consumers have a particular list of method names. Since parameterized roles have direct access to its consumer, you can inspect it and throw errors if the consumer does not meet your needs. role { my $p = shift; my %args = @_; my $consumer = $args{consumer}; $consumer->find_attribute_by_name('stack') or confess "You must have a 'stack' attribute"; my $push = $consumer->find_method_by_name('push') or confess "You must have a 'push' method"; my $params = $push->parsed_signature->positional_params->params; @$params == 1 or confess "Your push method must take a single parameter"; $params->[0]->sigil eq '$' or confess "Your push parameter must be a scalar"; ... } =back =cut MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Meta/Role/000755 000765 000024 00000000000 12214101244 026222 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Meta/Trait/000755 000765 000024 00000000000 12214101244 026404 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Meta/Trait/Parameterized.pm000644 000765 000024 00000003311 12214076625 031552 0ustar00sartakstaff000000 000000 package MooseX::Role::Parameterized::Meta::Trait::Parameterized; use Moose::Role; our $VERSION = '1.02'; use MooseX::Role::Parameterized::Parameters; use Moose::Util 'find_meta'; has genitor => ( is => 'ro', isa => 'MooseX::Role::Parameterized::Meta::Role::Parameterizable', required => 1, ); has parameters => ( is => 'rw', isa => 'MooseX::Role::Parameterized::Parameters', ); around reinitialize => sub { my $orig = shift; my $class = shift; my ($pkg) = @_; my $meta = blessed($pkg) ? $pkg : find_meta($pkg); my $genitor = $meta->genitor; my $parameters = $meta->parameters; my $new = $class->$orig( @_, (defined($genitor) ? (genitor => $genitor) : ()), (defined($parameters) ? (parameters => $parameters) : ()), ); # in case the role metaclass was reinitialized $MooseX::Role::Parameterized::CURRENT_METACLASS = $new; return $new; }; no Moose::Role; 1; __END__ =head1 NAME MooseX::Role::Parameterized::Meta::Trait::Parameterized - trait for parameterized roles =head1 DESCRIPTION This is the trait for parameterized roles; that is, parameterizable roles with their parameters bound. All this actually provides is a place to store the L object as well as the L object that generated this role object. =head1 ATTRIBUTES =head2 genitor Returns the L metaobject that generated this role. =head2 parameters Returns the L object that represents the specific parameter values for this parameterized role. =cut MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm000644 000765 000024 00000012176 12214076625 031714 0ustar00sartakstaff000000 000000 package MooseX::Role::Parameterized::Meta::Role::Parameterizable; use Moose; extends 'Moose::Meta::Role'; our $VERSION = '1.02'; use MooseX::Role::Parameterized::Meta::Role::Parameterized; use MooseX::Role::Parameterized::Parameters; use Module::Runtime 'use_module'; has parameterized_role_metaclass => ( is => 'ro', isa => 'ClassName', default => 'MooseX::Role::Parameterized::Meta::Role::Parameterized', ); has parameters_class => ( is => 'ro', isa => 'ClassName', default => 'MooseX::Role::Parameterized::Parameters', ); has parameters_metaclass => ( is => 'rw', isa => 'Moose::Meta::Class', lazy => 1, builder => '_build_parameters_metaclass', handles => { has_parameter => 'has_attribute', add_parameter => 'add_attribute', construct_parameters => 'new_object', }, ); has role_generator => ( is => 'rw', isa => 'CodeRef', predicate => 'has_role_generator', ); sub _build_parameters_metaclass { my $self = shift; return $self->parameters_class->meta->create_anon_class( superclasses => [$self->parameters_class], ); } sub generate_role { my $self = shift; my %args = @_; my $parameters = blessed($args{parameters}) ? $args{parameters} : $self->construct_parameters(%{ $args{parameters} }); confess "A role generator is required to apply parameterized roles (did you forget the 'role { ... }' block in your parameterized role '".$self->name."'?)" unless $self->has_role_generator; my $parameterized_role_metaclass = $self->parameterized_role_metaclass; use_module($parameterized_role_metaclass); my $role; if ($args{package}) { $role = $parameterized_role_metaclass->create( $args{package}, genitor => $self, parameters => $parameters, ); } else { $role = $parameterized_role_metaclass->create_anon_role( genitor => $self, parameters => $parameters, ); } local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role; $self->apply_parameterizable_role($role); $self->role_generator->($parameters, operating_on => $role, consumer => $args{consumer}, ); # don't just return $role here, because it might have been changed when # metaroles are applied return $MooseX::Role::Parameterized::CURRENT_METACLASS; } sub _role_for_combination { my $self = shift; my $parameters = shift; return $self->generate_role( parameters => $parameters, ); } sub apply { my $self = shift; my $consumer = shift; my %args = @_; my $role = $self->generate_role( consumer => $consumer, parameters => \%args, ); $role->apply($consumer, %args); } sub apply_parameterizable_role { my $self = shift; $self->SUPER::apply(@_); } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =head1 NAME MooseX::Role::Parameterized::Meta::Role::Parameterizable - metaclass for parameterizable roles =head1 DESCRIPTION This is the metaclass for parameterizable roles, roles that have their parameters currently unbound. These are the roles that you use L, but instead of composing the parameterizable role, we construct a new parameterized role (L) and use that new parameterized instead. =head1 ATTRIBUTES =head2 parameterized_role_metaclass The name of the class that will be used to construct the parameterized role. =head2 parameters_class The name of the class that will be used to construct the parameters object. =head2 parameters_metaclass A metaclass representing this roles's parameters. It will be an anonymous subclass of L. Each call to L adds an attribute to this metaclass. When this role is consumed, the parameters object will be instantiated using this metaclass. =head2 role_generator A code reference that is used to generate a role based on the parameters provided by the consumer. The user usually specifies it using the L keyword. =head1 METHODS =head2 add_parameter $name, %options Delegates to L on the L object. =head2 construct_parameters %arguments Creates a new L object using metaclass L. The arguments are those specified by the consumer as parameter values. =head2 generate_role %arguments This method generates and returns a new instance of L. It can take any combination of three named parameters: =over 4 =item arguments A hashref of parameters for the role, same as would be passed in at a "with" statement. =item package A package name that, if present, we will use for the generated role; if not, we generate an anonymous role. =item consumer A consumer metaobject, if available. =back =head2 apply Overrides L to automatically generate the parameterized role. =cut MooseX-Role-Parameterized-1.02/lib/MooseX/Role/Parameterized/Meta/Role/Parameterized.pm000644 000765 000024 00000001102 12214076625 031364 0ustar00sartakstaff000000 000000 package MooseX::Role::Parameterized::Meta::Role::Parameterized; use Moose; extends 'Moose::Meta::Role'; with 'MooseX::Role::Parameterized::Meta::Trait::Parameterized'; our $VERSION = '1.02'; __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =head1 NAME MooseX::Role::Parameterized::Meta::Role::Parameterized - metaclass for parameterized roles =head1 DESCRIPTION This is the metaclass for parameterized roles; that is, parameterizable roles with their parameters bound. See L which has all the guts. =cut MooseX-Role-Parameterized-1.02/inc/Module/000755 000765 000024 00000000000 12214101244 020754 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/inc/Module/Install/000755 000765 000024 00000000000 12214101244 022362 5ustar00sartakstaff000000 000000 MooseX-Role-Parameterized-1.02/inc/Module/Install.pm000644 000765 000024 00000030135 12214101214 022717 0ustar00sartakstaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. MooseX-Role-Parameterized-1.02/inc/Module/Install/AutoManifest.pm000644 000765 000024 00000001257 12214101214 025321 0ustar00sartakstaff000000 000000 #line 1 use strict; use warnings; package Module::Install::AutoManifest; use Module::Install::Base; BEGIN { our $VERSION = '0.003'; our $ISCORE = 1; our @ISA = qw(Module::Install::Base); } sub auto_manifest { my ($self) = @_; return unless $Module::Install::AUTHOR; die "auto_manifest requested, but no MANIFEST.SKIP exists\n" unless -e "MANIFEST.SKIP"; if (-e "MANIFEST") { unlink('MANIFEST') or die "Can't remove MANIFEST: $!"; } $self->postamble(<<"END"); create_distdir: manifest_clean manifest distclean :: manifest_clean manifest_clean: \t\$(RM_F) MANIFEST END } 1; __END__ #line 48 #line 131 1; # End of Module::Install::AutoManifest MooseX-Role-Parameterized-1.02/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12214101214 023573 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 MooseX-Role-Parameterized-1.02/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12214101214 023427 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 MooseX-Role-Parameterized-1.02/inc/Module/Install/Fetch.pm000644 000765 000024 00000004627 12214101214 023757 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; MooseX-Role-Parameterized-1.02/inc/Module/Install/GithubMeta.pm000644 000765 000024 00000002105 12214101214 024744 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::GithubMeta; use strict; use warnings; use Cwd; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.22'; sub githubmeta { my $self = shift; return unless $Module::Install::AUTHOR; return unless _under_git(); return unless $self->can_run('git'); my $remote = shift || 'origin'; return unless my ($git_url) = `git remote show -n $remote` =~ /URL: (.*)$/m; return unless $git_url =~ /github\.com/; # Not a Github repository my $http_url = $git_url; $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!; $http_url =~ s![\w\-]+\@([^:]+):!https://$1/!; $http_url =~ s!\.git$!/tree!; $self->repository( $git_url ); $self->homepage( $http_url ) unless $self->homepage(); return 1; } sub _under_git { return 1 if -e '.git'; my $cwd = getcwd; my $last = $cwd; my $found = 0; while (1) { chdir '..' or last; my $current = getcwd; last if $last eq $current; $last = $current; if ( -e '.git' ) { $found = 1; last; } } chdir $cwd; return $found; } 'Github'; __END__ #line 111 MooseX-Role-Parameterized-1.02/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12214101214 024447 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 MooseX-Role-Parameterized-1.02/inc/Module/Install/ManifestSkip.pm000644 000765 000024 00000001557 12214101214 025322 0ustar00sartakstaff000000 000000 #line 1 ## # name: Module::Install::ManifestSkip # abstract: Generate a MANIFEST.SKIP file # author: Ingy döt Net # license: perl # copyright: 2010, 2011 # see: # - Module::Manifest::Skip package Module::Install::ManifestSkip; use 5.008001; use strict; use warnings; use base 'Module::Install::Base'; my $requires = " use Module::Manifest::Skip 0.10 (); "; our $VERSION = '0.20'; our $AUTHOR_ONLY = 1; my $skip_file = "MANIFEST.SKIP"; sub manifest_skip { my $self = shift; return unless $self->is_admin; eval $requires; die $@ if $@; print "Writing $skip_file\n"; open OUT, '>', $skip_file or die "Can't open $skip_file for output: $!";; print OUT Module::Manifest::Skip->new->text; close OUT; $self->clean_files('MANIFEST'); $self->clean_files($skip_file) if grep /^clean$/, @_; } 1; MooseX-Role-Parameterized-1.02/inc/Module/Install/Metadata.pm000644 000765 000024 00000043277 12214101214 024452 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; MooseX-Role-Parameterized-1.02/inc/Module/Install/Win32.pm000644 000765 000024 00000003403 12214101214 023617 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; MooseX-Role-Parameterized-1.02/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002376 12214101214 024450 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1;