10000. příspěvek na php.vrana.cz

Z mj41.cz
(Přesměrováno z 10000)

Na silvestra 2010 Jakub Vrána na svém blogu vypsal soutěž o 10000. diskuzní příspěvek. Těšil jsem se na slávu, tak jsem asi během hodiny až hodiny a půl sepsal skript uvedený níže. Bohužel jsem jako na potvoru v den D (3.ledna 2011) ještě upravil časy a skript spustil znovu. Při úpravě jsem tam zanesl chybu a prodloužil tak reakční dobu pro poslední tři příspěvky na 5 sekund, takže skript neměl šanci a zareagoval až o sekundu později než Roman Jakubec ([1]), kterému tímto gratuluji.

Celý kód i s chybou

use strict;
use warnings;
 
use Time::HiRes qw(sleep time);
use HTML::TreeBuilder;
use HTTP::Request::Common qw(POST GET);
use LWP::UserAgent;
 
my $doc;
 
my $num = 0;
my $sum = 0;
my $diff = 10;
my $prev_sum = 0;
my $sum_test = 9997;
while ( $diff > 1 ) {
    $num++;
    print "loop num: $num\n";
 
    my $file_name = 'cache.html';
    if ( 0 ) {
      open (FL, $file_name);
 
      while ( my $line = <FL> ) {
         $doc .= $line;
      }
 
    } else {
      print "getting online\n";
      my $ua = LWP::UserAgent->new;
 
      my $req = GET 'http://php.vrana.cz/archiv.php';
      $doc = $ua->request($req)->as_string;
 
      my $fh;
      open($fh,'>'.$file_name) || die;
      print $fh $doc;
      close $fh;
    }
 
    #print "$doc\n";
 
    my $tree = HTML::TreeBuilder->new; # empty tree
    $tree->parse($doc);
    #$tree->dump;
 
    my $table = $tree->look_down(
      '_tag', 'table'
    );
    die $! unless $table;
 
    my @trs = $table->look_down(
      '_tag', 'tr'
    );
    #print $table->as_text();
 
    $prev_sum = $sum;
    $sum = 0;
    foreach my $tr ( @trs ) {
        #print $tr->as_text();
        my @tds = $tr->look_down(
          '_tag', 'td'
        );
        my $td = $tds[2]->as_text();
        my ( $num ) = $td =~ /diskuse\:\s*(\d+)/;
        # print "$num\n";
        $sum += $num;
    }
 
    # sum test
    if ( 0 ) {
        $sum = $sum_test;
        $sum_test++;
    }
 
    print "sum " . $sum . "\n";
    $diff = 10000 - $sum;
    print "diff $diff\n";
 
    my $sl = 60*3;
    if ( $prev_sum != $sum ) {
        $sl = 0.5;
    } elsif ( $diff <= 3 ) {
        $sl = 5;
    } elsif ( $diff <= 10 ) {
        $sl = 60;
    } elsif ( $diff <= 20 ) {
        $sl = 60;
    }
    print "sleep $sl\n";
    sleep $sl;
 
    print "\n";
}
 
if ( $diff <= 1 ) {
 
    my $url = 'https://mujtest.cz/mj41/vrana/diskuse.php?clanek=10000-diskus-u#new';
    #$url = 'http://php.vrana.cz/diskuse.php?clanek=10000-disk...#new';
    print "posting to $url\n";
 
    my $req = POST $url, [
        re => undef,
        jmeno => 'mj41',
        url => 'http://mj41.cz',
        zprava => 'Pokus o příspěvěk číslo 10000 na tomto blogu. perl++',
        robots => 'spamno',
    ];
    my $ua = LWP::UserAgent->new;
    my $doc = $ua->request($req)->as_string;
    print $doc;
 
    my $file_name = 'post-prispevek-'.int(time()).'.html';
    my $fh;
    open($fh,'>'.$file_name) || die;
    print $fh $doc;
    close $fh;
}

Bez chyby

    ...
 
    my $sl = 60*53
    if ( $prev_sum != $sum ) {
        $sl = 0.2;
    } elsif ( $diff <= 3 ) {
        $sl = 0.5;
    } elsif ( $diff <= 10 ) {
        $sl = 10;
    } elsif ( $diff <= 20 ) {
        $sl = 30;
    }
 
    ...

Výstup skriptu

...

loop num: 6
getting online
sum 9997
diff 3
sleep 5

loop num: 7
getting online
sum 9998
diff 2
sleep 0.5

loop num: 8
getting online
sum 9998
diff 2
sleep 5

loop num: 9
getting online
sum 9999
diff 1
sleep 0.5

posting to http://php.vrana.cz/diskuse.php?clanek=10000-diskusnich-prispevku-na-tomto-blogu#new
HTTP/1.1 303 See Other
Connection: close
Date: Mon, 03 Jan 2011 12:59:41 GMT
Location: http://php.vrana.cz/10000-diskusnich-prispevku-na-tomto-blogu.php?new=11304
Server: Apache
Content-Length: 0
Content-Type: text/html; charset=utf-8
Client-Date: Mon, 03 Jan 2011 12:58:26 GMT
Client-Peer: 93.89.80.122:80
Client-Response-Num: 1
Set-Cookie: jmeno=mj41; expires=Wed, 02-Feb-2011 23:00:00 GMT
Set-Cookie: url=http%3A%2F%2Fmj41.cz; expires=Wed, 02-Feb-2011 23:00:00 GMT
spřízněné weby
Jazyk