From: Florian Ragwitz Date: Tue, 3 Feb 2009 18:28:02 +0000 (+0000) Subject: Make list assignment work. X-Git-Tag: 0.00800~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b41ad5fb702ac48ccff6d10c6fe4bc483038d64f;p=gitmo%2FMooseX-Emulate-Class-Accessor-Fast.git Make list assignment work. --- diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast.pm b/lib/MooseX/Emulate/Class/Accessor/Fast.pm index 91c218c..b6b4065 100644 --- a/lib/MooseX/Emulate/Class/Accessor/Fast.pm +++ b/lib/MooseX/Emulate/Class/Accessor/Fast.pm @@ -4,6 +4,8 @@ use Moose::Role; use Class::MOP (); use Scalar::Util (); +use MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor (); + our $VERSION = '0.00701'; =head1 NAME @@ -116,7 +118,9 @@ sub mk_accessors{ #dont overwrite existing methods if($reader eq $writer){ my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) ); - my $attr = $meta->add_attribute($attr_name, %opts); + my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, %opts, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ); if($attr_name eq $reader){ my $alias = "_${attr_name}_accessor"; next if $meta->has_method($alias); @@ -126,7 +130,9 @@ sub mk_accessors{ } else { my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) ); push(@opts, (reader => $reader)) unless $meta->has_method($reader); - $meta->add_attribute($attr_name, @opts); + my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, @opts, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ); } } } @@ -149,7 +155,9 @@ sub mk_ro_accessors{ if $meta->find_attribute_by_name($attr_name); my $reader = $self->accessor_name_for($attr_name); my @opts = ($meta->has_method($reader) ? () : (reader => $reader) ); - my $attr = $meta->add_attribute($attr_name, @opts); + my $attr = $meta->add_attribute($attr_name, @opts, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ) if scalar(@opts); if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){ $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref) unless $meta->has_method("_${attr_name}_accessor"); @@ -176,7 +184,9 @@ sub mk_wo_accessors{ if $meta->find_attribute_by_name($attr_name); my $writer = $self->mutator_name_for($attr_name); my @opts = ($meta->has_method($writer) ? () : (writer => $writer) ); - my $attr = $meta->add_attribute($attr_name, @opts); + my $attr = $meta->add_attribute($attr_name, @opts, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ) if scalar(@opts); if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){ $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref) unless $meta->has_method("_${attr_name}_accessor"); @@ -255,7 +265,9 @@ sub get{ sub make_accessor { my($class, $field) = @_; my $meta = $locate_metaclass->($class); - my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); + my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ); my $reader = $attr->get_read_method_ref; my $writer = $attr->get_write_method_ref; return sub { @@ -269,7 +281,9 @@ sub make_accessor { sub make_ro_accessor { my($class, $field) = @_; my $meta = $locate_metaclass->($class); - my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); + my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ); return $attr->get_read_method_ref; } @@ -277,7 +291,9 @@ sub make_ro_accessor { sub make_wo_accessor { my($class, $field) = @_; my $meta = $locate_metaclass->($class); - my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); + my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field, + traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] + ); return $attr->get_write_method_ref; } diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm b/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm new file mode 100644 index 0000000..7dc9c81 --- /dev/null +++ b/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm @@ -0,0 +1,51 @@ +package MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor; + +use Moose; + +extends 'Moose::Meta::Method::Accessor'; + +sub generate_accessor_method { + my $attr = (shift)->associated_attribute; + return sub { + my $self = shift; + $attr->set_value($self, $_[0]) if scalar(@_) == 1; + $attr->set_value($self, [@_]) if scalar(@_) > 1; + $attr->get_value($self); + }; +} + +sub generate_writer_method { + my $attr = (shift)->associated_attribute; + return sub { + my $self = shift; + $attr->set_value($self, $_[0]) if scalar(@_) == 1; + $attr->set_value($self, [@_]) if scalar(@_) > 1; + }; +} + +# FIXME - this is shite, but it does work... +sub generate_accessor_method_inline { + my $attr = (shift)->associated_attribute; + my $attr_name = $attr->name; + my $meta_instance = $attr->associated_class->instance_metaclass; + + my $code = eval "sub { + my \$self = shift; + \$self->{'$attr_name'} = \$_[0] if scalar(\@_) == 1; + \$self->{'$attr_name'} = [\@_] if scalar(\@_) > 1; + \$self->{'$attr_name'}; + }"; + confess "Could not generate inline accessor because : $@" if $@; + + return $code; +} + +{ + my $meta = __PACKAGE__->meta; + $meta->add_method(generate_writer_method_inline => $meta->get_method('generate_accessor_method_inline')); +} + +no Moose; +__PACKAGE__->meta->make_immutable; + +1; diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm b/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm new file mode 100644 index 0000000..4941f1f --- /dev/null +++ b/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm @@ -0,0 +1,6 @@ +package MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute; +use Moose::Role; + +sub accessor_metaclass { 'MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor' } + +1;