when со скаляром
Простейший вариант использования конструкции с ключевым словом when — указание констант в условиях проверки.
foreach (@hazards) {
when ($WUMPUS) {
$self -> lose;
push @messages => "Oops! Bumped into a Wumpus!";
}
when ($PIT) {
$self -> lose;
push @messages => "YYYIIIIEEEE! Fell in a pit!";
}
when ($BAT) {
push @messages =>
"ZAP! Super bat snatch! Elsewhereville for you!";} }
Games::Wumpus — 24 Nov 2009
Play Hunt the Wumpus
Забегая вперед, обратите внимение на то, что when не обязательно использовать исключительно внутри блока given. Любой вызов when выполняет сопоставление с переменной $_, поэтому они хорошо работают в конструкциях for и foreach, которые используют ее в качестве переменной по умолчанию на текущей итерации.
when для выбора вариантов
Выбор одного из нескольких вариантов — самое очевидное применениее конструкции given/when.
given ($k) {
when ('file') { $opt_file = $v; }
when ('argv') { $opt_argv = $v; }
when ('inter') { $opt_interact = $v; }
when ('prompt') { $opt_prompt = $v; }
when ('quiet') { $opt_quiet = $v; }
when ('tty_in') { $tty_in = $v; }
when ('tty_out') { $tty_out = $v; }
default {
die "Error: in subroutine set_opt(),
found invalid key {$k => '$v'}
(not 'file', 'argv', 'inter', 'prompt',
'quiet',
'tty_in' or 'tty_out')";} }
Term::DBPrompt — 18 Dec 2009
Commandline prompt for a database application
given ($inp_typ)
when ('f') . . .
when ('a') . . .
when ('i') . . .
default {
die "Internal error: type =
'$inp_typ' (not 'f', 'a' or 'i')";
}
}
Term::DBPrompt — 18 Dec 2009
Commandline prompt for a database application
when с булевым выражением
Следующая «ступень» — использовать внутри when не константы, а выражения с переменной $_, в частности, булевые:
unless ( 'itan' ~~ @list ) {
given ( length $password ) {
when ( 16 ) {
# ok
}
when ( $_ < 4 ) {
die('ERROR: Password is too short
(Min 4 bytes required)');
}
when ( $_ > 16 ) {
die('ERROR: Password is too long
(Max 16 bytes allowed)');
}
default {
while (1) {
$password .= '0';
last
if length $password == 16;
}
}
}
App::iTan::Utils — 26 Oct 2009
Secure management of iTans for online banking
Кстати, в этом примере конструкция выбора обрамлена условием с использованием смартматчинга:
unless ( 'itan' ~~ @list )
when с регулярным выражением
Сделать проверку с использованием регуляного выражения так же просто, как и с константой.
sub range2list {
my $_ = shift;
given ($_) {
when (/^(\d)\-(\d)$/o ) { return "$1..$2" }
when (/^\d\.\.\d$/o ) { return "$_" }
when (/^\d$/o ) { return $_}
when (/^(.*?),(.*)$/o ) { return range2list($1). ','
.range2list($2)}
default { return ''}
}
}
Catalyst::Devel
when и ref
Помимо проверки значения возможно проверять и тип переменной:
given(ref $fdef){
when('ARRAY'){
Package::FromData — 14 Jan 2008
generate a package with methods and variables from a data structure
when и undef
Не столь очевидно, однако вполне законно, сопоставление с undef. В этом случае блок when принимает управление, если переменная неопределена.
given ($1) {
when (undef) {return}
when ($left) { $depth++; }
when ($right) { $depth--; }
}
Parse::Marpa::Lex
В одном из модулей встретилась конструкция, где явным образом записано, что для неопределннной переменной делать ничего не нужно:
given ($action) {
when (undef) {;} # do nothing
# Right now do nothing
# but find lex_q_quote
when ('lex_q_quote') {
$lexers[$ix] =
[ \&Parse::Marpa::Lex::lex_q_quote,
$prefix, $suffix ];
}
Parse::Marpa::Recognizer
Вложенные блоки given/when
Блоки given/when легко объединяются и образуют вложенные конструкции.
given($name) {
when ('stream:stream') . . .
when ('challenge') . . .
when ('failure') . . .
when ('stream:features') . . .
given(my $clist = $node->getChildrenHash()) {
when ('starttls') . . .
when('mechanisms') . . .
foreach($clist->{'mechanisms'}->
[0]->getChildrenByTagName('*')) when($_->textContent() eq 'DIGEST-MD5'
or $_->textContent() eq 'PLAIN')
when('bind') . . .
default . . .
when ('proceed') . . .
when ('success') . . .
POE::Component::Jabber — 22 Mar 2009
A POE Component for communicating over Jabber
Стоит отметить, что вложенные конструкции в некоторых случаях возможно развернуть в одноуровневые.
for и when
Несмотря на то, что ключевое слово when появилось в Perl 5.10 одновременно с given и default, ничто не обязывает всегда использовать их совместно. Как уже упоминалось, действие, выполняемое функцией when, во многих случах явлется сопоставлением переменной по умолчания $_ с указанным значением (константой, регулярным выражением, списком и т. д.). Поэтому иногда when удобно применять вместо последовательности if/elsif/else.
for ( catch ) {
when ( $_->isa('Getopt::Lucid::Exception::ARGV') ) {
say;
# usage stuff
return 1;
}
default { die $_ }
}
App::CPAN::Mini::Visit — 07 Nov 2008
explore each distribution in a minicpan repository
Cмартматчинг (~~)
Оператор сопоставления используется довольно часто, хотя и менее популярен, чем оператор //.
Встречаются самые разные комбинации типов операндов, в том числе и сопоставление с регулярными выражениями.
return _fail( $pkg, $sub ) if $_ ~~ 0;
if ( $attr ~~ /^Export_?Lexical$/i ) {
Export::Lexical — 09 Oct 2008
Lexically scoped subroutine imports
Интересен пример использования оператора ~~ внутри блока кода встроенной функции grep.
@exportz = grep { ! ( $_ ~~ @argz ) } @_;
$disp ~~ @exportz or push @exportz, $disp;
Exporter::Proxy — 29 Jan 2010
Simplified symbol export & proxy dispatch
В этом же фрагменте есть еще не менее интересное и практичное применение: ~~ удобно привлекать, чтобы определить, содержится ли элемент с неким значением в списке.
Чуть более нагляден вариант, в котором условие записано в постфиксной форме:
push @exportz, $disp unless $disp ~~ @exportz;
Смартматчинг, выполненный внутри if, разумеется, возможен, однако в таких случаях стоит задумться об использовании when, поскольку он неявно использует именно смартматчинг.
for( @_ )
{
index $_, ':'
or next;
if( $_ ~~ @exportz )
{
my $source = qualify_to_ref $_, $source;
my $install = qualify_to_ref $_, $caller;
*$install = *$source;
}
else
{
die "Bogus $source: '$_' not exported";
}
}
Exporter::Proxy — 29 Jan 2010
Simplified symbol export & proxy dispatch
Именованные сохраняющие скобки
На сегодняшнем спане новые возможности регулярных выражений используются еще не слишком часто, вот один из найденных примеров, где встретились именованные сохраняющие скобки:
my $compiled_regex = qr{
\G
(?<mArPa_prefix>$prefix)
(?<mArPa_match>$regex)
(?<mArPa_suffix>$suffix)
}xms;
Parse::Marpa::Recognizer
Продолжение будет.
С нетерпением ждём ...