use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
+use Sub::Name 'subname';
+use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.81';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# defined in Class::MOP::Class
'superclasses' => \undef,
- 'methods' => {},
- 'attributes' => {},
- 'attribute_metaclass' => ( $options->{'attribute_metaclass'} || 'Class::MOP::Attribute' ),
- 'method_metaclass' => ( $options->{'method_metaclass'} || 'Class::MOP::Method' ),
- 'wrapped_method_metaclass' => ( $options->{'wrapped_method_metaclass'} || 'Class::MOP::Method::Wrapped' ),
- 'instance_metaclass' => ( $options->{'instance_metaclass'} || 'Class::MOP::Instance' ),
- 'immutable_trait' => ( $options->{'immutable_trait'} || 'Class::MOP::Class::Immutable::Trait' ),
+ 'methods' => {},
+ 'attributes' => {},
+ 'attribute_metaclass' =>
+ ( $options->{'attribute_metaclass'} || 'Class::MOP::Attribute' ),
+ 'method_metaclass' =>
+ ( $options->{'method_metaclass'} || 'Class::MOP::Method' ),
+ 'wrapped_method_metaclass' => (
+ $options->{'wrapped_method_metaclass'}
+ || 'Class::MOP::Method::Wrapped'
+ ),
+ 'instance_metaclass' =>
+ ( $options->{'instance_metaclass'} || 'Class::MOP::Instance' ),
+ 'immutable_trait' => (
+ $options->{'immutable_trait'}
+ || 'Class::MOP::Class::Immutable::Trait'
+ ),
'constructor_name' => ( $options->{constructor_name} || 'new' ),
- 'constructor_class' => ( $options->{constructor_class} || 'Class::MOP::Method::Constructor' ),
+ 'constructor_class' => (
+ $options->{constructor_class} || 'Class::MOP::Method::Constructor'
+ ),
'destructor_class' => $options->{destructor_class},
}, $class;
}
sub DESTROY {
my $self = shift;
- return if Class::MOP::in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
+ return if in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
no warnings 'uninitialized';
return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
my $full_method_name = ($self->name . '::' . $method_name);
$self->add_package_symbol(
{ sigil => '&', type => 'CODE', name => $method_name },
- Class::MOP::subname($full_method_name => $body)
+ subname($full_method_name => $body)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_before_modifier(
- Class::MOP::subname(':before' => $method_modifier)
+ subname(':before' => $method_modifier)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_after_modifier(
- Class::MOP::subname(':after' => $method_modifier)
+ subname(':after' => $method_modifier)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_around_modifier(
- Class::MOP::subname(':around' => $method_modifier)
+ subname(':around' => $method_modifier)
);
}
} else {
$self->invalidate_meta_instances();
}
+
+ # get our count of previously inserted attributes and
+ # increment by one so this attribute knows its order
+ my $order = (scalar keys %{$self->get_attribute_map}) - 1;
+ $attribute->_set_insertion_order($order + 1);
# then onto installing the new accessors
$self->get_attribute_map->{$attribute->name} = $attribute;
my ( $self, @args ) = @_;
if ( $self->is_mutable ) {
- $self->_initialize_immutable($self->_immutable_options(@args));
+ $self->_initialize_immutable( $self->_immutable_options(@args) );
$self->_rebless_as_immutable(@args);
return $self;
- } else {
+ }
+ else {
return;
}
}
-
sub make_mutable {
my $self = shift;
$self->_remove_inlined_code(@args);
delete $self->{__immutable};
return $self;
- } else {
+ }
+ else {
return;
}
}
-sub immutable_metaclass {
+sub _rebless_as_immutable {
+ my ( $self, @args ) = @_;
+
+ $self->{__immutable}{original_class} = ref $self;
+
+ bless $self => $self->_immutable_metaclass(@args);
+}
+
+sub _immutable_metaclass {
my ( $self, %args ) = @_;
if ( my $class = $args{immutable_metaclass} ) {
my $class_name;
if ( $meta_attr and $trait eq $meta_attr->default ) {
- # if the trait is the same as the default we try and pick a predictable
- # name for the immutable metaclass
+
+ # if the trait is the same as the default we try and pick a predictable
+ # name for the immutable metaclass
$class_name = "Class::MOP::Class::Immutable::" . ref($self);
- } else {
- $class_name = join("::", "Class::MOP::Class::Immutable::CustomTrait", $trait, "ForMetaClass", ref($self));
+ }
+ else {
+ $class_name
+ = join( "::", "Class::MOP::Class::Immutable::CustomTrait", $trait,
+ "ForMetaClass", ref($self) );
}
if ( Class::MOP::is_class_loaded($class_name) ) {
if ( $class_name->isa($trait) ) {
return $class_name;
- } else {
- confess "$class_name is already defined but does not inherit $trait";
}
- } else {
+ else {
+ confess
+ "$class_name is already defined but does not inherit $trait";
+ }
+ }
+ else {
my @super = ( $trait, ref($self) );
my $meta = Class::MOP::Class->initialize($class_name);
}
}
-sub _rebless_as_immutable {
- my ( $self, @args ) = @_;
-
- $self->{__immutable}{original_class} = ref $self;
-
- bless $self => $self->immutable_metaclass(@args);
-}
-
sub _remove_inlined_code {
my $self = shift;
- $self->remove_method($_->name) for $self->_inlined_methods;
+ $self->remove_method( $_->name ) for $self->_inlined_methods;
delete $self->{__immutable}{inlined_methods};
}
-sub _inlined_methods { @{ $_[0]{__immutable}{inlined_methods} || [] } };
+sub _inlined_methods { @{ $_[0]{__immutable}{inlined_methods} || [] } }
sub _add_inlined_method {
my ( $self, $method ) = @_;
my ( $self, %args ) = @_;
# FIXME
- $self->_inline_accessors(%args) if $args{inline_accessors};
+ $self->_inline_accessors(%args) if $args{inline_accessors};
$self->_inline_constructor(%args) if $args{inline_constructor};
- $self->_inline_destructor(%args) if $args{inline_destructor};
+ $self->_inline_destructor(%args) if $args{inline_destructor};
}
sub _rebless_as_mutable {
#if ( my $existing = $self->name->can($args{constructor_name}) ) {
# if ( refaddr($existing) == refaddr(\&Moose::Object::new) ) {
- unless ($args{replace_constructor}
- or !$self->has_method($name) ) {
+ unless ( $args{replace_constructor}
+ or !$self->has_method($name) ) {
my $class = $self->name;
warn "Not inlining a constructor for $class since it defines"
- . " its own constructor.\n"
- . "If you are certain you don't need to inline your"
- . " constructor, specify inline_constructor => 0 in your"
- . " call to $class->meta->make_immutable\n";
+ . " its own constructor.\n"
+ . "If you are certain you don't need to inline your"
+ . " constructor, specify inline_constructor => 0 in your"
+ . " call to $class->meta->make_immutable\n";
return;
}
);
if ( $args{replace_constructor} or $constructor->can_be_inlined ) {
- $self->add_method($name => $constructor);
+ $self->add_method( $name => $constructor );
$self->_add_inlined_method($constructor);
}
}
Class::MOP::load_class($destructor_class);
- return unless $destructor_class->is_needed( $self );
+ return unless $destructor_class->is_needed($self);
my $destructor = $destructor_class->new(
options => \%args,
# add a method to Foo ...
Foo->meta->add_method( 'bar' => sub {...} )
- # get a list of all the classes searched
- # the method dispatcher in the correct order
- Foo->meta->class_precedence_list()
+ # get a list of all the classes searched
+ # the method dispatcher in the correct order
+ Foo->meta->class_precedence_list()
- # remove a method from Foo
- Foo->meta->remove_method('bar');
+ # remove a method from Foo
+ Foo->meta->remove_method('bar');
# or use this to actually create classes ...
version => '0.01',
superclasses => ['Foo'],
attributes => [
- Class::MOP:: : Attribute->new('$bar'),
- Class::MOP:: : Attribute->new('$baz'),
+ Class::MOP::Attribute->new('$bar'),
+ Class::MOP::Attribute->new('$baz'),
],
methods => {
calculate_bar => sub {...},