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


line stmt bran cond sub pod time code
1             package Regexp::From::String;
2              
3 1     1   107657 use strict;
  1         27  
  1         29  
4 1     1   9 use warnings;
  1         2  
  1         30  
5              
6 1     1   14 use Exporter 'import';
  1         3  
  1         683  
7              
8             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
9             our $DATE = '2022-11-08'; # DATE
10             our $DIST = 'Regexp-From-String'; # DIST
11             our $VERSION = '0.007'; # VERSION
12              
13             our @EXPORT_OK = qw(str_maybe_to_re str_to_re);
14              
15             sub _str_maybe_to_re_or_to_re {
16 39     39   64 my $which = shift;
17              
18 39 100       115 my $opts = ref $_[0] eq 'HASH' ? {%{shift()}} : {};
  22         74  
19 39         74 my $opt_ci1 = delete($opts->{ci});
20 39         114 my $opt_ci2 = delete $opts->{case_insensitive}; # so we delete both ci & this. case_insensitive is deprecated and no longer documented.
21 39 100       98 my $opt_ci = defined $opt_ci1 ? $opt_ci1 : defined $opt_ci2 ? $opt_ci2 : 0;
    100          
22 39         54 my $opt_always_quote = delete $opts->{always_quote};
23 39 100       58 my $opt_anchored = delete $opts->{anchored}; $opt_anchored = 0 unless defined $opt_anchored;
  39         88  
24 39 100       61 my $opt_safety = delete $opts->{safety}; $opt_safety = 1 unless defined $opt_safety;
  39         77  
25 39 100       135 die "Unknown option(s): ".join(", ", sort keys %$opts) if keys %$opts;
26              
27 37         73 my $str = shift;
28              
29 37 100 100     267 if (!$opt_always_quote && $str =~ m!\A(?:/(.*)/|qr\((.*)\))(?:[ims]*)\z!s) {
30 23         98 my ($pat1, $pat2) = ($1, $2);
31 23 100       110 my $code = "my \$re = " . (substr($str, 0, 2) eq 'qr' ? $str : "qr$str");
32 23 100       60 $code .= "i" if $opt_ci;
33 23 100       55 $code .= "; \$re = qr(\\A\$re\\z)" if $opt_anchored;
34              
35             #print "D: $code\n";
36 23         26 my $re;
37              
38 23 100       55 if ($opt_safety == 0) {
    100          
39 4         410 $re = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
40 4 50       15 die if $@;
41             } elsif ($opt_safety == 2) {
42 4         26 require Regexp::Util;
43 4         13 $re = Regexp::Util::deserialize_regexp($code);
44 2 50       1148 die "$which(): Unsafe regex: contains embedded code"
45             if Regexp::Util::regexp_seen_evals($re);
46             } else {
47 15 100       31 if (defined $pat1) {
48 9 100       42 die "$which(): Unsafe regex: contains literal /" if $pat1 =~ m!/!;
49             } else {
50 6 100       36 die "$which(): Unsafe regex: contains literal )" if $pat2 =~ m!\)!;
51             }
52 12 100       25 my $pat = defined $pat1 ? $pat1 : $pat2;
53 12 100       38 die "$which(): Unsafe regex: contains embedded code" if $pat =~ m!\(\?\??\{!;
54              
55 11         765 $re = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
56 11 100       74 die if $@;
57             }
58              
59 13         108 return $re;
60             } else {
61 14 100       61 return $str if $which eq 'str_maybe_to_re';
62              
63 7         18 $str = quotemeta($str);
64 7 50       97 my $re = $opt_anchored ?
    100          
    100          
65             ($opt_ci ? qr/\A$str\z/i : qr/\A$str\z/) :
66             ($opt_ci ? qr/$str/i : qr/$str/);
67 7         56 return $re;
68             }
69             }
70              
71             sub str_maybe_to_re {
72 26     26 1 56865 _str_maybe_to_re_or_to_re('str_maybe_to_re', @_);
73             }
74              
75             sub str_to_re {
76 13     13 1 6402 _str_maybe_to_re_or_to_re('str_to_re', @_);
77             }
78              
79             1;
80             # ABSTRACT: Convert '/.../' or 'qr(...)' into Regexp object
81              
82             __END__