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