cgiの投票回数制限設定について(Perl)

投票cgiを作成していますが、以下のPerlでは、同一IPから1日１回の投票しかできません。

同一IPからの投票を１日連続５回まで許可する仕組みにしたいと考えています。（６回目以降は単にカウントされないだけで警告等は出さない）

以下のPerlをどのように改造すれば良いか具体的にアドバイスを頂けると大変助かります。

かなり専門的な内容で恐縮ですが、困っておりますので、何卒よろしくお願い致します。
ｍ（＿　＿）ｍ


---------------------

# IPアドレスのチェック

sub IpCheck {
if (!-e $iplog) {
&TimeLog;
}
$last = (localtime((stat($iplog))[9] + $jisa))[3];
$today = (localtime($nowtime))[3];
if ($last != $today) {
unlink($iplog);
&TimeLog;
}
open(TLOG,"<$iplog");
@IP = <TLOG>;
close(TLOG);

$l = 0;
foreach (@IP) {
$_ =~ s/\r|\n//g;
if ($_ =~ /^$addr/) {
&NoCnt;

}
elsif ($l == $#IP) {
if (!open(RTIP,">>$iplog")) {
&Error(4);
}
print RTIP "$addr\n";
close(RTIP);
&CNTUP;
}
$l++;
}
}

sub TimeLog {
if (!open(TIME,">$iplog")) {
&Error(5);
}
print TIME "$addr\n";
close(TIME);
chmod(0666,$iplog);
&CNTUP;
}

#-------------------------------------------------
# クリックカウントアップ

sub CNTUP {

#ファイルロック開始
if( $lockkey ne '0' ){ &LOCK; }

if (!open(IN,"$linkdata_file")) { &ERROR( read_linkdata ); }
@BASE = <IN>;
close(IN);

foreach $data (@BASE) {

#データリスト読込
&LINKDATALIST;

if( $in{'targetno'} eq $CNTNUM ){

$COUNTERUP = $CLICK + 1;
$targeturl = $LINKURL;

$new_data = "$CNTNUM,$DATE_LINKDATA,$DATE_LMT,$DATE_ESY,$OPN,$NEWMARK,$CATEGORY,$LINKNAME,$HONORIFIC,$LINKURL,$COMMENT,$COUNTERUP,$IMAGE,\n";

}else{

$new_data = "$CNTNUM,$DATE_LINKDATA,$DATE_LMT,$DATE_ESY,$OPN,$NEWMARK,$CATEGORY,$LINKNAME,$HONORIFIC,$LINKURL,$COMMENT,$CLICK,$IMAGE,\n";

}
#ファイルの最初にデータを保存する
push( @TOTAL , $new_data );
}

#実際にファイルに書き込む
if (!open(NOTE,">$linkdata_file")) { &ERROR( read_linkdata ); }
print NOTE @TOTAL;
close(NOTE);

#ファイルロック解除
if( $lockkey ne '0' ){ &UNLOCK; }

#HTML出力
print "Location: $targeturl\n\n";
exit;

No.2 ベストアンサー 回答者： N60-BASIC 回答日時： 2011/04/25 04:18

# IPアドレスのチェック結果に応じてカウント処理

sub IpCheck {
_IpCheck($addr, $iplog) ? CNTUP() : NoCnt();
}

# IPアドレス毎の書き込み回数チェック
sub _IpCheck {
my $addr = shift;# 調べたいIPアドレス
my $iplog = shift;# データファイル名

my $count_max = 5;# IPアドレス毎の最大書き込み回数

# 現在日付の取得
my $today = sub {
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($_[0]);
sprintf('%04d/%02d/%02d', $year+1900, $mon+1, $mday);
}->(time);

# IPアドレス毎の書き込み回数の読み書き
use Fcntl;
sysopen(my $fh, $iplog, O_CREAT|O_RDWR) or Error(5);# 読み書きモード／ファイルがなければ新規作成
eval { flock($fh, 2); };# ちゃんとロックしないと壊れます
eval { chmod(0666, $fh); };# 動かない環境もあるので念のためeval
binmode($fh, ':crlf') if($^O =~ /MSWin32/);# Windowsでは改行コードをCR+LFで読み書き
seek($fh, 0, 0);
my $lastday = <$fh> || '';# データファイルの1行目の日付を読む
chomp $lastday;
my %count;
if($lastday eq $today) {
# 日付が同じ場合だけ過去データを読む
while(my $data = <$fh>) {
chomp $data;
my($ip, $c) = split /\t/, $data;
$count{$ip} = $c;
}
}
$count{$addr}++;
return if($count{$addr} > $count_max);# 回数オーバーならundefを返す
seek($fh, 0, 0);
print $fh $today."\n";# データファイルの1行目に日付を保存
foreach my $ip (sort keys %count) {
print $fh $ip."\t".$count{$ip}."\n";
}
truncate($fh, tell($fh));
close($fh);
return 1;# 書き込み可能な場合は1を返す
}

# Perl5の入門書を読むことをお勧めします。
# Perl4は絶滅して久しいですし、何よりPerl4で書かれたプログラムは読むのがつらい・・・

この回答への補足

N60-BASICさま

先ほど、試しました！完璧でした！！(^^)/
感動して、背中に武者震いが走りました！

貴方様のような素晴らしい方に御指導いただけて大変光栄です。

大変困っていたので、今回の御指導には筆舌に尽くしがたいほど非常に感謝しております。

世の中には天才プログラマーがいるんだということを身を持って感じました。

誠にありがとうございました。ｍ（＿　＿）ｍ

補足日時：2011/04/25 21:40

この回答へのお礼

N60-BASICさま
詳細な御説明、誠にありがとうございました。
ｍ（＿　＿）ｍ

非常に参考になり、目から鱗が落ちました！
スペシャリストの方は、やはり違いますね！感動です。
早速、組み込んで試してみたいと思います。
Perl5も勉強します!

お礼日時：2011/04/25 06:22

No.1 回答者： osamuy 回答日時： 2011/04/25 01:13

自分なら、dbmopen/tieを使って、IPアドレス:日付をキーにしてアクセス回数を管理します。

間違いを気にせず書くと、こんな感じ：

tie %cnt, (略) or die;
$v = $cnt{ $ip, $today };
if ( $v < 5 ){
データ追記処理; $cnt{ $ip, $today } = $v + 1;
}
untie %cnt;

この回答へのお礼

御回答誠にありがとうございました。
なるほど、日付をキーにして回数を管理するわけですね！
とても参考になりました！（＾＾）

お礼日時：2011/04/25 06:19