И второе. Test::Pod::Coverage::Permissive. Принцип работы такой же, как и у Test::Pod::Coverage, только тесты валятся лишь в том случае, если появилась ещё одна не­за­до­ку­мен­ти­ро­ван­ная фунция.
Т.е. при первом запуске у вас тесты пройдут в любом случае. Задокументируете функцию — тесты пройдут. Напишете ещё одну незадокументированную функцию — обвалятся.

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

К чему это я — пользуйтесь и пишите баги.

Создаёт порт из перлового модуля и отправляет его разработчикам FreeBSD.

Как работать:

pm2port CSS::Croco

Тестируем и находим баги.

Начинаем работу

Итак, что же нам даёт строчкa “use Moose”?

Во-первых она включает “use strict” и “use warnings”, потому что программа на Perl без этих директив заслуженно считается гавном.

Во-вторых – добавляет в тело пакета несколько ключевых слов, о которых я напишу чуть позже.

Атрибуты

Думаю, все знакомы с объектной системой Perl. Чтобы указатель превратился в объект, его нужно благословить (bless). Все аттрибуты являются ключами хэша, а валидации нет и в помине. Moose прячет от вас все эти хитрые подробности и позволяет работать с объектами примерно так же, как это делается в C# и Ruby.

Для начала давайте напишем простой класс без Moose, а потом с его помощью:

#Без Moose
package MyRecordsCache;
use warnings;
use strict;
use Scalar::Util qw(looks_like_number);
 
sub new {
  my $class = shift;
  my $args = shift;
  $args{cache_size} //= 0;
  if ( ref $args->{cache_size} || int( $args->{cache_size} ) != $args->{cache_size} ) {
    die "cache_size must be integer";
  }
  my $self = { %$args };
  bless $class, $self;
  return $self;
}
 
sub cache_size {
  my $self = shift;
  $self->{cache_size};
}
1;

И версия с использованием Moose:

package MyRecordsCache;
use Moose;
has 'cache_size' => ( 
  is => 'ro', #только для чтения.
  isa => 'Int', #только целые числа
  default => 0, #по умолчанию будет 0
);
__PACKAGE__->meta->make_immutable;
1;

С Moose получилось очень мало кода, а в исходнике появилось новое ключевое слово – has. Именно этим ключевым словом мы и создаём аттрибут. О его параметрах будет рассказано ниже. Как вы могли заметить, метода new у нас нет – Moose создаст его автоматически.

Итак, мы описали целочисленный аттрибут только для чтения с дефолтным значением. Ничего сложного, ага?

Но это лишь базовые возможности has. Ниже будет небольшая докуметация по параметрам has, а потом рассмотрим пример посложнее.

Параметры ключевого слова has

is

Обязательный параметр – тип аттрибута. ‘rw’ или ‘ro’. read-only – изменение аттрибута невозможно. read-write – возможно как чтение, так и изменение объекта.

isa

Проверка устанавливаемых данных. Есть встроенный набор типов (Int, Bool, Str, Array, Array[Int],…), можно указать любой класс, либо создать свой тип с блекджеком и шлюхами. Тогда экземпляры этого класса и его наследников будут проходить валидацию.

required

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

default

Значение по умолчанию. Здесь может быть либо скаляр (не ссылка), либо анонимная функция, которая возвращает значение аттрибута. Это нужно для того, чтобы у каждого объекта была собственная копия значения. Вот что было бы без этого ограничения:

package A;
has 'attr' => ( is => 'rw', default=> { test => 1 } );
package main;
my $v1 = A->new;
my $v2 = A->new;
$v1->attr->{test} = 2;
print $v1->attr->{test} . "\n"; # получаем "2"
print $v2->attr->{test} . "\n"; # вернёт "2" а не "1"

clearer

Создаёт вспомогательный метод, который очищает значение аттрибута.

predicate

Создаёт вспомогательный метод, который возвращает истину, если аттрибут установлен.

Пример:

has 'owner' => ( 
  is => 'ro', 
  predicate => 'has_owner', 
  clearer => 'clear_owner' 
);
#затем
$obj->has_owner;#false
$obj->owner($owner);
$obj->has_owner;#true
$obj->owner(undef);
$obj->has_owner;# да-да, всё ещё true!
$obj->clear_owner;
$obj->has_owner; #ага, а вот сейчас false

Делегация методов

Делегация методов – это перекладывание задачи на другой класс. Или, если посмотреть с другой стороны, shortcut-ы. Пример делегации можно найти в LWP: В HTTP::Request есть метод headers, который возвращает класс HTTP::Headers. Но вместо $req->headers->header('Content-Type' => 'text/html') можно запросто написать $req->header('Content-Type' => 'text/html');
Если бы LWP писали на Moose, то реализация выглядела бы так:

  package HTTP::Message;
  has 'headers' => ( #создаём аттрибут headers
    is => 'rw',
    isa => 'HTTP::Headers',
    default => sub { HTTP::Headers->new },
    handles => { #и делегируем выполнение нескольких наших методов ему
      header => 'header',
      headers_as_string => 'as_string'
      ...
    }
  );
  package main;
  my $msg = LWP::Message->new();
  $msg->headers->header( Location => 'http://127.0.0.1' );
  $msg->header( Location => 'http://127.0.0.1' );
  $msg->header_as_string;

