more browser hackin

[gitmo/Class-MOP.git] / lib / Class / MOP / Method.pm

diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 386a8a1..04f1312 100644 (file)
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -8,11 +8,15 @@ use Carp         'confess';
 use Scalar::Util 'reftype', 'blessed';
 use B            'svref_2object';
 
-our $VERSION   = '0.03';
+our $VERSION   = '0.04';
 our $AUTHORITY = 'cpan:STEVAN';
 
-use overload '&{}' => sub { $_[0]->{body} },
-             fallback => 1;
+use base 'Class::MOP::Object';
+
+# NOTE:
+# if poked in the right way, 
+# they should act like CODE refs.
+use overload '&{}' => sub { $_[0]->{body} }, fallback => 1;
 
 # introspection
 
@@ -33,28 +37,36 @@ sub wrap {
     } => blessed($class) || $class;
 }
 
+## accessors
+
 sub body { (shift)->{body} }
 
+# TODO - add associated_class
+
 # informational
 
+# NOTE: 
+# this may not be the same name 
+# as the class you got it from
+# This gets the package stash name 
+# associated with the actual CODE-ref
 sub package_name { 
-       my $code = shift->{body};
-#      (blessed($code))
-#              || confess "Can only ask the package name of a blessed CODE";
+       my $code = (shift)->{body};
        svref_2object($code)->GV->STASH->NAME;
 }
 
+# NOTE: 
+# this may not be the same name 
+# as the method name it is stored
+# with. This gets the name associated
+# with the actual CODE-ref
 sub name { 
-       my $code = shift->{body};
-#      (blessed($code))
-#              || confess "Can only ask the package name of a blessed CODE";   
+       my $code = (shift)->{body};
        svref_2object($code)->GV->NAME;
 }
 
 sub fully_qualified_name {
        my $code = shift;
-#      (blessed($code))
-#              || confess "Can only ask the package name of a blessed CODE";
        $code->package_name . '::' . $code->name;               
 }
 
@@ -67,9 +79,10 @@ use Carp         'confess';
 use Scalar::Util 'reftype', 'blessed';
 use Sub::Name    'subname';
 
-our $VERSION = '0.01';
+our $VERSION   = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
 
-our @ISA = ('Class::MOP::Method');     
+use base 'Class::MOP::Method'; 
 
 # NOTE:
 # this ugly beast is the result of trying 
@@ -126,8 +139,6 @@ my $_build_wrapped_method = sub {
        }
 };
 
-my %MODIFIERS;
-
 sub wrap {
        my $class = shift;
        my $code  = shift;
@@ -145,40 +156,27 @@ sub wrap {
        };
        $_build_wrapped_method->($modifier_table);
        my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });       
-       $MODIFIERS{$method} = $modifier_table;
+       $method->{modifier_table} = $modifier_table;
        $method;  
 }
 
 sub get_original_method {
        my $code = shift; 
-    $MODIFIERS{$code}->{orig} 
-        if exists $MODIFIERS{$code};
+    $code->{modifier_table}->{orig};
 }
 
 sub add_before_modifier {
        my $code     = shift;
        my $modifier = shift;
-       (exists $MODIFIERS{$code})
-               || confess "You must first wrap your method before adding a modifier";          
-       (blessed($code))
-               || confess "Can only ask the package name of a blessed CODE";
-       #('CODE' eq (reftype($code) || ''))
-    #    || confess "You must supply a CODE reference for a modifier";                 
-       unshift @{$MODIFIERS{$code}->{before}} => $modifier;
-       $_build_wrapped_method->($MODIFIERS{$code});
+       unshift @{$code->{modifier_table}->{before}} => $modifier;
+       $_build_wrapped_method->($code->{modifier_table});
 }
 
 sub add_after_modifier {
        my $code     = shift;
        my $modifier = shift;
-       (exists $MODIFIERS{$code})
-               || confess "You must first wrap your method before adding a modifier";          
-       (blessed($code))
-               || confess "Can only ask the package name of a blessed CODE";
-    #('CODE' eq (reftype($code) || ''))
-    #    || confess "You must supply a CODE reference for a modifier";                 
-       push @{$MODIFIERS{$code}->{after}} => $modifier;
-       $_build_wrapped_method->($MODIFIERS{$code});    
+       push @{$code->{modifier_table}->{after}} => $modifier;
+       $_build_wrapped_method->($code->{modifier_table});      
 }
 
 {
@@ -199,18 +197,12 @@ sub add_after_modifier {
        sub add_around_modifier {
                my $code     = shift;
                my $modifier = shift;
-               (exists $MODIFIERS{$code})
-                       || confess "You must first wrap your method before adding a modifier";          
-               (blessed($code))
-                       || confess "Can only ask the package name of a blessed CODE";
-           #('CODE' eq (reftype($code) || ''))
-           #    || confess "You must supply a CODE reference for a modifier";                  
-               unshift @{$MODIFIERS{$code}->{around}->{methods}} => $modifier;         
-               $MODIFIERS{$code}->{around}->{cache} = $compile_around_method->(
-                       @{$MODIFIERS{$code}->{around}->{methods}},
-                       $MODIFIERS{$code}->{orig}
+               unshift @{$code->{modifier_table}->{around}->{methods}} => $modifier;           
+               $code->{modifier_table}->{around}->{cache} = $compile_around_method->(
+                       @{$code->{modifier_table}->{around}->{methods}},
+                       $code->{modifier_table}->{orig}->body
                );
-               $_build_wrapped_method->($MODIFIERS{$code});            
+               $_build_wrapped_method->($code->{modifier_table});              
        }       
 }