From: Dave Rolsky <autarch@urth.org>
Date: Mon, 14 Sep 2009 18:26:41 +0000 (-0500)
Subject: Actually implemented public get_method_map for back-compat, and made sure all its... 
X-Git-Tag: 0.93~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b409c96967194909d2071df0e129453d1b7f74d7;p=gitmo%2FClass-MOP.git

Actually implemented public get_method_map for back-compat, and made sure all its values are still method objects.

Tweaked docs in CMOP::Deprecated.
---

diff --git a/Changes b/Changes
index fd3a83d..507c3e1 100644
--- a/Changes
+++ b/Changes
@@ -20,9 +20,7 @@ Next
         failed to update the method map properly. RT #48985. Reported by Paul
         Mooney. (Dave Rolsky)
       - The get_method_map method is now private. The public version is
-        available as a deprecated method, but the values of the hash reference
-        may now be either Class::MOP::Method objects _or_ raw sub
-        references. (Dave Rolsky)
+        available as a deprecated method. (Dave Rolsky)
 
 0.92_01 Thu, Sep 10, 2009
     * Class::MOP::Package
diff --git a/lib/Class/MOP/Deprecated.pm b/lib/Class/MOP/Deprecated.pm
index b36d687..a4659dd 100644
--- a/lib/Class/MOP/Deprecated.pm
+++ b/lib/Class/MOP/Deprecated.pm
@@ -2,7 +2,9 @@ package Class::MOP::Deprecated;
 
 use strict;
 use warnings;
-use Carp qw(cluck);
+
+use Carp qw( cluck );
+use Scalar::Util qw( blessed );
 
 our $VERSION = '0.92_01';
 $VERSION = eval $VERSION;
@@ -113,6 +115,21 @@ sub in_global_destruction {
 package
     Class::MOP::Package;
 
+sub get_method_map {
+    Class::MOP::Deprecated::warn(
+              'The get_method_map method has been made private.'
+            . " The public version is deprecated and will be removed in a future release.\n"
+    );
+    my $self = shift;
+
+    my $map = $self->_full_method_map;
+
+    $map->{$_} = $self->get_method($_)
+        for grep { !blessed( $map->{$_} ) } keys %{$map};
+
+    return $map;
+}
+
 package
     Class::MOP::Module;
 
@@ -362,20 +379,12 @@ Class::MOP::Deprecated - List of deprecated methods
 
 =head1 FUNCTIONS
 
-This class provides methods that have been deprecated but remain for backward compatibility.
-
-If you specify C<< -compatible => $version >>, you can use deprecated features without warnings.
-Note that this special treatment is package-scoped.
-
-=over 4
-
-=item B<Class::MOP::Deprecated::warn($message)>
-
-Checks compatibility for the caller feature, and produces warnings if needed.
-
-This function is used in internals.
+This class provides methods that have been deprecated but remain for backward
+compatibility.
 
-=back
+If you specify C<< -compatible => $version >>, you can use deprecated features
+without warnings. Note that this special treatment is limited to the package
+that loads C<Class::MOP::Deprecated>.
 
 =head1 AUTHORS
 
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 2ebdbf7..5d891d5 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 => 302;
+use Test::More tests => 304;
 use Test::Exception;
 
 use Class::MOP;
@@ -42,6 +42,8 @@ my @class_mop_package_methods = qw(
     get_method_list _full_method_map
 
     _deconstruct_variable_name
+
+    get_method_map
 );
 
 my @class_mop_module_methods = qw(
diff --git a/t/500_deprecated.t b/t/500_deprecated.t
index 165219e..2914ecc 100755
--- a/t/500_deprecated.t
+++ b/t/500_deprecated.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4;
+use Test::More tests => 6;
 use Test::Exception;
 
 use Carp;
@@ -53,3 +53,24 @@ $SIG{__WARN__} = \&croak;
     } 'safe in an inner class';
 }
 
+{
+    package Quux;
+
+    use Class::MOP::Deprecated -compatible => 0.92;
+    use Scalar::Util qw( blessed );
+
+    use metaclass;
+
+    sub foo {42}
+
+    Quux->meta->add_method( bar => sub {84} );
+
+    my $map = Quux->meta->get_method_map;
+    my @method_objects = grep { blessed($_) } values %{$map};
+
+    ::is( scalar @method_objects, 3,
+          'get_method_map still returns all values as method object' );
+    ::is_deeply( [ sort keys %{$map} ],
+                 [ qw( bar foo meta ) ],
+                 'get_method_map returns expected methods' );
+}
diff --git a/xt/author/pod_coverage.t b/xt/author/pod_coverage.t
index 1d7cb87..490de83 100644
--- a/xt/author/pod_coverage.t
+++ b/xt/author/pod_coverage.t
@@ -46,7 +46,9 @@ my %trustme = (
     ],
     'Class::MOP::Class::Immutable::Trait'             => ['.+'],
     'Class::MOP::Class::Immutable::Class::MOP::Class' => ['.+'],
-    'Class::MOP::Instance'                            => [
+    'Class::MOP::Deprecated'                          => ['.+'],
+
+    'Class::MOP::Instance' => [
         qw( BUILDARGS
             bless_instance_structure
             is_dependent_on_superclasses ),
@@ -86,8 +88,8 @@ my %trustme = (
             initialize_body
             )
     ],
-    'Class::MOP::Module' => ['create'],
-    'Class::MOP::Package' => ['wrap_method_body'],
+    'Class::MOP::Module'  => ['create'],
+    'Class::MOP::Package' => [ 'get_method_map', 'wrap_method_body' ],
 );
 
 for my $module ( sort @modules ) {