use 5.010000;
use strict;
use warnings;
package Regexp::Util;
our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION = '0.005';
require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);
eval 'require re';
require Exporter::Tiny;
our @ISA = qw( Exporter::Tiny );
our @EXPORT;
our @EXPORT_OK = qw(
is_regexp
regexp_seen_evals
regexp_is_foreign
serialize_regexp
deserialize_regexp
regexp_pattern regmust regname regnames regnames_count
);
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");
}
sub regexp_pattern {
goto \&re::regexp_pattern;
}
sub regmust {
goto \&re::regmust;
}
sub regname {
goto \&re::regname;
}
sub regnames {
goto \&re::regnames;
}
sub regnames_count {
goto \&re::regnames_count;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
Regexp::Util - A selection of general-utility regexp subroutines
=head1 SYNOPSIS
use Regexp::Util qw( :all );
my $stringified = serialize_regexp( qr/^foo/ );
my $regexp = deserialize_regexp( $stringified );
"foobar" =~ $regexp;
=head1 DESCRIPTION
This module provides the following functions:
=over
=item C<< is_regexp($ref) >>
Returns a boolean indicating whether C<< $ref >> is a regexp reference.
Is not tricked by blessed regexps.
=item C<< regexp_seen_evals($re) >>
Returns true if C<< $re >> contains embedded Perl code.
=item C<< regexp_is_foreign($re) >>
Returns true if C<< $re >> uses a regexp engine plugin.
(Since Perl 5.10, it has been possible to use regexp engine plugins,
such as L<re::engine::PCRE> and L<re::engine::RE2>.)
=item C<< serialize_regexp($re) >>
Serializes the regexp to a string of Perl code.
Croaks if the regexp contains embedded Perl code, or uses a regexp engine
plugin.
=item C<< deserialize_regexp($str) >>
Evaluates a string of Perl code generated by C<serialize_regexp> to
return the original regexp object. Uses L<Safe>, and also checks that
the return value is a regexp, so should be I<somewhat> safer than
C<< eval($str) >>.
=back
This module can also re-export C<< regexp_pattern($re) >>,
C<< regmust($re) >>, C<< regname($name, $all) >>,
C<< regnames($all) >>, and C<< regnames_count() >> from L<re>
for convenience.
=head1 BUGS
Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=Regexp-Util>.
=head1 SEE ALSO
More regexp stuff:
L<re>.
Other util modules:
L<Scalar::Util>,
L<List::Util>,
L<Hash::Util>.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2014, 2018 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 DISCLAIMER OF WARRANTIES
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.