Tag archive: perl

Archive Pages

Posts tagged with "perl"

Jun 19, 2013

My next JAPH

posted by varnie • Tags: perl • Show comments

Написал еще один незамысловатый 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))

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

Jun 15, 2013

WWW::Mechanize and keeping tracks of the performed requests

posted by varnie • Tags: perl • Show comments

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

#!/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;
}

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

Dec 29, 2012

My attempts at making Perl JAPHs

posted by varnie • Tags: perl • Show comments

Несколько 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

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

Oct 14, 2012

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

posted by varnie • Tags: php, Rust, perl • Show comments

Нашел интересный пост на 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

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

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

</br>

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

Sep 02, 2012

perl: Goatse operator usage

posted by varnie • Tags: perl • Show comments

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

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

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

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

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

Aug 22, 2012

perl: parsing timestamps

posted by varnie • Tags: perl • Show comments

На форуме 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.

Aug 15, 2012

Learning perl: regular expressions

posted by varnie • Tags: perl • Show comments

Неторопливо изучаю великую книгу 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() без передачи ей строки, она отработает правильно.

Aug 01, 2012

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

posted by varnie • Tags: perl • Show comments

На простом примере разобрался как работать с модулем 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

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

Codebits that rock!

Posts tagged with "perl"

Codebits
that rock!