Check for the group entry returned by getpwuid as well when testing

[p5sagit/p5-mst-13.2.git] / lib / Switch.pm

diff --git a/lib/Switch.pm b/lib/Switch.pm
index df6e9b8..709442e 100644 (file)
--- a/lib/Switch.pm
+++ b/lib/Switch.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw($VERSION);
 use Carp;
 
-$VERSION = '2.10_01';
+$VERSION = '2.14';
 
 
 # LOAD FILTERING MODULE...
@@ -72,15 +72,9 @@ sub is_block
        return !$ishash;
 }
 
-
-my $EOP = qr/\n\n|\Z/;
-my $CUT = qr/\n=cut.*$EOP/;
-my $pod_or_DATA = qr/ ^=(?:head[1-4]|item) .*? $CUT
-                    | ^=pod .*? $CUT
-                    | ^=for .*? $EOP
-                    | ^=begin \s* (\S+) .*? \n=end \s* \1 .*? $EOP
-                    | ^__(DATA|END)__\n.*
-                    /smx;
+my $pod_or_DATA = qr/ ^=[A-Za-z] .*? ^=cut (?![A-Za-z]) .*? $
+                   | ^__(DATA|END)__\n.*
+                   /smx;
 
 my $casecounter = 1;
 sub filter_blocks
@@ -101,10 +95,22 @@ sub filter_blocks
                if (defined $pos[0])
                {
                        my $pre = substr($source,$pos[0],$pos[1]); # matched prefix
-                       $text .= $pre . substr($source,$pos[2],$pos[18]-$pos[2]);
+                        my $iEol;
+                        if( substr($source,$pos[4],$pos[5]) eq '/' && # 1st delimiter
+                            substr($source,$pos[2],$pos[3]) eq '' && # no op like 'm'
+                            index( substr($source,$pos[16],$pos[17]), 'x' ) == -1 && # no //x
+                            ($iEol = index( $source, "\n", $pos[4] )) > 0         &&
+                            $iEol < $pos[8] ){ # embedded newlines
+                            # If this is a pattern, it isn't compatible with Switch. Backup past 1st '/'.
+                            pos( $source ) = $pos[6];
+                           $text .= $pre . substr($source,$pos[2],$pos[6]-$pos[2]);
+                       } else {
+                           $text .= $pre . substr($source,$pos[2],$pos[18]-$pos[2]);
+                       }
                        next component;
                }
-               if ($source =~ m/\G\s*($pod_or_DATA)/gc) {
+               if ($source =~ m/(\G\s*$pod_or_DATA)/gc) {
+                       $text .= $1;
                        next component;
                }
                @pos = Text::Balanced::_match_variable(\$source,qr/\s*/);
@@ -502,26 +508,24 @@ Switch - A switch statement for Perl
 
 =head1 VERSION
 
-This document describes version 2.10 of Switch,
-released Dec 29, 2003.
+This document describes version 2.14 of Switch,
+released Dec 29, 2008.
 
 =head1 SYNOPSIS
 
-       use Switch;
-
-       switch ($val) {
+    use Switch;
 
-               case 1          { print "number 1" }
-               case "a"        { print "string a" }
-               case [1..10,42] { print "number in list" }
-               case (@array)   { print "number in list" }
-               case /\w+/      { print "pattern" }
-               case qr/\w+/    { print "pattern" }
-               case (%hash)    { print "entry in hash" }
-               case (\%hash)   { print "entry in hash" }
-               case (\&sub)    { print "arg to subroutine" }
-               else            { print "previous case not true" }
-       }
+    switch ($val) {
+       case 1          { print "number 1" }
+       case "a"        { print "string a" }
+       case [1..10,42] { print "number in list" }
+       case (\@array)  { print "number in list" }
+       case /\w+/      { print "pattern" }
+       case qr/\w+/    { print "pattern" }
+       case (\%hash)   { print "entry in hash" }
+       case (\&sub)    { print "arg to subroutine" }
+       else            { print "previous case not true" }
+    }
 
 =head1 BACKGROUND
 
@@ -591,14 +595,11 @@ the existence of a series of keys (C<match if exists $s-E<gt>{$c}>),
 one could test for the existence of a single key in a series of hashes
 (C<match if exists $c-E<gt>{$s}>).
 
-As L<perltodo> observes, a Perl case mechanism must support all these
-"ways to do it".
-
-
 =head1 DESCRIPTION
 
 The Switch.pm module implements a generalized case mechanism that covers
-the numerous possible combinations of switch and case values described above.
+most (but not all) of the numerous possible combinations of switch and case
+values described above.
 
 The module augments the standard Perl syntax with two new control
 statements: C<switch> and C<case>. The C<switch> statement takes a
@@ -834,7 +835,7 @@ and then treats the two resulting references as arguments to C<&&>:
 
 This boolean expression is inevitably true, since both references are
 non-false. Fortunately, the overloaded C<'bool'> operator catches this
-situation and flags it as a error. 
+situation and flags it as an error. 
 
 =head1 DEPENDENCIES
 
@@ -843,8 +844,9 @@ and requires both these modules to be installed.
 
 =head1 AUTHOR
 
-Damian Conway (damian@conway.org). The maintainer of this module is now Rafael
-Garcia-Suarez (rgarciasuarez@free.fr).
+Damian Conway (damian@conway.org). This module is now maintained by Rafael
+Garcia-Suarez (rgarciasuarez@gmail.com) and more generally by the Perl 5
+Porters (perl5-porters@perl.org), as part of the Perl core.
 
 =head1 BUGS
 
@@ -853,7 +855,11 @@ Bug reports and other feedback are most welcome.
 
 =head1 LIMITATIONS
 
-Due to the heuristic nature of Switch.pm's source parsing, the presence
+Due to the heuristic nature of Switch.pm's source parsing, the presence of
+regexes with embedded newlines that are specified with raw C</.../>
+delimiters and don't have a modifier C<//x> are indistinguishable from
+code chunks beginning with the division operator C</>. As a workaround
+you must use C<m/.../> or C<m?...?> for such patterns. Also, the presence
 of regexes specified with raw C<?...?> delimiters may cause mysterious
 errors. The workaround is to use C<m?...?> instead.
 
@@ -867,6 +873,6 @@ use smaller source files.
 
 =head1 COPYRIGHT
 
-    Copyright (c) 1997-2006, Damian Conway. All Rights Reserved.
+    Copyright (c) 1997-2008, Damian Conway. All Rights Reserved.
     This module is free software. It may be used, redistributed
         and/or modified under the same terms as Perl itself.