2013-04-05

いかにしてメイドさん画像をダウンロードするか～NAVERまとめ編

動機

NAVERまとめを「メイド」検索すると約１００のまとめがヒットします。もちろんすべてが画像サイトというわけではありませんがここに少なからぬ宝が埋蔵されているわけで、これを発掘したいと思ったわけです。

全体の構成

アプローチですが、DBに「巡回リスト」を用意してこの台帳に登録されているURLを順に巡回します。それぞれの巡回先では画像を（もしあれば）取り込みながら、さらにそこからリンクされているURLを新たな巡回先としてリストに登録します。

次のような流れになります。

まずMySQLデータベースとそのユーザーを用意しておきます。そして「巡回番号」と「URL」の２つの列だけの簡単な表を用意し、巡回の起点となるNAVERまとめサイトの「メイド」検索結果のページを巡回番号１として登録しておきます。
メインループではループカウンタを１から順に増やしながら、カウンタ値を巡回番号とするURLを巡回リストから読み取ります。読み取ったURLを子プロセスに渡して親プロセスは次の周にまわります。
それぞれの子プロセスは対象URLにアクセスして、
- Aタグのリンク先を読み取り条件にあえば巡回リストに加えます。
- Aタグのリンク先がjpg画像であればダウンロード処理をします。

巡回リスト

まず初期処理で巡回リストを作成します。もしも既に一度スクリプトを実施済みでリストが存在したらDROP TABLEで一度クリアしてしまいます。巡回リストのテーブル名はオプションで変更できるようにしておきました。コードを抜粋すると次のようなものです。

sub init_db {
    my $h = shift;

    my $sql = "DROP TABLE IF EXISTS ".$opt->get_table_name;
    my $sth = $h->prepare($sql);
    my $result = $sth->execute();

    $sql = "CREATE TABLE ".$opt->get_table_name.
        "(id INTEGER AUTO_INCREMENT PRIMARY KEY,".
        "url VARCHAR(255),".
        "CONSTRAINT UNIQUE cu_test (url))";

    $sth = $h->prepare($sql);
    $result = $sth->execute();
    $sth->finish();

    insert_db($h, $opt->get_target_url);
}

列idはAUTO_INCREMENTを指定していますので新たなレコードが追加されるたびに自動的に１ずつ増加した値が入ります。列urlは巡回先で重複を避けるためにUNIQUE制約をかけています。

最後にサブルーチンinsert_dbで巡回起点URLを登録しています。これも抜粋しておくと、

sub insert_db {
    my $h = shift;
    my $u = shift;

    my $sql = "INSERT INTO ".$opt->get_table_name." (id, url) VALUES (NULL, ?)";
    my $sth = $h->prepare($sql);
    {
        local $sth->{PrintError} = 0;
        my $result = $sth->execute($u);
        if (not defined $result) {
            if ($sth->err == 1062) {
                ; # It is nothing
            } else {
                ERROR "code : ".$sth->err;
                ERROR "string : ".$sth->errstr;
                ERROR "state : ".$sth->state;
            }
        }
    }

    $sth->finish();
}

以前にこのブログに書いた一意キー制約違反を無視するしかけをしています。

親プロセスのメインループ

巡回リストが作成できたら、ひたすらリストを読み取って巡回することを繰り返します。この部分をParallel::ForkManagerを使って並列処理化しました。コードを抜粋すると、

my $dbh = connect_db() or die("Cannot connect DB".$DBI::errstr);

init_db($dbh);
my $pm = Parallel::ForkManager->new($opt->get_num_of_workers);

for (my $c = 1; $c < $opt->get_max_pages; $c++) {
    my $u = get_url($c);
    if (not defined $u) {
        last;
    }
    my $pid = $pm->start and next;
    worker($u, $c);
    $pm->finish;
}
disconnect_db($dbh);

サブルーチンget_urlがDBから巡回先URLを取ってくる部分です。少し困るのは子プロセスが次の巡回先をDBに登録する前にこのサブルーチンが呼ばれたときの動作なのですが、そこは「１秒おきにリストを読みに行く」というポーリング動作をget_urlの中で書いて誤魔化しています。

sub get_url {
    my $id = shift;
    my $query = "SELECT url FROM ".$opt->get_table_name.
        " WHERE id = ?";

    for (my $i = 0; $i < $opt->get_wait_count; $i++) {
        my $sth = $dbh->prepare_cached($query);
        $sth->execute($id);
        my @rs = $sth->fetchrow_array();
        $sth->finish;
        if ($rs[0]) {
            return ($rs[0]);
        }
        sleep 1;
    }
    return undef;
}

