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 our $VERSION = '1.13';
   7 $VERSION = eval $VERSION;
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use base 'Moose::Meta::Method::Accessor::Native::String::Writer';
  11
  12 sub _minimum_arguments { 1 }
  13 sub _maximum_arguments { 2 }
  14
  15 sub _inline_check_arguments {
  16     my $self = shift;
  17
  18     return $self->_inline_throw_error(
  19         q{'The first argument passed to replace must be a string or regexp reference'}
  20         )
  21         . q{ unless ! ref $_[0] || ref $_[0] eq 'Regexp';} . "\n"
  22         . $self->_inline_throw_error(
  23         q{'The second argument passed to replace must be a string or code reference'}
  24         ) . q{ unless ! ref $_[1] || ref $_[1] eq 'CODE';};
  25 }
  26
  27 sub _potential_value {
  28     my ( $self, $slot_access ) = @_;
  29
  30     return "( do { my \$val = $slot_access; ref \$_[1] ? \$val =~ s/\$_[0]/\$_[1]->()/e : \$val =~ s/\$_[0]/\$_[1]/; \$val } )";
  31 }
  32
  33 sub _inline_set_new_value {
  34     my ( $self, $inv, $new ) = @_;
  35
  36     return $self->SUPER::_inline_set_new_value(@_)
  37         if $self->_value_needs_copy;
  38
  39     my $slot_access = $self->_inline_get($inv);
  40
  41     return "if ( ref \$_[1] ) { $slot_access =~ s/\$_[0]/\$_[1]->()/e; } else { $slot_access =~ s/\$_[0]/\$_[1]/; }";
  42 }
  43
  44 1;