X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=b3b6b97b0bfcf86d2b4d1c2e04d7fbd7dca56c1f;hb=7d1a576bad6260090ba0d40950f861227ead48a8;hp=10c5d5e6f80c4b1b889587ac719b67ea97ee514c;hpb=9fcd76fdf3de5a03e208417f4fe63741d5859e90;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 10c5d5e..b3b6b97 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -8,6 +8,7 @@ use Class::MOP::Instance;
 use Class::MOP::Method::Wrapped;
 use Class::MOP::Method::Accessor;
 use Class::MOP::Method::Constructor;
+use Class::MOP::MiniTrait;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
@@ -16,7 +17,7 @@ use Devel::GlobalDestruction 'in_global_destruction';
 use Try::Tiny;
 use List::MoreUtils 'all';
 
-our $VERSION   = '1.04';
+our $VERSION   = '1.08';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -280,7 +281,7 @@ sub _check_single_metaclass_compatibility {
               . $self->name . " (" . ($self->$metaclass_type)
               . ")" . " is not compatible with the "
               . "$metaclass_type_name metaclass of its "
-              . "superclass, " . $superclass_name . " ("
+              . "superclass, $superclass_name ("
               . ($super_meta->$metaclass_type) . ")";
     }
 }
@@ -483,6 +484,7 @@ sub create {
         superclasses
         attributes
         methods
+        no_meta
         version
         authority
     )};
@@ -492,8 +494,16 @@ sub create {
 
     # FIXME totally lame
     $meta->add_method('meta' => sub {
+        if (Class::MOP::DEBUG_NO_META()) {
+            my ($self) = @_;
+            if (my $meta = try { $self->SUPER::meta }) {
+                return $meta if $meta->isa('Class::MOP::Class');
+            }
+            confess "'meta' method called by MOP internals"
+                if caller =~ /Class::MOP|metaclass/;
+        }
         $class->initialize(ref($_[0]) || $_[0]);
-    });
+    }) unless $options{no_meta};
 
     $meta->superclasses(@{$options{superclasses}})
         if exists $options{superclasses};
@@ -603,6 +613,13 @@ sub _create_meta_instance {
     return $instance;
 }
 
+sub inline_create_instance {
+    my $self = shift;
+    my ($class) = @_;
+
+    return $self->get_meta_instance->inline_create_instance($class);
+}
+
 sub clone_object {
     my $class    = shift;
     my $instance = shift;
@@ -763,7 +780,7 @@ sub get_all_attributes {
 sub superclasses {
     my $self     = shift;
 
-    my $isa = $self->get_package_symbol(
+    my $isa = $self->get_or_add_package_symbol(
         { sigil => '@', type => 'ARRAY', name => 'ISA' } );
 
     if (@_) {
@@ -1168,17 +1185,7 @@ sub _immutable_metaclass {
         superclasses => [ ref $self ],
     );
 
-    Class::MOP::load_class($trait);
-    for my $meth ( Class::MOP::Class->initialize($trait)->get_all_methods ) {
-        my $meth_name = $meth->name;
-
-        if ( $immutable_meta->find_method_by_name( $meth_name ) ) {
-            $immutable_meta->add_around_method_modifier( $meth_name, $meth->body );
-        }
-        else {
-            $immutable_meta->add_method( $meth_name, $meth->clone );
-        }
-    }
+    Class::MOP::MiniTrait::apply( $immutable_meta, $trait );
 
     $immutable_meta->make_immutable(
         inline_constructor => 0,
@@ -1402,6 +1409,10 @@ hash reference are method names and values are subroutine references.
 
 An optional array reference of L<Class::MOP::Attribute> objects.
 
+=item * no_meta
+
+If true, a C<meta> method will not be installed into the class.
+
 =back
 
 =item B<< Class::MOP::Class->create_anon_class(%options) >>
@@ -1513,6 +1524,11 @@ metaclass.
 Returns an instance of the C<instance_metaclass> to be used in the
 construction of a new instance of the class.
 
+=item B<< $metaclass->inline_create_instance($class_var) >>
+
+This method takes a variable name, and uses it create an inline snippet of
+code that will create a new instance of the class.
+
 =back
 
 =head2 Informational predicates