Removing the use of UNIVERSAL::require
[gitmo/Moose.git] / lib / Moose.pm
index a3cc118..8f6d75e 100644 (file)
@@ -4,13 +4,13 @@ package Moose;
 use strict;
 use warnings;
 
-our $VERSION = '0.05';
+our $VERSION = '0.13';
 
 use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
 use Sub::Name    'subname';
+use B            'svref_2object';
 
-use UNIVERSAL::require;
 use Sub::Exporter;
 
 use Class::MOP;
@@ -19,18 +19,17 @@ use Moose::Meta::Class;
 use Moose::Meta::TypeConstraint;
 use Moose::Meta::TypeCoercion;
 use Moose::Meta::Attribute;
+use Moose::Meta::Instance;
 
 use Moose::Object;
 use Moose::Util::TypeConstraints;
 
 {
-    my ( $CALLER, %METAS );
+    my $CALLER;
 
-    sub _find_meta {
+    sub _init_meta {
         my $class = $CALLER;
 
-        return $METAS{$class} if exists $METAS{$class};
-
         # make a subtype for each Moose class
         subtype $class
             => as 'Object'
@@ -39,101 +38,132 @@ use Moose::Util::TypeConstraints;
 
         my $meta;
         if ($class->can('meta')) {
+            # NOTE:
+            # this is the case where the metaclass pragma 
+            # was used before the 'use Moose' statement to 
+            # override a specific class
             $meta = $class->meta();
             (blessed($meta) && $meta->isa('Moose::Meta::Class'))
-                || confess "Whoops, not møøsey enough";
+                || confess "You already have a &meta function, but it does not return a Moose::Meta::Class";
         }
         else {
-            $meta = Moose::Meta::Class->initialize($class => (
-                ':attribute_metaclass' => 'Moose::Meta::Attribute'
-            ));
+            # NOTE:
+            # this is broken currently, we actually need 
+            # to allow the possiblity of an inherited 
+            # meta, which will not be visible until the 
+            # user 'extends' first. This needs to have 
+            # more intelligence to it 
+            $meta = Moose::Meta::Class->initialize($class);
             $meta->add_method('meta' => sub {
                 # re-initialize so it inherits properly
-                Moose::Meta::Class->initialize($class => (
-                    ':attribute_metaclass' => 'Moose::Meta::Attribute'
-                ));
+                Moose::Meta::Class->initialize(blessed($_[0]) || $_[0]);
             })
         }
 
         # make sure they inherit from Moose::Object
         $meta->superclasses('Moose::Object')
            unless $meta->superclasses();
-
-        return $METAS{$class} = $meta;
     }
 
     my %exports = (
         extends => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::extends' => sub {
+            my $class = $CALLER;
+            return subname 'Moose::extends' => sub (@) {
+                confess "Must derive at least one class" unless @_;
                 _load_all_classes(@_);
-                $meta->superclasses(@_)
+                # this checks the metaclass to make sure 
+                # it is correct, sometimes it can get out 
+                # of sync when the classes are being built
+                my $meta = $class->meta->_fix_metaclass_incompatability(@_);
+                $meta->superclasses(@_);
             };
         },
         with => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::with' => sub {
-                my ($role) = @_;
-                _load_all_classes($role);
-                $role->meta->apply($meta);
+            my $class = $CALLER;
+            return subname 'Moose::with' => sub (@) {
+                my (@roles) = @_;
+                confess "Must specify at least one role" unless @roles;
+                _load_all_classes(@roles);
+                $class->meta->_apply_all_roles(@roles);
             };
         },
         has => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::has' => sub {
-                my ($name, %options) = @_;
-                $meta->add_attribute($name, %options)
+            my $class = $CALLER;
+            return subname 'Moose::has' => sub ($;%) {
+                my ($name, %options) = @_;              
+                $class->meta->_process_attribute($name, %options);
             };
         },
         before => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::before' => sub {
+            my $class = $CALLER;
+            return subname 'Moose::before' => sub (@&) {
                 my $code = pop @_;
+                my $meta = $class->meta;
                 $meta->add_before_method_modifier($_, $code) for @_;
             };
         },
         after => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::after' => sub {
+            my $class = $CALLER;
+            return subname 'Moose::after' => sub (@&) {
                 my $code = pop @_;
+                my $meta = $class->meta;
                 $meta->add_after_method_modifier($_, $code) for @_;
             };
         },
         around => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::around' => sub {
