2 package Class::MOP::Method::Constructor;
8 use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
10 our $VERSION = '0.78';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
14 use base 'Class::MOP::Method::Generated';
20 (blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class'))
21 || confess "You must pass a metaclass instance if you want to inline"
22 if $options{is_inline};
24 ($options{package_name} && $options{name})
25 || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
27 my $self = $class->_new(\%options);
29 # we don't want this creating
30 # a cycle in the code, if not
32 weaken($self->{'associated_metaclass'});
34 $self->_initialize_body;
41 my $options = @_ == 1 ? $_[0] : {@_};
46 'package_name' => $options->{package_name},
47 'name' => $options->{name},
48 # specific to this subclass
49 'options' => $options->{options} || {},
50 'associated_metaclass' => $options->{metaclass},
51 'is_inline' => ($options->{is_inline} || 0),
55 sub can_be_inlined { 1 }
59 sub options { (shift)->{'options'} }
60 sub associated_metaclass { (shift)->{'associated_metaclass'} }
66 $self->{'meta_instance'} ||= $self->associated_metaclass->get_meta_instance;
71 $self->{'attributes'} ||= [ $self->associated_metaclass->compute_all_applicable_attributes ]
77 warn 'The initialize_body method has been made private.'
78 . " The public version is deprecated and will be removed in a future release.\n";
79 goto &_initialize_body;
82 sub _initialize_body {
84 my $method_name = '_generate_constructor_method';
86 $method_name .= '_inline' if $self->is_inline;
88 $self->{'body'} = $self->$method_name;
91 sub generate_constructor_method {
92 warn 'The generate_constructor_method method has been made private.'
93 . " The public version is deprecated and will be removed in a future release.\n";
94 goto &_generate_constructor_method;
97 sub _generate_constructor_method {
98 return sub { Class::MOP::Class->initialize(shift)->new_object(@_) }
101 sub generate_constructor_method_inline {
102 warn 'The generate_constructor_method_inline method has been made private.'
103 . " The public version is deprecated and will be removed in a future release.\n";
104 goto &_generate_constructor_method_inline;
107 sub _generate_constructor_method_inline {
112 my $source = 'sub {';
113 $source .= "\n" . 'my $class = shift;';
115 $source .= "\n" . 'return Class::MOP::Class->initialize($class)->new_object(@_)';
116 $source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';';
118 $source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};';
120 $source .= "\n" . 'my $instance = ' . $self->meta_instance->inline_create_instance('$class');
121 $source .= ";\n" . (join ";\n" => map {
122 $self->_generate_slot_initializer($_, $close_over)
123 } @{$self->attributes});
124 $source .= ";\n" . 'return $instance';
125 $source .= ";\n" . '}';
126 warn $source if $self->options->{debug};
128 my $code = $self->_eval_closure(
132 confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
137 sub _generate_slot_initializer {
143 if ($attr->has_default) {
145 # default values can either be CODE refs
146 # in which case we need to call them. Or
147 # they can be scalars (strings/numbers)
148 # in which case we can just deal with them
149 # in the code we eval.
150 if ($attr->is_default_a_coderef) {
151 my $idx = @{$close->{'@defaults'}||=[]};
152 push(@{$close->{'@defaults'}}, $attr->default);
153 $default = '$defaults[' . $idx . ']->($instance)';
156 $default = $attr->default;
157 # make sure to quote strings ...
158 unless (looks_like_number($default)) {
159 $default = "'$default'";
162 } elsif( $attr->has_builder ) {
163 $default = '$instance->'.$attr->builder;
166 if ( defined $attr->init_arg ) {
168 'if(exists $params->{\'' . $attr->init_arg . '\'}){' . "\n" .
169 $self->meta_instance->inline_set_slot_value(
172 '$params->{\'' . $attr->init_arg . '\'}' ) . "\n" .
173 '} ' . (!defined $default ? '' : 'else {' . "\n" .
174 $self->meta_instance->inline_set_slot_value(
180 } elsif ( defined $default ) {
182 $self->meta_instance->inline_set_slot_value(
198 Class::MOP::Method::Constructor - Method Meta Object for constructors
202 use Class::MOP::Method::Constructor;
204 my $constructor = Class::MOP::Method::Constructor->new(
205 metaclass => $metaclass,
207 debug => 1, # this is all for now
211 # calling the constructor ...
212 $constructor->body->execute($metaclass->name, %params);
216 This is a subclass of C<Class::MOP::Method> which generates
223 =item B<< Class::MOP::Method::Constructor->new(%options) >>
225 This creates a new constructor object. It accepts a hash reference of
232 This should be a L<Class::MOP::Class> object. It is required.
236 The method name (without a package name). This is required.
240 The package name for the method. This is required.
244 This indicates whether or not the constructor should be inlined. This
249 =item B<< $metamethod->is_inline >>
251 Returns a boolean indicating whether or not the constructor is
254 =item B<< $metamethod->associated_metaclass >>
256 This returns the L<Class::MOP::Class> object for the method.
258 =item B<< $metamethod->is_inline >>
260 Returns a boolean indicating whether or not the constructor is
263 =item B<< $metamethod->can_be_inlined >>
265 This method always returns true in this class. It exists so that
266 subclasses (as in Moose) can do some sort of checking to determine
267 whether or not inlining the constructor is safe.
273 Stevan Little E<lt>stevan@iinteractive.comE<gt>
275 =head1 COPYRIGHT AND LICENSE
277 Copyright 2006-2009 by Infinity Interactive, Inc.
279 L<http://www.iinteractive.com>
281 This library is free software; you can redistribute it and/or modify
282 it under the same terms as Perl itself.