File Coverage

blib/lib/Regexp/From/String.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	45	48	93.7
condition	3	3	100.0
subroutine	6	6	100.0
pod	2	2	100.0
total	104	107	97.2

package Regexp::From::String;

use strict;
use warnings;

use Exporter 'import';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-11-08'; # DATE
our $DIST = 'Regexp-From-String'; # DIST
our $VERSION = '0.007'; # VERSION

our @EXPORT_OK = qw(str_maybe_to_re str_to_re);

sub _str_maybe_to_re_or_to_re {
    my $which = shift;

    my $opts = ref $_[0] eq 'HASH' ? {%{shift()}} : {};
    my $opt_ci1 = delete($opts->{ci});
    my $opt_ci2 = delete $opts->{case_insensitive}; # so we delete both ci & this. case_insensitive is deprecated and no longer documented.
    my $opt_ci  = defined $opt_ci1 ? $opt_ci1 : defined $opt_ci2 ? $opt_ci2 : 0;
    my $opt_always_quote = delete $opts->{always_quote};
    my $opt_anchored = delete $opts->{anchored}; $opt_anchored = 0 unless defined $opt_anchored;
    my $opt_safety = delete $opts->{safety}; $opt_safety = 1 unless defined $opt_safety;
    die "Unknown option(s): ".join(", ", sort keys %$opts) if keys %$opts;

    my $str = shift;

    if (!$opt_always_quote && $str =~ m!\A(?:/(.*)/|qr\((.*)\))(?:[ims]*)\z!s) {
        my ($pat1, $pat2) = ($1, $2);
        my $code = "my \$re = " . (substr($str, 0, 2) eq 'qr' ? $str : "qr$str");
        $code .= "i" if $opt_ci;
        $code .= "; \$re = qr(\\A\$re\\z)" if $opt_anchored;

        #print "D: $code\n";
        my $re;

        if ($opt_safety == 0) {
            $re = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
            die if $@;
        } elsif ($opt_safety == 2) {
            require Regexp::Util;
            $re = Regexp::Util::deserialize_regexp($code);
            die "$which(): Unsafe regex: contains embedded code"
                if Regexp::Util::regexp_seen_evals($re);
        } else {
            if (defined $pat1) {
                die "$which(): Unsafe regex: contains literal /" if $pat1 =~ m!/!;
            } else {
                die "$which(): Unsafe regex: contains literal )" if $pat2 =~ m!\)!;
            }
            my $pat = defined $pat1 ? $pat1 : $pat2;
            die "$which(): Unsafe regex: contains embedded code" if $pat =~ m!\(\?\??\{!;

            $re = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
            die if $@;
        }

        return $re;
    } else {
        return $str if $which eq 'str_maybe_to_re';

        $str = quotemeta($str);
        my $re = $opt_anchored ?
            ($opt_ci ? qr/\A$str\z/i : qr/\A$str\z/) :
            ($opt_ci ? qr/$str/i     : qr/$str/);
        return $re;
    }
}

sub str_maybe_to_re {
    _str_maybe_to_re_or_to_re('str_maybe_to_re', @_);
}

sub str_to_re {
    _str_maybe_to_re_or_to_re('str_to_re', @_);
}

1;
# ABSTRACT: Convert '/.../' or 'qr(...)' into Regexp object

__END__