diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/MooseX/NonMoose.pm | 23 | ||||
| -rw-r--r-- | lib/MooseX/NonMoose/Meta/Role/Class.pm | 89 |
2 files changed, 88 insertions, 24 deletions
diff --git a/lib/MooseX/NonMoose.pm b/lib/MooseX/NonMoose.pm index 0fd9282..5a989e0 100644 --- a/lib/MooseX/NonMoose.pm +++ b/lib/MooseX/NonMoose.pm @@ -62,6 +62,15 @@ return a list of arguments to pass to the superclass constructor. This allows C<MooseX::NonMoose> to support superclasses whose constructors would get confused by the extra arguments that Moose requires (for attributes, etc.) +Not all non-Moose classes use C<new> as the name of their constructor. This +module allows you to extend these classes by explicitly stating which method is +the constructor, during the call to C<extends>. The syntax looks like this: + + extends 'Foo' => { -constructor_name => 'create' }; + +similar to how you can already pass C<-version> in the C<extends> call in a +similar way. + =cut my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( @@ -81,14 +90,6 @@ sub init_meta { $package->$init_meta(@_); } -=head1 TODO - -=over 4 - -=item * Allow for constructors with names other than C<new>. - -=back - =head1 BUGS/CAVEATS =over 4 @@ -111,10 +112,6 @@ C<MooseX::NonMoose> (i.e. using C<sub new { ... }>) currently doesn't work, although using method modifiers on the constructor should work identically to normal Moose classes. -=item * C<MooseX::NonMoose> currently assumes in several places that the -superclass constructor will be called C<new>. This may be made configurable -in the future. - =back Please report any bugs through RT: email @@ -125,7 +122,7 @@ L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-NonMoose>. =over 4 -=item * L<Moose::Cookbook::FAQ/How do I make non-Moose constructors work with Moose?> +=item * L<Moose::Manual::FAQ/How do I make non-Moose constructors work with Moose?> =item * L<MooseX::Alien> diff --git a/lib/MooseX/NonMoose/Meta/Role/Class.pm b/lib/MooseX/NonMoose/Meta/Role/Class.pm index 6c09b22..e873877 100644 --- a/lib/MooseX/NonMoose/Meta/Role/Class.pm +++ b/lib/MooseX/NonMoose/Meta/Role/Class.pm @@ -46,6 +46,33 @@ has has_nonmoose_destructor => ( default => 0, ); +# overrides the constructor_name attr that already exists +has constructor_name => ( + is => 'rw', + isa => 'Str', + lazy => 1, + default => sub { shift->throw_error("No constructor name has been set") }, +); + +# XXX ugh, really need to fix this in moose +around reinitialize => sub { + my $orig = shift; + my $class = shift; + my ($pkg) = @_; + + my $meta = blessed($pkg) ? $pkg : Class::MOP::class_of($pkg); + + $class->$orig( + @_, + (map { $_->init_arg => $_->get_value($meta) } + grep { $_->has_value($meta) } + map { $meta->meta->find_attribute_by_name($_) } + qw(has_nonmoose_constructor + has_nonmoose_destructor + constructor_name)), + ); +}; + sub _determine_constructor_options { my $self = shift; my @options = @_; @@ -57,12 +84,17 @@ sub _determine_constructor_options { unless $cc_meta->can('does_role') && $cc_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor'); - # XXX: get constructor name from the constructor metaclass? - my $local_constructor = $self->get_method('new'); + # do nothing if we explicitly ask for the constructor to not be inlined + my %options = @options; + return @options if !$options{inline_constructor}; + + my $constructor_name = $self->constructor_name; + + my $local_constructor = $self->get_method($constructor_name); if (!defined($local_constructor)) { warn "Not inlining a constructor for " . $self->name . " since " . "its parent " . ($self->superclasses)[0] . " doesn't contain a " - . "'new' method. " + . "constructor named '$constructor_name'. " . "If you are certain you don't need to inline your" . " constructor, specify inline_constructor => 0 in your" . " call to " . $self->name . "->meta->make_immutable\n"; @@ -77,10 +109,6 @@ sub _determine_constructor_options { return @options if $local_constructor->isa('Class::MOP::Method::Wrapped'); - # do nothing if we explicitly ask for the constructor to not be inlined - my %options = @options; - return @options if !$options{inline_constructor}; - # otherwise, explicitly ask for the constructor to be replaced (to suppress # the warning message), since this is the expected usage, and shouldn't # cause a warning @@ -115,13 +143,12 @@ sub _check_superclass_constructor { # if the current class defined a custom new method (since subs happen at # BEGIN time), don't try to override it - return if $self->has_method('new'); + return if $self->has_method($self->constructor_name); # 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'); + my $super_new = $self->find_next_method_by_name($self->constructor_name); # if we're trying to extend a (non-immutable) moose class, just do nothing return if $super_new->package_name eq 'Moose::Object'; @@ -142,7 +169,7 @@ sub _check_superclass_constructor { $super_new->associated_metaclass->_inlined_methods; } - $self->add_method(new => sub { + $self->add_method($self->constructor_name => sub { my $class = shift; my $params = $class->BUILDARGS(@_); @@ -228,6 +255,46 @@ around superclasses => sub { return $self->$orig unless @_; + # XXX lots of duplication between here and MMC::superclasses + my ($constructor_name, $constructor_class); + for my $super (@{ Data::OptList::mkopt(\@_) }) { + my ($name, $opts) = @{ $super }; + + my $cur_constructor_name = delete $opts->{'-constructor_name'}; + + if (defined($constructor_name) && defined($cur_constructor_name)) { + $self->throw_error( + "You have already specified " + . "${constructor_class}::${constructor_name} as the parent " + . "constructor; ${name}::${cur_constructor_name} cannot also be " + . "the constructor" + ); + } + + Class::MOP::load_class($name, $opts); + + if (defined($cur_constructor_name)) { + my $meta = Class::MOP::class_of($name); + $self->throw_error( + "You specified '$cur_constructor_name' as the constructor for " + . "$name, but $name has no method by that name" + ) unless $meta + ? $meta->find_method_by_name($cur_constructor_name) + : $name->can($cur_constructor_name); + } + + if (!defined($constructor_name)) { + $constructor_name = $cur_constructor_name; + $constructor_class = $name; + } + + delete $opts->{'-constructor_name'}; + } + + $self->constructor_name( + defined($constructor_name) ? $constructor_name : 'new' + ); + my @superclasses = @_; push @superclasses, 'Moose::Object' unless grep { !ref($_) && $_->isa('Moose::Object') } @superclasses; |