File Coverage

blib/lib/Data/Printer/Filter/ClassicRegex.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Data::Printer::Filter::ClassicRegex;
use warnings;
use strict;

use Data::Printer::Filter;

our $VERSION = 0.01;


# borrowed almost verbatim from Gisle Aas' Data::Dump
filter 'Regexp' => sub {
  my ($item, $p) = @_;
  my $v = "$item";
  my $mod = "";
  if ($v =~ /^\(\?\^?([msix-]*):([\x00-\xFF]*)\)\z/) {
    $mod = $1;
    $v = $2;
    $mod =~ s/-.*//;
  }

  my $sep = '/';
  my $sep_count = ($v =~ tr/\///);
  if ($sep_count) {
    # see if we can find a better one
    for ('|', ',', ':', '#') {
      my $c = eval "\$v =~ tr/\Q$_\E//"; ## no critic
      if ($c < $sep_count) {
        $sep = $_;
        $sep_count = $c;
        last if $sep_count == 0;
      }
    }
  }
  $v =~ s/\Q$sep\E/\\$sep/g;
  return "qr$sep$v$sep$mod";
};


42;
__END__