Removing the use of UNIVERSAL::require
[gitmo/Moose.git] / lib / Moose.pm
index eaf420c..8f6d75e 100644 (file)
@@ -4,13 +4,13 @@ package Moose;
 use strict;
 use warnings;
 
-our $VERSION = '0.06';
+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;
@@ -44,7 +44,7 @@ use Moose::Util::TypeConstraints;
             # 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 {
             # NOTE:
@@ -68,96 +68,35 @@ use Moose::Util::TypeConstraints;
     my %exports = (
         extends => sub {
             my $class = $CALLER;
-            return subname 'Moose::extends' => sub {
+            return subname 'Moose::extends' => sub (@) {
+                confess "Must derive at least one class" unless @_;
                 _load_all_classes(@_);
-                my $meta = $class->meta;
-                foreach my $super (@_) {
-                    # don't bother if it does not have a meta.
-                    next unless $super->can('meta');
-                    # if it's meta is a vanilla Moose, 
-                    # then we can safely ignore it.
-                    next if blessed($super->meta) eq 'Moose::Meta::Class';
-                    # but if we have anything else, 
-                    # we need to check it out ...
-                    unless (# see if of our metaclass is incompatible
-                            ($meta->isa(blessed($super->meta)) &&
-                             # and see if our instance metaclass is incompatible
-                             $meta->instance_metaclass->isa($super->meta->instance_metaclass)) &&
-                            # ... and if we are just a vanilla Moose
-                            $meta->isa('Moose::Meta::Class')) {
-                        # re-initialize the meta ...
-                        my $super_meta = $super->meta;
-                        # NOTE:
-                        # We might want to consider actually 
-                        # transfering any attributes from the 
-                        # original meta into this one, but in 
-                        # general you should not have any there
-                        # at this point anyway, so it's very 
-                        # much an obscure edge case anyway
-                        $meta = $super_meta->reinitialize($class => (
-                            ':attribute_metaclass' => $super_meta->attribute_metaclass,                            
-                            ':method_metaclass'    => $super_meta->method_metaclass,
-                            ':instance_metaclass'  => $super_meta->instance_metaclass,
-                        ));
-                    }
-                }
+                # 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 $class = $CALLER;
-            return subname 'Moose::with' => sub {
+            return subname 'Moose::with' => sub (@) {
                 my (@roles) = @_;
+                confess "Must specify at least one role" unless @roles;
                 _load_all_classes(@roles);
-                ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
-                    || confess "You can only consume roles, $_ is not a Moose role"
-                        foreach @roles;
-                if (scalar @roles == 1) {
-                    $roles[0]->meta->apply($class->meta);
-                }
-                else {
-                    Moose::Meta::Role->combine(
-                        map { $_->meta } @roles
-                    )->apply($class->meta);
-                }
+                $class->meta->_apply_all_roles(@roles);
             };
         },
         has => sub {
             my $class = $CALLER;
-            return subname 'Moose::has' => sub {
+            return subname 'Moose::has' => sub ($;%) {
                 my ($name, %options) = @_;              
-                my $meta = $class->meta;
-                if ($name =~ /^\+(.*)/) {
-                    my $inherited_attr = $meta->find_attribute_by_name($1);
-                    (defined $inherited_attr)
-                        || confess "Could not find an attribute by the name of '$1' to inherit from";
-                    my $new_attr;
-                    if ($inherited_attr->isa('Moose::Meta::Attribute')) {
-                        $new_attr = $inherited_attr->clone_and_inherit_options(%options);
-                    }
-                    else {
-                        # NOTE:
-                        # kind of a kludge to handle Class::MOP::Attributes
-                        $new_attr = Moose::Meta::Attribute::clone_and_inherit_options(
-                            $inherited_attr, %options
-                        );                        
-                    }
-                    $meta->add_attribute($new_attr);
-                }
-                else {
-                    if ($options{metaclass}) {
-                        _load_all_classes($options{metaclass});
-                        $meta->add_attribute($options{metaclass}->new($name, %options));
-                    }
-                    else {
-                        $meta->add_attribute($name, %options);
-                    }
-                }
+                $class->meta->_process_attribute($name, %options);
             };
         },
         before => sub {
             my $class = $CALLER;
-            return subname 'Moose::before' => sub {
+            return subname 'Moose::before' => sub (@&) {
                 my $code = pop @_;
                 my $meta = $class->meta;
                 $meta->add_before_method_modifier($_, $code) for @_;
@@ -165,7 +104,7 @@ use Moose::Util::TypeConstraints;
         },
         after => sub {
             my $class = $CALLER;
-            return subname 'Moose::after' => sub {
+            return subname 'Moose::after' => sub (@&) {
                 my $code = pop @_;
                 my $meta = $class->meta;
                 $meta->add_after_method_modifier($_, $code) for @_;
@@ -173,7 +112,7 @@ use Moose::Util::TypeConstraints;
         },
         around => sub {
             my $class = $CALLER;            
-            return subname 'Moose::around' => sub {
+            return subname 'Moose::around' => sub (@&) {
                 my $code = pop @_;
                 my $meta = $class->meta;
                 $meta->add_around_method_modifier($_, $code) for @_;
@@ -184,7 +123,7 @@ use Moose::Util::TypeConstraints;
         },
         override => sub {
             my $class = $CALLER;
-            return subname 'Moose::override' => sub {
+            return subname 'Moose::override' => sub ($&) {
                 my ($name, $method) = @_;
                 $class->meta->add_override_method_modifier($name => $method);
             };
@@ -194,17 +133,37 @@ use Moose::Util::TypeConstraints;
         },
         augment => sub {
             my $class = $CALLER;
-            return subname 'Moose::augment' => sub {
+            return subname 'Moose::augment' => sub (@&) {
                 my ($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({ 
@@ -216,6 +175,9 @@ use Moose::Util::TypeConstraints;
     
     sub import {     
         $CALLER = caller();
+        
+        strict->import;
+        warnings->import;        
 
         # we should never export to main
         return if $CALLER eq 'main';
@@ -224,6 +186,28 @@ use Moose::Util::TypeConstraints;
         
         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
@@ -234,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 {
@@ -247,7 +240,7 @@ sub _is_class_already_loaded {
                next if substr($_, -2, 2) eq '::';
                return 1 if defined &{"${name}::$_"};
        }
-    return 0;
+       return 0;
 }
 
 1;
@@ -258,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;
@@ -275,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
 
@@ -300,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.
@@ -310,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??
-
-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
+=head2 Can I use this in production? Or is this just an experiment?
 
-=item Makes Object Orientation Spiffy- Er  (sorry ingy)
+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.
 
-=item Most Other Object Systems Emasculate
+=head2 Is Moose just Perl 6 in Perl 5?
 
-=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.
 
@@ -374,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
 
@@ -397,20 +386,20 @@ 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 of constructors. You B<must> have supplied 
+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.
 
@@ -427,22 +416,33 @@ an accessor.
 
 =item I<weak_ref =E<gt> (1|0)>
 
-This will tell the class to strore the value of this attribute as a weakened 
-reference. If an attribute is a weakened reference, it can B<not> also be coerced. 
+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 nessecary. 
+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 can B<not> have a trigger on 
+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
 
 =item B<before $name|@names =E<gt> sub { ... }>
@@ -451,66 +451,113 @@ a read-only attribute.
 
 =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
@@ -532,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
@@ -542,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>