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 and L.) =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 to return the original regexp object. Uses L, and also checks that the return value is a regexp, so should be I 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 for convenience. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO More regexp stuff: L. Other util modules: L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =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.