From: Dave Rolsky <autarch@urth.org>
Date: Thu, 1 Oct 2009 19:06:30 +0000 (-0500)
Subject: Deprecate get_attribute_map
X-Git-Tag: 0.95~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b1aaf0dc7312de31c7274c66681eca2d02c4d22b;p=gitmo%2FClass-MOP.git

Deprecate get_attribute_map
---

diff --git a/Changes b/Changes
index 4bafd93..e05db34 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,10 @@ Revision history for Perl extension Class-MOP.
         which are false (like "0"), but the name must be defined and not be an
         emptry string.
 
+    * Class::MOP::Class
+      - Deprecated get_attribute_map as a public method. You can use a
+        combination of get_attribute_list and get_attribute instead. (Dave
+        Rolsky)
 
 0.94 Tue, Sep 22, 2009
     * Class::MOP::Attribute
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 7f3514e..5a9d043 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -282,7 +282,7 @@ Class::MOP::Class->meta->add_attribute(
             #
             # we just alias the original method
             # rather than re-produce it here
-            'get_attribute_map' => \&Class::MOP::Class::get_attribute_map
+            '_attribute_map' => \&Class::MOP::Class::_attribute_map
         },
         default  => sub { {} }
     ))
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index b953e36..9e969ee 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -329,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'}             }
@@ -729,11 +729,11 @@ 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
     try {
@@ -813,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);
@@ -831,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();
@@ -842,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;
 }
 
@@ -1446,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
diff --git a/lib/Class/MOP/Deprecated.pm b/lib/Class/MOP/Deprecated.pm
index b69c6a4..551bb16 100644
--- a/lib/Class/MOP/Deprecated.pm
+++ b/lib/Class/MOP/Deprecated.pm
@@ -26,6 +26,7 @@ my %DeprecatedAt = (
     'Class::MOP::Class::alias_method'                      => 0.93,
     'Class::MOP::Class::compute_all_applicable_methods'    => 0.93,
     'Class::MOP::Class::compute_all_applicable_attributes' => 0.93,
+    'Class::MOP::Class::get_attribute_map' => 0.95,
 
     'Class::MOP::Instance::bless_instance_structure' => 0.93,
 
@@ -205,6 +206,13 @@ sub compute_all_applicable_attributes {
     shift->get_all_attributes(@_);
 }
 
+sub get_attribute_map {
+    Class::MOP::Deprecated::warn(
+        "The get_attribute_map method has been deprecated.\n");
+
+    shift->_attribute_map(@_);
+}
+
 package
     Class::MOP::Instance;
 
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 5d891d5..fd3888f 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 304;
+use Test::More tests => 306;
 use Test::Exception;
 
 use Class::MOP;
@@ -90,7 +90,9 @@ my @class_mop_class_methods = qw(
         add_before_method_modifier add_after_method_modifier add_around_method_modifier
 
     has_attribute get_attribute add_attribute remove_attribute
-    get_attribute_list get_attribute_map get_all_attributes compute_all_applicable_attributes find_attribute_by_name
+    get_attribute_list _attribute_map get_all_attributes compute_all_applicable_attributes find_attribute_by_name
+
+    get_attribute_map
 
     is_mutable is_immutable make_mutable make_immutable
     _initialize_immutable _install_inlined_code _inlined_methods
@@ -194,7 +196,7 @@ is_deeply(
 );
 
 is_deeply(
-    [ sort keys %{$class_mop_class_meta->get_attribute_map} ],
+    [ sort keys %{$class_mop_class_meta->_attribute_map} ],
     [ sort @class_mop_class_attributes ],
     '... got the right list of attributes');
 
@@ -211,7 +213,7 @@ is_deeply(
     '... got the right list of attributes');
 
 is_deeply(
-    [ sort keys %{$class_mop_package_meta->get_attribute_map} ],
+    [ sort keys %{$class_mop_package_meta->_attribute_map} ],
     [ sort @class_mop_package_attributes ],
     '... got the right list of attributes');
 
@@ -228,7 +230,7 @@ is_deeply(
     '... got the right list of attributes');
 
 is_deeply(
-    [ sort keys %{$class_mop_module_meta->get_attribute_map} ],
+    [ sort keys %{$class_mop_module_meta->_attribute_map} ],
     [ sort @class_mop_module_attributes ],
     '... got the right list of attributes');
 
@@ -282,8 +284,8 @@ is($class_mop_package_meta->get_attribute('method_metaclass')->default,
 
 ok($class_mop_class_meta->get_attribute('attributes')->has_reader, '... Class::MOP::Class attributes has a reader');
 is_deeply($class_mop_class_meta->get_attribute('attributes')->reader,
-   { 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map },
-   '... Class::MOP::Class attributes\'s a reader is &get_attribute_map');
+   { '_attribute_map' => \&Class::MOP::Class::_attribute_map },
+   '... Class::MOP::Class attributes\'s a reader is &_attribute_map');
 
 ok($class_mop_class_meta->get_attribute('attributes')->has_init_arg, '... Class::MOP::Class attributes has a init_arg');
 is($class_mop_class_meta->get_attribute('attributes')->init_arg,
diff --git a/t/500_deprecated.t b/t/500_deprecated.t
index b97ddc9..3f1337d 100755
--- a/t/500_deprecated.t
+++ b/t/500_deprecated.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 7;
 use Test::Exception;
 
 use Carp;
@@ -48,6 +48,16 @@ $SIG{__WARN__} = \&croak;
 }
 
 {
+    package Foo2;
+
+    use metaclass;
+
+    ::throws_ok{ Foo2->meta->get_attribute_map }
+        qr/\Qget_attribute_map method has been deprecated/,
+        'get_attribute_map is deprecated';
+}
+
+{
     package Quux;
 
     use Class::MOP::Deprecated -compatible => 0.92;
diff --git a/xt/author/pod_coverage.t b/xt/author/pod_coverage.t
index 490de83..bf1daf1 100644
--- a/xt/author/pod_coverage.t
+++ b/xt/author/pod_coverage.t
@@ -43,6 +43,9 @@ my %trustme = (
 
         # doc'd with rebless_instance
         'rebless_instance_away',
+
+        # deprecated
+        'get_attribute_map',
     ],
     'Class::MOP::Class::Immutable::Trait'             => ['.+'],
     'Class::MOP::Class::Immutable::Class::MOP::Class' => ['.+'],