use Carp 'confess';
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;
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 };
*HAVE_ISAREV = defined(&mro::get_isarev)
? sub () { 1 }
: sub () { 1 };
+}
- # NOTE:
- # we may not use this yet, but once
- # the get_code_info XS gets merged
- # upstream to it, we will always use
- # it. But for now it is just kinda
- # extra overhead.
- # - SL
- require Sub::Identify;
-
- # stash these for a sec, and see how things go
- my $_PP_subname = sub { $_[1] };
- my $_PP_get_code_info = \&Sub::Identify::get_code_info;
+our $VERSION = '0.65';
+our $AUTHORITY = 'cpan:STEVAN';
- if ($ENV{CLASS_MOP_NO_XS}) {
- # NOTE:
- # this is if you really want things
- # to be slow, then you can force the
- # no-XS rule this way, otherwise we
- # make an effort to load as much of
- # the XS as possible.
- # - SL
- no warnings 'prototype', 'redefine';
-
- # this is either part of core or set up appropriately by MRO::Compat
- *check_package_cache_flag = \&mro::get_pkg_gen;
-
- # our own version of Sub::Name
- *subname = $_PP_subname;
- # and the Sub::Identify version of the get_code_info
- *get_code_info = $_PP_get_code_info;
- }
- else {
- # now try our best to get as much
- # of the XS loaded as possible
- {
- local $@;
- eval {
- require XSLoader;
- XSLoader::load( 'Class::MOP', $VERSION );
- };
- die $@ if $@ && $@ !~ /object version|loadable object/;
-
- # okay, so the XS failed to load, so
- # use the pure perl one instead.
- *get_code_info = $_PP_get_code_info if $@;
- }
-
- # get it from MRO::Compat
- *check_package_cache_flag = \&mro::get_pkg_gen;
-
- # now try and load the Sub::Name
- # module and use that as a means
- # for naming our CVs, if not, we
- # use the workaround instead.
+# after that everything is loaded, if we're allowed try to load faster XS
+# versions of various things
+unless ($ENV{CLASS_MOP_NO_XS}) {
+ my $e = do {
local $@;
- if ( eval { require Sub::Name } ) {
- *subname = \&Sub::Name::subname;
- }
- else {
- *subname = $_PP_subname;
- }
- }
+ eval {
+ require XSLoader;
+ __PACKAGE__->XSLoader::load($VERSION);
+ };
+ $@;
+ };
+
+ die $e if $e && $e !~ /object version|loadable object/;
}
{
))
);
-# 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, @_);
# included for completeness
Class::MOP::Instance->meta->add_attribute(
- Class::MOP::Attribute->new('associated_metaclass')
+ Class::MOP::Attribute->new('associated_metaclass',
+ reader => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
+ ),
);
Class::MOP::Instance->meta->add_attribute(
- Class::MOP::Attribute->new('attributes')
+ Class::MOP::Attribute->new('_class_name',
+ init_arg => undef,
+ reader => { _class_name => \&Class::MOP::Instance::_class_name },
+ #lazy => 1, # not yet supported by Class::MOP but out our version does it anyway
+ #default => sub { $_[0]->associated_metaclass->name },
+ ),
+);
+
+Class::MOP::Instance->meta->add_attribute(
+ Class::MOP::Attribute->new('attributes',
+ reader => { attributes => \&Class::MOP::Instance::attributes },
+ ),
);
Class::MOP::Instance->meta->add_attribute(
- Class::MOP::Attribute->new('slots')
+ Class::MOP::Attribute->new('slots',
+ reader => { slots => \&Class::MOP::Instance::slots },
+ ),
);
Class::MOP::Instance->meta->add_attribute(
- Class::MOP::Attribute->new('slot_hash')
+ Class::MOP::Attribute->new('slot_hash',
+ reader => { slot_hash => \&Class::MOP::Instance::slot_hash },
+ ),
);
# 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
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
projects / gitmo/Class-MOP.git / blobdiff