what_me: (Default)

в FB ленте увидел пост [livejournal.com profile] zamotivator про то, как он делал своё же тестовое задание - многопоточный загрузчик. Я такие штучки люблю, и сделал свой https://github.com/onokhov/crawler/blob/master/crawler.pl. Естественно на Perl.

Для этой задачки было бы достаточно параллельных коннектов, сделанных с AnyEvent::HTTP. Но параллельность там не совсем настоящая, потому как читать ответы, парсить их и записывать в файлы всё равно пришлось бы в один поток. Да и скучно было бы писать программу, основная часть которой уже написана в мануале по AnyEvent. Поэтому я решил реализовать параллельность форками.

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

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

Скрипт ни в коей мере не предназначен для замены wget, это просто программистская разминка.

Perl

Apr. 2nd, 2012 01:04 pm
what_me: (Default)
Perl программисты меряются у кого короче
what_me: (Default)
Если у вас есть карта Белагропромбанка, с подключённой услугой 'интернет-банкинг', то можно узнать сколько на ней есть денег таким скриптом:
Perl )
Таким образом можно наладить систему, чтоб уведомляла смсками об изменении баланса
what_me: (Default)
Понадобилось, вдруг, скачать несколько роликов с ютуба, оказалось нечем. Мой старый не работает, Злобинский тоже не работает, youtube-dl из убунтовского репозитория тоже не работает. Пришлось делать новый.
ytd.pl )
what_me: (Default)
[livejournal.com profile] head_of_babulka обратил внимание на онлайн-голосовалку по теме ближайших президентских выборов в РБ.
Ну, просто так голосовать не интересно. Нужно подойти к делу творчески и сделать робота, который может зарабатывать проценты для любимого кандидата без отдыха круглые сутки.

Perl )
what_me: (Default)
Замечательно все работает. IP адрес, правда, 10.x.x.x, но это мне ничуть не мешает.
Ubuntu 10.04, модем USB Huawei E156G. Network manager сам его обнаружил, предложил выбрать страну, оператора и тарифный план.
Прочитав первопроходцев написал свой скрипт, который показывает остатки денег и трафика. Мой не требует установки дополнительных модулей.
perl )

ccn@ccn-laptop ~
$ balance
Vash balans sostavlyaet minus 26150 rublej
U Vas ostalos' 660 Mb

ccn@ccn-laptop ~
$ cat ~/bin/balance
#!/bin/sh
# check your Velcom balance

sudo ~/bin/ussd.pl '*100#' '*100*1#'

ccn@ccn-laptop ~


Update: вместо двух портов (один для чтения другой для записи) достаточно одного
what_me: (Default)
Вот, два варианта реализации кодирования/декодирования семибитного текста на Perl. Один длинный, другой короче. Тому, кто знает Perl )
Мне легче читать короткий, а вам?

P.S. В длинном коде есть ошибка в алгоритме decode_text7, иногда она неправильно декодирует текст. Я отправил report на CPAN, и многоуважаемый Cosimo Streppone уже через 30 минут(!) выдал новый исправленный релиз.
what_me: (Default)
В связи с известными событиями, скачанные ранее c torrents.ru торрент файлы стали недействительными.

Чтобы не перекачивать их заново, можно у себя запустить такую команду:

find . -type f -name '*.torrent'|xargs perl -i.orig -0777pe 's/(\d+)(:http:\/\/(?:bt\d*\.)?)torrents.ru/($1+2).$2."rutracker.org"/ge'


Я проделал это, у меня все в порядке. Но, на всякий случай, рекомендую сделать бэкапы перед запуском.
what_me: (Default)
cperl-mode, поставляемый вместе с Emacs в Ubuntu 9.10, поломан. В нем глючит подсветка синтаксиса. Ладно бы еще поставляли устаревшую версию, но нет, cperl-version 6.2 -- последняя.
Оказалось, последняя, да не та. Правильный cperl-mode лежит здесь.

Бах!

Feb. 1st, 2010 11:01 pm
what_me: (Default)
Под музыку Баха отлично работается! С мысли не сбивает, спокойное настроение поддерживает. Вот уже несколько дней он фоном звучит. Доволен.
what_me: (Default)
do удобен тем, что можно локализовать всю вспомогательную работу.

Пример. Хэш, ключами которого будут строки из файла:

  my %hash_from_file = do {
    open my $f, '</path/to/file' or die $!;
    map {chomp; $_ => 1} <$f>;
  };
