Recently in perl Category

Как известно, этот модуль хранит сессии в текстовых полях в base64(nfreeze($data)), что является явно избыточным, т.к. можно юзать только Storable и blob для хранения. Поэтому - небольшой тестик:

nfreeze: time: 331 sec; speed: 3021 req/sec
thaw:    time: 213 sec; speed: 4694 req/sec
encode_base64: time: 67 sec; speed: 14925 req/sec
decode_base64: time: 116 sec; speed: 8620 req/sec
STORE: time: 399 sec; speed: 2506 req/sec
GET:   time: 328 sec; speed: 3048 req/sec

В тесте разложены методы MIME::Base64 и Storable, а также - всё вместе.

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

Собсно профайлингом занималсо, заодно YAML затестил, скорость Load и Dump разных модулей.

Вот результаты:

YAML::Load:       time: 361 sec; speed:   277 req/sec
YAML::Dump:       time: 203 sec; speed:   492 req/sec
YAML::Syck::Load: time: 130 sec; speed:  7692 req/sec
YAML::Syck::Dump: time:  86 sec; speed: 11627 req/sec
YAML::XS::Load:   time: 124 sec; speed:  8064 req/sec
YAML::XS::Dump:   time: 118 sec; speed:  8474 req/sec

Для pureperl - 100к циклов, для остального - 1кк.

Кстати, у YAML::XS::Load утечки памяти сильные, по крайней мере на freebsd (7.2 и 8.0, i386 и amd64 соответственно). За лям итераций съело 1G оперативы.

Вопреки стереотипам, YAML::Syck показал бОльшую производительность, чем YAML::XS. Плюс последний течет :) Ну а про pure perl вообще сказать нечего. Работает стабильно, но меееееееедленно.

$c->forward() возвращает только истину. Истину в последней инстанции :)

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

Массивы и хеши тоже нельзя возвращать. Т.к. получите последний элемент массива. Ссылки на них - пожалуйста. Ибо ссылка на массив истинна, даже если массив пустой.

Вот собственно и всё :) Теперь чуток примерчиков для наглядности:

sub t_zero   { 0           };
sub t_empty  { ""          };
sub t_undef  { undef       };
sub t_arr    { qw/a b c/   };
sub t_scalar { "ok"        };
sub t_arref  { [qw/a b c/] };
sub t_hashref{ {}          };

sub test {
    my ( $self, $c ) = @_;
    $c->forward('t_zero');    # 0
    $c->forward('t_empty');   # 0
    $c->forward('t_undef');   # 0
    $c->forward('t_arr');     # 'c'
    $c->forward('t_scalar');  # 'ok'
    $c->forward('t_arref');   # ['a', 'b', 'c']
    $c->forward('t_hashref'); # {}
};

Дано:

Массив длиной L, каждый элемент массива имеет вес weight (для простоты - целочисленный)

Задача:

Выбрать рандомно N элементов из массива (N < L), при этом не должно быть одинаковых элементов, и вероятность выборки каждого элемента должна быть прямо пропорциональна весу элемента.

Решение:

Разместим элементы массива на оси весов, при этом длина отрезка каждого элемента равна весу этого элемента.
Посчитаем суммарный вес элементов - это максимально возможная координата.

Теперь итерируем массив от начала (столько итераций, сколько нужно выбрать элементов). На каждой итерации:

• Выбираем рандомно точку от 1 до макс. координаты $weight
• Ищем элемент, соответствующий отрезку, содержащему эту точку
• Меняем местами выбранный элемент с элементом, соответствующем текущей итерации - т.о. "запоминаем" его.
• Сдвигаем начало координат (и соотв. макс. координату) на величину, равную длине отрезка выбранного элемента

Всё. Теперь N начальных элементов - и есть интересующая нас выборка. Осталось только отбросить лишнюю часть массива от N+1 до L

# @res - исходный массив
# $need_count - сколько нужно выбрать элементов
# $weight - суммарный вес всех элементов исходного массива

