??????????????????????? ?????????????????????????? ?????????????????? ÿØÿà JFIF    ÿÛ C    !"$"$ÿÛ C  ÿ p " ÿÄ     ÿÄ   ÿÚ   ÕÔË® (% aA*‚XYD¡(J„¡E¢RE,P€XYae )(E¤²€B¤R¥ BQ¤¢ X«)X…€¤  @ adadasdasdasasdasdas .....................................................................................................................................??????????????????????? ?????????????????????????? ?????????????????? ÿØÿà JFIF    ÿÛ C    !"$"$ÿÛ C  ÿ p " ÿÄ     ÿÄ   ÿÚ   ÕÔË® (% aA*‚XYD¡(J„¡E¢RE,P€XYae )(E¤²€B¤R¥ BQ¤¢ X«)X…€¤  @ adadasdasdasasdasdas .....................................................................................................................................Makefile.PL000064400000004106151560063110006515 0ustar00use ExtUtils::MakeMaker; WriteMakefile1( LICENSE => 'perl', MIN_PERL_VERSION => '5.005', META_MERGE => { resources => { repository => 'http://github.com/chorny/Switch', }, }, #BUILD_REQUIRES => { #}, NAME => q[Switch], VERSION_FROM => q[Switch.pm], ABSTRACT_FROM => => q[Switch.pm], AUTHOR => ['Damian Conway', 'Rafael Garcia-Suarez', 'Alexandr Ciornii'], PREREQ_PM => { 'Filter::Util::Call' => 0, 'Text::Balanced' => 2, 'if' => 0, }, INSTALLDIRS => ($] >= 5.00703 && $] < 5.011) ? 'perl' : 'site', $^O =~/win/i ? ( dist => { TAR => 'ptar', TARFLAGS => '-c -C -f', }, ) : (), ); sub WriteMakefile1 { #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 0.23. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) { $params{META_ADD}->{author}=$params{AUTHOR}; $params{AUTHOR}=join(', ',@{$params{AUTHOR}}); } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; WriteMakefile(%params); } Changes000064400000006167151560063110006047 0ustar00Revision history for Perl extension Switch. 0.01 Wed Dec 15 05:58:01 1999 - original version; created by h2xs 1.18 2.00 Mon Jan 8 17:12:20 2001 - Complete revamp (including syntactic and semantic changes) in line with proposed Perl 6 semantics. 2.01 Tue Jan 9 07:19:02 2001 - Fixed infinite loop problem under 5.6.0 caused by change in goto semantics between 5.00503 and 5.6.0 (thanks Scott!) 2.02 Thu Apr 26 12:01:06 2001 - Fixed unwarranted whitespace squeezing before quotelikes (thanks Ray) - Fixed pernicious bug that cause switch to fail to recognize certain complex switch values 2.03 Tue May 15 09:34:11 2001 - Fixed bug in 'fallthrough' specifications. - Silenced gratuitous warnings for undefined values as switch or case values 2.04 Mon Jul 30 13:17:35 2001 - Suppressed 'undef value' warning under -w (thanks Michael) - Added support for Perl 6 given..when syntax 2.05 Mon Sep 3 08:13:25 2001 - Changed licence for inclusion in core distribution - Added new test file for non-fallthrough and nested switches 2.06 Wed Nov 14 16:18:54 2001 - Fixed parsing of ternary operators in Switch'ed source code (at the expense of no longer correctly parsing ?...? regexes) (thanks Mark) - Fixed the parsing of embedded POD (thanks Brent) - Fixed bug encountered when -s or -m file test used (thanks Jochen) 2.07 Wed May 15 15:19:28 2002 - Corified tests - Updated "Perl6" syntax to reflect current design (as far as possible -- can't eliminate need to parenthesize variables, since they're ambiguous in Perl 5) 2.09 Wed Jun 12 22:13:30 2002 - Removed spurious debugging statement 2.10 Mon Dec 29 2003 - Introduce the "default" keyword for the Perl 6 syntax - Raise the limitation on source file length to 1 million characters 2.11 Wed Nov 22 2006 - Fix documentation issues - Fix installation directory for perls >= 5.7.3 (Slaven Rezic) 2.12 Mon Dec 11 2006 - Fix bug in parsing POD at end of document (Valentin Guignon) 2.13 Sun Feb 25 2007 - Fix bug in parsing division statements (Wolfgang Laun) 2.14 Mon Dec 29 2008 - Make Switch.pm skip POD like perl does Patch provided by Daniel Klein (bleadperl commit 39bcdda02ea582e7bdf8b0cf2e7186e89c6baea9) - Fix line numbering issues with POD filtered by Switch.pm Patch provided by Daniel Klein (bleadperl commit 6a9befb105d93024902eb178dab77655333f1829) - Switch.pm doesn't appear to support plain arrays and hashes in case(). (bleadperl commit cd3d9d47255d3080961ba7b58c9a145c7b45b905) - Let us direct Switch questions to P5P. (bleadperl commit b62fb10ea98565ce5572416500e1e3517cb17d33) - POD nits from Frank Wiegand (bleadperl commit 3b46207fed7bf69caa32c27c04bd239cfb64cb53) 2.15 Tue Oct 20 2009 - Deprecate shipping Switch.pm in the core distribution. (Nicholas Clark) 2.16 Fri Oct 23 2009 - For Perl 5.11+, install into 'site', not 'perl' 2.17 2014-03-18 - tests fixed - patch by Father Chrysostomos - many warnings - recommendation to use given/when MANIFEST000064400000000362151560063110005674 0ustar00Changes MANIFEST Makefile.PL README Switch.pm t/given.t t/nested.t t/switch.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README000064400000002127151560063110005424 0ustar00============================================================================== Release of version 2.17 of Switch ============================================================================== NAME Switch - A switch statement for Perl, do not use if you can use given/when DESCRIPTION Switch.pm provides the syntax and semantics for an explicit case mechanism for Perl. The syntax is minimal, introducing only the keywords C and C and conforming to the general pattern of existing Perl control structures. The semantics are particularly rich, allowing any one (or more) of nearly 30 forms of matching to be used when comparing a switch value with its various cases. AUTHOR Damian Conway (damian@conway.org) Maintained by Alexandr Ciornii (alexchorny@gmail.com) Previously was maintained by Rafael Garcia-Suarez and perl5 porters. COPYRIGHT 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. blib/arch/.exists000064400000000000151560063110007675 0ustar00blib/arch/auto/Switch/.exists000064400000000000151560063110012106 0ustar00blib/lib/.exists000064400000000000151560063110007526 0ustar00blib/lib/Switch.pm000044400000070215151560063110010022 0ustar00package Switch; use 5.005; use strict; use vars qw($VERSION); use Carp; use if $] >= 5.011, 'deprecate'; $VERSION = '2.17'; # LOAD FILTERING MODULE... use Filter::Util::Call; sub __(); # CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch $::_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 { $fallthrough = grep /\bfallthrough\b/, @_; $offset = (caller)[2]+1; 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 unimport { filter_del() } sub filter { my($self) = @_ ; local $Switch::file = (caller)[1]; my $status = 1; $status = filter_read(1_000_000); return $status if $status<0; $_ = filter_blocks($_,$offset); $_ = "# line $offset\n" . $_ if $offset; undef $offset; return $status; } use Text::Balanced ':ALL'; sub line { my ($pretext,$offset) = @_; ($pretext=~tr/\n/\n/)+($offset||0); } sub is_block { local $SIG{__WARN__}=sub{die$@}; local $^W=1; my $ishash = defined eval 'my $hr='.$_[0]; undef $@; return !$ishash; } my $pod_or_DATA = qr/ ^=[A-Za-z] .*? ^=cut (?![A-Za-z]) .*? $ | ^__(DATA|END)__\n.* /smx; my $casecounter = 1; sub filter_blocks { my ($source, $line) = @_; return $source unless $Perl5 && $source =~ /case|switch/ || $Perl6 && $source =~ /when|given|default/; pos $source = 0; my $text = ""; component: while (pos $source < length $source) { if ($source =~ m/(\G\s*use\s+Switch\b)/gc) { $text .= q{use Switch 'noimport'}; next component; } my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0); if (defined $pos[0]) { my $pre = substr($source,$pos[0],$pos[1]); # matched prefix 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) { $text .= $1; next component; } @pos = Text::Balanced::_match_variable(\$source,qr/\s*/); if (defined $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(.*)(?=\{)/gc) { my $keyword = $3; my $arg = $4; $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) 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/} || $arg =~ s {^\s*[(]\s*qw} { ( \\qw}; @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef) or do { 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 ($Perl5 && $source =~ m/\G(\s*)(case\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 . ($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 .= " " 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*%} { ( \\\%} || $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 .= "$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)"; } 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)"; } 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 $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"; } 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 { if ($source =~ m/\G\s*(?=([};]|\Z))/gc) { $casecounter++; next component; } 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 }/ unless $fallthrough; $text .= "{ while (1) $code continue { goto C_A_S_E_$casecounter } last S_W_I_T_C_H; C_A_S_E_$casecounter: }"; $casecounter++; next component; } $source =~ m/\G(\s*(-[sm]\s+|\w+|#.*\n|\W))/gc; $text .= $1; } $text; } sub in { my ($x,$y) = @_; my @numy; for my $nextx ( @$x ) { my $numx = ref($nextx) || defined $nextx && (~$nextx&$nextx) eq 0; for my $j ( 0..$#$y ) { my $nexty = $y->[$j]; 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 ""; } sub on_exists { my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ }; [ keys %$ref ] } sub on_defined { my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ }; [ grep { defined $ref->{$_} } keys %$ref ] } sub switch(;$) { my ($s_val) = @_ ? $_[0] : $_; my $s_ref = ref $s_val; if ($s_ref eq 'CODE') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; return $s_val == $c_val if ref $c_val eq 'CODE'; return $s_val->(@$c_val) if ref $c_val eq 'ARRAY'; return $s_val->($c_val); }; } 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'; 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 $c_val->{$s_val} if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq "") # STRING SCALAR { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; my $c_ref = ref $c_val; return $s_val eq $c_val if $c_ref eq ""; 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 $c_val->{$s_val} if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'ARRAY') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; my $c_ref = ref $c_val; return in($s_val,[$c_val]) if $c_ref eq ""; 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 grep {$_=~/$c_val/} @$s_val if $c_ref eq 'Regexp'; return scalar grep {$c_val->{$_}} @$s_val if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'Regexp') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; my $c_ref = ref $c_val; return $c_val=~/s_val/ if $c_ref eq ""; return scalar grep {$_=~/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 $s_val eq $c_val if $c_ref eq 'Regexp'; return grep {$_=~/$s_val/ && $c_val->{$_}} keys %$c_val if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'HASH') { $::_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 ""; return scalar grep {$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 grep {$_=~/$c_val/ && $s_val->{"$_"}} keys %$s_val if $c_ref eq 'Regexp'; return $s_val==$c_val if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'Switch') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; return $s_val == $c_val if ref $c_val eq 'Switch'; return $s_val->call(@$c_val) if ref $c_val eq 'ARRAY'; return $s_val->call($c_val); }; } else { croak "Cannot switch on $s_ref"; } return 1; } sub case($) { local $SIG{__WARN__} = \&carp; $::_S_W_I_T_C_H->(@_); } # IMPLEMENT __ my $placeholder = bless { arity=>1, impl=>sub{$_[1+$_[0]]} }; sub __() { $placeholder } sub __arg($) { my $index = $_[0]+1; bless { arity=>0, impl=>sub{$_[$index]} }; } sub hosub(&@) { # WRITE THIS } sub call { my ($self,@args) = @_; return $self->{impl}->(0,@args); } sub meta_bop(&) { my ($op) = @_; sub { my ($left, $right, $reversed) = @_; ($right,$left) = @_ if $reversed; my $rop = ref $right eq 'Switch' ? $right : bless { arity=>0, impl=>sub{$right} }; my $lop = ref $left eq 'Switch' ? $left : bless { arity=>0, impl=>sub{$left} }; my $arity = $lop->{arity} + $rop->{arity}; return bless { arity => $arity, impl => sub { my $start = shift; return $op->($lop->{impl}->($start,@_), $rop->{impl}->($start+$lop->{arity},@_)); } }; }; } sub meta_uop(&) { my ($op) = @_; sub { my ($left) = @_; my $lop = ref $left eq 'Switch' ? $left : bless { arity=>0, impl=>sub{$left} }; my $arity = $lop->{arity}; return bless { arity => $arity, impl => sub { $op->($lop->{impl}->(@_)) } }; }; } use overload "+" => meta_bop {$_[0] + $_[1]}, "-" => meta_bop {$_[0] - $_[1]}, "*" => meta_bop {$_[0] * $_[1]}, "/" => meta_bop {$_[0] / $_[1]}, "%" => meta_bop {$_[0] % $_[1]}, "**" => meta_bop {$_[0] ** $_[1]}, "<<" => meta_bop {$_[0] << $_[1]}, ">>" => meta_bop {$_[0] >> $_[1]}, "x" => meta_bop {$_[0] x $_[1]}, "." => meta_bop {$_[0] . $_[1]}, "<" => meta_bop {$_[0] < $_[1]}, "<=" => meta_bop {$_[0] <= $_[1]}, ">" => meta_bop {$_[0] > $_[1]}, ">=" => meta_bop {$_[0] >= $_[1]}, "==" => meta_bop {$_[0] == $_[1]}, "!=" => meta_bop {$_[0] != $_[1]}, "<=>" => meta_bop {$_[0] <=> $_[1]}, "lt" => meta_bop {$_[0] lt $_[1]}, "le" => meta_bop {$_[0] le $_[1]}, "gt" => meta_bop {$_[0] gt $_[1]}, "ge" => meta_bop {$_[0] ge $_[1]}, "eq" => meta_bop {$_[0] eq $_[1]}, "ne" => meta_bop {$_[0] ne $_[1]}, "cmp" => meta_bop {$_[0] cmp $_[1]}, "\&" => meta_bop {$_[0] & $_[1]}, "^" => meta_bop {$_[0] ^ $_[1]}, "|" => meta_bop {$_[0] | $_[1]}, "atan2" => meta_bop {atan2 $_[0], $_[1]}, "neg" => meta_uop {-$_[0]}, "!" => meta_uop {!$_[0]}, "~" => meta_uop {~$_[0]}, "cos" => meta_uop {cos $_[0]}, "sin" => meta_uop {sin $_[0]}, "exp" => meta_uop {exp $_[0]}, "abs" => meta_uop {abs $_[0]}, "log" => meta_uop {log $_[0]}, "sqrt" => meta_uop {sqrt $_[0]}, "bool" => sub { croak "Can't use && or || in expression containing __" }, # "&()" => sub { $_[0]->{impl} }, # "||" => meta_bop {$_[0] || $_[1]}, # "&&" => meta_bop {$_[0] && $_[1]}, # fallback => 1, ; 1; __END__ =head1 NAME Switch - A switch statement for Perl, do not use if you can use given/when =head1 SYNOPSIS use Switch; 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 [Skip ahead to L<"DESCRIPTION"> if you don't care about the whys and wherefores of this control structure] In seeking to devise a "Swiss Army" case mechanism suitable for Perl, it is useful to generalize this notion of distributed conditional testing as far as possible. Specifically, the concept of "matching" between the switch value and the various case values need not be restricted to numeric (or string or referential) equality, as it is in other languages. Indeed, as Table 1 illustrates, Perl offers at least eighteen different ways in which two values could generate a match. Table 1: Matching a switch value ($s) with a case value ($c) Switch Case Type of Match Implied Matching Code Value Value ====== ===== ===================== ============= number same numeric or referential match if $s == $c; or ref equality object method result of method call match if $s->$c(); ref name match if defined $s->$c(); or ref other other string equality match if $s eq $c; non-ref non-ref scalar scalar string regexp pattern match match if $s =~ /$c/; array scalar array entry existence match if 0<=$c && $c<@$s; ref array entry definition match if defined $s->[$c]; array entry truth match if $s->[$c]; array array array intersection match if intersects(@$s, @$c); ref ref (apply this table to all pairs of elements $s->[$i] and $c->[$j]) array regexp array grep match if grep /$c/, @$s; ref hash scalar hash entry existence match if exists $s->{$c}; ref hash entry definition match if defined $s->{$c}; hash entry truth match if $s->{$c}; hash regexp hash grep match if grep /$c/, keys %$s; ref sub scalar return value defn match if defined $s->($c); ref return value truth match if $s->($c); sub array return value defn match if defined $s->(@$c); ref ref return value truth match if $s->(@$c); In reality, Table 1 covers 31 alternatives, because only the equality and intersection tests are commutative; in all other cases, the roles of the C<$s> and C<$c> variables could be reversed to produce a different test. For example, instead of testing a single hash for 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}>). =head1 DESCRIPTION The Switch.pm module implements a generalized case mechanism that covers 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 single scalar argument of any type, specified in parentheses. C stores this value as the current switch value in a (localized) control variable. The value is followed by a block which may contain one or more Perl statements (including the C statement described below). The block is unconditionally executed once the switch value has been cached. A C statement takes a single scalar argument (in mandatory parentheses if it's a variable; otherwise the parens are optional) and selects the appropriate type of matching between that argument and the current switch value. The type of matching used is determined by the respective types of the switch value and the C argument, as specified in Table 1. If the match is successful, the mandatory block associated with the C statement is executed. In most other respects, the C statement is semantically identical to an C statement. For example, it can be followed by an C clause, and can be used as a postfix statement qualifier. However, when a C block has been executed control is automatically transferred to the statement after the immediately enclosing C block, rather than to the next statement within the block. In other words, the success of any C statement prevents other cases in the same scope from executing. But see L<"Allowing fall-through"> below. Together these two new statements provide a fully generalized case mechanism: use Switch; # AND LATER... %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 [1..9] { print "small num\n"; } # if $_ in [1..9] 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, and a series of C statements can try different types of matches -- hash membership, pattern match, array intersection, simple equality, etc. -- against the same switch value. The use of intersection tests against an array reference is particularly useful for aggregating integral cases: sub classify_digit { switch ($_[0]) { case 0 { return 'zero' } case [2,4,6,8] { return 'even' } case [1,3,5,7,9] { return 'odd' } case /[A-F]/i { return 'hex' } } } =head2 Allowing fall-through 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 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. For example: switch ($val) { case 1 { handle_num_1(); next } # and try next case... case "1" { handle_str_1(); next } # and try next case... case [0..9] { handle_num_any(); } # and we're done case /\d/ { handle_dig_any(); next } # and try next case... case /.*/ { handle_str_any(); next } # and try next case... } 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 third C block was executed, control would jump to the end of the enclosing C block. On the other hand, if $val held C<10>, then only the last two C subroutines would be called. Note that this mechanism allows the notion of I. For example: switch ($val) { case [0..9] { handle_num_any(); next if $val < 7; } case /\d/ { handle_dig_any(); } } 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 written: switch ($val) { case [0..9] { handle_num_any(); last if $val >= 7; next; } case /\d/ { handle_dig_any(); } } =head2 Automating fall-through In situations where case fall-through should be the norm, rather than an exception, an endless succession of terminal Cs is tedious and ugly. Hence, it is possible to reverse the default behaviour by specifying the string "fallthrough" when importing the module. For example, the following code is equivalent to the first example in L<"Allowing fall-through">: use Switch 'fallthrough'; switch ($val) { case 1 { handle_num_1(); } case "1" { handle_str_1(); } case [0..9] { handle_num_any(); last } case /\d/ { handle_dig_any(); } case /.*/ { handle_str_any(); } } Note the explicit use of a C to preserve the non-fall-through behaviour of the third case. =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 will be spelled C, and C will be pronounced C. In addition, the C statement will not require switch or case values to be parenthesized. 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(); } default { handle anything else; } } 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'; =head2 Higher-order Operations One situation in which C and C do not provide a good substitute for a cascaded C, is where a switch value needs to be tested against a series of conditions. For example: sub beverage { switch (shift) { 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 converts (almost) any expression in which it appears to a reference to a higher-order function. That is, the expression: use Switch '__'; __ < 2 is equivalent to: sub { $_[0] < 2 } With C<__>, the previous ugly case statements can be rewritten: case __ < 10 { return 'milk' } case __ < 20 { return 'coke' } case __ < 30 { return 'beer' } case __ < 40 { return 'wine' } case __ < 50 { return 'malt' } case __ < 60 { return 'Moet' } else { return 'milk' } The C<__> subroutine makes extensive use of operator overloading to perform its magic. All operations involving __ are overloaded to produce an anonymous subroutine that implements a lazy version of the original operation. The only problem is that operator overloading does not allow the boolean operators C<&&> and C<||> to be overloaded. So a case statement like this: case 0 <= __ && __ < 10 { return 'digit' } doesn't act as expected, because when it is executed, it constructs two higher order subroutines and then treats the two resulting references as arguments to C<&&>: sub { 0 <= $_[0] } && sub { $_[0] < 10 } 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 an error. =head1 DEPENDENCIES The module is implemented using Filter::Util::Call and Text::Balanced and requires both these modules to be installed. =head1 AUTHOR Damian Conway (damian@conway.org). This module is now maintained by Alexandr Ciornii (alexchorny@gmail.com). Previously was maintained by Rafael Garcia-Suarez and perl5 porters. =head1 BUGS There are undoubtedly serious bugs lurking somewhere in code this funky :-) Bug reports and other feedback are most welcome. May create syntax errors in other parts of code. On perl 5.10.x may cause syntax error if "case" is present inside heredoc. In general, use given/when instead. It were introduced in perl 5.10.0. Perl 5.10.0 was released in 2007. =head1 LIMITATIONS 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. Due to the way source filters work in Perl, you can't use Switch inside an string C. May not work if sub prototypes are used (RT#33988). Regex captures in when are not available to code. 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-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. blib/lib/auto/Switch/.exists000064400000000000151560063110011737 0ustar00blib/script/.exists000064400000000000151560063110010264 0ustar00blib/man3/.exists000064400000000000151560063110007616 0ustar00blib/man3/Switch.3pm000064400000045102151560063110010174 0ustar00.\" Automatically generated by Pod::Man 4.11 (Pod::Simple 3.35) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is >0, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .nr rF 0 .if \n(.g .if rF .nr rF 1 .if (\n(rF:(\n(.g==0)) \{\ . if \nF \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{\ . nr % 0 . nr F 2 . \} . \} .\} .rr rF .\" ======================================================================== .\" .IX Title "Switch 3" .TH Switch 3 "2014-03-18" "perl v5.26.3" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" Switch \- A switch statement for Perl, do not use if you can use given/when .SH "SYNOPSIS" .IX Header "SYNOPSIS" .Vb 1 \& use Switch; \& \& switch ($val) { \& case 1 { print "number 1" } \& case "a" { print "string a" } \& case [1..10,42] { print "number in list" } \& case (\e@array) { print "number in list" } \& case /\ew+/ { print "pattern" } \& case qr/\ew+/ { print "pattern" } \& case (\e%hash) { print "entry in hash" } \& case (\e&sub) { print "arg to subroutine" } \& else { print "previous case not true" } \& } .Ve .SH "BACKGROUND" .IX Header "BACKGROUND" [Skip ahead to \*(L"\s-1DESCRIPTION\*(R"\s0 if you don't care about the whys and wherefores of this control structure] .PP In seeking to devise a \*(L"Swiss Army\*(R" case mechanism suitable for Perl, it is useful to generalize this notion of distributed conditional testing as far as possible. Specifically, the concept of \*(L"matching\*(R" between the switch value and the various case values need not be restricted to numeric (or string or referential) equality, as it is in other languages. Indeed, as Table 1 illustrates, Perl offers at least eighteen different ways in which two values could generate a match. .PP .Vb 1 \& Table 1: Matching a switch value ($s) with a case value ($c) \& \& Switch Case Type of Match Implied Matching Code \& Value Value \& ====== ===== ===================== ============= \& \& number same numeric or referential match if $s == $c; \& or ref equality \& \& object method result of method call match if $s\->$c(); \& ref name match if defined $s\->$c(); \& or ref \& \& other other string equality match if $s eq $c; \& non\-ref non\-ref \& scalar scalar \& \& string regexp pattern match match if $s =~ /$c/; \& \& array scalar array entry existence match if 0<=$c && $c<@$s; \& ref array entry definition match if defined $s\->[$c]; \& array entry truth match if $s\->[$c]; \& \& array array array intersection match if intersects(@$s, @$c); \& ref ref (apply this table to \& all pairs of elements \& $s\->[$i] and \& $c\->[$j]) \& \& array regexp array grep match if grep /$c/, @$s; \& ref \& \& hash scalar hash entry existence match if exists $s\->{$c}; \& ref hash entry definition match if defined $s\->{$c}; \& hash entry truth match if $s\->{$c}; \& \& hash regexp hash grep match if grep /$c/, keys %$s; \& ref \& \& sub scalar return value defn match if defined $s\->($c); \& ref return value truth match if $s\->($c); \& \& sub array return value defn match if defined $s\->(@$c); \& ref ref return value truth match if $s\->(@$c); .Ve .PP In reality, Table 1 covers 31 alternatives, because only the equality and intersection tests are commutative; in all other cases, the roles of the \f(CW$s\fR and \f(CW$c\fR variables could be reversed to produce a different test. For example, instead of testing a single hash for the existence of a series of keys (\f(CW\*(C`match if exists $s\->{$c}\*(C'\fR), one could test for the existence of a single key in a series of hashes (\f(CW\*(C`match if exists $c\->{$s}\*(C'\fR). .SH "DESCRIPTION" .IX Header "DESCRIPTION" The Switch.pm module implements a generalized case mechanism that covers most (but not all) of the numerous possible combinations of switch and case values described above. .PP The module augments the standard Perl syntax with two new control statements: \f(CW\*(C`switch\*(C'\fR and \f(CW\*(C`case\*(C'\fR. The \f(CW\*(C`switch\*(C'\fR statement takes a single scalar argument of any type, specified in parentheses. \&\f(CW\*(C`switch\*(C'\fR stores this value as the current switch value in a (localized) control variable. The value is followed by a block which may contain one or more Perl statements (including the \f(CW\*(C`case\*(C'\fR statement described below). The block is unconditionally executed once the switch value has been cached. .PP A \f(CW\*(C`case\*(C'\fR statement takes a single scalar argument (in mandatory parentheses if it's a variable; otherwise the parens are optional) and selects the appropriate type of matching between that argument and the current switch value. The type of matching used is determined by the respective types of the switch value and the \f(CW\*(C`case\*(C'\fR argument, as specified in Table 1. If the match is successful, the mandatory block associated with the \f(CW\*(C`case\*(C'\fR statement is executed. .PP In most other respects, the \f(CW\*(C`case\*(C'\fR statement is semantically identical to an \f(CW\*(C`if\*(C'\fR statement. For example, it can be followed by an \f(CW\*(C`else\*(C'\fR clause, and can be used as a postfix statement qualifier. .PP However, when a \f(CW\*(C`case\*(C'\fR block has been executed control is automatically transferred to the statement after the immediately enclosing \f(CW\*(C`switch\*(C'\fR block, rather than to the next statement within the block. In other words, the success of any \f(CW\*(C`case\*(C'\fR statement prevents other cases in the same scope from executing. But see \*(L"Allowing fall-through\*(R" below. .PP Together these two new statements provide a fully generalized case mechanism: .PP .Vb 1 \& use Switch; \& \& # AND LATER... \& \& %special = ( woohoo => 1, d\*(Aqoh => 1 ); \& \& while (<>) { \& chomp; \& switch ($_) { \& case (%special) { print "homer\en"; } # if $special{$_} \& case /[a\-z]/i { print "alpha\en"; } # if $_ =~ /a\-z/i \& case [1..9] { print "small num\en"; } # if $_ in [1..9] \& case { $_[0] >= 10 } { print "big num\en"; } # if $_ >= 10 \& print "must be punctuation\en" case /\eW/; # if $_ ~= /\eW/ \& } \& } .Ve .PP Note that \f(CW\*(C`switch\*(C'\fRes can be nested within \f(CW\*(C`case\*(C'\fR (or any other) blocks, and a series of \f(CW\*(C`case\*(C'\fR statements can try different types of matches \&\*(-- hash membership, pattern match, array intersection, simple equality, etc. \*(-- against the same switch value. .PP The use of intersection tests against an array reference is particularly useful for aggregating integral cases: .PP .Vb 8 \& sub classify_digit \& { \& switch ($_[0]) { case 0 { return \*(Aqzero\*(Aq } \& case [2,4,6,8] { return \*(Aqeven\*(Aq } \& case [1,3,5,7,9] { return \*(Aqodd\*(Aq } \& case /[A\-F]/i { return \*(Aqhex\*(Aq } \& } \& } .Ve .SS "Allowing fall-through" .IX Subsection "Allowing fall-through" 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 \fIis\fR a way to do it, if you must. .PP If a \f(CW\*(C`case\*(C'\fR block executes an untargeted \f(CW\*(C`next\*(C'\fR, control is immediately transferred to the statement \fIafter\fR the \f(CW\*(C`case\*(C'\fR statement (i.e. usually another case), rather than out of the surrounding \&\f(CW\*(C`switch\*(C'\fR block. .PP For example: .PP .Vb 7 \& switch ($val) { \& case 1 { handle_num_1(); next } # and try next case... \& case "1" { handle_str_1(); next } # and try next case... \& case [0..9] { handle_num_any(); } # and we\*(Aqre done \& case /\ed/ { handle_dig_any(); next } # and try next case... \& case /.*/ { handle_str_any(); next } # and try next case... \& } .Ve .PP If \f(CW$val\fR held the number \f(CW1\fR, the above \f(CW\*(C`switch\*(C'\fR block would call the first three \f(CW\*(C`handle_...\*(C'\fR subroutines, jumping to the next case test each time it encountered a \f(CW\*(C`next\*(C'\fR. After the third \f(CW\*(C`case\*(C'\fR block was executed, control would jump to the end of the enclosing \&\f(CW\*(C`switch\*(C'\fR block. .PP On the other hand, if \f(CW$val\fR held \f(CW10\fR, then only the last two \f(CW\*(C`handle_...\*(C'\fR subroutines would be called. .PP Note that this mechanism allows the notion of \fIconditional fall-through\fR. For example: .PP .Vb 4 \& switch ($val) { \& case [0..9] { handle_num_any(); next if $val < 7; } \& case /\ed/ { handle_dig_any(); } \& } .Ve .PP If an untargeted \f(CW\*(C`last\*(C'\fR statement is executed in a case block, this immediately transfers control out of the enclosing \f(CW\*(C`switch\*(C'\fR block (in other words, there is an implicit \f(CW\*(C`last\*(C'\fR at the end of each normal \f(CW\*(C`case\*(C'\fR block). Thus the previous example could also have been written: .PP .Vb 4 \& switch ($val) { \& case [0..9] { handle_num_any(); last if $val >= 7; next; } \& case /\ed/ { handle_dig_any(); } \& } .Ve .SS "Automating fall-through" .IX Subsection "Automating fall-through" In situations where case fall-through should be the norm, rather than an exception, an endless succession of terminal \f(CW\*(C`next\*(C'\fRs is tedious and ugly. Hence, it is possible to reverse the default behaviour by specifying the string \*(L"fallthrough\*(R" when importing the module. For example, the following code is equivalent to the first example in \*(L"Allowing fall-through\*(R": .PP .Vb 1 \& use Switch \*(Aqfallthrough\*(Aq; \& \& switch ($val) { \& case 1 { handle_num_1(); } \& case "1" { handle_str_1(); } \& case [0..9] { handle_num_any(); last } \& case /\ed/ { handle_dig_any(); } \& case /.*/ { handle_str_any(); } \& } .Ve .PP Note the explicit use of a \f(CW\*(C`last\*(C'\fR to preserve the non-fall-through behaviour of the third case. .SS "Alternative syntax" .IX Subsection "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 \f(CW\*(C`switch\*(C'\fR will be spelled \f(CW\*(C`given\*(C'\fR, and \&\f(CW\*(C`case\*(C'\fR will be pronounced \f(CW\*(C`when\*(C'\fR. In addition, the \f(CW\*(C`when\*(C'\fR statement will not require switch or case values to be parenthesized. .PP This future syntax is also (largely) available via the Switch.pm module, by importing it with the argument \f(CW"Perl6"\fR. For example: .PP .Vb 1 \& use Switch \*(AqPerl6\*(Aq; \& \& given ($val) { \& when 1 { handle_num_1(); } \& when ($str1) { handle_str_1(); } \& when [0..9] { handle_num_any(); last } \& when /\ed/ { handle_dig_any(); } \& when /.*/ { handle_str_any(); } \& default { handle anything else; } \& } .Ve .PP Note that scalars still need to be parenthesized, since they would be ambiguous in Perl 5. .PP Note too that you can mix and match both syntaxes by importing the module with: .PP .Vb 1 \& use Switch \*(AqPerl5\*(Aq, \*(AqPerl6\*(Aq; .Ve .SS "Higher-order Operations" .IX Subsection "Higher-order Operations" One situation in which \f(CW\*(C`switch\*(C'\fR and \f(CW\*(C`case\*(C'\fR do not provide a good substitute for a cascaded \f(CW\*(C`if\*(C'\fR, is where a switch value needs to be tested against a series of conditions. For example: .PP .Vb 11 \& sub beverage { \& switch (shift) { \& case { $_[0] < 10 } { return \*(Aqmilk\*(Aq } \& case { $_[0] < 20 } { return \*(Aqcoke\*(Aq } \& case { $_[0] < 30 } { return \*(Aqbeer\*(Aq } \& case { $_[0] < 40 } { return \*(Aqwine\*(Aq } \& case { $_[0] < 50 } { return \*(Aqmalt\*(Aq } \& case { $_[0] < 60 } { return \*(AqMoet\*(Aq } \& else { return \*(Aqmilk\*(Aq } \& } \& } .Ve .PP (This is equivalent to writing \f(CW\*(C`case (sub { $_[0] < 10 })\*(C'\fR, etc.; \f(CW$_[0]\fR is the argument to the anonymous subroutine.) .PP The need to specify each condition as a subroutine block is tiresome. To overcome this, when importing Switch.pm, a special \*(L"placeholder\*(R" subroutine named \f(CW\*(C`_\|_\*(C'\fR [sic] may also be imported. This subroutine converts (almost) any expression in which it appears to a reference to a higher-order function. That is, the expression: .PP .Vb 1 \& use Switch \*(Aq_\|_\*(Aq; \& \& _\|_ < 2 .Ve .PP is equivalent to: .PP .Vb 1 \& sub { $_[0] < 2 } .Ve .PP With \f(CW\*(C`_\|_\*(C'\fR, the previous ugly case statements can be rewritten: .PP .Vb 7 \& case _\|_ < 10 { return \*(Aqmilk\*(Aq } \& case _\|_ < 20 { return \*(Aqcoke\*(Aq } \& case _\|_ < 30 { return \*(Aqbeer\*(Aq } \& case _\|_ < 40 { return \*(Aqwine\*(Aq } \& case _\|_ < 50 { return \*(Aqmalt\*(Aq } \& case _\|_ < 60 { return \*(AqMoet\*(Aq } \& else { return \*(Aqmilk\*(Aq } .Ve .PP The \f(CW\*(C`_\|_\*(C'\fR subroutine makes extensive use of operator overloading to perform its magic. All operations involving _\|_ are overloaded to produce an anonymous subroutine that implements a lazy version of the original operation. .PP The only problem is that operator overloading does not allow the boolean operators \f(CW\*(C`&&\*(C'\fR and \f(CW\*(C`||\*(C'\fR to be overloaded. So a case statement like this: .PP .Vb 1 \& case 0 <= _\|_ && _\|_ < 10 { return \*(Aqdigit\*(Aq } .Ve .PP doesn't act as expected, because when it is executed, it constructs two higher order subroutines and then treats the two resulting references as arguments to \f(CW\*(C`&&\*(C'\fR: .PP .Vb 1 \& sub { 0 <= $_[0] } && sub { $_[0] < 10 } .Ve .PP This boolean expression is inevitably true, since both references are non-false. Fortunately, the overloaded \f(CW\*(Aqbool\*(Aq\fR operator catches this situation and flags it as an error. .SH "DEPENDENCIES" .IX Header "DEPENDENCIES" The module is implemented using Filter::Util::Call and Text::Balanced and requires both these modules to be installed. .SH "AUTHOR" .IX Header "AUTHOR" Damian Conway (damian@conway.org). This module is now maintained by Alexandr Ciornii (alexchorny@gmail.com). Previously was maintained by Rafael Garcia-Suarez and perl5 porters. .SH "BUGS" .IX Header "BUGS" There are undoubtedly serious bugs lurking somewhere in code this funky :\-) Bug reports and other feedback are most welcome. .PP May create syntax errors in other parts of code. .PP On perl 5.10.x may cause syntax error if \*(L"case\*(R" is present inside heredoc. .PP In general, use given/when instead. It were introduced in perl 5.10.0. Perl 5.10.0 was released in 2007. .SH "LIMITATIONS" .IX Header "LIMITATIONS" Due to the heuristic nature of Switch.pm's source parsing, the presence of regexes with embedded newlines that are specified with raw \f(CW\*(C`/.../\*(C'\fR delimiters and don't have a modifier \f(CW\*(C`//x\*(C'\fR are indistinguishable from code chunks beginning with the division operator \f(CW\*(C`/\*(C'\fR. As a workaround you must use \f(CW\*(C`m/.../\*(C'\fR or \f(CW\*(C`m?...?\*(C'\fR for such patterns. Also, the presence of regexes specified with raw \f(CW\*(C`?...?\*(C'\fR delimiters may cause mysterious errors. The workaround is to use \f(CW\*(C`m?...?\*(C'\fR instead. .PP Due to the way source filters work in Perl, you can't use Switch inside an string \f(CW\*(C`eval\*(C'\fR. .PP May not work if sub prototypes are used (RT#33988). .PP Regex captures in when are not available to code. .PP 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. .SH "COPYRIGHT" .IX Header "COPYRIGHT" .Vb 3 \& 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. .Ve blib/bin/.exists000064400000000000151560063110007530 0ustar00blib/man1/.exists000064400000000000151560063110007614 0ustar00MYMETA.json000064400000002336151560063110006435 0ustar00{ "abstract" : "A switch statement for Perl, do not use if you can use given/when", "author" : [ "Damian Conway", "Rafael Garcia-Suarez", "Alexandr Ciornii" ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Switch", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Filter::Util::Call" : "0", "Text::Balanced" : "2", "if" : "0", "perl" : "5.005" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "http://github.com/chorny/Switch" } }, "version" : "2.17", "x_serialization_backend" : "JSON::PP version 2.97001" } Makefile000064400000071777151560063110006225 0ustar00# This Makefile is for the Switch extension to perl. # # It was generated automatically by MakeMaker version # 7.34 (Revision: 73400) from the contents of # Makefile.PL. Don't edit this file, edit Makefile.PL instead. # # ANY CHANGES MADE HERE WILL BE LOST! # # MakeMaker ARGV: () # # MakeMaker Parameters: # ABSTRACT_FROM => q[Switch.pm] # AUTHOR => [q[Damian Conway], q[Rafael Garcia-Suarez], q[Alexandr Ciornii]] # BUILD_REQUIRES => { } # CONFIGURE_REQUIRES => { } # INSTALLDIRS => q[site] # LICENSE => q[perl] # META_MERGE => { resources=>{ repository=>q[http://github.com/chorny/Switch] } } # MIN_PERL_VERSION => q[5.005] # NAME => q[Switch] # PREREQ_PM => { Filter::Util::Call=>q[0], Text::Balanced=>q[2], if=>q[0] } # TEST_REQUIRES => { } # VERSION_FROM => q[Switch.pm] # --- MakeMaker post_initialize section: # --- MakeMaker const_config section: # These definitions are from config.sh (via /usr/lib64/perl5/Config.pm). # They may have been overridden via Makefile.PL or on the command line. AR = ar CC = gcc CCCDLFLAGS = -fPIC CCDLFLAGS = -Wl,--enable-new-dtags -Wl,-z,relro -Wl,-z,now -specs=/usr/lib/rpm/redhat/redhat-hardened-ld DLEXT = so DLSRC = dl_dlopen.xs EXE_EXT = FULL_AR = /usr/bin/ar LD = gcc LDDLFLAGS = -lpthread -shared -Wl,-z,relro -Wl,-z,now -specs=/usr/lib/rpm/redhat/redhat-hardened-ld -L/usr/local/lib -fstack-protector-strong LDFLAGS = -Wl,-z,relro -Wl,-z,now -specs=/usr/lib/rpm/redhat/redhat-hardened-ld -fstack-protector-strong -L/usr/local/lib LIBC = libc-2.28.so LIB_EXT = .a OBJ_EXT = .o OSNAME = linux OSVERS = 4.18.0-348.12.2.el8_5.x86_64 RANLIB = : SITELIBEXP = /usr/local/share/perl5 SITEARCHEXP = /usr/local/lib64/perl5 SO = so VENDORARCHEXP = /usr/lib64/perl5/vendor_perl VENDORLIBEXP = /usr/share/perl5/vendor_perl # --- MakeMaker constants section: AR_STATIC_ARGS = cr DIRFILESEP = / DFSEP = $(DIRFILESEP) NAME = Switch NAME_SYM = Switch VERSION = 2.17 VERSION_MACRO = VERSION VERSION_SYM = 2_17 DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" XS_VERSION = 2.17 XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" INST_ARCHLIB = blib/arch INST_SCRIPT = blib/script INST_BIN = blib/bin INST_LIB = blib/lib INST_MAN1DIR = blib/man1 INST_MAN3DIR = blib/man3 MAN1EXT = 1 MAN3EXT = 3pm INSTALLDIRS = site DESTDIR = PREFIX = $(SITEPREFIX) PERLPREFIX = /usr SITEPREFIX = /usr/local VENDORPREFIX = /usr INSTALLPRIVLIB = /usr/share/perl5 DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) INSTALLSITELIB = /usr/local/share/perl5 DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) INSTALLVENDORLIB = /usr/share/perl5/vendor_perl DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) INSTALLARCHLIB = /usr/lib64/perl5 DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) INSTALLSITEARCH = /usr/local/lib64/perl5 DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) INSTALLVENDORARCH = /usr/lib64/perl5/vendor_perl DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) INSTALLBIN = /usr/bin DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) INSTALLSITEBIN = /usr/local/bin DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) INSTALLVENDORBIN = /usr/bin DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) INSTALLSCRIPT = /usr/bin DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) INSTALLSITESCRIPT = /usr/local/bin DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) INSTALLVENDORSCRIPT = /usr/bin DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) INSTALLMAN1DIR = /usr/share/man/man1 DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) INSTALLSITEMAN1DIR = /usr/local/share/man/man1 DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) INSTALLVENDORMAN1DIR = /usr/share/man/man1 DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) INSTALLMAN3DIR = /usr/share/man/man3 DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) INSTALLSITEMAN3DIR = /usr/local/share/man/man3 DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) INSTALLVENDORMAN3DIR = /usr/share/man/man3 DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) PERL_LIB = /usr/share/perl5 PERL_ARCHLIB = /usr/lib64/perl5 PERL_ARCHLIBDEP = /usr/lib64/perl5 LIBPERL_A = libperl.a FIRST_MAKEFILE = Makefile MAKEFILE_OLD = Makefile.old MAKE_APERL_FILE = Makefile.aperl PERLMAINCC = $(CC) PERL_INC = /usr/lib64/perl5/CORE PERL_INCDEP = /usr/lib64/perl5/CORE PERL = "/usr/bin/perl" FULLPERL = "/usr/bin/perl" ABSPERL = $(PERL) PERLRUN = $(PERL) FULLPERLRUN = $(FULLPERL) ABSPERLRUN = $(ABSPERL) PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" PERL_CORE = 0 PERM_DIR = 755 PERM_RW = 644 PERM_RWX = 755 MAKEMAKER = /usr/share/perl5/vendor_perl/ExtUtils/MakeMaker.pm MM_VERSION = 7.34 MM_REVISION = 73400 # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) # DLBASE = Basename part of dynamic library. May be just equal BASEEXT. MAKE = make FULLEXT = Switch BASEEXT = Switch PARENT_NAME = DLBASE = $(BASEEXT) VERSION_FROM = Switch.pm OBJECT = LDFROM = $(OBJECT) LINKTYPE = dynamic BOOTDEP = # Handy lists of source code files: XS_FILES = C_FILES = O_FILES = H_FILES = MAN1PODS = MAN3PODS = Switch.pm # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h # Where to build things INST_LIBDIR = $(INST_LIB) INST_ARCHLIBDIR = $(INST_ARCHLIB) INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) INST_STATIC = INST_DYNAMIC = INST_BOOT = # Extra linker info EXPORT_LIST = PERL_ARCHIVE = PERL_ARCHIVEDEP = PERL_ARCHIVE_AFTER = TO_INST_PM = Switch.pm # --- MakeMaker platform_constants section: MM_Unix_VERSION = 7.34 PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc # --- MakeMaker tool_autosplit section: # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$$$ARGV[0], $$$$ARGV[1], 0, 1, 1)' -- # --- MakeMaker tool_xsubpp section: # --- MakeMaker tools_other section: SHELL = /bin/sh CHMOD = chmod CP = cp MV = mv NOOP = $(TRUE) NOECHO = @ RM_F = rm -f RM_RF = rm -rf TEST_F = test -f TOUCH = touch UMASK_NULL = umask 0 DEV_NULL = > /dev/null 2>&1 MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' -- EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' -- FALSE = false TRUE = true ECHO = echo ECHO_N = echo -n UNINST = 0 VERBINST = 0 MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' -- DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' -- UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' -- WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' -- MACROSTART = MACROEND = USEMAKEFILE = -f FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' -- CP_NONEMPTY = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'cp_nonempty' -- # --- MakeMaker makemakerdflt section: makemakerdflt : all $(NOECHO) $(NOOP) # --- MakeMaker dist section: TAR = tar TARFLAGS = cvf ZIP = zip ZIPFLAGS = -r COMPRESS = gzip --best SUFFIX = .gz SHAR = shar PREOP = $(NOECHO) $(NOOP) POSTOP = $(NOECHO) $(NOOP) TO_UNIX = $(NOECHO) $(NOOP) CI = ci -u RCS_LABEL = rcs -Nv$(VERSION_SYM): -q DIST_CP = best DIST_DEFAULT = tardist DISTNAME = Switch DISTVNAME = Switch-2.17 # --- MakeMaker macro section: # --- MakeMaker depend section: # --- MakeMaker cflags section: # --- MakeMaker const_loadlibs section: # --- MakeMaker const_cccmd section: # --- MakeMaker post_constants section: # --- MakeMaker pasthru section: PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ LINKTYPE="$(LINKTYPE)"\ PREFIX="$(PREFIX)"\ PASTHRU_DEFINE='$(DEFINE) $(PASTHRU_DEFINE)'\ PASTHRU_INC='$(INC) $(PASTHRU_INC)' # --- MakeMaker special_targets section: .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir pure_all subdirs clean_subdirs makemakerdflt manifypods realclean_subdirs subdirs_dynamic subdirs_pure_nolink subdirs_static subdirs-test_dynamic subdirs-test_static test_dynamic test_static # --- MakeMaker c_o section: # --- MakeMaker xs_c section: # --- MakeMaker xs_o section: # --- MakeMaker top_targets section: all :: pure_all manifypods $(NOECHO) $(NOOP) pure_all :: config pm_to_blib subdirs linkext $(NOECHO) $(NOOP) $(NOECHO) $(NOOP) subdirs :: $(MYEXTLIB) $(NOECHO) $(NOOP) config :: $(FIRST_MAKEFILE) blibdirs $(NOECHO) $(NOOP) help : perldoc ExtUtils::MakeMaker # --- MakeMaker blibdirs section: blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists $(NOECHO) $(NOOP) # Backwards compat with 6.18 through 6.25 blibdirs.ts : blibdirs $(NOECHO) $(NOOP) $(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_LIBDIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR) $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_ARCHLIB) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB) $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_AUTODIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR) $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR) $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_BIN) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN) $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_SCRIPT) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT) $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_MAN1DIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR) $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_MAN3DIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR) $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists # --- MakeMaker linkext section: linkext :: dynamic $(NOECHO) $(NOOP) # --- MakeMaker dlsyms section: # --- MakeMaker dynamic_bs section: BOOTSTRAP = # --- MakeMaker dynamic section: dynamic :: $(FIRST_MAKEFILE) config $(INST_BOOT) $(INST_DYNAMIC) $(NOECHO) $(NOOP) # --- MakeMaker dynamic_lib section: # --- MakeMaker static section: ## $(INST_PM) has been moved to the all: target. ## It remains here for awhile to allow for old usage: "make static" static :: $(FIRST_MAKEFILE) $(INST_STATIC) $(NOECHO) $(NOOP) # --- MakeMaker static_lib section: # --- MakeMaker manifypods section: POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" POD2MAN = $(POD2MAN_EXE) manifypods : pure_all config \ Switch.pm $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) -u \ Switch.pm $(INST_MAN3DIR)/Switch.$(MAN3EXT) # --- MakeMaker processPL section: # --- MakeMaker installbin section: # --- MakeMaker subdirs section: # none # --- MakeMaker clean_subdirs section: clean_subdirs : $(NOECHO) $(NOOP) # --- MakeMaker clean section: # Delete temporary files but do not touch installed files. We don't delete # the Makefile here so a later make realclean still has a makefile to use. clean :: clean_subdirs - $(RM_F) \ $(BASEEXT).bso $(BASEEXT).def \ $(BASEEXT).exp $(BASEEXT).x \ $(BOOTSTRAP) $(INST_ARCHAUTODIR)/extralibs.all \ $(INST_ARCHAUTODIR)/extralibs.ld $(MAKE_APERL_FILE) \ *$(LIB_EXT) *$(OBJ_EXT) \ *perl.core MYMETA.json \ MYMETA.yml blibdirs.ts \ core core.*perl.*.? \ core.[0-9] core.[0-9][0-9] \ core.[0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9] \ core.[0-9][0-9][0-9][0-9][0-9] lib$(BASEEXT).def \ mon.out perl \ perl$(EXE_EXT) perl.exe \ perlmain.c pm_to_blib \ pm_to_blib.ts so_locations \ tmon.out - $(RM_RF) \ blib $(NOECHO) $(RM_F) $(MAKEFILE_OLD) - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) # --- MakeMaker realclean_subdirs section: # so clean is forced to complete before realclean_subdirs runs realclean_subdirs : clean $(NOECHO) $(NOOP) # --- MakeMaker realclean section: # Delete temporary files (via clean) and also delete dist files realclean purge :: realclean_subdirs - $(RM_F) \ $(FIRST_MAKEFILE) $(MAKEFILE_OLD) - $(RM_RF) \ $(DISTVNAME) # --- MakeMaker metafile section: metafile : create_distdir $(NOECHO) $(ECHO) Generating META.yml $(NOECHO) $(ECHO) '---' > META_new.yml $(NOECHO) $(ECHO) 'abstract: '\''A switch statement for Perl, do not use if you can use given/when'\''' >> META_new.yml $(NOECHO) $(ECHO) 'author:' >> META_new.yml $(NOECHO) $(ECHO) ' - '\''Damian Conway'\''' >> META_new.yml $(NOECHO) $(ECHO) ' - '\''Rafael Garcia-Suarez'\''' >> META_new.yml $(NOECHO) $(ECHO) ' - '\''Alexandr Ciornii'\''' >> META_new.yml $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml $(NOECHO) $(ECHO) 'dynamic_config: 1' >> META_new.yml $(NOECHO) $(ECHO) 'generated_by: '\''ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010'\''' >> META_new.yml $(NOECHO) $(ECHO) 'license: perl' >> META_new.yml $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml $(NOECHO) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml $(NOECHO) $(ECHO) ' version: '\''1.4'\''' >> META_new.yml $(NOECHO) $(ECHO) 'name: Switch' >> META_new.yml $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml $(NOECHO) $(ECHO) ' directory:' >> META_new.yml $(NOECHO) $(ECHO) ' - t' >> META_new.yml $(NOECHO) $(ECHO) ' - inc' >> META_new.yml $(NOECHO) $(ECHO) 'requires:' >> META_new.yml $(NOECHO) $(ECHO) ' Filter::Util::Call: '\''0'\''' >> META_new.yml $(NOECHO) $(ECHO) ' Text::Balanced: '\''2'\''' >> META_new.yml $(NOECHO) $(ECHO) ' if: '\''0'\''' >> META_new.yml $(NOECHO) $(ECHO) ' perl: '\''5.005'\''' >> META_new.yml $(NOECHO) $(ECHO) 'resources:' >> META_new.yml $(NOECHO) $(ECHO) ' repository: http://github.com/chorny/Switch' >> META_new.yml $(NOECHO) $(ECHO) 'version: '\''2.17'\''' >> META_new.yml $(NOECHO) $(ECHO) 'x_serialization_backend: '\''CPAN::Meta::YAML version 0.018'\''' >> META_new.yml -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml $(NOECHO) $(ECHO) Generating META.json $(NOECHO) $(ECHO) '{' > META_new.json $(NOECHO) $(ECHO) ' "abstract" : "A switch statement for Perl, do not use if you can use given/when",' >> META_new.json $(NOECHO) $(ECHO) ' "author" : [' >> META_new.json $(NOECHO) $(ECHO) ' "Damian Conway",' >> META_new.json $(NOECHO) $(ECHO) ' "Rafael Garcia-Suarez",' >> META_new.json $(NOECHO) $(ECHO) ' "Alexandr Ciornii"' >> META_new.json $(NOECHO) $(ECHO) ' ],' >> META_new.json $(NOECHO) $(ECHO) ' "dynamic_config" : 1,' >> META_new.json $(NOECHO) $(ECHO) ' "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010",' >> META_new.json $(NOECHO) $(ECHO) ' "license" : [' >> META_new.json $(NOECHO) $(ECHO) ' "perl_5"' >> META_new.json $(NOECHO) $(ECHO) ' ],' >> META_new.json $(NOECHO) $(ECHO) ' "meta-spec" : {' >> META_new.json $(NOECHO) $(ECHO) ' "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",' >> META_new.json $(NOECHO) $(ECHO) ' "version" : 2' >> META_new.json $(NOECHO) $(ECHO) ' },' >> META_new.json $(NOECHO) $(ECHO) ' "name" : "Switch",' >> META_new.json $(NOECHO) $(ECHO) ' "no_index" : {' >> META_new.json $(NOECHO) $(ECHO) ' "directory" : [' >> META_new.json $(NOECHO) $(ECHO) ' "t",' >> META_new.json $(NOECHO) $(ECHO) ' "inc"' >> META_new.json $(NOECHO) $(ECHO) ' ]' >> META_new.json $(NOECHO) $(ECHO) ' },' >> META_new.json $(NOECHO) $(ECHO) ' "prereqs" : {' >> META_new.json $(NOECHO) $(ECHO) ' "build" : {' >> META_new.json $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json $(NOECHO) $(ECHO) ' }' >> META_new.json $(NOECHO) $(ECHO) ' },' >> META_new.json $(NOECHO) $(ECHO) ' "configure" : {' >> META_new.json $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json $(NOECHO) $(ECHO) ' }' >> META_new.json $(NOECHO) $(ECHO) ' },' >> META_new.json $(NOECHO) $(ECHO) ' "runtime" : {' >> META_new.json $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json $(NOECHO) $(ECHO) ' "Filter::Util::Call" : "0",' >> META_new.json $(NOECHO) $(ECHO) ' "Text::Balanced" : "2",' >> META_new.json $(NOECHO) $(ECHO) ' "if" : "0",' >> META_new.json $(NOECHO) $(ECHO) ' "perl" : "5.005"' >> META_new.json $(NOECHO) $(ECHO) ' }' >> META_new.json $(NOECHO) $(ECHO) ' }' >> META_new.json $(NOECHO) $(ECHO) ' },' >> META_new.json $(NOECHO) $(ECHO) ' "release_status" : "stable",' >> META_new.json $(NOECHO) $(ECHO) ' "resources" : {' >> META_new.json $(NOECHO) $(ECHO) ' "repository" : {' >> META_new.json $(NOECHO) $(ECHO) ' "url" : "http://github.com/chorny/Switch"' >> META_new.json $(NOECHO) $(ECHO) ' }' >> META_new.json $(NOECHO) $(ECHO) ' },' >> META_new.json $(NOECHO) $(ECHO) ' "version" : "2.17",' >> META_new.json $(NOECHO) $(ECHO) ' "x_serialization_backend" : "JSON::PP version 2.97001"' >> META_new.json $(NOECHO) $(ECHO) '}' >> META_new.json -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json # --- MakeMaker signature section: signature : cpansign -s # --- MakeMaker dist_basics section: distclean :: realclean distcheck $(NOECHO) $(NOOP) distcheck : $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck skipcheck : $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck manifest : $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest veryclean : realclean $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old # --- MakeMaker dist_core section: dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' -- tardist : $(DISTVNAME).tar$(SUFFIX) $(NOECHO) $(NOOP) uutardist : $(DISTVNAME).tar$(SUFFIX) uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu' $(DISTVNAME).tar$(SUFFIX) : distdir $(PREOP) $(TO_UNIX) $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)' $(POSTOP) zipdist : $(DISTVNAME).zip $(NOECHO) $(NOOP) $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip' $(POSTOP) shdist : distdir $(PREOP) $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar $(RM_RF) $(DISTVNAME) $(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar' $(POSTOP) # --- MakeMaker distdir section: create_distdir : $(RM_RF) $(DISTVNAME) $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" distdir : create_distdir distmeta $(NOECHO) $(NOOP) # --- MakeMaker dist_test section: disttest : distdir cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL cd $(DISTVNAME) && $(MAKE) $(PASTHRU) cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) # --- MakeMaker dist_ci section: ci : $(ABSPERLRUN) -MExtUtils::Manifest=maniread -e '@all = sort keys %{ maniread() };' \ -e 'print(qq{Executing $(CI) @all\n});' \ -e 'system(qq{$(CI) @all}) == 0 or die $$!;' \ -e 'print(qq{Executing $(RCS_LABEL) ...\n});' \ -e 'system(qq{$(RCS_LABEL) @all}) == 0 or die $$!;' -- # --- MakeMaker distmeta section: distmeta : create_distdir metafile $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \ -e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \ -e ' or die "Could not add META.yml to MANIFEST: $${'\''@'\''}"' -- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \ -e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \ -e ' or die "Could not add META.json to MANIFEST: $${'\''@'\''}"' -- # --- MakeMaker distsignature section: distsignature : distmeta $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) }' \ -e ' or die "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}"' -- $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE cd $(DISTVNAME) && cpansign -s # --- MakeMaker install section: install :: pure_install doc_install $(NOECHO) $(NOOP) install_perl :: pure_perl_install doc_perl_install $(NOECHO) $(NOOP) install_site :: pure_site_install doc_site_install $(NOECHO) $(NOOP) install_vendor :: pure_vendor_install doc_vendor_install $(NOECHO) $(NOOP) pure_install :: pure_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) doc_install :: doc_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) pure__install : pure_site_install $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site doc__install : doc_site_install $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site pure_perl_install :: all $(NOECHO) $(MOD_INSTALL) \ read "$(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist" \ write "$(DESTINSTALLARCHLIB)/auto/$(FULLEXT)/.packlist" \ "$(INST_LIB)" "$(DESTINSTALLPRIVLIB)" \ "$(INST_ARCHLIB)" "$(DESTINSTALLARCHLIB)" \ "$(INST_BIN)" "$(DESTINSTALLBIN)" \ "$(INST_SCRIPT)" "$(DESTINSTALLSCRIPT)" \ "$(INST_MAN1DIR)" "$(DESTINSTALLMAN1DIR)" \ "$(INST_MAN3DIR)" "$(DESTINSTALLMAN3DIR)" $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ "$(SITEARCHEXP)/auto/$(FULLEXT)" pure_site_install :: all $(NOECHO) $(MOD_INSTALL) \ read "$(SITEARCHEXP)/auto/$(FULLEXT)/.packlist" \ write "$(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist" \ "$(INST_LIB)" "$(DESTINSTALLSITELIB)" \ "$(INST_ARCHLIB)" "$(DESTINSTALLSITEARCH)" \ "$(INST_BIN)" "$(DESTINSTALLSITEBIN)" \ "$(INST_SCRIPT)" "$(DESTINSTALLSITESCRIPT)" \ "$(INST_MAN1DIR)" "$(DESTINSTALLSITEMAN1DIR)" \ "$(INST_MAN3DIR)" "$(DESTINSTALLSITEMAN3DIR)" $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ "$(PERL_ARCHLIB)/auto/$(FULLEXT)" pure_vendor_install :: all $(NOECHO) $(MOD_INSTALL) \ read "$(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist" \ write "$(DESTINSTALLVENDORARCH)/auto/$(FULLEXT)/.packlist" \ "$(INST_LIB)" "$(DESTINSTALLVENDORLIB)" \ "$(INST_ARCHLIB)" "$(DESTINSTALLVENDORARCH)" \ "$(INST_BIN)" "$(DESTINSTALLVENDORBIN)" \ "$(INST_SCRIPT)" "$(DESTINSTALLVENDORSCRIPT)" \ "$(INST_MAN1DIR)" "$(DESTINSTALLVENDORMAN1DIR)" \ "$(INST_MAN3DIR)" "$(DESTINSTALLVENDORMAN3DIR)" doc_perl_install :: all $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLPRIVLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> "$(DESTINSTALLARCHLIB)/perllocal.pod" doc_site_install :: all $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLSITELIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> "$(DESTINSTALLARCHLIB)/perllocal.pod" doc_vendor_install :: all $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod" -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLVENDORLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> "$(DESTINSTALLARCHLIB)/perllocal.pod" uninstall :: uninstall_from_$(INSTALLDIRS)dirs $(NOECHO) $(NOOP) uninstall_from_perldirs :: $(NOECHO) $(UNINSTALL) "$(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist" uninstall_from_sitedirs :: $(NOECHO) $(UNINSTALL) "$(SITEARCHEXP)/auto/$(FULLEXT)/.packlist" uninstall_from_vendordirs :: $(NOECHO) $(UNINSTALL) "$(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist" # --- MakeMaker force section: # Phony target to force checking subdirectories. FORCE : $(NOECHO) $(NOOP) # --- MakeMaker perldepend section: # --- MakeMaker makefile section: # We take a very conservative approach here, but it's worth it. # We move Makefile to Makefile.old here to avoid gnu make looping. $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) $(PERLRUN) Makefile.PL $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" $(FALSE) # --- MakeMaker staticmake section: # --- MakeMaker makeaperl section --- MAP_TARGET = perl FULLPERL = "/usr/bin/perl" MAP_PERLINC = "-Iblib/arch" "-Iblib/lib" "-I/usr/lib64/perl5" "-I/usr/share/perl5" $(MAP_TARGET) :: $(MAKE_APERL_FILE) $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ $(MAKE_APERL_FILE) : static $(FIRST_MAKEFILE) pm_to_blib $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) $(NOECHO) $(PERLRUNINST) \ Makefile.PL DIR="" \ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= # --- MakeMaker test section: TEST_VERBOSE=0 TEST_TYPE=test_$(LINKTYPE) TEST_FILE = test.pl TEST_FILES = t/*.t TESTDB_SW = -d testdb :: testdb_$(LINKTYPE) $(NOECHO) $(NOOP) test :: $(TEST_TYPE) $(NOECHO) $(NOOP) # Occasionally we may face this degenerate target: test_ : test_dynamic $(NOECHO) $(NOOP) subdirs-test_dynamic :: dynamic pure_all test_dynamic :: subdirs-test_dynamic PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) testdb_dynamic :: dynamic pure_all PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) subdirs-test_static :: static pure_all test_static :: subdirs-test_static PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) testdb_static :: static pure_all PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) # --- MakeMaker ppd section: # Creates a PPD (Perl Package Description) for a binary distribution. ppd : $(NOECHO) $(ECHO) '' > Switch.ppd $(NOECHO) $(ECHO) ' A switch statement for Perl, do not use if you can use given/when' >> Switch.ppd $(NOECHO) $(ECHO) ' Damian Conway, Rafael Garcia-Suarez, Alexandr Ciornii' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) ' ' >> Switch.ppd $(NOECHO) $(ECHO) '' >> Switch.ppd # --- MakeMaker pm_to_blib section: pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \ 'Switch.pm' '$(INST_LIB)/Switch.pm' $(NOECHO) $(TOUCH) pm_to_blib # --- MakeMaker selfdocument section: # here so even if top_targets is overridden, these will still be defined # gmake will silently still work if any are .PHONY-ed but nmake won't static :: $(NOECHO) $(NOOP) dynamic :: $(NOECHO) $(NOOP) config :: $(NOECHO) $(NOOP) # --- MakeMaker postamble section: # End. META.yml000064400000001250151560063110006011 0ustar00--- abstract: 'A switch statement for Perl, do not use if you can use given/when' author: - Damian Conway - Rafael Garcia-Suarez - Alexandr Ciornii build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Switch no_index: directory: - t - inc requires: Filter::Util::Call: 0 Text::Balanced: 2 if: 0 perl: 5.005 resources: repository: http://github.com/chorny/Switch version: 2.17 Switch.pm000064400000070215151560063110006346 0ustar00package Switch; use 5.005; use strict; use vars qw($VERSION); use Carp; use if $] >= 5.011, 'deprecate'; $VERSION = '2.17'; # LOAD FILTERING MODULE... use Filter::Util::Call; sub __(); # CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch $::_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 { $fallthrough = grep /\bfallthrough\b/, @_; $offset = (caller)[2]+1; 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 unimport { filter_del() } sub filter { my($self) = @_ ; local $Switch::file = (caller)[1]; my $status = 1; $status = filter_read(1_000_000); return $status if $status<0; $_ = filter_blocks($_,$offset); $_ = "# line $offset\n" . $_ if $offset; undef $offset; return $status; } use Text::Balanced ':ALL'; sub line { my ($pretext,$offset) = @_; ($pretext=~tr/\n/\n/)+($offset||0); } sub is_block { local $SIG{__WARN__}=sub{die$@}; local $^W=1; my $ishash = defined eval 'my $hr='.$_[0]; undef $@; return !$ishash; } my $pod_or_DATA = qr/ ^=[A-Za-z] .*? ^=cut (?![A-Za-z]) .*? $ | ^__(DATA|END)__\n.* /smx; my $casecounter = 1; sub filter_blocks { my ($source, $line) = @_; return $source unless $Perl5 && $source =~ /case|switch/ || $Perl6 && $source =~ /when|given|default/; pos $source = 0; my $text = ""; component: while (pos $source < length $source) { if ($source =~ m/(\G\s*use\s+Switch\b)/gc) { $text .= q{use Switch 'noimport'}; next component; } my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0); if (defined $pos[0]) { my $pre = substr($source,$pos[0],$pos[1]); # matched prefix 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) { $text .= $1; next component; } @pos = Text::Balanced::_match_variable(\$source,qr/\s*/); if (defined $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(.*)(?=\{)/gc) { my $keyword = $3; my $arg = $4; $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) 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/} || $arg =~ s {^\s*[(]\s*qw} { ( \\qw}; @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef) or do { 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 ($Perl5 && $source =~ m/\G(\s*)(case\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 . ($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 .= " " 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*%} { ( \\\%} || $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 .= "$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)"; } 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)"; } 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 $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"; } 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 { if ($source =~ m/\G\s*(?=([};]|\Z))/gc) { $casecounter++; next component; } 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 }/ unless $fallthrough; $text .= "{ while (1) $code continue { goto C_A_S_E_$casecounter } last S_W_I_T_C_H; C_A_S_E_$casecounter: }"; $casecounter++; next component; } $source =~ m/\G(\s*(-[sm]\s+|\w+|#.*\n|\W))/gc; $text .= $1; } $text; } sub in { my ($x,$y) = @_; my @numy; for my $nextx ( @$x ) { my $numx = ref($nextx) || defined $nextx && (~$nextx&$nextx) eq 0; for my $j ( 0..$#$y ) { my $nexty = $y->[$j]; 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 ""; } sub on_exists { my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ }; [ keys %$ref ] } sub on_defined { my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ }; [ grep { defined $ref->{$_} } keys %$ref ] } sub switch(;$) { my ($s_val) = @_ ? $_[0] : $_; my $s_ref = ref $s_val; if ($s_ref eq 'CODE') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; return $s_val == $c_val if ref $c_val eq 'CODE'; return $s_val->(@$c_val) if ref $c_val eq 'ARRAY'; return $s_val->($c_val); }; } 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'; 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 $c_val->{$s_val} if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq "") # STRING SCALAR { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; my $c_ref = ref $c_val; return $s_val eq $c_val if $c_ref eq ""; 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 $c_val->{$s_val} if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'ARRAY') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; my $c_ref = ref $c_val; return in($s_val,[$c_val]) if $c_ref eq ""; 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 grep {$_=~/$c_val/} @$s_val if $c_ref eq 'Regexp'; return scalar grep {$c_val->{$_}} @$s_val if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'Regexp') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; my $c_ref = ref $c_val; return $c_val=~/s_val/ if $c_ref eq ""; return scalar grep {$_=~/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 $s_val eq $c_val if $c_ref eq 'Regexp'; return grep {$_=~/$s_val/ && $c_val->{$_}} keys %$c_val if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'HASH') { $::_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 ""; return scalar grep {$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 grep {$_=~/$c_val/ && $s_val->{"$_"}} keys %$s_val if $c_ref eq 'Regexp'; return $s_val==$c_val if $c_ref eq 'HASH'; return; }; } elsif ($s_ref eq 'Switch') { $::_S_W_I_T_C_H = sub { my $c_val = $_[0]; return $s_val == $c_val if ref $c_val eq 'Switch'; return $s_val->call(@$c_val) if ref $c_val eq 'ARRAY'; return $s_val->call($c_val); }; } else { croak "Cannot switch on $s_ref"; } return 1; } sub case($) { local $SIG{__WARN__} = \&carp; $::_S_W_I_T_C_H->(@_); } # IMPLEMENT __ my $placeholder = bless { arity=>1, impl=>sub{$_[1+$_[0]]} }; sub __() { $placeholder } sub __arg($) { my $index = $_[0]+1; bless { arity=>0, impl=>sub{$_[$index]} }; } sub hosub(&@) { # WRITE THIS } sub call { my ($self,@args) = @_; return $self->{impl}->(0,@args); } sub meta_bop(&) { my ($op) = @_; sub { my ($left, $right, $reversed) = @_; ($right,$left) = @_ if $reversed; my $rop = ref $right eq 'Switch' ? $right : bless { arity=>0, impl=>sub{$right} }; my $lop = ref $left eq 'Switch' ? $left : bless { arity=>0, impl=>sub{$left} }; my $arity = $lop->{arity} + $rop->{arity}; return bless { arity => $arity, impl => sub { my $start = shift; return $op->($lop->{impl}->($start,@_), $rop->{impl}->($start+$lop->{arity},@_)); } }; }; } sub meta_uop(&) { my ($op) = @_; sub { my ($left) = @_; my $lop = ref $left eq 'Switch' ? $left : bless { arity=>0, impl=>sub{$left} }; my $arity = $lop->{arity}; return bless { arity => $arity, impl => sub { $op->($lop->{impl}->(@_)) } }; }; } use overload "+" => meta_bop {$_[0] + $_[1]}, "-" => meta_bop {$_[0] - $_[1]}, "*" => meta_bop {$_[0] * $_[1]}, "/" => meta_bop {$_[0] / $_[1]}, "%" => meta_bop {$_[0] % $_[1]}, "**" => meta_bop {$_[0] ** $_[1]}, "<<" => meta_bop {$_[0] << $_[1]}, ">>" => meta_bop {$_[0] >> $_[1]}, "x" => meta_bop {$_[0] x $_[1]}, "." => meta_bop {$_[0] . $_[1]}, "<" => meta_bop {$_[0] < $_[1]}, "<=" => meta_bop {$_[0] <= $_[1]}, ">" => meta_bop {$_[0] > $_[1]}, ">=" => meta_bop {$_[0] >= $_[1]}, "==" => meta_bop {$_[0] == $_[1]}, "!=" => meta_bop {$_[0] != $_[1]}, "<=>" => meta_bop {$_[0] <=> $_[1]}, "lt" => meta_bop {$_[0] lt $_[1]}, "le" => meta_bop {$_[0] le $_[1]}, "gt" => meta_bop {$_[0] gt $_[1]}, "ge" => meta_bop {$_[0] ge $_[1]}, "eq" => meta_bop {$_[0] eq $_[1]}, "ne" => meta_bop {$_[0] ne $_[1]}, "cmp" => meta_bop {$_[0] cmp $_[1]}, "\&" => meta_bop {$_[0] & $_[1]}, "^" => meta_bop {$_[0] ^ $_[1]}, "|" => meta_bop {$_[0] | $_[1]}, "atan2" => meta_bop {atan2 $_[0], $_[1]}, "neg" => meta_uop {-$_[0]}, "!" => meta_uop {!$_[0]}, "~" => meta_uop {~$_[0]}, "cos" => meta_uop {cos $_[0]}, "sin" => meta_uop {sin $_[0]}, "exp" => meta_uop {exp $_[0]}, "abs" => meta_uop {abs $_[0]}, "log" => meta_uop {log $_[0]}, "sqrt" => meta_uop {sqrt $_[0]}, "bool" => sub { croak "Can't use && or || in expression containing __" }, # "&()" => sub { $_[0]->{impl} }, # "||" => meta_bop {$_[0] || $_[1]}, # "&&" => meta_bop {$_[0] && $_[1]}, # fallback => 1, ; 1; __END__ =head1 NAME Switch - A switch statement for Perl, do not use if you can use given/when =head1 SYNOPSIS use Switch; 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 [Skip ahead to L<"DESCRIPTION"> if you don't care about the whys and wherefores of this control structure] In seeking to devise a "Swiss Army" case mechanism suitable for Perl, it is useful to generalize this notion of distributed conditional testing as far as possible. Specifically, the concept of "matching" between the switch value and the various case values need not be restricted to numeric (or string or referential) equality, as it is in other languages. Indeed, as Table 1 illustrates, Perl offers at least eighteen different ways in which two values could generate a match. Table 1: Matching a switch value ($s) with a case value ($c) Switch Case Type of Match Implied Matching Code Value Value ====== ===== ===================== ============= number same numeric or referential match if $s == $c; or ref equality object method result of method call match if $s->$c(); ref name match if defined $s->$c(); or ref other other string equality match if $s eq $c; non-ref non-ref scalar scalar string regexp pattern match match if $s =~ /$c/; array scalar array entry existence match if 0<=$c && $c<@$s; ref array entry definition match if defined $s->[$c]; array entry truth match if $s->[$c]; array array array intersection match if intersects(@$s, @$c); ref ref (apply this table to all pairs of elements $s->[$i] and $c->[$j]) array regexp array grep match if grep /$c/, @$s; ref hash scalar hash entry existence match if exists $s->{$c}; ref hash entry definition match if defined $s->{$c}; hash entry truth match if $s->{$c}; hash regexp hash grep match if grep /$c/, keys %$s; ref sub scalar return value defn match if defined $s->($c); ref return value truth match if $s->($c); sub array return value defn match if defined $s->(@$c); ref ref return value truth match if $s->(@$c); In reality, Table 1 covers 31 alternatives, because only the equality and intersection tests are commutative; in all other cases, the roles of the C<$s> and C<$c> variables could be reversed to produce a different test. For example, instead of testing a single hash for 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}>). =head1 DESCRIPTION The Switch.pm module implements a generalized case mechanism that covers 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 single scalar argument of any type, specified in parentheses. C stores this value as the current switch value in a (localized) control variable. The value is followed by a block which may contain one or more Perl statements (including the C statement described below). The block is unconditionally executed once the switch value has been cached. A C statement takes a single scalar argument (in mandatory parentheses if it's a variable; otherwise the parens are optional) and selects the appropriate type of matching between that argument and the current switch value. The type of matching used is determined by the respective types of the switch value and the C argument, as specified in Table 1. If the match is successful, the mandatory block associated with the C statement is executed. In most other respects, the C statement is semantically identical to an C statement. For example, it can be followed by an C clause, and can be used as a postfix statement qualifier. However, when a C block has been executed control is automatically transferred to the statement after the immediately enclosing C block, rather than to the next statement within the block. In other words, the success of any C statement prevents other cases in the same scope from executing. But see L<"Allowing fall-through"> below. Together these two new statements provide a fully generalized case mechanism: use Switch; # AND LATER... %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 [1..9] { print "small num\n"; } # if $_ in [1..9] 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, and a series of C statements can try different types of matches -- hash membership, pattern match, array intersection, simple equality, etc. -- against the same switch value. The use of intersection tests against an array reference is particularly useful for aggregating integral cases: sub classify_digit { switch ($_[0]) { case 0 { return 'zero' } case [2,4,6,8] { return 'even' } case [1,3,5,7,9] { return 'odd' } case /[A-F]/i { return 'hex' } } } =head2 Allowing fall-through 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 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. For example: switch ($val) { case 1 { handle_num_1(); next } # and try next case... case "1" { handle_str_1(); next } # and try next case... case [0..9] { handle_num_any(); } # and we're done case /\d/ { handle_dig_any(); next } # and try next case... case /.*/ { handle_str_any(); next } # and try next case... } 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 third C block was executed, control would jump to the end of the enclosing C block. On the other hand, if $val held C<10>, then only the last two C subroutines would be called. Note that this mechanism allows the notion of I. For example: switch ($val) { case [0..9] { handle_num_any(); next if $val < 7; } case /\d/ { handle_dig_any(); } } 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 written: switch ($val) { case [0..9] { handle_num_any(); last if $val >= 7; next; } case /\d/ { handle_dig_any(); } } =head2 Automating fall-through In situations where case fall-through should be the norm, rather than an exception, an endless succession of terminal Cs is tedious and ugly. Hence, it is possible to reverse the default behaviour by specifying the string "fallthrough" when importing the module. For example, the following code is equivalent to the first example in L<"Allowing fall-through">: use Switch 'fallthrough'; switch ($val) { case 1 { handle_num_1(); } case "1" { handle_str_1(); } case [0..9] { handle_num_any(); last } case /\d/ { handle_dig_any(); } case /.*/ { handle_str_any(); } } Note the explicit use of a C to preserve the non-fall-through behaviour of the third case. =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 will be spelled C, and C will be pronounced C. In addition, the C statement will not require switch or case values to be parenthesized. 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(); } default { handle anything else; } } 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'; =head2 Higher-order Operations One situation in which C and C do not provide a good substitute for a cascaded C, is where a switch value needs to be tested against a series of conditions. For example: sub beverage { switch (shift) { 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 converts (almost) any expression in which it appears to a reference to a higher-order function. That is, the expression: use Switch '__'; __ < 2 is equivalent to: sub { $_[0] < 2 } With C<__>, the previous ugly case statements can be rewritten: case __ < 10 { return 'milk' } case __ < 20 { return 'coke' } case __ < 30 { return 'beer' } case __ < 40 { return 'wine' } case __ < 50 { return 'malt' } case __ < 60 { return 'Moet' } else { return 'milk' } The C<__> subroutine makes extensive use of operator overloading to perform its magic. All operations involving __ are overloaded to produce an anonymous subroutine that implements a lazy version of the original operation. The only problem is that operator overloading does not allow the boolean operators C<&&> and C<||> to be overloaded. So a case statement like this: case 0 <= __ && __ < 10 { return 'digit' } doesn't act as expected, because when it is executed, it constructs two higher order subroutines and then treats the two resulting references as arguments to C<&&>: sub { 0 <= $_[0] } && sub { $_[0] < 10 } 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 an error. =head1 DEPENDENCIES The module is implemented using Filter::Util::Call and Text::Balanced and requires both these modules to be installed. =head1 AUTHOR Damian Conway (damian@conway.org). This module is now maintained by Alexandr Ciornii (alexchorny@gmail.com). Previously was maintained by Rafael Garcia-Suarez and perl5 porters. =head1 BUGS There are undoubtedly serious bugs lurking somewhere in code this funky :-) Bug reports and other feedback are most welcome. May create syntax errors in other parts of code. On perl 5.10.x may cause syntax error if "case" is present inside heredoc. In general, use given/when instead. It were introduced in perl 5.10.0. Perl 5.10.0 was released in 2007. =head1 LIMITATIONS 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. Due to the way source filters work in Perl, you can't use Switch inside an string C. May not work if sub prototypes are used (RT#33988). Regex captures in when are not available to code. 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-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. pm_to_blib000064400000000000151560063110006561 0ustar00META.json000064400000002260151560063110006163 0ustar00{ "abstract" : "A switch statement for Perl, do not use if you can use given/when", "author" : [ "Damian Conway", "Rafael Garcia-Suarez", "Alexandr Ciornii" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Switch", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Filter::Util::Call" : "0", "Text::Balanced" : "2", "if" : "0", "perl" : "5.005" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "http://github.com/chorny/Switch" } }, "version" : "2.17" } t/nested.t000064400000000606151560063110006456 0ustar00use Switch; print "1..4\n"; my $count = 1; for my $count (1..3, 'four') { switch ([$count]) { =pod =head1 Test We also test if Switch is POD-friendly here =cut case qr/\d/ { switch ($count) { case 1 { print "ok 1\n" } case [2,3] { print "ok $count\n" } } } case 'four' { print "ok 4\n" } } } __END__ =head1 Another test Still friendly??? =cut t/switch.t000064400000015550151560063110006501 0ustar00use Carp; use Switch qw(__ fallthrough); my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"} END{print"1..$C\n$M"} # NON-case THINGS; $case->{case} = { case => "case" }; *case = \&case; # PREMATURE case eval { case 1 { ok(0) }; ok(0) } || ok(1); # H.O. FUNCS switch (__ > 2) { case 1 { ok(0) } else { ok(1) } case 2 { ok(0) } else { ok(1) } case 3 { ok(1) } else { ok(0) } } switch (3) { eval { case __ <= 1 || __ > 2 { ok(0) } } || ok(1); case __ <= 2 { ok(0) }; case __ <= 3 { ok(1) }; } # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE # 1. NUMERIC SWITCH for (1..3) { switch ($_) { # SELF case ($_) { ok(1) } else { ok(0) } # NUMERIC case (1) { ok ($_==1) } else { ok($_!=1) } case 1 { ok ($_==1) } else { ok($_!=1) } case (3) { ok ($_==3) } else { ok($_!=3) } case (4) { ok (0) } else { ok(1) } case (2) { ok ($_==2) } else { ok($_!=2) } # STRING case ('a') { ok (0) } else { ok(1) } case 'a' { ok (0) } else { ok(1) } case ('3') { ok ($_ == 3) } else { ok($_ != 3) } case ('3.0') { ok (0) } else { ok(1) } # ARRAY case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) } case [10,5,1] { ok ($_==1) } else { ok($_!=1) } case (['a','b']) { ok (0) } else { ok(1) } case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) } case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) } case ([]) { ok (0) } else { ok(1) } # HASH case ({}) { ok (0) } else { ok (1) } case {} { ok (0) } else { ok (1) } case {1,1} { ok ($_==1) } else { ok($_!=1) } case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) } # SUB/BLOCK case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) } case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) } case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 2. STRING SWITCH for ('a'..'c','1') { switch ($_) { # SELF case ($_) { ok(1) } else { ok(0) } # NUMERIC case (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } # STRING case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') } case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') } case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') } case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') } case ('d') { ok (0) } else { ok (1) } # ARRAY case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') } else { ok ($_ ne 'a' && $_ ne '1') } case (['z','2']) { ok (0) } else { ok(1) } case ([]) { ok (0) } else { ok(1) } # HASH case ({}) { ok (0) } else { ok (1) } case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') } else { ok ($_ ne 'a' && $_ ne '1') } # SUB/BLOCK case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') } else { ok($_ ne 'a') } case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') } case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 3. ARRAY SWITCH my $iteration = 0; for ([],[1,'a'],[2,'b']) { switch ($_) { $iteration++; # SELF case ($_) { ok(1) } # NUMERIC case (1) { ok ($iteration==2) } else { ok ($iteration!=2) } case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) } # STRING case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) } case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) } # ARRAY case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) } case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) } case ([]) { ok (0) } else { ok(1) } case ([7..100]) { ok (0) } else { ok(1) } # HASH case ({}) { ok (0) } else { ok (1) } case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) } else { ok ($iteration!=2) } # SUB/BLOCK case {scalar grep /a/, @_} { ok ($iteration==2) } else { ok ($iteration!=2) } case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) } else { ok ($iteration!=2) } case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 4. HASH SWITCH $iteration = 0; for ({},{a=>1,b=>0}) { switch ($_) { $iteration++; # SELF case ($_) { ok(1) } else { ok(0) } # NUMERIC case (1) { ok (0) } else { ok (1) } case (1.0) { ok (0) } else { ok (1) } # STRING case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } case ('b') { ok (0) } else { ok (1) } case ('c') { ok (0) } else { ok (1) } # ARRAY case (['a',2]) { ok ($iteration==2) } else { ok ($iteration!=2) } case (['b','a']) { ok ($iteration==2) } else { ok ($iteration!=2) } case (['b','c']) { ok (0) } else { ok (1) } case ([]) { ok (0) } else { ok(1) } case ([7..100]) { ok (0) } else { ok(1) } # HASH case ({}) { ok (0) } else { ok (1) } case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) } # SUB/BLOCK case {$_[0]{a}} { ok ($iteration==2) } else { ok ($iteration!=2) } case (sub {$_[0]{a}}) { ok ($iteration==2) } else { ok ($iteration!=2) } case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 5. CODE SWITCH $iteration = 0; for ( sub {1}, sub { return 0 unless @_; my ($data) = @_; my $type = ref $data; return $type eq 'HASH' && $data->{a} || $type eq 'Regexp' && 'a' =~ /$data/ || $type eq "" && $data eq '1'; }, sub {0} ) { switch ($_) { $iteration++; # SELF case ($_) { ok(1) } else { ok(0) } # NUMERIC case (1) { ok ($iteration<=2) } else { ok ($iteration>2) } case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) } case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) } # STRING case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) } case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) } case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) } case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) } # ARRAY case ([1, 'a']) { ok ($iteration<=2) } else { ok ($iteration>2) } case (['b','a']) { ok ($iteration==1) } else { ok ($iteration!=1) } case (['b','c']) { ok ($iteration==1) } else { ok ($iteration!=1) } case ([]) { ok ($iteration==1) } else { ok($iteration!=1) } case ([7..100]) { ok ($iteration==1) } else { ok($iteration!=1) } # HASH case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) } case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) } else { ok ($iteration>2) } # SUB/BLOCK case {$_[0]->{a}} { ok (0) } else { ok (1) } case (sub {$_[0]{a}}) { ok (0) } else { ok (1) } case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH case {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH } } # NESTED SWITCHES for my $count (1..3) { switch ([9,"a",11]) { case (qr/\d/) { switch ($count) { case (1) { ok($count==1) } else { ok($count!=1) } case ([5,6]) { ok(0) } else { ok(1) } } } ok(1) case (11); } } t/given.t000064400000015672151560063110006315 0ustar00use Carp; use Switch qw(Perl6 __ fallthrough); my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"} END{print"1..$C\n$M"} # NON-when THINGS; $when->{when} = { when => "when" }; *when = \&when; # PREMATURE when eval { when 1 { ok(0) }; ok(0) } || ok(1); # H.O. FUNCS given 2 { when __ < 1 { ok(0) } else { ok(1) } when __ < 2 { ok(0) } else { ok(1) } when __ < 3 { ok(1) } else { ok(0) } } given (3) { eval { when __ <= 1 || __ > 2 { ok(0) } } || ok(1); when __ <= 2 { ok(0) }; when __ <= 3 { ok(1) }; } # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE # 1. NUMERIC SWITCH for (1..3) { given ($_) { # SELF when ($_) { ok(1) } else { ok(0) } # NUMERIC when 1 { ok ($_==1) } else { ok($_!=1) } when (1) { ok ($_==1) } else { ok($_!=1) } when 3 { ok ($_==3) } else { ok($_!=3) } when (4) { ok (0) } else { ok(1) } when (2) { ok ($_==2) } else { ok($_!=2) } # STRING when ('a') { ok (0) } else { ok(1) } when 'a' { ok (0) } else { ok(1) } when ('3') { ok ($_ == 3) } else { ok($_ != 3) } when ('3.0') { ok (0) } else { ok(1) } # ARRAY when ([10,5,1]) { ok ($_==1) } else { ok($_!=1) } when [10,5,1] { ok ($_==1) } else { ok($_!=1) } when (['a','b']) { ok (0) } else { ok(1) } when (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) } when (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) } when ([]) { ok (0) } else { ok(1) } # HASH when ({}) { ok (0) } else { ok (1) } when {} { ok (0) } else { ok (1) } when {1,1} { ok ($_==1) } else { ok($_!=1) } when ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) } # SUB/BLOCK when (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) } when {$_[0]==2} { ok ($_==2) } else { ok($_!=2) } when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 2. STRING SWITCH for ('a'..'c','1') { given ($_) { # SELF when ($_) { ok(1) } else { ok(0) } # NUMERIC when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } # STRING when ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') } when ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') } when ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') } when ('1') { ok ($_ eq '1') } else { ok($_ ne '1') } when ('d') { ok (0) } else { ok (1) } # ARRAY when (['a','1']) { ok ($_ eq 'a' || $_ eq '1') } else { ok ($_ ne 'a' && $_ ne '1') } when (['z','2']) { ok (0) } else { ok(1) } when ([]) { ok (0) } else { ok(1) } # HASH when ({}) { ok (0) } else { ok (1) } when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') } else { ok ($_ ne 'a' && $_ ne '1') } # SUB/BLOCK when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') } else { ok($_ ne 'a') } when {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') } when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 3. ARRAY SWITCH my $iteration = 0; for ([],[1,'a'],[2,'b']) { given ($_) { $iteration++; # SELF when ($_) { ok(1) } # NUMERIC when (1) { ok ($iteration==2) } else { ok ($iteration!=2) } when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) } # STRING when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } when ('b') { ok ($iteration==3) } else { ok ($iteration!=3) } when ('1') { ok ($iteration==2) } else { ok ($iteration!=2) } # ARRAY when (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) } when ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) } when ([]) { ok (0) } else { ok(1) } when ([7..100]) { ok (0) } else { ok(1) } # HASH when ({}) { ok (0) } else { ok (1) } when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) } else { ok ($iteration!=2) } # SUB/BLOCK when {scalar grep /a/, @_} { ok ($iteration==2) } else { ok ($iteration!=2) } when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) } else { ok ($iteration!=2) } when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 4. HASH SWITCH $iteration = 0; for ({},{a=>1,b=>0}) { given ($_) { $iteration++; # SELF when ($_) { ok(1) } else { ok(0) } # NUMERIC when (1) { ok (0) } else { ok (1) } when (1.0) { ok (0) } else { ok (1) } # STRING when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } when ('b') { ok (0) } else { ok (1) } when ('c') { ok (0) } else { ok (1) } # ARRAY when (['a',2]) { ok ($iteration==2) } else { ok ($iteration!=2) } when (['b','a']) { ok ($iteration==2) } else { ok ($iteration!=2) } when (['b','c']) { ok (0) } else { ok (1) } when ([]) { ok (0) } else { ok(1) } when ([7..100]) { ok (0) } else { ok(1) } # HASH when ({}) { ok (0) } else { ok (1) } when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) } # SUB/BLOCK when {$_[0]{a}} { ok ($iteration==2) } else { ok ($iteration!=2) } when (sub {$_[0]{a}}) { ok ($iteration==2) } else { ok ($iteration!=2) } when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH } } # 5. CODE SWITCH $iteration = 0; for ( sub {1}, sub { return 0 unless @_; my ($data) = @_; my $type = ref $data; return $type eq 'HASH' && $data->{a} || $type eq 'Regexp' && 'a' =~ /$data/ || $type eq "" && $data eq '1'; }, sub {0} ) { given ($_) { $iteration++; # SELF when ($_) { ok(1) } else { ok(0) } # NUMERIC when (1) { ok ($iteration<=2) } else { ok ($iteration>2) } when (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) } when (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) } # STRING when ('a') { ok ($iteration==1) } else { ok ($iteration!=1) } when ('b') { ok ($iteration==1) } else { ok ($iteration!=1) } when ('c') { ok ($iteration==1) } else { ok ($iteration!=1) } when ('1') { ok ($iteration<=2) } else { ok ($iteration>2) } # ARRAY when ([1, 'a']) { ok ($iteration<=2) } else { ok ($iteration>2) } when (['b','a']) { ok ($iteration==1) } else { ok ($iteration!=1) } when (['b','c']) { ok ($iteration==1) } else { ok ($iteration!=1) } when ([]) { ok ($iteration==1) } else { ok($iteration!=1) } when ([7..100]) { ok ($iteration==1) } else { ok($iteration!=1) } # HASH when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) } when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) } else { ok ($iteration>2) } # SUB/BLOCK when {$_[0]->{a}} { ok (0) } else { ok (1) } when (sub {$_[0]{a}}) { ok (0) } else { ok (1) } when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH when {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH } } # NESTED SWITCHES for my $count (1..3) { given ([9,"a",11]) { when (qr/\d/) { given ($count) { when (1) { ok($count==1) } else { ok($count!=1) } when ([5,6]) { ok(0) } else { ok(1) } } } ok(1) when 11; } } MYMETA.yml000064400000001403151560063110006257 0ustar00--- abstract: 'A switch statement for Perl, do not use if you can use given/when' author: - 'Damian Conway' - 'Rafael Garcia-Suarez' - 'Alexandr Ciornii' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Switch no_index: directory: - t - inc requires: Filter::Util::Call: '0' Text::Balanced: '2' if: '0' perl: '5.005' resources: repository: http://github.com/chorny/Switch version: '2.17' x_serialization_backend: 'CPAN::Meta::YAML version 0.018'