X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse.pm;h=bff08e5594e8a87ef9dd7a78b60f46825ffd832b;hp=c07b20094fdb36e46435bc1fbf12594ddfb7d9bf;hb=2b68f76d78d96325821e9a6360c3639f8c5637df;hpb=1820fffecb0bd1da64edc16ecde534178b841d14 diff --git a/lib/Mouse.pm b/lib/Mouse.pm index c07b200..bff08e5 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 -use base 'Exporter'; +our $VERSION = '0.40_03'; -our $VERSION = '0.33_01'; +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,26 +17,38 @@ use Mouse::Meta::Attribute; use Mouse::Object; use Mouse::Util::TypeConstraints (); +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; } @@ -84,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; @@ -116,16 +130,10 @@ sub init_meta { my $class = $args{for_class} or confess("Cannot call init_meta without specifying a for_class"); + 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); - my $meta = $metaclass->initialize($class); $meta->add_method(meta => sub{ @@ -135,74 +143,25 @@ sub init_meta { $meta->superclasses($base_class) unless $meta->superclasses; - 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, - ); + # make a class type for each Mouse class + Mouse::Util::TypeConstraints::class_type($class) + unless Mouse::Util::TypeConstraints::find_type_constraint($class); - 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}; - } - } + return $meta; } -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 Mouse - Moose minus the antlers +=head1 VERSION + +This document describes Mouse version 0.40_03 + =head1 SYNOPSIS package Point; @@ -243,9 +202,8 @@ latter, if possible. Mouse aims to alleviate this by providing a subset of Moose's functionality, faster. -We're also going as light on dependencies as possible. -L or L is required -if you want support for L, L, and L. +We're also going as light on dependencies as possible. Mouse currently has +B except for testing modules. =head2 MOOSE COMPATIBILITY @@ -265,6 +223,8 @@ Moose, if you run into weird errors, it would be worth running: to see if the bug is caused by Mouse. Moose's diagnostics and validation are also much better. +See also L for compatibility and incompatibility with Moose. + =head2 MouseX Please don't copy MooseX code to MouseX. If you need extensions, you really @@ -273,12 +233,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 >> @@ -446,15 +400,17 @@ Perl 5.6.2 or later. =head1 SEE ALSO +L + L L =head1 AUTHORS -Shawn M Moore, C<< >> +Shawn M Moore, Esartak at gmail.comE -Yuval Kogman, C<< >> +Yuval Kogman, Enothingmuch at woobling.orgE tokuhirom @@ -462,7 +418,7 @@ Yappo wu-lee -Goro Fuji (gfx) C<< >> +Goro Fuji (gfx) Egfuji at cpan.orgE with plenty of code borrowed from L and L