ヤフオクの出品商品のアクセス数とかを監視するPerlスクリプト

初めてYahoo!オークションに出品したんですが、アクセス総数やウォッチリスト追加総数の伸びが気になってしょうがないので作りました。cronに登録して動かしてます。CPANにもこういうのなくてヤフオクのAPI使ってもアクセス数とかは取れないんですよね。

ログはこんなふうに取れてます。データは左から時刻、アクセス総数、友だちにメールを送った総数、ウォッチリストに追加した総数、違反商品として申告された総数、現在価格、入札件数です。

time                    views   friend  watch   illegal price   bids
2008-06-02T15:30:06     39      0       16      0       1,100   4
2008-06-02T15:40:06     39      0       16      0       1,100   4
2008-06-02T15:50:06     41      0       16      0       1,100   4
2008-06-02T16:00:05     44      0       16      0       1,100   4
2008-06-02T16:10:06     44      0       16      0       1,100   4

スクリプトは下の通りです。
今思うと普通に正規表現でスクレープでもいい気がしますが、Web::Scraper 良いですね。miyagawaさん最高っすね！
ヤフオクだと空白行はさむのに単一の <p> タグが使われてたりするのですが、おそらく HTML::TreeBuilder で p_strict がデフォルトで false になってるせいで単一の <p> をちゃんとXPathの階層に入れないと解釈できません。Firebugから取ったXPathだと p が入らないので（おまけに tbody がなくても入っちゃいますが）そのまま使えず、仕方なく自分でHTML構造たどりました。不便やなー

Cookieの処理が肝心です。最初作ったスクリプトで、面倒くさいので毎回ログインフォームからログインしてたんですが、10分おきに動かしててその日40回くらいアクセスしたところでいきなりログイン時にCaptchaを要求されるようになり、ログインできなくなってしまいました。いくらUser-Agent変えようが10分おきにログインしてたらbotって丸わかりですね、すいません。Cookieでログインしてれば回避できるみたいです。

#!/usr/bin/perl
use strict;
use warnings;
use WWW::Mechanize;
use Web::Scraper;
use DateTime;
use Encode qw/encode decode/;

# ヤフオクユーザ名
my $username = 'ユーザ名';
# ヤフオクパスワード
my $password = 'パスワード';
# 監視対象のヤフオク商品ページ
my $target_page = 'http://page--.auctions.yahoo.co.jp/jp/auction/---------';

# 抽出したデータを記録するファイル
my $logfile = 'yalog.txt';
# Cookieを保存するファイル
my $cookie_file = 'cookies.txt';
# ログインできたかどうか確認するための検索文字列
my $login_string = encode('euc-jp', decode('utf8', "こんにちは、 $username さん"));

# ログインを試みる
# Cookieを使ってだめなら通常のログインを行う
sub try_login($) {
  my $mech = shift;
  unless (&cookie_login($mech)) {
    unless (&login($mech)) {
      return 0;
    }
  }
  return 1;
}

# Cookieを使ってログインを試みる
sub cookie_login($) {
  print "cookie_login\n";
  my $mech = shift;
  if (-e $cookie_file) {
    $mech->cookie_jar({ file => $cookie_file });
    $mech->get('http://auctions.yahoo.co.jp/');
    if ($mech->content =~ $login_string) { # ログイン成功
      print " - 成功\n";
      return 1;
    }
  } else {
    print "cookieファイルがありません \"$cookie_file\"\n";
  }
  # ログイン失敗
  print " - 失敗\n";
  return 0;
}

# フォームからのログインを試みる
# 既存のCookieが別アカウントのものならば一旦ログアウトする
sub login($) {
  print "login\n";
  my $mech = shift;
  $mech->get('https://login.yahoo.co.jp/config/login?.lg=jp&.intl=jp&.src=auc&.done=http://auctions.yahoo.co.jp/jp');
  unless ($mech->find_all_inputs( name => 'login' )) {
    # ログインフォームがない＝別アカウントでログインしている？
    print "違うユーザでログインしていると思われるのでまずログアウトします\n";
    &logout($mech);
    $mech->get('https://login.yahoo.co.jp/config/login?.lg=jp&.intl=jp&.src=auc&.done=http://auctions.yahoo.co.jp/jp');
  }
  $mech->submit_form(
    fields => {
      login  => $username,
      passwd => $password
    },
  );
  $mech->get('http://auctions.yahoo.co.jp/jp');
  if ($mech->content =~ $login_string) { # ログイン成功
    print " - 成功, Cookieをファイルに保存します\n";
    open(FILE, ">$cookie_file") or die $!;
    print FILE "#LWP-Cookies-1.0\n";
    # discardなCookieもダンプが必要
    print FILE $mech->cookie_jar->as_string;
    close(FILE);
    return 1;
  } else { # ログイン失敗
    print " - 失敗\n";
    return 0;
  }
}

# ログアウトする
sub logout($) {
  my $mech = shift;
  print "logout\n";
  $mech->get('http://login.yahoo.co.jp/config/login?.lg=jp&.intl=jp&logout=1&.src=auc&.done=http://auctions.yahoo.co.jp/jp');
}

# main
my $mech = new WWW::Mechanize();
$mech->agent_alias('Windows IE 6');

unless (&try_login($mech)) {
  die "ログインできませんでした";
}

$mech->get($target_page);

my $scraper = scraper {
  # 0: アクセス総数
  # 1: 友だちにメールを送った総数
  # 2: ウォッチリストに追加した総数
  # 3: 違反商品として申告された総数
  # 4: 入札者評価制限
  process '/html/body/p/table/tr/td/table/tr/td/table/tr/td/table/tr/td/font', 'nums[]' => 'TEXT';
  # 5: 現在価格
  # 7: 残り時間
  # 12: 入札件数
  process '/html/body/p/table/tr/td/table/tr/td/font', 'info[]' => 'TEXT'; # 13th
};

my $res = $scraper->scrape($mech->content, $mech->uri);

my $price = $res->{'info'}->[5];
$price =~ s/[^0-9,]//g;
my $bid = $res->{'info'}->[12];
$bid =~ s/[^0-9,]//g;

# 出力は左から以下の項目をタブ区切り
#  取得時刻
#  アクセス総数
#  友だちにメールを送った総数
#  ウォッチリストに追加した総数
#  違反商品として申告された総数
#  現在価格
#  入札件数
my $line = DateTime->now->set_time_zone('Asia/Tokyo') . "\t"
            . join("\t", @{$res->{'nums'}}[0..3]) . "\t"
            . $price . "\t"
            . $bid . "\n";
open(FILE, ">>$logfile") or die $!;
flock(FILE, 2);
print FILE $line;
close(FILE);