summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/re.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/re.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/re.pm68
1 files changed, 45 insertions, 23 deletions
diff --git a/Master/tlpkg/tlperl/lib/re.pm b/Master/tlpkg/tlperl/lib/re.pm
index 058b8aa961c..c416b94c28f 100644
--- a/Master/tlpkg/tlperl/lib/re.pm
+++ b/Master/tlpkg/tlperl/lib/re.pm
@@ -4,7 +4,7 @@ package re;
use strict;
use warnings;
-our $VERSION = "0.32";
+our $VERSION = "0.34";
our @ISA = qw(Exporter);
our @EXPORT_OK = ('regmust',
qw(is_regexp regexp_pattern
@@ -23,6 +23,7 @@ my %reflags = (
s => 1 << ($PMMOD_SHIFT + 1),
i => 1 << ($PMMOD_SHIFT + 2),
x => 1 << ($PMMOD_SHIFT + 3),
+ xx => 1 << ($PMMOD_SHIFT + 4),
n => 1 << ($PMMOD_SHIFT + 5),
p => 1 << ($PMMOD_SHIFT + 6),
strict => 1 << ($PMMOD_SHIFT + 10),
@@ -112,7 +113,6 @@ sub bits {
my $on = shift;
my $bits = 0;
my $turning_all_off = ! @_ && ! $on;
- my %seen; # Has flag already been seen?
if ($turning_all_off) {
# Pretend were called with certain parameters, which are best dealt
@@ -180,6 +180,7 @@ sub bits {
} elsif ($s =~ s/^\///) {
my $reflags = $^H{reflags} || 0;
my $seen_charset;
+ my $x_count = 0;
while ($s =~ m/( . )/gx) {
local $_ = $1;
if (/[adul]/) {
@@ -225,7 +226,19 @@ sub bits {
&& $^H{reflags_charset} == $reflags{$_};
}
} elsif (exists $reflags{$_}) {
- $seen{$_}++;
+ if ($_ eq 'x') {
+ $x_count++;
+ if ($x_count > 2) {
+ require Carp;
+ Carp::carp(
+ qq 'The "x" flag may only appear a maximum of twice'
+ );
+ }
+ elsif ($x_count == 2) {
+ $_ = 'xx'; # First time through got the /x
+ }
+ }
+
$on
? $reflags |= $reflags{$_}
: ($reflags &= ~$reflags{$_});
@@ -247,18 +260,6 @@ sub bits {
")");
}
}
- if (exists $seen{'x'} && $seen{'x'} > 1
- && (warnings::enabled("deprecated")
- || warnings::enabled("regexp")))
- {
- my $message = "Having more than one /x regexp modifier is deprecated";
- if (warnings::enabled("deprecated")) {
- warnings::warn("deprecated", $message);
- }
- else {
- warnings::warn("regexp", $message);
- }
- }
if ($turning_all_off) {
_load_unload(0);
@@ -331,7 +332,7 @@ re - Perl pragma to alter regular expression behaviour
use re qw(is_regexp regexp_pattern); # import utility functions
my ($pat,$mods)=regexp_pattern(qr/foo/i);
- if (is_regexp($obj)) {
+ if (is_regexp($obj)) {
print "Got regexp: ",
scalar regexp_pattern($obj); # just as perl would stringify
} # it but no hassle with blessed
@@ -420,20 +421,34 @@ under non-strict.
=head2 '/flags' mode
-When C<use re '/flags'> is specified, the given flags are automatically
+When C<use re '/I<flags>'> is specified, the given I<flags> are automatically
added to every regular expression till the end of the lexical scope.
-
-C<no re '/flags'> will turn off the effect of C<use re '/flags'> for the
+I<flags> can be any combination of
+C<'a'>,
+C<'aa'>,
+C<'d'>,
+C<'i'>,
+C<'l'>,
+C<'m'>,
+C<'n'>,
+C<'p'>,
+C<'s'>,
+C<'u'>,
+C<'x'>,
+and/or
+C<'xx'>.
+
+C<no re '/I<flags>'> will turn off the effect of C<use re '/I<flags>'> for the
given flags.
-For example, if you want all your regular expressions to have /msx on by
+For example, if you want all your regular expressions to have /msxx on by
default, simply put
- use re '/msx';
+ use re '/msxx';
at the top of your code.
-The character set /adul flags cancel each other out. So, in this example,
+The character set C</adul> flags cancel each other out. So, in this example,
use re "/u";
"ss" =~ /\xdf/;
@@ -442,6 +457,13 @@ The character set /adul flags cancel each other out. So, in this example,
the second C<use re> does an implicit C<no re '/u'>.
+Similarly,
+
+ use re "/xx"; # Doubled-x
+ ...
+ use re "/x"; # Single x from here on
+ ...
+
Turning on one of the character set flags with C<use re> takes precedence over the
C<locale> pragma and the 'unicode_strings' C<feature>, for regular
expressions. Turning off one of these flags when it is active reverts to
@@ -467,7 +489,7 @@ strings on/off, pre-point part on/off.
See L<perldebug/"Debugging Regular Expressions"> for additional info.
As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
-lexically scoped, as the other directives are. However they have both
+lexically scoped, as the other directives are. However they have both
compile-time and run-time effects.
See L<perlmodlib/Pragmatic Modules>.