Commit | Line | Data |
44babf1f |
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 | |
efa728b4 |
8 | our $VERSION = '1.15'; |
44babf1f |
9 | $VERSION = eval $VERSION; |
10 | our $AUTHORITY = 'cpan:STEVAN'; |
11 | |
8b9641b8 |
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 | }; |
44babf1f |
25 | |
26 | sub _minimum_arguments { 2 } |
27 | |
28 | sub _maximum_arguments { undef } |
29 | |
8b9641b8 |
30 | around _inline_check_argument_count => sub { |
31 | my $orig = shift; |
44babf1f |
32 | my $self = shift; |
33 | |
34 | return |
8b9641b8 |
35 | $self->$orig(@_) . "\n" |
44babf1f |
36 | . $self->_inline_throw_error( |
37 | q{'You must pass an even number of arguments to set'}) |
38 | . ' if @_ % 2;'; |
8b9641b8 |
39 | }; |
44babf1f |
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 | |
fe4e0a8c |
63 | return "{ %{ $slot_access }, \@_ }"; |
44babf1f |
64 | } |
65 | |
66 | sub _new_members { '@_[ @values_idx ]' } |
67 | |
68 | sub _inline_optimized_set_new_value { |
69 | my ( $self, $inv, $new, $slot_access ) = @_; |
70 | |
584540d9 |
71 | return "\@{ $slot_access }{ \@_[ \@keys_idx] } = \@_[ \@values_idx ]"; |
44babf1f |
72 | } |
73 | |
8b9641b8 |
74 | no Moose::Role; |
75 | |
44babf1f |
76 | 1; |