Checking in changes prior to tagging of version 0.96. Changelog diff is:
[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm
index 52228dc..fa65765 100644 (file)
@@ -13,8 +13,9 @@ use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use Devel::GlobalDestruction 'in_global_destruction';
+use Try::Tiny;
 
-our $VERSION   = '0.94';
+our $VERSION   = '0.96';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -328,7 +329,7 @@ sub create {
 # all these attribute readers will be bootstrapped
 # away in the Class::MOP bootstrap section
 
-sub get_attribute_map        { $_[0]->{'attributes'}                  }
+sub _attribute_map           { $_[0]->{'attributes'}                  }
 sub attribute_metaclass      { $_[0]->{'attribute_metaclass'}         }
 sub instance_metaclass       { $_[0]->{'instance_metaclass'}          }
 sub immutable_trait          { $_[0]->{'immutable_trait'}             }
@@ -595,7 +596,7 @@ sub class_precedence_list {
 
     sub add_before_method_modifier {
         my ($self, $method_name, $method_modifier) = @_;
-        (defined $method_name && $method_name)
+        (defined $method_name && length $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
         $method->add_before_modifier(
@@ -605,7 +606,7 @@ sub class_precedence_list {
 
     sub add_after_method_modifier {
         my ($self, $method_name, $method_modifier) = @_;
-        (defined $method_name && $method_name)
+        (defined $method_name && length $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
         $method->add_after_modifier(
@@ -615,7 +616,7 @@ sub class_precedence_list {
 
     sub add_around_method_modifier {
         my ($self, $method_name, $method_modifier) = @_;
-        (defined $method_name && $method_name)
+        (defined $method_name && length $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
         $method->add_around_modifier(
@@ -639,7 +640,7 @@ sub class_precedence_list {
 
 sub find_method_by_name {
     my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
+    (defined $method_name && length $method_name)
         || confess "You must define a method name to find";
     foreach my $class ($self->linearized_isa) {
         my $method = $self->initialize($class)->get_method($method_name);
@@ -670,7 +671,7 @@ sub get_all_method_names {
 
 sub find_all_methods_by_name {
     my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
+    (defined $method_name && length $method_name)
         || confess "You must define a method name to find";
     my @methods;
     foreach my $class ($self->linearized_isa) {
@@ -687,7 +688,7 @@ sub find_all_methods_by_name {
 
 sub find_next_method_by_name {
     my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
+    (defined $method_name && length $method_name)
         || confess "You must define a method name to find";
     my @cpl = $self->linearized_isa;
     shift @cpl; # discard ourselves
@@ -728,23 +729,21 @@ sub add_attribute {
     
     # get our count of previously inserted attributes and
     # increment by one so this attribute knows its order
-    my $order = (scalar keys %{$self->get_attribute_map});
+    my $order = (scalar keys %{$self->_attribute_map});
     $attribute->_set_insertion_order($order);
 
     # then onto installing the new accessors
-    $self->get_attribute_map->{$attr_name} = $attribute;
+    $self->_attribute_map->{$attr_name} = $attribute;
 
     # invalidate package flag here
-    my $e = do {
-        local $@;
+    try {
         local $SIG{__DIE__};
-        eval { $attribute->install_accessors() };
-        $@;
-    };
-    if ( $e ) {
-        $self->remove_attribute($attr_name);
-        die $e;
+        $attribute->install_accessors();
     }
+    catch {
+        $self->remove_attribute($attr_name);
+        die $_;
+    };
 
     return $attribute;
 }
@@ -814,14 +813,14 @@ sub has_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name)
         || confess "You must define an attribute name";
-    exists $self->get_attribute_map->{$attribute_name};
+    exists $self->_attribute_map->{$attribute_name};
 }
 
 sub get_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name)
         || confess "You must define an attribute name";
-    return $self->get_attribute_map->{$attribute_name}
+    return $self->_attribute_map->{$attribute_name}
     # NOTE:
     # this will return undef anyway, so no need ...
     #    if $self->has_attribute($attribute_name);
@@ -832,9 +831,9 @@ sub remove_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name)
         || confess "You must define an attribute name";
-    my $removed_attribute = $self->get_attribute_map->{$attribute_name};
+    my $removed_attribute = $self->_attribute_map->{$attribute_name};
     return unless defined $removed_attribute;
-    delete $self->get_attribute_map->{$attribute_name};
+    delete $self->_attribute_map->{$attribute_name};
     $self->invalidate_meta_instances();
     $removed_attribute->remove_accessors();
     $removed_attribute->detach_from_class();
@@ -843,12 +842,12 @@ sub remove_attribute {
 
 sub get_attribute_list {
     my $self = shift;
-    keys %{$self->get_attribute_map};
+    keys %{$self->_attribute_map};
 }
 
 sub get_all_attributes {
     my $self = shift;
-    my %attrs = map { %{ $self->initialize($_)->get_attribute_map } } reverse $self->linearized_isa;
+    my %attrs = map { %{ $self->initialize($_)->_attribute_map } } reverse $self->linearized_isa;
     return values %attrs;
 }
 
@@ -1447,12 +1446,6 @@ Returns a boolean indicating whether or not the class defines the
 named attribute. It does not include attributes inherited from parent
 classes.
 
-=item B<< $metaclass->get_attribute_map >>
-
-Returns a hash reference representing the attributes defined in this
-class. The keys are attribute names and the values are
-L<Class::MOP::Attribute> objects.
-
 =item B<< $metaclass->get_attribute_list >>
 
 This will return a list of attributes I<names> for all attributes