MooX-Aliases-0.001006/000755 000765 000024 00000000000 12463361402 014463 5ustar00gknopstaff000000 000000 MooX-Aliases-0.001006/Changes000644 000765 000024 00000001247 12463361354 015770 0ustar00gknopstaff000000 000000 Revision history for MooX::Aliases 0.001006 - 2015-02-01 - name alias methods to avoid them getting autocleaned or detected by Test::CleanNamespaces (RT#101814) 0.001005 - 2015-01-06 - fix +attribute overrides - fix multi-attribute definitions 0.001004 - 2014-12-09 - remove synopsis test, as it is redundant and annoying to test 0.001003 - 2014-12-07 - fix aliases being added in +attribute overrides (GH#1) 0.001002 - 2014-08-16 - fix compatibility with perl 5.6 - list perl prerequisite in metadata - include correct developer prerequisites 0.001001 - 2014-05-25 - fix compatibility with namespace::clean 0.001000 - 2013-05-02 - initial release MooX-Aliases-0.001006/lib/000755 000765 000024 00000000000 12463361402 015231 5ustar00gknopstaff000000 000000 MooX-Aliases-0.001006/maint/000755 000765 000024 00000000000 12463361402 015573 5ustar00gknopstaff000000 000000 MooX-Aliases-0.001006/Makefile.PL000644 000765 000024 00000005252 12463360156 016446 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.006; my %META = ( name => 'MooX-Aliases', license => 'perl_5', prereqs => { test => { requires => { 'Test::More' => 0.94, 'Test::Fatal' => 0.003, } }, runtime => { requires => { 'Moo' => 1.001000, 'Class::Method::Modifiers' => 1.05, 'strictures' => 1, 'perl' => 5.006, } }, develop => { requires => { 'Moose' => 0, 'namespace::clean' => 0, 'namespace::autoclean' => 0, 'Test::CleanNamespaces' => 0, } }, }, resources => { repository => { url => 'git://github.com/haarg/MooX-Aliases.git', web => 'http://github.com/haarg/MooX-Aliases', type => 'git', }, x_IRC => 'irc://irc.perl.org/#moose', bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=MooX-Aliases', mailto => 'bug-MooX-Aliases@rt.cpan.org', }, license => [ 'http://dev.perl.org/licenses/' ], }, no_index => { directory => [ 't', 'xt' ] }, x_authority => 'cpan:HAARG', ); my %MM_ARGS = ( ); ## BOILERPLATE ############################################################### require ExtUtils::MakeMaker; (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $META{license} = [ $META{license} ] if $META{license} && !ref $META{license}; $MM_ARGS{LICENSE} = $META{license}[0] if $META{license} && $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); ## END BOILERPLATE ########################################################### MooX-Aliases-0.001006/MANIFEST000644 000765 000024 00000001030 12463361402 015606 0ustar00gknopstaff000000 000000 Changes lib/MooX/Aliases.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/attributes.t t/basic.t t/errors.t t/init_arg-coerce.t t/init_arg.t t/roles-init_arg.t t/roles.t t/traits.t xt/autoclean.t xt/clean.t xt/init-args-moose.t xt/moose-inherit.t xt/test-cleannamespaces.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) MooX-Aliases-0.001006/META.json000644 000765 000024 00000003263 12463361402 016110 0ustar00gknopstaff000000 000000 { "abstract" : "easy aliasing of methods and attributes in Moo", "author" : [ "haarg - Graham Knop (cpan:HAARG) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "MooX-Aliases", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : {}, "configure" : {}, "develop" : { "requires" : { "Moose" : "0", "Test::CleanNamespaces" : "0", "namespace::autoclean" : "0", "namespace::clean" : "0" } }, "runtime" : { "requires" : { "Class::Method::Modifiers" : "1.05", "Moo" : "1.001", "perl" : "5.006", "strictures" : "1" } }, "test" : { "requires" : { "Test::Fatal" : "0.003", "Test::More" : "0.94" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-MooX-Aliases@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=MooX-Aliases" }, "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/haarg/MooX-Aliases.git", "web" : "http://github.com/haarg/MooX-Aliases" }, "x_IRC" : "irc://irc.perl.org/#moose" }, "version" : "0.001006", "x_authority" : "cpan:HAARG" } MooX-Aliases-0.001006/META.yml000644 000765 000024 00000001455 12463361402 015741 0ustar00gknopstaff000000 000000 --- abstract: 'easy aliasing of methods and attributes in Moo' author: - 'haarg - Graham Knop (cpan:HAARG) ' build_requires: Test::Fatal: '0.003' Test::More: '0.94' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MooX-Aliases no_index: directory: - t - xt requires: Class::Method::Modifiers: '1.05' Moo: '1.001' perl: '5.006' strictures: '1' resources: IRC: irc://irc.perl.org/#moose bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=MooX-Aliases license: http://dev.perl.org/licenses/ repository: git://github.com/haarg/MooX-Aliases.git version: '0.001006' x_authority: cpan:HAARG MooX-Aliases-0.001006/README000644 000765 000024 00000003657 12463361402 015356 0ustar00gknopstaff000000 000000 NAME MooX::Aliases - easy aliasing of methods and attributes in Moo SYNOPSIS package MyClass; use Moo; use MooX::Aliases; has this => ( is => 'rw', alias => 'that', ); sub foo { my $self = shift; print $self->that } alias bar => 'foo'; my $o = MyApp->new(); $o->this('Hello World'); $o->bar; # prints 'Hello World' or package MyRole; use Moo::Role; use MooX::Aliases; has this => ( is => 'rw', alias => 'that', ); sub foo { my $self = shift; print $self->that } alias bar => 'foo'; DESCRIPTION The MooX::Aliases module will allow you to quickly alias methods in Moo. It provides an alias parameter for has() to generate aliased accessors as well as the standard ones. Attributes can also be initialized in the constructor via their aliased names. You can create more than one alias at once by passing a listref: has ip_addr => ( alias => [ qw(ipAddr ip) ], ); FUNCTIONS alias $alias, $method Creates $alias as a method that is aliased to $method. CAVEATS This module uses the "BUILDARGS" to map the attributes. If a class uses a custom "BUILDARGS", this module may not behave properly. SEE ALSO MooseX::Aliases AUTHOR haarg - Graham Knop (cpan:HAARG) CONTRIBUTORS * Chris Prather * Jesse Luehrs * Justin Hunter * Karen Etheridge * Yuval Kogman * Daniel Gempesaw * Denis Ibaev COPYRIGHT Copyright (c) 2013 the MooX::Alises "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. MooX-Aliases-0.001006/t/000755 000765 000024 00000000000 12463361402 014726 5ustar00gknopstaff000000 000000 MooX-Aliases-0.001006/xt/000755 000765 000024 00000000000 12463361402 015116 5ustar00gknopstaff000000 000000 MooX-Aliases-0.001006/xt/autoclean.t000644 000765 000024 00000001511 12463360323 017255 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; use Test::Fatal; { package Foo; use Moo; use MooX::Aliases; use namespace::autoclean; has attr1 => ( is => 'ro', required => 1, alias => 'attr1_alias', ); } is exception { Foo->new( attr1_alias => 1 ); }, undef, 'aliases work when using namespace::autoclean'; ok +Foo->can('attr1_alias'), 'aliases still exist when using namespace::autoclean'; { package Bar; use Moo; use MooX::Aliases; use namespace::autoclean; BEGIN { has attr1 => ( is => 'ro', required => 1, alias => 'attr1_alias', ); } } is exception { Bar->new( attr1_alias => 1 ); }, undef, 'compile time aliases work in constructor with namespace::autoclean'; ok +Bar->can('attr1_alias'), 'compile time alias methods still exist with namespace::autoclean'; done_testing; MooX-Aliases-0.001006/xt/clean.t000644 000765 000024 00000001461 12463360100 016361 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; use Test::Fatal; { package Foo; use Moo; use MooX::Aliases; use namespace::clean; has attr1 => ( is => 'ro', required => 1, alias => 'attr1_alias', ); } is exception { Foo->new( attr1_alias => 1 ); }, undef, 'aliases work when using namespace::clean'; ok +Foo->can('attr1_alias'), 'aliases still exist when using namespace::clean'; { package Bar; use Moo; use MooX::Aliases; use namespace::clean; BEGIN { has attr1 => ( is => 'ro', required => 1, alias => 'attr1_alias', ); } } is exception { Bar->new( attr1_alias => 1 ); }, undef, 'compile time aliases work in constructor with namespace::clean'; ok +Bar->can('attr1_alias'), 'compile time alias methods still exist with namespace::clean'; done_testing; MooX-Aliases-0.001006/xt/init-args-moose.t000644 000765 000024 00000002676 12227575505 020344 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; { package MyTestBase; use Moo; use MooX::Aliases; has foo => ( is => 'ro', alias => ['bar'], ); has baz => ( is => 'rw', init_arg => undef, alias => ['quux'], ); } { package MyTest; use Moose; extends 'MyTestBase'; has 'other' => (is => 'ro'); } my $test1 = MyTest->new(foo => 'foo', baz => 'baz'); is($test1->foo, 'foo', 'Attribute set with default init_arg'); is($test1->baz, undef, 'Attribute set with default init_arg (undef)'); $test1->baz('baz'); is($test1->baz, 'baz', 'Attribute set with default writer, read with default reader'); is($test1->quux, 'baz', 'Attribute set with default writer, read with aliased reader'); $test1->quux('quux'); is($test1->baz, 'quux', 'Attribute set with aliased writer'); is($test1->quux, 'quux', 'Attribute set with aliased writer'); my $test2 = MyTest->new(bar => 'foo', baz => 'baz'); is($test2->foo, 'foo', 'Attribute set wtih aliased init_arg'); is($test2->baz, undef, 'Attribute set with default init_arg (undef)'); $test2->baz('baz'); is($test2->baz, 'baz', 'Attribute set with default writer, read with default reader'); is($test2->quux, 'baz', 'Attribute set with default writer, read with aliased reader'); $test2->quux('quux'); is($test2->baz, 'quux', 'Attribute set with aliased writer'); is($test2->quux, 'quux', 'Attribute set with aliased writer'); done_testing; MooX-Aliases-0.001006/xt/moose-inherit.t000644 000765 000024 00000001064 12227575505 020077 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; my $called = 0; my $subclass = 0; { package MyTest; use Moo; use MooX::Aliases; sub foo { $called++ } alias bar => 'foo'; package MyTest::Sub; use Moose; extends qw(MyTest); sub foo { $subclass++ }; } ($called, $subclass) = (0, 0); my $t = MyTest->new; $t->foo; $t->bar; is($called, 2, 'alias calls the original method'); my $t2 = MyTest::Sub->new; $t2->foo; $t2->bar; is($subclass, 2, 'subclass method called twice'); is($called, 2, 'original method not called again'); done_testing; MooX-Aliases-0.001006/xt/test-cleannamespaces.t000644 000765 000024 00000000346 12463360120 021401 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; use Test::CleanNamespaces; BEGIN { package Foo; use Moo; use MooX::Aliases; has bar => ( is => 'ro', alias => 'baz', ); use namespace::clean; } namespaces_clean('Foo'); done_testing; MooX-Aliases-0.001006/t/attributes.t000644 000765 000024 00000003521 12463357061 017310 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; use Test::Fatal; my ($foo_called, $baz_called, $override_called); { package MyTest; use Moo; use MooX::Aliases; has foo => ( is => 'rw', alias => 'bar', trigger => sub { $foo_called++ }, ); has baz => ( is => 'rw', alias => [qw/quux quuux/], trigger => sub { $baz_called++ }, ); has wark => ( is => 'rw', ); ::like( ::exception { has [qw(attr1 attr2)] => ( is => 'rw', alias => 'attr3', ); }, qr/^Cannot make alias to list of attributes/, "aliasing a list of attributes fails"); ::is( ::exception { has [qw(attr4 attr5)] => ( is => 'rw', ); }, undef, "creating a list of attributes without aliases works"); ::is( ::exception { has [qw(attr6)] => ( is => 'rw', alias => 'attr7', ); }, undef, "aliasing a list of one attribute works"); ::is( ::exception { has [qw(attr8 attr9)] => ( is => 'rw', alias => [], ); }, undef, "multiple attributes with an empty list of aliases works"); package MyTest::Sub; use Moo; use MooX::Aliases; extends qw(MyTest); has '+foo' => ( alias => 'override', trigger => sub { $override_called++ }, ); } ($foo_called, $baz_called, $override_called) = (0, 0, 0); my $t = MyTest->new; $t->foo(1); $t->bar(1); $t->baz(1); $t->quux(1); $t->quuux(1); $t->wark(1); is($foo_called, 2, 'all aliased methods were called from foo'); is($baz_called, 3, 'all aliased methods were called from baz'); my $t2 = MyTest::Sub->new; $t2->override(1); is($override_called, 1, 'all subclassed aliases were called from override'); done_testing; MooX-Aliases-0.001006/t/basic.t000644 000765 000024 00000001062 12463357061 016201 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; my $called = 0; my $subclass = 0; { package MyTest; use Moo; use MooX::Aliases; sub foo { $called++ } alias bar => 'foo'; package MyTest::Sub; use Moo; extends qw(MyTest); sub foo { $subclass++ }; } ($called, $subclass) = (0, 0); my $t = MyTest->new; $t->foo; $t->bar; is($called, 2, 'alias calls the original method'); my $t2 = MyTest::Sub->new; $t2->foo; $t2->bar; is($subclass, 2, 'subclass method called twice'); is($called, 2, 'original method not called again'); done_testing; MooX-Aliases-0.001006/t/errors.t000644 000765 000024 00000001022 12463357061 016430 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; use Test::Fatal; { package Foo; use Moo; use MooX::Aliases; ::like( ::exception { alias foo => 'bar' }, qr/^Cannot find method bar to alias/, "aliasing a non-existent method gives an appropriate error"); has foo => ( is => 'ro', alias => [qw(bar baz quux)], ) } like( exception { Foo->new(bar => 1, baz => 2) }, qr/^Conflicting init_args: \(bar, baz\)/, "conflicting init_args give an appropriate error"); done_testing; MooX-Aliases-0.001006/t/init_arg-coerce.t000644 000765 000024 00000002661 12463357061 020160 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; { package MyTest; use Moo; use MooX::Aliases; has foo => ( is => 'ro', isa => sub { $_[0] >= 0 }, alias => ['bar'], coerce => sub { abs $_[0] }, ); has baz => ( is => 'rw', isa => sub { $_[0] >= 0 }, init_arg => undef, alias => ['quux'], coerce => sub { abs $_[0] }, ); } my $test1 = MyTest->new(foo => -1, baz => -3); is($test1->foo, 1, 'Attribute set with default init_arg'); is($test1->baz, undef, 'Attribute set with default init_arg (undef)'); $test1->baz(-3); is($test1->baz, 3, 'Attribute set with default writer, read with default reader'); is($test1->quux, 3, 'Attribute set with default writer, read with aliased reader'); $test1->quux(4); is($test1->baz, 4, 'Attribute set with aliased writer'); is($test1->quux, 4, 'Attribute set with aliased writer'); my $test2 = MyTest->new(bar => -1, baz => -3); is($test2->foo, 1, 'Attribute set wtih aliased init_arg'); is($test2->baz, undef, 'Attribute set with default init_arg (undef)'); $test2->baz(-3); is($test2->baz, 3, 'Attribute set with default writer, read with default reader'); is($test2->quux, 3, 'Attribute set with default writer, read with aliased reader'); $test2->quux(-4); is($test2->baz, 4, 'Attribute set with aliased writer'); is($test2->quux, 4, 'Attribute set with aliased writer'); done_testing; MooX-Aliases-0.001006/t/init_arg.t000644 000765 000024 00000003200 12463357061 016710 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; { package MyTest; use Moo; use MooX::Aliases; has foo => ( is => 'ro', alias => ['bar'], ); has baz => ( is => 'rw', init_arg => undef, alias => ['quux'], ); package MyTest::Sub; use Moo; use MooX::Aliases; extends qw(MyTest); has '+foo' => ( is => 'rw', alias => 'override', ); } my $test1 = MyTest->new(foo => 'foo', baz => 'baz'); is($test1->foo, 'foo', 'Attribute set with default init_arg'); is($test1->baz, undef, 'Attribute set with default init_arg (undef)'); $test1->baz('baz'); is($test1->baz, 'baz', 'Attribute set with default writer, read with default reader'); is($test1->quux, 'baz', 'Attribute set with default writer, read with aliased reader'); $test1->quux('quux'); is($test1->baz, 'quux', 'Attribute set with aliased writer'); is($test1->quux, 'quux', 'Attribute set with aliased writer'); my $test2 = MyTest->new(bar => 'foo', baz => 'baz'); is($test2->foo, 'foo', 'Attribute set wtih aliased init_arg'); is($test2->baz, undef, 'Attribute set with default init_arg (undef)'); $test2->baz('baz'); is($test2->baz, 'baz', 'Attribute set with default writer, read with default reader'); is($test2->quux, 'baz', 'Attribute set with default writer, read with aliased reader'); $test2->quux('quux'); is($test2->baz, 'quux', 'Attribute set with aliased writer'); is($test2->quux, 'quux', 'Attribute set with aliased writer'); my $test3 = MyTest::Sub->new(override => 'over'); is($test3->override, 'over', 'Overriden attribute set with aliased writer'); done_testing; MooX-Aliases-0.001006/t/roles-init_arg.t000644 000765 000024 00000002653 12463357061 020045 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; { package MyTestRole; use Moo::Role; use MooX::Aliases; has foo => ( is => 'rw', alias => 'bar', ); has baz => ( is => 'rw', init_arg => undef, alias => [qw/quux quuux/], ); } { package MyTest; use Moo; with 'MyTestRole'; } my $test1 = MyTest->new(foo => 'foo', baz => 'baz'); is($test1->foo, 'foo', 'Attribute set with default init_arg'); is($test1->baz, undef, 'Attribute set with default init_arg (undef)'); $test1->baz('baz'); is($test1->baz, 'baz', 'Attribute set with default writer, read with default reader'); is($test1->quux, 'baz', 'Attribute set with default writer, read with aliased reader'); $test1->quux('quux'); is($test1->baz, 'quux', 'Attribute set with aliased writer'); is($test1->quux, 'quux', 'Attribute set with aliased writer'); my $test2 = MyTest->new(bar => 'foo', baz => 'baz'); is($test2->foo, 'foo', 'Attribute set wtih aliased init_arg'); is($test2->baz, undef, 'Attribute set with default init_arg (undef)'); $test2->baz('baz'); is($test2->baz, 'baz', 'Attribute set with default writer, read with default reader'); is($test2->quux, 'baz', 'Attribute set with default writer, read with aliased reader'); $test2->quux('quux'); is($test2->baz, 'quux', 'Attribute set with aliased writer'); is($test2->quux, 'quux', 'Attribute set with aliased writer'); done_testing; MooX-Aliases-0.001006/t/roles.t000644 000765 000024 00000001556 12463357061 016254 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; my ($foo_called, $baz_called, $run_called); { package MyTestRole; use Moo::Role; use MooX::Aliases; has foo => ( is => 'rw', alias => 'bar', trigger => sub { $foo_called++ }, ); has baz => ( is => 'rw', alias => [qw/quux quuux/], trigger => sub { $baz_called++ }, ); sub run { $run_called++ } alias walk => 'run'; } { package MyTest; use Moo; with 'MyTestRole'; } ($foo_called, $baz_called, $run_called) = (0, 0, 0); my $t = MyTest->new; $t->foo(1); $t->bar(1); $t->baz(1); $t->quux(1); $t->quuux(1); is($foo_called, 2, 'all aliased methods were called from foo'); is($baz_called, 3, 'all aliased methods were called from baz'); $t->run; $t->walk; is($run_called, 2, 'all aliased methods were called from run'); done_testing; MooX-Aliases-0.001006/t/traits.t000644 000765 000024 00000001550 12463357061 016430 0ustar00gknopstaff000000 000000 use strictures 1; use Test::More; my ($foo_called, $baz_called, $run_called); { package MyTest; use Moo; use MooX::Aliases; has foo => ( is => 'rw', traits => ['Aliased'], alias => 'bar', trigger => sub { $foo_called++ }, ); has baz => ( is => 'rw', traits => ['Aliased'], alias => [qw/quux quuux/], trigger => sub { $baz_called++ }, ); sub run { $run_called++ } alias walk => 'run'; } ($foo_called, $baz_called, $run_called) = (0, 0, 0); my $t = MyTest->new; $t->foo(1); $t->bar(1); $t->baz(1); $t->quux(1); $t->quuux(1); $t->run; $t->walk; is($foo_called, 2, 'all aliased methods were called from foo'); is($baz_called, 3, 'all aliased methods were called from baz'); is($run_called, 2, 'all aliased methods were called from run'); done_testing; MooX-Aliases-0.001006/maint/Makefile.PL.include000644 000765 000024 00000000273 12227575505 021202 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; author 'haarg - Graham Knop (cpan:HAARG) '; MooX-Aliases-0.001006/lib/MooX/000755 000765 000024 00000000000 12463361402 016113 5ustar00gknopstaff000000 000000 MooX-Aliases-0.001006/lib/MooX/Aliases.pm000644 000765 000024 00000007672 12463361307 020052 0ustar00gknopstaff000000 000000 package MooX::Aliases; use strictures 1; our $VERSION = '0.001006'; $VERSION = eval $VERSION; use Carp; use Class::Method::Modifiers qw(install_modifier); sub import { my ($class) = @_; my $target = caller; my $around = do { no strict 'refs'; \&{"${target}::around"} } or croak "$target is not a Moo class or role"; my $make_alias = sub { my ($from, $to) = @_; if (!$target->can($to)) { croak "Cannot find method $to to alias"; } eval qq{ sub ${target}::${from} { goto &{\$_[0]->can("$to")}; }; 1; } or die "$@"; }; { no strict 'refs'; *{"${target}::alias"} = $make_alias; } my $installed_buildargs; my %init_args; install_modifier $target, 'around', 'has', sub { my $orig = shift; my ($attr, %opts) = @_; my $aliases = delete $opts{alias}; $aliases = [ $aliases ] if $aliases && !ref $aliases; return $orig->($attr, %opts) unless $aliases && @$aliases; my $attr_name = !ref $attr ? $attr : @{$attr} == 1 ? $attr->[0] : croak "Cannot make alias to list of attributes"; $attr_name =~ s/^\+//; my $name = defined $opts{init_arg} ? $opts{init_arg} : $attr_name; my @names = @$aliases; if (!exists $opts{init_arg} || defined $opts{init_arg}) { unshift @names, $name; } $init_args{$name} = \@names; my $out = $orig->($attr, %opts); for my $alias (@$aliases) { $make_alias->($alias => $attr_name); } if (!$installed_buildargs) { $installed_buildargs = 1; $around->('BUILDARGS', sub { my $orig = shift; my $self = shift; my $args = $self->$orig(@_); for my $attr (keys %init_args) { my @init = grep { exists $args->{$_} } (@{$init_args{$attr}}); if (@init > 1) { croak "Conflicting init_args: (" . join(', ', @init) . ")"; } elsif (@init == 1) { $args->{$attr} = delete $args->{$init[0]}; } } return $args; }); } return $out; }; } 1; __END__ =head1 NAME MooX::Aliases - easy aliasing of methods and attributes in Moo =head1 SYNOPSIS package MyClass; use Moo; use MooX::Aliases; has this => ( is => 'rw', alias => 'that', ); sub foo { my $self = shift; print $self->that } alias bar => 'foo'; my $o = MyApp->new(); $o->this('Hello World'); $o->bar; # prints 'Hello World' or package MyRole; use Moo::Role; use MooX::Aliases; has this => ( is => 'rw', alias => 'that', ); sub foo { my $self = shift; print $self->that } alias bar => 'foo'; =head1 DESCRIPTION The MooX::Aliases module will allow you to quickly alias methods in Moo. It provides an alias parameter for has() to generate aliased accessors as well as the standard ones. Attributes can also be initialized in the constructor via their aliased names. You can create more than one alias at once by passing a listref: has ip_addr => ( alias => [ qw(ipAddr ip) ], ); =head1 FUNCTIONS =over 4 =item alias $alias, $method Creates $alias as a method that is aliased to $method. =back =head1 CAVEATS This module uses the C to map the attributes. If a class uses a custom C, this module may not behave properly. =head1 SEE ALSO =over 4 =item L =back =head1 AUTHOR haarg - Graham Knop (cpan:HAARG) =head2 CONTRIBUTORS =over 8 =item * Chris Prather =item * Jesse Luehrs =item * Justin Hunter =item * Karen Etheridge =item * Yuval Kogman =item * Daniel Gempesaw =item * Denis Ibaev =back =head1 COPYRIGHT Copyright (c) 2013 the MooX::Alises L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. =cut