From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sat, 23 Feb 2008 16:29:13 +0000 (+0000)
Subject: overload awareness
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fattic%2Foverload_aware;p=gitmo%2FClass-MOP.git

overload awareness
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index ecce121..92d2aaa 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -290,6 +290,13 @@ sub attribute_metaclass { $_[0]->{'$!attribute_metaclass'} }
 sub method_metaclass    { $_[0]->{'$!method_metaclass'}    }
 sub instance_metaclass  { $_[0]->{'$!instance_metaclass'}  }
 
+my %overload_symbols;
+
+BEGIN {
+    %overload_symbols = ( map { ("($_" => $_) } map { split } values %overload::ops );
+    delete @overload_symbols{map { "($_" } split ' ', $overload::ops{special}};
+}
+
 # FIXME:
 # this is a prime canidate for conversion to XS
 sub get_method_map {
@@ -306,7 +313,11 @@ sub get_method_map {
     my $method_metaclass = $self->method_metaclass;
 
     foreach my $symbol ($self->list_all_package_symbols('CODE')) {
-        my $code = $self->get_package_symbol('&' . $symbol);
+        my $overload = $overload_symbols{$symbol};
+
+        my $code = defined($overload)
+            ? overload::Method( $class_name, $overload )
+            : $self->get_package_symbol('&' . $symbol);
 
         next if exists  $map->{$symbol} &&
                 defined $map->{$symbol} &&
@@ -314,9 +325,10 @@ sub get_method_map {
 
         my ($pkg, $name) = Class::MOP::get_code_info($code);
         next if ($pkg  || '') ne $class_name &&
-                ($name || '') ne '__ANON__';
+                ($name || '') ne '__ANON__' &&
+                !defined($overload);
 
-        $map->{$symbol} = $method_metaclass->wrap($code);
+        $map->{$symbol} = $method_metaclass->wrap($code, $overload);
     }
 
     return $map;
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 56b3037..197a54e 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -28,12 +28,14 @@ sub meta {
 # construction
 
 sub wrap { 
-    my $class = shift;
-    my $code  = shift;
+    my ( $class, $code, $op ) = @_;
+
     ('CODE' eq (reftype($code) || ''))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
+
     bless { 
-        '&!body' => $code 
+        '&!body' => $code,
+        '$!op'   => $op,
     } => blessed($class) || $class;
 }
 
@@ -41,6 +43,8 @@ sub wrap {
 
 sub body { (shift)->{'&!body'} }
 
+sub op   { (shift)->{'$!op'} }
+
 # TODO - add associated_class
 
 # informational
@@ -118,6 +122,10 @@ instance which wraps the given C<$code> reference.
 
 This returns the actual CODE reference of the particular instance.
 
+=item B<op>
+
+This returns the operator name this method is an overload for, if any.
+
 =item B<name>
 
 This returns the name of the CODE reference.
diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 0e09c7f..5349e75 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -10,6 +10,8 @@ use Carp         'confess';
 our $VERSION   = '0.07';
 our $AUTHORITY = 'cpan:STEVAN';
 
+use overload ();
+
 use base 'Class::MOP::Object';
 
 # introspection
@@ -216,6 +218,19 @@ sub list_all_package_symbols {
     } keys %{$namespace};
 }
 
+sub is_overloaded {
+    my $self = shift;
+    overload::Overloaded( $self->name );
+}
+
+sub overload_fallback {
+    my $self = shift;
+
+    return unless $self->is_overloaded;
+
+    ${ $self->get_package_symbol('$()') }
+}
+
 1;
 
 __END__
@@ -291,6 +306,14 @@ the package.
 By passing a C<$type_filter>, you can limit the list to only those 
 which match the filter (either SCALAR, ARRAY, HASH or CODE).
 
+=item B<is_overloaded>
+
+Whether or not the package has overloading enabled.
+
+=item B<overload_fallback>
+
+Returns the value of L<overload>'s C<fallback> parameter.
+
 =back
 
 =head1 AUTHORS
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 2c9e9a7..09287e8 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 205;
+use Test::More tests => 209;
 use Test::Exception;
 
 BEGIN {
@@ -38,6 +38,8 @@ my @class_mop_package_methods = qw(
     add_package_symbol get_package_symbol has_package_symbol remove_package_symbol
     list_all_package_symbols remove_package_glob
 
+    is_overloaded overload_fallback
+
     _deconstruct_variable_name
 );