X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=c6a7a2a32dad901bd344ace39efa86485854fb73;hb=e5f31f1f0660e9c8b0f8f55b181f0edb55b650fb;hp=2dad7f7e0c92f08d5955f0c0251eaf61ae948b47;hpb=2a674d232b1060884cceddaa23be19aa7b335a33;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 2dad7f7..c6a7a2a 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -3,14 +3,16 @@ package Mouse; use strict; use warnings; -our $VERSION = '0.01'; +our $VERSION = '0.05'; +use 5.006; use Sub::Exporter; use Carp 'confess'; use Scalar::Util 'blessed'; +use Class::Method::Modifiers (); -use Mouse::Attribute; -use Mouse::Class; +use Mouse::Meta::Attribute; +use Mouse::Meta::Class; use Mouse::Object; use Mouse::TypeRegistry; @@ -19,7 +21,7 @@ do { my %exports = ( meta => sub { - my $meta = Mouse::Class->initialize($CALLER); + my $meta = Mouse::Meta::Class->initialize($CALLER); return sub { $meta }; }, @@ -37,7 +39,12 @@ do { $names = [$names] if !ref($names); for my $name (@$names) { - Mouse::Attribute->create($package, $name, @_); + if ($name =~ s/^\+//) { + Mouse::Meta::Attribute->clone_parent($package, $name, @_); + } + else { + Mouse::Meta::Attribute->create($package, $name, @_); + } } }; }, @@ -49,6 +56,32 @@ do { blessed => sub { return \&blessed; }, + + before => sub { + return \&Class::Method::Modifiers::before; + }, + + after => sub { + return \&Class::Method::Modifiers::after; + }, + + around => sub { + return \&Class::Method::Modifiers::around; + }, + + with => sub { + my $caller = $CALLER; + + return sub { + my $role = shift; + my $class = $caller->meta; + + confess "Mouse::Role only supports 'with' on individual roles at a time" if @_; + + Mouse::load_class($role); + $role->meta->apply_to_class($class); + }; + }, ); my $exporter = Sub::Exporter::build_exporter({ @@ -62,7 +95,7 @@ do { strict->import; warnings->import; - my $meta = Mouse::Class->initialize($CALLER); + my $meta = Mouse::Meta::Class->initialize($CALLER); $meta->superclasses('Mouse::Object') unless $meta->superclasses; @@ -83,6 +116,11 @@ do { sub load_class { my $class = shift; + if (ref($class) || !defined($class) || !length($class)) { + my $display = defined($class) ? $class : 'undef'; + confess "Invalid class name ($display)"; + } + return 1 if is_class_loaded($class); (my $file = "$class.pm") =~ s{::}{/}g; @@ -96,12 +134,30 @@ sub load_class { sub is_class_loaded { my $class = shift; - no strict 'refs'; - return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"}; - foreach my $symbol (keys %{"${class}::"}) { - next if substr($symbol, -2, 2) eq '::'; - return 1 if defined &{"${class}::${symbol}"}; + return 0 if ref($class) || !defined($class) || !length($class); + + # walk the symbol table tree to avoid autovififying + # \*{${main::}{"Foo::"}} == \*main::Foo:: + + my $pack = \*::; + foreach my $part (split('::', $class)) { + return 0 unless exists ${$$pack}{"${part}::"}; + $pack = \*{${$$pack}{"${part}::"}}; + } + + # check for $VERSION or @ISA + return 1 if exists ${$$pack}{VERSION} + && defined *{${$$pack}{VERSION}}{SCALAR}; + return 1 if exists ${$$pack}{ISA} + && defined *{${$$pack}{ISA}}{ARRAY}; + + # check for any method + foreach ( keys %{$$pack} ) { + next if substr($_, -2, 2) eq '::'; + return 1 if defined *{${$$pack}{$_}}{CODE}; } + + # fail return 0; } @@ -111,11 +167,7 @@ __END__ =head1 NAME -Mouse - Moose minus antlers - -=head1 VERSION - -Version 0.01 released ??? +Mouse - Moose minus the antlers =head1 SYNOPSIS @@ -138,18 +190,66 @@ Version 0.01 released ??? has 'z' => (is => 'rw', isa => 'Int'); - #after 'clear' => sub { - # my $self = shift; - # $self->z(0); - #}; + after 'clear' => sub { + my $self = shift; + $self->z(0); + }; =head1 DESCRIPTION -Moose. +L is wonderful. + +Unfortunately, it's a little slow. Though significant progress has been made +over the years, the compile time penalty is a non-starter for some +applications. + +Mouse aims to alleviate this by providing a subset of Moose's +functionality, faster. In particular, L is missing only a few +expert-level features. + +=head2 MOOSE COMPAT + +Compatibility with Moose has been the utmost concern. Fewer than 1% of the +tests fail when run against Moose instead of Mouse. Mouse code coverage is also +over 99%. Even the error messages are taken from Moose. The Mouse code just +runs the test suite 3x-4x faster. + +The idea is that, if you need the extra power, you should be able to run +C on your codebase and have nothing break. To that end, +nothingmuch has written L (part of this distribution) which will act +as Mouse unless Moose is loaded, in which case it will act as Moose. + +Mouse also has the blessings of Moose's author, stevan. + +=head2 MISSING FEATURES + +=head3 Roles + +Fixing this one slightly less soon. stevan has suggested an implementation +strategy. Mouse currently mostly ignores methods. + +=head3 Complex types + +User-defined type constraints and parameterized types may be implemented. Type +coercions probably not (patches welcome). + +=head3 Bootstrapped meta world + +Very handy for extensions to the MOP. Not pressing, but would be nice to have. + +=head3 Modification of attribute metaclass + +When you declare an attribute with L, you get the inlined accessors +installed immediately. Modifying the attribute metaclass, even if possible, +does nothing. -=head1 INTERFACE +=head3 Lots more.. -=head2 meta -> Mouse::Class +MouseX? + +=head1 KEYWORDS + +=head2 meta -> Mouse::Meta::Class Returns this class' metaclass instance. @@ -157,10 +257,105 @@ Returns this class' metaclass instance. Sets this class' superclasses. +=head2 before (method|methods) => Code + +Installs a "before" method modifier. See L or +L. + +=head2 after (method|methods) => Code + +Installs an "after" method modifier. See L or +L. + +=head2 around (method|methods) => Code + +Installs an "around" method modifier. See L or +L. + =head2 has (name|names) => parameters Adds an attribute (or if passed an arrayref of names, multiple attributes) to -this class. +this class. Options: + +=over 4 + +=item is => ro|rw + +If specified, inlines a read-only/read-write accessor with the same name as +the attribute. + +=item isa => TypeConstraint + +Provides basic type checking in the constructor and accessor. Basic types such +as C, C, C are supported. Any unknown type is taken to +be a class check (e.g. isa => 'DateTime' would accept only L +objects). + +=item required => 0|1 + +Whether this attribute is required to have a value. If the attribute is lazy or +has a builder, then providing a value for the attribute in the constructor is +optional. + +=item init_arg => Str + +Allows you to use a different key name in the constructor. + +=item default => Value | CodeRef + +Sets the default value of the attribute. If the default is a coderef, it will +be invoked to get the default value. Due to quirks of Perl, any bare reference +is forbidden, you must wrap the reference in a coderef. Otherwise, all +instances will share the same reference. + +=item lazy => 0|1 + +If specified, the default is calculated on demand instead of in the +constructor. + +=item predicate => Str + +Lets you specify a method name for installing a predicate method, which checks +that the attribute has a value. It will not invoke a lazy default or builder +method. + +=item clearer => Str + +Lets you specify a method name for installing a clearer method, which clears +the attribute's value from the instance. On the next read, lazy or builder will +be invoked. + +=item handles => HashRef|ArrayRef + +Lets you specify methods to delegate to the attribute. ArrayRef forwards the +given method names to method calls on the attribute. HashRef maps local method +names to remote method names called on the attribute. Other forms of +L, such as regular expression and coderef, are not yet supported. + +=item weak_ref => 0|1 + +Lets you automatically weaken any reference stored in the attribute. + +=item trigger => Coderef + +Any time the attribute's value is set (either through the accessor or the +constructor), the trigger is called on it. The trigger receives as arguments +the instance, the new value, and the attribute instance. + +=item builder => Str + +Defines a method name to be called to provide the default value of the +attribute. C<< builder => 'build_foo' >> is mostly equivalent to +C<< default => sub { $_[0]->build_foo } >>. + +=item auto_deref => 0|1 + +Allows you to automatically dereference ArrayRef and HashRef attributes in list +context. In scalar context, the reference is returned (NOT the list length or +bucket status). You must specify an appropriate type constraint to use +auto_deref. + +=back =head2 confess error -> BOOM @@ -179,8 +374,8 @@ You may use L to replace the superclass list. =head2 unimport -Please unimport Mouse so that if someone calls one of the keywords (such as -L) it will break loudly instead breaking subtly. +Please unimport Mouse (C) so that if someone calls one of the +keywords (such as L) it will break loudly instead breaking subtly. =head1 FUNCTIONS @@ -190,10 +385,18 @@ This will load a given C (or die if it's not loadable). This function can be used in place of tricks like C or using C. +=head2 is_class_loaded Class::Name -> Bool + +Returns whether this class is actually loaded or not. It uses a heuristic which +involves checking for the existence of C<$VERSION>, C<@ISA>, and any +locally-defined method. + =head1 AUTHOR Shawn M Moore, C<< >> +with plenty of code borrowed from L and L + =head1 BUGS No known bugs.