#!/usr/bin/perl BEGIN { use FindBin qw($Bin); use lib './lib', "$FindBin::Bin/lib"; use CGI; use LWP::Simple; if($ENV{'SERVER_SOFTWARE'} =~ /IIS/i){ chdir $FindBin::Bin; } } $q = new CGI; @param = $q->param; %param = &get_param(@param); $LockFile = "./lock"; $OutFile = $param{f}; # 書き出し先 $InFile = $param{f}; $key = $param{k}; $n = $param{n}; $code = $param{code}; #---------------------------------------------------------------------- # 変更必須項目ここから #---------------------------------------------------------------------- # このURLを変更 $url = "http://www.dadechemistry.com/update/get.cgi?n=$n&key=$key&code=$code"; # 更新間隔の設定 $Interval = 100; # 4桁の半角数字で表す。 頭のゼロは省略可。1125 と書けば投稿間隔は 11時間25分 となる。 #---------------------------------------------------------------------- # ここまで #---------------------------------------------------------------------- # テストモードではファイルロックは行わない if($param{mode} ne "test"){ &Lock($LockFile); } $content = get($url); $TargetStart = qq(); $TargetEnd = qq(); open(FILE, "<$InFile") or error("ファイルの読み込みに失敗しました"); while(){ push @lines, $_; } close FILE; if($lines[0] ne ""){ open(OUT, ">$OutFile") or error("ファイルの書き出しに失敗しました"); my $flag = 0; my $check = 0; foreach(@lines){ if($flag == 1 and $check == 0){ $check = 1; print OUT $content; next; } if($_ =~ /$TargetStart/){ $flag = 1; } if($_ =~ /$TargetEnd/){ $flag = 0; $check = 0; print OUT "\n" . $_; next; } if($flag == 1 and $check == 1){ next; } print OUT $_; } close OUT; } print qq(Content-type: text/html; charset=$CHARSET\n\n); print "ok"; sub Lock{ my $File = shift; my $data = &GetDate(); my $UpdateTime = $Interval; my $LastUpdate; my $Now = $data->{yearDay}; if(-f $File){ open(FILE, "<$File"); $LastUpdate = ; close FILE; my $Limit = $Now - $UpdateTime; if($Limit >= $LastUpdate){ open(SUB, ">$File"); print SUB $Now; close SUB; }else{ &error(); } }else{ open(SUB, ">$File"); print SUB $Now; close SUB; } } sub unLock{ my $File = shift; if(-f $File){ unlink $File; } } sub get_param{ @param = @_; foreach $key (@param){ $value = $q->param($key); $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; $value =~ s/&/&/g; $value =~ s//>/g; $value =~ s/\x0D\x0A/
/g; $value =~ tr/\t/ /; # $value =~ s/\\/\\\\/g; $value =~ s/"/#double#/g; $param{$key} = $value; } return(%param); } sub GetDate{ ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $year_day = sprintf("%04d%02d%02d", $year + 1900, $mon +1, $mday); $hour_minit = sprintf("%02d%02d", $hour, $min); $date->{year} = $year + 1900; $date->{mon} = $mon + 1; $date->{mday} = $mday; $date->{yearDay} = "$year_day" . "$hour_minit"; return($date); } sub error { my ($mes) = @_; print < エラー

ERROR

以下のエラー内容をご確認の上、ブラウザの「戻る」ボタンで前の画面へ戻り、再度情報を送信してください

$mes

END exit; }