i-t-шные заметки: хитрый split

my $s = "bla bla bla";
my $count = () = split / /, $s;

Чему равен $count ?

03:09

Язык_Perl | Сообщества на YVISION.KZ: Япония отаке!!1

В последнее время на cpan'e наблюдается засилие японцев =)» UPD: и китайцев =)))

Написал shootnix@yvision.kz (shootnix) в 23:08

Кодекс кодоголика: Perl in Springfield

Интересно, кто в Спрингфилде программирует на Perl? Барт? Лиза? Или, может быть, Мо? Ждем появления NewNewYork.pm.

Написал noreply@blogger.com (codeholic) в 21:46

Blog.Perl5doc.ru: Установка тестовых модулей - Тестирование программ

Ниже приводится перевод главы Beginning Testing из учебника Perl Testing: A Developer`s Notebook

Практические занятия в этой главе проходят через самые элементарные шаги написания и выполнения автоматизированных тестов на Perl. К концу главы вы будете знать как начать тестирование, как работают библиотеки тестирования на Perl, и где найти дополнительные библиотеки, чтобы облегчить вашу работу.

Одной из сильных сторон Perl является CPAN - архив тысяч библиотек в свободном доступе, которые решают почти любые программные задачи, включая написание и выполнение тестов. Однако прежде, чем использовать эти модули, их нужно установить. Perl упрощает эту задачу.

Способы установки модулей Perl

Лучший способ установки модулей из CPAN через систему установки модулей, которая может сама произвести поиск, загрузку сборку, установку модулей и их зависимостей.

Через оболочку CPAN

На Unix-подобных платформах (включая Mac OS X), а также в Windows если есть в наличии С компилятор, самый простой способ установки модулей - использование модуля CPAN, который поставляется с Perl. Например, если у вас еще не установлен модуль Test::Simple, запустите командную оболочку CPAN, а затем введите install Test::Simple . Ниже приводится примерная картина установки этого модуля.

% cpan cpan shell -- CPAN exploration and modules installation (v1.7601) ReadLine support enabled cpan> install Test::Simple Running install for module Test::Simple Running make for M/MS/MSCHWERN/Test-Simple-0.54.tar.gz

...

Appending installation info to /usr/lib/perl5/5.8.6/powerpc-linux/perllocal.pod /usr/bin/make install UNINST=1 -- OK

Примечание: Вы также можете запустить оболочку CPAN командой perl MCPAN -e shell .

Если Test::Simple имеет какие-либо зависимости (в нашем случае их нет), оболочка обнаружит их и установит их первыми.

Если вы запускаете оболочку cpan впервый раз, возможно нужно будет указать конфигурацию системы, сети и.т.п. Обычно по умолчанию настройка производится автоматически.

Через PPM

В Windows чаще в всего используется дистрибутив Perl от ActiveState, в которую входит утилита ppm для загрузки, конфигурации, сборки и установки модулей. Если у вас установлен ActivePerl, откройте окно консоли и введите:

    C:\>PPM
    PPM> install Test-Simple

Примечание: ActivePerl также выпускает дистрибутивы Perl для Linux и Solaris, так что вышеуказанные инструкции работают и там.

Если конфигурация указана верно, ppm загрузит и установит последнюю версию Test::Simple из репозитория ActiveState.

Если модуля нет в репозитории вообще, либо его версия в репозитории не самая последняя, у вас есть несколько вариантов.

Первый вариант - вы можете найти альтернативные репозитории. Смотрите список ppm репозиториев . Ниже приводится пример подключения репозитория к PPM.

    C:\>PPM
    PPM> set repository dada http://dada.perl.it/PPM
    PPM> set save

Вручную

Если вы хотите вручную установить модуль на чистом Perl или работаете на пларформе, где имеется соответствующий компилятор, вы можете загрузить и установить модуль вручную. Найти подходящий модуль можно на сайте http://search.cpan.org. После того, как вы нашли и загрузили архив модуля, распокуйте его в домашнем каталоге:

    $ tar xvzf Test-Simple-0.54.tar.gz
    Test-Simple-0.54/
    ...

Примечание: Чтобы установить среду компиляции для Perl на Windows, обратитесь к файлу README.win32, который поставляется вместе с Perl.

Запустите программу Makefile.PL и затем выполните стандартные команды сборки и тестирования модуля:

$ perl Makefile.PL Checking if your kit is complete... Looks good Writing Makefile for Test::Simple

$ make ... cp lib/Test/Builder.pm blib/lib/Test/Builder.pm cp lib/Test/Simple.pm blib/lib/Test/Simple.pm

$ make test

Примечание: Загруженный архив имеет статус "Текущий релиз"(This Reliase), если вы планируете помочь в развитии модуля, нужно загрузить его последний релиз для разработчиков (Latest Dev Release).

Если все тесты пройдены, отлично! В противном случае, сделайте все возможное, чтобы выяснить, что не удалось сделать, почему, и насколько это поправимо. Наконец, необходимо установить модуль, запустив make install (с привилегиями администратора, если вы устанавливаете модуль в системный каталог).

Обычно Makefile.PL использует модуль ExtUtils::MakeMaker для конфигурации и установки модулей. Но иногда для этой же цели используется Build.PL и Module::Build. В этом случае нужно указать другие команды установки:

    $ perl Build.PL
    $ perl Build
    $ perl Build test
    # perl Build install

Примечание: на Unix можно использовать ./Build вместо perl Build.

В остальном, они работают практически идентично.

На Windows может потребоваться установка утилиты nmake от Microsoft для установки модулей вручную, которая использутеся так же, как и make. Таким образом, установка модулей на Windows производится командами nmake: nmake, nmake test, и nmake install.

Примечание: Файл README.win32 из исходного кода дистрибутива Perl может помочь в разрешении вопросов по утилите nmake.exe

Вопрос - ответ ...

Вопрос:
Как я узнаю какое имя нужно указать, при установке модуля через PPM ? Я пытался установить Test-More, но утилита не может его найти!
Ответ:
Такое бывает когда модуль входит в состав дистрибутива модулей, поэтому нужно установить сам дистрибутив. Определить к какому дистрибутиву относится модуль можно на http://search.cpan.org. В нашем примере Test::More входит в дистрибутив Test-Simple, поэтому нужно указать в PPM название дистрибутива Тest::Simple, чтобы установился модуль Test::More.
Вопрос:
Я не системный администратор, или я не хочу устанавливать модули в системный каталог. Как я могу установить модуль в конкретный каталог?
Ответ:
Укажите соответствующий параметр PREFIX при установке модуля. Например, PREFIX ~/perl/lib установит модуль в каталог ~/perl/lib (по меньшей мере, на Unix системах). Затем добавьте в переменную окружающей среды PERL5LIB путь к каталогу или не забывайте использовать прагму lib для добавления каталога в @INC во всех программах, в которых будут вызваны локально установленные модули. Примечание: Почитайте perlfaq8 чтобы узнать больше о поддержке вашего собственного каталога модулей.

Если вы устанавливаете модуль вручную, выполните Makefile.PL следующим образом:
```
    $ perl Makefile.PL PREFIX=~/perl/lib
