use Class::MOP::Method::Accessor;
use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype', 'weaken';
+use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.23';
+our $VERSION = '0.64';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Object';
-sub meta {
- require Class::MOP::Class;
- Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
-}
-
# NOTE: (meta-circularity)
# This method will be replaced in the
# boostrap section of Class::MOP, by
} else {
(is_default_a_coderef(\%options))
|| confess("References are not allowed as default values, you must ".
- "wrap then in a CODE reference (ex: sub { [] } and not [])")
+ "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
if exists $options{default} && ref $options{default};
}
if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
# 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;
return $self->associated_class->get_method($reader);
}
else {
- return sub { $self->get_value(@_) };
+ my $code = sub { $self->get_value(@_) };
+ if (my $class = $self->associated_class) {
+ return $class->method_metaclass->wrap(
+ $code,
+ package_name => $class->name,
+ name => '__ANON__'
+ );
+ }
+ else {
+ return $code;
+ }
}
}
return $self->associated_class->get_method($writer);
}
else {
- return sub { $self->set_value(@_) };
+ my $code = sub { $self->set_value(@_) };
+ if (my $class = $self->associated_class) {
+ return $class->method_metaclass->wrap(
+ $code,
+ package_name => $class->name,
+ name => '__ANON__'
+ );
+ }
+ else {
+ return $code;
+ }
}
}
sub is_default_a_coderef {
- ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || ''))
+ ('CODE' eq ref($_[0]->{'$!default'} || $_[0]->{default}))
}
sub default {
sub process_accessors {
my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
- if (reftype($accessor)) {
- (reftype($accessor) eq 'HASH')
+ if (ref($accessor)) {
+ (ref($accessor) eq 'HASH')
|| confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
my ($name, $method) = %{$accessor};
- $method = $self->accessor_metaclass->wrap($method);
+ $method = $self->accessor_metaclass->wrap(
+ $method,
+ package_name => $self->associated_class->name,
+ name => $name,
+ );
$self->associate_method($method);
return ($name, $method);
}
attribute => $self,
is_inline => $inline_me,
accessor_type => $type,
+ package_name => $self->associated_class->name,
+ name => $accessor,
);
};
confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
{
my $_remove_accessor = sub {
my ($accessor, $class) = @_;
- if (reftype($accessor) && reftype($accessor) eq 'HASH') {
+ if (ref($accessor) && ref($accessor) eq 'HASH') {
($accessor) = keys %{$accessor};
}
my $method = $class->get_method($accessor);
=head1 SYNOPSIS
- Class::MOP::Attribute->new('$foo' => (
+ Class::MOP::Attribute->new( foo => (
accessor => 'foo', # dual purpose get/set accessor
predicate => 'has_foo' # predicate check for defined-ness
init_arg => '-foo', # class->new will look for a -foo key
default => 'BAR IS BAZ!' # if no -foo key is provided, use this
));
- Class::MOP::Attribute->new('$.bar' => (
+ Class::MOP::Attribute->new( bar => (
reader => 'bar', # getter
writer => 'set_bar', # setter
predicate => 'has_bar' # predicate check for defined-ness
NOTE: If no reader/writer/accessor was specified, this will use the
attribute get_value/set_value methods, which can be very inefficient.
+=item B<has_read_method>
+
+=item B<has_write_method>
+
+Return whether a method exists suitable for reading / writing the value
+of the attribute in the associated class. Suitable for use whether
+C<reader> and C<writer> or C<accessor> was used.
+
=back
=head2 Informational predicates