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