子プロセスの動作

起動された子プロセスは指定URLを巡回しますが、目的と無関係な画像のダウンロードを避けるためにコンテンツに「メイド」の文字列が存在することをチェックすることにしました。また「NAVERまとめ」の外のサイトは巡回リストに登録しないよう、フィルタをかけました。

コードは以下のような具合です。

sub worker {
    my $url = shift;
    my $c = shift;

    my $ua = LWP::UserAgent->new(
        ssl_opts => {
            verify_hostname => 0,
        }
        );

    my $target_url = URI->new($url);

    my $r = $ua->get($target_url);
    if (not ($r->is_success)) {
        return;
    }
    my $contents = $r->decoded_content;

    my $t = HTML::TreeBuilder->new;
    $t -> parse( $contents);
    $t -> eof();

    if ($contents =~ /メイド/) {
        DEBUG "メイド found";
    } else {
        return;
    }

    my $h = connect_db();
    if ($h) {
        foreach my $a ($t->find("a") ) {
            my $tgt = $a->attr('href');
            if ($tgt) {
                my $uri = URI->new_abs($tgt, $target_url);
                get_photo($ua, $tgt, $target_url);
                if ($uri =~ m{^http://matome.naver.jp/odai/}) {
                    insert_db($h, $uri);
                }
            }
        } 

        disconnect_db($h);
    }
    $t->delete;
}

サブルーチン get_photo はリンク先がJPEG画像で100KB以上のサイズだったときにのみファイルにダウンロードする処理をします。

その成果

メインループの最大回数を１万回に設定して実行したところ、６００枚強の画像を取得できました。今回はかなりの精度でメイドさん関連の画像をダウンロードできており大満足です。

2013-03-31

Log::Log4perlのEasy ModeでプロセスのPIDもログに出力する

お手軽なログ出力

自分のスクリプトにデバッグ目的でたくさんのprint文を入れるのが常なのですが、最近はLog::Log4perlを使うことを覚えました。

Easy Mode というものが簡便に使えて、たとえば

use Log::Log4perl qw( :easy );

Log::Log4perl->easy_init( $DEBUG );

DEBUG "hogehoge";

これを実行すると

# perl ex1.pl
2013/03/31 14:43:04 hogehoge

と、自動的にタイムスタンプもついて出力されるのが嬉しい。

PIDもログ出力

ログ出力のメッセージフォーマットはカスタマイズ可能でタイムスタンプ以外にファイル名や行番号なども表示させることができます。途中でforkするようなマルチプロセスのスクリプトではそれぞれのログメッセージをどのプロセスが出力しているかを判別できるようにPIDを出すとよいと思います。

use Log::Log4perl qw( :easy );

Log::Log4perl->easy_init(
    {
    level => $DEBUG,
    layout => "%d %p [%P] (%F %L) %m%n",
    }
    );

DEBUG "hogehoge";

こうすると出力は

# perl ex2.pl
2013/03/31 14:52:25 DEBUG [3959] (ex2.pl 14) hogehoge

layoutの書き方はperldoc Log::Log4perlで「Log Layouts」の節に記載があります。

参考

2013-03-28

設定ファイルから読み込んだパラメータ内容をGetopt::Lucidを使ってコマンドラインオプションで上書きする

設定ファイルとコマンドラインオプションの優先順位の問題

スクリプトの中のパラメータの一部をコマンドライン引数で指定した設定ファイルから読み込むようにしたい、さらにその内の任意の項目をコマンドラインオプション指定で上書きできるようにしたいと思うわけです。

例えば次のような設定ファイルconfig.yamlがあって、

---
db_name: TestDB
db_user: TestUser
db_pass: TestPass
num_of_workers: 5

コマンドラインから次のようにスクリプトを起動すると、

$ ./myapp.pl --db_name="hogehoge" config.yaml

db_name だけは「hogehoge」で、その他のパラメータは config.yaml の内容で動作するようにしたい。

つまりコンフィグファイルの内容よりもコマンドラインオプションの指定が優先されるようにしたいのですが、これには悩ましい点があって、たとえば「業務に役立つPerl」という書籍などではコマンドラインオプションの処理方法としてGetopt::Longを使った次のような方法が紹介されているのですが、

# 1) Set defaults
my $db_name = "db_default_name";

# 2) read options
GetOptions(
    'db_name' => \$db_name,
    );

# 3) read arguments
my $config_file = shift;

設定ファイルconfig.yamlの読み込み処理をこのあとに何も考えずに書くと# 2)のコマンドラインオプション内容を上書きしてしまいそうです。そうなると意図した優先順位と逆転してしまう。

Getopt::Lucidを使う

Getopt::Longの替わりにGetopt::Lucidを使うとこの悩みをスマートに解決できます。

perldoc Getopt::Lucidで「Managing Defaults and Config Files」の節にこの優先順位の問題が論じられています。前記のコードでの# 2)のコマンドラインオプションの取得において、 Getopt::Lucid # 1)のデフォルト値を内部的に保持し続け、# 3)のあとに設定ファイルを読み込んだあとに # 2)ではなく# 1)のデフォルトを置き換えて評価しなおすことが可能です。

少し長くなりますが例えばこんなようなコードになると思います。

use Getopt::Lucid qw( :all );
use Config::Any;

# 1)
my @specs = (
    Param("db_name")->default("db_test"),
    Param("db_user")->default("user_test"),
    Param("db_pass")->default("pass_test"),
    Param("num_of_workers")->default(8),
    );

# 2)
my $opt = Getopt::Lucid->getopt(\@specs);

# 3)
my $config_file = shift;
my $cfg = Config::Any->load_files(
    {
        files => [$config_file],
        use_ext => 0,
        flatten_to_hash => 0,
    }
    );
my ($filename, $config) = %$cfg;

# デフォルトをconfig.yamlの内容で置き換える
$opt->replace_defaults($config);

# Results
print $opt->get_db_name."\n";
print $opt->get_db_user."\n";
print $opt->get_db_pass."\n";
print $opt->get_num_of_workers."\n";

これをコマンドラインオプションなしで実行すると

$ ./myapp.pl config.yaml
TestDB
TestUser
TestPass
5

コマンドラインオプションを指定して実行すると

$ ./myapp.pl --db_name="hogehoge" --num_of_workers=12 config.yaml
hogehoge
TestUser
TestPass
12

と、期待通りの結果となります。

その他のあれこれ

「Lucid」とは英語で「頭脳明晰な」「わかりやすい」といった意味の単語だそうです。上記の他にもオプション値の正当性評価やエラー時の例外処理の仕組みなどが組み込まれているようですので、おいおいに使い方を覚えようと思っています。

2013-03-23

いかにしてメイドさん画像をダウンロードするか～FC2編

Webサイトを巡回して画像ファイルを得る

Googleなどで「メイド画像」を検索しているとfc2.comドメインのWebページが少なからずヒットします。そこでこれらのWebページを巡回してメイドさん画像をダウンロードするスクリプトを書いてみました。おおまかには

Web検索APIを使って「メイド画像 fc2.com」をキーワードに検索する。
検索にヒットした各Webサイトにアクセスし150Kbytes以上のJPG画像をダウンロードする。

という手順です。

マイクロソフトの検索エンジンの利用

検索エンジンにはこのブログエントリの元ネタでも利用されていた MicrosoftのBing Search API を利用しました。利用にはWindows Azure Marketplaceでアカウントを作成しアカウントキーを得ることが必要ですが、登録さえすれば月あたり5000トランザクションまで無料で利用できます。

１回のクエリにつき最大50件の結果が返りますのでパラメータ「skip」を調整しながら問い合わせを繰り返します。さしあたり問い合わせ回数の上限を１００回と決めました。

use utf8;
use LWP::UserAgent;
use HTTP::Request;

# 略

my $url = URI->new('https://api.datamarket.azure.com/Bing/SearchWeb/Web');
my $authid = '';
my $authpass = 'My_API_Key';
my $query = 'メイド 画像 fc2.com';
my $ua = LWP::UserAgent->new( );

my $page_count = 0;
for (my $c = 0; $c < 100; $c++) {
    my $skip = $page_count * 50;

    $url->query_form(
        'Query' => qq{'$query'},
        '$top' => 50,           # max num of results
        '$skip' => $skip,       # offset
        '$format' => 'json',
        'Adult' => qq{'Off'},
        );

    my $req = HTTP::Request->new(GET => $url);
    $req->authorization_basic($authid, $authpass);

    my $res = $ua->request($req);

    if ($res->is_success) {

# 後述

    } else { # not success
        die $res->code;
    }
    $page_count++;
}

留意すべき点としてはクエリーを投げるときの「Adult」を「Off」指定している箇所です。これは「Adultな結果をフィルタする機能をOffにする」という意味合いであって、つまりAdultな結果を手に入れたいなら「Off」指定が必要です。

Parallel::ForkManagerによる並列処理

Web検索APIの結果が返ってきたらJSONモジュールでパースします。「results」には最大50件の結果が格納されていますので、それぞれの「Url」について昨日のブログエントリの要領で画像ファイルの検索・ダウンロードを試みます。

ここで高速化を期待してParallel::ForkManagerを使って最大８プロセスでの並列処理をさせました。

use JSON;
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new(8);

# 途中略

for (my $c = 0; $c < 100; $c++) {

# 途中略

    if ($res->is_success) {
        my $j = decode_json $res->content;

        my $results = $j->{d}{results};
        if ($results) {
            my @targets = @$results;
            if (scalar(@targets) == 0) {
                last;
            }
            foreach my $target (@targets) {
                my $pid = $pm->start and next;
                &get_document($target->{'Url'});
                $pm->finish;
            }
        }
    }

# 途中略

} # for $c

コード中のサブルーチンget_documentの中身がほぼ昨日のブログエントリのものです。

成果

このスクリプトを実行することで約１４００枚の画像をダウンロードできましたが残念ながらメイドさんとはまったく無関係のものも多く混在してしまいました。感覚的にはメイドさん画像が半数程度というところでしょうか。

とはいえ、それらの無関係な画像も含めて楽しめたので、まずはこれで善しと考えたいと思います。

2013-03-22

Webページから一定の大きさ以上のJPEG画像ファイルをダウンロードする

ビッグデータの時代に

情報が氾濫するこの時代に真に意味のある情報とは何でしょうか。価値観は人それぞれでしょうが、さしあたりここでは「150キロバイト以上のサイズのJPGイメージファイル」こそ有意な情報であるという前提とします。

目標

対象とするWebページから有意な情報のみを取り出すことが目標です。やりたいことは、

目的のWebページ（HTML文書）をとってきて
該当ページ内のIMGタグのSRC属性およびAタグのHREF属性に記されたJPEG画像のURLを取得し
サイズが規定値以上ならダウンロードする

となります。

前半

LWP::UserAgentで対象文書の取得を行い、解析はHTML::TreeBuilderで行います。

use HTML::TreeBuilder;
use LWP::UserAgent;
use URI;

# (略)

my $target_url = URI->new("http://sanzierogazo.blog129.fc2.com/blog-entry-1489.html");

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

my $r = $ua->get($target_url);
die "Request failed :$!" unless $r->is_success;

my $t = HTML::TreeBuilder->new;
$t -> parse( $r->decoded_content);
$t -> eof();

foreach my $i ($t->find("img") ) {
    &get_photo($i->attr('src'));
}

foreach my $a ($t->find("a") ) {
    &get_photo($a->attr('href'));
} 

$t->delete;

後半

画像のダウンロード部分は再びLWP::UserAgentを使って以下のように書きました。

sub get_photo {
    my $img = shift;
    return if not defined $img;

    my $media_url = URI->new_abs($img, $target_url);
    return if not $media_url =~ /\.jpg$/;

    my $res = $ua->head($media_url);
    return if $res->header("content-length") < 150000;

    my $filename = $media_url;
    $filename =~ s/\/+/_/g;
    $filename = $savedir.$filename;

    return if -f $filename;
    $res = $ua->get($media_url, ':content_file' => $filename);
}

参考文献

スクリプトを書くにあたっての参考としては「Perl & LWP」という書籍が今ではオンラインでフリーに読むことができます。特にChapter 9のあたり。

さらに直接的には日本人の先人の知恵のブログ記事が簡潔で、参考にさせていただきました。

2013-03-20

MySQLデータベースにINSERT文で行を挿入しようとしたときの一意キー制約によるエラーを無視する

一意キー制約

MySQLデータベースを使っていて、列が１つだけの表にどんどんレコードを追加していきたい、ただし重複したデータは登録したくないとします。

テーブル作成時に該当の列に一意キー制約をかけておくと

mysql> create table tbl_sometest (url varchar(255), constraint unique ct_sometest(url) );
Query OK, 0 rows affected (0.11 sec)

重複したデータを登録しようとしても以下のようにエラーになって登録できません。

mysql> insert into tbl_sometest (url) values ('http://www.example.com');
Query OK, 1 row affected (0.00 sec)

mysql> select * from tbl_sometest;
+------------------------+
| url                    |
+------------------------+
| http://www.example.com |
+------------------------+
1 row in set (0.00 sec)

mysql> insert into tbl_sometest (url) values ('http://www.example.com');
ERROR 1062 (23000): Duplicate entry 'http://www.example.com' for key 'ct_sometest'

エラーコード1062は MySQLのドキュメントに記載されています。

Perl によるコード

言い方を変えればデータ重複の検査をMySQLにまかせてスクリプト側ではとにもかくにもINSERT文を実行すればよい、とも言えそうです。ただしその場合はINSERT時のデータ重複によるエラーとそれ以外の予期せぬエラーを分けて扱いたい。データ重複によるエラーは言わば「予期されたエラー」なので単に無視したいわけです。

そこで次のようなコードを書きました。

use DBI;

# 略

my $dbh = DBI->connect($dsn, $dbUser, $dbPass);
my $query = qq{ INSERT INTO tbl_sometest(url) VALUES (?) };
my $sth = $dbh->prepare($query);
my $param = 'http://www.example.com';

my $res = $sth->execute($param);

if (not defined $res) {
    if ($sth->err == 1062 and $sth->errstr =~ /ct_sometest/) {
        ; # It is nothing
    } else {
        ERROR "string : ".$sth->errstr;
        die;
    }
}

コード中の「ct_sometest」はテーブル作成時に決めた一意キー制約の名前です。

DBI が出すエラーメッセージを抑制する

ところがこれでも標準エラー出力に 1062 のエラーメッセージが出ます。どうやらDBIが内部で出すもののようで、これを抑制するには、 perldoc DBI によれば次のようにします。

    {
        local $sth->{PrintError} = 0; # localize and turn off for this block
        $param = 'http://www.example.com';
        $res = $sth->execute($param);
        if (not defined $res) {
            ERROR "string : ".$sth->errstr;
            die;
        }
    }

2013-03-16

いかにしてメイドさん画像をダウンロードするか～2013

元ネタ

ゆーすけべーさんの有名なブログエントリ「いかにしておっぱい画像をダウンロードするか～2012」をほとんどそのまま利用して「おっぱい」を「メイド」に置き換えれば大量のメイドさん画像を得ることができます。

この元ネタはゆーすけべーさんの以下の著書でも取り上げられています。

しかしながらこの方法で集めたメイドさん画像はマイクロソフトの検索エンジンの限界なのか、いまひとつ刺激が足りず、中にはテイラーメイドのスポーツ用品の写真なども混じって来てしまう。

そこで、これも既に先人がいることだろうとは思いますが練習を兼ねて tumblr.com から「メイド」のtagがついた画像のポストを集めるスクリプトを書きました。

tumblr

まずはtumblr.com の API についてのドキュメントを読みます。

一番最後に記されている Tagged Methodで「メイド」のタグがついたポストを取得し、その画像をダウンロードするのが目標です。

利用には、まずは自分の「アプリケーション」を何かしら登録して API Keyの取得が必要です。

taggedメソッド

tumblrのtaggedメソッドには必須パラメータとして「api_key」「tag」の指定が必要ですが、さらにオプションとして「before」を指定可能です。

tumblrの各投稿にはタイムスタンプがついており、「before」を指定することで指定日時以前の投稿を取得できます。

taggedメソッドの１回の問い合わせに対して最大２０個の投稿が返ってきますので、その中からもっとも古いタイムスタンプを選び、次の問い合わせを投げるときには「before」にそのタイムスタンプを指定することでより過去に遡って投稿情報を取得できます。

１回の問い合わせのコードは抜粋すると以下のようになります。

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

# 途中略

sub tumblr {
    my $t = shift;
    my $url = URI->new('http://api.tumblr.com/v2/tagged');
    my $query = 'メイド';
    my $api_key = 'MyAPI_Key';

    $url->query_form(
        'tag' => $query,
        'api_key' => $api_key,
        'before' => $t,
        );

    my $req = HTTP::Request->new(GET => $url);
    my $res = $ua->request($req);

# （以下略）

}

画像のダウンロード

画像のダウンロードはオリジナルのおっぱい取得スクリプトをほとんどそのまま使います。画像は「photos」リストに格納されますので、原寸の画像のみをダウンロードすることにします。前記のサブルーチンの続きは以下のようなコードになります。

    if ($res->is_success) {

        my $j = decode_json $res->content;
        my $items = $j->{"response"};

        foreach my $item (@$items) {

            my $phs;
            if ($phs = $item->{'photos'}) {
                if ($t > $item->{'timestamp'}) {
                    $t = $item->{'timestamp'};
                }
                foreach my $ph (@$phs) {
                    &get_photo($ph->{'original_size'}->{'url'});
                } # foreach photo
            }
        } # foreach item
        return $t;

    }
# 以下略

途中、timestamp値を最小値に更新して返すようにしています。サブルーチン get_photo は指定URLのJPGファイルをダウンロードして保存する内容を別に設けています。

成果

画像を含まない投稿もあるわけですが、二次元と三次元を取り混ぜて５００枚余りのメイドさんを収集できました。さらなる成果を得るには、もう少し何か工夫が必要なようです。

週末には少しPerlを。

Perlスクリプトの学習日記です。