X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=05291ae195a63388f7255177efeb4d22f1377cdc;hb=4b698b1a547836fd91575b96ab89767c31351f4e;hp=2f263f91156633a21574563a653fe1d09b520101;hpb=0531f5107472b7d12155394f59f3755042e21d2c;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 2f263f9..05291ae 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -11,6 +11,25 @@ use Scalar::Util  'weaken';
 
 use Sub::Identify 'get_code_info';
 
+BEGIN {
+    local $@;
+    eval {
+        require Sub::Name;
+        Sub::Name->import(qw(subname));
+        1
+    } or eval 'sub subname { $_[1] }';
+
+    # this is either part of core or set up appropriately by MRO::Compat
+    *check_package_cache_flag = \&mro::get_pkg_gen;
+
+    eval {
+        require Devel::GlobalDestruction;
+        Devel::GlobalDestruction->import("in_global_destruction");
+        1;
+    } or *in_global_destruction = sub () { '' };
+}
+
+
 use Class::MOP::Class;
 use Class::MOP::Attribute;
 use Class::MOP::Method;
@@ -18,10 +37,6 @@ use Class::MOP::Method;
 use Class::MOP::Immutable;
 
 BEGIN {
-    
-    our $VERSION   = '0.65';
-    our $AUTHORITY = 'cpan:STEVAN';    
-    
     *IS_RUNNING_ON_5_10 = ($] < 5.009_005) 
         ? sub () { 0 }
         : sub () { 1 };    
@@ -29,16 +44,11 @@ BEGIN {
     *HAVE_ISAREV = defined(&mro::get_isarev)
         ? sub () { 1 }
         : sub () { 1 };
-
-    {
-        local $@;
-        eval 'use Sub::Name qw(subname); 1' || eval 'sub subname { $_[1] }';
-    }
-
-    # this is either part of core or set up appropriately by MRO::Compat
-    *check_package_cache_flag = \&mro::get_pkg_gen;
 }
 
+our $VERSION   = '0.65';
+our $AUTHORITY = 'cpan:STEVAN';    
+    
 # after that everything is loaded, if we're allowed try to load faster XS
 # versions of various things
 unless ($ENV{CLASS_MOP_NO_XS}) {
@@ -46,7 +56,7 @@ unless ($ENV{CLASS_MOP_NO_XS}) {
         local $@;
         eval {
             require XSLoader;
-            __PACKAGE__->XSLoader::load(our $VERSION);
+            __PACKAGE__->XSLoader::load($VERSION);
         };
         $@;
     };
@@ -441,40 +451,6 @@ Class::MOP::Attribute->meta->add_attribute(
     ))
 );
 
-# NOTE: (meta-circularity)
-# This should be one of the last things done
-# it will "tie the knot" with Class::MOP::Attribute
-# so that it uses the attributes meta-objects
-# to construct itself.
-Class::MOP::Attribute->meta->add_method('new' => sub {
-    my ( $class, @args ) = @_;
-
-    unshift @args, "name" if @args % 2 == 1;
-    my %options = @args;
-
-    my $name = $options{name};
-
-    (defined $name && $name)
-        || confess "You must provide a name for the attribute";
-    $options{init_arg} = $name
-        if not exists $options{init_arg};
-
-    if(exists $options{builder}){
-        confess("builder must be a defined scalar value which is a method name")
-            if ref $options{builder} || !(defined $options{builder});
-        confess("Setting both default and builder is not allowed.")
-            if exists $options{default};
-    } else {
-        (Class::MOP::Attribute::is_default_a_coderef(\%options))
-            || confess("References are not allowed as default values, you must ".
-                       "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
-                if exists $options{default} && ref $options{default};
-    }
-
-    # return the new object
-    $class->meta->new_object(%options);
-});
-
 Class::MOP::Attribute->meta->add_method('clone' => sub {
     my $self  = shift;
     $self->meta->clone_object($self, @_);
@@ -506,25 +482,6 @@ Class::MOP::Method->meta->add_attribute(
     ))
 );
 
-# FIMXE prime candidate for immutablization
-Class::MOP::Method->meta->add_method('wrap' => sub {
-    my ( $class, @args ) = @_;
-
-    unshift @args, 'body' if @args % 2 == 1;
-
-    my %options = @args;
-    my $code = $options{body};
-
-    ('CODE' eq ref($code))
-        || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
-
-    ($options{package_name} && $options{name})
-        || confess "You must supply the package_name and name parameters";
-
-    # return the new object
-    $class->meta->new_object(%options);
-});
-
 Class::MOP::Method->meta->add_method('clone' => sub {
     my $self  = shift;
     $self->meta->clone_object($self, @_);
@@ -723,8 +680,10 @@ undef Class::MOP::Instance->meta->{_package_cache_flag};
 # no actual benefits.
 
 $_->meta->make_immutable(
-    inline_constructor => 0,
-    inline_accessors   => 0,
+    inline_constructor  => 1,
+    replace_constructor => 1,
+    constructor_name    => "_new",
+    inline_accessors => 0,
 ) for qw/
     Class::MOP::Package
     Class::MOP::Module
@@ -988,6 +947,13 @@ If possible, we will load the L<Sub::Name> module and this will function
 as C<Sub::Name::subname> does, otherwise it will just return the C<$code>
 argument.
 
+=item B<in_global_destruction>
+
+If L<Devel::GlobalDestruction> is available, this returns true under global
+destruction.
+
+Otherwise it's a constant returning false.
+
 =back
 
 =head2 Metaclass cache functions