use vars qw($VERSION);
use Carp;
-$VERSION = '2.07';
+$VERSION = '2.10';
# LOAD FILTERING MODULE...
local $Switch::file = (caller)[1];
my $status = 1;
- $status = filter_read(10_000);
+ $status = filter_read(1_000_000);
return $status if $status<0;
$_ = filter_blocks($_,$offset);
$_ = "# line $offset\n" . $_ if $offset; undef $offset;
- # print STDERR $_;
return $status;
}
{
my ($source, $line) = @_;
return $source unless $Perl5 && $source =~ /case|switch/
- || $Perl6 && $source =~ /when|given/;
+ || $Perl6 && $source =~ /when|given|default/;
pos $source = 0;
my $text = "";
- $DB::single = 1;
component: while (pos $source < length $source)
{
if ($source =~ m/(\G\s*use\s+Switch\b)/gc)
my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0);
if (defined $pos[0])
{
- $text .= " " . substr($source,$pos[2],$pos[18]-$pos[2]);
+ my $pre = substr($source,$pos[0],$pos[1]); # matched prefix
+ $text .= $pre . substr($source,$pos[2],$pos[18]-$pos[2]);
next component;
}
if ($source =~ m/\G\s*($pod_or_DATA)/gc) {
@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;
}
{
my $keyword = $3;
my $arg = $4;
- print STDERR "[$arg]\n";
$text .= $1.$2.'S_W_I_T_C_H: while (1) ';
unless ($arg) {
@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef)
next component;
}
elsif ($Perl5 && $source =~ m/\G(\s*)(case\b)(?!\s*=>)/gc
- || $Perl6 && $source =~ m/\G(\s*)(when\b)(?!\s*=>)/gc)
+ || $Perl6 && $source =~ m/\G(\s*)(when\b)(?!\s*=>)/gc
+ || $Perl6 && $source =~ m/\G(\s*)(default\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)) {
+ $text .= $1 . ($keyword eq "default"
+ ? "if (1)"
+ : "if (Switch::case");
+
+ if ($keyword eq "default") {
+ # Nothing to do
+ }
+ 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 .= " 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));
$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]);
$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) {
=head1 VERSION
-This document describes version 2.07 of Switch,
-released May 15, 2002.
+This document describes version 2.10 of Switch,
+released Dec 29, 2003.
=head1 SYNOPSIS
is usually a Bad Idea in a switch statement. However, this
is Perl, not a police state, so there I<is> a way to do it, if you must.
-If a C<case> block executes an untargetted C<next>, control is
+If a C<case> block executes an untargeted C<next>, control is
immediately transferred to the statement I<after> the C<case> statement
(i.e. usually another case), rather than out of the surrounding
C<switch> block.
case /\d/ { handle_dig_any(); }
}
-If an untargetted C<last> statement is executed in a case block, this
+If an untargeted C<last> statement is executed in a case block, this
immediately transfers control out of the enclosing C<switch> block
(in other words, there is an implicit C<last> at the end of each
normal C<case> block). Thus the previous example could also have been
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 not require switch or case values to be parenthesized.
when [0..9] { handle_num_any(); last }
when /\d/ { handle_dig_any(); }
when /.*/ { handle_str_any(); }
+ default { handle anything else; }
}
Note that scalars still need to be parenthesized, since they would be
=head1 AUTHOR
-Damian Conway (damian@conway.org)
+Damian Conway (damian@conway.org). The maintainer of this module is now Rafael
+Garcia-Suarez (rgarciasuarez@free.fr).
=head1 BUGS
There are undoubtedly serious bugs lurking somewhere in code this funky :-)
Bug reports and other feedback are most welcome.
-=head1 LIMITATION
+=head1 LIMITATIONS
Due to the heuristic nature of Switch.pm's source parsing, the presence
of regexes specified with raw C<?...?> delimiters may cause mysterious
errors. The workaround is to use C<m?...?> instead.
+Due to the way source filters work in Perl, you can't use Switch inside
+an string C<eval>.
+
+If your source file is longer then 1 million characters and you have a
+switch statement that crosses the 1 million (or 2 million, etc.)
+character boundary you will get mysterious errors. The workaround is to
+use smaller source files.
+
=head1 COPYRIGHT
- Copyright (c) 1997-2001, Damian Conway. All Rights Reserved.
+ Copyright (c) 1997-2003, 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.