Keep track of the instantiated metaclass in associated_class, use the MOP better...
[gitmo/Mouse.git] / lib / Mouse.pm
index 3136d35..c6013e9 100644 (file)
@@ -3,11 +3,13 @@ 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::Meta::Attribute;
 use Mouse::Meta::Class;
@@ -31,13 +33,21 @@ do {
         },
 
         has => sub {
+            my $caller = $CALLER;
+
             return sub {
-                my $package = caller;
+                my $meta = $caller->meta;
+
                 my $names = shift;
                 $names = [$names] if !ref($names);
 
                 for my $name (@$names) {
-                    Mouse::Meta::Attribute->create($package, $name, @_);
+                    if ($name =~ s/^\+//) {
+                        Mouse::Meta::Attribute->clone_parent($meta, $name, @_);
+                    }
+                    else {
+                        Mouse::Meta::Attribute->create($meta, $name, @_);
+                    }
                 }
             };
         },
@@ -49,6 +59,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($class);
+            };
+        },
     );
 
     my $exporter = Sub::Exporter::build_exporter({
@@ -82,8 +118,11 @@ do {
 
 sub load_class {
     my $class = shift;
-    return if ref($class);
-    return unless defined($class) && length($class);
+
+    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);
 
@@ -98,12 +137,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;
 }
 
@@ -113,11 +170,7 @@ __END__
 
 =head1 NAME
 
-Mouse - Moose minus antlers
-
-=head1 VERSION
-
-Version 0.01 released ???
+Mouse - Moose minus the antlers
 
 =head1 SYNOPSIS
 
@@ -140,16 +193,64 @@ 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<Moose> 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<Moose/has> 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<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
+nothingmuch has written L<Squirrel> (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
 
-=head1 INTERFACE
+When you declare an attribute with L</has>, you get the inlined accessors
+installed immediately. Modifying the attribute metaclass, even if possible,
+does nothing.
+
+=head3 Lots more..
+
+MouseX?
+
+=head1 KEYWORDS
 
 =head2 meta -> Mouse::Meta::Class
 
@@ -159,10 +260,114 @@ Returns this class' metaclass instance.
 
 Sets this class' superclasses.
 
+=head2 before (method|methods) => Code
+
+Installs a "before" method modifier. See L<Moose/before> or
+L<Class::Method::Modifiers/before>.
+
+=head2 after (method|methods) => Code
+
+Installs an "after" method modifier. See L<Moose/after> or
+L<Class::Method::Modifiers/after>.
+
+=head2 around (method|methods) => Code
+
+Installs an "around" method modifier. See L<Moose/around> or
+L<Class::Method::Modifiers/around>.
+
 =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<Int>, C<ArrayRef>, C<Defined> are supported. Any unknown type is taken to
+be a class check (e.g. isa => 'DateTime' would accept only L<DateTime>
+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</handles>, 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 | HashRef
+
+Triggers are like method modifiers for setting attribute values. You can have
+a "before" and an "after" trigger, each of which receive as arguments the instance, the new value, and the attribute metaclass. Historically, triggers have
+only been "after" modifiers, so if you use a coderef for the C<trigger> option,
+it will maintain that compatibility. Like method modifiers, you can't really
+affect the act of setting the attribute value, and the return values of the 
+modifiers are ignored.
+
+There's also an "around" trigger which you can use to change the value that
+is being set on the attribute, or even prevent the attribute from being
+updated. The around trigger receives as arguments a code reference to invoke
+to set the attribute's value (which expects as arguments the instance and
+the new value), the instance, the new value, and the attribute metaclass.
+
+=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
 
@@ -181,8 +386,8 @@ You may use L</extends> to replace the superclass list.
 
 =head2 unimport
 
-Please unimport Mouse so that if someone calls one of the keywords (such as
-L</extends>) it will break loudly instead breaking subtly.
+Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
+keywords (such as L</extends>) it will break loudly instead breaking subtly.
 
 =head1 FUNCTIONS
 
@@ -192,10 +397,18 @@ This will load a given C<Class::Name> (or die if it's not loadable).
 This function can be used in place of tricks like
 C<eval "use $module"> or using C<require>.
 
+=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<< <sartak at gmail.com> >>
 
+with plenty of code borrowed from L<Class::MOP> and L<Moose>
+
 =head1 BUGS
 
 No known bugs.