File Coverage

blib/lib/Regexp/Util.pm

Criterion	Covered	Total	%
statement	28	43	65.1
branch	6	18	33.3
condition	2	6	33.3
subroutine	6	6	100.0
pod	3	3	100.0
total	45	76	59.2

use 5.010000;
use strict;
use warnings;

package Regexp::Util;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.002';

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

eval 'require re';

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT;
our @EXPORT_OK = qw(
	is_regexp
	regexp_seen_evals
	regexp_is_foreign
	serialize_regexp
	deserialize_regexp
);
our %EXPORT_TAGS = (
	all     => \@EXPORT_OK,
	default => \@EXPORT,
);

sub regexp_is_foreign
{
	_regexp_engine_id($_[0]) != _regexp_engine_id(qr//);
}

sub serialize_regexp
{
	my $re = shift;

	if (not is_regexp($re))
	{
		require Carp;
		Carp::croak("Cannot serialize non-regexp");
	}

	if (regexp_seen_evals($re))
	{
		require Carp;
		Carp::croak("Cannot serialize regexp containing evals");
	}

	if (regexp_is_foreign($re))
	{
		require Carp;
		Carp::croak("Cannot serialize regexp using plugin re engine");
	}

	my $str = re::regexp_pattern($re);
	return "qr/$str/" if $str !~ m{\/};
	return "qr!$str!" if $str !~ m{\!};
	return "qr#$str#" if $str !~ m{\#};

	require B;
	sprintf('do { my $re = %s; qr/$re/ }', B::perlstring($str));
}

my $safe;
sub deserialize_regexp
{
	my $str = shift;

	if (!defined $str or ref $str)
	{
		require Carp;
		Carp::croak("Cannot deserialize regexp");
	}

	$safe ||= do {
		require Safe;
		my $cpt = Safe->new;
		$cpt->permit(qw/ :base_core :base_mem sprintf qr /);
		$cpt;
	};

	my $re = $safe->reval($str) or do {
		(my $e = $@) =~
			s/ at \(eval \d+\) .+//;
		chomp $e;
		require Carp;
		Carp::croak("Cannot deserialize regexp: $e");
	};

	return $re if is_regexp($re);

	require Carp;
	Carp::croak("Cannot deserialize regexp: eval returned $re");
}

1;

__END__