X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=97142d4c63e6323601f84a4249d4595b314bcc5d;hb=efeb6d0c0f94adf6e09f4c6db5806cfe463fcc60;hp=7cdd2438554c0376cc29eb93cda092fea84e3e6f;hpb=eb6f444462e64af1280ee10d00e8b9020c7fa513;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 7cdd243..97142d4 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -4,7 +4,7 @@ use warnings; use 5.006; use base 'Exporter'; -our $VERSION = '0.24'; +our $VERSION = '0.25'; use Carp 'confess'; use Scalar::Util 'blessed'; @@ -88,6 +88,46 @@ sub override { }); } +sub init_meta { + # This used to be called as a function. This hack preserves + # backwards compatibility. + if ( $_[0] ne __PACKAGE__ ) { + return __PACKAGE__->init_meta( + for_class => $_[0], + base_class => $_[1], + metaclass => $_[2], + ); + } + + shift; + my %args = @_; + + my $class = $args{for_class} + or Carp::croak( + "Cannot call init_meta without specifying a for_class"); + my $base_class = $args{base_class} || 'Mouse::Object'; + my $metaclass = $args{metaclass} || 'Mouse::Meta::Class'; + + Carp::croak("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.") + unless $metaclass->isa('Mouse::Meta::Class'); + + # make a subtype for each Mouse class + class_type($class) + unless find_type_constraint($class); + + my $meta = $metaclass->initialize($class); + $meta->superclasses($base_class) + unless $meta->superclasses; + + { + no strict 'refs'; + no warnings 'redefine'; + *{$class.'::meta'} = sub { $meta }; + } + + return $meta; +} + sub import { my $class = shift; @@ -111,16 +151,9 @@ sub import { return; } - my $meta = Mouse::Meta::Class->initialize($caller); - $meta->superclasses('Mouse::Object') - unless $meta->superclasses; - - # make a subtype for each Mouse class - class_type($caller) unless find_type_constraint($caller); - - no strict 'refs'; - no warnings 'redefine'; - *{$caller.'::meta'} = sub { $meta }; + Mouse->init_meta( + for_class => $caller, + ); if (@_) { __PACKAGE__->export_to_level( $level+1, $class, @_);