```
Примечание: MakeMaker 6.26 поддерживает INSTALLBASE, используйте его вместо PREFIX.

Если вы используете CPAN, можно настроить его для установки модулей в нужную вам директорию. Запустите оболочку CPAN под вашей учетной записью с последующим конфигурированием параметров.
```
    % cpan



    ...
             # указать каталог установки модулей
    cpan[1]> o conf makepl_arg PREFIX=/home/UserName/mylib  



             # зафиксировать изменения параметров
    cpan[2]> o conf commit
```
Если устанавливаемый модуль использует Module::Build , укажите параметр --installbase вместо PREFIX
```
    $ perl Build.PL --installbase=~/perl
```
Обратитесь к документации для ExtUtils::MakeMaker, CPAN, и Module::Build за более подробной информацией.

Написал Dinar в 20:35

Павел Кудинов: про доклады

Определился с докладами для РИТ 2010, в силу необычности перед подготовкой дождусь заключения программного комитета, с чем мне разрешат присесть на уши уважаемой аудитории, а с чем нет

Lazy::Slicely - ленивый sql join моя не-объектная read-only альтернатива ORM (DBIx::Class и прочим). 2006 года выпуска, 10 строк кода (400 байт), 10 страниц "how to" документации :), пара десятков проектов моих и друзей, чьи схемы данных описаны на базе Lazy::Slicely, и это только в рот (с) (т.е. до выкладывания на CPAN). Вообще, мой лучший велосипед, 5 лет production'а без единой модификации - можно гордиться :)

блиц-доклад: идеальная цветовая схема для редакторов кода с точки зрения восприятия цветов мозгом + ссылки на схему для популярных редакторов :)

Интерактивная модель графа на SVG+JS с автолейаутом уже писал про неё. Просто интересная (технологически) и многим полезная (легко применима для отладки) игрушка получилась

Костыли - это кошерно! доклад на тему того, что проект, эволюционно построенный как совокупность заплаток, на практике гораздо стабильнее и удобнее технически совершенных творений + немного забавных фактов из микробиологии и эволюции, намекающих на кошерность явления (соответствие идеям автора нашей уютненькой вселенной)

p.s. технические "серверные" доклады отложу на очередной HighLoad

20:01

Shoor/нал: Нафига?

Обнаружил в коде прекрасное:

[% FILTER replace('\n', '<br>') %][% FILTER replace('<', '\<') %][% FILTER replace('>', '\>') %][% notice.body %][% END %][% END %][% END %]

заменил на:

[% notice.body | html | html_line_break %]

Интересно, в

ru_perlfuck примеры на Template::Toolkit принимают?

18:51

Блог Сказкина: Новый логин Вконтакте — Perl, Curl

Собственно, уже не мудрствуя лукаво — кто хоть немного знает перл — разберётся.

Вконтакте добавили редиректики, что не помешает доблестному Curl через них пройти и получить куку в файл.

#!/usr/bin/perl -w
use strict;
use WWW::Curl::Easy;
use Carp;

sub getURL {
  my $params = shift;

  croak q[HASH needed as param] if ref ($params) ne 'HASH';
  croak q[HREF needed in HASH] if (!exists ($params->{href}));

  $params->{href} = q[http://].$params->{href} if $params->{href} !~ /^http (s)?:\/\//;

  my $result = 'false';
  open my $oldout, «>&STDOUT» or die «Can't dup STDOUT: $!»;

  close STDOUT;
  open STDOUT, «> /dev/null»;
  my $retcode;

  my $curl;
  {
    $curl = new WWW::Curl::Easy;
    $curl->setopt (CURLOPT_URL, $params->{href});
    $curl->setopt (CURLOPT_USERAGENT,q[q[Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2) Gecko/20100115 Firefox/3.6]]);
    $curl->setopt (CURLOPT_POST,1) if $params->{post};
    $curl->setopt (CURLOPT_POSTFIELDS,$params->{post}) if $params->{post};
    $curl->setopt (CURLOPT_COOKIEJAR, $params->{cookie_file}) if $params->{cookie_file};
    $curl->setopt (CURLOPT_COOKIEFILE, $params->{cookie_file}) if $params->{cookie_file};
    $curl->setopt (CURLOPT_FOLLOWLOCATION,1);
    open (my $tmp_for_curl, ">", \$result);
    $curl->setopt (CURLOPT_FILE,$tmp_for_curl);
    $retcode = $curl->perform;
  }

  close STDOUT;
  open STDOUT, «>&», $oldout or die «Can't dup \$oldout: $!»;

  return {
        content         => $result,
        retcode         => $retcode,
        http_code        => $curl->getinfo (CURLINFO_HTTP_CODE),
        effective_url      => $curl->getinfo (CURLINFO_EFFECTIVE_URL),
        content_type      => $curl->getinfo (CURLINFO_CONTENT_TYPE)
      };
}

my $login     =  q[your@email];
my $password    =  q[password];
my $cookie_file  =  q[./cookie_file]
$login       =~ s/@/%40/;
my $result     =  getURL ({
                href => q[http://vkontakte.ru/login.php],
                post => qq[op=>a_login_attempt&email=$login&pass=$password&expire=0],
                cookie_file => $cookie_file
            });

Написал Andrew Skazkin в 13:37

Хабрахабр: Метки / perl: Великий Язык PERL! / Необычный оператор диапазона

Должен предупредить, что это ещё одна статья, не содержащая никаких откровений. Для тех супер-гиков, которые назубок знают весь perldoc, она будет абсолютно бесполезной, так что, уважаемые супер-гики, можете проходить мимо и не информировать, что всё это есть в доках. Я и так это знаю. :-) Моя статья для всех остальных, для тех, кто весь perldoc целиком либо не осилил, либо осилил, но не понял, либо понял, но не запомнил.

Я думаю, многие знают о так называемом операторе диапазона, записывающемся как .. (две точки), с помощью которого можно быстро создавать массивы из набора последовательных элементов. Например, следующий код создаёт массив из 35 чисел: 3, 4, 5, …, 37:

my @arr = 3 .. 37;

Помимо чисел можно использовать строки: в этом случае для генерации элементов массива будет выполняться так называемый магический инкремент (например, можно задать диапазон букв: 'a' .. 'z').

Однако оператор диапазона может использоваться и в скалярном контексте, принимая в качестве операндов булевские выражения и возвращая булевский результат. И вот здесь начинается самое интересное, потому что это оператор с состоянием: результат операции будет зависеть не только от значений левого и правого операндов, но ещё и от истории вызовов данного выражения!

Читать дальше →

Написал CaptainFlint в 13:36

Блог Сказкина: Любимая функция для получения контента

Таскаю за собой по всем модулям и скриптам.

sub getURL {
  my $params = shift;

  croak q[HASH needed as param] if ref ($params) ne 'HASH';

  croak q[HREF needed in HASH] if (!exists ($params->{href}));

  $params->{href} = q[http://].$params->{href} if $params->{href} !~ /^http (s)?:\/\//;
  $params->{headers} = 0 if !$params->{headers};
  $params->{ag} = qq ($user_agents[rand(($#user_agents+1))]) if !exists $params->{ag};
  $params->{timeout} = 20 if !exists $params->{timeout};
  $params->{content_length} = 600000000 if !exists $params->{content_length};

  my $result = 'false';
  open my $oldout, «>&STDOUT» or die «Can't dup STDOUT: $!»;

  close STDOUT;
  open STDOUT, «> /dev/null»;
  my $retcode;

  my $curl;
  {
    $curl = new WWW::Curl::Easy;

    $curl->setopt (CURLOPT_URL, $params->{href});
    $curl->setopt (CURLOPT_INTERFACE, $params->{ip}) if exists $params->{ip};
    $curl->setopt (CURLOPT_CONNECTTIMEOUT,$params->{timeout});
    $curl->setopt (CURLOPT_TIMEOUT,$params->{timeout});
    $curl->setopt (CURLOPT_NOPROGRESS, 0);
    $curl->setopt (CURLOPT_PROGRESSFUNCTION, sub {$_[2]>$params->{content_length}?1:0});
    $curl->setopt (CURLOPT_USERAGENT,$params->{ag});
    $curl->setopt (CURLOPT_POST,1) if $params->{post};
    $curl->setopt (CURLOPT_PROXY,$params->{proxy}) if $params->{proxy};
    $curl->setopt (CURLOPT_POSTFIELDS,$params->{post}) if $params->{post};
    $curl->setopt (CURLOPT_HEADER,$params->{headers});
    $curl->setopt (CURLOPT_COOKIE,$params->{cookie_string}) if $params->{cookie_string};
    $curl->setopt (CURLOPT_COOKIEJAR, $params->{cookie_file}) if $params->{cookie_file};
    $curl->setopt (CURLOPT_COOKIEFILE, $params->{cookie_file}) if $params->{cookie_file};
    $curl->setopt (CURLOPT_FOLLOWLOCATION,1);
    $curl->setopt (CURLOPT_REFERER,$params->{referer}) if exists $params->{referer};
    open (my $tmp_for_curl, ">", \$result);
    $curl->setopt (CURLOPT_FILE,$tmp_for_curl);
    $retcode = $curl->perform;
  }

  close STDOUT;
  open STDOUT, «>&», $oldout or die «Can't dup \$oldout: $!»;

  return {
        content         => $result,
        retcode         => $retcode,
        http_code        => $curl->getinfo (CURLINFO_HTTP_CODE),
        effective_url      => $curl->getinfo (CURLINFO_EFFECTIVE_URL),
        content_type      => $curl->getinfo (CURLINFO_CONTENT_TYPE)
      };
}

Написал Andrew Skazkin в 13:27

Shoor/нал: Что это?!

Это я такое написал? Проще уж на обычном SQL писать...

$c->stash->{'checkpoints'} = [
    $c->model($MODEL)->search(
        {
            'stgroup_id.id'           => $student->stgroup_id->id,
            'checkresults.student_id' => [ $student->id, undef ],
        },
        {
            'select'   => [ \'me.name cpname', qw/me.id me.date max_ball/ ],
            'join'      => [
                'checkresults', {
                    'tss_id' => [
                        qw/stgroup_id subject_id/,
                        { 'teacher_id' => 'user_id' }
                    ],
                }
            ],
            '+columns'  => [
                qw/subject_id.name checkresults.ball/,
                qw/user_id.fname user_id.sname user_id.lname/,
            ],
#             '+as'       => [ qw/subject_name ball/ ],
            'order_by'  => [ qw/date/ ],
        },
    )
];

12:42

On Perl — блог о языке программирования Perl и его сообществе: Perl 5.10 в 2010-м — первая часть части III

Часть III
Как пишут другие

В этом разделе собраны и сгруппированы примеры использования новых возможностей Perl 5.10, которые встречаются в модулях на CPAN.

Как включить режим Perl 5.10

Поскольку новые ключевые слова могут сделать программу несовместимой с предыдущими версиями компилятора, необходимо дать явные указания, чтобы активировать соответствующие фичи Perl 5.10.

Cпособы, которыми пользуются авторы, как нельзя лучше демоснтрируют принцип TIMTOWTDI:

use 5.010000;
use 5.01001;
use 5.010;
use 5.010_000;
use 5.10.0;
use v5.10.0;
use v5.10;
use feature ':5.10';

Строки, начинающиеся с буквы v, либо содержащие две точки, называются v-string (version string или, иногда, vector string). При объявлении версии интерпретатора следущие варианты эквивалентны.

5.10.0
v5.10.0
v5.10

Обратите внимание, если при указании версии используется обычное число (с одной десятичной точкой), то следует писать не 5.10, а 5.010.

say для отладки

Функцию say удобно использовать во время отладки программы для вывода промежуточных значений переменных. На CPAN можно найти следы такой отладки — закомментированный вызов say.

given ($action) {
    when (/^include_cmd:/) {
        my $cmd = $child->content;
        $cmd =~ /^include_cmd:(\s*)/;
        my $ws = $1 || '';
        $cmd =~ s/^include_cmd:\s*//;
        #say("cmd:$ws$cmd");
        $cmd = cwd() . '/' . $cmd;
        @output = qx($cmd);
        $child->content($ws . join($ws, @output));
    }

Pod::Elemental::Transformer::Include — 08 Jan 2010
include output via files and commands

(Здесь и далее рядом с примером кода указано название модуля, откуда взят пример, дата выхода его первой версии и авторское описание; пунктуация, отступы и пробелы в коде в большинстве случаев сохранены.)

// и //= для значений по умолчанию

Пожалуй, самое распространенное применение оператора defined-or — установка значений по умолчанию.

В частности, удобно пользоваться вариантом с присвоением.

$port //=  5432;
$host //= 'localhost';



$col  //= '';

Pg::Loader — 07 Jul 2008
Perl extension for loading Postgres tables

$attrz{ maxjob  } //= 1;
$value //= 1;



$attrz{ $_ } //= 0;
$attrz{ verbose } //= '';
$attrz{ debug   } //= '';
$val //= 1;
$exit //= 0;
$skipz->{ $job_id } //= 'Skip on SIGHUP'

Parallel::Depend — 12 Aug 2009
Parallel-dependent dispatch of perl or shell code

Чуть более сложный пример — с обращением к встроенной функции:

sub import   {
    shift;
    my %args = @_;
    # we do not care about autoviv
    $^H{fixedtime} = $args{epoch_offset} // 
                     CORE::time;
}

fixedtime — 14 Aug 2008
lexical pragma to fix the epoch offset for time related functions

Defined-or используют и непосредственно при передаче аргументов функциям.

say $answer //      "I don't know enough to answer you yet.";

Hailo — 29 Jan 2010
A pluggable Markov engine analogous to MegaHAL

Следует обратить внимание, что оператор возможно использовать не только с истинными скалярами.

my $marpa_version  =  $Parse::Marpa::VERSION // 'undef';
my $source_version =  $Parse::Marpa::Source::VERSION // 'undef';



$options //= {};

Parse::Marpa — 14 Dec 2008
Generate Parsers from any BNF grammar

В следующем примере помимо многократного использования // интересно отметить, что say передается файловый дескриптор.

my $nulling_symbol =
  $rhs_symbol->[Parse::Marpa::Internal::Symbol::NULL_ALIAS] // $rhs_symbol;



$action //= $default_action;



say {$trace_fh}
    'Problems compiling action for original rule: ',
    Parse::Marpa::brief_original_rule($rule);



my $clone = $clone_arg // 1;
my $current_parse_set = $parse_set_arg // $default_parse_set;



$choice //= 0;



$lines //= [0];
$source_options //= {};

Parse::Marpa::Internal::Evaluator — 14 Dec 2008
Generate Parsers from any BNF grammar

Наконец, и сам файловый дескриптор удобно вписывается в работу с defined-or:

my $trace_fh = $arg_trace_fh // (*STDERR);



my $trace_fh = shift;
$trace_fh //= *STDERR;

Parse::Marpa::Recognizer — 14 Dec 2008
Generate Parsers from any BNF grammar

// внутри return

Оператор defined-or часто встречается внутри вызова return, опять же чтобы вернуть определенное значение, если оно не получено на предыдущих шагах.

return $self->_get_infection( $disease->id ) // 0;



my $val = $self->_get($key) // $default->{$key};



return @{ $self->_players // [] };

Games::Pandemic::City, Games::Pandemic::Config — 07 Sep 2009
Games::Risk — 18 Oct 2008

Иногда в одном из операндов // вызывают фукнции, которые могут привести к досрочному завершению программы или выходу из блока.

sub homedir {
  my ($self) = @_;
  require File::HomeDir;
  return File::HomeDir->my_home
    // croak 'File::HomeDir says you have no home
              directory';
}