From: Matt S Trout Date: Fri, 6 Apr 2012 20:54:26 +0000 (+0000) Subject: complete attributeshortcuts support X-Git-Tag: v0.009_015~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2bb6aaa3ef3d4a9ec015b5198411014ee731419d;p=gitmo%2FMoo.git complete attributeshortcuts support --- diff --git a/Changes b/Changes index ff86051..0269814 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,4 @@ + - Complete support for MooseX::AttributeShortcuts 0.009 - Allow Moo classes to compose Moose roles - Introduce Moo::HandleMoose, which should allow Moo classes and roles to be treated as Moose classes/roles. Supported so far: diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm index ce84f62..ea5a4ed 100644 --- a/lib/Method/Generate/Accessor.pm +++ b/lib/Method/Generate/Accessor.pm @@ -23,13 +23,25 @@ sub generate_method { } elsif ($is eq 'rw') { $spec->{accessor} = $name unless exists $spec->{accessor}; } elsif ($is eq 'lazy') { - $spec->{init_arg} = undef unless exists $spec->{init_arg}; $spec->{reader} = $name unless exists $spec->{reader}; $spec->{lazy} = 1; $spec->{builder} ||= '_build_'.$name unless $spec->{default}; + } elsif ($is eq 'rwp') { + $spec->{reader} = $name unless exists $spec->{reader}; + $spec->{writer} = "_set_${name}" unless exists $spec->{writer}; } elsif ($is ne 'bare') { die "Unknown is ${is}"; } + $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1; + if (($spec->{predicate}||0) eq 1) { + $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}"; + } + if (($spec->{clearer}||0) eq 1) { + $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}"; + } + if (($spec->{trigger}||0) eq 1) { + $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)'); + } my %methods; if (my $reader = $spec->{reader}) { if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) { diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm index 5c7cd4b..ed2e885 100644 --- a/lib/Moo/HandleMoose.pm +++ b/lib/Moo/HandleMoose.pm @@ -45,7 +45,7 @@ sub inject_real_metaclass_for { local @{_getstash($name)}{keys %methods}; foreach my $name (keys %$attr_specs) { my %spec = %{$attr_specs->{$name}}; - $spec{is} = 'ro' if $spec{is} eq 'lazy'; + $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp'; if (my $isa = $spec{isa}) { $spec{isa} = do { if (my $mapped = $TYPE_MAP{$isa}) { diff --git a/t/accessor-shortcuts.t b/t/accessor-shortcuts.t index ef6e7fc..fa4a752 100644 --- a/t/accessor-shortcuts.t +++ b/t/accessor-shortcuts.t @@ -30,20 +30,14 @@ my $foo = Foo->new; { is $foo->{lazy}, undef, "lazy value storage is undefined"; is $foo->lazy, $test, "lazy value returns test value when called"; - like exception { $foo->lazy($test) }, qr/Usage: Foo::lazy\(self\)/, "lazy is read_only"; - - my $foo_with_args = Foo->new(lazy => $test); - is $foo_with_args->{lazy}, undef, "lazy ignores constructor value"; + ok exception { $foo->lazy($test) }, "lazy is read_only"; } # lazy + default { is $foo->{lazy_default}, undef, "lazy_default value storage is undefined"; is $foo->lazy_default, $lazy_default, "lazy_default value returns test value when called"; - like exception { $foo->lazy_default($test) }, qr/Usage: Foo::lazy\(self\)/, "lazy_default is read_only"; - - my $foo_with_args = Foo->new(lazy_default => $test); - is $foo_with_args->{lazy_default}, undef, "lazy_default ignores constructor value"; + ok exception { $foo->lazy_default($test) }, "lazy_default is read_only"; } done_testing; diff --git a/t/accessor-trigger.t b/t/accessor-trigger.t index aaef959..762b290 100644 --- a/t/accessor-trigger.t +++ b/t/accessor-trigger.t @@ -100,7 +100,7 @@ run_for 'LazyDefault'; has one => (is => 'rw', trigger => 1 ); - sub _one_trigger { push @::tr, $_[1] } + sub _trigger_one { push @::tr, $_[1] } } run_for 'Shaz';