Commit | Line | Data |
5cf3dbcf |
1 | |
2 | package Moose::Meta::Method::Constructor; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
0d922627 |
7 | use Carp (); |
0fa70d03 |
8 | use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr'; |
55c361dc |
9 | use Try::Tiny; |
5cf3dbcf |
10 | |
bb8ef151 |
11 | our $VERSION = '1.9900'; |
5cf3dbcf |
12 | our $AUTHORITY = 'cpan:STEVAN'; |
13 | |
badb7e89 |
14 | use base 'Moose::Meta::Method', |
bc89e9b5 |
15 | 'Class::MOP::Method::Constructor'; |
5cf3dbcf |
16 | |
17 | sub new { |
18 | my $class = shift; |
19 | my %options = @_; |
7a5b07b3 |
20 | |
3e504337 |
21 | my $meta = $options{metaclass}; |
22 | |
23 | (ref $options{options} eq 'HASH') |
a9538ac9 |
24 | || $class->throw_error("You must pass a hash of options", data => $options{options}); |
7a5b07b3 |
25 | |
1b2aea39 |
26 | ($options{package_name} && $options{name}) |
a9538ac9 |
27 | || $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"); |
1b2aea39 |
28 | |
5cf3dbcf |
29 | my $self = bless { |
d03bd989 |
30 | 'body' => undef, |
e606ae5f |
31 | 'package_name' => $options{package_name}, |
32 | 'name' => $options{name}, |
e606ae5f |
33 | 'options' => $options{options}, |
e606ae5f |
34 | 'associated_metaclass' => $meta, |
0fa70d03 |
35 | '_expected_method_class' => $options{_expected_method_class} || 'Moose::Object', |
5cf3dbcf |
36 | } => $class; |
37 | |
7a5b07b3 |
38 | # we don't want this creating |
39 | # a cycle in the code, if not |
5cf3dbcf |
40 | # needed |
e606ae5f |
41 | weaken($self->{'associated_metaclass'}); |
5cf3dbcf |
42 | |
f5b0af77 |
43 | $self->_initialize_body; |
5cf3dbcf |
44 | |
7a5b07b3 |
45 | return $self; |
5cf3dbcf |
46 | } |
47 | |
5cf3dbcf |
48 | ## method |
49 | |
f5b0af77 |
50 | sub _initialize_body { |
5cf3dbcf |
51 | my $self = shift; |
e247d17c |
52 | $self->{'body'} = $self->_generate_constructor_method_inline; |
53 | } |
54 | |
55 | sub _eval_environment { |
56 | my $self = shift; |
57 | |
58 | my $attrs = $self->_attributes; |
59 | |
60 | my $defaults = [map { $_->default } @$attrs]; |
61 | |
62 | # We need to check if the attribute ->can('type_constraint') |
63 | # since we may be trying to immutabilize a Moose meta class, |
64 | # which in turn has attributes which are Class::MOP::Attribute |
65 | # objects, rather than Moose::Meta::Attribute. And |
66 | # Class::MOP::Attribute attributes have no type constraints. |
67 | # However we need to make sure we leave an undef value there |
68 | # because the inlined code is using the index of the attributes |
69 | # to determine where to find the type constraint |
70 | |
71 | my @type_constraints = map { |
72 | $_->can('type_constraint') ? $_->type_constraint : undef |
73 | } @$attrs; |
74 | |
75 | my @type_constraint_bodies = map { |
76 | defined $_ ? $_->_compiled_type_constraint : undef; |
77 | } @type_constraints; |
78 | |
79 | return { |
80 | '$meta' => \$self, |
81 | '$attrs' => \$attrs, |
82 | '$defaults' => \$defaults, |
83 | '@type_constraints' => \@type_constraints, |
84 | '@type_constraint_bodies' => \@type_constraint_bodies, |
85 | }; |
86 | } |
87 | |
5cf3dbcf |
88 | 1; |
89 | |
5cf3dbcf |
90 | __END__ |
91 | |
92 | =pod |
93 | |
7a5b07b3 |
94 | =head1 NAME |
5cf3dbcf |
95 | |
96 | Moose::Meta::Method::Constructor - Method Meta Object for constructors |
97 | |
5cf3dbcf |
98 | =head1 DESCRIPTION |
99 | |
cec39889 |
100 | This class is a subclass of L<Class::MOP::Method::Constructor> that |
cefc9e36 |
101 | provides additional Moose-specific functionality |
102 | |
103 | To understand this class, you should read the the |
cec39889 |
104 | L<Class::MOP::Method::Constructor> documentation as well. |
d44714be |
105 | |
bc89e9b5 |
106 | =head1 INHERITANCE |
107 | |
108 | C<Moose::Meta::Method::Constructor> is a subclass of |
109 | L<Moose::Meta::Method> I<and> L<Class::MOP::Method::Constructor>. |
110 | |
c5fc2c21 |
111 | =head1 BUGS |
112 | |
113 | See L<Moose/BUGS> for details on reporting bugs. |
114 | |
5cf3dbcf |
115 | =head1 AUTHORS |
116 | |
117 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
118 | |
119 | =head1 COPYRIGHT AND LICENSE |
120 | |
7e0492d3 |
121 | Copyright 2006-2010 by Infinity Interactive, Inc. |
5cf3dbcf |
122 | |
123 | L<http://www.iinteractive.com> |
124 | |
125 | This library is free software; you can redistribute it and/or modify |
7a5b07b3 |
126 | it under the same terms as Perl itself. |
5cf3dbcf |
127 | |
128 | =cut |
129 | |