Web屋のネタ帳

なんのためのスクリプトかという話はここでは書かない。とりあえず過去記事にリンクしておく。

windows用のActive Perl5.8.8で動作確認済み。 もちろんLinuxなんかでも動くだろう。

なお、SSL(https)なページを経由しなければならないので、 Crypt::SSLeay(Net::SSLeay)などのモジュールも必要。 これはActivePerlの標準のPPMでは入ってない／うまく取得できないはず。 ここなどにある解説を参考にしながらいれる。

#!/usr/local/bin/perl -w
#
# 使い方： rakuaffl_get.pl ユーザーID 開始日付(YYYY-MM-DD) 取得したい週数 結果を格納するファイル名
# 例1 perl rakuaffl_get.pl hogehoge@example.com 2007-01-31 4 hogehoge.txt
# 結果は日付どおりに並んでないのはご愛嬌。
#
# タブ区切りテキストなのでそのままエクセルに
# コピペ可能なのであとは日付ソートやオートフィルタ等
# 好きに加工、分析する。
# リクエスト間隔を3秒とっているので、件数が多かったり
# 取得したい週数が多かったりするとそれなりに時間がかかります。
#
# Shift_JISな環境を想定しているので、それ以外の場合は
# jcode呼んで->sjisとかやっているところを->eucとかにするとよいかも。

use strict;
use Term::ReadKey;
use Date::Simple;
use WWW::Mechanize;
use HTML::TableContentParser;
use HTML::Strip;
use Jcode;

my $userid = $ARGV[0];
my $date = Date::Simple->new($ARGV[1]);
my $week = $ARGV[2];
if ($week > 30) {
    print "一度に取得できる最大週数は30週です\n";
    exit(0);
}
my $file = $ARGV[3];

# パスワード
ReadMode('noecho');
print "input password: ";
my $password = ReadLine(0);
chomp $password;

# ログイン
my $mech = WWW::Mechanize->new();
my $start = "http://affiliate.rakuten.co.jp/";
$mech->agent_alias('Windows IE 6');
$mech->get($start);
$mech->form_name("LoginForm");
$mech->field(u => $userid);
$mech->field(p => $password);
$mech->submit();
if (jcode($mech->content())->sjis =~ /入力に誤りがあります/) {
    print "IDかパスワードが違うみたい\n";
    exit(0);
}else {
    print "\n";
}

# 全データを取得してファイルに格納
open(FILE, ">$file") || die "ファイルが作成できません\n";
foreach (my $i=0; $i<$week; $i++) {
    foreach my $data (&getdata($date->year, $date->month, $date->day)) {
        print FILE join("\t", @{$data}), "\n";
    }
    $date -= 7;
}
close(FILE);

# 指定した日付を基点に過去1週間のデータをすべて取得する。
sub getdata {
    my ($end_year, $end_mon, $end_mday) = @_;
    my $url  = "https://partner.afl.rakuten.co.jp/af/a_report.cgi?";
       $url .= "Command=disp&SubCommand=result&page=1&limit=100&span=1week";
       $url .= "&end_year=$end_year&end_mon=$end_mon&end_mday=$end_mday";
       $url .= "&status=1";
    my @result = ();
    my $flag = 1;
    while ($flag) {
        sleep(3);
        $mech->get($url);
        my $content = $mech->content();
        my $parser = HTML::TableContentParser->new();
        my $strip = HTML::Strip->new();
        if (jcode($content)->sjis !~ /指定された条件に該当する成果はありませんでした/) {
            my @tables = $parser->parse($content);
            shift(@{$tables[0][22]{"rows"}}); # 最初の行は見出し
            foreach my $row (@{$tables[0][22]{"rows"}}) {
                my @data = ();
                for my $cell (@{$row->{cells}}) {
                    my $d = $strip->parse($cell->{"data"}); # 余計なfontタグ等除去
                    $d =~ s/\s//g; # 余計な空白除去
                    push(@data, $d);
                }
                push(@result, [@data])
            }
        }
        if ($mech->find_link(text_regex => qr/次の100件/i)) {
            $url = $mech->find_link(text_regex => qr/次の100件/i)->url();
        } else {
            $flag = 0;
        }
    }
    return @result;
}

__END__

それPlaggerでできるよというツッコミが多数予測されるが(笑)あえて使わなかった理由はWWW::Mechanizeその他のCPANモジュールの使い方を忘れかけてたのを頭に入れなおしたかったから。本当はPHPかJavaでやりたかったのだが、この種の話はやはりperlとCPANに分がある。実質80行程度でできた。