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
|
package Moose::Meta::Method::Accessor::Native::String::substr;
our $VERSION = '2.1405';
use strict;
use warnings;
use Moose::Util ();
use Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Reader',
'Moose::Meta::Method::Accessor::Native::Writer';
sub _generate_method {
my $self = shift;
my $inv = '$self';
my $slot_access = $self->_get_value($inv);
return (
'sub {',
'my ' . $inv . ' = shift;',
$self->_inline_curried_arguments,
'if (@_ == 1 || @_ == 2) {',
$self->_inline_reader_core($inv, $slot_access),
'}',
'elsif (@_ == 3) {',
$self->_inline_writer_core($inv, $slot_access),
'}',
'else {',
$self->_inline_check_argument_count,
'}',
'}',
);
}
sub _minimum_arguments { 1 }
sub _maximum_arguments { 3 }
sub _inline_process_arguments {
my $self = shift;
my ($inv, $slot_access) = @_;
return (
'my $offset = shift;',
'my $length = @_ ? shift : length ' . $slot_access . ';',
'my $replacement = shift;',
);
}
sub _inline_check_arguments {
my $self = shift;
my ($for_writer) = @_;
my @code = (
'if ($offset !~ /^-?\d+$/) {',
$self->_inline_throw_exception( InvalidArgumentToMethod =>
'argument => $offset,'.
'ordinal => "first",'.
'type_of_argument => "integer",'.
'method_name => "substr",'.
'type => "Int"',
) . ';',
'}',
'if ($length !~ /^-?\d+$/) {',
$self->_inline_throw_exception( InvalidArgumentToMethod =>
'argument => $length,'.
'ordinal => "second",'.
'type_of_argument => "integer",'.
'method_name => "substr",'.
'type => "Int"',
) . ';',
'}',
);
if ($for_writer) {
push @code, (
'if (!Moose::Util::_STRINGLIKE0($replacement)) {',
$self->_inline_throw_exception( InvalidArgumentToMethod =>
'argument => $replacement,'.
'ordinal => "third",'.
'type_of_argument => "string",'.
'method_name => "substr",'.
'type => "Str"',
) . ';',
'}',
);
}
return @code;
}
sub _potential_value {
my $self = shift;
my ($slot_access) = @_;
return '(do { '
. 'my $potential = ' . $slot_access . '; '
. '@return = substr $potential, $offset, $length, $replacement; '
. '$potential; '
. '})';
}
sub _inline_optimized_set_new_value {
my $self = shift;
my ($inv, $new, $slot_access) = @_;
return '@return = substr ' . $slot_access . ', '
. '$offset, $length, $replacement;';
}
sub _return_value {
my $self = shift;
my ($slot_access, $for_writer) = @_;
return '$return[0]' if $for_writer;
return 'substr ' . $slot_access . ', $offset, $length';
}
no Moose::Role;
1;
|
