projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
for File::Temp::tempdir(CLEANUP => 1)
[p5sagit/p5-mst-13.2.git] / lib / Switch.pm
diff --git a/lib/Switch.pm b/lib/Switch.pm
index 7f05bc0..9c4abe3 100644 (file)
--- a/lib/Switch.pm
+++ b/lib/Switch.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw($VERSION);
 use Carp;
 
-$VERSION = '2.06';
+$VERSION = '2.10';
 
 
 # LOAD FILTERING MODULE...
@@ -22,7 +22,6 @@ my ($Perl5, $Perl6) = (0,0);
 
 sub import
 {
-       $DB::single = 1;
        $fallthrough = grep /\bfallthrough\b/, @_;
        $offset = (caller)[2]+1;
        filter_add({}) unless @_>1 && $_[1] eq 'noimport';
@@ -53,7 +52,6 @@ sub filter
        return $status if $status<0;
        $_ = filter_blocks($_,$offset);
        $_ = "# line $offset\n" . $_ if $offset; undef $offset;
-       # print STDERR $_;
        return $status;
 }
 
@@ -92,6 +90,7 @@ sub filter_blocks
                           || $Perl6 && $source =~ /when|given/;
        pos $source = 0;
        my $text = "";
+       $DB::single = 1;
        component: while (pos $source < length $source)
        {
                if ($source =~ m/(\G\s*use\s+Switch\b)/gc)
@@ -102,7 +101,8 @@ sub filter_blocks
                my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0);
                if (defined $pos[0])
                {
-                       $text .= " " . substr($source,$pos[2],$pos[18]-$pos[2]);
+                       $text .= " " if $pos[0] < $pos[2];
+                       $text .= substr($source,$pos[2],$pos[18]-$pos[2]);
                        next component;
                }
                if ($source =~ m/\G\s*($pod_or_DATA)/gc) {
@@ -111,20 +111,26 @@ sub filter_blocks
                @pos = Text::Balanced::_match_variable(\$source,qr/\s*/);
                if (defined $pos[0])
                {
-                       $text .= " " . substr($source,$pos[0],$pos[4]-$pos[0]);
+                       $text .= " " if $pos[0] < $pos[2];
+                       $text .= substr($source,$pos[0],$pos[4]-$pos[0]);
                        next component;
                }
 
                if ($Perl5 && $source =~ m/\G(\n*)(\s*)(switch)\b(?=\s*[(])/gc
-                || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc)
+                || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc
+                || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(.*)(?=\{)/gc)
                {
                        my $keyword = $3;
+                       my $arg = $4;
+                       # print  STDERR "[$arg]\n";
                        $text .= $1.$2.'S_W_I_T_C_H: while (1) ';
-                       @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef) 
-                       or do {
-                               die "Bad $keyword statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
-                       };
-                       my $arg = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
+                       unless ($arg) {
+                               @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef) 
+                               or do {
+                                       die "Bad $keyword statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
+                               };
+                               $arg = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
+                       }
                        $arg =~ s {^\s*[(]\s*%}   { ( \\\%}     ||
                        $arg =~ s {^\s*[(]\s*m\b} { ( qr}       ||
                        $arg =~ s {^\s*[(]\s*/}   { ( qr/}      ||
@@ -145,8 +151,9 @@ sub filter_blocks
                        $text .= $1."if (Switch::case";
                        if (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)) {
                                my $code = substr($source,$pos[0],$pos[4]-$pos[0]);
-                               $text .= " sub" if is_block $code;
-                               $text .= " " . filter_blocks($code,line(substr($source,0,$pos[0]),$line)) . ")";
+                               $text .= " " if $pos[0] < $pos[2];
+                               $text .= "sub " if is_block $code;
+                               $text .= filter_blocks($code,line(substr($source,0,$pos[0]),$line)) . ")";
                        }
                        elsif (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/[[(]/,qr/[])]/,qr/[[({]/,qr/[])}]/,undef)) {
                                my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
@@ -154,13 +161,15 @@ sub filter_blocks
                                $code =~ s {^\s*[(]\s*m\b} { ( qr}      ||
                                $code =~ s {^\s*[(]\s*/}   { ( qr/}     ||
                                $code =~ s {^\s*[(]\s*qw}  { ( \\qw};
-                               $text .= " $code)";
+                               $text .= " " if $pos[0] < $pos[2];
+                               $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 .= " $code)";
+                               $text .= " " if $pos[0] < $pos[2];
+                               $text .= "$code)";
                        }
                        elsif ( @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0)) {
                                my $code = substr($source,$pos[2],$pos[18]-$pos[2]);
@@ -168,10 +177,11 @@ sub filter_blocks
                                $code =~ s {^\s*m}  { qr}       ||
                                $code =~ s {^\s*/}  { qr/}      ||
                                $code =~ s {^\s*qw} { \\qw};
-                               $text .= " $code)";
+                               $text .= " " if $pos[0] < $pos[2];
+                               $text .= "$code)";
                        }
                        elsif ($Perl5 && $source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\s*{)/gc
-                          ||  $Perl6 && $source =~ m/\G\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 .= " $code)";
@@ -180,8 +190,8 @@ sub filter_blocks
                                die "Bad $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n";
                        }
 
-                       die "Missing colon or semi-colon after 'when' value near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"
-                               unless !$Perl6 || $source =~ m/\G(\s*)(:|(?=;))/gc;
+                       die "Missing opening brace or semi-colon after 'when' value near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"
+                               unless !$Perl6 || $source =~ m/\G(\s*)(?=;|\{)/gc;
 
                        do{@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)}
                        or do {
@@ -487,8 +497,8 @@ Switch - A switch statement for Perl
 
 =head1 VERSION
 
-This document describes version 2.06 of Switch,
-released November 14, 2001.
+This document describes version 2.09 of Switch,
+released June 12, 2002.
 
 =head1 SYNOPSIS
 
@@ -737,25 +747,27 @@ behaviour of the third case.
 
 Perl 6 will provide a built-in switch statement with essentially the
 same semantics as those offered by Switch.pm, but with a different
-pair of keywords. In Perl 6 C<switch> with be spelled C<given>, and
+pair of keywords. In Perl 6 C<switch> will be spelled C<given>, and
 C<case> will be pronounced C<when>. In addition, the C<when> statement
-will use a colon between its case value and its block (removing the
-need to parenthesize variables.
+will not require switch or case values to be parenthesized.
 
-This future syntax is also available via the Switch.pm module, by
+This future syntax is also (largely) available via the Switch.pm module, by
 importing it with the argument C<"Perl6">.  For example:
 
         use Switch 'Perl6';
 
         given ($val) {
-                when 1 :      { handle_num_1(); }
-                when $str1 :  { handle_str_1(); }
-                when [0..9] : { handle_num_any(); last }
-                when /\d/ :   { handle_dig_any(); }
-                when /.*/ :   { handle_str_any(); }
+                when 1       { handle_num_1(); }
+                when ($str1) { handle_str_1(); }
+                when [0..9]  { handle_num_any(); last }
+                when /\d/    { handle_dig_any(); }
+                when /.*/    { handle_str_any(); }
         }
 
-Note that you can mix and match both syntaxes by importing the module
+Note that scalars still need to be parenthesized, since they would be
+ambiguous in Perl 5.
+
+Note too that you can mix and match both syntaxes by importing the module
 with:
 
        use Switch 'Perl5', 'Perl6';
Unnamed repository; edit this file to name it for gitweb.