X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=cd7dc7110a5f341a8569bf69c8a312b63d62cfa0;hb=9457b59678c67b47f31e82d284ed57c10d7fc091;hp=46a7e2c7ace9737ad75177c3c807d44d85e46121;hpb=71b98d4fae80b55fd5b03142fae05b625b03d328;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 46a7e2c..cd7dc71 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -4,6 +4,8 @@ package Class::MOP; use strict; use warnings; +use 5.008; + use MRO::Compat; use Carp 'confess'; @@ -26,7 +28,7 @@ BEGIN { require Devel::GlobalDestruction; Devel::GlobalDestruction->import("in_global_destruction"); 1; - } or *in_global_destruction = sub () { '' }; + } or *in_global_destruction = sub () { !1 }; } @@ -46,7 +48,9 @@ BEGIN { : sub () { 1 }; } -our $VERSION = '0.65'; +our $VERSION = '0.64_06'; +our $XS_VERSION = $VERSION; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; # after that everything is loaded, if we're allowed try to load faster XS @@ -56,7 +60,7 @@ unless ($ENV{CLASS_MOP_NO_XS}) { local $@; eval { require XSLoader; - __PACKAGE__->XSLoader::load($VERSION); + __PACKAGE__->XSLoader::load($XS_VERSION); }; $@; }; @@ -208,15 +212,6 @@ Class::MOP::Package->meta->add_attribute( )) ); -# NOTE: -# use the metaclass to construct the meta-package -# which is a superclass of the metaclass itself :P -Class::MOP::Package->meta->add_method('initialize' => sub { - my $class = shift; - my $package_name = shift; - $class->meta->new_object('package' => $package_name, @_); -}); - ## -------------------------------------------------------- ## Class::MOP::Module @@ -451,40 +446,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, @_); @@ -543,15 +504,6 @@ Class::MOP::Method::Generated->meta->add_attribute( )) ); -Class::MOP::Method::Generated->meta->add_method('new' => sub { - my ($class, %options) = @_; - ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters"; - my $self = $class->meta->new_object(%options); - $self->initialize_body; - $self; -}); - ## -------------------------------------------------------- ## Class::MOP::Method::Accessor @@ -569,36 +521,6 @@ Class::MOP::Method::Accessor->meta->add_attribute( )) ); -Class::MOP::Method::Accessor->meta->add_method('new' => sub { - my $class = shift; - my %options = @_; - - (exists $options{attribute}) - || confess "You must supply an attribute to construct with"; - - (exists $options{accessor_type}) - || confess "You must supply an accessor_type to construct with"; - - (Scalar::Util::blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute')) - || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance"; - - ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters"; - - # return the new object - my $self = $class->meta->new_object(%options); - - # we don't want this creating - # a cycle in the code, if not - # needed - Scalar::Util::weaken($self->{'attribute'}); - - $self->initialize_body; - - $self; -}); - - ## -------------------------------------------------------- ## Class::MOP::Method::Constructor @@ -620,30 +542,6 @@ Class::MOP::Method::Constructor->meta->add_attribute( )) ); -Class::MOP::Method::Constructor->meta->add_method('new' => sub { - my $class = shift; - my %options = @_; - - (Scalar::Util::blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class')) - || confess "You must pass a metaclass instance if you want to inline" - if $options{is_inline}; - - ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters"; - - # return the new object - my $self = $class->meta->new_object(%options); - - # we don't want this creating - # a cycle in the code, if not - # needed - Scalar::Util::weaken($self->{'associated_metaclass'}); - - $self->initialize_body; - - $self; -}); - ## -------------------------------------------------------- ## Class::MOP::Instance @@ -668,7 +566,7 @@ Class::MOP::Instance->meta->add_attribute( Class::MOP::Instance->meta->add_attribute( Class::MOP::Attribute->new('attributes', - reader => { attributes => \&Class::MOP::Instance::attributes }, + reader => { attributes => \&Class::MOP::Instance::get_all_attributes }, ), ); @@ -689,17 +587,6 @@ Class::MOP::Instance->meta->add_attribute( # for the constructor to be able to use it Class::MOP::Instance->meta->get_meta_instance; -Class::MOP::Instance->meta->add_method('new' => sub { - my $class = shift; - my $options = $class->BUILDARGS(@_); - - my $self = $class->meta->new_object(%$options); - - Scalar::Util::weaken($self->{'associated_metaclass'}); - - $self; -}); - # pretend the add_method never happenned. it hasn't yet affected anything undef Class::MOP::Instance->meta->{_package_cache_flag}; @@ -714,12 +601,9 @@ undef Class::MOP::Instance->meta->{_package_cache_flag}; # no actual benefits. $_->meta->make_immutable( - ( $_->can("_new") ? ( - inline_constructor => 1, - constructor_name => "_new", - ) : ( - inline_constructor => 0, - ) ), + inline_constructor => 1, + replace_constructor => 1, + constructor_name => "_new", inline_accessors => 0, ) for qw/ Class::MOP::Package