X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=1f77bf0ce8fe389447b7a5f2f932636cfd2f8198;hp=470fbd73e8f2eacef59460b2b0389b8d77ec3600;hb=aff73a9e6d34b45a21123586c0893921df98181b;hpb=e058b279f94cfd76ca59d7972209e1b346492db9 diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 470fbd7..1f77bf0 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -18,15 +18,20 @@ sub is_class_loaded { return 0 if ref($class) || !defined($class) || !length($class); # walk the symbol table tree to avoid autovififying - # \*{${main::}{"Foo::"}} == \*main::Foo:: + # \*{${main::}{"Foo::"}{"Bar::"}} == \*main::Foo::Bar:: my $pack = \%::; foreach my $part (split('::', $class)) { - my $entry = \$pack->{$part . '::'}; + $part .= '::'; + return 0 if !exists $pack->{$part}; + + my $entry = \$pack->{$part}; return 0 if ref($entry) ne 'GLOB'; - $pack = *{$entry}{HASH} or return 0; + $pack = *{$entry}{HASH}; } + return 0 if !%{$pack}; + # check for $VERSION or @ISA return 1 if exists $pack->{VERSION} && defined *{$pack->{VERSION}}{SCALAR} && defined ${ $pack->{VERSION} }; @@ -199,7 +204,6 @@ sub add_method { return; } - package Mouse::Meta::Class; @@ -223,6 +227,16 @@ sub get_all_attributes { return values %attrs; } +sub new_object { + my $self = shift; + my %args = (@_ == 1 ? %{$_[0]} : @_); + + my $object = bless {}, $self->name; + + $self->_initialize_object($object, \%args); + return $object; +} + sub _initialize_object{ my($self, $object, $args, $ignore_triggers) = @_; @@ -482,7 +496,7 @@ Mouse::PurePerl - A Mouse guts in pure Perl =head1 VERSION -This document describes Mouse version 0.40_06 +This document describes Mouse version 0.43 =head1 SEE ALSO