作者StubbornLin (Victor)
看板perl
标题[问题] 档案会变成empty@@"
时间Thu Sep 14 17:35:40 2006
我的网站有一个很久以前写的下载管理程式，平时运作还正常
但是就是有一点很奇怪，隔一段时间，下载的资料档会突然变成empty
也就是0位元组，里面什麽都没有
我想是因为下载人数会去更动到档案的部份，如果有两个人同时下载档案
可能会造成档案损坏之类的情况，但这只是个人推测
而奇怪的是我看我原始档里面有lock档阿，可是不知为何
隔一段时间资料档就会突然清空
以下是该Perl程式的档案，新增人数的函数是addtime
谁可不可以帮我看一下，是我锁档案没弄好所造成的错误，还是什麽样的情况
会造成档案内容清空?
#!/usr/bin/perl
## ~---------------------
## ~ 取得资料
## ~---------------------
sub getdata{
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
}else{
$in = $ENV{'QUERY_STRING'};
}
@pairs = split(/&/,$in);
foreach $pair(@pairs) {
($name,$value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; #解码
$value =~ s/\,/,/g; #取代,号
$value =~ s/\r\n/<br>/g; #取代断行
if ($FORM{$name} ne ''){
$FORM{$name} = "$FORM{$name},$value"; #给予FORM
}else{
$FORM{$name} = $value;
}
}
}
## ~---------------------
## ~ 系统设定
## ~---------------------
$perl_url = 'download.pl'; ## 程式位置
$data_url = 'download/data.cgi'; ## 资料库位置
$sn_url = 'download/sn.txt'; ## 流水号档
$id = '********'; ## 管理帐号
$pass = '*******'; ## 管理密码
$s_url{'out'} = 'download_out.htm' ; ## 外部样版
$s_url{'table'} = 'download/table.htm' ; ## 表格样版
$s_url{'adm_m'} = 'download/adm_menu.htm' ; ## 管理员选单样版
$s_url{'adm_t'} = 'download/adm_table.htm' ; ## 管理员表格样版
$s_url{'login'} = 'download/login.htm' ; ## 管理员登入样版
$s_key{'in'} = '!~in~!'; ## 外部样版置入
$s_key{'name'} = '!~name~!'; ## 名称
$s_key{'text'} = '!~text~!'; ## 简介
$s_key{'d_url'} = '!~d_url~!'; ## 载点
$s_key{'c_time'} = '!~c_time~!'; ## 次数
$s_key{'size'} = '!~size~!'; ## 大小
$s_key{'pic'} = '!~pic~!'; ## 图片位置
$s_key{'url'} = '!~url~!'; ## 程式位置
$s_key{'sn'} = '!~sn~!'; ## 档案编号
## ~---------------------
## ~ 主要程式
## ~---------------------
&getdata; ## 取得资料
&getcookie; ## 取得Cookie
&setadmcookie; ## 设定ADMCookie
&loadskins; ## 载入样版
if ($FORM{mode} eq 'new' && &c_idps == 1){
&newfile;
print "Location: $perl_url\n\n"; ## 跳回原页
exit;
}elsif($FORM{mode} eq 'download'){
&addtime($FORM{sn});
print "Location: $FORM{url}\n\n"; ## 跳到档案
exit;
}elsif($FORM{mode} eq 'login'){
print "Content-type: text/html; charset=big5\n\n"; ##输出网页档头
$skin_get{login}=~ s/$s_key{url}/$perl_url/g;
$skin_get{out} =~ s/$s_key{in}/$skin_get{login}/g;
print "$skin_get{out}";
exit;
}elsif($FORM{'mode'} eq 'out' && &c_idps == 1){
$date_gmt = "1987, 1\-1\-1 1:1:1 GMT";
print "Set-Cookie:id=0; expires=$date_gmt\n";
print "Set-Cookie:pass=0; expires=$date_gmt\n";
print "Location: $perl_url\n\n"; ## 跳回原页
exit;
}elsif($FORM{mode} eq 'fix' && &c_idps == 1){
&fixfile($FORM{sn});
print "Location: $perl_url\n\n"; ## 跳回原页
exit;
}elsif($FORM{mode} eq 'top' && &c_idps == 1){
&topfile($FORM{sn});
print "Location: $perl_url\n\n"; ## 跳回原页
exit;
}elsif($FORM{mode} eq 'del' && &c_idps == 1){
&delfile($FORM{sn});
print "Location: $perl_url\n\n"; ## 跳回原页
exit;
}elsif(&c_idps == 1){
&shelladmhtml;
print "Location: $perl_url\n\n"; ## 跳回原页
exit;
}
&shellhtml;
exit;
## ~---------------------
## ~ 输出网页
## ~---------------------
sub shellhtml{
print "Content-type: text/html; charset=big5\n\n"; ##输出网页档头
if ( !( open(GD,"<$data_url") ) ){&error("$data_url 无法读档");}
@gd=<GD>;
close(GD);
foreach $gad(@gd){
($GD{'name'},$GD{'text'},$GD{'d_url'},$GD{'pic'},$GD{'size'},$GD{'c_time'},$GD{'sn'})=
split(/,/,$gad) ;
chomp($GD{'sn'});
$gethtml = $skin_get{table};
foreach $keyi(keys %s_key){
$gethtml =~ s/$s_key{$keyi}/$GD{$keyi}/g;
}
$htmlshell .= $gethtml;
}
if ($htmlshell eq ''){
$htmlshell='<br><div align="center"></div><table width="500"
border="0" align="left"><tr><td><div align="center">没有档案
</div></td></tr></table><br>';
}
$htmlshell .= "<div align=\"left\"><br><a href=\"$perl_url?mode=login\">管
理作品下载</a></div>";
$skin_get{out} =~ s/$s_key{in}/$htmlshell/g;
print "$skin_get{out}";
}
## ~---------------------
## ~ 输出管理员用网页
## ~---------------------
sub shelladmhtml{
print "Content-type: text/html; charset=big5\n\n"; ##输出网页档头
if ( !( open(GD,"<$data_url") ) ){&error("$data_url 无法读档");}
@gd=<GD>;
close(GD);
$GD{'url'} =$perl_url;
$htmlshell = $skin_get{'adm_m'};
$htmlshell =~ s/$s_key{url}/$perl_url/g;
foreach $gad(@gd){
($GD{'name'},$GD{'text'},$GD{'d_url'},$GD{'pic'},$GD{'size'},$GD{'c_time'},$GD{'sn'})=
split(/,/,$gad) ;
chomp($GD{'sn'});
$gethtml = $skin_get{adm_t};
foreach $keyi(keys %s_key){
$gethtml =~ s/$s_key{$keyi}/$GD{$keyi}/g;
}
$htmlshell .= $gethtml;
}
if ($htmlshell eq ''){
$htmlshell='<br><div align="center"></div><table width="500"
border="0" align="left"><tr><td><div align="center">没有档案
</div></td></tr></table><br>';
}
$htmlshell .= "<div align=\"left\"><br><a href=\"$perl_url?mode=login\">管
理作品下载</a></div>";
$skin_get{out} =~ s/$s_key{in}/$htmlshell/g;
print "$skin_get{out}";
}
## ~---------------------
## ~ 新增下载资料
## ~---------------------
sub newfile{
if ( !( open(GD,"<$data_url") ) ){&error("$data_url 无法读档");}
@gd=<GD>;
close(GD);
&getsn;
$name = $FORM{'name'};
$text = $FORM{'text'};
$d_url = $FORM{'d_url'};
$pic = $FORM{'pic'};
$size = $FORM{'size'};
$wd = "$name,$text,$d_url,$pic,$size,0,$sn\n";
unshift(@gd,$wd);
## 对档尾的断行去除
$last=pop(@gd); #取出
chomp($last);
push(@gd,$last); #放回
## 存回记录档
if ( !( open(SD,">$data_url") ) ){&error("$data_url无法存档");}
flock(2,SD); #锁档
print SD @gd;
flock(8,SD); #开锁
close(SD);
&addsn;
}
## ~---------------------
## ~ 删除档案
## ~---------------------
sub delfile{
## 取得记录档
if ( !( open(GD,"<$data_url") ) ){&error("$data_url无法读档");}
@gd=<GD>;
close(GD);
$delsn=$_[0];
foreach $gad(@gd){
($name,$text,$d_url,$pic,$size,$c_time,$sn)= split(/,/,$gad) ;
chomp($sn);
if ($delsn == $sn){
$gad='';
}
}
## 存回记录档
if ( !( open(SD,">$data_url") ) ){&error("$data_url无法存档");}
flock(2,SD); #锁档
print SD @gd;
flock(8,SD); #开锁
close(SD);
}
## ~---------------------
## ~ 档案置顶
## ~---------------------
sub topfile{
## 取得记录档
if ( !( open(GD,"<$data_url") ) ){&error("$data_url无法读档");}
@gd=<GD>;
close(GD);
$topsn=$_[0];
foreach $gad(@gd){
($name,$text,$d_url,$pic,$size,$c_time,$sn)= split(/,/,$gad) ;
chomp($sn);
if ($topsn == $sn){
splice(@gd,$i,1);
unshift(@gd,"$name,$text,$d_url,$pic,$size,$c_time,$sn\n");
}
$i++;
}
## 对档尾的断行去除
$last=pop(@gd); #取出
chomp($last);
push(@gd,$last); #放回
## 存回记录档
if ( !( open(SD,">$data_url") ) ){&error("$data_url无法存档");}
flock(2,SD); #锁档
print SD @gd;
flock(8,SD); #开锁
close(SD);
}
## ~---------------------
## ~ 增加次数
## ~---------------------
sub addtime{
## 取得记录档
if ( !( open(GD,"<$data_url") ) ){&error("$data_url无法读档");}
@gd=<GD>;
close(GD);
$addsn=$_[0];
foreach $gad(@gd){
($name,$text,$d_url,$pic,$size,$c_time,$sn)= split(/,/,$gad) ;
chomp($sn);
if ($addsn == $sn){
$c_time++;
$gad= "$name,$text,$d_url,$pic,$size,$c_time,$sn\n";
}
}
## 对档尾的断行去除
$last=pop(@gd); #取出
chomp($last);
push(@gd,$last); #放回
## 存回记录档
if ( !( open(SD,">$data_url") ) ){&error("$data_url无法存档");}
flock(2,SD); #锁档
print SD @gd;
flock(8,SD); #开锁
close(SD);
}
## ~---------------------
## ~ 修改档案
## ~---------------------
sub fixfile{
## 取得记录档
if ( !( open(GD,"<$data_url") ) ){&error("$data_url无法读档");}
@gd=<GD>;
close(GD);
$fixsn=$_[0];
$name = $FORM{'name'};
$text = $FORM{'text'};
$d_url = $FORM{'d_url'};
$pic = $FORM{'pic'};
$size = $FORM{'size'};
$c_time= $FORM{'c_time'};
foreach $gad(@gd){
($temp,$temp,$temp,$temp,$temp,$temp,$sn)= split(/,/,$gad) ;
chomp($sn);
if ($fixsn == $sn){
$gad= "$name,$text,$d_url,$pic,$size,$c_time,$sn\n";
}
}
## 对档尾的断行去除
$last=pop(@gd); #取出
chomp($last);
push(@gd,$last); #放回
## 存回记录档
if ( !( open(SD,">$data_url") ) ){&error("$data_url无法存档");}
flock(2,SD); #锁档
print SD @gd;
flock(8,SD); #开锁
close(SD);
}
## ~---------------------
## ~ 设定ADM的Cookie
## ~---------------------
sub setadmcookie{
if ($FORM{id} ne '' && $FORM{pass} ne ''){
print "Set-Cookie:id=$FORM{id};\n";
print "Set-Cookie:pass=$FORM{pass};\n";
$COOKIE{id}=$FORM{id};
$COOKIE{pass}=$FORM{pass};
}
}
## ~---------------------
## ~ 得到Cookie
## ~---------------------
sub getcookie{
$cookies = $ENV{'HTTP_COOKIE'};
@pairs = split(/;/,$cookies); ##取得不同组的cookie
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ s/ //g;
$COOKIE{$name} = $value;
}
if ($FORM{'pass'} ne ''){ $COOKIE{'pass'}=$FORM{'pass'};}
if ($FORM{'id'} ne ''){ $COOKIE{'id'}=$FORM{'id'};}
}
## ~---------------------
## ~ 得到页数资料
## ~---------------------
sub get_page{
$FORM{page}-=1;
if ($book_m <= $page_ch){ ## 篇数没有超过指定的换页数
$book_s=0;
$book_e=$book_m-1;
}else{
if ($book_m % $page_ch==0){
$page_m=$book_m / $page_ch;
}else{
$page_m=int($book_m / $page_ch)+1;
}
if ($FORM{page}+1>=$page_m){ ## 最後一页 或超过
$FORM{page}=$page_m-1;
$book_s=$FORM{page} * $page_ch;
$book_e=$book_m -1 ;
}else{
if ($FORM{page} < 0){
$FORM{page}=0;
}
$book_s=$FORM{page} * $page_ch;
$book_e=(($FORM{page}+1) * $page_ch)-1;
}
}
if ($page_m eq ''){
$page_m=0;
}
}
## ~---------------------
## ~ 载入所有样版
## ~---------------------
sub loadskins{
foreach $skinkey(keys %s_url) {
&loadskin($s_url{$skinkey},$skinkey)
}
}
## ~---------------------
## ~ 载入样版
## ~---------------------
sub loadskin{
if ( !( open(SKIN,"<$_[0]") ) ){&error("$_[0] 样版 无法读取");}
@gskin=<SKIN>;
close(SKIN);
foreach $line(@gskin){
$skin_get{$_[1]}="$skin_get{$_[1]}$line";
}
}
## ~---------------------
## ~ 得到流水号
## ~---------------------
sub getsn{
if ( !( open(SN,"<$sn_url") ) ){&error("$sn_url无法读取");}
$sn=<SN>;
close(SN);
## 流水号档内容为空 设为0
if ($sn eq '') {
$sn=0;
}
}
## ~---------------------
## ~ 递增流水号
## ~---------------------
sub addsn{
$sn++;
if ( !( open(SN,">$sn_url") ) ){&error("$sn_url无法存档");}
print SN $sn;
close(SN);
}
## ~---------------------
## ~ 发生错误
## ~---------------------
sub error{
print "Content-type: text/html; charset=big5\n\n"; ##输出网页档头
print "发生错误 : $_[0]" ;
exit;
}
## ~---------------------
## ~ 确认帐号密码
## ~---------------------
sub c_idps{
if(($FORM{id} eq $id && $FORM{pass} eq $pass) ||
($COOKIE{id} eq $id && $COOKIE{pass} eq $pass)){
return 1;
}else{
return 0;
}
}
--
VICTOR工作室 |
PTT游戏设计版隆重开幕!
|
不管是新手老手，程式美工音乐企划....
URL :
http://www.kinmen.info/vic/ |
都欢迎来游戏设计版参与讨论 XD
|
战略高手>
C/C++ |
GameTopics>
Visual Basic 6.0 |
GameDesign
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 140.134.242.171