アクセス解析CGI #00003：記：So-net blog

	ブログをはじめるログイン

竹仲絵里『サヨナラサヨナラ/gerbe..｜『Piano Collections　F.. ブログトップ

アクセス解析CGI #00003　[プログラミング] [編集]

バージョン0.01。
ようやくデータ形式等定まってきました。今回は解析結果を表示するプログラムに力点を置いていたりいなかったり。

とりあえずアクセス解析CGI本体のソース。perlで書いてます。

ana.cgi - アクセス解析 ver.0.01

#!/usr/local/bin/perl

$ver = "ver.0.01";


$query = $ENV{'QUERY_STRING'};
@query = split(/&/, $query);
foreach (@query) {
#(UTF-16) :
#  # UTF-16を含むエンコードデータか否かを識別
#  if($_ =~ /%u[0-9a-fA-F]{4}/){
#    ;# 含まれている場合は simaguni.pl でデコード
#    ;# Ver3.5bから呼び出し元CGIと別ディレクトリにsimaguni.plを設置可能に
#    $simagunipath =  './simaguni.pl';
#    require $simagunipath;
#    if(&simaguni'loadbook($simagunipath)){
#      ;# 'euc' 'sjis' 'jis' 'utf16' の何れかを指定
#      &simaguni'decode(\$_,'euc');
#      &simaguni'unloadbook();
#    }
#    ;# UTF-8を含むエンコードデータか否かを識別
#  }else if($s =~ m/%[eE][0-9a-fA-F]{1}%[0-9a-fA-F]{2}%[0-9a-fA-F]{2}%[eE][0-9a-fA-F]{1}%[0-9a-fA-F]{2}%[0-9a-fA-F]{2}/){
#    ;# 含まれている場合は simaguni.pl でデコード
#    ;# Ver3.5bから呼び出し元CGIと別ディレクトリにsimaguni.plを設置可能に
    $simagunipath =  './simaguni.pl';
    require $simagunipath;
#    if(&simaguni'loadbook8($simagunipath)){
#      ;# 'euc' 'sjis' 'jis' の何れかを指定
#      &simaguni'decode8(*_,'euc');
#      &simaguni'unloadbook8();
#    }
#  }else{
    ($property, $value) = split(/=/, $_);
    $property =~ tr/+/ /;
    if(&simaguni'loadbook8($simagunipath)){
      ;# 'euc' 'sjis' 'jis' の何れかを指定
      &simaguni'decode8(*property,'sjis');
      &simaguni'unloadbook8();
    }
#    $property =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
    $property =~ s/\r\n//g;
    $property =~ s/\r//g;
    $property =~ s/\n//g;
    $property =~ s/<>/&lt;&gt;/g;
    $value =~ tr/+/ /;
    if(&simaguni'loadbook8($simagunipath)){
      ;# 'euc' 'sjis' 'jis' の何れかを指定
      &simaguni'decode8(*value,'sjis');
      &simaguni'unloadbook8();
    }
#    $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/<>/&lt;&gt;/g;
#  }
  $q{$property} = $value;
}

$ttl = $q{'TITLE'};
$url = $q{'URL'};
$ref = $q{'REFR'};

# データファイル読み込み
$lfh = my_flock() or die 'Busy!';

# 時刻取得
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
$ymd = sprintf("%d%02d%02d", $year + 1900, $mon +1, $mday);
$hms = sprintf("%02d:%02d:%02d", $hour, $min, $sec);

$t_dat = "ana${ymd}.dat";
$dirname = '.';

opendir(DIR, $dirname) or die;
@files = readdir(DIR);
closedir(DIR);
$i = 0;
$g = 0;
while ($i < @files) {
  if ($t_dat eq $files[$i]) {
    $g = 1;
    last;
  }
  $i++;
}
if ($g == 1) {
  open(FILE, "./$t_dat") or die;
  @dat = <FILE>;
  close(FILE);
} else {
  @dat = ();
}

# データ処理
push(@dat, "$hms<>$url<>$ttl<>$ref<>\n");

# データファイル書き込み
open(TFILE, ">./~$t_dat") or die;
foreach (@dat) {
  print TFILE "$_";
}
close(TFILE);
rename ("./~$t_dat", "./$t_dat");
my_funlock($lfh);

$prt = $#dat + 1;
print "Content-type: text/javascript\n";
print "document.write(\'test";
print "$prt";
print "\')\;\n";

exit(0);

# ファイルロック・アンロック
# 参考: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});
}

とりあえず送られてきたデータの文字コードを変換するようにしました。UTF-8からSJISに。
とりあえずの措置なんでいろいろコメントアウトしてたりして見苦しいです・・・・。
あとは、データを受け取ったままに積み上げていくようにした、というのが大きな変更点。

で、下が解析結果を表示するCGI。バージョン0.01。

anas.cgi - アクセス解析結果表示 ver.0.01

#!/usr/local/bin/perl

# ana.cgi ver.0.01型データ対応
$ver = "ver.0.01";
# このファイルのurl
$turl = "./anas.cgi";

$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/<>/&lt;&gt;/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 '    <title>アクセス解析CGI - データ表示</title>' . "\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;">（時:分:秒）</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";
    print "          <span><a href=\"javascript:location.replace('$_[3]')\" title=\"$_[3]\">$_[3]</a></span>\n";
    print "          <br />\n";
    print "          <span>→<a href=\"javascript:location.replace('$_[1]')\" title=\"$_[1]\">$_[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 "    <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);

# ファイルロック・アンロック
# 参考: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});
}

ちなみに、このCGIはhttp://hpcgi2.nifty.com/definition/ana/anas.cgiに置いてるんで、見たい方はどうぞご自由に。
まあ、しょぼくれているんで見てもしょうがないですが。
ところで、解析結果の表示で、リンク元等へ飛んだときに履歴を残さないようにJavaScriptを使ってやってるんですが、JavaScriptを通すと検索時のキーワード等が崩れてしまって、期待通りのページに飛ばなかったりします。
まあこれはおいおい直そうと思います。
ちゅーか、履歴を残さずに飛ばすもっと良い方法があったら教えてください。

さて、受験勉強という現実から逃避するために書き始めたこのプログラムですが、センターも終わりそろそろ本気で勉強する時期になったんで、ここらでちょっと止めておこうかと思います。

2006-01-29 15:45 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット