varnie

My next JAPH

2013-06-19T00:00:00+00:00

Написал еще один незамысловатый JAPH. Сначала покажу итоговую версию:

use strict;
 use warnings;
  my$k='my@a=((-4
   ,26,10,-4,-104,-
    56,-61,-79,-94,-
     127,-152,-162,-
      268,-245,-250,-
       264,-298,-403,-
        361,-399,-429,-
         454,-494,-516),
          @_);join"",map{
           chr$a[$_]+$a[$_+
            $#a/2+1]}0..$#a/2
             ';foreach(reverse(
               12..35)){$k="sub
                {$k}->(\@_,int 
                 map{(int)x\$_}(
                  1..$_))"}print
                   eval $k;

Можно было бы даже сократить немного код, убрав прагмы strict и warnings, но я сторонник чистоты кода и отсутствия ошибок. Теперь то же самое, только в ужатом виде:

#!/usr/bin/perl

use strict;
use warnings;

my$k='my @a = ((-4, 26, 10, -4, -104, -56, -61, -79, -94, -127, -152, -162, -268, -245, -250, -264, -298, -403, -361, -399, -429, -454, -494, -516), @_);
join "", map{ chr $a[$_] + $a[$_+$#a/2+1] } 0..$#a/2';

foreach (reverse (12..35)) {
    $k = "sub{$k}->(\@_,int map{(int)x\$_}(1..$_))"
}

print eval $k;

Как работает код? Код генерит длиннющую строку с кодом, которой потом делается eval и print собственно результата. Весь финт в генерации этой строки-кода. О ней и поговорим ниже. Т.е. по сути в результате у нас будет такая вот красота:

use strict;
use warnings;

print sub{
    sub{
        sub{
            sub{
                sub{               
                    sub{                       
                        sub{                          
                            sub{
                                sub{
                                    sub{
                                        sub{
                                            sub{
                                                sub{
                                                    sub{
                                                        sub{
                                                            sub{
                                                                sub{
                                                                    sub{
                                                                        sub{    
                                                                            sub{ 
                                                                                 sub{ 
                                                                                    sub{ 
                                                                                        sub{ 
                                                                                           sub{ 

    my (@a) = ((-4, 26, 10, -4, -104, -56, -61, -79, -94, -127, -152, -162, -268, -245, -250, -264, -298, -403, -361, -399, -429, -454, -494, -516), @_);
    print join "", map{ chr $a[$_] + $a[$_+$#a/2+1] } 0..$#a/2
                                                                                            }->(@_, int map{(int) x$_} (1..35)) 
                                                                                        }->(@_, int map{(int) x$_} (1..34)) 
                                                                                    }->(@_, int map{(int) x$_} (1..33)) 
                                                                                }->(@_, int map{(int) x$_} (1..32)) 
                                                                            }->(@_, int map{(int) x$_} (1..31)) 
                                                                        }->(@_, int map{(int) x$_} (1..30)) 
                                                                    }->(@_, int map{(int) x$_} (1..29)) 
                                                                }->(@_, int map{(int) x$_} (1..28)) 
                                                            }->(@_, int map{(int) x$_} (1..27)) 
                                                        }->(@_, int map{(int) x$_} (1..26)) 
                                                    }->(@_, int map{(int) x$_} (1..25)) 
                                                }->(@_, int map{(int) x$_} (1..24)) 
                                            }->(@_, int map{(int) x$_} (1..23)) 
                                        }->(@_, int map{(int) x$_} (1..22)) 
                                    }->(@_, int map{(int) x$_} (1..21)) 
                                }->(@_, int map{(int) x$_} (1..20)) 
                            }->(@_, int map{(int) x$_} (1..19)) 
                        }->(@_, int map{(int) x$_} (1..18)) 
                    }->(@_, int map{(int) x$_} (1..17)) 
                }->(@_, int map{(int) x$_} (1..16)) 
            }->(@_, int map{(int) x$_} (1..15))
        }->(@_, int map{(int) x$_} (1..14))
    }->(@_, int map{(int) x$_} (1..13))
}->(int map{(int) x $_} (1..12))

Дальше уже проще, т.ч разбор полётов оставлю читателю.

WWW::Mechanize and keeping tracks of the performed requests

2013-06-15T00:00:00+00:00

Столкнулся с проблемой при использовании WWW:Mechanize - после многократной отправки POST запросов с большими данными Perl падал с Out of memory. Вот этот очень простой пример:

#!/usr/bin/perl

use strict;
use warnings;
use WWW::Mechanize;
use 5.010;

$| = 1;

my $mech = WWW::Mechanize->new(autocheck => 1);

foreach (1..1000) {
    $mech->post('http://SOME_URL_HERE', [some_action => 'SOME_ACTION_HERE',  some_data => join ('', map { int rand 2} (0..63)) x (16*1024*50)]);
    say $mech->response->decoded_content;
}

То бишь, 1000 раз шлем POST запрос со строчкой-мусором длиной в 50 мегабайт. Жирная строчка, да, но не в этом вся соль. К примеру, на моей машине программка падала ближе к 50-ой итерации.

Нелогично и непонятно - по-хорошему память должна подчищаться после каждой итерации.

Первая мысль - на каждой итерации создавать новый инстанс WWW::Mechanize, но зачем городить огород? Давайте разберемся. На помощь придет хорошо всем знакомый Data::Dumper. Итак, дебажный код:

#!/usr/bin/perl

use strict;
use warnings;
use WWW::Mechanize;
use 5.010;
use Data::Dumper;

$| = 1;

my $mech = WWW::Mechanize->new(autocheck => 1);

foreach (1..1000) {
    $mech->post('http://SOME_URL_HERE', [some_action => 'SOME_ACTION_HERE',  some_data => join ('', map { int rand 2} (0..63)) x (16*1024*50)]);
    say Dumper($mech);
    say $mech->response->decoded_content;
}

Запускаем в консоле и наблюдаем: чем дальше в лес - тем толще партизаны, т.е. чем больше прогнано итераций в цикле, тем длиннее вывод генерит дампер:). Узкое место - поле “page_stack” (массив хранящий инфу о предыдущих прогнанных запросах)!!! Оно растёт с каждой новой итерацией.

Для нашего случая хранить эти данные абсолютно не нужно, поэтому идём на сайт WWW::Mechanize и читаем:

stack_depth => $value Sets the depth of the page stack that keeps track of all the downloaded pages. Default is effectively infinite stack size. If the stack is eating up your memory, then set this to a smaller number, say 5 or 10. Setting this to zero means Mech will keep no history.

Итоговый, рабочий вариант, который не жрёт память аки конь:

#!/usr/bin/perl

use strict;
use warnings;
use WWW::Mechanize;
use 5.010;

$| = 1;

my $mech = WWW::Mechanize->new(autocheck => 1);
$mech->stack_depth(0); #do not keep track of the performed requests!

foreach (1..1000) {
    $mech->post('http://SOME_URL_HERE', [some_action => 'SOME_ACTION_HERE',  some_data => join ('', map { int rand 2} (0..63)) x (16*1024*50)]);
    say $mech->response->decoded_content;
}

Мораль - читать доки об используемых либах.

A Befunge interpreter written in Perl

2013-02-17T00:00:00+00:00

Написал простейший интерпретатор эзотерического языка программирования Befunge. Код доступен на github: https://github.com/varnie/befunge.pl, поддерживающий спецификацию “Befunge-93” (т.е без всяких расширений синтаксиса, обрабатываются первые 80x25 символов исходного кода программок, итд).

Запускается следующим образом: <pre class="terminal"> chmod +x befunge.pl befunge.pl ./my_befunge_program.bf </pre>

Внимание, емкость стека никак не ограничена, а потому, упирается лишь в динамическую память, доступную для перла. Действует Перловый принцип - “нет никаких лимитов” (если перефразировать;)

jCarousel: No width/height set for items. This will cause an infinite loop. Aborting...: fix

2013-02-07T00:00:00+00:00

При использовании jQuery плагина jCarousel в IE8 (будь он проклят трижды) словил баг:

“Сообщение: jCarousel: No width/height set for items. This will cause an infinite loop. Aborting…”.

Несмотря на то, что закастомайзенный класс ul/li карусельки имел явно прописанные CSS-аттрибуты width и height, IE8 упорно делал вид что не видит их, отсюда и баг.

Кто натолкнулся на этот баг, вот готовое решение: наряду со своими кастом-стилями прописать дефолтный “.jcarousel-list li { height: 39px; width: 44px; }”, где значения, разумеется, должны быть вашими.

Надеюсь, кому-нибудь эта заметка пригодится.

Befunge: first steps

2013-01-18T00:00:00+00:00

Буду краток. Поковырялся с ужасным эзотерическим языком Befunge, в итоге разродился простой программкой, выводящей числа от 1 до 10 (да-да, это не так просто сделать, как кажется!). Фантастика, но это работает.

Программка:

1: v     : <

   5
   2
   *
   `
@  _ :.:1+ ^

Вывод: 1 2 3 4 5 6 7 8 9 10

>updated: Теперь перепишем то же самое, но немного усложним - величину, до которой выводить значения, будем запрашивать у юзера. Реализация:

&11p  1: v   :   <
         1
         1
         g
         
         `       
      @  _ :.:1+ ^

Вывод: Befunge-93 Interpreter/Debugger v2.23 20 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Т.е запросили выводить до 20; вывод корректный.

Теперь затрону такую офигенную фишку Befunge как возможность самомодификации, которая встроена в сам язык(!). Это реализуется командами p и g. Первая пушит в код программы по указанным на стеке координатам x и y ASCII значение (пример использования: “101p” - пишет ASCII символ, соответствующий единице по координатам x=0, y=1.). Вторая инструкция получает значение по координатам и пушит его на вершину стека.

А вот простенький пример самомодификации на Befunge:

52*5*80p1.@

Несмотря на то что в коде явно прописано вывести на экран 1, выведется 50. Разберем подробнее:

Сначала на стек ложится 5 и 2. Берутся эти числа, перемножаются, и результат ложится на вершину стека. Имеем 10.

На вершину стека ложится 5. Далее опять перемножение (уже 10 и 5), что дает 50; результат опять ложится на вершину стека. Имеем 50.

Далее на стек ложатся последовательно 8 и затем 0. Имеем 50, 8, 0.

Далее команда p пишет ASCII значение 50 (т.е двойку) на место инструкции с координатами (0,8) затирая собой находящуюся там единичку:)

Далее значение лежащее на стеке выводится на экран и программа завершает свою работу. В итоге выводится 2, а не 1!

Начало положено, далее что-нибудь еще напишу в свободное время.

My attempts at making Perl JAPHs

2012-12-29T00:00:00+00:00

Несколько JAPH моего производства. О том что это такое и для чего нужно можно прочесть в Википедии.

От простого до чуть посложнее:

#!/usr/bin/perl
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;print chr $,-2;
print chr $,-1;$,=0; $,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;print chr $,-12;print chr $,-15;print chr $,-2;$,=0; 
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;print chr $,-6;$,=0; 
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;print chr $,;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;print chr $,-7;print chr $,-5;
$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;print chr $,-6;$,+=()=//;$,+=()=//;$,+=()=//;$,+=()=//;
$,+=()=//;$,+=()=//;$,+=()=//;print chr $,;

Та же идея, но другая начинка:

#!/usr/bin/perl
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;print chr $x;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;print chr $x-2;
print chr $x-1;$x=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;print chr $x;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;print chr $x;print chr $x+1;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;print chr $x;$x=0;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;print chr $x;print chr $x-3;print chr $x+10;$x=0;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;print chr $x;print chr $x-6;$x=0;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;print chr $x-7;print chr $x-5;
$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;print chr $x-6;$x+=eval print;$x+=eval print;$x+=eval print;
$x+=eval print;$x+=eval print;$x+=eval print;$x+=eval print;print chr $x;

Это все громоздко и страшновато, поэтому напоследок кое-что покороче, для щекотания нервов:

#!/usr/bin/perl
my$h=0;print map{chr($_+ord(substr("perl"x6,$h++,1))-80)}<DATA>=~/../g;__DATA__
429681880076768384836786005967867611706967866786

С новым годом и хорошего кодинга.

Do it well or do not at all

2012-11-04T00:00:00+00:00

Делаешь сервис, где девяностовосемью процентами смысла является пост тех или иных данных через форму? -Проверь, что юзеру будет удобно: переходы между инпутами по табам, проставление чекбоксов кликом по лейблам, вывод внятных явных сообщений об ошибках заполнения данных; проверь, что тебя не заспаммят путем субмита формы элементарными ботами (сделай капчу, ограничение на пост по времени с одного IP, прочие блокировки) итд.

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

Подытожу: если делаешь что-то - делай это хорошо, либо не делай вовсе.

The nasty bug

2012-10-26T00:00:00+00:00

Пятница, поздний вечер. Все идет хорошо, ничто не предвещает беду. Внезапно Вам сообщают, что галерея на Вашем сайте не работает. Хотя ведь работала, черть подери!!! Судорожно смотришь в svn log, кто что делал за последние пол-дня. Хм, вроде бы чисто, никто не трогал галерею. Хотя…

В одном из базовых скриптов участвующих в формировании линков на AJAX-запросы для конкретной страницы видим:

switch ($alias) {
    //много много кейсов
    //...
    case 'galleryData':
        $link = '/gallery.php?action=galleryData';
    
    case 'fooBarCheck':
        $link = '/main/foobarcheck';
        break;

Кто-то похерил break у кейса ‘galleryData’ и теперь даже если $alias равен ‘galleryData’, исполнение пойдет далее и $link переприсвоится и станет ‘/main/foobarcheck’.

Повезло, что проблему так быстро выявили и пофиксили.

Занятно, что в новомодных языках, таких как Go эту проблему решили на корню: проход сквозь несколько веток свитча запрещен на уровне языка. Если же требуется такое поведение (что случается крайне редко), то нужно использовать ключевое слово fallthrough:

“In a switch statement, case labels do not fall through. You can make them fall through using the fallthrough keyword. This applies even to adjacent cases.”

В Perl же аналогичного поведения можно добиться используя явное указание ключевого слова next или же используя use Switch ‘fallthrough’;. Линк на доку.

Go language: reverse a singly linked list

2012-10-18T00:00:00+00:00

Стало интересно, как развернуть односвязный список на языке Go без использования дополнительных списков, работы с памятью итд.

Решением с радостью делюсь со всеми кому интересно.

package main

import "fmt"

type Item struct { 
    pNext *Item
    val rune
}

func createList() *Item {

    pHead := &Item{nil, 'a'}
    
    pCurr := pHead
    for i:= 'b'; i <= 'z'; i++ { 
        pItem := &Item{nil, i}       
        pCurr.pNext = pItem
        pCurr = pItem
    }
    
    return pHead
}

func printList(pList *Item) {

    pCurr := pList
    for {
        fmt.Printf("%c", pCurr.val)
        
        if pCurr.pNext != nil {
            pCurr = pCurr.pNext
        } else {
            break
        }
    }
    fmt.Println("")
}

func reverseList(pList *Item) *Item {
    
    pCurr := pList
    var pTop *Item = nil
    for {
        if pCurr == nil {
            break
        }
        pTemp := pCurr.pNext
        pCurr.pNext = pTop
        pTop = pCurr
        pCurr = pTemp        
    }
    
    return pTop
}

func main() {

    var pList = createList() 
    printList(pList)
    printList(reverseList(pList))
}

Вывод:

abcdefghijklmnopqrstuvwxyz zyxwvutsrqponmlkjihgfedcba

JavaScript: hiding class implementation

2012-10-16T00:00:00+00:00

Открыл для себя простой удобный способ спрятать реализацию класса в JavaScript. Сначала покажу код:

var myFooObj = (function(){

    var FooClass = function() {};
    FooClass.prototype = { 
        //some data
    };

    return new FooClass(); 
})();

Как видно, вся хитрость в самовызываемой анонимной функции. Никто не запретит передать в класс какие-либо данные для инициализации, например:

var myFooObj = (function(val){

    var FooClass = function() {}; 
    FooClass.prototype = { 
        value: val
    };

    return new FooClass(); 
})(43);

console.log(myFooObj.value); //43

Здесь уже сработает механизм замыканий.

Мы можем пойти дальше и реализовать наследование:

var myChildObj = (function(){

    var ParentClass = function() {}; 
    ParentClass.prototype = { 
        //some data
    };

    function extendsClass(childClass, parentClass, isRewrite) {
        for(var property in parentClass.prototype) {
            if (isRewrite || 
               (!isRewrite && 
                !isDefined(childClass.prototype[property]))) {                         
                childClass.prototype[property] = parentClass.prototype[property];
            }
        }

        childClass.prototype.parent =  parentClass.prototype;
    }

    var ChildClass = function() {}; 
    ChildClass.prototype = {
        //some data
    }

    extendsClass(ChildClass, ParentClass, false);
    return new PhotoGallerySingle(); 
})();

Проблема всплывает в случае если имплементации классов слишком большие. В этом случае по-просту будет неэстетично постить “жирные” имплементации в одну функцию, но все же, вариант рабочий.

PHP: странности

2012-10-14T00:00:00+00:00

Нашел интересный пост на stackoverflow касаемо т.н. “Branch prediction”. Примеры на С++, Яве, С#, Go есть, но захотелось потестить локально Perl, PHP и новый язык от компании Mozilla - Rust.

О них и поговорим ниже.

Первым идет переписка программы на Perl:

#!/usr/bin/perl
use strict;
use Modern::Perl;

my $array_size = 32768;
my @data;

#prepare data
for (my $c = 0; $c < $array_size; ++$c) {
    $data[$c] = int(rand(256)) + 1;
}
 
sub calc {
    my ($data_ref, $times) = (shift, shift);
    
    my $sum = 0;
    for (my $i = 0; $i < $times; ++$i) {
        for my $v (@$data_ref) {
            if ($v >= 128) {
                $sum += $v;
            }
        }
    }
    
    return $sum;
} 

say "estimate with not sorted array";
my $start = time();
my $result = calc(\@data, 100000);
my $elapsed = time() - $start;
say "sum: $result";
say "elapsed time: $elapsed seconds";


say "estimate with sorted array";
my @sorted_data = sort { $a <=> $b } @data;

$start = time();
$result = calc(\@sorted_data, 100000);
$elapsed = time() - $start;
say "sum: $result";
say "elapsed time: $elapsed seconds";

Ниже аналогично на PHP:

<?php

function calc(&$arr, $times) {

    $sum = 0;
    
    for ($i = 0; $i < $times; ++$i) {
        foreach ($arr as $v) {
            if ($v >= 128) {
                $sum += $v; 
            }
        } 
    }
    
    return $sum;
}

//prepare array
$array_size = 32768;
$data = array();

for ($c = 0; $c < $array_size; ++$c) {
    $data[] = rand(1, 256);
}

print "estimate with not sorted array\n";
$start = time();
$sum = calc($data, 100000);
$elapsed = time() - $start;
echo "elapsed time: " . $elapsed . " seconds\n";
echo "sum: " . $sum . "\n";

print "estimate with sorted array\n";
sort($data);
$start = time();
$sum = calc($data, 100000);
$elapsed = time() - $start;
echo "elapsed time: " . $elapsed . " seconds\n";
echo "sum: " . $sum . "\n";

и на закуску экзотика в лице языка Rust:

extern mod std;
use rand = core::rand;

fn calculate(d: &[int], iterations_cnt: uint) -> u64 {

    let mut sum: u64 = 0 as u64;
    
    for iterations_cnt.times  {
        for d.each |val| {                 
            if *val >= 128 {
                sum += *val as u64;
            } 
        }
    }
    
    return sum;
}

fn main() {

    //prepare data
    let array_size = 32768;
    let mut data: ~[int] = ~[];
    vec::reserve(&mut data, array_size);
    
    let r = rand::Rng();
    for array_size.times {
        data.push(r.gen_int_range(1, 256) + 1);
    }

    let iterations_count = 100000;

    io::println("estimate with not sorted array");
    let mut start = std::time::precise_time_s();
    let mut result = calculate(data, iterations_count);
    let mut stop = std::time::precise_time_s();
    io::println(u64::str(result));
    io::println(#fmt("elapsed time: %f ms", (stop - start) * 1000f));
    
    pure fn leual(a: &int, b: &int) -> bool { *a <= *b }
    let sorted_data = std::sort::merge_sort(leual, data);
    io::println("estimate with sorted array");
    start = std::time::precise_time_s();
    result = calculate(sorted_data, iterations_count);
    stop = std::time::precise_time_s();
    io::println(u64::str(result));
    io::println(#fmt("elapsed time: %f ms", (stop - start) * 1000f));
}

Также для полноты картины и для того, чтобы было с чем сравнивать, прогнал исходную программу на С++ у себя на компе. На моем Core2Duo E6600 2.4 GHZ и с 4 гигами оперативки имеем сл. результаты:

C++ (gcc version 4.4.5)

estimate with not sorted array

314931600000

elapsed time: 27.63 sec

estimate with sorted array

314931600000

elapsed time: 11.11 sec

Go (version go1)

estimate with not sorted array

317447800000

elapsed time: 24.855818 sec

estimate with sorted array

317447800000

elapsed time: 13.112228s

Rust (rustc 0.4 (39c0d35 2012-10-11 21:01:16 -0700))

estimate with not sorted array

321315600000

elapsed time: 360.734 ms

estimate with sorted array

321315600000

elapsed time: 356.501 ms

PHP (PHP 5.3.3-1ubuntu9.10 with Suhosin-Patch)

estimate with not sorted array

elapsed time: 1210 seconds

sum: 316930100000

estimate with sorted array

elapsed time: 1135 seconds

sum: 316930100000

Perl (v5.10.1)

estimate with not sorted array

sum: 317376400000

elapsed time: 553 seconds

estimate with sorted array

sum: 317376400000

elapsed time: 500 seconds

Поигрался с оптимизациями, в итоге результаты следующие:

C++ (gcc version 4.4.5, пример билдил с флагом -O3)

estimate with not sorted array

314931600000

elapsed time: 18.86 sec

estimate with sorted array

314931600000

elapsed time: 7.74 sec

Go (version go1, пример билдил с -gccgoflags ‘-O3’)

estimate with not sorted array

317447800000

elapsed time: 24.956293s

estimate with sorted array

317447800000

elapsed time: 13.127326s

Rust (rustc 0.4, пример билдил с флагом –opt-level=3 (39c0d35 2012-10-11 21:01:16 -0700))

estimate with not sorted array

320484300000

elapsed time: 20333.950295 ms

estimate with sorted array

320484300000

elapsed time: 7764.199734 ms

Результаты PHP выглядят просто ужасно, даже Perl его обгоняет.

perl: Goatse operator usage

2012-09-02T00:00:00+00:00

Велик язык Perl, велик настолько, что многое можно переписать десятком других способов. Собственно, потому и девиз Perl - TMTOWTDI. Например, ковыряя предыдущую программку на Перле, я обнаружил что одно действие можно переписать несколько иначе (надеюсь найти и др. способы со временем). Итак, вот этот кусок:

1 while (/\s/gp && $count++ < 4);

Как можно переписать:

my $count =()= /\s/gp;

Да, так называемый “goatse operator”. Не буду разглашать принцип его работы, т.к. мне самому доставило удовольствие разобраться с этим. Кому интересны подробности - можно почитать дискуссию на perlmonks.org Далее, кому интересны выкладки по перфомансу: дискуссия на StackOverflow.

perl: parsing timestamps

2012-08-22T00:00:00+00:00

На форуме RSDN набрел на следующую задачу:

Имеем лог с содержимым вида: * Aug 20 2012 11:00:39 fhfh * Aug 14 2012 12:39:27 bird * Apr 16 2012 3:16:0 cat

, где Aug 20 2012 11:00:39” - таймстамп, а “fhfh” - некие данные. Требуется написать perl программу, которая подсчитывает количество строк из лога, содержащих то или иное регулярное выражение за указанный промежуток времени в часах до текущего времени. Регулярное выражение и количество часов задается в аргументах программы.

#!/usr/bin/perl
use Modern::Perl;
use Time::Local qw(timelocal);
use Date::Parse qw(strptime);
use Scalar::Util::Numeric qw(isint);

#Please write a Perl script that will check a log file and count how many
#times a pattern appears within hh hours.
#For example...
#
#checklog.pl /home/saag/mylog.txt "created '\w[1-10]$" 48
#the file contains entries having the following format:
#Sep 11 2012 11:06:39 abc some text
if (@ARGV < 2) {
    die "Not enough arguments\n";
}

my ($regex_pattern, $hours_count) = splice(@ARGV, 0, 2);
my $regex = eval { qr/$regex_pattern/is };
if (!$regex) {
    die "malformed regex: $@";
}

if (!isint $hours_count) {
    die "malformed integer value for hours";
}

my $current_time = time();
my $from_time = $current_time - $hours_count * 60 * 60;

my $count_matched = 0;
while (<DATA>) {
    # take one input line at a time
    chomp;
    
    my $count = 0;
    1 while (/\s/gp && $count++ < 4);
    # modifier /p: Preserve the string matched such that ${^PREMATCH},
    # {$^MATCH}, and ${^POSTMATCH} are available for use after matching.

    if ($count == 4) {
        my ($date, $text) = (${^PREMATCH}, ${^POSTMATCH});
        
        my ($ss, $mm, $hh, $day, $month, $year, undef) = strptime($date);
        $year += 1900;
        my $time = timelocal($ss, $mm, $hh, $day, $month, $year);
        if ($time >= $from_time && $time < $current_time && $text =~ /$regex/) {
            say "found: `$_`";
            ++$count_matched;
        }
    }
}

say "total matches: $count_matched";
__DATA__
Aug 20 2012 11:00:39 fhfh
Aug 14 2012 12:39:27 bird
Apr 16 2012 3:16:0 cat
Nov 11 2012 18:25:56 dog
Jul 13 2012 12:9:46 fird
Jul 11 2012 23:43:24 bird
Feb 18 2012 1:48:34 fat
Nov 11 2012 10:22:50 fog
May 17 2012 10:42:17 fat
Aug 17 2012 10:13:18 fird
Jun 11 2012 20:15:50 fat
Oct 13 2012 16:37:23 fat
Jan 12 2012 23:35:19 cat
Nov 11 2012 21:39:44 dog
Sep 19 2012 22:16:50 dog
Aug 19 2012 11:00:39 fhfh
Jul 12 2012 14:31:35 cat
Apr 16 2012 14:41:39 dog
Oct 20 2012 3:40:12 bird
Jul 23 2012 3:25:35 bird
Oct 24 2012 16:18:5 cat

Вместо работы с логом из файла я переместил данные прямо в исходник, предварив их _DATA_, что очень удобно для демонстрации. Подробнее об этой фиче можно почитать, обратившись к perldoc perldata.

Learning perl: regular expressions

2012-08-15T00:00:00+00:00

Неторопливо изучаю великую книгу Learning Perl авторов Randal L. Schwartz, Tom Phoenix, brian d foy и пробую на практике изученное.

В качестве упражнения для самоконтроля придумал следующую задачу:

“определить, содержит ли указанная строка элементы, разделенные одним и тем же разделителем и если да - вернуть разделитель. Два разделителя не могут идти одновременно.”

Т.е к примеру для строки q,w,e,r,t,y результатом должна быть запятая.

Для строки qwe!qer2452!wt - восклицательный знак.

Для строки a(b(( - ответ должен быть отрицательным, т.к. после второго разделителя, (, нет элемента и сразу идет третий разделитель. Можно было изменить условие задачи и считать такие строки подходящими, но я решил что такие ситуации не слишком полезны на практике.

И да, как я уже сказал, строка вида 234@3252@foobar! не должна удовлетворять условиям задачи - т.к. здесь присутствуют 2 различных разделителя.

Итак, моё решение:

#!/usr/bin/perl
use Modern::Perl;

print "please enter a test string, or q/Q for exit: ";
chomp(my $input = <STDIN>);
 
while (lc($input) ne "q") { 
    my $separator = find_separator($input);
    
    print "correct. separator is `$separator`\n" if $separator;
    print "please enter a test string, or q/Q for exit: ";
    chomp($input = <STDIN>);
}

sub find_separator {
    my $str = shift @_;
    
    my ($result, $separator);
    while ($str =~ s/^\w+(?<SEPARATOR>\W)//) {
        if ($separator && $separator ne $+{SEPARATOR}) {
            $result = 0;
            last;
        }
       
        ($separator, $result) = ($1, 1);
    }
   
    if (length $str > 0 && $str !~ /^\w+$/) {
        $result = 0;
    }
    
    $result ? $separator : undef;
}

Если мы усложним немного условие задачи, запретив строки оканчивающиеся на разделитель (к примеру, foo*), то потребуется чуть-чуть изменить подпрограмму find_separator:

sub find_separator {
    my $str = shift;
    
    my ($result, $separator);
    while ($str =~ s/^\w+(?<SEPARATOR>\W)//) {
        if ($separator && $separator ne $+{SEPARATOR} || length $str == 0) {    #added || length $str == 0
            $result = 0;
            last;
        }
       
        ($separator, $result) = ($1, 1);
    }
   
    if (length $str > 0 && $str !~ /^\w+$/) {
        $result = 0;
    }
    
    $result ? $separator : undef;
}

Для вышеуказаной работы с подпрограммой find_separator этого достаточно, но что если мы попытаемся вызвать её без передачи строки? Мы получим warning:

Use of uninitialized value $str in substitution (s///) at /home/varnie/foo/regexp.pl.

Для защиты от подобных неприятностей немного допилим подпрограмму find_separator:

sub find_separator {
    return undef unless @_ > 0; #added
    
    my ($str, $result, $separator) = shift;
    while ($str =~ s/^\w+(?<SEPARATOR>\W)//) {
        if ($separator && $separator ne $+{SEPARATOR} || length $str == 0) {
            $result = 0;
            last;
        }
       
        ($separator, $result) = ($1, 1);
    }
   
    if (length $str > 0 && $str !~ /^\w+$/) {
        $result = 0;
    }
    
    $result ? $separator : undef;
}

Теперь, даже если вызовем find_separator() без передачи ей строки, она отработает правильно.

A challenge: generating an expression: part two

2012-08-04T00:00:00+00:00

Hi all.

As I promised few days ago, I’m showing one more solution to that problem.

Here’s the code:

import java.text.CharacterIterator;
import java.text.StringCharacterIterator;
import java.util.ArrayList;
import java.util.List;
import java.util.Random;
import java.util.Stack;

public class SentenceMixer {

    private static class Item {

        private List<Object> objects = new ArrayList<Object>();

        public Item(String value) {
            add(value);
        }

        public Item() {
            super();
        }

        public void add(Object value) {
            objects.add(value);
        }

        public void shrink() {
            Random randomGenerator = new Random();

            int preserveIndex = randomGenerator.nextInt(objects.size());
            for (int i = objects.size() - 1; i >= 0; --i) {
                if (i != preserveIndex) {
                    objects.remove(i);
                }
            }
        }

        public void archive() {

            int count = objects.size();
            if (count == 2) {
                shrink();
            } else if (count > 2) {
                Item item = new Item();
                for (Object obj : objects) {
                    item.add(obj);
                }
                objects.clear();
                objects.add(item);
            }
        }
    }

    private final String sentence;

    public SentenceMixer(String sentence) {
        this.sentence = sentence;
    }

    public String generate() {
        Stack<Item> stack = new Stack<Item>();

        stack.push(new Item());
        Item top = stack.peek();
        StringBuilder stringBuilder = new StringBuilder();

        CharacterIterator iter = new StringCharacterIterator(sentence);
        for (char ch = iter.first(); ch != CharacterIterator.DONE; ch = iter.next()) {
            if (ch == '|') {
                if (stringBuilder.length() > 0){
                    top.add(new Item(stringBuilder.toString()));
                    stringBuilder.setLength(0);
                    top.archive();
                }
            } else if (ch == '{') {
                if (stringBuilder.length() > 0) {
                    top.add(new Item(stringBuilder.toString()));
                    stringBuilder.setLength(0);
                }
                Item item = new Item();
                stack.add(item);
                top.add(item);
                top = item;
            } else if (ch == '}') {
                if (stringBuilder.length() > 0) {
                    top.add(new Item(stringBuilder.toString()));
                    stringBuilder.setLength(0);
                }
                top.shrink();
                stack.pop();
                top = stack.peek();
            } else {
                stringBuilder.append(ch);
            }
        }

        return traverseItem(top);
    }

    private static String traverseItem(Item item) {

        StringBuilder stringBuilder = new StringBuilder();

        for (Object obj : item.objects) {
            if (obj instanceof String) {
                stringBuilder.append(obj);
            } else {
                stringBuilder.append(traverseItem((Item) obj));
            }
        }

        return stringBuilder.toString();
    }

    public static void main(String[] args) {
        System.out.println(new SentenceMixer("{Пожалуйста|Просто} сделайте так, чтобы это {удивительное|крутое|простое} " + 
            + "тестовое предложение {изменялось {быстро|мгновенно} случайным образом|менялось каждый раз}.").generate());
    }
}

A challenge: generating an expression: part three

2012-08-04T00:00:00+00:00

Today I decided to refresh my knowledge of PHP (sick!). Here’s a PHP verson of the problem that has been discussed few posts ago:

<?php

$src = '{Пожалуйста|Просто} сделайте так, чтобы это {удивительное|крутое|простое} тестовое предложение '
    . '{изменялось {быстро|мгновенно} случайным образом|менялось каждый раз}';

while (preg_match("/\{([^\{\}]*)\}/", $src, $matches)){
$alt_items = explode("|", $matches[1]);
$item = $alt_items[array_rand($alt_items)];
$src = str_replace($matches[0], $item, $src);
}

print $src;

A challenge: generating an expression

2012-08-04T00:00:00+00:00

Okay, here it is: suppose you have a string containing some substrings separated by ‘

’, and glued together into smaller chunks like {a

c}}. Someone asks you to generate a complete sentence using random alternatives you have. A quick solution I’ve came up with is below:

# coding: utf-8

src = '{Пожалуйста|Просто} сделайте так, чтобы это {удивительное|крутое|простое} тестовое предложение ' <<
    '{изменялось {быстро|мгновенно} случайным образом|менялось каждый раз}';
r = Regexp.new(/\{[^\{\}]*\}/)

while (match = r.match(src)) do
  match.length.times { |i|
    offsets = match.offset(i)
    chunk = src[offsets[0],offsets[1]-offsets[0]]
    bracelessChunk = chunk[1..-2] #remove leading '{' and trailing '}'
    alternatives = bracelessChunk.split("|")
    selectedAlternative = alternatives[rand(alternatives.size())]
    src[chunk]=selectedAlternative
  }
end

puts src

I have another solution (this time written in Java), which follows a different approach. I’ll post it later.

The basic date validation using Ruby regexps

2012-08-03T00:00:00+00:00

Hi there, Ruby lovers all over the world.

I’ve been playing with Ruby regexps for a while and worked out a usable regexp (well, to my opinion) which checks whether the date format is proper (“YYYY#MM#DD”) where # stands for a separator: - or : or /.

It performs basic checks on a date: accepts only dates which have a valid year (which cannot start from zero), a valid month (from 01 to 12), and checks that a day is within the range [1..31].

The second separator must match the first.

One of the drawbacks of that regexp is that it is not smart enough to know whether a supplied day is valid for the supplied month, but it may be further improved by the use of Ruby’s Date and DateTime modules.

Alrighty, let’s look at the code!

=begin rdoc
Checks that the supplied date has the correct date format '#YYYY:MM:DD' with the separators both be either - or : or /.
A year cannot start from the zero, while a month and a day can.
Doesn't check that the supplied day is within the specified month's day range. It may be further improved.
=end
def checkDate(aDate)
  %r{
    (?<year>
      (^            #no input before the start
        [1-9]\d{3}  #a year cannot start from the zero
      ) 
    )
    (?<sep>-|:|/)   #a separator can be either - or : or / 
    (?<month>       
      (0[1-9])      #a month can start from the zero
      |
      (1[0-2])      #or it could be just 10, 11 or 12 of course
    )
    \k<sep>         #the 2nd separator must be the same as the 1st met
    (?<day>
      (0[1-9])      #a day can start from the zero
      |(1[0-9])     #or should fall into the range [1..31]
      |(2[0-9])
      |30
      |31
    )$              #marks there should be the end of the input
  }x =~ aDate
end

date  = "1234:12:31"
print "date is #{checkDate(date) ? "" : "not "}correct"

A curious reader might have already noticed I used lots of spaces in the regexp. Yes, it is possible in Ruby regexps if you specify ‘x’ option (as I did). It makes it much easier to understand. Effective comments also worth mentioning. Without them the regexp might not be so straightforward and clear.

Okay, let’s get rid of the mentioned flaws. All we need is to look at Ruby’s handy Date class which performs all these checks automatically during instantiation a new Date object.

Here is a final solution:

=begin rdoc
Checks that the supplied date has the correct date format '#YYYY:MM:DD' with the separators both be either - or : or /.
A year cannot start from the zero, while a month and a day can.
Performs additional checkings that the date is valid.
=end
def checkDateUpdated(aDate)
  matched =
    %r{
        (?<year>
        (^            #no input before the start
          [1-9]\d{3}  #a year cannot start from the zero
        )
      )
      (?<sep>-|:|/)   #a separator can be either - or : or /
      (?<month>
        (0[1-9])      #a month can start from the zero
        |
        (1[0-2])      #or it could be just 10, 11 or 12 of course
      )
      \k<sep>         #the 2nd separator must be the same as the 1st met
      (?<day>
        (0[1-9])      #a day can start from the zero
        |(1[0-9])     #or should fall into the range [1..31]
        |(2[0-9])
        |30
        |31
      )$              #marks there should be the end of the input
    }x.match(aDate)

    if (matched)
      day, month, year = matched[:day], matched[:month], matched[:year]
      day = day[-1] if day[0] == "0"
      month = month[-1] if month[0] == "0"

      year, month, day = year.to_i, month.to_i, day.to_i

      require 'date'
      begin
        date = Date.new(year, month, day)
      rescue ArgumentError => e
        return false
      end

      true
    else
      false
    end
end
 
date = "2011:11:30"
print "date is #{checkDateUpdated(date) ? "" : "not "}correct"

It discards wrong entries such as “2011:11:31”, “2011:02:29” etc.

Cheers!

Пример работы модуля Deparse для perl

2012-08-01T00:00:00+00:00

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

Итак, имеем кривую программку:

#!/usr/bin/perl    
use Modern::Perl;

my $i = 1;
while ($i & 8 == 0 || $i & 256 == 0){
    ++$i;
}
print $i, "\n";

, которая на выводе даёт единицу. Если проблема слёту не видна, обратимся к возможностям модуля Deparse:

varnie@foo:~/bar$ perl -MO=Deparse /home/varnie/buggy.pl

use Modern::Perl;
use warnings;
use strict 'refs';
BEGIN {
    $^H{'feature_say'} = q(1);
    $^H{'feature_state'} = q(1);
    $^H{'feature_switch'} = q(1);
}
my $i = 1;
while ($i & !1 or $i & 0) {
    ++$i;
}
print $i, "\n";

/home/varnie/buggy.pl syntax OK

Здесь видно каким образом перловский парсер её видит; налицо ошибка. Правим:

#!/usr/bin/perl
use Modern::Perl;

my $i = 1;
while (!($i & 8) || !($i & 256)){
    ++$i;
}

print $i, "\n"

Запускаем - 264. Все ОК. Для интереса запускаем с модулем Deparse: varnie@foo:~/bar$ perl -MO=Deparse /home/varnie/fixed.pl

use Modern::Perl;
use warnings;
use strict 'refs';
BEGIN {
    $^H{'feature_say'} = q(1);
    $^H{'feature_state'} = q(1);
    $^H{'feature_switch'} = q(1);
}
my $i = 1;
while (not $i & 8 or not $i & 256) {
    ++$i;
}
print $i, "\n";

/home/varnie/fixed.pl syntax OK

Видно что условие в цикле соответствует тому, что мы и пытались выполнить в перле.