blob: b27091ab5ddee76b273a0e7b76750474246a3845 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
package MooseX::NonMoose::Meta::Role::Class;
use Moose::Role;
has replace_constructor => (
is => 'rw',
isa => 'Bool',
default => 0,
);
around _make_immutable_transformer => sub {
my $orig = shift;
my $self = shift;
my @args = @_;
unshift @args, replace_constructor => 1 if $self->replace_constructor;
$self->$orig(@args);
};
around superclasses => sub {
my $orig = shift;
my $self = shift;
return $self->$orig unless @_;
my @superclasses = @_;
push @superclasses, 'Moose::Object'
unless grep { $_->isa('Moose::Object') } @superclasses;
my @ret = $self->$orig(@superclasses);
# we need to get the non-moose constructor from the superclass
# of the class where this method actually exists, regardless of what class
# we're calling it on
# XXX: get constructor name from the constructor metaclass?
my $super_new = $self->find_next_method_by_name('new');
# if we're trying to extend a (non-immutable) moose class, just do nothing
return @ret if $super_new->package_name eq 'Moose::Object';
if ($super_new->associated_metaclass->can('constructor_class')) {
my $constructor_class_meta = Class::MOP::Class->initialize(
$super_new->associated_metaclass->constructor_class
);
# if the constructor we're inheriting is already one of ours, there's
# no reason to install a new one
return @ret if $constructor_class_meta->can('does_role')
&& $constructor_class_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor');
# if the constructor we're inheriting is an inlined version of the
# default moose constructor, don't do anything either
return @ret if $constructor_class_meta->name eq 'Moose::Meta::Method::Constructor';
}
$self->add_method(new => sub {
my $class = shift;
my $params = $class->BUILDARGS(@_);
my $instance = $super_new->execute($class, @_);
my $self = Class::MOP::Class->initialize($class)->new_object(
__INSTANCE__ => $instance,
%$params,
);
$self->BUILDALL($params);
return $self;
});
$self->replace_constructor(1);
return @ret;
};
no Moose::Role;
1;
|
