X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FAttribute.pm;h=7d3c3805ad4fdab790e06ea0eb849b76e57a2fed;hb=f3c1ccc818bb5c50c50e17b9141b91c09b077b04;hp=2076297b39606e487838d7a5bf2f2aeec5ebddb7;hpb=af745d5a30ceb45518de556943e95dfdc03f451a;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm
index 2076297..7d3c380 100644
--- a/lib/Mouse/Attribute.pm
+++ b/lib/Mouse/Attribute.pm
@@ -26,7 +26,7 @@ sub is_lazy         { $_[0]->{lazy}            }
 sub predicate       { $_[0]->{predicate}       }
 sub clearer         { $_[0]->{clearer}         }
 sub handles         { $_[0]->{handles}         }
-sub weak_ref        { $_[0]->{weak_ref}        }
+sub is_weak_ref     { $_[0]->{weak_ref}        }
 sub init_arg        { $_[0]->{init_arg}        }
 sub type_constraint { $_[0]->{type_constraint} }
 sub trigger         { $_[0]->{trigger}         }
@@ -44,11 +44,12 @@ sub generate_accessor {
     my $attribute = shift;
 
     my $name       = $attribute->name;
-    my $key        = $attribute->init_arg;
+    my $key        = $name;
     my $default    = $attribute->default;
     my $trigger    = $attribute->trigger;
     my $type       = $attribute->type_constraint;
     my $constraint = $attribute->find_type_constraint;
+    my $builder    = $attribute->builder;
 
     my $accessor = 'sub {
         my $self = shift;';
@@ -66,8 +67,8 @@ sub generate_accessor {
 
         $accessor .= '$self->{$key} = $_;';
 
-        if ($attribute->weak_ref) {
-            $accessor .= 'Scalar::Util::weaken($self->{$key});';
+        if ($attribute->is_weak_ref) {
+            $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($self->{$key});';
         }
 
         if ($trigger) {
@@ -77,13 +78,18 @@ sub generate_accessor {
         $accessor .= '}';
     }
     else {
+        $accessor .= 'confess "Cannot assign a value to a read-only accessor" if @_;';
     }
 
     if ($attribute->is_lazy) {
         $accessor .= '$self->{$key} = ';
-        $accessor .= ref($default) eq 'CODE'
-                   ? '$default->($self)'
-                   : '$default';
+
+        $accessor .= $attribute->has_builder
+                   ? '$self->$builder'
+                     : ref($default) eq 'CODE'
+                     ? '$default->($self)'
+                     : '$default';
+
         $accessor .= ' if !exists($self->{$key});';
     }
 
@@ -95,7 +101,7 @@ sub generate_accessor {
 
 sub generate_predicate {
     my $attribute = shift;
-    my $key = $attribute->init_arg;
+    my $key = $attribute->name;
 
     my $predicate = 'sub { exists($_[0]->{$key}) }';
 
@@ -104,7 +110,7 @@ sub generate_predicate {
 
 sub generate_clearer {
     my $attribute = shift;
-    my $key = $attribute->init_arg;
+    my $key = $attribute->name;
 
     my $predicate = 'sub { delete($_[0]->{$key}) }';
 
@@ -114,11 +120,12 @@ sub generate_clearer {
 sub generate_handles {
     my $attribute = shift;
     my $reader = $attribute->name;
+    my %handles = $attribute->_canonicalize_handles($attribute->handles);
 
     my %method_map;
 
-    for my $local_method (keys %{ $attribute->handles }) {
-        my $remote_method = $attribute->handles->{$local_method};
+    for my $local_method (keys %handles) {
+        my $remote_method = $handles{$local_method};
 
         my $method = 'sub {
             my $self = shift;
@@ -134,20 +141,15 @@ sub generate_handles {
 sub create {
     my ($self, $class, $name, %args) = @_;
 
-    confess "You must specify a default for lazy attribute '$name'"
-        if $args{lazy} && !exists($args{default});
-
-    confess "Trigger is not allowed on read-only attribute '$name'"
-        if $args{trigger} && $args{is} ne 'rw';
+    confess "You cannot have lazy attribute ($name) without specifying a default value for it"
+        if $args{lazy} && !exists($args{default}) && !exists($args{builder});
 
     confess "References are not allowed as default values, you must wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])"
         if ref($args{default})
         && ref($args{default}) ne 'CODE';
 
-    $args{handles} = { $self->_canonicalize_handles($args{handles}) }
-        if $args{handles};
-
-    $args{type_constraint} = delete $args{isa};
+    $args{type_constraint} = delete $args{isa}
+        if exists $args{isa};
 
     my $attribute = $self->new(%args, name => $name, class => $class);
     my $meta = $class->meta;
@@ -267,7 +269,7 @@ installed. Some error checking is done.
 
 =head2 has_handles -> Bool
 
-=head2 weak_ref -> Bool
+=head2 is_weak_ref -> Bool
 
 =head2 init_arg -> Str
 
@@ -301,5 +303,15 @@ Creates a new code reference for the attribute's clearer.
 
 Creates a new code reference for each of the attribute's handles methods.
 
+=head2 find_type_constraint -> CODE
+
+Returns a code reference which can be used to check that a given value passes
+this attribute's type constraint;
+
+=head2 verify_type_constraint Item -> 1 | ERROR
+
+Checks that the given value passes this attribute's type constraint. Returns 1
+on success, otherwise C<confess>es.
+
 =cut