what-a-mess
[gitmo/Moose.git] / lib / Moose.pm
index dcec72a..6f972bc 100644 (file)
@@ -4,24 +4,37 @@ package Moose;
 use strict;
 use warnings;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
 use Sub::Name    'subname';
 
+use UNIVERSAL::require;
+
+use Class::MOP;
+
 use Moose::Meta::Class;
 use Moose::Meta::Attribute;
+use Moose::Meta::TypeConstraint;
 
 use Moose::Object;
-use Moose::Util::TypeConstraints ':no_export';
+use Moose::Util::TypeConstraints;
 
 sub import {
        shift;
        my $pkg = caller();
        
+       # we should never export to main
+       return if $pkg eq 'main';
+       
        Moose::Util::TypeConstraints->import($pkg);
        
+       # make a subtype for each Moose class
+    subtype $pkg 
+        => as Object 
+        => where { $_->isa($pkg) };    
+
        my $meta;
        if ($pkg->can('meta')) {
                $meta = $pkg->meta();
@@ -45,7 +58,10 @@ sub import {
        # will not name it with 
        
        # handle superclasses
-       $meta->alias_method('extends' => subname 'Moose::extends' => sub { $meta->superclasses(@_) });
+       $meta->alias_method('extends' => subname 'Moose::extends' => sub { 
+           $_->require for @_;
+           $meta->superclasses(@_) 
+       });     
        
        # handle attributes
        $meta->alias_method('has' => subname 'Moose::has' => sub { 
@@ -59,13 +75,26 @@ sub import {
                        }                       
                }
                if (exists $options{isa}) {
-                       if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
-                               $options{type_constraint} = $options{isa};
+                   # allow for anon-subtypes here ...
+                   if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
+                               $options{type_constraint} = Moose::Meta::TypeConstraint->new(
+                                   name            => '__ANON__',
+                                   constraint_code => $options{isa}
+                               );
                        }
                        else {
-                               $options{type_constraint} = Moose::Util::TypeConstraints::subtype(
-                                       Object => Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
-                               );                      
+                           # otherwise assume it is a constraint
+                           my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
+                           # if the constraing it not found ....
+                           unless (defined $constraint) {
+                               # assume it is a foreign class, and make 
+                               # an anon constraint for it 
+                               $constraint = Moose::Meta::TypeConstraint->new(
+                                   name            => '__ANON__',
+                                   constraint_code => subtype Object => where { $_->isa($constraint) }
+                               );
+                           }                       
+                $options{type_constraint} = $constraint;
                        }
                }
                $meta->add_attribute($name, %options) 
@@ -78,21 +107,21 @@ sub import {
        });
        $meta->alias_method('after'  => subname 'Moose::after' => sub { 
                my $code = pop @_;
-               $meta->add_after_method_modifier($_, $code)  for @_;
+               $meta->add_after_method_modifier($_, $code) for @_;
        });     
        $meta->alias_method('around' => subname 'Moose::around' => sub { 
                my $code = pop @_;
-               $meta->add_around_method_modifier($_, $code)  for @_;   
+               $meta->add_around_method_modifier($_, $code) for @_;    
        });     
-       
+
        # make sure they inherit from Moose::Object
-       $meta->superclasses('Moose::Object') 
-               unless $meta->superclasses();
+       $meta->superclasses('Moose::Object')
+       unless $meta->superclasses();
 
        # we recommend using these things 
        # so export them for them
-       $meta->alias_method('confess' => \&confess);                    
-       $meta->alias_method('blessed' => \&blessed);                            
+       $meta->alias_method('confess' => \&Carp::confess);                      
+       $meta->alias_method('blessed' => \&Scalar::Util::blessed);                              
 }
 
 1;
@@ -110,8 +139,8 @@ Moose - Moose, it's the new Camel
   package Point;
   use Moose;
        
-  has 'x' => (isa => Int(), is => 'rw');
-  has 'y' => (isa => Int(), is => 'rw');
+  has 'x' => (isa => 'Int', is => 'rw');
+  has 'y' => (isa => 'Int', is => 'rw');
   
   sub clear {
       my $self = shift;
@@ -124,7 +153,7 @@ Moose - Moose, it's the new Camel
   
   extends 'Point';
   
-  has 'z' => (isa => Int());
+  has 'z' => (isa => 'Int');
   
   after 'clear' => sub {
       my $self = shift;
@@ -152,8 +181,8 @@ object system.
 
 Moose is built on top of L<Class::MOP>, which is a metaclass system 
 for Perl 5. This means that Moose not only makes building normal 
-Perl 5 objects better, but is also provides brings with it the power 
-of metaclass programming. 
+Perl 5 objects better, but it also provides the power of metaclass 
+programming.
 
 =head2 What does Moose stand for??
 
@@ -163,10 +192,49 @@ more :)
 
 =over 4
 
-=item Makes Other Object Systems Envious
+=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
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=over 4
+
+=item I blame Sam Vilain for giving me my first hit of meta-model crack.
+
+=item I blame Audrey Tang for encouraging that meta-crack habit in #perl6.
+
+=item Without the love and encouragement of Yuval "nothingmuch" Kogman, 
+this module would not be possible (and it wouldn't have a name).
+
+=item The basis of the TypeContraints module was Rob Kinyon's idea 
+originally, I just ran with it.
+
+=item Much love to mst & chansen and the whole #moose poose for all the 
+ideas/feature-requests/encouragement
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<http://forum2.org/moose/>
+
 =back
 
 =head1 BUGS