))
);
-# FIMXE prime candidate for immutablization
-Class::MOP::Method->meta->add_method('wrap' => sub {
- my ( $class, @args ) = @_;
-
- unshift @args, 'body' if @args % 2 == 1;
-
- my %options = @args;
- my $code = $options{body};
-
- ('CODE' eq ref($code))
- || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
-
- ($options{package_name} && $options{name})
- || confess "You must supply the package_name and name parameters";
-
- # return the new object
- $class->meta->new_object(%options);
-});
-
Class::MOP::Method->meta->add_method('clone' => sub {
my $self = shift;
$self->meta->clone_object($self, @_);
($params{package_name} && $params{name})
|| confess "You must supply the package_name and name parameters $UPGRADE_ERROR_TEXT";
- my $self = bless {
- 'body' => $code,
- 'associated_metaclass' => $params{associated_metaclass},
- 'package_name' => $params{package_name},
- 'name' => $params{name},
- } => ref($class) || $class;
+ my $self = (ref($class) || $class)->_new(%params);
weaken($self->{associated_metaclass}) if $self->{associated_metaclass};
return $self;
}
+sub _new {
+ my ( $class, %params ) = @_;
+
+ my $self = bless {
+ 'body' => $params{body},
+ 'associated_metaclass' => $params{associated_metaclass},
+ 'package_name' => $params{package_name},
+ 'name' => $params{name},
+ } => $class;
+}
+
## accessors
sub body { (shift)->{'body'} }