what_me: (Default)
Если в скрипте нужна дата в виде строки
my $TODAY = do { my @t = ( localtime() )[ 3 .. 5 ];
                 $t[1]++; $t[2] += 1900;
                 join '.', @t };


Update: Красивость из комментов от [livejournal.com profile] sharifulin
my $TODAY = join '.', map {$_->[3], $_->[4]+1, $_->[5]+1900} [localtime];
what_me: (Default)
Все знают, что при вызове системных функций необходимо проверять был ли вызов успешен. Обычно при успешном вызове фуцнкции возвращают true, а при неудаче false, и вызовы оформляются в стиле "сделай или умри": программистское )
what_me: (Default)
Облегченная версия предыдущего скрипта (посвящается юзеру [livejournal.com profile] pavel_kudinov)
для программистов )
what_me: (Default)

Тут [livejournal.com profile] fritzmorgen назвал гастарбайтерами программистов на Perl и показал как писать робота-сосалку на Lisp. Поскольку выложил он только кусочки кода, то как выглядит его исходник целиком, осталось неясно. (Upd: лисп программа здесь)



Пройти мимо я не мог, и сделал порт на Perl. Read more... )



То же самое на PHP, Питоне, Хаскеле

what_me: (Default)
Утилитка для сдвига времени в субтитрах srt фортмата. Идея спёрта у [livejournal.com profile] ignik
#!/usr/bin/perl -pl
# time shift for srt subtitles

BEGIN {
    ($dt = shift @ARGV) != 0
        or print "Usage: $0 SECONDS file" and exit;
}

s{ (\d+) : (\d\d) : (\d\d) , (\d+) }
 { my @t = ($1, $2, $3, $4 + $dt * 1E3);
   $t[2] += $t[3] / 1E3; $t[3] %= 1E3;
   $t[1] += $t[2] / 60;  $t[2] %= 60;
   $t[0] += $t[1] / 60;  $t[1] %= 60;
   sprintf '%02d:%02d:%02d,%03d', @t;
 }gxe;

what_me: (Default)
Вот такая загогулина: ~~($$..!$$)

print $_ , ' => ', ~~($$..!$$), "\n"
    for qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);


Этот счетчик увеличивается при каждом обращении, так что если использовать его внутри процедуры, то нумерация получится сквозной через все вызовы. Следующий код напечатает числа от 1 до 10.

sub tick {
    print ~~($$..!$$), "\n";
}
tick for 1 .. 5;  # выводит числа от 1 до 5
tick for 1 .. 5;  # выводит числа от 6 до 10


Если в код вставить несколько таких штук, то они будут независимы друг от друга.
sub tick {
    print ~~($$..!$$), "\n";
}
sub tick2 {
    print ~~($$..!$$), "\n";
}
tick  for 1 .. 5;  # выводит числа от 1 до 5 
tick2 for 1 .. 5;  # выводит числа от 1 до 5


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

Пояснения:

  • Две тильды -- это гольф-трюк, заменяющий функцию scalar. Запись получается короче, взамен получаем больший оверхед.

  • Используется range operator .. в скалярном контексте. Левый операнд $$ -- переменная всегда "истина", а правый операнд её отрицание !$$ -- всегда "ложь". Некоторые предлагают вместо $$ использовать $0, но это не работает в случае, когда имя скрипта преобразовывается в "ложь", например, когда имя состоит из одного символа '0'.
what_me: (Default)
Пояснения здесь
Update: заменил пары точек многоточиями и еще чуток отформатировал

s bbq oprint
q as a and print grep!
m aca, grep!
m cac, a...
c, a...
c and print
q aq a and print grep!
m pnp, grep!
m npn, n...
p and print and print grep!
m pnp, grep!
m npn, n...
p and print grep!
m cac, grep!
m aca, a...
c and print
q qe and q and printobe and print
q as a and print grep!
m aca, grep!
m cac, a...
c, a...
c and print
q aq a and print grep!
m pnp, grep!
m npn, n...
p and print and print grep!
m pnp, grep!
m npn, n...
p and print grep!
m cac, grep!
m aca, a...
c and print
q qe and q and print


А потом говорят, что Perl непонятный язык....
what_me: (Default)
Всегда с неприязнью и подозрительностью отношусь к глобальным переменным в коде. Вот, на глаза попался перкрасный пример:
Perl... )
Page generated Sep. 20th, 2017 08:17 pm
Powered by Dreamwidth Studios