package Mouse;
use 5.006_002;
-use strict;
-use warnings;
+use Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.37_02';
+our $VERSION = '0.40_07';
-use Exporter;
-
-use Carp 'confess';
-use Scalar::Util 'blessed';
+use Carp qw(confess);
+use Scalar::Util qw(blessed);
use Mouse::Util qw(load_class is_class_loaded get_code_package not_supported);
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, ... )})\r
+ if @_ % 2; # odd number of arguments
+
$meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name;
}
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;
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{
$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))
- && get_code_package($code) eq __PACKAGE__){
-
- delete $stash->{$keyword};
- }
- }
-}
1;
-
__END__
=head1 NAME
Mouse - Moose minus the antlers
+=head1 VERSION
+
+This document describes Mouse version 0.40_07
+
=head1 SYNOPSIS
package Point;
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<Class::Method::Modifiers::Fast> or L<Class::Method::Modifiers> is required
-if you want support for L</before>, L</after>, and L</around>.
+We're also going as light on dependencies as possible. Mouse currently has
+B<no dependencies> except for testing modules.
=head2 MOOSE COMPATIBILITY
to see if the bug is caused by Mouse. Moose's diagnostics and validation are
also much better.
+See also L<Mouse::Spec> for compatibility and incompatibility with Moose.
+
=head2 MouseX
Please don't copy MooseX code to MouseX. If you need extensions, you really
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<http://www.nntp.perl.org/group/perl.moose/2009/04/msg653.html>.
-If you would like to help maintain this module, please get in touch with us.
-
=head1 KEYWORDS
=head2 C<< $object->meta -> Mouse::Meta::Class >>
=head1 SEE ALSO
+L<Mouse::Spec>
+
L<Moose>
L<Class::MOP>
=head1 AUTHORS
-Shawn M Moore, E<lt>sartak at gmail.comE<gt>
+Shawn M Moore E<lt>sartak at gmail.comE<gt>
-Yuval Kogman, E<lt>nothingmuch at woobling.orgE<gt>
+Yuval Kogman E<lt>nothingmuch at woobling.orgE<gt>
tokuhirom