/usr/lib/perl5/Moose/Meta/Method/Accessor/Native/Hash/set.pm is in libmoose-perl 2.0401-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | package Moose::Meta::Method::Accessor::Native::Hash::set;
BEGIN {
$Moose::Meta::Method::Accessor::Native::Hash::set::AUTHORITY = 'cpan:STEVAN';
}
{
$Moose::Meta::Method::Accessor::Native::Hash::set::VERSION = '2.0401';
}
use strict;
use warnings;
use List::MoreUtils ();
use Scalar::Util qw( looks_like_number );
use Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Hash::Writer' => {
-excludes => [
qw(
_minimum_arguments
_maximum_arguments
_inline_process_arguments
_inline_check_arguments
_inline_coerce_new_values
_inline_optimized_set_new_value
_return_value
)
],
};
sub _minimum_arguments { 2 }
sub _maximum_arguments { undef }
around _inline_check_argument_count => sub {
my $orig = shift;
my $self = shift;
return (
$self->$orig(@_),
'if (@_ % 2) {',
$self->_inline_throw_error(
sprintf(
'"You must pass an even number of arguments to %s"',
$self->delegate_to_method,
),
) . ';',
'}',
);
};
sub _inline_process_arguments {
my $self = shift;
return (
'my @keys_idx = grep { ! ($_ % 2) } 0..$#_;',
'my @values_idx = grep { $_ % 2 } 0..$#_;',
);
}
sub _inline_check_arguments {
my $self = shift;
return (
'for (@keys_idx) {',
'if (!defined($_[$_])) {',
$self->_inline_throw_error(
sprintf(
'"Hash keys passed to %s must be defined"',
$self->delegate_to_method,
),
) . ';',
'}',
'}',
);
}
sub _adds_members { 1 }
# We need to override this because while @_ can be written to, we cannot write
# directly to $_[1].
sub _inline_coerce_new_values {
my $self = shift;
return unless $self->associated_attribute->should_coerce;
return unless $self->_tc_member_type_can_coerce;
# Is there a simpler way to do this?
return (
'my $iter = List::MoreUtils::natatime(2, @_);',
'@_ = ();',
'while (my ($key, $val) = $iter->()) {',
'push @_, $key, $member_coercion->($val);',
'}',
);
};
sub _potential_value {
my $self = shift;
my ($slot_access) = @_;
return '{ %{ (' . $slot_access . ') }, @_ }';
}
sub _new_members { '@_[ @values_idx ]' }
sub _inline_optimized_set_new_value {
my $self = shift;
my ($inv, $new, $slot_access) = @_;
return '@{ (' . $slot_access . ') }{ @_[@keys_idx] } = @_[@values_idx];';
}
sub _return_value {
my $self = shift;
my ($slot_access) = @_;
return 'wantarray '
. '? @{ (' . $slot_access . ') }{ @_[@keys_idx] } '
. ': ' . $slot_access . '->{ $_[$keys_idx[0]] }';
}
no Moose::Role;
1;
|