X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=e6719136e90371256332a110661f9cc218fa7d4e;hb=999072aba606906b12c2f18e0ebde72e224de4dc;hp=203319847d8c366706b843fbcf023f97b1653c0e;hpb=32ec255c44d36d63cce20f5e21386d5cd11396b9;p=gitmo%2FMouse.git diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 2033198..e671913 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -5,11 +5,11 @@ use strict; use warnings; use warnings FATAL => 'redefine'; # to avoid to load Mouse::PurePerl twice +use Scalar::Util (); use B (); require Mouse::Util; - # taken from Class/MOP.pm sub is_valid_class_name { my $class = shift; @@ -134,12 +134,11 @@ sub generate_can_predicate_for { package Mouse::Util::TypeConstraints; -use Scalar::Util (); sub Any { 1 } sub Item { 1 } -sub Bool { $_[0] ? $_[0] eq '1' : 1 } +sub Bool { !$_[0] || $_[0] eq '1' } sub Undef { !defined($_[0]) } sub Defined { defined($_[0]) } sub Value { defined($_[0]) && !ref($_[0]) } @@ -340,6 +339,12 @@ sub is_immutable { $_[0]->{is_immutable} } sub strict_constructor; *strict_constructor = $generate_class_accessor->('strict_constructor'); +sub _invalidate_metaclass_cache { + my($self) = @_; + delete $self->{_mouse_cache}; + return; +} + sub _report_unknown_args { my($metaclass, $attrs, $args) = @_; @@ -534,7 +539,7 @@ sub _process_options{ if(defined $tc){ # both isa and does supplied my $does_ok = do{ local $@; - eval{ "$tc"->does($args) }; + eval{ "$tc"->does($args->{does}) }; }; if(!$does_ok){ $class->throw_error("Cannot have both an isa option and a does option because '$tc' does not do '$args->{does}' on attribute ($name)"); @@ -745,7 +750,7 @@ Mouse::PurePerl - A Mouse guts in pure Perl =head1 VERSION -This document describes Mouse version 0.75 +This document describes Mouse version 0.82 =head1 SEE ALSO