#!/usr/bin/perl
#↑ここを自分のプロバイダにあわせて書き換えます。
# AccessLogger Model4-------------------
# ---------------- LastUpdate [99/06/26]
# (C)Nobutaka Makino -------------------
# WEB : http://www.imaginet.ne.jp/~nobu/
# mail: nobu@pt.imaginet.ne.jp ---------
# --設定項目----------------------
# 設置URL --------
$PageUrl = 'http://www5.tkcity.net/~wilstyle/'; # ログをとるページのURL。リンク元がこのURLを含む場合はログをとらない。
# パス/URL等 -----
$Redirect = 'html/dummy.gif'; # 呼び出し後に表示する画像のURL。
$DataDir = 'data/'; # データ保存用フォルダへのパス。
$Jcode = 'jcode.pl'; # jcode.plへのパス
# システムフラグ -
$OffLine = 0; # gethostbyaddr()が使えない場合'1'を指定。
#$OffLine = 1;
$SSI = 0; # SSIで呼び出す場合'1'を指定。
#$SSI = 1;
# ロック処理系 ---
$LockTryMax = 10; # ロック処理の待ち時間[秒]
$LockLimit = 5; # 強制ロック解除までの時間[秒]
# クッキー処理系 -
$CookLimit = 0; # 重複アクセスを排除する時間[秒]
#$CookLimit = 60*60*2;
$CookName = 'AccessLog4'; # 上に使用するクッキー名
$CookValue = 'OverrapCheck!'; # 同じくクッキーの値
# その他 ---------
$TimeDiff = 0; # サーバからの時間差を指定。
$KeyDivide = 0; # 検索キーのペアを項目として保存する場合 '0'
# 検索キーのペアを分割して保存する場合 '1'
%Search = ( # サーチエンジンの設定。
# '含むURL(正規表現使用可)', '検索キーのフィールド名',
'yahoo\.co\.jp', 'p', # YahooJapan
'www\.infoseek\.co\.jp', 'qt', # InfoseekJapan
'japan\.infoseek\.co\.jp', 'qt', #
'www\.goo\.ne\.jp', 'MT', # Goo
'search\.fresheye\.com', 'kw', # fresh eye
'www\.lycos\.co\.jp', 'query', # lycos
'search\.netplaza\.biglobe\.ne\.jp', 'key', # netplaza
);
# !) 各サーチエンジンの情報は 99年4月18日現在のモノです。
return(1) if( $isTestLoad );
umask(0111);
#-------------------------------
# ToDo
# build #--- : 検索キー [全角英数->半角英数]の変換
# build #--- : ログデータサイズの考慮
# build #--- : クッキーを使わない重複アクセス排除
# build #--- : 自分のアクセスは記録しないようにする
# build #--- : 検索キーの文字数制限(表示時?)
# build #--- : 検索キーの文字化け対処
# build #--- : オフライン時のホスト取得部
# build #--- : OS判定部の調整(今かなり古いデータ...)
# build #--- : 強制ロック解除の見直し(データ破損の可能性アリ?)
# History
$Ver = '#059';
# build #059 : Cook クッキーのフォーマットをrfcに合わせて修正。
# build #058 : 変更点無し。Each版とのバージョン整合
# build #057 : Word 全角スペースで区切られた検索キーも分ける。(キー分割モードの時)
# build #056 : Reff Yahooカテゴリからのリンク元処理を正常に。CGIからのアクセス判定を強化。
# build #055 : Reff 複数のサーチエンジンに、設定変更だけで対応可能に。
# build #054 : Sys $CookLimitが[0]の時、cookieを発行しないようにした
# build #053 : Sys 不明データを書き出す部分を修正。
# build #052 : Sys cookieの有効期限部分(年)を4桁出力に修正。
# build #051 : Sys cookieが正しく発行されていなかったのを修正。(cookie_name/cookie_valueとなっていた)
# build #050 : Sys cookieを発行しブラウザのbackボタンで戻ってきたときに起こる
# 2重記録を確実にシャットアウトするオプションを追加。(デフォルトではoff)
# [99/01/19]
# build #049 : jcode.plのロード失敗を検出。
# build #048 : 修正部分が有効になっていなかったのを修正。
# build #047 : 不明データ出力で重複するモノはカットするように。
# build #046 : Ref 不明データ出力部を修正。(DirectAccessになっていた。)
# build #045 : 時差設定を追加。($TimeDiff)
# build #044 : Agent ブラウザ名取得部分を少し修正。
# build #043 : Ref リンク元に「'」や「bookmarks」が入るのを仮修正。DirectAccessとして扱う。
# [98/10/29]
# build #042 : ホストのデフォルト値がうまくセットできなかったのを修正。
# build #041 : perl4 データヘッダが出力されない点を修正。(データがないのに @Dataが1を返す。。?)
# build #040 : if であるべきところが elsif になっていたのを修正。(RecMain)
# build #039 : DyasData ディレクトリ作成時umask(0000)を一時的に指定。777出ないとファイル作成出来ないため。
# build #038 : perl4 undefを左辺値に使わないように修正。
# build #037 : umask(0111);を追加。mkdir()のパーミッションを変更。
# build #036 : 全体のコードの調整。(特にRec/Days/Word)
# build #035 : Host 'localhost'の例外処理を追加。
# build #034 : DataDirの存在チェックを追加。
# build #033 : Host ホスト名が分かっているときにもgethostbyaddr()を呼んでいたのを修正。
# build #032 : Host $OffLineの処理を変更。
# build #031 : 不明データの出力処理を変更。
# build #030 : 変数名を一部変更。localを多用(いいんだろうか?)
# build #029 : Agent Unkown -> Unknown を修正。
# build #028 : Agent 「'」が抜けているのを修正。
# [98/10/24]
# build #027 : ブックマークなどの直接アクセスの大部分が取得できていなかったのを修正。
# JavaScriptでリンク元がなかったとき、環境変数を調べていたため、
# リンク元を設置URLと解釈してしまい、重複チェックではねられていました。
# build #026 : $PageUrlが設定されていないと動かなかったが、エラー出力するように変更。
# build #025 : ロック部分の修正。ちょっとヤバかったかも。
# build #024 : SSIでの呼び出しに対応。($SSI=1;)
# build #023 : gooに仮対応。
# build #022 : 引数に含まれる'<'や'>'の処理を追加。表が崩れるのを防ぐ。
# build #021 : mdayが2桁になってなかったのを修正。
# build #020 : JavaScriptのエラー、mailbox:に対応。
# build #019 : WORDのヘッダが消えてしまうのを修正。
# build #018 : 月別データのファイル数を減らす。
# build #017 : データにヘッダを出力するように。
# build #016 : 日別データ保存に対応。なかなか試行錯誤。
# build #015 : 大部分を全部最初から書き直す。
# build #014 : &UnLockErrの呼び出しミス修正。
# build #013 : &LockErrの呼び出し部分を整理。
# build #012 : umask()がよくわからないので不安だが、生成するディレクトリのパーミッションがおかしかったのを修正。
# build #011 : エラー出力形式の変更。ana3.cgiがうまく動かないのを防ぐ。
# build #010 : ロック強制解除機構作成。
# build #009 : &UnLockの返す%LOCKEDの値を修正。
# build #008 : ロック失敗時にログを残すようにした。
# build #007 : データ保存前にロックの解除を行っていたのを修正。
# build #006 : ローカルファイルからのリンクを記録しない。
# build #005 : ディレクトリを使ったファイルロック採用。
# build #004 : 半角カナの処理を修正。
# build #003 : Osにwin98を追加。
# build #002 : 引数なしの場合、環境変数からリンク元取得。<SSI用
# build #001 : log3.cgiの後継。特に変更なし。
#---
# log.cgi - メイン処理
# 設置URLが無いとき。
&catErr('$PageUrlが設定されていません。' ) if(!$PageUrl );
&catErr('データディレクトリがありません。') if(!-e $DataDir);
&ChkCook;
&SetCook if(!$CookLock);
#---
eval{ require $Jcode; };
&catErr("jcode.plのロードに失敗しました($@)") if( $@ );
&Redirect; # redirect
&GetRefData; # ref/key
exit if( $CookLock || $Reff =~ /$PageUrl/);
&GetAgentData; # agent/os
&GetHostName; # host/ip
&GetFileName; # filename
&Record; # save
1;
#--- ioCook.pl : build #050より追加。
sub ChkCook{
#----------------------
# check cookie
$Cooks = $ENV{'HTTP_COOKIE'};
$Cooks =~ s/; /;/ig;
for( split(/;/,$Cooks) ){
$CookLock = 1 if( /^$CookName=$CookValue$/ );
last;
}
}
sub SetCook{
#---------------------
# cokkieの出力
return if(!$CookLimit);
# $date = gmtime( time + $cookie_limit ); # perl5
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $CookLimit);
$year = sprintf( "%04d", $year + 1900 ); # 2000年問題対応(2)
$sec = sprintf( "%02d", $sec ); $min = sprintf( "%02d", $min );
$hour = sprintf( "%02d", $hour ); $mday = sprintf( "%02d", $mday );
$wday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') [$wday];
$mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
$date = "$wday, $mday\-$mon\-$year $hour:$min:$sec GMT";
print "Set-Cookie: $CookName=$CookValue; expires=$date\n";
}
1;
sub RecDaysData{
# 日別データ記録。
local( $ChkReff,$ChkHost,$ChkHour,$ChkOs,$ChkAgent,$ChkWord);
local( $RecAct) = 'DaysData';
&Load;
$ChkReff = 1 if(!$Reff);
$ChkWord = 1 if(!@Words);
&SetDataHeader if( $Data[0] !~ '-' );
# incr data / 変数にメタ文字が含まれる場合おかしくなる->対処済み。
foreach( @Data ){
if(!$ChkReff && /^reff:\t($Reff)\t(\d+)$/ ) { $_ = "reff:\t$1\t". ($2+1). "\n"; $ChkReff = 1; }
elsif(!$ChkHost && /^host:\t($Host)\t(\d+)$/ ) { $_ = "host:\t$1\t". ($2+1). "\n"; $ChkHost = 1; }
elsif(!$ChkHour && /^hour:\t($hour)\t(\d+)$/ ) { $_ = "hour:\t$1\t". ($2+1). "\n"; $ChkHour = 1; }
elsif(!$ChkOs && /^os:\t($Os)\t(\d+)$/ ) { $_ = "os:\t$1\t". ($2+1). "\n"; $ChkOs = 1; }
elsif(!$ChkAgent && /^agent:\t($Agent)\t(\d+)$/ ) { $_ = "agent:\t$1\t". ($2+1). "\n"; $ChkAgent = 1; }
elsif(!$ChkWord && /^word:\t(.+)\t(\d+)$/ ) {
local( $cnt); # ヘッダが[word:]の時は、
foreach $tmp ( @Words ){ # @Wordsそれぞれと比較して
if( $1 eq $tmp ){ # キー同士が一致すれば
$_ = "word:\t$1\t". ($2+1). "\n"; # @Dataのカウントを増やして
splice(@Words,$cnt,1); # @Wordsから消す。(次回のループ数が減る)
$ChkWord = 1 if( !@Words ); # @Wordsを全て処理し終えたらフラグをたてる。
last; # 一致したので次の(@Dataの)要素へ。
}
$cnt++; # 添え字カウンタ(spliceで使用)
} # enc foreach
} # end elsif
} # end foreach
# add data / @Dataに無かった場合、別に追加。
if (!$ChkReff ){ push( @Data, "reff:\t$Reff\t1\n" ); }
if (!$ChkHost ){ push( @Data, "host:\t$Host\t1\n" ); }
if (!$ChkHour ){ push( @Data, "hour:\t$hour\t1\n" ); }
if (!$ChkOs ){ push( @Data, "os:\t$Os\t1\n" ); }
if (!$ChkAgent ){ push( @Data, "agent:\t$Agent\t1\n" );}
# wordは別に追加。
foreach( @Words){
$tmp = "word:\t$_\t1\n";
push( @Data, $tmp);
}
# すでに incr された要素は削除されている。
&Save;
}
1;
#---
sub ana{
local($data) = @_;
push( @ana, $data) if(!grep( $_ eq $data ,@ana) );
}
sub SetDataHeader{
local( $Head);
$Head =
"----------------------------------------------\n".
"Access Logger Model4 (c) 1999 Nobutaka Makino.\n".
" Location: $PageUrl\n".
" Created : $year$mon$mday\n".
" DataType: $RecAct\n".
"----------------------------------------------\n\n";
unshift(@Data, $Head );
}
sub catErr{
print "Content-type: text/html\n\n";
print "\n";
print " エラーが発生しました \n
\n";
print "";
print "";
exit;
}
1;
#---
sub Record{
# record data
&RecMain;
&Rec('Reff', $Reff );
&Rec('Host', $Host );
&Rec('Word', $Word ) if(@Words);
&RecDaysData;
}
#---
sub RecMain{
# Mon/Main
local( $tmp,$RecAct,$ChkWday,$ChkMday,$ChkHour,$ChkOs,$ChkAgent );
$RecAct = 'Main';
&Load;
return(1) if(!$LOCKED{$RecAct});
if( $Data[0] !~ '-' ){
push( @Data, );
&SetDataHeader;
}
foreach( @Data ){ # incr
if(!$ChkWday && /^wday:\t($wday)\t(\d+)$/ ){ $_ = "wday:\t$1\t". ($2+1). "\n"; $ChkWday = 1; }
elsif(!$ChkMday && /^mday:\t($mday)\t(\d+)$/ ){ $_ = "mday:\t$1\t". ($2+1). "\n"; $ChkMday = 1; }
elsif(!$ChkHour && /^hour:\t($hour)\t(\d+)$/ ){ $_ = "hour:\t$1\t". ($2+1). "\n"; $ChkHour = 1; }
elsif(!$ChkOs && /^os:\t($Os)\t(\d+)$/ ){ $_ = "os:\t$1\t". ($2+1). "\n"; $ChkOs = 1; }
elsif(!$ChkAgent && /^agent:\t($Agent)\t(\d+)$/){ $_ = "agent:\t$1\t". ($2+1). "\n"; $ChkAgent = 1; }
}
# add data
if(!$ChkAgent ){ push( @Data, "agent:\t$Agent\t1\n" ); }
if(!$ChkOs ){ push( @Data, "os:\t$Os\t1\n" ); }
# add unknown
&AddUnknown if( @ana);
&Save;
}
#---
sub AddUnknown{
# 重複するモノを除外してから付け足そう
local($cnt);
for $d ( reverse(@Data) ){ # unknown_data はデータの最後に付け加えられる。
$cnt=0;
last if(!@ana);
for $a (@ana){
splice(@ana,$cnt,1) if( $d eq "$a\n" );
$cnt++;
}
}
foreach( @ana ){
s/\n//; # 空白キーを除外。
push( @Data, "$_\n" ) if( $_ );
}
}
#---
sub Rec{
# Mon/others
local($RecAct,$Value) = @_;
&Load;
return(1) if(!$LOCKED{$RecAct});
&SetDataHeader if( $Data[0] !~ '-' ); # 何故か if(!@Data) ではうまく行かない...。
if($RecAct eq 'Word'){
foreach (@Words){ &incr( $_ ) if( $_ ); }
}
else{
$Value = "Data Missing." if(!$Value); #「DataMissing」になることはまず無い。
&incr( $Value );
}
&Save;
}
#---
sub incr{
# incr / add
local( $Name,$tmp ) = @_;
foreach(@Data){
if(/^($Name)\t(\d+)$/){
$_ = "$1\t". ($2+1). "\n";
$tmp = 1; last;
}
}
if(!$tmp){
$tmp = "$Name\t1\n";
push(@Data,$tmp);
}
}
1;
#---
sub Load{
# データのロード。
$DataFile = $DataFileOf{$RecAct};
&Lock;
return if(!$LOCKED{$RecAct});
# ロック失敗しているときは処理を戻す。
# 他のプロセスがアクセス中にロードすると、空データを読んでしまうことがある。
open(IN,"$DataFile");
@Data = ;
close(IN);
}
#---
sub Save{
# データの保存。
return if(!$LOCKED{$RecAct});
# ロック失敗している時は処理を戻す。
# 空データに新しいデータを追加して、(上参照)
# ファイルに保存したらひどいことになるもんね。
if( $RecAct eq 'DaysData' && !(-e $DaysDir) ){
umask(0000); # (0777)のディレクトリを作るため。
mkdir( $DaysDir, 0777 ) || &LockErr('mkdirErr');
umask(0111); # 終われば戻す。
}
open(OUT,">$DataFile") || &LockErr('SaveFileErr') ; # LockErrの流用?
print OUT @Data;
close(OUT);
&UnLock;
}
#---
sub Redirect{
# リダイレクト
if(!$SSI) {
print "Content-type: image/gif\n";
print "Expires: 01/01/70 00:00:00 GMT\n";
print "Location: $Redirect\n\n";
}
else{
print "Status:204 No Response\n\n";
}
}
1;
#---
sub Lock{
# ロックの強制解除と生成
local($Retry);
$LockDir = $DataDir.$RecAct;
$Pass = -M $LockDir; # Age[day]
$Pass = $Pass*24*60*60; # [day]->[s]
if( $Pass > $LockLimit ){ # ある程度ロック状態が続いていれば
if( rmdir( $LockDir) ){ &LockErr('ForceUnLocked'); } # ロックを強制解除してみる。
else { &LockErr('ForceUnLockErr'); } # 失敗すれば、エラーを書き出す。
}
while( !mkdir($LockDir, 0777) ){ # ロック処理。
if ( ++$Retry > $LockTryMax ){ &LockErr('LockErr'); return(0); }
else { sleep(1) }
}
# ロック成功時、真を返す。
$LOCKED{$RecAct} = 1;
}
#---
sub UnLock{
# ロックの解除
$LockDir = $DataDir.$RecAct;
return(0) if(!$LOCKED{$RecAct});
$LOCKED{$RecAct} = !rmdir( $LockDir); # 消去成功 ? 成功[偽] : 失敗[真]
&LockErr('UnLockErr') if( $LOCKED{$RecAct} ); # 失敗したらエラーを書き出す。
!$LOCKED{$RecAct}; # 成功->[真] / 失敗->[偽]
}
sub LockErr{
# ロックエラーの書き出し
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon++;
open(ERR,">>$DataFileOf{'err'}");
printf ERR ("%-15s %-7s %2d/%2d/%2d %2d:%2d:%2d\n",$_[0],"[$RecAct]",$year,$mon,$mday,$hour,$min,$sec);
close(ERR);
}
1;
#---
sub GetFileName{
# ファイルネームのHashを生成。
# (undef,undef,$hour,$mday,$mon,$year,$wday) = localtime(time); # perl5
($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time + $TimeDiff ); # compatible for perl4
$mon++;
$mon = sprintf("%02d",$mon );
$year = sprintf("%02d",$year % 100 );
$hour = sprintf("%02d",$hour );
$mday = sprintf("%02d",$mday );
$DaysDir = "$DataDir$year$mon";
%DataFileOf = (
'Main', "$DataDir$year$mon.main",
'Host', "$DataDir$year$mon.host",
'Reff', "$DataDir$year$mon.reff",
'Word', "$DataDir$year$mon.word",
'DaysData', "${DaysDir}/$year$mon$mday.dat",
'err', "${DataDir}LockErr.dat",
);
}
1;
#---
sub GetHostName{
# ホスト名取得 / IPのマスク処理
local( $tmp, @tmp);
$Host = $ENV{'REMOTE_HOST'};
$Addr = $ENV{'REMOTE_ADDR'};
if( $Host eq $Addr || !$Host ){
@tmp = split(/\./, $Addr );
$tmp = pack('C4', @tmp );
($Host) = gethostbyaddr($tmp,2) if(!$OffLine);
}
return if( $Host eq 'localhost');
# host/ip mask (.+) は当てはまる中で一番長い文字列にマッチする。
if( $Host =~ /^(.+)\.(.+)\.(.+)\.(.+)$/ ) { $Host = "www\.$2\.$3\.$4"; }
elsif( $Host =~ /^(.+)\.(.+)\.(.+)$/ ) { $Host = "www\.$2\.$3"; }
elsif( $Addr =~ /^(.+)\.(\d+)$/ ) { &ana( $Host ) if ( $Host);
$Host = "$1\.". 'x' x length($2); }
$Host = 'Unknown' if(!$Host); # シェルテスト用。(ホスト/IPともに取得できない場合)
}
1;
#---
sub GetAgentData{
# ブラウザ、OSの判定
local( $tmp );
$tmp = $ENV{'HTTP_USER_AGENT'};
for ( $tmp ){
( $_ ) = split(/ *via/); #プロクシ情報の削除。
# OS判定
if( /Win/ && /95/) { $Os = 'win95'; }
elsif( /Win/ && /98/) { $Os = 'win98'; }
elsif( /Win/ && /16/) { $Os = 'win3.1'; }
elsif( /Win/ && /NT/) { $Os = 'winNT'; }
elsif( /Mac/ && /68K/) { $Os = 'Mac68K'; }
elsif( /Mac/ && /PowerPC/){ $Os = 'MacPPC'; }
elsif( /Mac/ && /PPC/) { $Os = 'MacPPC'; }
elsif( /X11/ ) { $Os = 'Unix'; }
else { &ana( $_ ); } # 不明データ
# ブラウザ判定
if( /MSIE (\d)/ ){ $Agent = "Internet Explorer $1.x";} # MsIE
elsif( /Mozilla\/(\d)/ ){ $Agent = "Netscape $1.x"; } # Netscape
elsif( /(\S+)\/(\d)/ ){ $Agent = "$1 $2.x"; &ana( $_ ); } # 汎用1 Name/Ver
elsif( /\(/ ){ ($Agent) = split(/\(/); chop($Agent); &ana( $_ ); } # 汎用2 Name (...)
else { $Agent = $_; &ana( $_ ); } # 汎用3 Name Ver
$Os = 'Unknown' if(!$Os); # 不明データ
$Agent = 'Unknown' if(!$Agent); # 不明データ
}
}
1;
#---
#---------------------------------------
# 990417 検索キー取得部の変更。
# getReffData.pl - [e]モード共有不可
# 最初の数行を変更する必要有り。。
#---------------------------------------
sub GetRefData{
# リンク元の解析。
local ( $tmp,$dummy,@tmp );
$Reff = $ENV{'QUERY_STRING'}; # JavaScriptで呼び出した時。
$Reff = $ENV{'HTTP_REFERER'} if($SSI && !$Reff); # $SSI=1で、Jsを使わないとき。
$Reff = $ENV{'REFERER_URL'} if($SSI && !$Reff); # 上に同じ。
&ChkSearchWords;
$Reff =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if(!$Reff) { $Reff = 'Direct Access.';}
elsif( $Reff =~ /^file:/ ) { $Reff = 'Direct Access.';} # ローカルファイル
elsif( $Reff =~ /^mailbox:/ ) { $Reff = 'Direct Access.';} # メールボックス
elsif( $Reff !~ /^http:/ ) { &ana( $Reff ); # 不明なアクセス
$Reff = 'Direct Access.';}
else{
# &jcode'convert( *Reff,'euc'); # 変換によってアドレスが変わるのでヤメ。
$Reff =~ s/\?/\&\#63;/g; # これはいらない? '?'のエスケープ
$Reff =~ s/</g; # テーブルが崩れるのを防止。
$Reff =~ s/\r|\n/ /g; # 改行によるデータ破損防止。
}
}
sub ChkSearchWords{
# KeyWordの取得 ( @Wordsの設定 )
return if( $Reff !~ /^(http:.+)\?(.+\=.+)$/ ); # [?]と[=]をこの順で含む
local($sURL,$sKEY,$Words);
local($RefURL,$Query) = ($1,$2);
while( ($sURL,$sKEY) = each %Search ){
if( $RefURL =~ /$sURL/ && $Query =~ /$sKEY\=/ ){
$Words = &GetQuery( $Query, $sKEY );
last;
}
}
return if(!$Words);
$Words =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$Words =~ tr/^[A-Z]/^[a-z]/;
# EUCに変換
&jcode'h2z_euc( *Words ); # ほとんどの場合ページと同じEUCコード。違う場合文字化け。
&jcode'convert( *Words,'euc'); # 文字コードの変換
# &jcode'tr( *Words, '」-」レ','a-Z'); # 2バイト=>1バイト
$Words =~ s/</g; # キーに等が含まれる場合(一応)
$Words =~ s/\r|\n/ /g; # 改行によるデータ破損防止。
if( $KeyDivide ){
@Words = split (/\+|。。/,$Words); # (半角|全角)スペース(EUC)で分割。
}
else{
@tmp = split (/\+|。。/,$Words);
@Words = ( join( ', ', sort(@tmp)) );
}
$Reff = $RefURL;
$Reff =~ s|^(http://[^/]+/)(.+)$|$1|;
# /bin/search など、検索プログラムへのパスを削除。。(ダメ?)
}
sub GetQuery{
# QUERY_STRINGからKeyに対応するフォーム値を返す。
local(@pairs);
local($query, $key ) = @_;
@pairs = split(/\&/, $query );
for( @pairs ){
if( /^$key\=(.+)$/ ){
return $1;
}
}
return "";
}
1;
#--- end of 'getReff.pl' ----
#---
# - メインデータフォーマット.
__END__
wday: 0 0
wday: 1 0
wday: 2 0
wday: 3 0
wday: 4 0
wday: 5 0
wday: 6 0
mday: 01 0
mday: 02 0
mday: 03 0
mday: 04 0
mday: 05 0
mday: 06 0
mday: 07 0
mday: 08 0
mday: 09 0
mday: 10 0
mday: 11 0
mday: 12 0
mday: 13 0
mday: 14 0
mday: 15 0
mday: 16 0
mday: 17 0
mday: 18 0
mday: 19 0
mday: 20 0
mday: 21 0
mday: 22 0
mday: 23 0
mday: 24 0
mday: 25 0
mday: 26 0
mday: 27 0
mday: 28 0
mday: 29 0
mday: 30 0
mday: 31 0
mday: 32 0
hour: 00 0
hour: 01 0
hour: 02 0
hour: 03 0
hour: 04 0
hour: 05 0
hour: 06 0
hour: 07 0
hour: 08 0
hour: 09 0
hour: 10 0
hour: 11 0
hour: 12 0
hour: 13 0
hour: 14 0
hour: 15 0
hour: 16 0
hour: 17 0
hour: 18 0
hour: 19 0
hour: 20 0
hour: 21 0
hour: 22 0
hour: 23 0
agent: Internet Explorer 5.x 0
agent: Internet Explorer 4.x 0
agent: Internet Explorer 3.x 0
agent: Netscape 5.x 0
agent: Netscape 4.x 0
agent: Netscape 3.x 0
agent: Netscape 2.x 0
agent: Unknown 0
os: win98 0
os: win95 0
os: winNT 0
os: win3.1 0
os: Mac68K 0
os: MacPPC 0
os: Unix 0
os: Unknown 0
--- UnknownData ---
|