Version 0.40_01

[gitmo/Mouse.git] / lib / Mouse / Meta / Attribute.pm

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 1b2fb03..c5482aa 100644 (file)
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -156,48 +156,8 @@ sub new {
     return $self;
 }
 
-# readers
-
-sub name                 { $_[0]->{name}                   }
-sub associated_class     { $_[0]->{associated_class}       }
-
-sub accessor             { $_[0]->{accessor}               }
-sub reader               { $_[0]->{reader}                 }
-sub writer               { $_[0]->{writer}                 }
-sub predicate            { $_[0]->{predicate}              }
-sub clearer              { $_[0]->{clearer}                }
-sub handles              { $_[0]->{handles}                }
-
-sub _is_metadata         { $_[0]->{is}                     }
-sub is_required          { $_[0]->{required}               }
-sub default              { $_[0]->{default}                }
-sub is_lazy              { $_[0]->{lazy}                   }
-sub is_lazy_build        { $_[0]->{lazy_build}             }
-sub is_weak_ref          { $_[0]->{weak_ref}               }
-sub init_arg             { $_[0]->{init_arg}               }
-sub type_constraint      { $_[0]->{type_constraint}        }
-
-sub trigger              { $_[0]->{trigger}                }
-sub builder              { $_[0]->{builder}                }
-sub should_auto_deref    { $_[0]->{auto_deref}             }
-sub should_coerce        { $_[0]->{coerce}                 }
-
-# predicates
-
-sub has_accessor         { exists $_[0]->{accessor}        }
-sub has_reader           { exists $_[0]->{reader}          }
-sub has_writer           { exists $_[0]->{writer}          }
-sub has_predicate        { exists $_[0]->{predicate}       }
-sub has_clearer          { exists $_[0]->{clearer}         }
-sub has_handles          { exists $_[0]->{handles}         }
-
-sub has_default          { exists $_[0]->{default}         }
-sub has_type_constraint  { exists $_[0]->{type_constraint} }
-sub has_trigger          { exists $_[0]->{trigger}         }
-sub has_builder          { exists $_[0]->{builder}         }
-
-sub has_read_method      { exists $_[0]->{reader} || exists $_[0]->{accessor} }
-sub has_write_method     { exists $_[0]->{writer} || exists $_[0]->{accessor} }
+sub has_read_method      { $_[0]->has_reader || $_[0]->has_accessor }
+sub has_write_method     { $_[0]->has_writer || $_[0]->has_accessor }
 
 sub _create_args { # DEPRECATED
     $_[0]->{_create_args} = $_[1] if @_ > 1;
@@ -248,7 +208,7 @@ sub canonicalize_args{ # DEPRECATED
     return %args;
 }
 
-sub create {
+sub create { # DEPRECATED
     my ($self, $class, $name, %args) = @_;
 
     Carp::cluck("$self->create has been deprecated."
@@ -263,15 +223,12 @@ sub _coerce_and_verify {
     my($self, $value, $instance) = @_;
 
     my $type_constraint = $self->{type_constraint};
-
-    return $value if !$type_constraint;
+    return $value if !defined $type_constraint;
 
     if ($self->should_coerce && $type_constraint->has_coercion) {
         $value = $type_constraint->coerce($value);
     }
 
-    return $value if $type_constraint->check($value);
-
     $self->verify_against_type_constraint($value);
 
     return $value;
@@ -281,7 +238,7 @@ sub verify_against_type_constraint {
     my ($self, $value) = @_;
 
     my $type_constraint = $self->{type_constraint};
-    return 1 if !$type_constraint;;
+    return 1 if !$type_constraint;
     return 1 if $type_constraint->check($value);
 
     $self->verify_type_constraint_error($self->name, $value, $type_constraint);
@@ -289,7 +246,8 @@ sub verify_against_type_constraint {
 
 sub verify_type_constraint_error {
     my($self, $name, $value, $type) = @_;
-    $self->throw_error("Attribute ($name) does not pass the type constraint because: " . $type->get_message($value));
+    $self->throw_error("Attribute ($name) does not pass the type constraint because: "
+        . $type->get_message($value));
 }
 
 sub coerce_constraint { # DEPRECATED
@@ -339,10 +297,10 @@ sub get_parent_args { # DEPRECATED
 
 
 sub get_read_method {
-    $_[0]->{reader} || $_[0]->{accessor}
+    $_[0]->reader || $_[0]->accessor
 }
 sub get_write_method {
-    $_[0]->{writer} || $_[0]->{accessor}
+    $_[0]->writer || $_[0]->accessor
 }
 
 sub get_read_method_ref{
@@ -402,19 +360,16 @@ sub _canonicalize_handles {
     }
 }
 
-
 sub associate_method{
     my ($attribute, $method) = @_;
     $attribute->{associated_methods}++;
     return;
 }
 
-sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' }
-
 sub install_accessors{
     my($attribute) = @_;
 
-    my $metaclass      = $attribute->{associated_class};
+    my $metaclass      = $attribute->associated_class;
     my $accessor_class = $attribute->accessor_metaclass;
 
     foreach my $type(qw(accessor reader writer predicate clearer)){
@@ -464,6 +419,10 @@ __END__
 
 Mouse::Meta::Attribute - The Mouse attribute metaclass
 
+=head1 VERSION
+
+This document describes Mouse version 0.40_01
+
 =head1 METHODS
 
 =head2 C<< new(%options) -> Mouse::Meta::Attribute >>