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 | |
10 | use base qw( |
9377e13a |
11 | Moose::Meta::Method::Accessor::Native::Reader |
a6ae7438 |
12 | Moose::Meta::Method::Accessor::Native::Writer |
e7724627 |
13 | ); |
14 | |
15 | sub _generate_method { |
16 | my $self = shift; |
17 | |
18 | my $inv = '$self'; |
19 | |
20 | my $slot_access = $self->_inline_get($inv); |
21 | |
22 | my $code = 'sub {'; |
23 | |
24 | $code .= "\n" . $self->_inline_pre_body(@_); |
25 | $code .= "\n" . 'my $self = shift;'; |
26 | |
27 | $code .= "\n" . $self->_inline_curried_arguments; |
28 | |
29 | $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {'; |
30 | |
0a132375 |
31 | $code .= $self->_reader_core( $inv, $slot_access ); |
e7724627 |
32 | |
33 | $code .= "\n" . '} elsif ( @_ == 3 ) {'; |
34 | |
0a132375 |
35 | $code .= $self->_writer_core( $inv, $slot_access ); |
e7724627 |
36 | |
37 | $code .= "\n" . $self->_inline_post_body(@_); |
38 | |
39 | $code .= "\n" . '} else {'; |
40 | |
41 | $code .= "\n" . $self->_inline_check_argument_count; |
42 | |
43 | $code .= "\n" . '}'; |
44 | $code .= "\n" . '}'; |
45 | |
46 | return $code; |
47 | } |
48 | |
49 | sub _minimum_arguments {1} |
50 | sub _maximum_arguments {3} |
51 | |
52 | sub _inline_process_arguments { |
53 | my ( $self, $inv, $slot_access ) = @_; |
54 | |
55 | return |
56 | 'my $offset = shift;' . "\n" |
57 | . "my \$length = \@_ ? shift : length $slot_access;" . "\n" |
58 | . 'my $replacement = shift;'; |
59 | } |
60 | |
61 | sub _inline_check_arguments { |
62 | my ( $self, $for_writer ) = @_; |
63 | |
64 | my $code |
65 | = $self->_inline_throw_error( |
66 | q{'The first argument passed to substr must be an integer'}) |
67 | . q{ if ref $offset || $offset !~ /^-?\\d+$/;} . "\n" |
68 | . $self->_inline_throw_error( |
69 | q{'The second argument passed to substr must be a positive integer'}) |
70 | . q{ if ref $length || $offset !~ /^-?\\d+$/;}; |
71 | |
72 | if ($for_writer) { |
73 | $code |
74 | .= "\n" |
75 | . $self->_inline_throw_error( |
76 | q{'The third argument passed to substr must be a string'}) |
77 | . q{ unless defined $replacement && ! ref $replacement;}; |
78 | } |
79 | |
80 | return $code; |
81 | } |
82 | |
83 | sub _potential_value { |
84 | my ( $self, $slot_access ) = @_; |
85 | |
86 | return |
87 | "( do { my \$potential = $slot_access; substr \$potential, \$offset, \$length, \$replacement; \$potential; } )"; |
88 | } |
89 | |
e32b7489 |
90 | sub _inline_optimized_set_new_value { |
91 | my ( $self, $inv, $new, $slot_access ) = @_; |
e7724627 |
92 | |
584540d9 |
93 | return "substr $slot_access, \$offset, \$length, \$replacement"; |
e7724627 |
94 | } |
95 | |
96 | sub _return_value { |
97 | my ( $self, $slot_access, $for_writer ) = @_; |
98 | |
99 | return q{} if $for_writer; |
100 | |
101 | return "substr $slot_access, \$offset, \$length"; |
102 | } |
103 | |
104 | 1; |