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__ |