From: gfx Date: Fri, 14 Aug 2009 00:33:14 +0000 (+0900) Subject: Make "use Moose -extends => [@superclasses]" establish is-a relationship at compile... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e0abefb7a09a8e8e8f5d6070dfcb556ac23c7919;p=gitmo%2FMoose.git Make "use Moose -extends => [@superclasses]" establish is-a relationship at compile time. --- diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index c8265bc..7ec2dc0 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -373,6 +373,9 @@ sub _make_import_sub { 'Class' => $metaclass ) if defined $metaclass && length $metaclass; + my $superclasses; + ( $superclasses, @_ ) = _strip_extends(@_); + # Normally we could look at $_[0], but in some weird cases # (involving goto &Moose::import), $_[0] ends as something # else (like Squirrel). @@ -406,6 +409,16 @@ sub _make_import_sub { $did_init_meta = 1; } + if(@{$superclasses}){ + if($did_init_meta){ + $CALLER->meta->superclasses(@{$superclasses}); + } + else{ + require Moose; + Moose->throw_error("Cannot provide -extends when $class does not have an init_meta() method"); + } + } + if ( $did_init_meta && @{$traits} ) { # The traits will use Moose::Role, which in turn uses # Moose::Exporter, which in turn sets $CALLER, so we need @@ -451,6 +464,20 @@ sub _strip_metaclass { return ( $metaclass, @_ ); } +sub _strip_extends { + my $idx = first_index { $_ eq '-extends' } @_; + + return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1; + + my $superclasses = $_[ $idx + 1 ]; + + splice @_, $idx, 2; + + $superclasses = [ $superclasses ] unless ref $superclasses; + + return ( $superclasses, @_ ); +} + sub _apply_meta_traits { my ( $class, $traits ) = @_;