unsorted ~ Чтение сайтов с помощью Perl LWP

на примере unsorted.ru

Возраст: 50 C нами с 27.01.2005 Репутация: **129.4**

Как говорил Линус, крутые перцы не делают бекап. Они кладут исходники на ftp, и весь остальной свет миррорит их у себя :-) Мне до Торвальдса далеко, конечно же, но вариант размещения сырцов на форуме кажется мне интересным.

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

#!/usr/bin/perl -w
# Reading all Adult forum

use LWP;
use cyrillic qw/win2koi/;

$MAX_TOPIC = 0; ## Use for only new topics

my $br = LWP&#58;&#58;UserAgent->new;
$br->cookie_jar&#40;&#123;&#125;&#41;;

my $r = $br->post&#40;"http&#58;//pt.unsorted.ru/login.php",
  &#91; "username"   => "Poupkine",
    "password"   => "perl-foreva",
    "redirect"   => "",
    "autologin"  => "on",
    "login"      => "Вход",
    "mainoption" => "" &#93; &#41;;

if&#40;$r -> status_line =~ /^302 /&#41;        &#123;

        $r = $br->get&#40;"http&#58;//pt.unsorted.ru/viewforum.php?f=11&topicdays=0&all=on"&#41;;

        parse_forum&#40;$r -> content&#41;;

&#125; else  &#123;
        print "Unable to login\n";
&#125;

sub parse_forum &#123;
        $_ = win2koi&#40;shift&#41;;

        foreach&#40;split /^</b>&#40;.*&#41;</a></&#41;;
                        $topic=$1       if&#40;/<a href="viewtopic.php\?t=&#40;\d+&#41;\" class="gen\">/&#41;;
                        if&#40;/icon_latest_reply.gif/&#41;     &#123;
                                if&#40;$size =~ /&#40;&#91;\d\.&#93;+&#41; GB/&#41;     &#123;
                                        $size = $1 * 1024;
                                &#125;
                                $size =~ s/ MB//;
                                next    if&#40;$topic eq "."&#41;;
                                next    if&#40;$topic </td>get&#40;"http&#58;//pt.unsorted.ru/viewtopic.php?t=$top"&#41;;
        die     if&#40; ! $r->is_success&#41;;
        $_ = $r -> content;
        $rez = ""; $t=0;
        foreach&#40;split /\n/ &#41;    &#123;
                $t = 2  if&#40;/><b>яЙЮВЮКХ&#58;</b></Скачали>\&#91; <b>&#40;\d+&#41;</b> \&#93;</41>new;
$br->cookie_jar&#40;&#123;&#125;&#41;;

my $r = $br->post&#40;"http&#58;//pt.unsorted.ru/login.php",
  &#91; "username"   => "Poupkine",
    "password"   => "perl-foreva",
    "redirect"   => "",
    "autologin"  => "on",
    "login"      => "Вход",
    "mainoption" => "" &#93; &#41;;

&#40;$d, $m, $y&#41; = &#40;localtime&#41;&#91;3, 4, 5&#93;;
$date = sprintf&#40;"%04d%02d%02d",$y+1900, $m+1, $d&#41;;

if&#40;$r -> status_line =~ /^302 /&#41;        &#123;

        $r = $br->get&#40;"http&#58;//pt.unsorted.ru/groupcp.php?g=77&all=on"&#41;;
        $_ = $r->content;

        open&#40;F, "> $date-users.txt"&#41;    || die;
        foreach&#40;split /\n/&#41;     &#123;
                if&#40;/viewprofile.*class=\"gen\">&#40;.*&#41;</a>/&#41;      &#123;
                        print F win2koi&#40;$1&#41;,"\n";
                &#125;
        &#125;
        close&#40;F&#41;;

&#125; else  &#123;
        print "Unable to login\n";
&#125;

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

Добавлено спустя 24 минуты 41 секунду:

Нда. Не рассчитан явно движок на постинг перл-кода. Из него были распарсены куски http, поэтому получилось печальное месиво. Разбираться лень, если кому сильно надо, пишите в личку.