アクセス解析CGI #00004 [プログラミング]
昨日、「ここらへんでプログラム書くのは一時止めておきます」とか書いたけど、中途半端な不良があるとついついどうやったら直るか考えてしまう。
そんなわけで、結果表示のCGI。バージョン0.02。
anas.cgi - アクセス解析結果表示 ver.0.02
#!/usr/local/bin/perl
# ana.cgi ver.0.01型データ対応
# ↓対応済み検索エンジン
# blog.goo.ne.jp goo ブログ検索
# blog.with2.net Blog Ranking
# bst.blogpeople.net BlogPeople
# search.goo.ne.jp goo ウェブ検索
# search.yahoo.co.jp Yahoo!
# www.google.com Google
# www.google.co.jp Google
# www.trackword.net トラックワード
$ver = "ver.0.02";
# このファイルのurl
$turl = "./anas.cgi";
$simagunipath = './simaguni.pl';
$jcodepl = './jcode.pl';
require $simagunipath;
require $jcodepl;
$query = $ENV{'QUERY_STRING'};
@query = split(/&/, $query);
foreach (@query) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q{$property} = $value;
}
$qmod = $q{'MOD'};
$qmon = $q{'MON'};
$qdat = $q{'DAT'};
# 時刻取得
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
$ymd = sprintf("%d%02d%02d", $year + 1900, $mon +1, $mday);
if ($qmod eq "day") {
# データファイル読み込み
$datname = "ana${qmon}${qdat}.dat";
open(FILE, "./$datname") or die;
@dat = <FILE>;
close(FILE);
print "Content-type: text/html\n";
print "<html>\n <head>\n";
print ' <meta name="robots" content="none" />' . "\n";
print ' <meta name="robots" content="noindex,nofollow" />' . "\n";
print ' <title>アクセス解析CGI - データ表示</title>' . "\n";
print ' <style type="text/css">' . "\n";
print ' <!--' . "\n";
print ' a { text-decoration: none; color:#333399; }' . "\n";
print ' a:link { text-decoration: none; color:#333399; }' . "\n";
print ' a:visited { text-decoration: none; color:#333366; }' . "\n";
print ' a:active { text-decoration: none; color:#ff9933; }' . "\n";
print ' a:hover { text-decoration: underline; color:#ff9933; }' . "\n";
print ' th { font-size: 14px; padding: 5px; line-height: 170%; letter-spacing: 1px; }' . "\n";
print ' td { font-size: 12px; padding: 5px; line-height: 180%; letter-spacing: 1px; }' . "\n";
print ' -->' . "\n";
print ' </style>' . "\n";
print " </head>\n <body>\n";
print " <div><span>$qmon$qdatのデータです。</span></div>\n";
print " <table border=1>\n";
print " <thead>\n";
print " <tr>\n";
print " <th style=\"width: 70px;\">\n";
print ' <span>閲覧時刻</span><br /><span style="font-weight: 500; font-size: 12px;">（時:分:秒）</span>' . "\n";
print " </th>\n";
print " <th>\n";
print " <span>リンク元→閲覧ページ</span>\n";
print " </th>\n";
print " </tr>\n";
print " </thead>\n";
print " <tbody>\n";
foreach (@dat) {
chomp($_);
(@_, $lfc) = split(/<>/, $_);
print " <tr>\n";
print " <td>\n";
print " <span>$_[0]</span>\n";
print " </td>\n";
print " <td>\n";
&sref($_[3]);
print " <br />\n";
print ' <span><span style="color: #999999;">→ </span><a href="./anaj.cgi?' . "$_[1]" . '" title="' . "$_[1]" . '" style="font-size: 14px;">' . "$_[2]" . '</a></span>' . "\n";
print " </td>\n";
print " </tr>\n";
}
print " </tbody>\n";
print " </table>\n";
print " </body>\n";
print "</html>";
} else {
# ファイルロック
# $lfh = my_flock() or die 'Busy!';
$dirname = '.';
opendir(DIR, $dirname) or die;
@files = readdir(DIR);
closedir(DIR);
$i = 0;
@datfiles = ();
while ($i < @files) {
if ($files[$i] =~ /ana\d\d\d\d\d\d\d\d\.dat/) {
push(@datfiles, $files[$i]);
}
$i++;
}
# データファイル一覧表示
print "Content-type: text/html\n";
print "<html>\n <head>\n";
print ' <meta name="robots" content="none" />' . "\n";
print ' <meta name="robots" content="noindex,nofollow" />' . "\n";
print ' <title>アクセス解析CGI - データ表示</title>' . "\n";
print " </head>\n <body>\n";
print " <div><span>↓解析年月日一覧</span></div>\n";
foreach (@datfiles) {
$dyearmonth = substr ($_, 3, 6);
$dyear = substr($_, 3, 4);
$dmonth = substr($_, 7, 2);
$dday = substr ($_, 9, 2);
print " <div><a href=\"$turl?MOD=day&MON=$dyearmonth&DAT=$dday\">$dyear年$dmonth月$dday日</a></div>\n";
}
print " </body>\n";
print "</html>";
}
exit(0);
# リンク元表示
sub sref {
my($ref) = $_[0];
# www.google.co.jpの場合 UTF-8
if ($ref =~ /^http:\/\/www\.google\.co\.jp\/search\?/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
if(&simaguni'loadbook8($simagunipath)){
;# 'euc' 'sjis' 'jis' の何れかを指定
&simaguni'decode8(*value,'sjis');
&simaguni'unloadbook8();
}
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@Google : 「' . "$q2{'q'}" . '」</a></span>' . "\n";
# www.google.comの場合 UTF-8
} elsif ($ref =~ /^http:\/\/www\.google\.com\/search\?/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
if(&simaguni'loadbook8($simagunipath)){
;# 'euc' 'sjis' 'jis' の何れかを指定
&simaguni'decode8(*value,'sjis');
&simaguni'unloadbook8();
}
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@Google : 「' . "$q2{'q'}" . '」</a></span>' . "\n";
# www.trackword.netの場合 EUC
} elsif ($ref =~ /^http:\/\/www\.trackword\.net\/k/) {
$scht = substr($ref, 27);
$scht =~ tr/+/ /;
$scht =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
&jcode::euc2sjis(\$scht);
$scht =~ s/\r\n//g;
$scht =~ s/\r//g;
$scht =~ s/\n//g;
$scht =~ s/<>/<>/g;
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@トラックワード : 「' . "$scht" . '」</a></span>' . "\n";
# search.yahoo.co.jpの場合 UTF-8
} elsif ($ref =~ /^http:\/\/search\.yahoo\.co\.jp\/search\?/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
if(&simaguni'loadbook8($simagunipath)){
;# 'euc' 'sjis' 'jis' の何れかを指定
&simaguni'decode8(*value,'sjis');
&simaguni'unloadbook8();
}
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@Yahoo! : 「' . "$q2{'p'}" . '」</a></span>' . "\n";
# bst.blogpeople.netの場合 sjis
} elsif ($ref =~ /^http:\/\/bst\.blogpeople\.net\/search_result\.jsp\?/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@BlogPeople : 「' . "$q2{'keyword'}" . '」</a></span>' . "\n";
# search.goo.ne.jpの場合 EUC
} elsif ($ref =~ /^http:\/\/search\.goo\.ne\.jp\/web\.jsp\?/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
&jcode::euc2sjis(\$value);
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@goo ウェブ検索 : 「' . "$q2{'MT'}" . '」</a></span>' . "\n";
# blog.goo.ne.jpの場合 EUC
} elsif ($ref =~ /^http:\/\/blog\.goo\.ne\.jp\/search\/search\.php\?/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
&jcode::euc2sjis(\$value);
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@goo ブログ検索 : 「' . "$q2{'MT'}" . '」</a></span>' . "\n";
# blog.with2.netの場合 EUC
} elsif ($ref =~ /^http:\/\/blog\.with2\.net\/find/) {
@que1 = split(/\?/, $ref);
@que2 = split(/&/, $que1[1]);
foreach (@que2) {
($property, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
&jcode::euc2sjis(\$value);
$value =~ s/\r\n//g;
$value =~ s/\r//g;
$value =~ s/\n//g;
$value =~ s/<>/<>/g;
$q2{$property} = $value;
}
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">@Blog Ranking : 「' . "$q2{'key'}" . '」</a></span>' . "\n";
} elsif ($ref eq '') {
print ' <span>（お気に入り・URL直接入力等）</span>' . "\n";
} else {
print ' <span><a href="./anaj.cgi?' . "$ref" . '" title="' . "$ref" . '">' . "$ref" . '</a></span>' . "\n";
}
}
# ファイルロック・アンロック
# 参考:http://tech.bayashi.net/pdmemo/filelock.html
sub my_flock {
my %lfh = (dir => './lockdir/', basename => 'lockfile', timeout => 60, trytime => 10, @_);
$lfh{path} = $lfh{dir} . $lfh{basename};
for (my $i = 0; $i < $lfh{trytime}; $i++, sleep 1) {
return \%lfh if (rename($lfh{path}, $lfh{current} = $lfh{path} . time));
}
opendir(LOCKDIR, $lfh{dir});
my @filelist = readdir(LOCKDIR);
closedir(LOCKDIR);
foreach (@filelist) {
if (/^$lfh{basename}(\d+)/) {
return \%lfh if (time - $1 > $lfh{timeout} and rename($lfh{dir} . $_, $lfh{current} = $lfh{path} . time));
last;
}
}
undef;
}
sub my_funlock {
rename($_[0]->{current}, $_[0]->{path});
}
前はJavaScriptを使って直に飛び、なおかつ履歴を残さないようにしてましたが、ちょっと無理があるんで2クッション挟むことにしました。その2つのクッションは別のCGIが担っています。以下にそのソースを載っけときます。
あと、解析結果を表示するとき、リンク元が検索サイトだった場合、その検索サイトのタイトルと検索キーワードの表示をするようにしました。一部の検索サイトだけですが。
anaj.cgi - リンク時のクッション用CGI
#!/usr/local/bin/perl
$query = $ENV{'QUERY_STRING'};
if ($query eq 'jump') {
open(FILE, "./anaj.dat") or die;
@dat = <FILE>;
close(FILE);
chomp($dat[0]);
print "Location:$dat[0]\n\n";
} else {
open(FILE, ">./anaj.dat") or die;
print FILE "$query" . "\n";
close(FILE);
# 出力
print "Content-type: text/html\n";
print "<html>\n <head>\n";
print ' <meta name="robots" content="none" />' . "\n";
print ' <meta name="robots" content="noindex,nofollow" />' . "\n";
print ' <title>移動用</title>' . "\n";
print " </head>\n";
print ' <body onload="location.replace(\'./anaj.cgi?jump\')">' . "\n";
print ' <div>' . "\n";
print ' <span>JavaScriptを使い、自動的に ' . "$query" . ' に移動します。</span>' . "\n";
print ' <br />' . "\n";
print ' <span>JavaScriptが無効になっている場合は、お手数ですが手動で移動してください。</span>' . "\n";
print ' </div>' . "\n";
print " </body>\n";
print "</html>";
}
exit;
履歴を残さないようにするにはJavaScriptは使わざるを得ないようです。
【同日追記】
ところで、このプログラムで、URLエンコーディングされた情報を受け取ったあと、SJISの文字に戻すために、Unicodeデコーダ「simaguni.pl」を使っているのですが、"×P"という文字が化けてしまいます。
なぜでしょう・・・・。
simaguni.plの中身を詳しく見ないとわかんないけど、多分エンコーディングされた文字列をUTF-8からS-JISに変換してからデコードしてるから、だと思う。デコードしてから文字コードの変換をしたらきっとこんなことにはならないはず・・・・。
jcode.plはUnicodeをサポートしてないし、うちのサーバーはjcode.pmを使えないし。いっそ自分で文字コードを変換するプログラム書こうかな・・・・。
【さらに追記】
今"simaguni.pl"の中身を見てきたら、UCS-2マルチバイト文字（0x0080-0x07FF）を変換するための命令文がコメントアウトされてました。
何故でしょうか。謎です。不完全なのかな？
とりあえずコメントからはずして動作確認してみたら、"×P"という文字もちゃんと表示されるようになりました（"×"はUCS-2マルチバイト文字（0x0080-0x07FF）だから）。
ちゅうか、上の追記でデコードしてから変換したらええやんみたいな馬鹿なことを言ってますが、それが出来たら苦労はしないんですよね。はぅあー・・・・Perl5.8が使えたら何も苦労は無いのにorz。
どうでもいい愚痴。
livedoor検索って検索結果のサイトに飛ぶときに1クッション置くけど、なんかやらしいよね・・・・。
履歴から検索キーワードを知られたくないとか、そういうのがあるのかなぁ。
【2月1日追記】
検索エンジンに対応！ とか書いといて恥ずかしいけど、一部文字化けしてますね。
ちゃんと文字コードを調べなきゃ。。。。
コメント 0