MooseX::Emulate::Class::Accessor::Fast - Emulate Class::Accessor::Fast behavior using Moose attributes

MooseX-Emulate-Class-Accessor-Fast documentation Contained in the MooseX-Emulate-Class-Accessor-Fast distribution.

Index

Code Index:

NAME

Top

MooseX::Emulate::Class::Accessor::Fast - Emulate Class::Accessor::Fast behavior using Moose attributes

SYNOPSYS

Top

    package MyClass;
    use Moose;

    with 'MooseX::Emulate::Class::Accessor::Fast';




    #fields with readers and writers
    __PACKAGE__->mk_accessors(qw/field1 field2/);
    #fields with readers only
    __PACKAGE__->mk_ro_accessors(qw/field3 field4/);
    #fields with writers only
    __PACKAGE__->mk_wo_accessors(qw/field5 field6/);

DESCRIPTION

Top

This module attempts to emulate the behavior of Class::Accessor::Fast as accurately as possible using the Moose attribute system. The public API of Class::Accessor::Fast is wholly supported, but the private methods are not. If you are only using the public methods (as you should) migration should be a matter of switching your use base line to a with line.

While I have attempted to emulate the behavior of Class::Accessor::Fast as closely as possible bugs may still be lurking in edge-cases.

BEHAVIOR

Top

Simple documentation is provided here for your convenience, but for more thorough documentation please see Class::Accessor::Fast and Class::Accessor.

A note about introspection

Please note that, at this time, the is flag attribute is not being set. To determine the reader and writer methods using introspection in later versions of Class::MOP ( > 0.38) please use the get_read_method and get_write_method methods in Class::MOP::Attribute. Example

    # with Class::MOP <= 0.38
    my $attr = $self->meta->find_attribute_by_name($field_name);
    my $reader_method = $attr->reader || $attr->accessor;
    my $writer_method = $attr->writer || $attr->accessor;

    # with Class::MOP > 0.38
    my $attr = $self->meta->find_attribute_by_name($field_name);
    my $reader_method = $attr->get_read_method;
    my $writer_method = $attr->get_write_method;

METHODS

Top

BUILD $self %args

Change the default Moose class building to emulate the behavior of C::A::F and store arguments in the instance hashref.

mk_accessors @field_names

Create read-write accessors. An attribute named $field_name will be created. The name of the c<reader> and writer methods will be determined by the return value of accessor_name_for and mutator_name_for, which by default return the name passed unchanged. If the accessor and mutator names are equal the accessor attribute will be passes to Moose, otherwise the reader and writer attributes will be passed. Please see Class::MOP::Attribute for more information.

mk_ro_accessors @field_names

Create read-only accessors.

mk_ro_accessors @field_names

Create write-only accessors.

follow_best_practices

Preface readers with 'get_' and writers with 'set_'. See original Class::Accessor documentation for more information.

mutator_name_for

accessor_name_for

See original Class::Accessor documentation for more information.

set

See original Class::Accessor documentation for more information.

get

See original Class::Accessor documentation for more information.

meta

See Moose::Meta::Class.

SEE ALSO

Top

Moose, Moose::Meta::Attribute, Class::Accessor, Class::Accessor::Fast, Class::MOP::Attribute, MooseX::Adopt::Class::Accessor::Fast

AUTHORS

Top

Guillermo Roditi (groditi) <groditi@cpan.org>

With contributions from:

Tomas Doran (t0m) <bobtfish@bobtfish.net>
Florian Ragwitz (rafl) <rafl@debian.org>

LICENSE

Top

You may distribute this code under the same terms as Perl itself.

MooseX-Emulate-Class-Accessor-Fast documentation Contained in the MooseX-Emulate-Class-Accessor-Fast distribution. 
package MooseX::Emulate::Class::Accessor::Fast;

use Moose::Role;
use Class::MOP ();
use Scalar::Util ();

use MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor ();

our $VERSION = '0.00903';


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 { }

around 'BUILD' => sub {
  my $orig = shift;
  my $self = shift;
  my %args = %{ $_[0] };
  $self->$orig(\%args);
  my @extra = grep { !exists($self->{$_}) } keys %args;
  @{$self}{@extra} = @args{@extra};
  return $self;
};


sub mk_accessors {
  my $self = shift;
  my $meta = $locate_metaclass->($self);
  my $class = $meta->name;
  confess("You are trying to modify ${class}, which has been made immutable, this is ".
    "not supported. Try subclassing ${class}, rather than monkeypatching it")
    if $meta->is_immutable;

  for my $attr_name (@_){
    $meta->remove_attribute($attr_name)
      if $meta->find_attribute_by_name($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 = ( $meta->has_method($reader) ? ( is => 'bare' ) : (accessor => $reader) );
      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);
        $meta->add_method($alias => $attr->get_read_method_ref);
      }
    } else {
      my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) );
      push(@opts, (reader => $reader)) unless $meta->has_method($reader);
      my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, @opts,
        traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
      );
    }
  }
}


sub mk_ro_accessors {
  my $self = shift;
  my $meta = $locate_metaclass->($self);
  my $class = $meta->name;
  confess("You are trying to modify ${class}, which has been made immutable, this is ".
    "not supported. Try subclassing ${class}, rather than monkeypatching it")
    if $meta->is_immutable;
  for my $attr_name (@_){
    $meta->remove_attribute($attr_name)
      if $meta->find_attribute_by_name($attr_name);
    my $reader = $self->accessor_name_for($attr_name);
    my @opts = ($meta->has_method($reader) ? (is => 'bare') : (reader => $reader) );
    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");
    }
  }
}


#this is retarded.. but we need it for compatibility or whatever.
sub mk_wo_accessors {
  my $self = shift;
  my $meta = $locate_metaclass->($self);
  my $class = $meta->name;
  confess("You are trying to modify ${class}, which has been made immutable, this is ".
    "not supported. Try subclassing ${class}, rather than monkeypatching it")
    if $meta->is_immutable;
  for my $attr_name (@_){
    $meta->remove_attribute($attr_name)
      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,
      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");
    }
  }
}


sub follow_best_practice {
  my $self = shift;
  my $meta = $locate_metaclass->($self);

  $meta->remove_method('mutator_name_for');
  $meta->remove_method('accessor_name_for');
  $meta->add_method('mutator_name_for',  sub{ return "set_".$_[1] });
  $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] });
}


sub mutator_name_for  { return $_[1] }
sub accessor_name_for { return $_[1] }


sub set {
  my $self = shift;
  my $k = shift;
  confess "Wrong number of arguments received" unless scalar @_;
  my $meta = $locate_metaclass->($self);

  confess "No such attribute  '$k'"
    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;

  for( @_ ){
    confess "No such attribute  '$_'"
      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,
      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'],
     is => 'bare',
  );
  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,
      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'],
     is => 'bare',
  );
  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,
      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'],
      is => 'bare',
  );
  return $attr->get_write_method_ref;
}

1;