use warnings;
use Carp 'confess';
-use Scalar::Util 'weaken', 'reftype';
+use Scalar::Util 'weaken', 'reftype', 'blessed';
-our $VERSION = '0.89';
+our $VERSION = '1.12';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
my %params = @args;
my $code = $params{body};
- (ref $code && 'CODE' eq reftype($code))
- || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
+ if (blessed($code) && $code->isa(__PACKAGE__)) {
+ my $method = $code->clone;
+ delete $params{body};
+ Class::MOP::class_of($class)->rebless_instance($method, %params);
+ return $method;
+ }
+ elsif (!ref $code || 'CODE' ne reftype($code)) {
+ confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
+ }
($params{package_name} && $params{name})
|| confess "You must supply the package_name and name parameters";
sub _new {
my $class = shift;
+
+ return Class::MOP::Class->initialize($class)->new_object(@_)
+ if $class ne __PACKAGE__;
+
my $params = @_ == 1 ? $_[0] : {@_};
- my $self = bless {
+ return bless {
'body' => $params->{body},
'associated_metaclass' => $params->{associated_metaclass},
'package_name' => $params->{package_name},
'name' => $params->{name},
+ 'original_method' => $params->{original_method},
} => $class;
}
sub associated_metaclass { shift->{'associated_metaclass'} }
-sub _is_valid_generation{
- my($self) = @_;
- my $metaclass = $self->associated_metaclass;
-
- if($metaclass){
- return( ($self->{_generation} || 0) == Class::MOP::check_package_cache_flag($metaclass->name) );
- }
- else{
- return 1;
- }
-}
-
-sub _update_generation {
- my($self) = @_;
- my $metaclass = $self->associated_metaclass
- or confess("No metaclass associated to the method " . $self->name);
- $self->{_generation} = Class::MOP::check_package_cache_flag($metaclass->name);
-}
-
sub attach_to_class {
my ( $self, $class ) = @_;
$self->{associated_metaclass} = $class;
$self->body->(@_);
}
-# NOTE:
-# the Class::MOP bootstrap
-# will create this for us
-# - SL
-# sub clone { ... }
+# We used to go through use Class::MOP::Class->clone_instance to do this, but
+# this was awfully slow. This method may be called a number of times when
+# classes are loaded (especially during Moose role application), so it is
+# worth optimizing. - DR
+sub clone {
+ my $self = shift;
+
+ my $clone = bless { %{$self}, @_ }, blessed($self);
+
+ $clone->_set_original_method($self);
+
+ return $clone;
+}
1;
=item B<< Class::MOP::Method->wrap($code, %options) >>
-This is the constructor. It accepts a subroutine reference and a hash
-of options.
+This is the constructor. It accepts a method body in the form of
+either a code reference or a L<Class::MOP::Method> instance, followed
+by a hash of options.
The options are:
=item * name
-The method name (without a package name). This is required.
+The method name (without a package name). This is required if C<$code>
+is a coderef.
=item * package_name
-The package name for the method. This is required.
+The package name for the method. This is required if C<$code> is a
+coderef.
=item * associated_metaclass
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>