complete attributeshortcuts support
Matt S Trout [Fri, 6 Apr 2012 20:54:26 +0000 (20:54 +0000)]
Changes
lib/Method/Generate/Accessor.pm
lib/Moo/HandleMoose.pm
t/accessor-shortcuts.t
t/accessor-trigger.t

diff --git a/Changes b/Changes
index ff86051..0269814 100644 (file)
--- 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:
index ce84f62..ea5a4ed 100644 (file)
@@ -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)) {
index 5c7cd4b..ed2e885 100644 (file)
@@ -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}) {
index ef6e7fc..fa4a752 100644 (file)
@@ -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;
index aaef959..762b290 100644 (file)
@@ -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';