情報処理資料($curn/${Fisn})[$waitsec]

#! /usr/local/bin/perl ## 画像ファイル(*.jpg)を表示する ## version 2005.11a srand(time); rand(100); ## なぜか jperl4 on Win だと最初の一回目は乱数になってない (^_^; $| = 1; #print "Content-type: text/plain\n\n"; { local($qss) = $ENV{'QUERY_STRING'}; local(@Qs) = split(/\&/, $qss); foreach $qss ( @Qs ) { local($qa,$qb) = ( $qss, 1, ); if($qss =~ /=/) { ($qa, $qb) = ( $`, $', ); } if($qa eq 'D') { $D = $qb; } if($qa eq 'img') { $Xmode = 'img'; if($qb =~ /./) { $imgfn = $qb; }} } } if($D !~ /./ || ! -d $D) { $D = '.'; } { local(@Fis_temp); if(opendir(D, $D)) { @Fis_temp = grep(/^[^\.].*\.(jpe?g|gif|png|body)$/, readdir(D)); closedir(D); } @Fis = sort(grep(/[^ ]/, (@Fis_temp))); } { $Fisn = $#Fis + 1; if(open(I, "$D/current.dat")) { $cur = ; $cur =~ s/[ \t\r\n]*$//; close(I); } if($cur ne 'fin') { $cur += 0; if($cur < 0) { $cur = 0; } if($#Fis < $cur) { $cur = $#Fis; } } } if($Xmode ne 'img') { if($cur eq 'fin') { &proc_finale; } else { &proc_html; } } else { &proc_image; } exit; sub proc_image { $fn = $Fis[$cur]; if($imgfn =~ /./ && -f "$D/$imgfn") { $fn = $imgfn; } %typs = ( 'jpg', 'image/jpeg', 'png', 'image/png', 'gif', 'image/gif', 'swf', 'application/x-shockwave-flash', ); local($fnx) = $fn; local($zz) = 'image/jpeg'; # default while(length($fnx) > 0) { if($typs{$fnx} =~ /./) { $zz = $typs{$fnx}; last; } $fnx =~ s/^.//; } local($siz) = (-s "$D/$fn"); if(open(I, "$D/$fn")) { binmode(I); binmode(STDOUT); # print "Content-type: $zz\n\n"; print "Content-type: $zz\n" . "Pragma: no-cache\nCache-Control: no-cache\n\n"; local($zz, $zi, ); while(read(I, $zi, 4096)) { $zz .= $zi; } close(I); print $zz; } else { print "Content-type: text/plain\n\nCannot Open: $D/$Fis[$cir]\n"; } } sub proc_html { $URI = $ENV{'REQUEST_URI'}; $URI =~ s/\?[^\?]*$//; if($D ne '.') { $URI .= "?D=${D}\&"; } else { $URI .= '?'; } #$waitsec = int(rand(11))+10; $waitsec = int(rand(6))+10; $curn = $cur + 1; local($COMMAND) = ""; if($Fis[$cur] =~ /\.body$/) { local($x, $z); if(open(I, "$D/$Fis[$cur]")) { while($x = ) { $x =~ s/\$D\$\//${URI}img=/g; $z .= $x; } close(I); } $COMMAND = $z; } print < 情報処理資料($curn/${Fisn})[$waitsec] $COMMAND EOH } sub proc_finale { $URI = $ENV{'REQUEST_URI'}; $URI =~ s/\?[^\?]*$//; if(open(I, "$D/finale.html") || open(I, "$D/finale.htm")) { local($obuf) = "Content-type: text/html\n\n"; while() { $obuf .= $_; } close(I); $obuf =~ s/\*MENU\*//g; ## これは cntl.cgi のみ有効のもの print $obuf; } else { &proc_html; } }