use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
+use Try::Tiny;
-our $VERSION = '0.78_01';
+our $VERSION = '1.11';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
-use base 'Class::MOP::Object';
+use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore';
# NOTE: (meta-circularity)
# This method will be replaced in the
my $name = $options{name};
- (defined $name && $name)
+ (defined $name)
|| confess "You must provide a name for the attribute";
$options{init_arg} = $name
confess("Setting both default and builder is not allowed.")
if exists $options{default};
} else {
- (is_default_a_coderef(\%options))
+ ($class->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};
sub _new {
my $class = shift;
+
+ return Class::MOP::Class->initialize($class)->new_object(@_)
+ if $class ne __PACKAGE__;
+
my $options = @_ == 1 ? $_[0] : {@_};
bless {
'clearer' => $options->{clearer},
'builder' => $options->{builder},
'init_arg' => $options->{init_arg},
- 'default' => $options->{default},
+ exists $options->{default}
+ ? ('default' => $options->{default})
+ : (),
'initializer' => $options->{initializer},
'definition_context' => $options->{definition_context},
# keep a weakened link to the
# and a list of the methods
# associated with this attr
'associated_methods' => [],
+ # this let's us keep track of
+ # our order inside the associated
+ # class
+ 'insertion_order' => undef,
}, $class;
}
$params->{$init_arg},
);
}
- elsif (defined $self->{'default'}) {
+ elsif (exists $self->{'default'}) {
$self->_set_initial_slot_value(
$meta_instance,
$instance,
$instance->$initializer($value, $callback, $self);
}
-# NOTE:
-# the next bunch of methods will get bootstrapped
-# away in the Class::MOP bootstrapping section
-
-sub associated_class { $_[0]->{'associated_class'} }
-sub associated_methods { $_[0]->{'associated_methods'} }
-
-sub has_accessor { defined($_[0]->{'accessor'}) }
-sub has_reader { defined($_[0]->{'reader'}) }
-sub has_writer { defined($_[0]->{'writer'}) }
-sub has_predicate { defined($_[0]->{'predicate'}) }
-sub has_clearer { defined($_[0]->{'clearer'}) }
-sub has_builder { defined($_[0]->{'builder'}) }
-sub has_init_arg { defined($_[0]->{'init_arg'}) }
-sub has_default { defined($_[0]->{'default'}) }
-sub has_initializer { defined($_[0]->{'initializer'}) }
-
-sub accessor { $_[0]->{'accessor'} }
-sub reader { $_[0]->{'reader'} }
-sub writer { $_[0]->{'writer'} }
-sub predicate { $_[0]->{'predicate'} }
-sub clearer { $_[0]->{'clearer'} }
-sub builder { $_[0]->{'builder'} }
-sub init_arg { $_[0]->{'init_arg'} }
-sub initializer { $_[0]->{'initializer'} }
-sub definition_context { $_[0]->{'definition_context'} }
-
-# end bootstrapped away method section.
-# (all methods below here are kept intact)
-
-sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor }
-sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor }
-
sub get_read_method {
my $self = shift;
my $reader = $self->reader || $self->accessor;
}
}
-sub is_default_a_coderef {
- ('CODE' eq ref($_[0]->{'default'}))
-}
-
-sub default {
- my ($self, $instance) = @_;
- if (defined $instance && $self->is_default_a_coderef) {
- # if the default is a CODE ref, then
- # we pass in the instance and default
- # can return a value based on that
- # instance. Somewhat crude, but works.
- return $self->{'default'}->($instance);
- }
- $self->{'default'};
-}
-
# slots
sub slots { (shift)->name }
);
}
-sub set_value {
+sub set_value { shift->set_raw_value(@_) }
+sub get_value { shift->get_raw_value(@_) }
+
+sub set_raw_value {
my ($self, $instance, $value) = @_;
Class::MOP::Class->initialize(ref($instance))
->set_slot_value($instance, $self->name, $value);
}
-sub get_value {
+sub get_raw_value {
my ($self, $instance) = @_;
Class::MOP::Class->initialize(ref($instance))
sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
-sub process_accessors {
- warn 'The process_accessors method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n";
- goto &_process_accessors;
-}
-
sub _process_accessors {
my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
else {
my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
my $method;
- eval {
+ try {
if ( $method_ctx ) {
my $desc = "accessor $accessor";
if ( $accessor ne $self->name ) {
name => $accessor,
definition_context => $method_ctx,
);
+ }
+ catch {
+ confess "Could not create the '$type' method for " . $self->name . " because : $_";
};
- confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
$self->associate_method($method);
return ($accessor, $method);
}
}
+sub inline_get {
+ my $self = shift;
+ my ($instance) = @_;
+
+ return $self->associated_class->get_meta_instance->inline_get_slot_value(
+ $instance, $self->name );
+}
+
+sub inline_set {
+ my $self = shift;
+ my ( $instance, $value ) = @_;
+
+ return $self->associated_class->get_meta_instance->inline_set_slot_value(
+ $instance, $self->name, $value );
+}
+
+sub inline_has {
+ my $self = shift;
+ my ($instance) = @_;
+
+ return
+ $self->associated_class->get_meta_instance
+ ->inline_is_slot_initialized( $instance, $self->name );
+}
+
+sub inline_clear {
+ my $self = shift;
+ my ($instance) = @_;
+
+ return
+ $self->associated_class->get_meta_instance
+ ->inline_deinitialize_slot( $instance, $self->name );
+}
+
1;
__END__
initialization hash. For instance, if we have an C<init_arg> value of
C<-foo>, then the following code will Just Work.
- MyClass->meta->construct_instance( -foo => 'Hello There' );
+ MyClass->meta->new_object( -foo => 'Hello There' );
If an init_arg is not assigned, it will automatically use the
attribute's name. If C<init_arg> is explicitly set to C<undef>, the
Class::MOP::Attribute->new(
'doubled' => (
initializer => sub {
- my ( $instance, $value, $set ) = @_;
+ my ( $self, $value, $set, $attr ) = @_;
$set->( $value * 2 );
},
)
always return a subroutine reference, regardless of whether or not the
attribute is read- or write-only.
+=item B<< $attr->insertion_order >>
+
+If this attribute has been inserted into a class, this returns a zero
+based index regarding the order of insertion.
+
=back
=head2 Informational predicates
=item B<< $attr->has_builder >>
+=item B<< $attr->has_insertion_order >>
+
+This will be I<false> if this attribute has not be inserted into a class
+
=back
=head2 Value management
Sets the value without going through the accessor. Note that this
works even with read-only attributes.
+=item B<< $attr->set_raw_value($instance, $value) >>
+
+Sets the value with no side effects such as a trigger.
+
+This doesn't actually apply to Class::MOP attributes, only to subclasses.
+
=item B<< $attr->set_initial_value($instance, $value) >>
Sets the value without going through the accessor. This method is only
Returns the value without going through the accessor. Note that this
works even with write-only accessors.
+=item B<< $attr->get_raw_value($instance) >>
+
+Returns the value without any side effects such as lazy attributes.
+
+Doesn't actually apply to Class::MOP attributes, only to subclasses.
+
=item B<< $attr->has_value($instance) >>
Return a boolean indicating whether the attribute has been set in
This does not currently remove methods from the list returned by
C<associated_methods>.
+=item B<< $attr->inline_get >>
+
+=item B<< $attr->inline_set >>
+
+=item B<< $attr->inline_has >>
+
+=item B<< $attr->inline_clear >>
+
+These methods return a code snippet suitable for inlining the relevant
+operation. They expect strings containing variable names to be used in the
+inlining, like C<'$self'> or C<'$_[1]'>.
+
=back
=head2 Introspection
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/Class-MOP.git / blobdiff