На perlcast.com — интервью со Стеваном Литтлом, создателем Moose.
На спане — модуль для Perl-гольфистов Acme::Minify.
На perlcast.com — интервью со Стеваном Литтлом, создателем Moose.
На спане — модуль для Perl-гольфистов Acme::Minify.
В очередной раз подумалось, что код из блока SYNOPSIS POD-документации модулей на спане нужно автоматически включать в набор тестов.
Вот модуль Time::Business, судя по описанию, полезный: умеет переводить рабочие часы в «общечеловеческие». CPAN сообщает о десятках успешных тестов на разных платформах. Но в действительности к модулю прилагается только тест use_ok (это не самое страшное), а код из краткого описания не работает:
use v5.12;
use Time::Business;
my $bt = new Time::Business ({
WORKDAYS => [1..5],
STARTTIME => 1000,
ENDTIME => 1900,
});
my $seconds = $bt->calctime(time, time + 1 * 86400);
perl test.pl
Can't locate object method "calctime" via package "Time::Business" at test.pl line 9.
Понятно, что дальнейшее чтение документации помогает добиться работоспособности, но внутренний голос сразу начинает говорить о том, что как-то и все остальное некрасиво: и странный формат записи времени (а что, если записать 0800 — не в восьмеричном ли формате это получится?), и капслок в именах ключей, и отсутствие предопределенных значений — собственно, все то, что замечаешь при первом взгляде, но что лишь усиливает негатив после того, как первый тест не заработал.
Для этого фокуса потребуется взять один Class::Accessor и один Test::Deep, замешав их в одном модуле:
package MyTest;
use base 'Class::Accessor';
use Test::Deep;
__PACKAGE__->mk_accessors qw(mytest);
1;
Модуль Class::Accessor создаст в пакете MyTest метод mytest(), который должен работать как пара сеттер — геттер для установки поля mytest (точнее, $self->{mytest}). Тестируем:
use v5.12;
use MyTest;
my $test = new MyTest;
$test->mytest('test');
say "mytest=", $test->mytest;
И видим, что никакое значение mytest=test не устанавливается. Комментируем в файле MyTest.pm строку, подключающую модуль Test::Deep, и все работает:
mytest=test
Раскомментируем обратно и попробуем немного по-другому:
$test->set('key', 'value');
set $test('key', 'value');
Опять не работает. Но по-другому мы пробуем уже после того, как заглянули в исходник Test::Deep и увидели там безусловный экспорт функции set:
@EXPORT = qw( eq_deeply cmp_deeply cmp_set cmp_bag cmp_methods
useclass noclass set bag subbagof superbagof subsetof
supersetof superhashof subhashof
);
В свою очередь, внутри методов-аккессоров, которые создает Class::Accessor, используются вызовы $self->set(...), которые в модуле, унаследованном от него, попадают напрямую в Test::Deep::set().
Неуклюжее быстрое решение: подсказать компилятору, куда направлять внутренние вызовы методов set:
package MyTest;
use base 'Class::Accessor';
use Test::Deep;
*set = *Class::Accessor::set;
__PACKAGE__->mk_accessors qw(mytest);
1;
На спане есть модуль Инги дёт Нета (Брайана Ингерсона) под названием XXX, предназначенный для — ха! — для отладки.
Модуль экспортирует несколько функций WWW, XXX, YYY и ZZZ, которые печатают дамп того, что находится справа. То есть достаточно вписать в нужное место XXX, и выполнение программы прекратится отладочным сообщением:
use v5.12;
use XXX;
XXX my @digits = 'a'..'f';
--- a
--- b
--- c
--- d
--- e
--- f
...
at 1.pl line 4
По умолчанию дамп делается в формате YAML, но это возможно переопределить, например:
use v5.12;
use XXX -with => 'Data::Dumper';
XXX my $person = {sex => 'male', age => 30};
$VAR1 = {
'age' => 30,
'sex' => 'male'
};
at 2.pl line 4
Вызов XXX приводит к завершению программы (die), а WWW печатает предупреждение (warn).
Несмотря на то, что все равно приходится явно подключать модуль (use XXX), подход очень интересный: написать в начале (или любой другой части — функция возвращает все свои аргументы) строки три буквы (хотя еще удобнее было бы, если бы названия функция были в нижнем регистре) намного проще и быстрее, чем, например, say Data::Dumper($var).
Йозеф Кутей обновил дистрибутив Universe::Galaxy, который содержит модуль с бесконечным названием Universe::ObservableUniverse::Filament::SuperCluster::Cluster:: Group::Galaxy::Arm::Bubble::InterstellarCloud::SolarSystem::Earth.
Из двух доступных методов нам важен ultimate_answer, который дает ответ на главный вопрос жизни, вселенной и всего такого.
use v5.10;
Universe::ObservableUniverse::Filament::SuperCluster::⏎
Cluster::Group::Galaxy::Arm::Bubble::InterstellarCloud::⏎
SolarSystem::Earth;
say Universe::ObservableUniverse::Filament::SuperCluster::⏎
Cluster::Group::Galaxy::Arm::Bubble::InterstellarCloud::⏎
SolarSystem::Earth->ultimate_answer;
42
А еще на спане есть модуль Acme::Test::42, который работает аналогично любому другому современному модулю, основанном на Test::Builder, но проверяет, вычислен ли ответ на главный вопрос.
Соответственно, тестируем:
use Universe::ObservableUniverse::Filament::SuperCluster::⏎
Cluster::Group::Galaxy::Arm::Bubble::InterstellarCloud::⏎
SolarSystem::Earth;
use Acme::Test::42 qw(no_plan);
ok(Universe::ObservableUniverse::Filament::SuperCluster::⏎
Cluster::Group::Galaxy::Arm::Bubble::InterstellarCloud::⏎
SolarSystem::Earth->ultimate_answer);
ok 1
1..1
Сегодня на DevConf::Perl рассказал про то, как авторы модулей CPAN используют новые возможности, доступные в Perl 5.10, и о том, что нового появилось в 5.12. Кстати, как раз сегодня появился релиз Perl 5.12.1.
Идея собрать примеры использования со спана появилась спонтанно перед поездкой на Perlburg в начале этого года (хотя вначале я хотел всего лишь обновить свои прошлогодние «Фичи Perl 5.10 на практике», показав новые примеры своего кода).
Начиная с февраля я рассказал про Perl 5.10 на спане три раза, и, хотя каждый раз появлялось что-то новое (и почти полностью менялась аудитория), я немного устал от этого набора слайдов. Теперь хочу подготовить большой обзор существующего сегодня кода на Perl 6. Премьера 26 июня в Брюсселе.
Из ментальных записок системного администратора.
Так, а что это записи в Твиттере давно не обновлялись? Ага, в кроне скрипт не закомментирован. Запускаю вручную.
Хопа! Обновился до 5.12, а Class::MOP не поставил. (Кстати, всегда считал, что P — это programming, а недавно узнал, что это protocol.)
# cpan Class::MOP
...won't install without force.
Хоп, это модный модерновый модуль-то не ставится на автомате? А, там Devel::GlobalDestruction не прошел тесты и все разрушил. Ну так и название — Глобальное Разрушение.
# cpan
cpan> look Devel::GlobalDestruction
# perl Makefile.PL
Поставили. Встал и Class::MOP. Запускаю. Хоп!
...get_meta_method_name not found.
Чо? Я должен пройти курс мета-программирования? Да мне надо всего лишь фигачить посты в Твиттер, там и буков-то не хватит для таких названий гета-мета-хуета-эйяфьятлайокудль. Кстати, Твиттер был бы другим, если бы его придумали исландцы.
Ну ладно, обновлю и Лосика.
# cpan Moose
О, сам установился. Ну все, победа, первомай.
Опа, а надо было же запустить скрипт из крона (за всем этим модернизмом и забыл).
Can't locate Variable/Magic.pm in @INС
Ну ё, опять просят магию. Что там, поставим.
Тут где-то была хорошая цитата про Муз в рассылке.
use Perl^WMoose^WMozg or die;
Музмаздай, что ли.
Во французском блоге про Perl недавно появилось сообщение о том, как автор написал для себя несколько модулей, чтобы было удобно сохранять HTML-файлы для чтения в электронной книге.
Приводятся ссылки на четыре модуля, и все они лежат на гитхабе. А модули-то интересные, например, HTML::Image::Size.
Сформулирую мысль кратко и в тезисах.
Простейший вариант использования конструкции с ключевым словом 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, которые используют ее в качестве переменной по умолчанию на текущей итерации.
Выбор одного из нескольких вариантов — самое очевидное применениее конструкции 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 не константы, а выражения с переменной $_, в частности, булевые:
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 )
Сделать проверку с использованием регуляного выражения так же просто, как и с константой.
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
Помимо проверки значения возможно проверять и тип переменной:
given(ref $fdef){
when('ARRAY'){
Package::FromData — 14 Jan 2008
generate a package with methods and variables from a data structure
Не столь очевидно, однако вполне законно, сопоставление с 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($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
Стоит отметить, что вложенные конструкции в некоторых случаях возможно развернуть в одноуровневые.
Несмотря на то, что ключевое слово 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
Оператор сопоставления используется довольно часто, хотя и менее популярен, чем оператор //.
Встречаются самые разные комбинации типов операндов, в том числе и сопоставление с регулярными выражениями.
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
Продолжение будет.