+            my $class = $CALLER;            
+            return subname 'Moose::around' => sub (@&) {
                 my $code = pop @_;
+                my $meta = $class->meta;
                 $meta->add_around_method_modifier($_, $code) for @_;
             };
         },
         super => sub {
-            my $meta = _find_meta();
             return subname 'Moose::super' => sub {};
         },
         override => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::override' => sub {
+            my $class = $CALLER;
+            return subname 'Moose::override' => sub ($&) {
                 my ($name, $method) = @_;
-                $meta->add_override_method_modifier($name => $method);
+                $class->meta->add_override_method_modifier($name => $method);
             };
         },
         inner => sub {
-            my $meta = _find_meta();
             return subname 'Moose::inner' => sub {};
         },
         augment => sub {
-            my $meta = _find_meta();
-            return subname 'Moose::augment' => sub {
+            my $class = $CALLER;
+            return subname 'Moose::augment' => sub (@&) {
                 my ($name, $method) = @_;
-                $meta->add_augment_method_modifier($name => $method);
+                $class->meta->add_augment_method_modifier($name => $method);
             };
         },
+        
+        # NOTE:
+        # this is experimental for now ...
+        self => sub {
+            return subname 'Moose::self' => sub {};
+        },        
+        method => sub {
+            my $class = $CALLER;
+            return subname 'Moose::method' => sub {
+                my ($name, $method) = @_;
+                $class->meta->add_method($name, sub {
+                    my $self = shift;
+                    no strict   'refs';
+                    no warnings 'redefine';
+                    local *{$class->meta->name . '::self'} = sub { $self };
+                    $method->(@_);
+                });
+            };
+        },                
+        
         confess => sub {
             return \&Carp::confess;
         },
         blessed => sub {
             return \&Scalar::Util::blessed;
-        }
+        },
     );
 
     my $exporter = Sub::Exporter::build_exporter({ 
@@ -143,14 +173,41 @@ use Moose::Util::TypeConstraints;
         }
     });
     
-    sub import {
+    sub import {     
         $CALLER = caller();
+        
+        strict->import;
+        warnings->import;        
 
         # we should never export to main
         return if $CALLER eq 'main';
-
+    
+        _init_meta();
+        
         goto $exporter;
-    };
+    }
+    
+    sub unimport {
+        no strict 'refs';        
+        my $class = caller();
+        # loop through the exports ...
+        foreach my $name (keys %exports) {
+            next if $name =~ /inner|super|self/;
+            
+            # if we find one ...
+            if (defined &{$class . '::' . $name}) {
+                my $keyword = \&{$class . '::' . $name};
+                
+                # make sure it is from Moose
+                my $pkg_name = eval { svref_2object($keyword)->GV->STASH->NAME };
+                next if $@;
+                next if $pkg_name ne 'Moose';
+                
+                # and if it is from Moose then undef the slot
+                delete ${$class . '::'}{$name};
+            }
+        }
+    }
 }
 
 ## Utility functions
@@ -161,9 +218,18 @@ sub _load_all_classes {
         # loaded in the symbol table
         next if _is_class_already_loaded($super);
         # otherwise require it ...
-        ($super->require)
-            || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR;
-    }    
+        # NOTE: 
+        # just in case the class we are 
+        # loading has a locally defined
+        # &require, we make sure that we
+        # use the on in UNIVERSAL 
+        my $file = $class . '.pm';
+        $file =~ s{::}{/}g;
+        eval { CORE::require($file) };
+        confess(
+            "Could not load module '$super' because : $@"
+            ) if $@;
+    }
 }
 
 sub _is_class_already_loaded {
@@ -174,7 +240,7 @@ sub _is_class_already_loaded {
                next if substr($_, -2, 2) eq '::';
                return 1 if defined &{"${name}::$_"};
        }
-    return 0;
+       return 0;
 }
 
 1;
@@ -185,15 +251,17 @@ __END__
 
 =head1 NAME
 
-Moose - Moose, it's the new Camel
+Moose - A complete modern object system for Perl 5
 
 =head1 SYNOPSIS
 
   package Point;
+  use strict;
+  use warnings;
   use Moose;
        
-  has 'x' => (isa => 'Int', is => 'rw');
-  has 'y' => (isa => 'Int', is => 'rw');
+  has 'x' => (is => 'rw', isa => 'Int');
+  has 'y' => (is => 'rw', isa => 'Int');
   
   sub clear {
       my $self = shift;
@@ -202,23 +270,32 @@ Moose - Moose, it's the new Camel
   }
   
   package Point3D;