for (my $i=0; $i<$need_count; $i++) {
    my $w = int(rand $weight)+1; # выбираем точку на оси весов
    for (my $j=$i; $j<=$#res; $j++) { # ищем элемент, соотв. точке
        if ($res[$j]->{weight} >= $w) {
            $weight -= $res[$j]->{weight};
            ($res[$i], $res[$j]) = ($res[$j], $res[$i]) if $i != $j;
            last;
        } else {
            $w -= $res[$j]->{weight};
        }
    }
}
@res = splice(@res,0,$need_count); # обрезаем массив

Начиная с версии 4.007 сломали $dbh->{mysql_auto_reconnect}=1

В результате при потере коннекта к мускулю вместо реконнекта происходит сегфолт перла. Оч. неприятная штука :)

В версии 4.008 так и не пофиксили, хотя с ней в один день выпустили патч.

Маленький perl-модуль к nginx-у, который "склеивает" www.domain -> domain и наоборот (т.е. на каждый урл выдает соотв. 301-редирект, плюс robots.txt для яндекса).

Прелесть в том, что не нужно описывать директиву server для каждого домена. Достаточно все домены - неосновные зеркала запихнуть в один server (поштучно или маской/регэкспом) и вообщем-то всё. Если домен с www, значит основным зеркалом считается без www, и наоборот.

А вообще это делается как-то так:

server {
    server_name все_неосновные_зеркала_поштучно_или_маской;
    if ($host ~ ^www\.(.+)$) {
        set $h $1;
        rewrite ^(.*)$ http://$h$1 permanent;
        break;
    }
    rewrite ^(.*)$ http://www.$host$1 permanent;
}

Но тут не будет генериться robots.txt

Сабж. Эвристический анализатор, очень хороший :) Несмотря на то, что был написан полтора года назад, до сих пор исправно и качественно работает.

Понимает все кодировки, в том числе двойной quoted-printable, utf16-be и т.п. Если бы данные кодировки не юзались где-то, я бы не стал делать их поддержку :) При разработке через анализатор было пропущено 1.5 ляма реальных рефов, далее он был доработан, чтобы понимать те рефы, которые он не понимал.

За давностью лет его КПД я, к сожалению, не помню, но точно больше 99.9%, что для эвристики - очень и очень гуд. Плюс, он работает довольно быстро.

Referrer.pm.tar.gz

Модуль экспортирует единственную функцию analyze()
Использование:
my ($se, $kw) = analyze($ref);
$ref - исходный реферрер (без эскейпа, т.е. в том виде как он пришел из заголовка)
$se - поисковик (hardcoded в @cfg_se, для незнакомых возвращает 'other')
$kw - распознанный кейворд (в кодировке cp1251).

Также может вернуть undef, если реферрер битый (нельзя выпарсить домен, или протокол отличен от http(s)

Прошлой зимой нужно было ограничить скорость отдачи контента для ботов, т.к. они "валили" бэкенды, особенно ночью и особенно яндекс :)

При этом имелось несколько бэкендов, и хотелось их ограничивать "по-разному", или не ограничивать вовсе, в зависимости от текущей нагрузки.

Вообщем в итоге родилось следующее решение:

• Некий демон с определенным интервалом парсит команду "netstat -Lan", и определяет загруженность бэкендов по величине backlog. Далее смотрит текущий limit_rate для каждого из бэкендов в кеше на базе Cache::FastMmap, и понижает/повышает его, если надо.
• Хендлер для nginx-а определяет ботов по юзер-агенту, и если пришел бот - вытаскивает из кеша текущий limit_rate для бэкенда.

Архив с демоном, хендлером и примером конфига для nginx: nx_limitrate.tgz

Писалось всё исключительно для себя и быстро, поэтому абсолютно всё захардкодено, т.ч. претензии по этому поводу не принимаю :) Впрочем, код очень маленький и интуитивно понятный. А если нет - то велкам :)

Просто чтоб не забыть :) сцылко