Yahoo!フォトから画像一括ダウンロードするスクリプトを組んでみた

Perl

3月にサークルの後輩Sが結婚したのですが、そのときの写真をとある出席者がYahoo!フォトにアップしてくれました。で、オンラインで見れるのはいいのですが、なぜかYahoo!フォトには画像を一括してダウンロードする機能がありません。

別に何がなんでもオフラインで見たいというのではないのですが、ローカルに落とせてもいいよなぁと思って、カッとなって一括ダウンロードスクリプトを作ってやろうと。150枚以上の写真を一つずつ手動で保存するなんて、想像しただけでも気が狂いそうになりますし。

とは言っても、実際に着手までに1週間、完成までに1週間かかったわけで、2週間もたてば熱も結構冷めてるのですが・・・＞＜

対象のページは↓な感じ。指定したフォトアルバムの中の写真をボコボコ引っこ抜いてローカルに保存していきます。
f:id:ikikko:20080412031337j:image

今回試してみたかったのは、Web::Scraper - search.cpan.org。正規表現でスクレイプしたことは今までにもあったのですが、後日見たときに自分でもメンテする気も起きないぐらい可読性がないのがちょっとあれだったんですよね。use Web::Scraper; - 今日のCPANモジュール（跡地）を参考にしました。

プログラムの流れは、以下の通り。

  1. 外出しのYAML設定ファイルから、YahooのID・パスワード・アルバムのURLを取得
  2. WWW::Mechanizeを使って、Yahooにログイン
  3. 写真リスト一覧のページから、個々の写真の（URL・名前・ファイル拡張子）とアルバムタイトル名をスクレイプ
  4. アルバムのタイトル名をディクショナリ名として作成
  5. ループで個々の写真を処理
    1. 写真詳細ページのURLから画像の（名前・URL）をスクレイプ
    2. 画像をファイルに保存


今回作りながら思ったこと。

  • Web::Scraper楽しい♪まだ初歩的な使い方しかしてない*1けど、それなりに使うだけでも何かわくわくしてくるね、これ。プログラムが楽しくないと言っている人は、こういうのから入るとモチベーションが上がるのではって思ったよ*2。
  • XPath久しぶり。大学の研究以来やってなかったので、すっかり忘れてました。無駄にfollowing_sibling基準点とか使ってみたけど、もっとシンプルにやった方がよかったかも？
  • ソース眺めたりこことかこことか見て分かったけど、YahooってJavaScriptの有効・無効によって、ログイン時のフォーム値の受け渡しやログイン後のリダイレクトの方法変えてるんだね。チャレンジレスポンスとか、個々の技術要素は知っていたけど、なるほどと思った。
  • どうせならPerlの実行環境を持っていない人にも配布できたらと思って、[PAR] perlをexe化 :: ぼくはまちちゃん！を参考にバイナリ化しようとしてみたけど、撃沈。Web::Scraperの中で、HTML::TreeBuilder::XPathがnewできてないのは何故・・・？


最後に、全ソースを。設定ファイルは以下の通り。Yahoo!フォトにはサムネイルとリストという二つの表示形式がありますが、リスト表示の方のURLを指定します。

id:     "Yahoo ID"
passwd: "Yahoo パスワード"
url:    "フォトアルバムのURL"

最終的なコードは↓な感じ。これで、実行したディレクトリに新たにディレクトリを一つ作成し、その中でボコ×2写真をダウンロードしてきます。

#!/usr/bin/perl -w
use strict;

use Encode;
use Web::Scraper;
use WWW::Mechanize;
use YAML::Syck;

# 初期設定
my $mech = new WWW::Mechanize();
my $conf = LoadFile($ARGV[0])
  or die "$ARGV[0] : $!";

# Yahoo!にログイン
$mech->get('https://login.yahoo.co.jp/config/login');
$mech->submit_form(
  fields => {
    'login'  => $conf->{'id'},
    'passwd' => $conf->{'passwd'},
  }
);

# ダウンロードしたいアルバムのURLをセット
$mech->get($conf->{'url'});
my $list = scraper{
  process '/html/body/center/p/table[3]/tr[2]/td[3]/form/table[7]/tr/td[2]/font/a',
    'url[]'  => '@href',
    'name[]' => 'TEXT';
  process '/html/body/center/p/table[3]/tr[2]/td[3]/form/table[7]/tr[1]/following-sibling::node()/td[3]/font',
    'type[]' => 'TEXT';
  process '/html/body/center/p/table[3]/tr[2]/td[3]/form/table/tr/td/font/b',
    'dict'   => 'TEXT';
}->scrape($mech->content(), $mech->uri());

# アルバムのタイトルをディクショナリ名として作成
my $dict = &trim_and_encode((split />/, $list->{'dict'})[1]);
mkdir $dict, 0666
  or warn "Can't make dictionary! : $!";

# 各画像を取得
my $i = 0;
while(1) {
  my $url  = $list->{'url'}->[$i];
  my $type = $list->{'type'}->[$i];

  # スクリーンサイズの画像のURL取得
  $mech->get($url);
  my $photo = scraper{
    process '/html/body/center/p/table/tr/td/table/tr[3]/td[4]/table/tr[3]/td/table/tr/td/font/a/img', 'photo' => '@src';
    process '/html/body/center/p/table/tr/td/table/tr[3]/td[4]/table/tr[4]/td/table/tr[2]/td/font/b', 'title'  => 'TEXT';
  }->scrape($mech->content(), $mech->uri());

  # 画像をファイルに保存
  $mech->get($photo->{'photo'});
  my $name = &trim_and_encode($photo->{'title'});
  open OUT, "> $dict/$name$type"
    or die "Can't open photo file! : $!";
  binmode OUT;
  print OUT $mech->content();
  close OUT;

  last unless defined($list->{'url'}->[++$i]);
}

### 空白削除 & 文字コード変換
sub trim_and_encode {
  my ($target) = @_;

  $target =~ s/^\s+//;
  $target =~ s/\s+$//;
  Encode::from_to($target, 'euc_jp', 'sjis');

  return $target;
}

*1:参考サイトで勧められていたFirebugを使ってやってみたけど、手軽にできる反面メンテが大変そう。正規表現ほどではないでしょうが。

*2:こういった世界を知らずにエンタープライズ系システムからプログラムの世界に入っちゃうと、確かにつまらないと感じるかも。