bump-wipe.pl

#!/usr/bin/perl -X
# Кодировка: utf-8
# Требуется пакет libgtk2-perl
use strict;
use autodie;
use Gtk2 -init;
use LWP::UserAgent;
use File::Temp qw/tempfile/;
use utf8;
$| = 1;

#--------------------------------------------------------------------------

my $board  = "b"; # Доска
my $page   = 60;  # Стартовая страница, с которой бампать треды

my $file    = "pedal.jpg"; # Файл
my $timeout = 15; # Сколько ждать ответ сервера

#--------------------------------------------------------------------------

my $lwp = new LWP::UserAgent;
$lwp->agent("Opera/9.80 (X11; Linux i686; U; en) Presto/2.10.229 Version/11.60");
$lwp->default_header("Referer" => "http://iichan.ru/");
$lwp->timeout($timeout);

while(1) {
   foreach my $thread (keys %{find_threads()}) {
      print "Выбран тред: $thread\n";
      my $file = get_captcha($thread);
      my $captcha = display_captcha($file);
      send_post($thread, $captcha);
      unlink($file);
      print "-" x 30, "\n";
   }
   $page--;
}

sub find_threads {
   my %threads;
   while($page >= 0) {
      print "Поиск подходящих тредов (страница: $page): ";
      %threads = $lwp->get("http://iichan.ru/$board/$page.html")->decoded_content()
         =~ /(\d+)\.html">Ответ.*?Пропущено (\d+) сообщений/gs;
      die("Что-то пошло не так.\n") unless(%threads);
      for(keys %threads) {
         delete $threads{$_} if($threads{$_} >= 490);
      }
      if(%threads) {
         printf("%d найдено.\n", scalar(keys %threads));
         last;
      } else {
         print "Все треды на странице в бамплимите.\n";
         $page--;
      }
   }
   die "подходящие треды не найдены.\n" unless(%threads);
   return \%threads;
}

sub get_captcha {
   my($thread) = @_;
   my $script = ($board ne "b") ? "captcha.pl" : "captcha1.pl";
   for(1..3) {
      print "Капча: ";
      my $response = $lwp->get("http://iichan.ru/cgi-bin/$script/$board/?key=res$thread&dummy=");
      if($response->{_headers}->{"content-type"} eq "image/gif") {
         print "Успешно\n";
         my($fh, $file) = tempfile();
         binmode $fh;
         print $fh $response->content();
         return $file;
      } else {
         printf("Ошибка соединения (%s)\n", substr($response->status_line(), 0, 20));
      }
   }
   die "Не удалось скачать капчу.\n";
}

sub send_post {
   my($thread, $captcha) = @_;
   #----------------------------------------
   my $image;
   open(my $fh, $file);
   my $buffer;
   $image .= $buffer
      while(sysread($fh, $buffer, (stat($fh))[7]));
   $image .= substr(rand, -6);
   #----------------------------------------
   print "Пост: ";
   my $response = $lwp->post("http://iichan.ru/cgi-bin/wakaba.pl/$board/",
      Content_Type => "form-data",
      Content => [
         task   => "post",
         parent => $thread || "",
         nya3   => "", # Subject
         nya4   => "", # Message
         file   => [undef, $file,
                      Content_Type => "*/*",
                      Content => $image],
         captcha  => $captcha,
         password => "",
      ]
   );
   #----------------------------------------
   if($response->headers_as_string() =~ /Location:/) {
      print "Успешно\n";
      return 1;
   } elsif($response->code() == 200) {
      printf("Ошибка (%s)\n", parse_error($response));
   } else {
      printf("Ошибка соединения (%s)\n", substr($response->status_line(), 0, 20));
   }
   return 0;
}

sub parse_error {
   my($response) = @_;
   my($error) = $response->decoded_content() =~ /(Введён неверный код подтверждения|Код подтверждения не найден в базе|Тред не существует|Изображение слишком большое|Введён неверный пароль для удаления|Флуд|Строка отклонена)/;
   return $error || "Неизвестная ошибка движка";
}

sub display_captcha {
   my($filename) = @_;
   my $return_text;
   die(qq/Bad file "$filename"/)
      unless(-B $filename);
   #----------------------------------------
   my $main_window = new Gtk2::Window("toplevel");
   $main_window->set_position("center");
   $main_window->set_title("Капча");
   $main_window->signal_connect(destroy => sub { Gtk2->main_quit() });
   #----------------------------------------
   my $vbox = new Gtk2::VBox;
   my $image = Gtk2::Image->new_from_file($filename);
   my $entry = new Gtk2::Entry;
   $entry->signal_connect(
      activate => sub {
         $return_text = $entry->get_text();
         $main_window->destroy();
         Gtk2->main_quit();
      },
   );
   #----------------------------------------
   $vbox->pack_start($image, 0, 0, 20);
   $vbox->pack_start($entry, 0, 0, 0);
   $main_window->add($vbox);
   $main_window->show_all();
   #----------------------------------------
   Gtk2->main();
   return $return_text;
}