use vars qw($VERSION);
use Carp;
-$VERSION = '2.02';
+$VERSION = '2.05';
# LOAD FILTERING MODULE...
# CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch
-$::_S_W_I_T_C_H = sub { croak "case statement not in switch block" };
+$::_S_W_I_T_C_H = sub { croak "case/when statement not in switch/given block" };
my $offset;
my $fallthrough;
+my ($Perl5, $Perl6) = (0,0);
sub import
{
$DB::single = 1;
$fallthrough = grep /\bfallthrough\b/, @_;
$offset = (caller)[2]+1;
- filter_add({}) unless @_>1 && $_[1] ne '__';
+ filter_add({}) unless @_>1 && $_[1] eq 'noimport';
my $pkg = caller;
no strict 'refs';
for ( qw( on_defined on_exists ) )
*{"${pkg}::$_"} = \&$_;
}
*{"${pkg}::__"} = \&__ if grep /__/, @_;
+ $Perl6 = 1 if grep(/Perl\s*6/i, @_);
+ $Perl5 = 1 if grep(/Perl\s*5/i, @_) || !grep(/Perl\s*6/i, @_);
1;
}
sub line
{
my ($pretext,$offset) = @_;
- ($pretext=~tr/\n/\n/)+$offset,
+ ($pretext=~tr/\n/\n/)+($offset||0);
}
sub is_block
sub filter_blocks
{
my ($source, $line) = @_;
- return $source unless $source =~ /case|switch/;
+ return $source unless $Perl5 && $source =~ /case|switch/
+ || $Perl6 && $source =~ /when|given/;
pos $source = 0;
my $text = "";
component: while (pos $source < length $source)
next component;
}
- if ($source =~ m/\G(\n*)(\s*)switch\b(?=\s*[(])/gc)
+ if ($Perl5 && $source =~ m/\G(\n*)(\s*)(switch)\b(?=\s*[(])/gc
+ || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc)
{
+ my $keyword = $3;
$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 switch statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
+ 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));
$arg =~ s {^\s*[(]\s*%} { ( \\\%} ||
$arg =~ s {^\s*[(]\s*qw} { ( \\qw};
@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)
or do {
- die "Bad switch statement (problem in the code block?) near $Switch::file line ", line(substr($source,0, pos $source), $line), "\n";
+ die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0, pos $source), $line), "\n";
};
my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
$code =~ s/{/{ local \$::_S_W_I_T_C_H; Switch::switch $arg;/;
$text .= $code . 'continue {last}';
next component;
}
- elsif ($source =~ m/\G(\s*)(case\b)(?!\s*=>)/gc)
+ elsif ($Perl5 && $source =~ m/\G(\s*)(case\b)(?!\s*=>)/gc
+ || $Perl6 && $source =~ m/\G(\s*)(when\b)(?!\s*=>)/gc)
{
+ my $keyword = $2;
$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]);
$code =~ s {^\s*[(]\s*qw} { ( \\qw};
$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)";
+ }
elsif ( @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,1)) {
my $code = substr($source,$pos[2],$pos[18]-$pos[2]);
$code = filter_blocks($code,line(substr($source,0,$pos[2]),$line));
$code =~ s {^\s*qw} { \\qw};
$text .= " $code)";
}
- elsif ($source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\s*{)/gc) {
+ 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 .= " $code)";
}
else {
- die "Bad case statement (invalid case value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n";
+ die "Bad $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n";
}
- @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)
+ 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;
+
+ do{@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)}
or do {
if ($source =~ m/\G\s*(?=([};]|\Z))/gc) {
$casecounter++;
next component;
}
- die "Bad case statement (problem in the code block?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
+ die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
};
my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
$code =~ s/}(?=\s*\Z)/;last S_W_I_T_C_H }/
my @numy;
for my $nextx ( @$x )
{
- my $numx = ref($nextx) || (~$nextx&$nextx) eq 0;
+ my $numx = ref($nextx) || defined $nextx && (~$nextx&$nextx) eq 0;
for my $j ( 0..$#$y )
{
my $nexty = $y->[$j];
- push @numy, ref($nexty) || (~$nexty&$nexty) eq 0
+ push @numy, ref($nexty) || defined $nexty && (~$nexty&$nexty) eq 0
if @numy <= $j;
return 1 if $numx && $numy[$j] && $nextx==$nexty
|| $nextx eq $nexty;
return $s_val->($c_val);
};
}
- elsif ($s_ref eq "" && (~$s_val&$s_val) eq 0) # NUMERIC SCALAR
+ elsif ($s_ref eq "" && defined $s_val && (~$s_val&$s_val) eq 0) # NUMERIC SCALAR
{
$::_S_W_I_T_C_H =
sub { my $c_val = $_[0];
my $c_ref = ref $c_val;
return $s_val == $c_val if $c_ref eq ""
+ && defined $c_val
&& (~$c_val&$c_val) eq 0;
return $s_val eq $c_val if $c_ref eq "";
return in([$s_val],$c_val) if $c_ref eq 'ARRAY';
=head1 VERSION
-This document describes version 2.02 of Switch,
-released April 26, 2001.
+This document describes version 2.05 of Switch,
+released September 3, 2001.
=head1 SYNOPSIS
while (<>) {
switch ($_) {
- case %special { print "homer\n"; } # if $special{$_}
- case /a-z/i { print "alpha\n"; } # if $_ =~ /a-z/i
- case [1..9] { print "small num\n"; } # if $_ in [1..9]
+ case (%special) { print "homer\n"; } # if $special{$_}
+ case /a-z/i { print "alpha\n"; } # if $_ =~ /a-z/i
+ case [1..9] { print "small num\n"; } # if $_ in [1..9]
case { $_[0] >= 10 } { # if $_ >= 10
my $age = <>;
+=head2 Alternative syntax
+
+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
+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.
+
+This future syntax is also 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(); }
+ }
+
+Note that you can mix and match both syntaxes by importing the module
+with:
+
+ use Switch 'Perl5', 'Perl6';
+
+
=head2 Higher-order Operations
One situation in which C<switch> and C<case> do not provide a good
=head1 COPYRIGHT
-Copyright (c) 1997-2000, Damian Conway. All Rights Reserved.
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+ Copyright (c) 1997-2001, 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.
https://perl5.git.perl.org / perl5.git / blobdiff