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

package Regexp::Stringify;

our $DATE = '2016-03-15'; # DATE
our $VERSION = '0.05'; # VERSION

use 5.010001;
use strict;
use warnings;

use re qw(regexp_pattern);

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(stringify_regexp);

our %SPEC;

$SPEC{stringify_regexp} = {
    v => 1.1,
    summary => 'Stringify a Regexp object',
    description => <<'_',

This routine is an alternative to Perl's default stringification of Regexp
object (i.e.:`"$re"`) and has some features/options, e.g.: producing regexp
string that is compatible with certain perl versions.

If given a string (or other non-Regexp object), will return it as-is.

_
    args => {
        regexp => {
            schema => 're*',
            req => 1,
            pos => 0,
        },
        plver => {
            summary => 'Target perl version',
            schema => 'str*',
            description => <<'_',

Try to produce a regexp object compatible with a certain perl version (should at
least be >= 5.10).

For example, in perl 5.14 regex stringification changes, e.g. `qr/hlagh/i` would
previously be stringified as `(?i-xsm:hlagh)`, but now it's stringified as
`(?^i:hlagh)`. If you set `plver` to 5.10 or 5.12, then this routine will
still produce the former. It will also ignore regexp modifiers that are
introduced in newer perls.

Note that not all regexp objects are translatable to older perls, e.g. if they
contain constructs not known to older perls like `(^...)` before perl 5.14.

_
        },
        with_qr => {
            schema  => 'bool',
            description => <<'_',

If you set this to 1, then `qr/a/i` will be stringified as `'qr/a/i'` instead as
`'(^i:a)'`. The resulting string can then be eval-ed to recreate the Regexp
object.

_
        },
    },
    result_naked => 1,
    result => {
        schema => 'str*',
    },
};
sub stringify_regexp {
    my %args = @_;

    my $re = $args{regexp};
    return $re unless ref($re) eq 'Regexp';
    my $plver = $args{plver} // $^V;

    my ($pat, $mod) = regexp_pattern($re);

    my $ge_5140 = version->parse($plver) >= version->parse('5.14.0');
    unless ($ge_5140) {
        $mod =~ s/[adlu]//g;
    }

    if ($args{with_qr}) {
        return "qr($pat)$mod";
    } else {
        if ($ge_5140) {
            return "(^$mod:$pat)";
        } else {
            return "(?:(?$mod-)$pat)";
        }
    }
}

1;
# ABSTRACT: Stringify a Regexp object

__END__