lib/Moose/Meta/Method/Accessor/Native/String/replace.pm

   1 package Moose::Meta::Method::Accessor::Native::String::replace;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose::Util ();
   7 use Params::Util ();
   8
   9 our $AUTHORITY = 'cpan:STEVAN';
  10
  11 use Moose::Role;
  12
  13 with 'Moose::Meta::Method::Accessor::Native::Writer' => {
  14     -excludes => [
  15         qw(
  16             _minimum_arguments
  17             _maximum_arguments
  18             _inline_check_arguments
  19             _inline_optimized_set_new_value
  20             )
  21     ]
  22     };
  23
  24 sub _minimum_arguments { 1 }
  25
  26 sub _maximum_arguments { 2 }
  27
  28 sub _inline_check_arguments {
  29     my $self = shift;
  30
  31     return (
  32         'if (!Moose::Util::_STRINGLIKE0($_[0]) && !Params::Util::_REGEX($_[0])) {',
  33             $self->_inline_throw_error(
  34                 '"The first argument passed to replace must be a string or '
  35               . 'regexp reference"'
  36             ) . ';',
  37         '}',
  38         'if (!Moose::Util::_STRINGLIKE0($_[1]) && !Params::Util::_CODELIKE($_[1])) {',
  39             $self->_inline_throw_error(
  40                 '"The second argument passed to replace must be a string or '
  41               . 'code reference"'
  42             ) . ';',
  43         '}',
  44     );
  45 }
  46
  47 sub _potential_value {
  48     my $self = shift;
  49     my ($slot_access) = @_;
  50
  51     return '(do { '
  52              . 'my $val = ' . $slot_access . '; '
  53              . 'ref $_[1] '
  54                  . '? $val =~ s/$_[0]/$_[1]->()/e '
  55                  . ': $val =~ s/$_[0]/$_[1]/; '
  56              . '$val; '
  57          . '})';
  58 }
  59
  60 sub _inline_optimized_set_new_value {
  61     my $self = shift;
  62     my ($inv, $new, $slot_access) = @_;
  63
  64     return (
  65         'ref $_[1]',
  66             '? ' . $slot_access . ' =~ s/$_[0]/$_[1]->()/e',
  67             ': ' . $slot_access . ' =~ s/$_[0]/$_[1]/;',
  68      );
  69 }
  70
  71 no Moose::Role;
  72
  73 1;