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