lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm

   1 package MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor;
   2
   3 use Moose;
   4
   5 extends 'Moose::Meta::Method::Accessor';
   6
   7 sub generate_accessor_method {
   8     my $attr = (shift)->associated_attribute;
   9     return sub {
  10         my $self = shift;
  11         $attr->set_value($self, $_[0]) if scalar(@_) == 1;
  12         $attr->set_value($self, [@_]) if scalar(@_) > 1;
  13         $attr->get_value($self);
  14     };
  15 }
  16
  17 sub generate_writer_method {
  18     my $attr = (shift)->associated_attribute;
  19     return sub {
  20         my $self = shift;
  21         $attr->set_value($self, $_[0]) if scalar(@_) == 1;
  22         $attr->set_value($self, [@_]) if scalar(@_) > 1;
  23     };
  24 }
  25
  26 # FIXME - this is shite, but it does work...
  27 sub generate_accessor_method_inline {
  28     my $attr          = (shift)->associated_attribute;
  29     my $attr_name     = $attr->name;
  30     my $meta_instance = $attr->associated_class->instance_metaclass;
  31
  32     my $code = eval "sub {
  33         my \$self = shift;
  34         \$self->{'$attr_name'} = \$_[0] if scalar(\@_) == 1;
  35         \$self->{'$attr_name'} = [\@_] if scalar(\@_) > 1;
  36         \$self->{'$attr_name'};
  37     }";
  38     confess "Could not generate inline accessor because : $@" if $@;
  39
  40     return $code;
  41 }
  42
  43 {
  44     my $meta = __PACKAGE__->meta;
  45     $meta->add_method(generate_writer_method_inline => $meta->get_method('generate_accessor_method_inline'));
  46 }
  47
  48 no Moose;
  49
  50 1;