Согласитесь, это лучше семи (а там 7 методов делегируется) процедур по 3 строки.

Наследование

В общем про наследование я расскажу в следующей телепередаче, а пока только про аттрибуты. Если вы напишете так:

package A;
use Moose;
has attr => ( is => 'rw' );
package B;
use Moose;
extends 'A';
has attr => ( is => 'ro', default => 1 );

То Perl пошлёт вас в жопу аж два раза подряд. Во-первых, если вы хотите переопределить аттрибут, то вы должны это сказать явно:

has '+attr' => ( default => 1 )

А во-вторых переопределять можно не все свойства. А только эти:

• default
• coerce
• required
• documentation
• lazy
• isa
• handles
• builder
• metaclass
• traits

Сделано это для защиты от извращенцев. В свободное время я посоветовал бы вам подумать о том, что извращенцы могли натворить без этих ограничений.

Билдеры

Билдеры – методы, которые вызываются для установки значения по умолчанию для аттрибута.
Конечно, значение аттрибута по умолчанию, равное пяти, можно и установить с помощью ( default => 5 ). Но что если нужно что-либо посложнее?
Если нужно за этим значением сходить в базу, скачать файл, или позвонить бабушке в Крыжополь?
Вот для этого нам понадобятся билдеры.

has attr => (
 is => 'ro',
 isa => 'Str',
 builder => '_build_attr'
);
sub _build_attr {
  my $self = shift;
  $self->dbh->selectrow_array('SELECT data FROM table');
}

Метод _build_attr может быть не только в этом же классе, но и в наследниках, и в ролях. В любом случае, он вызовется при создании объекта и установит наш аттрибут.

Но если наш аттрибут никогда не получается, на кой чёрт мы должны звонить бабушке ходить в базу?

has attr => (
 is => 'ro',
 isa => 'Str',
 builder => '_build_attr',
 lazy_build => 1
);

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

1. выполнить запрос
2. дождаться ответа
3. продолжить выполнение

Но пока работает длинный запрос, мы в приложении можем выполнить что-то полезное. Не простаивать же процессорному времени.

Для PostgreSQL в DBD::Pg есть некоторое подобие асинхронности. И иногда оно таки нам помогает.

Вы можете продолжить выполнять приложение, не дожидаясь выполнения запроса. Включается это параметром pg_async к prepare-запросу:

  use strict;
  use warnings;
  use Time::HiRes 'sleep';
  use DBD::Pg ':async';
 
  my $dbh = DBI->connect('dbi:Pg:dbname=postgres', 'postgres', '', {AutoCommit=>0,RaiseError=>1});
 
  ## Запустить длинный запрос
  my $sth = $dbh->prepare("SELECT pg_sleep(5)", {pg_async => PG_ASYNC});
  $sth->execute(5);
 
  ## Пока работает, мы можем что-то сделать
  print "Your query is processing. Thanks for waiting\n";
  check_on_the_kids();
 
  while (!$dbh->pg_ready) {
    check_on_the_kids();
    ## и подождём чуть-чуть
    sleep 0.1;
  }
 
  print "The query has finished. Gathering results\n";
  my $result = $sth->pg_result;
  print "Result: $result\n";
  my $info = $sth->fetchall_arrayref();

Для pg_async есть три константы:

• PG_ASYNC – выполнение запроса в асинхронном режиме
• PG_OLDQUERY_CANCEL – если в этот момент работал предыдущий запроса, то он отменяется
• PG_OLDQUERY_WAIT – блокируемся для ожидания предыдущего запроса и только потом начинаем выполнять новый

Так же есть три вспомогательных метода -
pg_cancel – отменить запрос. Реально открывается ещё одно соединение, в котором посылается SELECT pg_cancel_backend(?);
pg_ready – возвращает true, если запрос выполнился.
pg_result – блокируется до момента выполнения запроса, после чего возвращает то же, что и ->execute в стандартном режиме.

Из минусов – нельзя установить callback на момент исполнения запроса. Нужно постоянно проверять.
Так же в один момент времени в одном соединением можно выполнять только один запрос. Но что мешает открыть десяток соединений и по очереди посылать в них запросы?)

Попробую рассказать о применениях этой технологии:

• тяжёлые запросы + сложная логика. Равномерно загружаем свой сервер и сервер БД.

  while (){
  my $foo = compute_foo();#тяжёлая функция
  #блокируемся до тех пор, пока не выполнится предыдущий
  $dbh->do('UPDATE stats SET foo=foo+1', { pg_async => PG_ASYNC + PG_OLDQUERY_WAIT });
  }

