ファイル名: w/w2/test.cgi

#!/usr/local/bin/perl

$|=1;
$cgi_url = './test.cgi';
$datafile ='warewan_uploadbbs.memo';
$max = '6';
$Title = 'TEST_CGI';
$BODY = '<BODY BGCOLOR="#000000" TEXT="#C0C0C0" link="#00FFFF" vlink="#0099FF" alink="#FFFF00">';
#-----------------------------------------------------------------------------
require '../jcode.pl';
@wdays = ( "日", "月", "火", "水", "木", "金", "土", "日" );
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
#日付
$date = sprintf("%04d/%02d/%02d(%s)%02d:%02d:%02d",$year + 1900, $mon + 1, $mday, @wdays[$wday], $hour, $min,$sec);

#ナンバー指定、時間から、ファイル名作成
$number = ( "$sec$min$hour" );

if ($ENV{CONTENT_TYPE} =~ /multipart\/form-data/) {
binmode(STDIN);
read(STDIN, $read_data, $ENV{'CONTENT_LENGTH'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'GET'){#現在関係なし。
@pairs = split(/&/, $ENV{'QUERY_STRING'});
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/<!--(.|\n)*-->//g;
$value =~ s/\n//g;
$value =~ s/\,//g;
$value =~ s/</</g;
   $value =~ s/>/>/g;
   $value =~ s/"/"/g;
&jcode'convert(*value,'sjis');
$FORM{$name} = $value;
}
} else { &error("METHOD");}
#データ−分解
@in = split(/-*\S*\s*Content-Disposition: form-data; name="\w*"/, $read_data);
#最初は要らない。
shift (@in);
#画像データ−を取り出す。
$img_name_data = pop (@in);
#書きこみ処理
foreach $in (@in)
{
$in =~ s/\r\n\r\n//;
$in =~ tr/+/ /;
$in =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$in =~ s/<!--(.|\n)*-->//g;
$in =~ s/\n//g;
$in =~ s/\,//g;
$in =~ s/</</g;
   $in =~ s/>/>/g;
   $in =~ s/"/"/g;
push (@form_lines, $in);
}
chop(@form_lines);
#フォームからの、データーなら、書きこむ
if ($form_lines[0] eq 'tru')
{
#画像データ−取り出し。最初と、最後は、要らない。
$pos_f = index( $img_name_data, "\r\n\r\n") + 4;
$pos_e = index( $img_name_data, "-------------------");
$data_size = $pos_e - $pos_f ;
$img_data = substr( $img_name_data, $pos_f, $data_size );
#画像ファイル名を調べてアップする。
if( $img_name_data =~ /Content-Type: image\/(.*)jpeg/ )
{
$fname = '.jpg';
if (!open(OUT, "> $number.jpg")) {&error("open");}
binmode(OUT);
print OUT $img_data;
close(OUT);
}
if ($img_name_data =~ /Content-Type: image\/(.*)gif/ )
{
$fname = '.gif';
if (!open(OUT, "> $number.gif")) {&error("open");}
binmode(OUT);
print OUT $img_data;
close(OUT);
}
#書きこみ記事のライン処理
if ($fname eq ''){ $img = '';} else { $img = "$number$fname"; }
$line_data = "$date,$form_lines[1],$form_lines[2],$img,$form_lines[3]\n";
#書きこみ
if (!open(IN,"$datafile")) { &error("open"); }
@memo_lines = <IN>;
$line_count = @memo_lines;
close(IN);
unshift (@memo_lines,$line_data);
if ( $line_count >= $max )
{
($memo_date,$memo_name,$memo_dai,$memo_img,$memo_comment) = split(/,/, $memo_lines[$max]);
#MAX件数を超えたら、画像ファイルも削除
unlink "$memo_img";
@DATA = @memo_lines[0..$max-1];
}
else { @DATA = @memo_lines ;}

if (!open(OUT,">$datafile")) { &error("open"); }
print OUT (@DATA);
close(OUT);
}
#============================================================================
if (!open(IN,"$datafile")) { &error("open"); }
@lines = <IN>;
close(IN);

&head;
print "<form method=post enctype=\"multipart/form-data\" action=\"$cgi_url\">\n";
print "<input type=hidden name=action value=tru>\n";
print "<FONT SIZE=+3>TEST</FONT> MAX $max件<BR>\n";
print "Name<input type=text name=name size=17>\n";
print "Title<input type=text name=title size=17>\n";
print "<BR>comment<BR><textarea name=comment rows=4 cols=80></textarea>\n";
print "<BR>IMG<input type=file name=\"img\">\n";
print "<input type=submit value=\"OK\">\n";
print "</form>\n";
print "<a href=\"$cgi_url\">RECORD</a>\n";
print "</BLOCKQUOTE>\n";
print "<HR>\n";
foreach $line (@lines)
{
chop;
($memo_date,$memo_name,$memo_dai,$memo_img,$memo_comment) = split(/,/, $line);
$memo_comment =~ s/\r/<br>/g;
$count++;
print "<blockquote>\n";
print "[$count] $memo_date by$memo_name TITLE $memo_dai\n";
print "<BR><BR>\n";
print "$memo_comment\n";
print "<BR><BR>\n";
if( $memo_img ne ""){
print "<CENTER><IMG SRC=\"$memo_img\"></CENTER>\n";
}
print "</blockquote>\n";
print "<HR>\n";
}
print "</BODY>\n";
print "</HTML>\n";
exit;
#--------------------HTMLのヘッダー--------------------------------------
sub head {

print "Content-type: text/html\n\n";

print "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n";
print "$BODY\n";
}
#-------------------------エラー設定-----------------------------------
sub error
{
#エラーサブルーチンの引数にて受け取る
&head;
print "<center>\n";
print "<BR><BR><BR>\n";
print "$_[0] エラーです。\n";
print "<BR><BR>\n";
print "<a href=\"$cgi_url\">BACK</a>\n";
print "</center>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;
}