diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/re.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/re.pm | 68 |
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>. |