lib/Moose/Meta/Method/Accessor/Native.pm

   1 package Moose::Meta::Method::Accessor::Native;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp qw( confess );
   7 use Scalar::Util qw( blessed weaken );
   8
   9 our $VERSION = '1.13';
  10 $VERSION = eval $VERSION;
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 use base 'Moose::Meta::Method::Accessor', 'Moose::Meta::Method::Delegation';
  14
  15 sub new {
  16     my $class   = shift;
  17     my %options = @_;
  18
  19     die "Cannot instantiate a $class object directly"
  20         if $class eq __PACKAGE__;
  21
  22     ( exists $options{attribute} )
  23         || confess "You must supply an attribute to construct with";
  24
  25     ( blessed( $options{attribute} )
  26             && $options{attribute}->isa('Class::MOP::Attribute') )
  27         || confess
  28         "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
  29
  30     ( $options{package_name} && $options{name} )
  31         || confess "You must supply the package_name and name parameters";
  32
  33     exists $options{curried_arguments}
  34         || ( $options{curried_arguments} = [] );
  35
  36     ( $options{curried_arguments}
  37             && ( 'ARRAY' eq ref $options{curried_arguments} ) )
  38         || confess
  39         'You must supply a curried_arguments which is an ARRAY reference';
  40
  41     $options{delegate_to_method} = lc( ( split /::/, $class)[-1] );
  42
  43     my $self = $class->_new( \%options );
  44
  45     weaken( $self->{'attribute'} );
  46
  47     $self->_initialize_body;
  48
  49     return $self;
  50 }
  51
  52 sub _new {
  53     my $class = shift;
  54     my $options = @_ == 1 ? $_[0] : {@_};
  55
  56     return bless $options, $class;
  57 }
  58
  59 sub _initialize_body {
  60     my $self = shift;
  61
  62     $self->{'body'} = $self->_eval_code( $self->_generate_method );
  63
  64     return;
  65 }
  66
  67 1;