いかにして効率よく大量のおっぱい画像をダウンロードするか

Erogeekとしてとある実験のため、大量のおっぱいが写った画像ファイルが必要になった。しかも何千枚という枚数である。なので、アダルトサイトなどに行って右クリックで保存などという、ちまちましたやりかたではやってられない。

いかにして効率よく大量のおっぱい画像をダウンロードするか

とりあえず、俺は後ほど紹介するスクリプトで8000枚近くのおっぱい画像をダウンロードすることに成功した。

おっぱい

実行している様子
おっぱい

詳しい解説はしませんゆえ、コードみてください。あとこのスクリプトを使ってなんか問題が起こっても俺は何も責任を負いませんよー。他にもっと効率よく大量のおっぱい画像をダウンロードできる方いらしたら教えてちょ！

 #!/usr/bin/perl

use strict;
use warnings;
use Yahoo::Search;
use LWP::UserAgent;
use Digest::MD5 qw(md5_hex);
use Path::Class qw(file);

my $query       = "おっぱい";
my $image_dir   = "./temp";
my $yahoo_appid = "";

my $start = 0;
my $num   = 1;
my $count = 50;

my $ua          = LWP::UserAgent->new;

while () {
    my $result_num = search($start);
    last unless $result_num;
    $start = $start + $count;
}

sub search {
    my $start = shift;
    my @Results;
    for my $try (1..100){
    @Results = Yahoo::Search->Results(
                         Image      => $query,
                         AppId      => $yahoo_appid,
                         Mode       => 'all',
                         Start      => $start,
                         Count      => $count,
                         AllowAdult => 1,
                     );
    last if @Results;
    sleep 10;
    warn($@) if $try == 100;
    }
    map { fetch($_) } @Results;
    return $#Results + 1;
}

sub fetch {
    my $result = shift;
    my $head = $ua->head($result->Url);
    my $url;
    if( $head->content_type =~ /image/ ){
    $url = $result->Url;
    }else{
    $url = $result->ThumbUrl;
    }
    my $filename = Digest::MD5::md5_hex($url);
    my $filepath = file($image_dir , $filename);
    print "$num DownLoading... $url\n";
    unless(-f $filepath->stringify . ".jpg" )
    {
    $ua->get( $url, ":content_file" => $filepath->stringify . ".jpg");
    }
    $num ++;
}