File Coverage

blib/lib/Regexp/Stringify.pm
Criterion Covered Total %
statement 27 27 100.0
branch 7 8 87.5
condition 1 3 33.3
subroutine 6 6 100.0
pod 1 1 100.0
total 42 45 93.3


line stmt bran cond sub pod time code
1             package Regexp::Stringify;
2              
3             our $DATE = '2016-03-15'; # DATE
4             our $VERSION = '0.05'; # VERSION
5              
6 1     1   19346 use 5.010001;
  1         2  
7 1     1   3 use strict;
  1         1  
  1         17  
8 1     1   2 use warnings;
  1         1  
  1         30  
9              
10 1     1   3 use re qw(regexp_pattern);
  1         1  
  1         111  
11              
12 1     1   3 use Exporter;
  1         1  
  1         271  
13             our @ISA = qw(Exporter);
14             our @EXPORT_OK = qw(stringify_regexp);
15              
16             our %SPEC;
17              
18             $SPEC{stringify_regexp} = {
19             v => 1.1,
20             summary => 'Stringify a Regexp object',
21             description => <<'_',
22              
23             This routine is an alternative to Perl's default stringification of Regexp
24             object (i.e.:`"$re"`) and has some features/options, e.g.: producing regexp
25             string that is compatible with certain perl versions.
26              
27             If given a string (or other non-Regexp object), will return it as-is.
28              
29             _
30             args => {
31             regexp => {
32             schema => 're*',
33             req => 1,
34             pos => 0,
35             },
36             plver => {
37             summary => 'Target perl version',
38             schema => 'str*',
39             description => <<'_',
40              
41             Try to produce a regexp object compatible with a certain perl version (should at
42             least be >= 5.10).
43              
44             For example, in perl 5.14 regex stringification changes, e.g. `qr/hlagh/i` would
45             previously be stringified as `(?i-xsm:hlagh)`, but now it's stringified as
46             `(?^i:hlagh)`. If you set `plver` to 5.10 or 5.12, then this routine will
47             still produce the former. It will also ignore regexp modifiers that are
48             introduced in newer perls.
49              
50             Note that not all regexp objects are translatable to older perls, e.g. if they
51             contain constructs not known to older perls like `(^...)` before perl 5.14.
52              
53             _
54             },
55             with_qr => {
56             schema => 'bool',
57             description => <<'_',
58              
59             If you set this to 1, then `qr/a/i` will be stringified as `'qr/a/i'` instead as
60             `'(^i:a)'`. The resulting string can then be eval-ed to recreate the Regexp
61             object.
62              
63             _
64             },
65             },
66             result_naked => 1,
67             result => {
68             schema => 'str*',
69             },
70             };
71             sub stringify_regexp {
72 7     7 1 29 my %args = @_;
73              
74 7         9 my $re = $args{regexp};
75 7 50       16 return $re unless ref($re) eq 'Regexp';
76 7   33     13 my $plver = $args{plver} // $^V;
77              
78 7         15 my ($pat, $mod) = regexp_pattern($re);
79              
80 7         65 my $ge_5140 = version->parse($plver) >= version->parse('5.14.0');
81 7 100       19 unless ($ge_5140) {
82 2         4 $mod =~ s/[adlu]//g;
83             }
84              
85 7 100       15 if ($args{with_qr}) {
86 2         9 return "qr($pat)$mod";
87             } else {
88 5 100       8 if ($ge_5140) {
89 3         15 return "(^$mod:$pat)";
90             } else {
91 2         10 return "(?:(?$mod-)$pat)";
92             }
93             }
94             }
95              
96             1;
97             # ABSTRACT: Stringify a Regexp object
98              
99             __END__