X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=97142d4c63e6323601f84a4249d4595b314bcc5d;hb=efeb6d0c0f94adf6e09f4c6db5806cfe463fcc60;hp=9c880ee0b378bd41c0f5782b65487e179b6506d5;hpb=9e3c345e4b8c719e6750c3b6c6ff43a31c55ba5f;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 9c880ee..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.23'; +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, @_); @@ -191,6 +224,12 @@ sub is_class_loaded { return 0; } +sub class_of { + return unless defined $_[0]; + my $class = blessed($_[0]) || $_[0]; + return Mouse::Meta::Class::get_metaclass_by_name($class); +} + 1; __END__