package MooseX::Emulate::Class::Accessor::Fast;
use Moose::Role;
+use Class::MOP ();
+use Scalar::Util ();
-our $VERSION = '0.00400';
+our $VERSION = '0.00600';
=head1 NAME
=cut
+my $locate_metaclass = sub {
+ my $class = Scalar::Util::blessed($_[0]) || $_[0];
+ return Class::MOP::get_metaclass_by_name($class)
+ || Moose::Meta::Class->initialize($class);
+};
+
sub BUILD {
my $self = shift;
my %args;
sub mk_accessors{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
for my $attr_name (@_){
my $reader = $self->accessor_name_for($attr_name);
my $writer = $self->mutator_name_for( $attr_name);
#dont overwrite existing methods
if($reader eq $writer){
- my %opts = ( $self->can($reader) ? () : (accessor => $reader) );
+ my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) );
my $attr = $meta->add_attribute($attr_name, %opts);
if($attr_name eq $reader){
my $alias = "_${attr_name}_accessor";
- next if $self->can($alias);
- my @alias_method = $opts{accessor} ? ( $alias => $self->can($reader) )
- : ( $attr->process_accessors(accessor => $alias, 0 ) );
+ next if $meta->has_method($alias);
+ my @alias_method = $attr->process_accessors(accessor => $alias, 0);
$meta->add_method(@alias_method);
}
} else {
- my @opts = ( $self->can($writer) ? () : (writer => $writer) );
- push(@opts, (reader => $reader)) unless $self->can($reader);
+ my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) );
+ push(@opts, (reader => $reader)) unless $meta->has_method($reader);
$meta->add_attribute($attr_name, @opts);
}
}
sub mk_ro_accessors{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
for my $attr_name (@_){
my $reader = $self->accessor_name_for($attr_name);
- my @opts = ($self->can($reader) ? () : (reader => $reader) );
+ my @opts = ($meta->has_method($reader) ? () : (reader => $reader) );
my $attr = $meta->add_attribute($attr_name, @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 $self->can("_${attr_name}_accessor");
+ unless $meta->has_method("_${attr_name}_accessor");
}
}
}
#this is retarded.. but we need it for compatibility or whatever.
sub mk_wo_accessors{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
for my $attr_name (@_){
my $writer = $self->mutator_name_for($attr_name);
- my @opts = ($self->can($writer) ? () : (writer => $writer) );
+ my @opts = ($meta->has_method($writer) ? () : (writer => $writer) );
my $attr = $meta->add_attribute($attr_name, @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 $self->can("_${attr_name}_accessor");
+ unless $meta->has_method("_${attr_name}_accessor");
}
}
}
sub follow_best_practice{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
$meta->remove_method('mutator_name_for');
$meta->remove_method('accessor_name_for');
my $self = shift;
my $k = shift;
confess "Wrong number of arguments received" unless scalar @_;
+ my $meta = $locate_metaclass->($self);
- #my $writer = $self->mutator_name_for( $k );
confess "No such attribute '$k'"
- unless ( my $attr = $self->meta->find_attribute_by_name($k) );
- my $writer = $attr->writer || $attr->accessor;
+ unless ( my $attr = $meta->find_attribute_by_name($k) );
+ my $writer = $attr->get_write_method;
$self->$writer(@_ > 1 ? [@_] : @_);
}
sub get{
my $self = shift;
confess "Wrong number of arguments received" unless scalar @_;
-
+ my $meta = $locate_metaclass->($self);
my @values;
- #while( my $attr = $self->meta->find_attribute_by_name( shift(@_) ){
+
for( @_ ){
confess "No such attribute '$_'"
- unless ( my $attr = $self->meta->find_attribute_by_name($_) );
- my $reader = $attr->reader || $attr->accessor;
+ unless ( my $attr = $meta->find_attribute_by_name($_) );
+ my $reader = $attr->get_read_method;
@_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
}
return @values;
}
+sub make_accessor {
+ my($class, $field) = @_;
+ my $meta = $locate_metaclass->($class);
+ my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
+ my $reader = $attr->get_read_method_ref;
+ my $writer = $attr->get_write_method_ref;
+ return sub {
+ my $self = shift;
+ return $reader->($self) unless @_;
+ return $writer->($self,(@_ > 1 ? [@_] : @_));
+ }
+}
+
+
+sub make_ro_accessor {
+ my($class, $field) = @_;
+ my $meta = $locate_metaclass->($class);
+ my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
+ return $attr->get_read_method_ref;
+}
+
+
+sub make_wo_accessor {
+ my($class, $field) = @_;
+ my $meta = $locate_metaclass->($class);
+ my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
+ return $attr->get_write_method_ref;
+}
+
1;
=head2 meta