[PATCH] fixing CPAN bug #24027 in Switch.pm

The patch includes the addition of a notice that this module is
deprecated. The technical part of the patch follows my analysis -
matching isn't done in a sub any more, so all the captures are
available in the branch following the regexp.

(I've also increased the version, but maybe that's one too much?)

kr
Wolfgang

--- lib/Switch.pm.GOOD	2007-02-26 19:38:12.000000000 +0100
+++ lib/Switch.pm	2007-03-04 12:37:50.000000000 +0100
@@ -4,7 +4,7 @@
 use vars qw($VERSION);
 use Carp;

-$VERSION = '2.12';
+$VERSION = '2.14';


 # LOAD FILTERING MODULE...
@@ -158,16 +158,18 @@
 		    || $Perl6 && $source =~ m/\G(\s*)(default\b)(?=\s*\{)/gc)
 		{
 			my $keyword = $2;
-			$text .= $1 . ($keyword eq "default"
-					? "if (1)"
-					: "if (Switch::case");
+#			$text .= $1 . ($keyword eq "default"
+#					? "if (1)"
+#					: "if (Switch::case");
+                        $text .= $1;

 			if ($keyword eq "default") {
-				# Nothing to do
+				# if true
+			        $text .= "if (1)";
 			}
 			elsif (@pos =
Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef))
{
 				my $code = substr($source,$pos[0],$pos[4]-$pos[0]);
-				$text .= " " if $pos[0] < $pos[2];
+                                $text .= "if (Switch::case ";
 				$text .= "sub " if is_block $code;
 				$text .= filter_blocks($code,line(substr($source,0,$pos[0]),$line)) . ")";
 			}
@@ -177,29 +179,33 @@
 				$code =~ s {^\s*[(]\s*m\b} { ( qr}	||
 				$code =~ s {^\s*[(]\s*/}   { ( qr/}	||
 				$code =~ s {^\s*[(]\s*qw}  { ( \\qw};
-				$text .= " " if $pos[0] < $pos[2];
+                                $text .= "if (Switch::case ";
 				$text .= "$code)";
 			}
 			elsif ($Perl6 && do{@pos =
Text::Balanced::_match_variable(\$source,qr/\s*/)}) {
 				my $code =
filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
 				$code =~ s {^\s*%}  { \%}	||
 				$code =~ s {^\s*@}  { \@};
-				$text .= " " if $pos[0] < $pos[2];
-				$text .= "$code)";
+                                $text .= "if (Switch::case $code)";
 			}
 			elsif ( @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0)) {
 				my $code = substr($source,$pos[2],$pos[18]-$pos[2]);
 				$code = filter_blocks($code,line(substr($source,0,$pos[2]),$line));
-				$code =~ s {^\s*m}  { qr}	||
-				$code =~ s {^\s*/}  { qr/}	||
-				$code =~ s {^\s*qw} { \\qw};
-				$text .= " " if $pos[0] < $pos[2];
-				$text .= "$code)";
+                                $code =~ s {^\s*m}  { qr}	||
+        			$code =~ s {^\s*/}  { qr/}	;
+                                if( $code =~ /^\s*qr\b/	){
+                                    # a regexp must not be evaluated
in some sub as this loses captures
+                                    $text .= 'if( $::_S_W_I_T_C_H->(
' . $code . '  ) =~ ' . $code . ')';
+				} else {
+				    $code =~ s {^\s*qw} { \\qw};
+				    $text .= "if (Switch::case $code)";
+				}
 			}
 			elsif ($Perl5 && $source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\s*{)/gc
 			   ||  $Perl6 && $source =~ m/\G\s*([^;{]*)()/gc) {
 				my $code = filter_blocks($1,line(substr($source,0,pos $source),$line));
-				$text .= ' \\' if $2 eq '%';
+                                $text .= "if (Switch::case ";
+				$text .= '\\' if $2 eq '%';
 				$text .= " $code)";
 			}
 			else {
@@ -291,8 +297,7 @@
 			    return in([$s_val],$c_val)	if $c_ref eq 'ARRAY';
 			    return $c_val->($s_val)	if $c_ref eq 'CODE';
 			    return $c_val->call($s_val)	if $c_ref eq 'Switch';
-			    return scalar $s_val=~/$c_val/
-							if $c_ref eq 'Regexp';
+			    return scalar $s_val	if $c_ref eq 'Regexp';
 			    return scalar $c_val->{$s_val}
 							if $c_ref eq 'HASH';
 		            return;	
@@ -307,8 +312,7 @@
 			    return in([$s_val],$c_val)	if $c_ref eq 'ARRAY';
 			    return $c_val->($s_val)	if $c_ref eq 'CODE';
 			    return $c_val->call($s_val)	if $c_ref eq 'Switch';
-			    return scalar $s_val=~/$c_val/
-							if $c_ref eq 'Regexp';
+			    return scalar $s_val	if $c_ref eq 'Regexp';
 			    return scalar $c_val->{$s_val}
 							if $c_ref eq 'HASH';
 		            return;	
@@ -513,11 +517,15 @@

 =head1 VERSION

-This document describes version 2.11 of Switch,
-released Nov 22, 2006.
+This document describes version 2.14 of Switch,
+released Mar 4, 2007.

 =head1 SYNOPSIS

+This module is deprecated but retained for compatibility. Starting
+from Perl 5.10, it's preferable to use the built-in switch statement.
+See L<Switch statements|perlsyn/"Switch Statements">.
+
     use Switch;

     switch ($val) {

• [PATCH] fixing CPAN bug #24027 in Switch.pm by Wolfgang Laun
• Re: [PATCH] fixing CPAN bug #24027 in Switch.pm by Rafael Garcia-Suarez