+  use strict;
+  use warnings;  
   use Moose;
   
   extends 'Point';
   
-  has 'z' => (isa => 'Int');
+  has 'z' => (is => 'rw', isa => 'Int');
   
   after 'clear' => sub {
       my $self = shift;
-      $self->{z} = 0;
+      $self->z(0);
   };
   
 =head1 CAVEAT
 
-This is an early release of this module, it still needs 
-some fine tuning and B<lots> more documentation. I am adopting 
-the I<release early and release often> approach with this module, 
-so keep an eye on your favorite CPAN mirror!
+Moose is a rapidly maturing module, and is already being used by 
+a number of people. It's test suite is growing larger by the day, 
+and the docs should soon follow. 
+
+This said, Moose is not yet finished, and should still be considered 
+to be evolving. Much of the outer API is stable, but the internals 
+are still subject to change (although not without serious thought 
+given to it).  
+
+For more details, please refer to the L<FUTURE PLANS> section of 
+this document.
 
 =head1 DESCRIPTION
 
@@ -227,7 +304,7 @@ Moose is an extension of the Perl 5 object system.
 =head2 Another object system!?!?
 
 Yes, I know there has been an explosion recently of new ways to 
-build object's in Perl 5, most of them based on inside-out objects, 
+build object's in Perl 5, most of them based on inside-out objects
 and other such things. Moose is different because it is not a new 
 object system for Perl 5, but instead an extension of the existing 
 object system.
@@ -237,54 +314,39 @@ for Perl 5. This means that Moose not only makes building normal
 Perl 5 objects better, but it also provides the power of metaclass 
 programming.
 
-=head2 What does Moose stand for??
+=head2 Can I use this in production? Or is this just an experiment?
 
-Moose doesn't stand for one thing in particular, however, if you 
-want, here are a few of my favorites, feel free to contribute 
-more :)
+Moose is I<based> on the prototypes and experiments I did for the Perl 6
+meta-model; however Moose is B<NOT> an experiment/prototype, it is 
+for B<real>. I will be deploying Moose into production environments later 
+this year, and I have every intentions of using it as my de facto class 
+builder from now on.
 
-=over 4
+=head2 Is Moose just Perl 6 in Perl 5?
 
-=item Make Other Object Systems Envious
-
-=item Makes Object Orientation So Easy
-
-=item Makes Object Orientation Spiffy- Er  (sorry ingy)
-
-=item Most Other Object Systems Emasculate
-
-=item My Overcraft Overfilled (with) Some Eels
-
-=item Moose Often Ovulate Sorta Early
-
-=item Many Overloaded Object Systems Exists 
-
-=item Moose Offers Often Super Extensions
-
-=item Meta Object Orientation Syntax Extensions
-
-=back
+No. While Moose is very much inspired by Perl 6, it is not itself Perl 6.
+Instead, it is an OO system for Perl 5. I built Moose because I was tired or
+writing the same old boring Perl 5 OO code, and drooling over Perl 6 OO. So
+instead of switching to Ruby, I wrote Moose :)
 
 =head1 BUILDING CLASSES WITH MOOSE
 
-Moose makes every attempt to provide as much convience during class 
-construction/definition, but still stay out of your way if you want 
-it to. Here are some of the features Moose provides:
+Moose makes every attempt to provide as much convenience as possible during
+class construction/definition, but still stay out of your way if you want it
+to. Here are a few items to note when building classes with Moose.
 
 Unless specified with C<extends>, any class which uses Moose will 
 inherit from L<Moose::Object>.
 
 Moose will also manage all attributes (including inherited ones) that 
-are defined with C<has>. And assuming that you call C<new> which is 
+are defined with C<has>. And assuming that you call C<new>, which is 
 inherited from L<Moose::Object>, then this includes properly initializing 
-all instance slots, setting defaults where approprtiate and performing any 
+all instance slots, setting defaults where appropriate, and performing any 
 type constraint checking or coercion. 
 
-For more details, see the ever expanding L<Moose::Cookbook>.
-
 =head1 EXPORTED FUNCTIONS
 
-Moose will export a number of functions into the class's namespace, which 
+Moose will export a number of functions into the class's namespace which 
 can then be used to set up the class. These functions all work directly 
 on the current class.
 
@@ -301,19 +363,19 @@ This function will set the superclass(es) for the current class.
 This approach is recommended instead of C<use base>, because C<use base> 
 actually C<push>es onto the class's C<@ISA>, whereas C<extends> will 
 replace it. This is important to ensure that classes which do not have 
