X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=a766981cd4969c4e8059f6e3471072b86a960f4e;hb=6a7756cc831fa21bc28b924a8edbaeeb28a4a66b;hp=80756cd0e7d4988dd7c39355744577f7165c033a;hpb=4b58033d236a709a6b3ce901f29f601801329476;p=gitmo%2FMouse.git diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 80756cd..a766981 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,16 +134,15 @@ sub generate_can_predicate_for { package Mouse::Util::TypeConstraints; -use Scalar::Util qw(blessed looks_like_number openhandle); 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]) } -sub Num { looks_like_number($_[0]) } +sub Num { Scalar::Util::looks_like_number($_[0]) } sub Str { # We need to use a copy here to flatten MAGICs, for instance as in # Str( substr($_, 0, 42) ). @@ -168,10 +167,12 @@ sub RegexpRef { ref($_[0]) eq 'Regexp' } sub GlobRef { ref($_[0]) eq 'GLOB' } sub FileHandle { - return openhandle($_[0]) || (blessed($_[0]) && $_[0]->isa("IO::Handle")) + my($value) = @_; + return Scalar::Util::openhandle($value) + || (Scalar::Util::blessed($value) && $value->isa("IO::Handle")) } -sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } +sub Object { Scalar::Util::blessed($_[0]) && ref($_[0]) ne 'Regexp' } sub ClassName { Mouse::Util::is_class_loaded($_[0]) } sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') } @@ -309,7 +310,7 @@ sub clone_object { my $object = shift; my $args = $object->Mouse::Object::BUILDARGS(@_); - (blessed($object) && $object->isa($class->name)) + (Scalar::Util::blessed($object) && $object->isa($class->name)) || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)"); my $cloned = bless { %$object }, ref $object; @@ -532,7 +533,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)"); @@ -743,7 +744,7 @@ Mouse::PurePerl - A Mouse guts in pure Perl =head1 VERSION -This document describes Mouse version 0.73 +This document describes Mouse version 0.78 =head1 SEE ALSO