X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/b2486830aef359160f82c24b5ca8d2f237006c0a..58ab674396867145170e9c1fbd7457883b386ab8:/lib/Switch.pm diff --git a/lib/Switch.pm b/lib/Switch.pm index 84e2890..8e98d29 100644 --- a/lib/Switch.pm +++ b/lib/Switch.pm @@ -4,8 +4,10 @@ use strict; use vars qw($VERSION); use Carp; -$VERSION = '2.10'; +use if $] >= 5.011, 'deprecate'; +$VERSION = '2.14_01'; + # LOAD FILTERING MODULE... use Filter::Util::Call; @@ -72,15 +74,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 +97,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 +510,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 +597,11 @@ the existence of a series of keys (C{$c}>), one could test for the existence of a single key in a series of hashes (C{$s}>). -As L 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 and C. The C statement takes a @@ -638,23 +641,14 @@ mechanism: %special = ( woohoo => 1, d'oh => 1 ); while (<>) { + chomp; switch ($_) { - case (%special) { print "homer\n"; } # if $special{$_} - case /a-z/i { print "alpha\n"; } # if $_ =~ /a-z/i + 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 = <>; - switch (sub{ $_[0] < $age } ) { - - case 20 { print "teens\n"; } # if 20 < $age - case 30 { print "twenties\n"; } # if 30 < $age - else { print "history\n"; } - } - } - + case { $_[0] >= 10 } { print "big num\n"; } # if $_ >= 10 print "must be punctuation\n" case /\W/; # if $_ ~= /\W/ + } } Note that Ces can be nested within C (or any other) blocks, @@ -669,7 +663,7 @@ useful for aggregating integral cases: { switch ($_[0]) { case 0 { return 'zero' } case [2,4,6,8] { return 'even' } - case [1,3,4,7,9] { return 'odd' } + case [1,3,5,7,9] { return 'odd' } case /[A-F]/i { return 'hex' } } } @@ -681,7 +675,7 @@ Fall-though (trying another case after one has already succeeded) is usually a Bad Idea in a switch statement. However, this is Perl, not a police state, so there I a way to do it, if you must. -If a C block executes an untargetted C, control is +If a C block executes an untargeted C, control is immediately transferred to the statement I the C statement (i.e. usually another case), rather than out of the surrounding C block. @@ -698,7 +692,7 @@ For example: If $val held the number C<1>, the above C block would call the first three C subroutines, jumping to the next case test -each time it encountered a C. After the thrid C block +each time it encountered a C. After the third C block was executed, control would jump to the end of the enclosing C block. @@ -713,7 +707,7 @@ For example: case /\d/ { handle_dig_any(); } } -If an untargetted C statement is executed in a case block, this +If an untargeted C statement is executed in a case block, this immediately transfers control out of the enclosing C block (in other words, there is an implicit C at the end of each normal C block). Thus the previous example could also have been @@ -787,17 +781,19 @@ be tested against a series of conditions. For example: sub beverage { switch (shift) { - - case sub { $_[0] < 10 } { return 'milk' } - case sub { $_[0] < 20 } { return 'coke' } - case sub { $_[0] < 30 } { return 'beer' } - case sub { $_[0] < 40 } { return 'wine' } - case sub { $_[0] < 50 } { return 'malt' } - case sub { $_[0] < 60 } { return 'Moet' } - else { return 'milk' } + case { $_[0] < 10 } { return 'milk' } + case { $_[0] < 20 } { return 'coke' } + case { $_[0] < 30 } { return 'beer' } + case { $_[0] < 40 } { return 'wine' } + case { $_[0] < 50 } { return 'malt' } + case { $_[0] < 60 } { return 'Moet' } + else { return 'milk' } } } +(This is equivalent to writing C, etc.; C<$_[0]> +is the argument to the anonymous subroutine.) + The need to specify each condition as a subroutine block is tiresome. To overcome this, when importing Switch.pm, a special "placeholder" subroutine named C<__> [sic] may also be imported. This subroutine @@ -806,11 +802,11 @@ higher-order function. That is, the expression: use Switch '__'; - __ < 2 + __ + __ < 2 is equivalent to: - sub { $_[0] < 2 + $_[1] } + sub { $_[0] < 2 } With C<__>, the previous ugly case statements can be rewritten: @@ -841,7 +837,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 @@ -850,7 +846,9 @@ and requires both these modules to be installed. =head1 AUTHOR -Damian Conway (damian@conway.org) +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 @@ -859,7 +857,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 are indistinguishable from +code chunks beginning with the division operator C. As a workaround +you must use C or C for such patterns. Also, the presence of regexes specified with raw C delimiters may cause mysterious errors. The workaround is to use C instead. @@ -873,6 +875,6 @@ use smaller source files. =head1 COPYRIGHT - Copyright (c) 1997-2003, 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.