File Coverage

blib/lib/Regex/Object.pm

Criterion	Covered	Total	%
statement	58	59	98.3
branch	6	6	100.0
condition			n/a
subroutine	14	14	100.0
pod	3	3	100.0
total	81	82	98.7

package Regex::Object;

use 5.20.0;

use utf8;
use English;
use feature qw(signatures);

use Regex::Object::Match;
use Regex::Object::Matches;
use Moo;

no warnings qw(experimental::signatures);
use namespace::clean;

our $VERSION = '1.25';

tie my %nc,  "Tie::Hash::NamedCapture";
tie my %nca, "Tie::Hash::NamedCapture", all => 1;

has regex => (
    is => 'ro',
);

sub match($self, $string) {
    my $success = $string =~ $self->regex;

    return $self->collect($success);
}

sub match_all($self, $string) {
    my $regex = $self->regex;
    my $success;
    my @matches;

    while($success = $string =~ /$regex/g) {
        push @matches, $self->collect($success);
    }

    return Regex::Object::Matches->new(
        collection => \@matches,
    );
}

sub collect($, $success =  undef) {
    my $match;

    if (defined $success) {
        # Because of quirk with built-in $MATCH - in has last success match.
        $match   = $success ? $MATCH : undef;
    } else {
        # Okay, you have not passed success, then we have no choice and have to rely on $MATCH.
        $success = defined $MATCH;
        $match   = $MATCH;
    }

    return Regex::Object::Match->new(
        success            => $success,
        prematch           => $PREMATCH,
        match              => $match,
        postmatch          => $POSTMATCH,
        last_paren_match   => $LAST_PAREN_MATCH,
        captures           => _collect_captures(),
        named_captures     => { %nc },
        named_captures_all => { %nca },
    );
}

sub _collect_captures {
    my @captures;

    # Trick to get @captures the most appropriate to language version way.
    eval {
        @captures = @{^CAPTURE}; # This was added in 5.25.7.
    }
    or do {
        no strict 'refs';
        @captures = map { "$$_" } 1 .. $#-;
    };

    return \@captures;
}

1;

__END__