## --------------------------------------------------------
## Class::MOP::Method::Accessor
-Class::MOP::Method::Accessor->meta->add_attribute(
+Class::MOP::Method::Attribute->meta->add_attribute(
Class::MOP::Attribute->new('attribute' => (
reader => {
- 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
+ 'associated_attribute' => \&Class::MOP::Method::Attribute::associated_attribute
},
))
);
-Class::MOP::Method::Accessor->meta->add_attribute(
+Class::MOP::Method::Attribute->meta->add_attribute(
Class::MOP::Attribute->new('accessor_type' => (
- reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
+ reader => { 'accessor_type' => \&Class::MOP::Method::Attribute::accessor_type },
))
);
Class::MOP::Method::Inlined
Class::MOP::Method::Accessor
+ Class::MOP::Method::Attribute
Class::MOP::Method::Constructor
Class::MOP::Method::Wrapped
/;
use warnings;
use Class::MOP::Method::Accessor;
+use Class::MOP::Method::Reader;
+use Class::MOP::Method::Writer;
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
## load em up ...
sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
+sub method_metaclasses {
+ {
+ reader => 'Class::MOP::Method::Reader',
+ #writer => 'Class::MOP::Method::Writer',
+ }
+}
sub _process_accessors {
my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
$method_ctx->{description} = $desc;
}
- $method = $self->accessor_metaclass->new(
+ my $method_metaclass = $self->method_metaclasses->{$type} || $self->accessor_metaclass;
+
+ $method = $method_metaclass->new(
attribute => $self,
is_inline => $inline_me,
accessor_type => $type,
}
my $method = $class->get_method($accessor);
$class->remove_method($accessor)
- if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
+ if (ref($method) && $method->isa('Class::MOP::Method::Attribute'));
};
sub remove_accessors {
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
-use base 'Class::MOP::Method::Generated';
-
-sub new {
- 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";
-
- (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 $Class::MOP::Method::UPGRADE_ERROR_TEXT";
-
- my $self = $class->_new(\%options);
-
- # we don't want this creating
- # a cycle in the code, if not
- # needed
- weaken($self->{'attribute'});
-
- return $self;
-}
-
-sub _new {
- my $class = shift;
-
- return Class::MOP::Class->initialize($class)->new_object(@_)
- if $class ne __PACKAGE__;
-
- my $params = @_ == 1 ? $_[0] : {@_};
-
- return bless {
- # inherited from Class::MOP::Method
- body => $params->{body},
- associated_metaclass => $params->{associated_metaclass},
- package_name => $params->{package_name},
- name => $params->{name},
- original_method => $params->{original_method},
-
- # inherit from Class::MOP::Generated
- is_inline => $params->{is_inline} || 0,
- definition_context => $params->{definition_context},
-
- # defined in this class
- attribute => $params->{attribute},
- accessor_type => $params->{accessor_type},
- } => $class;
-}
-
-## accessors
-
-sub associated_attribute { (shift)->{'attribute'} }
-sub accessor_type { (shift)->{'accessor_type'} }
-
-## factory
+use base 'Class::MOP::Method::Attribute';
sub _initialize_body {
my $self = shift;
1;
+# XXX - UPDATE DOCS
__END__
=pod
--- /dev/null
+
+package Class::MOP::Method::Attribute;
+
+use strict;
+use warnings;
+
+use Carp 'confess';
+use Scalar::Util 'blessed', 'weaken';
+
+our $VERSION = '0.88';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Method::Generated';
+
+sub new {
+ my $class = shift;
+ my %options = @_;
+
+ (exists $options{attribute})
+ || confess "You must supply an attribute to construct with";
+
+ (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 $Class::MOP::Method::UPGRADE_ERROR_TEXT";
+
+ my $self = $class->_new(\%options);
+
+ # we don't want this creating
+ # a cycle in the code, if not
+ # needed
+ weaken($self->{'attribute'});
+
+ return $self;
+}
+
+sub _new {
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
+
+ $options->{is_inline} ||= 0;
+
+ return bless $options, $class;
+}
+
+## accessors
+
+sub associated_attribute { (shift)->{'attribute'} }
+sub accessor_type { (shift)->{'accessor_type'} }
+
+## factory
+
+sub initialize_body {
+ Carp::cluck('The initialize_body method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n");
+ shift->_initialize_body;
+}
+
+1;
+
+# XXX - UPDATE DOCS
+__END__
+
+=pod
+
+=head1 NAME
+
+Class::MOP::Method::Attribute - Method Meta Object for accessors
+
+=head1 SYNOPSIS
+
+ use Class::MOP::Method::Accessor;
+
+ my $reader = Class::MOP::Method::Accessor->new(
+ attribute => $attribute,
+ is_inline => 1,
+ accessor_type => 'reader',
+ );
+
+ $reader->body->execute($instance); # call the reader method
+
+=head1 DESCRIPTION
+
+This is a subclass of <Class::MOP::Method> which is used by
+C<Class::MOP::Attribute> to generate accessor code. It handles
+generation of readers, writers, predicates and clearers. For each type
+of method, it can either create a subroutine reference, or actually
+inline code by generating a string and C<eval>'ing it.
+
+=head1 METHODS
+
+=over 4
+
+=item B<< Class::MOP::Method::Accessor->new(%options) >>
+
+This returns a new C<Class::MOP::Method::Accessor> based on the
+C<%options> provided.
+
+=over 4
+
+=item * attribute
+
+This is the C<Class::MOP::Attribute> for which accessors are being
+generated. This option is required.
+
+=item * accessor_type
+
+This is a string which should be one of "reader", "writer",
+"accessor", "predicate", or "clearer". This is the type of method
+being generated. This option is required.
+
+=item * is_inline
+
+This indicates whether or not the accessor should be inlined. This
+defaults to false.
+
+=item * name
+
+The method name (without a package name). This is required.
+
+=item * package_name
+
+The package name for the method. This is required.
+
+=back
+
+=item B<< $metamethod->accessor_type >>
+
+Returns the accessor type which was passed to C<new>.
+
+=item B<< $metamethod->is_inline >>
+
+Returns a boolean indicating whether or not the accessor is inlined.
+
+=item B<< $metamethod->associated_attribute >>
+
+This returns the L<Class::MOP::Attribute> object which was passed to
+C<new>.
+
+=item B<< $metamethod->body >>
+
+The method itself is I<generated> when the accessor object is
+constructed.
+
+=back
+
+=head1 AUTHORS
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package Class::MOP::Method::Reader;
+
+use strict;
+use warnings;
+
+use Carp 'confess';
+use Scalar::Util 'blessed', 'weaken';
+
+our $VERSION = '0.88';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Method::Attribute';
+
+sub associated_attribute { (shift)->{'attribute'} }
+
+## factory
+
+sub _initialize_body {
+ my $self = shift;
+
+ my $method_name = join "_" => (
+ '_generate',
+ 'method',
+ ($self->is_inline ? 'inline' : ())
+ );
+
+ $self->{'body'} = $self->$method_name();
+}
+
+## generators
+
+sub generate_method {
+ Carp::cluck('The generate_reader_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n");
+ shift->_generate_method;
+}
+
+sub _generate_method {
+ my $attr = (shift)->associated_attribute;
+ return sub {
+ confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+ $attr->get_value($_[0]);
+ };
+}
+
+## Inline methods
+
+sub generate_method_inline {
+ Carp::cluck('The generate_reader_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n");
+ shift->_generate_method_inline;
+}
+
+sub _generate_method_inline {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+ my $attr_name = $attr->name;
+ my $meta_instance = $attr->associated_class->instance_metaclass;
+
+ my ( $code, $e ) = $self->_eval_closure(
+ {},
+ 'sub {'
+ . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
+ . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
+ . '}'
+ );
+ confess "Could not generate inline reader because : $e" if $e;
+
+ return $code;
+}
+
+1;
+
+# XXX - UPDATE DOCS
+__END__
+
+
+=pod
+
+=head1 NAME
+
+Class::MOP::Method::Reader - Method Meta Object for accessors
+
+=head1 SYNOPSIS
+
+ use Class::MOP::Method::Reader;
+
+ my $reader = Class::MOP::Method::Reader->new(
+ attribute => $attribute,
+ is_inline => 1,
+ );
+
+ $reader->body->execute($instance); # call the reader method
+
+=head1 DESCRIPTION
+
+This is a subclass of <Class::MOP::Method> which is used by
+C<Class::MOP::Attribute> to generate accessor code. It handles
+generation of readers, writers, predicates and clearers. For each type
+of method, it can either create a subroutine reference, or actually
+inline code by generating a string and C<eval>'ing it.
+
+=head1 METHODS
+
+=over 4
+
+=item B<< Class::MOP::Method::Accessor->new(%options) >>
+
+This returns a new C<Class::MOP::Method::Accessor> based on the
+C<%options> provided.
+
+=over 4
+
+=item * attribute
+
+This is the C<Class::MOP::Attribute> for which accessors are being
+generated. This option is required.
+
+=item * accessor_type
+
+This is a string which should be one of "reader", "writer",
+"accessor", "predicate", or "clearer". This is the type of method
+being generated. This option is required.
+
+=item * is_inline
+
+This indicates whether or not the accessor should be inlined. This
+defaults to false.
+
+=item * name
+
+The method name (without a package name). This is required.
+
+=item * package_name
+
+The package name for the method. This is required.
+
+=back
+
+=item B<< $metamethod->accessor_type >>
+
+Returns the accessor type which was passed to C<new>.
+
+=item B<< $metamethod->is_inline >>
+
+Returns a boolean indicating whether or not the accessor is inlined.
+
+=item B<< $metamethod->associated_attribute >>
+
+This returns the L<Class::MOP::Attribute> object which was passed to
+C<new>.
+
+=item B<< $metamethod->body >>
+
+The method itself is I<generated> when the accessor object is
+constructed.
+
+=back
+
+=head1 AUTHORS
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
use strict;
use warnings;
-use Test::More tests => 50;
+use Test::More tests => 53;
BEGIN {
use_ok('Class::MOP');
use_ok('Class::MOP::Method::Inlined');
use_ok('Class::MOP::Method::Generated');
use_ok('Class::MOP::Method::Accessor');
+ use_ok('Class::MOP::Method::Attribute');
use_ok('Class::MOP::Method::Constructor');
use_ok('Class::MOP::Instance');
use_ok('Class::MOP::Object');
'Class::MOP::Method::Inlined' => Class::MOP::Method::Inlined->meta,
'Class::MOP::Method::Generated' => Class::MOP::Method::Generated->meta,
'Class::MOP::Method::Accessor' => Class::MOP::Method::Accessor->meta,
+ 'Class::MOP::Method::Attribute' => Class::MOP::Method::Attribute->meta,
'Class::MOP::Method::Constructor' =>
Class::MOP::Method::Constructor->meta,
'Class::MOP::Package' => Class::MOP::Package->meta,
Class::MOP::Instance->meta,
Class::MOP::Method->meta,
Class::MOP::Method::Accessor->meta,
+ Class::MOP::Method::Attribute->meta,
Class::MOP::Method::Constructor->meta,
Class::MOP::Method::Generated->meta,
Class::MOP::Method::Inlined->meta,
Class::MOP::Instance
Class::MOP::Method
Class::MOP::Method::Accessor
+ Class::MOP::Method::Attribute
Class::MOP::Method::Constructor
Class::MOP::Method::Generated
Class::MOP::Method::Inlined
::ok($meta->has_method('get_baz'), '... a reader has been created');
::ok($meta->has_method('set_baz'), '... a writer has been created');
- ::isa_ok($meta->get_method('get_baz'), 'Class::MOP::Method::Accessor');
+ ::isa_ok($meta->get_method('get_baz'), 'Class::MOP::Method::Reader');
::isa_ok($meta->get_method('set_baz'), 'Class::MOP::Method::Accessor');
}
use strict;
use warnings;
-use Test::More tests => 72;
+use Test::More tests => 73;
use Test::Exception;
use Class::MOP;
_set_initial_slot_value
is_lazy
+ method_metaclasses
name
has_accessor accessor
has_writer writer
{
my $bar_accessor = $meta->get_method('bar');
- isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bar_accessor, 'Class::MOP::Method::Reader');
isa_ok($bar_accessor, 'Class::MOP::Method');
ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
# check out accessors too
{
my $bar_accessor = $meta->get_method('bar');
- isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bar_accessor, 'Class::MOP::Method::Reader');
isa_ok($bar_accessor, 'Class::MOP::Method');
ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
{
my $bar_accessor = $meta->find_method_by_name('bar');
- isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bar_accessor, 'Class::MOP::Method::Reader');
isa_ok($bar_accessor, 'Class::MOP::Method');
ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
my $baz_accessor = $meta->get_method('baz');
- isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($baz_accessor, 'Class::MOP::Method::Reader');
isa_ok($baz_accessor, 'Class::MOP::Method');
ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
# check out accessors too
{
my $bar_accessor = $meta->find_method_by_name('bar');
- isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bar_accessor, 'Class::MOP::Method::Reader');
isa_ok($bar_accessor, 'Class::MOP::Method');
ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
my $baz_accessor = $meta->get_method('baz');
- isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($baz_accessor, 'Class::MOP::Method::Reader');
isa_ok($baz_accessor, 'Class::MOP::Method');
ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
{
my $bar_accessor = $meta->find_method_by_name('bar');
- isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bar_accessor, 'Class::MOP::Method::Reader');
isa_ok($bar_accessor, 'Class::MOP::Method');
ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
my $baz_accessor = $meta->find_method_by_name('baz');
- isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($baz_accessor, 'Class::MOP::Method::Reader');
isa_ok($baz_accessor, 'Class::MOP::Method');
ok($baz_accessor->is_inline, '... the baz accessor is inlined');
my $bah_accessor = $meta->get_method('bah');
- isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bah_accessor, 'Class::MOP::Method::Reader');
isa_ok($bah_accessor, 'Class::MOP::Method');
ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
# check out accessors too
{
my $bar_accessor = $meta->find_method_by_name('bar');
- isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bar_accessor, 'Class::MOP::Method::Reader');
isa_ok($bar_accessor, 'Class::MOP::Method');
ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
my $baz_accessor = $meta->find_method_by_name('baz');
- isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($baz_accessor, 'Class::MOP::Method::Reader');
isa_ok($baz_accessor, 'Class::MOP::Method');
ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
my $bah_accessor = $meta->get_method('bah');
- isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
+ isa_ok($bah_accessor, 'Class::MOP::Method::Reader');
isa_ok($bah_accessor, 'Class::MOP::Method');
ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
projects / gitmo/Class-MOP.git / commitdiff