sorry konobi, not enough of a perf win, so lets wait till we get something more befor...

[gitmo/Moose.git] / lib / Moose.pm

diff --git a/lib/Moose.pm b/lib/Moose.pm
index bc9c0fb..6c48b60 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -4,7 +4,7 @@ package Moose;
 use strict;
 use warnings;
 
-our $VERSION   = '0.34';
+our $VERSION   = '0.39';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Scalar::Util 'blessed', 'reftype';
@@ -13,10 +13,11 @@ use Sub::Name    'subname';
 
 use Sub::Exporter;
 
-use Class::MOP 0.49;
+use Class::MOP 0.51;
 
 use Moose::Meta::Class;
 use Moose::Meta::TypeConstraint;
+use Moose::Meta::TypeConstraint::Class;
 use Moose::Meta::TypeCoercion;
 use Moose::Meta::Attribute;
 use Moose::Meta::Instance;
@@ -25,23 +26,23 @@ use Moose::Meta::Role;
 
 use Moose::Object;
 use Moose::Util::TypeConstraints;
+use Moose::Util ();
 
 {
     my $CALLER;
 
     sub init_meta {
         my ( $class, $base_class, $metaclass ) = @_;
-        $base_class = $class unless defined $base_class;
-        $metaclass = 'Moose::Meta::Class' unless defined $metaclass;
+        $base_class = 'Moose::Object'      unless defined $base_class;
+        $metaclass  = 'Moose::Meta::Class' unless defined $metaclass;
 
         confess
             "The Metaclass $metaclass must be a subclass of Moose::Meta::Class."
             unless $metaclass->isa('Moose::Meta::Class');
 
         # make a subtype for each Moose class
-        subtype $class => as 'Object' => where { $_->isa($class) } =>
-            optimize_as { blessed( $_[0] ) && $_[0]->isa($class) }
-        unless find_type_constraint($class);
+        class_type($class)
+            unless find_type_constraint($class);
 
         my $meta;
         if ( $class->can('meta') ) {
@@ -63,7 +64,6 @@ use Moose::Util::TypeConstraints;
             $meta = $metaclass->initialize($class);
             $meta->add_method(
                 'meta' => sub {
-
                     # re-initialize so it inherits properly
                     $metaclass->initialize( blessed( $_[0] ) || $_[0] );
                 }
@@ -73,6 +73,8 @@ use Moose::Util::TypeConstraints;
         # make sure they inherit from Moose::Object
         $meta->superclasses($base_class)
           unless $meta->superclasses();
+         
+        return $meta;
     }
 
     my %exports = (
@@ -92,41 +94,17 @@ use Moose::Util::TypeConstraints;
         with => sub {
             my $class = $CALLER;
             return subname 'Moose::with' => sub (@) {
-                my (@args) = @_;
-                confess "Must specify at least one role" unless @args;
-                
-                my $roles = Data::OptList::mkopt(\@args);
-                
-                #use Data::Dumper;
-                #warn Dumper $roles;
-                
-                Class::MOP::load_class($_->[0]) for @$roles;
-                
-                ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
-                    || confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
-                        foreach @$roles;
-
-                my $meta = $class->meta;
-
-                if (scalar @$roles == 1) {
-                    my ($role, $params) = @{$roles->[0]};
-                    $role->meta->apply($meta, (defined $params ? %$params : ()));
-                }
-                else {
-                    Moose::Meta::Role->combine(
-                        @$roles
-                    )->apply($meta);
-                }
-                
-                #$class->meta->_apply_all_roles(@roles);
+                Moose::Util::apply_all_roles($class->meta, @_)
             };
         },
         has => sub {
             my $class = $CALLER;
             return subname 'Moose::has' => sub ($;%) {
-                my ( $name, %options ) = @_;
+                my $name    = shift;
+                die 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
+                my %options = @_;
                 my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
-                $class->meta->_process_attribute( $_, %options ) for @$attrs;
+                $class->meta->add_attribute( $_, %options ) for @$attrs;
             };
         },
         before => sub {
@@ -183,6 +161,12 @@ use Moose::Util::TypeConstraints;
                 $class->meta->add_augment_method_modifier( $name => $method );
             };
         },
+        make_immutable => sub {
+            my $class = $CALLER;
+            return subname 'Moose::make_immutable' => sub {
+                $class->meta->make_immutable(@_);
+            };            
+        },        
         confess => sub {
             return \&Carp::confess;
         },
@@ -212,6 +196,11 @@ use Moose::Util::TypeConstraints;
     sub import {
         $CALLER = _get_caller(@_);
 
+        # this works because both pragmas set $^H (see perldoc perlvar)
+        # which affects the current compilation - i.e. the file who use'd
+        # us - which is why we don't need to do anything special to make
+        # it affect that file rather than this one (which is already compiled)
+
         strict->import;
         warnings->import;