File Coverage

blib/lib/Data/Printer/Filter/Regexp.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Data::Printer::Filter::Regexp;
2 32     32   178 use strict;
  32         59  
  32         805  
3 32     32   143 use warnings;
  32         59  
  32         897  
4 32     32   166 use Data::Printer::Filter;
  32         59  
  32         174  
5 32     32   155 use Data::Printer::Common;
  32         52  
  32         7210  
6              
7             filter 'Regexp' => sub {
8             my ($regexp, $ddp) = @_;
9             my $val = "$regexp";
10             my $string;
11              
12             # a regex to parse a regex. Talk about full circle :)
13             # note: we are not validating anything, just grabbing modifiers
14             if ($val =~ m/\(\?\^?([uladxismnpogce]*)(?:\-[uladxismnpogce]+)?:(.*)\)/s) {
15             my ($modifiers, $parsed_val) = ($1, $2);
16             $string = $ddp->maybe_colorize($parsed_val, 'regex');
17             if ($modifiers) {
18             $string .= " (modifiers: $modifiers)";
19             }
20             }
21             else {
22             Data::Printer::Common::_warn($ddp, "Unrecognized regex $val. Please submit a bug report for Data::Printer.");
23             $string = $ddp->maybe_colorize('Unknown Regexp', 'regex');
24             }
25              
26             if ($ddp->show_tied and my $tie = ref tied $regexp) {
27             $string .= " (tied to $tie)";
28             }
29             return $string;
30             };
31              
32             1;