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

   1 package Moose::Meta::Method::Accessor::Native::Hash::accessor;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '1.13';
   7 $VERSION = eval $VERSION;
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use base qw(
  11     Moose::Meta::Method::Accessor::Native::Hash::set
  12     Moose::Meta::Method::Accessor::Native::Hash::get
  13 );
  14
  15 sub _generate_method {
  16     my $self = shift;
  17
  18     my $inv = '$self';
  19
  20     my $code = 'sub {';
  21     $code .= "\n" . $self->_inline_pre_body(@_);
  22
  23     $code .= "\n" . 'my $self = shift;';
  24
  25     $code .= "\n" . $self->_inline_curried_arguments;
  26
  27     $code .= "\n" . $self->_inline_check_lazy($inv);
  28
  29     my $slot_access = $self->_inline_get($inv);
  30
  31     # get
  32     $code .= "\n" . 'if ( @_ == 1 ) {';
  33
  34     $code .= "\n" . $self->_inline_check_var_is_valid_index('$_[0]');
  35
  36     $code
  37         .= "\n"
  38         . 'return '
  39         . $self
  40         ->Moose::Meta::Method::Accessor::Native::Hash::get::_return_value(
  41         $slot_access)
  42         . ';';
  43
  44     # set
  45     $code .= "\n" . '} else {';
  46
  47     $code .= "\n" . $self->_inline_check_argument_count;
  48
  49     $code
  50         .= "\n"
  51         . $self
  52         ->Moose::Meta::Method::Accessor::Native::Hash::set::_inline_check_arguments;
  53
  54     my $potential_value = $self->_potential_value($slot_access);
  55
  56     $code .= "\n"
  57         . $self->_inline_tc_code(
  58         $potential_value,
  59         $slot_access,
  60         );
  61
  62     $code .= "\n" . $self->_inline_get_old_value_for_trigger($inv);
  63     $code .= "\n" . $self->_inline_capture_return_value($slot_access);
  64
  65     $code
  66         .= "\n" . $self->_inline_store( $inv, '[' . $potential_value . ']' );
  67
  68     $code .= "\n" . $self->_inline_post_body(@_);
  69     $code .= "\n" . $self->_inline_trigger( $inv, $slot_access, '@old' );
  70
  71     $code .= "\n}";
  72     $code .= "\n}";
  73
  74     return $code;
  75 }
  76
  77 # If we get one argument we won't check the argument count
  78 sub _minimum_arguments {2}
  79 sub _maximum_arguments {2}
  80
  81 sub _adds_members {1}
  82
  83 sub _potential_value {
  84     my ( $self, $slot_access ) = @_;
  85
  86     return "%{ $slot_access, @_ }";
  87 }
  88
  89 sub _new_members {'$_[1]'}
  90
  91 1;