-superclasses properly inherit from L<Moose::Object>.
+superclasses still properly inherit from L<Moose::Object>.
 
-=item B<with ($role)>
+=item B<with (@roles)>
 
-This will apply a given C<$role> to the local class. Role support is 
-currently very experimental, see L<Moose::Role> for more details.
+This will apply a given set of C<@roles> to the local class. Role support 
+is currently under heavy development; see L<Moose::Role> for more details.
 
 =item B<has ($name, %options)>
 
 This will install an attribute of a given C<$name> into the current class. 
-The list of C<%options> are the same as those provided by both 
-L<Class::MOP::Attribute> and L<Moose::Meta::Attribute>, in addition to a 
-few convience ones provided by Moose which are listed below:
+The list of C<%options> are the same as those provided by 
+L<Class::MOP::Attribute>, in addition to the list below which are provided 
+by Moose (L<Moose::Meta::Attribute> to be more specific):
 
 =over 4
 
@@ -324,15 +386,62 @@ only). These will create either a read/write accessor or a read-only
 accessor respectively, using the same name as the C<$name> of the attribute.
 
 If you need more control over how your accessors are named, you can use the 
-I<reader>, I<writer> and I<accessor> options inherited from L<Moose::Meta::Attribute>.
+I<reader>, I<writer> and I<accessor> options inherited from L<Class::MOP::Attribute>.
 
 =item I<isa =E<gt> $type_name>
 
 The I<isa> option uses Moose's type constraint facilities to set up runtime 
 type checking for this attribute. Moose will perform the checks during class 
 construction, and within any accessors. The C<$type_name> argument must be a 
-string. The string can be either a class name, or a type defined using 
-Moose's type defintion features.
+string. The string can be either a class name or a type defined using 
+Moose's type definition features.
+
+=item I<coerce =E<gt> (1|0)>
+
+This will attempt to use coercion with the supplied type constraint to change 
+the value passed into any accessors or constructors. You B<must> have supplied 
+a type constraint in order for this to work. See L<Moose::Cookbook::Recipe5>
+for an example usage.
+
+=item I<does =E<gt> $role_name>
+
+This will accept the name of a role which the value stored in this attribute 
+is expected to have consumed.
+
+=item I<required =E<gt> (1|0)>
+
+This marks the attribute as being required. This means a value must be supplied 
+during class construction, and the attribute can never be set to C<undef> with 
+an accessor. 
+
+=item I<weak_ref =E<gt> (1|0)>
+
+This will tell the class to store the value of this attribute as a weakened
+reference. If an attribute is a weakened reference, it B<cannot> also be
+coerced.
+
+=item I<lazy =E<gt> (1|0)>
+
+This will tell the class to not create this slot until absolutely necessary. 
+If an attribute is marked as lazy it B<must> have a default supplied.
+
+=item I<auto_deref =E<gt> (1|0)>
+
+This tells the accessor whether to automatically dereference the value returned. 
+This is only legal if your C<isa> option is either an C<ArrayRef> or C<HashRef>.
+
+=item I<trigger =E<gt> $code>
+
+The trigger option is a CODE reference which will be called after the value of 
+the attribute is set. The CODE ref will be passed the instance itself, the 
+updated value and the attribute meta-object (this is for more advanced fiddling
+and can typically be ignored in most cases). You B<cannot> have a trigger on
+a read-only attribute.
+
+=item I<handles =E<gt> [ @handles ]>
+
+There is experimental support for attribute delegation using the C<handles> 
+option. More docs to come later.
 
 =back
 
@@ -342,66 +451,113 @@ Moose's type defintion features.
 
 =item B<around $name|@names =E<gt> sub { ... }>
 
-This three items are syntactic sugar for the before, after and around method 
+This three items are syntactic sugar for the before, after, and around method 
 modifier features that L<Class::MOP> provides. More information on these can 
 be found in the L<Class::MOP> documentation for now. 
 
 =item B<super>
 
-The keyword C<super> is a noop when called outside of an C<override> method. In 
+The keyword C<super> is a no-op when called outside of an C<override> method. In  
 the context of an C<override> method, it will call the next most appropriate 
 superclass method with the same arguments as the original method.
 
 =item B<override ($name, &sub)>
 
-An C<override> method, is a way of explictly saying "I am overriding this 
+An C<override> method is a way of explicitly saying "I am overriding this 
 method from my superclass". You can call C<super> within this method, and 
 it will work as expected. The same thing I<can> be accomplished with a normal 
