X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod.pm;h=515f8c7aee029a0a439dbe6f9141e17a62f8556c;hb=eca95e0476ae5a66144c4fd1f4a23c2ba4bdbf26;hp=37af5a1ae869a8767026bef5e05173937c36ae53;hpb=91b73829b31b4035fa1b4a6ad7587a4861961a5d;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index 37af5a1..515f8c7 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'weaken'; -our $VERSION = '0.65'; +our $VERSION = '0.78'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -43,7 +43,7 @@ sub wrap { ($params{package_name} && $params{name}) || confess "You must supply the package_name and name parameters $UPGRADE_ERROR_TEXT"; - my $self = (ref($class) || $class)->_new(\%params); + my $self = $class->_new(\%params); weaken($self->{associated_metaclass}) if $self->{associated_metaclass}; @@ -64,8 +64,6 @@ sub _new { ## accessors -sub body { (shift)->{'body'} } - sub associated_metaclass { shift->{'associated_metaclass'} } sub attach_to_class { @@ -79,15 +77,49 @@ sub detach_from_class { delete $self->{associated_metaclass}; } -sub package_name { (shift)->{'package_name'} } - -sub name { (shift)->{'name'} } - sub fully_qualified_name { my $self = shift; $self->package_name . '::' . $self->name; } +sub original_method { (shift)->{'original_method'} } + +sub _set_original_method { $_[0]->{'original_method'} = $_[1] } + +# It's possible that this could cause a loop if there is a circular +# reference in here. That shouldn't ever happen in normal +# circumstances, since original method only gets set when clone is +# called. We _could_ check for such a loop, but it'd involve some sort +# of package-lexical variable, and wouldn't be terribly subclassable. +sub original_package_name { + my $self = shift; + + $self->original_method + ? $self->original_method->original_package_name + : $self->package_name; +} + +sub original_name { + my $self = shift; + + $self->original_method + ? $self->original_method->original_name + : $self->name; +} + +sub original_fully_qualified_name { + my $self = shift; + + $self->original_method + ? $self->original_method->original_fully_qualified_name + : $self->fully_qualified_name; +} + +sub execute { + my $self = shift; + $self->body->(@_); +} + # NOTE: # the Class::MOP bootstrap # will create this for us @@ -130,10 +162,8 @@ to this class. =item B This is the basic constructor, it returns a B -instance which wraps the given C<$code> reference. You can also -set the C and C attributes using the C<%params>. -If these are not set, then thier accessors will attempt to figure -it out using the C function. +instance which wraps the given C<$code> reference. You must also set +the C and C attributes in C<%params>. =item B @@ -166,6 +196,37 @@ This returns the package name that the CODE reference is attached to. This returns the fully qualified name of the CODE reference. +=item B + +If this method object was created as a clone of some other method +object, this returns the object that was cloned. + +=item B + +This returns the original name of the CODE reference, wherever it was +first defined. + +If this method is a clone of a clone (of a clone, etc.), this method +returns the name from the I method in the chain of clones. + +=item B + +This returns the original package name that the CODE reference is +attached to, wherever it was first defined. + +If this method is a clone of a clone (of a clone, etc.), this method +returns the package name from the I method in the chain of +clones. + +=item B + +This returns the original fully qualified name of the CODE reference, +wherever it was first defined. + +If this method is a clone of a clone (of a clone, etc.), this method +returns the fully qualified name from the I method in the chain +of clones. + =back =head2 Metaclass @@ -182,6 +243,17 @@ Disassociates the method from the metaclass =back +=head2 Miscellaneous + +=over 4 + +=item B + +Executes the method. Be sure to pass in the instance, since the +method expects it. + +=back + =head1 AUTHORS Stevan Little Estevan@iinteractive.comE