#!/usr/local/bin/perl
#
# 『だれどこ？』：登録したカードで指定しているホームショップに今いるプレイヤーを一覧する
#
# 2006/12/7 公開 /Daisuke Motohashi
#
use strict;
use warnings;
use LWP::UserAgent;
use CGI;# qw(-debug);
use CGI::Carp qw(fatalsToBrowser);
use HTTP::Request::Common qw(POST);
use HTTP::Cookies;
use HTML::Template;
use HTML::TableExtract;
#
#ユーザー設定（必須）
#
#フェニックスのアカウント情報
my @cardinfo = (
{
shop => '川内ファンキータイム',
id => '',
pw => ''
},
{
shop => '沖浜ファンキータイム',
id => '',
pw => ''
}
);
#プロキシの指定
my $proxy = "";
#
# ↑ここまでユーザー設定 ここからシステム設定↓
#
my $charset = "Shift_JIS";
my $cookie_file = "Cookie.txt";
# フェニックスPCサイトのURL
my $url_login = 'http://www.dartsjapan.jp/login.php'; #ログイン
my $url_homeshop = 'http://www.dartsjapan.jp/mypage_homeshop.php'; #いまどこ
# いまどこページ(mypage_homeshop.php)のテーブルで使われているヘッダー。
my @headers_mypage_homeshop = ('プレイヤーネーム', '性別', '年齢', 'Last Time', '状態' );
# その中から表示するヘッダを指定
my @th = ('プレイヤーネーム', '性別', 'Last Time');
#
# 設定ここまで
#
my $cgi = CGI->new;
print $cgi->header(-charset=>"$charset");
# UserAgentの生成と、cookie_jarのセット
my $cookie_jar = HTTP::Cookies->new(file => $cookie_file, autosave => 1, ignore_discard => 1);
my $ua = LWP::UserAgent->new;
$ua->cookie_jar($cookie_jar);
$ua->proxy(['http'] => $proxy);
my $template = HTML::Template->new_scalar_ref( template(), option => 'value');
my $line;
foreach my $card (@cardinfo){
my @players = getActivePlayers($ua, $card->{id}, $card->{pw});
$line .= "| $card->{shop} |
";
foreach my $p (@players){
$line .= "";
foreach my $key ( @th){
if(defined $p->{$key}){
$line .= "| $p->{$key} | \n";
}
else{
$line .= " | \n";
}
}
$line .= "
\n";
}
}
$template->param(playerslist => $line);
print $template->output;
exit;
sub getActivePlayers{
my ($ua, $id, $pw) = @_;
# UserAgentを生成してログイン処理
my $url = $url_login;
my %formdata = ('cardno' => $id, 'pw' => $pw);
my $request = POST($url, [%formdata]);
my $res = $ua->request($request);
# いまどこを取得
$url = $url_homeshop;
$res = $ua->get($url);
my @players = parse_mypage_homeshop( $res->as_string );
return @players;
}
#
#Phoenixいまどこページ(html)からのデータ抽出。ハッシュの配列を返す。
#
sub parse_mypage_homeshop{
my $html = $_[0];
my $te = HTML::TableExtract->new(
depth => 0,
subtables => 0,
);
$te->parse( $html );
my (@players);
foreach my $ts ($te->tables) {
foreach my $row ($ts->rows) {
my %rowHash;
for my $x (0..$#headers_mypage_homeshop){
$rowHash{ $headers_mypage_homeshop[$x] } = $row->[$x] unless($row->[$x] && $row->[$x] eq "\xA0");
}
push(@players, \%rowHash) if($rowHash{'Last Time'} && $rowHash{'Last Time'} =~ /\d+:\d/);
}
}
return @players;
}
#テンプレートのリファレンスを返す。
sub template{
my $temp = << "END_OF_TMPL";
Are there?
だれどこ
by ぶ (tenguyasiki.jp)
END_OF_TMPL
return \$temp;
}