X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=1c76f7c296f0c72179aa52e056f2d830eeb21eb5;hb=8f98ed261eac95dc093a9b6d22c462c790e63736;hp=e03e12a7d7dac90e27cb944a3386f3e192394123;hpb=a81cc7b83f688ff21284b599a81e14a44bcdf401;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index e03e12a..1c76f7c 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -4,13 +4,16 @@ use warnings; use 5.006; use base 'Exporter'; -our $VERSION = '0.30'; +our $VERSION = '0.31'; + +sub moose_version(){ 0.90 } # which Mouse is a subset of use Carp 'confess'; use Scalar::Util 'blessed'; -use Mouse::Util; +use Mouse::Util qw(load_class is_class_loaded); use Mouse::Meta::Attribute; +use Mouse::Meta::Module; use Mouse::Meta::Class; use Mouse::Object; use Mouse::Util::TypeConstraints; @@ -21,15 +24,15 @@ our %is_removable = map{ $_ => undef } @EXPORT; delete $is_removable{blessed}; delete $is_removable{confess}; -sub extends { Mouse::Meta::Class->initialize(caller)->superclasses(@_) } +sub extends { Mouse::Meta::Class->initialize(scalar caller)->superclasses(@_) } sub has { - my $meta = Mouse::Meta::Class->initialize(caller); + my $meta = Mouse::Meta::Class->initialize(scalar caller); $meta->add_attribute(@_); } sub before { - my $meta = Mouse::Meta::Class->initialize(caller); + my $meta = Mouse::Meta::Class->initialize(scalar caller); my $code = pop; @@ -39,7 +42,7 @@ sub before { } sub after { - my $meta = Mouse::Meta::Class->initialize(caller); + my $meta = Mouse::Meta::Class->initialize(scalar caller); my $code = pop; @@ -49,7 +52,7 @@ sub after { } sub around { - my $meta = Mouse::Meta::Class->initialize(caller); + my $meta = Mouse::Meta::Class->initialize(scalar caller); my $code = pop; @@ -59,7 +62,7 @@ sub around { } sub with { - Mouse::Util::apply_all_roles((caller)[0], @_); + Mouse::Util::apply_all_roles(scalar(caller), @_); } our $SUPER_PACKAGE; @@ -188,61 +191,6 @@ sub unimport { } } -sub load_class { - my $class = shift; - - if (!Mouse::Util::is_valid_class_name($class)) { - my $display = defined($class) ? $class : 'undef'; - confess "Invalid class name ($display)"; - } - - return 1 if is_class_loaded($class); - - (my $file = "$class.pm") =~ s{::}{/}g; - - eval { CORE::require($file) }; - confess "Could not load class ($class) because : $@" if $@; - - return 1; -} - -my %is_class_loaded_cache; -sub is_class_loaded { - my $class = shift; - - return 0 if ref($class) || !defined($class) || !length($class); - - return 1 if exists $is_class_loaded_cache{$class}; - - # walk the symbol table tree to avoid autovififying - # \*{${main::}{"Foo::"}} == \*main::Foo:: - - my $pack = \*::; - foreach my $part (split('::', $class)) { - return 0 unless exists ${$$pack}{"${part}::"}; - $pack = \*{${$$pack}{"${part}::"}}; - } - - # check for $VERSION or @ISA - return ++$is_class_loaded_cache{$class} if exists ${$$pack}{VERSION} - && defined *{${$$pack}{VERSION}}{SCALAR}; - return ++$is_class_loaded_cache{$class} if exists ${$$pack}{ISA} - && defined *{${$$pack}{ISA}}{ARRAY}; - - # check for any method - foreach ( keys %{$$pack} ) { - next if substr($_, -2, 2) eq '::'; - return ++$is_class_loaded_cache{$class} if defined *{${$$pack}{$_}}{CODE}; - } - - # fail - return 0; -} - -sub class_of { - return Mouse::Meta::Class::class_of($_[0]); -} - 1; __END__ @@ -509,6 +457,8 @@ Yappo wu-lee +Goro Fuji (gfx) C<< >> + with plenty of code borrowed from L and L =head1 BUGS