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.14';
   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             )
  23     ],
  24 };
  25
  26 sub _minimum_arguments { 2 }
  27
  28 sub _maximum_arguments { undef }
  29
  30 around _inline_check_argument_count => sub {
  31     my $orig = shift;
  32     my $self = shift;
  33
  34     return
  35         $self->$orig(@_) . "\n"
  36         . $self->_inline_throw_error(
  37         q{'You must pass an even number of arguments to set'})
  38         . ' if @_ % 2;';
  39 };
  40
  41 sub _inline_process_arguments {
  42     my $self = shift;
  43
  44     return 'my @keys_idx = grep { ! ($_ % 2) } 0..$#_;' . "\n"
  45         . 'my @values_idx = grep { $_ % 2 } 0..$#_;';
  46 }
  47
  48 sub _inline_check_arguments {
  49     my $self = shift;
  50
  51     return
  52         'for (@keys_idx) {' . "\n"
  53         . $self->_inline_throw_error(
  54         q{'Hash keys passed to set must be defined'})
  55         . ' unless defined $_[$_];' . "\n" . '}';
  56 }
  57
  58 sub _adds_members { 1 }
  59
  60 sub _potential_value {
  61     my ( $self, $slot_access ) = @_;
  62
  63     return "{ %{ $slot_access }, \@_ }";
  64 }
  65
  66 sub _new_members { '@_[ @values_idx ]' }
  67
  68 sub _inline_optimized_set_new_value {
  69     my ( $self, $inv, $new, $slot_access ) = @_;
  70
  71     return "\@{ $slot_access }{ \@_[ \@keys_idx] } = \@_[ \@values_idx ]";
  72 }
  73
  74 no Moose::Role;
  75
  76 1;