1 files changed, 123 insertions, 0 deletions
diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm b/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm
new file mode 100644
index 0000000..df82e23
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm
@@ -0,0 +1,123 @@
+package Moose::Meta::Method::Accessor::Native::String::substr;
+our $VERSION = '2.1405';
+
+use strict;
+use warnings;
+
+use Moose::Util ();
+
+use Moose::Role;
+
+with 'Moose::Meta::Method::Accessor::Native::Reader',
+     'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _generate_method {
+    my $self = shift;
+
+    my $inv         = '$self';
+    my $slot_access = $self->_get_value($inv);
+
+    return (
+        'sub {',
+            'my ' . $inv . ' = shift;',
+            $self->_inline_curried_arguments,
+            'if (@_ == 1 || @_ == 2) {',
+                $self->_inline_reader_core($inv, $slot_access),
+            '}',
+            'elsif (@_ == 3) {',
+                $self->_inline_writer_core($inv, $slot_access),
+            '}',
+            'else {',
+                $self->_inline_check_argument_count,
+            '}',
+        '}',
+    );
+}
+
+sub _minimum_arguments { 1 }
+sub _maximum_arguments { 3 }
+
+sub _inline_process_arguments {
+    my $self = shift;
+    my ($inv, $slot_access) = @_;
+
+    return (
+        'my $offset = shift;',
+        'my $length = @_ ? shift : length ' . $slot_access . ';',
+        'my $replacement = shift;',
+    );
+}
+
+sub _inline_check_arguments {
+    my $self = shift;
+    my ($for_writer) = @_;
+
+    my @code = (
+        'if ($offset !~ /^-?\d+$/) {',
+            $self->_inline_throw_exception( InvalidArgumentToMethod =>
+                                            'argument                => $offset,'.
+                                            'ordinal                 => "first",'.
+                                            'type_of_argument        => "integer",'.
+                                            'method_name             => "substr",'.
+                                            'type                    => "Int"',
+            ) . ';',
+        '}',
+        'if ($length !~ /^-?\d+$/) {',
+            $self->_inline_throw_exception( InvalidArgumentToMethod =>
+                                            'argument                => $length,'.
+                                            'ordinal                 => "second",'.
+                                            'type_of_argument        => "integer",'.
+                                            'method_name             => "substr",'.
+                                            'type                    => "Int"',
+            ) . ';',
+        '}',
+    );
+
+    if ($for_writer) {
+        push @code, (
+            'if (!Moose::Util::_STRINGLIKE0($replacement)) {',
+                $self->_inline_throw_exception( InvalidArgumentToMethod =>
+                                                'argument                => $replacement,'.
+                                                'ordinal                 => "third",'.
+                                                'type_of_argument        => "string",'.
+                                                'method_name             => "substr",'.
+                                                'type                    => "Str"',
+                ) . ';',
+            '}',
+        );
+    }
+
+    return @code;
+}
+
+sub _potential_value {
+    my $self = shift;
+    my ($slot_access) = @_;
+
+    return '(do { '
+             . 'my $potential = ' . $slot_access . '; '
+             . '@return = substr $potential, $offset, $length, $replacement; '
+             . '$potential; '
+         . '})';
+}
+
+sub _inline_optimized_set_new_value {
+    my $self = shift;
+    my ($inv, $new, $slot_access) = @_;
+
+    return '@return = substr ' . $slot_access . ', '
+                           . '$offset, $length, $replacement;';
+}
+
+sub _return_value {
+    my $self = shift;
+    my ($slot_access, $for_writer) = @_;
+
+    return '$return[0]' if $for_writer;
+
+    return 'substr ' . $slot_access . ', $offset, $length';
+}
+
+no Moose::Role;
+
+1;