ぶログ＠天狗屋敷.jp

なお、設置の際には表示したいホームショップを登録しているカードが必要です。設置例はこちらをご覧下さい。

■daredoko.cgi

#!/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";




だれどこ


	
player
sex
Last Time
	

by ぶ (tenguyasiki.jp)



END_OF_TMPL

	return \$temp;
}