• работа с несколькими серверами БД

  $first_dbh->do('DELETE FROM old_data', { pg_async => PG_ASYNC });
  $second_dbh->do('UPDATE new_data SET status=0', { pg_async => PG_ASYNC })

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

DBI_PROFILE=1 perl test.pl
DBI::Profile: 27.088730s 58.89% (52900 calls) test.pl @ 2009-07-08 23:08:39

Как видите, он краток. А кратк. сестр. тал. Он показывает, стоит ли нам вообще оптимизировать SQL.
он говорит, что на базу потрачено 60% времени.
Если нужно оптимизировать базу, то запускаем скрипт с DBI_PROFILE=2
Тогда нам покажется подробный отчёт о времени, затраченном на каждый тип запроса.

Изменений просто дохрена:

1. Первое и главное. Catalyst переписали на Moose. Теперь он будет есть не 80Мб, а 200Мб (:
2. Избавились к чертям от тормоза NEXT, который ещё и работает через задницу
3. Проапгрейдили Catalyst::Log, поправили баги и…
4. всё

Обещаю, что если вы не полный распиздяй, и не вставляли костылей в сам Catalyst, то переезд на Catamoose больше минуты не займёт. А вот размер проекта в памяти вырос на 19Мб.

Но что, если нам его недостаточно? Посмотрим, что нам даёт DBIx::Class. А даёт он нам класс DBIx::Class::Storage::Statistics.
Методы этого класса вызываются до и после каждого запроса, либо транзакции.

Попробуем после каждого запроса выводить время, которое он исполнялся. Это описано в DBIx::Class::Manual::Cookbook.

Добавляем схему:

  __PACKAGE__->storage->debugobj(new My::Profiler());
  __PACKAGE__->storage->debug(1);

И создаём модуль:

  package My::Profiler;
  use strict;
 
  use base 'DBIx::Class::Storage::Statistics';
 
  use Time::HiRes qw(time);
 
  my $start;
 
  sub query_start {
    my $self = shift();
    my $sql = shift();
    my $params = @_;
 
    $self->print("Executing $sql: ".join(', ', @params)."\n");
    $start = time();
  }
 
  sub query_end {
    my $self = shift();
    my $sql = shift();
    my @params = @_;
 
    my $elapsed = sprintf("%0.4f", time() - $start);
    $self->print("Execution took $elapsed seconds.\n");
    $start = undef;
  }
 
  1;

Отлично. Сейчас после каждого запроса пишется время выполнения. Если мы в My::Profile::print мы заменим print на carp, то после каждого SQL-запроса мы получим место его выполнения.

Но время выполнения запроса – это средняя температура по больнице, потому что может быть много быстрых запросов. Хотелось бы получить более красивую статистику. И она есть – DBIx::Class::QueryLog

Этот модуль сохраняет статистику по каждому выполненному запросу, группирует одинаковые запросы и сортирует по суммарному времени выполнения. Как им пользоваться – написано в документации. Свою задачу – ткнуть Вас носом в интересную фичу DBIx::Class – я выполнил.
Удачной Вам разработки.

Привет! Это не спам

Я включил вас в список русских CPAN-авторов (Acme::CPANAuthors::Russian), т.к. вы очень похоже на русских )))
Если я ошибся и вы не хотите находится в этом списке, дайте мне знать.

Спасибо!

use Perl or die;

Так приятно видеть в этом списке аццкое количество сотрудников Рамблера

use feature 'say';
say scalar(localtime(1234567890))

Sat Feb 14 02:31:30 2009

Псевдокод

Когда вам нужно создать метод, не нужно торопиться и писать кучу кода. Попробуйте начать работать по такой схеме:

• Обдумайте назначение метода, его название, параметры и то, что он будет возвращать
• Напишите к нему документацию
• Создайте каркас метода.
• В этот каркас на РОДНОМ для вас языке наиболее детально опишите то, что делает этот метод. Это описание должно отвечать на вопрос “Что делает этот метод?” а не “Каким образом?”. Например:
  • проверяем параметры
    • если нет логина или пароля, то выходим
  • получаем из базы пользователя с таким логином
    • если пользователь не найден, по выходим
  • …
• После этого превращаем это описание в комментарии
• И в соответствии с этими комментариями пишем код метода

То что получилось бы, если бы я писал такой метод:

=head2 authenticate_user( login => $login, password => $password )
 
Авторизация пользователя. Возвращает 1 в случае успеха.
 
=cut
 
sub authenticate_user {
    my $self = shift;
#проверяем параметры
    my %params = validate( login => { type => SCALAR }, password => { type => SCALAR } );
#если нет логина или пароля, то выходим
    if ( ! $params{ login } || ! $params{ password } ) {
         return;
    }
#получаем из базы пользователя с таким логином
    my $user = Database->;instance->get_user( @params{ qw/login password/ } );
#...
}

Итого: мы получаем грамотный изначально документированный код

OFFTOPIC: я спать. обещаю прийти на работу пораньше.