voice.pl

use v5.10;
use strict;
use autodie;
use File::Path qw/mkpath/;
use File::Spec::Functions qw/catfile/;
use Getopt::Long;
use Encode;
use LWP;
use Image::Magick;

my $opt = {
   image => undef,
   voice => "voice.mp3",

   size_x => 3,
   size_y => 15,

   tmpdir => catfile(".", "_voice"),
};

my $lwp = new LWP::UserAgent;
$lwp->default_header("referer" => "http://www.0chan.ru/");

GetOptions($opt,
   "image=s", "voice=s", "size_x=s",
   "size_y=s", "tmpdir=s", "upload",
   "multi", "crop",
   "clear" => sub { clear(); exit },
   "help"  => sub { print_help(); exit },
);

die "Can't find image file.\n" unless -f $opt->{image};
die "Can't find mp3 file.\n"   unless -f $opt->{voice};

mkpath $opt->{tmpdir};

if($opt->{crop}) {
   say "Crop image '$$opt{image}':";
   #----------------------------------------
   my $image = new Image::Magick;
   $image->Read($opt->{image});
   $image->Resize(
      width  => $opt->{size_x} * 300 + ($opt->{size_x} - 1) * 70,
      height => $opt->{size_y} * 50  + ($opt->{size_y} - 1) * 20,
   );
   $image->Write(catfile($opt->{tmpdir}, "big.png"));
   #----------------------------------------
   my $count = $opt->{size_x} * $opt->{size_y};
   for(my($i, $x, $y) = (1, 0, 0); $i <= $count; $y++) {
      for($x = 0; $x < $opt->{size_x}; $x++, $i++) {
         say "$i/$count";
         #----------------------------------------
         my $image = new Image::Magick;
         $image->Read(catfile($opt->{tmpdir}, "big.png"));
         $image->Crop(
            x => $x * 300 + $x * 70,
            y => $y * 50  + $y * 20,
            width  => 300,
            height => 50,
         );
         $image->Write(catfile($opt->{tmpdir}, "$i.png"));
         #----------------------------------------
      }
   }
}

if($opt->{upload} || $opt->{multi}) {
   if($opt->{multi} || $opt->{crop}) {
      my $count = $opt->{size_x} * $opt->{size_y};
      say "Upload $count parts of '$$opt{image}':";
      #----------------------------------------
      for my $i (1 .. $count) {
         my $fname = catfile($opt->{tmpdir}, "$i.png");
         die "Can't find image '$fname'\n" unless -f $fname;
         print upload($fname);
         say unless $i % $opt->{size_x};
      }
      #----------------------------------------
   } else {
      say "Upload '$$opt{image}':";
      say upload($opt->{image});
   }
}

sub upload {
   my($fname) = @_;
   #----------------------------------------
   my $res = $lwp->post("http://www.0chan.ru/voice.php",
      Content_Type => "form-data",
      Content => [
         voice  => [$opt->{voice}],
         visual => [$fname],
      ],
   );
   #----------------------------------------
   if($res->content =~ /done:(\w+)/) {
      return "[voice=$1]";
   } else {
      die $res->content;
   }
}

sub clear {
   no autodie;
   unlink glob catfile($opt->{tmpdir}, "*");
}

sub print_help {
   my $help = <<HLP;
Yoba flash uploader

Использование:
   perl $0 [аргументы]

Справка:
   --image=%  | Путь к файлу картинки
   --voice=%  | Путь к mp3-файлу ("./voice.mp3" по умолчанию)

   --size_x=% | Количество блоков по горизонтали (3 по умолчанию)
   --size_y=% | Количество блоков по вертикали (5 по умолчанию)

   --crop     | Порезать изображение на части
   --upload   | Загрузить изображение (все части в сочетании с --crop)
   --multi    | Загрузить части порезанной ранее картинки

   --clear    | Удалить временные файлы

Примеры:
   --image="yoba.png" --upload | Загрузить одну картинку
   --image="bolshoy_yoba.png" --crop --upload | Разрезать и загрузить по частям
HLP
   $help = encode("cp866", $help) if $^O =~ /win/;
   say $help;
}