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

   1 package Moose::Meta::Method::Accessor::Native::Hash::set;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Scalar::Util qw( looks_like_number );
   7
   8 our $VERSION = '1.16';
   9 $VERSION = eval $VERSION;
  10 our $AUTHORITY = 'cpan:STEVAN';
  11
  12 use Moose::Role;
  13
  14 with 'Moose::Meta::Method::Accessor::Native::Hash::Writer' => {
  15     -excludes => [
  16         qw(
  17             _minimum_arguments
  18             _maximum_arguments
  19             _inline_process_arguments
  20             _inline_check_arguments
  21             _inline_optimized_set_new_value
  22             _return_value
  23             )
  24     ],
  25 };
  26
  27 sub _minimum_arguments { 2 }
  28
  29 sub _maximum_arguments { undef }
  30
  31 around _inline_check_argument_count => sub {
  32     my $orig = shift;
  33     my $self = shift;
  34
  35     return
  36         $self->$orig(@_) . "\n"
  37         . $self->_inline_throw_error(
  38         q{'You must pass an even number of arguments to set'})
  39         . ' if @_ % 2;';
  40 };
  41
  42 sub _inline_process_arguments {
  43     my $self = shift;
  44
  45     return 'my @keys_idx = grep { ! ($_ % 2) } 0..$#_;' . "\n"
  46         . 'my @values_idx = grep { $_ % 2 } 0..$#_;';
  47 }
  48
  49 sub _inline_check_arguments {
  50     my $self = shift;
  51
  52     return
  53         'for (@keys_idx) {' . "\n"
  54         . $self->_inline_throw_error(
  55         q{'Hash keys passed to set must be defined'})
  56         . ' unless defined $_[$_];' . "\n" . '}';
  57 }
  58
  59 sub _adds_members { 1 }
  60
  61 sub _potential_value {
  62     my ( $self, $slot_access ) = @_;
  63
  64     return "{ %{ ($slot_access) }, \@_ }";
  65 }
  66
  67 sub _new_members { '@_[ @values_idx ]' }
  68
  69 sub _inline_optimized_set_new_value {
  70     my ( $self, $inv, $new, $slot_access ) = @_;
  71
  72     return "\@{ ($slot_access) }{ \@_[ \@keys_idx] } = \@_[ \@values_idx ]";
  73 }
  74
  75 sub _return_value {
  76     my ( $self, $slot_access ) = @_;
  77
  78     return "return wantarray ? \@{ ($slot_access) }{ \@_[ \@keys_idx ] } : ${slot_access}->{ \$_[ \$keys_idx[0] ] };";
  79 }
  80
  81 no Moose::Role;
  82
  83 1;