Commit | Line | Data |
e7724627 |
1 | package Moose::Meta::Method::Accessor::Native::String::substr; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
88e88a7b |
6 | use Moose::Util (); |
7 | |
d874ffad |
8 | our $VERSION = '1.20'; |
e7724627 |
9 | $VERSION = eval $VERSION; |
10 | our $AUTHORITY = 'cpan:STEVAN'; |
11 | |
8b9641b8 |
12 | use Moose::Role; |
13 | |
14 | with 'Moose::Meta::Method::Accessor::Native::Reader' => { |
15 | -excludes => [ |
16 | qw( _generate_method |
17 | _minimum_arguments |
18 | _maximum_arguments |
19 | _inline_process_arguments |
20 | _inline_check_arguments |
21 | _return_value |
22 | ) |
23 | ] |
24 | }, |
25 | 'Moose::Meta::Method::Accessor::Native::Writer' => { |
26 | -excludes => [ |
27 | qw( |
28 | _generate_method |
29 | _minimum_arguments |
30 | _maximum_arguments |
31 | _inline_process_arguments |
32 | _inline_check_arguments |
33 | _inline_optimized_set_new_value |
34 | _return_value |
35 | ) |
36 | ] |
37 | }; |
e7724627 |
38 | |
39 | sub _generate_method { |
40 | my $self = shift; |
41 | |
42 | my $inv = '$self'; |
43 | |
44 | my $slot_access = $self->_inline_get($inv); |
45 | |
46 | my $code = 'sub {'; |
47 | |
48 | $code .= "\n" . $self->_inline_pre_body(@_); |
49 | $code .= "\n" . 'my $self = shift;'; |
50 | |
51 | $code .= "\n" . $self->_inline_curried_arguments; |
52 | |
53 | $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {'; |
54 | |
0a132375 |
55 | $code .= $self->_reader_core( $inv, $slot_access ); |
e7724627 |
56 | |
57 | $code .= "\n" . '} elsif ( @_ == 3 ) {'; |
58 | |
0a132375 |
59 | $code .= $self->_writer_core( $inv, $slot_access ); |
e7724627 |
60 | |
61 | $code .= "\n" . $self->_inline_post_body(@_); |
62 | |
63 | $code .= "\n" . '} else {'; |
64 | |
65 | $code .= "\n" . $self->_inline_check_argument_count; |
66 | |
67 | $code .= "\n" . '}'; |
68 | $code .= "\n" . '}'; |
69 | |
70 | return $code; |
71 | } |
72 | |
73 | sub _minimum_arguments {1} |
74 | sub _maximum_arguments {3} |
75 | |
76 | sub _inline_process_arguments { |
77 | my ( $self, $inv, $slot_access ) = @_; |
78 | |
79 | return |
80 | 'my $offset = shift;' . "\n" |
81 | . "my \$length = \@_ ? shift : length $slot_access;" . "\n" |
82 | . 'my $replacement = shift;'; |
83 | } |
84 | |
85 | sub _inline_check_arguments { |
86 | my ( $self, $for_writer ) = @_; |
87 | |
88 | my $code |
89 | = $self->_inline_throw_error( |
90 | q{'The first argument passed to substr must be an integer'}) |
88e88a7b |
91 | . q{ unless $offset =~ /^-?\\d+$/;} . "\n" |
e7724627 |
92 | . $self->_inline_throw_error( |
88e88a7b |
93 | q{'The second argument passed to substr must be an integer'}) |
94 | . q{ unless $length =~ /^-?\\d+$/;}; |
e7724627 |
95 | |
96 | if ($for_writer) { |
97 | $code |
98 | .= "\n" |
99 | . $self->_inline_throw_error( |
100 | q{'The third argument passed to substr must be a string'}) |
5394a1c7 |
101 | . q{ unless Moose::Util::_STRINGLIKE0($replacement);}; |
e7724627 |
102 | } |
103 | |
104 | return $code; |
105 | } |
106 | |
107 | sub _potential_value { |
108 | my ( $self, $slot_access ) = @_; |
109 | |
110 | return |
7f5ec80d |
111 | "( do { my \$potential = $slot_access; \@return = substr \$potential, \$offset, \$length, \$replacement; \$potential; } )"; |
e7724627 |
112 | } |
113 | |
e32b7489 |
114 | sub _inline_optimized_set_new_value { |
115 | my ( $self, $inv, $new, $slot_access ) = @_; |
e7724627 |
116 | |
7f5ec80d |
117 | return "\@return = substr $slot_access, \$offset, \$length, \$replacement"; |
e7724627 |
118 | } |
119 | |
120 | sub _return_value { |
121 | my ( $self, $slot_access, $for_writer ) = @_; |
122 | |
7f5ec80d |
123 | return '$return[0]' if $for_writer; |
e7724627 |
124 | |
125 | return "substr $slot_access, \$offset, \$length"; |
126 | } |
127 | |
8b9641b8 |
128 | no Moose::Role; |
129 | |
e7724627 |
130 | 1; |