X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse.pm;h=a12c4a94e9d0198e03706ec36583326f8060a62e;hp=e3378a63537d8854444a283f6e39e6de09f4637e;hb=0126c27c413cb63f67e66e09b0fdfeb92117503a;hpb=f3bb863f6a6ef09220bbf51bc4cea3874d862776 diff --git a/lib/Mouse.pm b/lib/Mouse.pm index e3378a6..a12c4a9 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -1,17 +1,14 @@ package Mouse; use 5.006_002; -use strict; -use warnings; +use Mouse::Exporter; # enables strict and warnings -our $VERSION = '0.33_01'; +our $VERSION = '0.37_04'; -use Exporter; +use Carp qw(confess); +use Scalar::Util qw(blessed); -use Carp 'confess'; -use Scalar::Util 'blessed'; - -use Mouse::Util qw(load_class is_class_loaded not_supported); +use Mouse::Util qw(load_class is_class_loaded get_code_package not_supported); use Mouse::Meta::Module; use Mouse::Meta::Class; @@ -20,28 +17,38 @@ use Mouse::Meta::Attribute; use Mouse::Object; use Mouse::Util::TypeConstraints (); -our @ISA = qw(Exporter); +Mouse::Exporter->setup_import_methods( + as_is => [qw( + extends with + has + before after around + override super + augment inner + ), + \&Scalar::Util::blessed, + \&Carp::confess, + ], +); +# XXX: for backward compatibility our @EXPORT = qw( extends with has before after around override super augment inner - blessed confess ); -our %is_removable = map{ $_ => undef } @EXPORT; -delete $is_removable{blessed}; -delete $is_removable{confess}; - sub extends { Mouse::Meta::Class->initialize(scalar caller)->superclasses(@_) } sub has { my $meta = Mouse::Meta::Class->initialize(scalar caller); my $name = shift; + $meta->throw_error(q{Usage: has 'name' => ( key => value, ... )}) + if @_ % 2; # odd number of arguments + $meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name; } @@ -86,31 +93,36 @@ our @SUPER_ARGS; sub super { # This check avoids a recursion loop - see # t/100_bugs/020_super_recursion.t - return if defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller(); - return unless $SUPER_BODY; $SUPER_BODY->(@SUPER_ARGS); + return if defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller(); + return if !defined $SUPER_BODY; + $SUPER_BODY->(@SUPER_ARGS); } sub override { - my $meta = Mouse::Meta::Class->initialize(caller); - my $pkg = $meta->name; - - my $name = shift; - my $code = shift; - - my $body = $pkg->can($name) - or confess "You cannot override '$name' because it has no super method"; + # my($name, $method) = @_; + Mouse::Meta::Class->initialize(scalar caller)->add_override_method_modifier(@_); +} - $meta->add_method($name => sub { - local $SUPER_PACKAGE = $pkg; - local @SUPER_ARGS = @_; - local $SUPER_BODY = $body; +our %INNER_BODY; +our %INNER_ARGS; - $code->(@_); - }); +sub inner { + my $pkg = caller(); + if ( my $body = $INNER_BODY{$pkg} ) { + my $args = $INNER_ARGS{$pkg}; + local $INNER_ARGS{$pkg}; + local $INNER_BODY{$pkg}; + return $body->(@{$args}); + } + else { + return; + } } -sub inner { not_supported } -sub augment{ not_supported } +sub augment { + #my($name, $method) = @_; + Mouse::Meta::Class->initialize(scalar caller)->add_augment_method_modifier(@_); +} sub init_meta { shift; @@ -121,9 +133,6 @@ sub init_meta { my $base_class = $args{base_class} || 'Mouse::Object'; my $metaclass = $args{metaclass} || 'Mouse::Meta::Class'; - confess("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.") - unless $metaclass->isa('Mouse::Meta::Class'); - # make a subtype for each Mouse class Mouse::Util::TypeConstraints::class_type($class) unless Mouse::Util::TypeConstraints::find_type_constraint($class); @@ -140,65 +149,8 @@ sub init_meta { return $meta; } -sub import { - my $class = shift; - - strict->import; - warnings->import; - - my $opts = do { - if (ref($_[0]) && ref($_[0]) eq 'HASH') { - shift @_; - } else { - +{ }; - } - }; - my $level = delete $opts->{into_level}; - $level = 0 unless defined $level; - my $caller = caller($level); - - # we should never export to main - if ($caller eq 'main') { - warn qq{$class does not export its sugar to the 'main' package.\n}; - return; - } - - $class->init_meta( - for_class => $caller, - ); - - if (@_) { - __PACKAGE__->export_to_level( $level+1, $class, @_); - } else { - # shortcut for the common case of no type character - no strict 'refs'; - for my $keyword (@EXPORT) { - *{ $caller . '::' . $keyword } = *{__PACKAGE__ . '::' . $keyword}; - } - } -} - -sub unimport { - my $caller = caller; - - my $stash = do{ - no strict 'refs'; - \%{$caller . '::'} - }; - - for my $keyword (@EXPORT) { - my $code; - if(exists $is_removable{$keyword} - && ($code = $caller->can($keyword)) - && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){ - - delete $stash->{$keyword}; - } - } -} 1; - __END__ =head1 NAME @@ -275,12 +227,6 @@ should upgrade to Moose. We don't need two parallel sets of extensions! If you really must write a Mouse extension, please contact the Moose mailing list or #moose on IRC beforehand. -=head2 Maintenance - -The original author of this module has mostly stepped down from maintaining -Mouse. See L. -If you would like to help maintain this module, please get in touch with us. - =head1 KEYWORDS =head2 C<< $object->meta -> Mouse::Meta::Class >> @@ -454,9 +400,9 @@ L =head1 AUTHORS -Shawn M Moore, C<< >> +Shawn M Moore, Esartak at gmail.comE -Yuval Kogman, C<< >> +Yuval Kogman, Enothingmuch at woobling.orgE tokuhirom @@ -464,7 +410,7 @@ Yappo wu-lee -Goro Fuji (gfx) C<< >> +Goro Fuji (gfx) Egfuji at cpan.orgE with plenty of code borrowed from L and L