#!/usr/bin/perl -w
use Socket; # Socketモジュールを使う
require './jcodeLE.pl';
require './getres.cgi';
$| = 1;
$targethost = 'snog.squares.net';
$targetdir = 'vote2';
$targetcgi = 'vote.cgi';
$referer = "http://$targethost/$targetdir/";
$cgipath = 'http://www.jks.is.tsukuba.ac.jp/~akaho/board'; #このCGIがある所
$thiscgi = 'getlog.cgi';
$topfile = 'getlog.htm';
$logdir = 'log';
$bodys = ''; #標準表示設定
$metacode = ''; #文字コード指定
$sleepsec = 10;
$seritime = 3; #連続実行制限（分）
$temporary = 'tmp.htm';
&execcheck;
&ginit;
&decode;
if($room =~ /http:\/\/$targethost\/$targetdir\/htm\/(\d+)\.html/){
$room = $1;
}
if($proxyname ne ''){
($proxy,$proxyport) = split(/:/, $proxyname);
$proxyport = 8080 if($proxyport == 0);
$host = $proxy;
$port = $proxyport;
}else{
$host = $targethost;
$port = 80;
}
#箱リストの取得
if($getlist eq "on"){
$arg_string = "lm=1000";
$targetpath = "$targetdir/list.cgi?$arg_string";
&make_connection($host,$port);
&get_html;
&write_lines("$logdir/list.htm",@htmllines); #list.htmにリストを取る
&html;exit;
}
#箱番号が指定されていなければ入力画面へ
if($room == 0){
&print_interface; exit;
}
print "Content-type: text/html\n\n";
print <<"_HTML_";
ログ取得実験
$metacode
$bodys
ログ取得実験
$room
箱取得の要求を受け取りました。
しばらくした後トップページへお戻り下さい。
トップページ $cgipath/$topfile（３分後自動ジャンプ）
_HTML_
#箱取得要求
#$arg_string = "room=$room";
#$targetpath = "$targetdir/$targetcgi?$arg_string";
#とりあえず$targetpathの設定で２ヶ所、'htm'を挟んだ
$targetpath = "$targetdir/htm/$room.html";
&make_connection($host,$port);
&err("箱の取得に失敗しました。") if(&get_html($targethost,$targetpath,$referer,''));
@htmllines=grep(!/CONTENT=\"no\-cache\">/,@htmllines); #no-cacheのMETAタグ行を消す
&get_votes;
&err("項目の取得に失敗しました。") if(@votes == 0);
&write_lines("$logdir/b${room}t.htm",@htmllines); #箱のトップページを書き出す
$logfile = "$logdir/box${room}.txt";
open(DB,">$logfile");close(DB);
$htmlfile = "$logdir/b${room}c.htm";
foreach $vt (@votes){ #各項目のコメントを取得
$targetpath = "$targetdir/htm/$details{$vt}";
&make_connection($host,$port);
&get_html($targethost,$targetpath,$referer,'');
&get_comments;
&err("コメントの取得に失敗しました。") if(@comments == 0);
&print_comments($logfile,$vt);
# sleep($sleepsec);
}
&write_html($logfile,$htmlfile);
&html;exit;
##################################################
#取得した箱HTMLから項目へのリンク @details,@votesを抽出
sub get_votes {
my($vote,$ln,$i,$v);
@votes = ();
%details = ();
$ln = @htmllines-1;
$v = 0;
foreach $i (0 .. $ln){
if($htmllines[$i] =~ / | ([^<]+)<\/A>.*/;
if($2 ne ''){
$vote = $2;
push(@votes,$vote); #項目名
$details{$vote} = $1; #項目コメントへのリンク
#target="_blank"の入るリンクがうまく変換できないので２行に分けた。
#１行目は２行目のコピーにtarget="_blank"の解釈を入れただけ。
$htmllines[$i] =~ s///;
$htmllines[$i] =~ s///;
$v++;
}
}
elsif($htmllines[$i] =~ /[${vote}]に対するコメント\n",@comments);
open(DB,">>$file") || &err("データファイルを開けませんでした。");
print DB @lines;
close(DB);
}#print_comments END
##################################################
#取得したデータをHTMLファイルに書き出す。引数はファイル名
sub write_html {
my(@lines,$logfile,$htmlfile);
($logfile,$htmlfile) = @_;
open(DB,$logfile) || &err("データファイルから読み込めません");
@lines = ;
close(DB);
unshift(@lines,"$metacode\n",$targetbodys);
unshift(@lines,"${room}\n");
push(@lines,"");
open(DB,">$htmlfile") || &err("HTMLファイルに書き込めません");
print DB @lines;
close(DB);
chmod 0644, "$htmlfile";
unlink $logfile;
}#write_html END
##################################################
#取得済みの箱リストの出力
sub html {
my($file,$filedata,$room,$r2,@lines,$set,%ans2,%titles,$title);
#print "Content-type: text/html\n\n";
opendir(DIR,"$logdir");
@roomlist = grep(/\w+\.htm/, readdir(DIR));
closedir(DIR);
#更新順にファイルをソート
foreach $room (@roomlist){
$file = "./$logdir/$room";
$filedata = -M $file;
if($room =~ /b.+t/){
open(DB,$file);
@lines = ;
close(DB);
$set = shift(@lines);
$set =~ /([^<]*)<\/TITLE>.*/;
$title = $1;
$r2 = $room;
$r2 =~ s/t/c/;
$titles{$r2} = $title;
}
$ans2{$room} = $filedata;
}
@roomlist = sort { $ans2{$a} <=> $ans2{$b} } @roomlist;
open(DB,">$topfile") || &err("HTMLファイルに書き込めません");
print DB <<"_HTML_";
<HTML><HEAD><TITLE>ログ取得実験
$metacode
$bodys
ログ取得実験
ログは更新（取得）順に並んでいます。
_HTML_
print DB "";
foreach $room (@roomlist){
if(defined $titles{$room}){
$_ = $titles{$room};
print DB " ";
print DB "${_}\n";
print DB "";
}
print DB "- $room
\n";
}
print DB " ";
print DB <<"_HTML_";
新たに箱を取得する
注意事項
- ネットワークや相手サーバー等への負荷対策として、
${seritime}分に一度（全ユーザー共通）しか実行できません。
- 箱が大きい場合は時間がかかります
（タイムアウトしてもリロードはしないで下さい）。
- ディスク容量の関係上、ログが増えすぎた場合は削除する事があります。
- 箱リストは、リロードしないとCGIの実行結果が反映されない場合があります。
- 「○○が取得できない」というエラーが出る場合、
相手のHTML書式が変更された可\能\性があります。
- 保存したいログはダウンロードして下さい。
_HTML_
print DB " |
|---|