File Coverage

blib/lib/Data/Object/Role/Regexp.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	2	4	50.0
condition	3	4	75.0
subroutine	6	6	100.0
pod	0	2	0.0
total	47	52	90.3

# ABSTRACT: Regexp Object Role for Perl 5
package Data::Object::Role::Regexp;

use 5.010;
use Data::Object::Role;

use Data::Object 'throw';

map with($_), our @ROLES = qw(
    Data::Object::Role::Defined
    Data::Object::Role::Detract
    Data::Object::Role::Output
    Data::Object::Role::Ref
    Data::Object::Role::Type
);

our $VERSION = '0.42'; # VERSION

sub search {
    my($self, $string, $flags) = @_;

    my $captures;
    my @matches;

    my $op   = '$string =~ m/$$self/';
    my $capt = '$captures = (' . $op . ($flags // '') . ')';
    my $mtch = '@matches  = ([@-], [@+], {%-})';
    my $expr = join ';', $capt, $mtch;

    my $error = do { local $@; eval $expr; $@ };
    throw $error if $error;

    return [$$self, $string, $captures, @matches, $string];
}

sub replace {
    my($self, $string, $replacement, $flags) = @_;

    my $captures;
    my @matches;

    my $op   = '$string =~ s/$$self/$replacement/';
    my $capt = '$captures = (' . $op . ($flags // '') . ')';
    my $mtch = '@matches  = ([@-], [@+], {%-})';
    my $expr = join ';', $capt, $mtch;

    my $initial = $string;

    my $error = do { local $@; eval $expr; $@ };
    throw $error if $error;

    return [$$self, $string, $captures, @matches, $initial];
}

1;

__END__