[perl #78072] use re '/xism';

1 files changed, 82 insertions, 0 deletions

diff --git a/ext/re/re.pm b/ext/re/re.pm
index 90e31f3ff9..881323222d 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -16,6 +16,20 @@ my %bitmask = (
     eval    => 0x00200000, # HINT_RE_EVAL
 );
 
+my $flags_hint = 0x02000000; # HINT_RE_FLAGS
+my $PMMOD_SHIFT = 0;
+my %reflags = (
+    m => 1 << ($PMMOD_SHIFT + 0),
+    s => 1 << ($PMMOD_SHIFT + 1),
+    i => 1 << ($PMMOD_SHIFT + 2),
+    x => 1 << ($PMMOD_SHIFT + 3),
+    p => 1 << ($PMMOD_SHIFT + 4),
+# special cases:
+    l => 1 << ($PMMOD_SHIFT + 5),
+    u => 1 << ($PMMOD_SHIFT + 6),
+    d => 0,
+);
+
 sub setcolor {
  eval {				# Ignore errors
   require Term::Cap;
@@ -96,6 +110,7 @@ sub bits {
 	require Carp;
 	Carp::carp("Useless use of \"re\" pragma"); 
     }
+   ARG:
     foreach my $idx (0..$#_){
         my $s=$_[$idx];
         if ($s eq 'Debug' or $s eq 'Debugcolor') {
@@ -125,6 +140,33 @@ sub bits {
 	} elsif ($EXPORT_OK{$s}) {
 	    require Exporter;
 	    re->export_to_level(2, 're', $s);
+	} elsif ($s =~ s/^\///) {
+	    my $reflags = $^H{reflags} || 0;
+	    for(split//, $s) {
+		if (/[dul]/) {
+		    if ($on) {
+			$^H{reflags_dul} = $reflags{$_};
+		    }
+		    else {
+			delete $^H{reflags_dul}
+			 if  defined $^H{reflags_dul}
+			  && $^H{reflags_dul} == $reflags{$_};
+		    }
+		} elsif (exists $reflags{$_}) {
+		    $on
+		      ? $reflags |= $reflags{$_}
+		      : ($reflags &= ~$reflags{$_});
+		} else {
+		    require Carp;
+		    Carp::carp(
+		     qq'Unknown regular expression flag "$_"'
+		    );
+		    next ARG;
+		}
+	    }
+	    ($^H{reflags} = $reflags or defined $^H{reflags_dul})
+	     ? $^H |= $flags_hint
+	     : ($^H &= ~$flags_hint);
 	} else {
 	    require Carp;
 	    Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
@@ -170,6 +212,11 @@ re - Perl pragma to alter regular expression behaviour
 	/foo${pat}bar/;		   # disallowed (with or without -T switch)
     }
 
+    use re '/ix';
+    "FOO" =~ / foo /; # /ix implied
+    no re '/x';
+    "FOO" =~ /foo/; # just /i implied
+
     use re 'debug';		   # output debugging info during
     /^(.*)$/s;			   #     compile and run time
 
@@ -220,6 +267,41 @@ interpolation.  Thus:
 I<is> allowed if $pat is a precompiled regular expression, even
 if $pat contains C<(?{ ... })> assertions or C<(??{ ... })> subexpressions.
 
+=head2 '/flags' mode
+
+When C<use re '/flags'> is specified, the given 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
+given flags.
+
+For example, if you want all your regular expressions to have /msx on by
+default, simply put
+
+    use re '/msx';
+
+at the top of your code.
+
+The /dul flags cancel each other out. So, in this example,
+
+    use re "/u";
+    "ss" =~ /\xdf/;
+    use re "/d";
+    "ss" =~ /\xdf/;
+
+The second C<use re> does an implicit C<no re '/u'>.
+
+Turning on the /l and /u 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
+the behaviour specified by whatever other pragmata are in scope. For
+example:
+
+    use feature "unicode_strings";
+    no re "/u"; # does nothing
+    use re "/l";
+    no re "/l"; # reverts to unicode_strings behaviour
+
 =head2 'debug' mode
 
 When C<use re 'debug'> is in effect, perl emits debugging messages when