Bump version to 1.9900 for new version numbering scheme
[gitmo/Moose.git] / lib / Moose / Meta / Method / Accessor / Native / String / substr.pm
1 package Moose::Meta::Method::Accessor::Native::String::substr;
2
3 use strict;
4 use warnings;
5
6 use Moose::Util ();
7
8 our $VERSION = '1.9900';
9 $VERSION = eval $VERSION;
10 our $AUTHORITY = 'cpan:STEVAN';
11
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     };
38
39 sub _generate_method {
40     my $self = shift;
41
42     my $inv         = '$self';
43     my $slot_access = $self->_get_value($inv);
44
45     return (
46         'sub {',
47             'my ' . $inv . ' = shift;',
48             $self->_inline_curried_arguments,
49             'if (@_ == 1 || @_ == 2) {',
50                 $self->_inline_reader_core($inv, $slot_access),
51             '}',
52             'elsif (@_ == 3) {',
53                 $self->_inline_writer_core($inv, $slot_access),
54             '}',
55             'else {',
56                 $self->_inline_check_argument_count,
57             '}',
58         '}',
59     );
60 }
61
62 sub _minimum_arguments { 1 }
63 sub _maximum_arguments { 3 }
64
65 sub _inline_process_arguments {
66     my $self = shift;
67     my ($inv, $slot_access) = @_;
68
69     return (
70         'my $offset = shift;',
71         'my $length = @_ ? shift : length ' . $slot_access . ';',
72         'my $replacement = shift;',
73     );
74 }
75
76 sub _inline_check_arguments {
77     my $self = shift;
78     my ($for_writer) = @_;
79
80     my @code = (
81         'if ($offset !~ /^-?\d+$/) {',
82             $self->_inline_throw_error(
83                 '"The first argument passed to substr must be an integer"'
84             ) . ';',
85         '}',
86         'if ($length !~ /^-?\d+$/) {',
87             $self->_inline_throw_error(
88                 '"The second argument passed to substr must be an integer"'
89             ) . ';',
90         '}',
91     );
92
93     if ($for_writer) {
94         push @code, (
95             'if (!Moose::Util::_STRINGLIKE0($replacement)) {',
96                 $self->_inline_throw_error(
97                     '"The third argument passed to substr must be a string"'
98                 ) . ';',
99             '}',
100         );
101     }
102
103     return @code;
104 }
105
106 sub _potential_value {
107     my $self = shift;
108     my ($slot_access) = @_;
109
110     return '(do { '
111              . 'my $potential = ' . $slot_access . '; '
112              . '@return = substr $potential, $offset, $length, $replacement; '
113              . '$potential; '
114          . '})';
115 }
116
117 sub _inline_optimized_set_new_value {
118     my $self = shift;
119     my ($inv, $new, $slot_access) = @_;
120
121     return '@return = substr ' . $slot_access . ', '
122                            . '$offset, $length, $replacement;';
123 }
124
125 sub _return_value {
126     my $self = shift;
127     my ($slot_access, $for_writer) = @_;
128
129     return '$return[0]' if $for_writer;
130
131     return 'substr ' . $slot_access . ', $offset, $length';
132 }
133
134 no Moose::Role;
135
136 1;