下心で覚えるエッチな Perl - 若妻サイト「舞ワイフ」をスクレイピングしてみた

前回のエントリー「Perl が覚えられて胸もキュンとなるコードを書いてみた 」が思ったよりウケが良かったので続編を書いてみました。

前回同様、Perl の CPAN モジュール Web::Scraper を用いたスクレイピングですが、内容はより高度に、より実践的にしています。

具体的には、前回は単一のページから画像をダウンロードするコードでしたが、今回は複数のページから画像をゲットするコードです。

**本日の教材 コードの難易度は少し上げましたが、「下心で覚える」という基本方針については手を加えず。美人な若妻サイトをチョイスしてみました。

-舞ワイフ（18禁）

見本画像を載せたかったのですが、転載不可のため断念。でも、オトナの魅力全開の美人のひと多いです。（詳しい人に訊いたら、定番サイトらしい。でも、好みが合わないときは、サンプルコードの URL 及びそれに付随する箇所を自由に変えていただければと思います。）

ただし、18禁サイトなので、ボーイズは後述のサンプルコードをそのまま実行してはダメですよ、もちろん。URL のところをマイルドなサイトのものに書き換えてから実行してください。

**サイトの構造 トップページから「人妻ページ」へのリンクが貼られていて、人妻ページの下に「連番ページ」があります。そして、その下におたのしみ画像が眠っている、と。そんな構造です。

***< 人妻ページの URL 例 > http://sp.mywife.cc/free503/wife2/123wifename/index.html

***< 連番ページの URL 例 > http://sp.mywife.cc/free503/wife2/123wifename/p01.html http://sp.mywife.cc/free503/wife2/123wifename/p02.html

（「人妻」連呼でかたじけない...）

**サンプルコード

|perl|

! /usr/bin/perl

use strict; use warnings;

use Web::Scraper; use URI; use LWP::Simple qw/mirror/; use File::Basename qw/basename/;

my $url = URI->new('http://www.mywife.jp/'); my $scraper = scraper { # 「人妻ページ」の URL は、次の2パターンある # （URL例1）http://sp.mywife.cc/free503/wife2/[123wifename]/index.html # （URL例2）http://sp.mywife.cc/free503/wife2/[123wifename]/p01.html process 'a[href=~/^http:\/\/sp.mywife.cc\/free503\/wife2\/\d{1,3}\w+\/\w+.html/]', 'urls[]' => '@href'; result 'urls'; }; my $wife_urls_ref = $scraper->scrape($url);

画像を保存したいディレクトリを指定

chdir '/Users/username/Pictures/MyWife' or die "cannot chdir to /Users/username/Pictures/MyWife: $!";

foreach my $wife_url (@{$wife_urls_ref}) {

# wife_name は、あとで保存ファイル名に使う
my $wife_name = '';
if ($wife_url =~ m%^http://sp\.mywife\.cc/free503/wife2/\d{1,3}(\w+)/\w+\.html%) {
    $wife_name = $1;
}
my $page_urls_ref = scrape_page_urls($wife_url);

# 「人妻ページ」の URL が
# http://sp.mywife.cc/free503/wife2/[123wifename]/p01.html
# のパターンの場合には、「連番ページ」のリストの中に
# 「人妻ページ」も加えてあげる必要がある
unshift @{$page_urls_ref}, $wife_url;

foreach my $page_url (@{$page_urls_ref}) {
    print $page_url ."\n";
    my $img_urls_ref = scrape_img_urls($page_url);

    foreach my $img_url (@{$img_urls_ref}) {
        get_img($img_url, $wife_name);
    }
}

}

print "ダウンロードが完了しました\n";

------------------------------------------------------------

以下、サブルーチン

sub scrape_page_urls { my $wife_url = shift; my $scraper = scraper { # （例）p01.html process 'a[href=~/p\d{1,2}.html/]', 'urls' => '@href'; result 'urls'; }; my $urls_ref = $scraper->scrape($wife_url); return $urls_ref; }

sub scrape_img_urls { my $page_url = shift; my $scraper = scraper { process 'a[href=~/.jpe?g$/]', 'urls' => '@href'; result 'urls'; }; my $urls_ref = $scraper->scrape($page_url); return $urls_ref; }

sub get_img { my $img_url = shift; my $wife_name = shift; my $filename = $wife_name .basename($img_url);

unless (-e $filename) {
    mirror($img_url, $filename);
    print "$filename をダウンロードしています...\n";

    # サーバに負荷がかかりすぎないように
    sleep 5;
}
return 1;

} ||<

**解説 Web::Scraper の箇所は、次の記事がわかりやすいかと思います。 -use Web::Scraper; - 今日のCPANモジュール

その他の箇所については適宜コードの中にコメントを書きましたが、1点だけ補足。URL にマッチさせるパターンを指定するときには、スラッシュ以外のデミリタを使うと便利です。

なので、本当は

|perl| process 'a[href=~/^http:\/\/sp.mywife.cc\/free503\/wife2\/\d{1,3}\w+\/\w+.html/]', ||<

のところを

|perl| process 'a[href =~ m%http://sp.mywife.cc/free503/wife2/\d{1,3}\w+/\w+.html%]', ||<

と書きたかったのですが、うまくいきませんでした。Web::Scraper の scraper{} 以外のところでは正常に機能したんですけどね。（分かる方がいらっしゃいましたら、コメント等で教えてください。）

（2010年6月29日 追記） id:otsune さんのコメントを参考にして、ダブルクォーテーションを使ってみると、きれいに書けました。

|perl| process 'a[href=~"^http://sp.mywife.cc/free503/wife2/"]', ||< <<

**おわりに やはりエロの力は偉大。その力をうまく利用して、Perl が食わず嫌いだった人や、途中で挫折してしまった人が、もう一度チャレンジするためのきっかけになればと。

ただし、くれぐれも悪用しないようにしてくださいね。 ではでは。

**参考書籍

初めてのPerl 第5版

言わずと知れた入門書の定番。正規表現も含めて、サンプルコードの大半の部分はこの本を読めば理解できると思います。

**関連エントリー -Perl が覚えられて胸もキュンとなるコードを書いてみた -とんでもない美少女ソムリエが現れたので、Web::Scraper で萌え画像をぶっこ抜いてみる