ファイル名: w/w9/warewan.cgi

#!/usr/local/bin/perl

$|=1;
$cgi_url ='http://vaio/HP2/power/tes/warewan.cgi';

@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 (!open(IN,"warewan.memo")) { &error("open");}
@lines = <IN>;
close(IN);


if($ENV{'CONTENT_LENGTH'} > 200){#適当、このぐらいだと、ナンにも無くてもUPしない。
#############################アップロード###################################
#バイナリ-で、読みこみ
binmode(STDIN);
#普通に全部
read(STDIN, $read_data, $ENV{'CONTENT_LENGTH'});

#はじめのほうは、ファイル情報で、別利用。正規表現で、ファイル名など取り出せる。
#書きこむ位置を決める。\r\n\r\nが、出てくる位置をindexで、探す。
$pos = index($read_data, "\r\n\r\n") + 4;
#4つ足してる。\r\n\r\nこれ分要らないから、つまり、次から最後まで画像データ。

$size = $ENV{'CONTENT_LENGTH'} - $pos;#画像ファイル本体の、サイズ(長さ)。

#画像のファイル名がダブらないように、日時で、決める。
if (!open(OUT, "> img/$number.jpg")) {&error("open");}

#バイナリ-で、書きこみ
binmode(OUT);

#$read_dataの、$posの位置から、$sizeの長さを、取り出す。$date に、代入
$date = substr($read_data, $pos, $size);

#ファイル本体だけ書きこみ
print OUT $date;
close(OUT);
################################ここまで#######################################
#ファイル名の書きこみ
$newline = "$number.jpg\n";
if (!open(OUT,">>warewan.memo")) { &error("open"); }
print OUT ($newline);
close(OUT);
#print "Location: $cgi_url" . '?' . "\n\n";
}
&html;
#------------------------------html-----------------------------------------
sub html{

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

print "<HTML>\n";
print "<HEAD>\n";
print "<TITLE>ファイルアップロード</TITLE>\n";
print "</HEAD>\n";
print "<BODY BGCOLOR=#000000 TEXT=#C0C0C0 LINK=#00FF00 VLINK=#0099FF ALINK=#FF0000>\n";

print "<form method=post enctype=\"multipart/form-data\" action=\"$cgi_url\">\n";
print "<FONT SIZE=+3>ファイルのアップロード</FONT>\n";
print "<input type=file name=\"img\">\n";
print "<input type=submit value=\"送信\">\n";
print "</form>\n";
print "<BLOCKQUOTE>問題在りそうなんで、JPGのみにしました。<BR><BR>\n";
print "<a href=\"$cgi_url\">RECORD</a>\n";
print "\$ENV{'CONTENT_LENGTH'} = <FONT COLOR=\"#FFFF00\">$ENV{'CONTENT_LENGTH'}</FONT> ヘッドの部分 = <FONT COLOR=\"#FFFF00\">$pos</FONT> アップファイル = <FONT COLOR=\"#FFFF00\">$size</FONT><BR><BR>Lcationで、飛ばしていたが、データ-サイズを見ましたら、RECORDを押してください。<BR><BR>\n";
print "実験結果、画像データ-をアップロードするには、バイナリ-で、読みこんで、最初の部分の(\\r\\n\\r\\n)までは、要らない。その後を、バイナリ-で、書きこむ</BLOCKQUOTE>\n";
print "<HR>\n";
print "画像です。<BR><BR>\n";
foreach $line (@lines) {
($memo_number) = split(/,/, $line);
$cou++;
print "<A HREF=\"img/$memo_number\" TARGET=\"_blank\">$cou</A> \n";
}

print "</BODY>\n";
print "</HTML>\n";
exit;
}
#-------------------------エラー設定-----------------------------------
sub error
{
#エラーサブルーチンの引数にて受け取る
print "Content-type: text/html\n\n";

print "<HTML>\n";
print "<HEAD>\n";
print "<TITLE>ファイルアップロード</TITLE>\n";
print "</HEAD>\n";
print "<BODY BGCOLOR=#FFFFFF TEXT=#000000>\n";

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;
}