-method call and the C<SUPER::> pseudo-package, it is really your choice. 
+method call and the C<SUPER::> pseudo-package; it is really your choice. 
 
 =item B<inner>
 
 The keyword C<inner>, much like C<super>, is a no-op outside of the context of 
 an C<augment> method. You can think of C<inner> as being the inverse of 
-C<super>, the details of how C<inner> and C<augment> work is best described in 
+C<super>; the details of how C<inner> and C<augment> work is best described in
 the L<Moose::Cookbook>.
 
 =item B<augment ($name, &sub)>
 
-An C<augment> method, is a way of explictly saying "I am augmenting this 
+An C<augment> method, is a way of explicitly saying "I am augmenting this 
 method from my superclass". Once again, the details of how C<inner> and 
 C<augment> work is best described in the L<Moose::Cookbook>.
 
 =item B<confess>
 
-This is the C<Carp::confess> function, and exported here beause I use it 
+This is the C<Carp::confess> function, and exported here because I use it
 all the time. This feature may change in the future, so you have been warned. 
 
 =item B<blessed>
 
-This is the C<Scalar::Uti::blessed> function, it is exported here beause I 
+This is the C<Scalar::Uti::blessed> function, it is exported here because I
 use it all the time. It is highly recommended that this is used instead of 
 C<ref> anywhere you need to test for an object's class name.
 
 =back
 
+=head1 UNEXPORTING FUNCTIONS
+
+=head2 B<unimport>
+
+Moose offers a way of removing the keywords it exports though the C<unimport>
+method. You simply have to say C<no Moose> at the bottom of your code for this
+to work. Here is an example:
+
+    package Person;
+    use Moose;
+
+    has 'first_name' => (is => 'rw', isa => 'Str');
+    has 'last_name'  => (is => 'rw', isa => 'Str');
+    
+    sub full_name { 
+        my $self = shift;
+        $self->first_name . ' ' . $self->last_name 
+    }
+    
+    no Moose; # keywords are removed from the Person package    
+
+=head1 MISC.
+
+=head2 What does Moose stand for??
+
+Moose doesn't stand for one thing in particular, however, if you 
+want, here are a few of my favorites; feel free to contribute
+more :)
+
+=over 4
+
+=item Make Other Object Systems Envious
+
+=item Makes Object Orientation So Easy
+
+=item Makes Object Orientation Spiffy- Er  (sorry ingy)
+
+=item Most Other Object Systems Emasculate
+
+=item Moose Often Ovulate Sorta Early
+
+=item Moose Offers Often Super Extensions
+
+=item Meta Object Orientation Syntax Extensions
+
+=back
+
 =head1 CAVEATS
 
 =over 4
 
 =item *
 
-It should be noted that C<super> and C<inner> can B<not> be used in the same 
-method. However, they can be combined together with the same class hierarchy, 
+It should be noted that C<super> and C<inner> C<cannot> be used in the same 
+method. However, they can be combined together with the same class hierarchy;
 see F<t/014_override_augment_inner_super.t> for an example. 
 
-The reason that this is so is because C<super> is only valid within a method 
+The reason for this is that C<super> is only valid within a method 
 with the C<override> modifier, and C<inner> will never be valid within an 
 C<override> method. In fact, C<augment> will skip over any C<override> methods 
-when searching for it's appropriate C<inner>. 
+when searching for its appropriate C<inner>.
 
 This might seem like a restriction, but I am of the opinion that keeping these 
-two features seperate (but interoperable) actually makes them easy to use since 
+two features separate (but interoperable) actually makes them easy to use, since 
 their behavior is then easier to predict. Time will tell if I am right or not.
 
 =back
@@ -423,6 +579,8 @@ originally, I just ran with it.
 =item Thanks to mst & chansen and the whole #moose poose for all the 
 ideas/feature-requests/encouragement
 
+=item Thanks to David "Theory" Wheeler for meta-discussions and spelling fixes.
+
 =back
 
 =head1 SEE ALSO
@@ -433,6 +591,8 @@ ideas/feature-requests/encouragement
 
 =item The #moose channel on irc.perl.org
 
+=item The Moose mailing list - moose@perl.org
+
 =item L<http://forum2.org/moose/>
 
 =item L<http://www.cs.utah.edu/plt/publications/oopsla04-gff.pdf>
@@ -453,6 +613,10 @@ to cpan-RT.
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+Christian Hansen E<lt>chansen@cpan.orgE<gt>
+
+Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006 by Infinity Interactive, Inc.
@@ -462,4 +626,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
-=cut
\ No newline at end of file
+=cut