package Mouse;
use 5.006_002;
-use strict;
-use warnings;
+use Mouse::Exporter; # enables strict and warnings
-use base 'Exporter';
+our $VERSION = '0.40_09';
-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;
use Mouse::Object;
use Mouse::Util::TypeConstraints ();
-our @EXPORT = qw(
- extends with
- has
- before after around
- override super
- augment inner
-
- blessed confess
+Mouse::Exporter->setup_import_methods(
+ as_is => [qw(
+ extends with
+ has
+ before after around
+ override super
+ augment inner
+ ),
+ \&Scalar::Util::blessed,
+ \&Carp::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 extends {
+ Mouse::Meta::Class->initialize(scalar caller)->superclasses(@_);
+ return;
+}
+
+sub with {
+ Mouse::Util::apply_all_roles(scalar(caller), @_);
+ return;
+}
sub has {
my $meta = Mouse::Meta::Class->initialize(scalar caller);
my $name = shift;
- $meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name;
+ $meta->throw_error(q{Usage: has 'name' => ( key => value, ... )})
+ if @_ % 2; # odd number of arguments
+
+ if(ref $name){ # has [qw(foo bar)] => (...)
+ for (@{$name}){
+ $meta->add_attribute($_ => @_);
+ }
+ }
+ else{ # has foo => (...)
+ $meta->add_attribute($name => @_);
+ }
+ return;
}
sub before {
for (@_) {
$meta->add_before_method_modifier($_ => $code);
}
+ return;
}
sub after {
for (@_) {
$meta->add_after_method_modifier($_ => $code);
}
+ return;
}
sub around {
for (@_) {
$meta->add_around_method_modifier($_ => $code);
}
-}
-
-sub with {
- Mouse::Util::apply_all_roles(scalar(caller), @_);
+ return;
}
our $SUPER_PACKAGE;
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(@_);
+ return;
+}
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,
- );
-
- 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__){
+ # make a class type for each Mouse class
+ Mouse::Util::TypeConstraints::class_type($class)
+ unless Mouse::Util::TypeConstraints::find_type_constraint($class);
- delete $stash->{$keyword};
- }
- }
+ return $meta;
}
1;
-
__END__
=head1 NAME
Mouse - Moose minus the antlers
+=head1 VERSION
+
+This document describes Mouse version 0.40_09
+
=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 >>
=head2 C<< before (method|methods) => CodeRef >>
-Installs a "before" method modifier. See L<Moose/before> or
-L<Class::Method::Modifiers/before>.
-
-Use of this feature requires L<Class::Method::Modifiers>!
+Installs a "before" method modifier. See L<Moose/before>.
=head2 C<< after (method|methods) => CodeRef >>
-Installs an "after" method modifier. See L<Moose/after> or
-L<Class::Method::Modifiers/after>.
-
-Use of this feature requires L<Class::Method::Modifiers>!
-
+Installs an "after" method modifier. See L<Moose/after>.
=head2 C<< around (method|methods) => CodeRef >>
-Installs an "around" method modifier. See L<Moose/around> or
-L<Class::Method::Modifiers/around>.
-
-Use of this feature requires L<Class::Method::Modifiers>!
-
+Installs an "around" method modifier. See L<Moose/around>.
=head2 C<< has (name|names) => parameters >>
Adds an attribute (or if passed an arrayref of names, multiple attributes) to
We have a public git repository:
- git clone git://jules.scsys.co.uk/gitmo/Mouse.git
+ git clone git://git.moose.perl.org/Mouse.git
=head1 DEPENDENCIES
=head1 SEE ALSO
+L<Mouse::Spec>
+
L<Moose>
+L<Moose::Manual>
+
+L<Moose::Cookbook>
+
L<Class::MOP>
=head1 AUTHORS
-Shawn M Moore, C<< <sartak at gmail.com> >>
+Shawn M Moore E<lt>sartak at gmail.comE<gt>
-Yuval Kogman, C<< <nothingmuch at woobling.org> >>
+Yuval Kogman E<lt>nothingmuch at woobling.orgE<gt>
tokuhirom
wu-lee
-Goro Fuji (gfx) C<< <gfuji at cpan.org> >>
+Goro Fuji (gfx) E<lt>gfuji at cpan.orgE<gt>
with plenty of code borrowed from L<Class::MOP> and L<Moose>
projects / gitmo/Mouse.git / blobdiff