「アップローダーにおける改行コードの揺らぎと判定儀式の補完構造」

\n を受信して、判定中に \n -> \r\n に変わっている。

判定の不成立が、発生してしまう。
柔軟に \r?\n にすることで回避できる。

環境

fail: up_loder.cgi ;このファイル。
dir: sys_img ;代替えアイコンdirectory
in_fail: sys_img/mem10.gif ;zip.lzh代替え表示イメージ
dir: up_failu ;ふっぶされたイメージなどを補完するdirectory
need.これらを必要とする。
maik: total_size.txt ;管理用ファイル
#! C:/perl/bin/perl

use strict;
use warnings;
use Fcntl qw(:flock);
use POSIX qw(strftime);
use feature 'say';
use Scalar::Util qw(looks_like_number);
#---------------------------------------------------------
####################################
# adoress: http://localhost/up_loder/up_loder.cgi
# Edite: tattyan
# Date: 2023/10/27 ReNewal 2025/06/10
# Version: 1.0 https://qiita.com/tattyan39/items/12e5cc946bd0bd01f843
# renewal varsion: 1.01
####################################
#---------------------------- 基本設定 -----------------------
our %cf = ();
our %inhp = (); # 添付ファイル情報などを格納するグローバルハッシュ
our %FORM = (); # フォームデータを格納するグローバルハッシュ
$cf{'this_cgi'} = "./up_loder.cgi"; # このCGIのファイル名
$cf{'this_dir'} = "./up_loder/"; # このCGIのディレクトリ
#---------------------------- 設定 -----------------------
# フォーム投稿時の最大サイズ (単位：KB)
my $upsize = 2000;
# 添付ファイルの格納場所
my $icon_dir = "./up_failu/";
unless (-d $icon_dir) {
	mkdir $icon_dir or die "Cannot create directory $icon_dir: $!";
}
# 添付ファイル（許可する拡張子:全て半角小文字で登録）
my @iconft = ('jpg','gif','png','lzh','zip');
# 添付ファイルのサイズ
my $i_width = 128;  # 横
# 画像以外の添付ファイルに対してのアイコン
my $tmp_img = "./sys_img/mem10.gif";
# 画像保存先ディレクトリ
my $cp_img_dir = "./img/";
#---------------------------- 改造 -----------------------
# GET の不許可　1
my $get_no = 0; # GET の不許可　1
##  画像データーファイル バイナリーの一時ファイル
#$gazoufile = "./gazou.dat";
my $daigae_ico = './sys_img/mem10.gif'; # zip,lzhのアイコン 1 0=imge
# $inhp{'old_failename1'} = "";
# $inhp{'old_failename2'} = "";
# $inhp{'old_failename3'} = "";
# $inhp{'new_failename1'} = "";
# $inhp{'new_failename2'} = "";
# $inhp{'new_failename3'} = "";
my $total_size_memo = './sys_img/total_size.txt';
#---------------------------------------------------------
my $branti = 2; # ブランチのフラグ: 0=呼ばない単独動作, 1=POST強制連動, 2>=自動, 3>=連動loadformdataファーストコール。
  &loadformdata();
  # &kaiseki(); # 環境変数の解析 test_kaiseki &loadformdata起動の後にmainを連動させる。
&main(); # メイン処理の呼び出し
### フォーム受信 ##########
######
sub kaiseki {
    print <<"EOF";
Content-type:text/html\n\n
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="UTF-8">
    <title>up</title>
</head>
<body>
    <h1>解析</h1>
入りながら打ち出します。loadformdataの代わりにkaisekiを代わりのコードとして入れ替えます。中で呼びます。<br>
$ENV{'REQUEST_METHOD'} eq "POST"<br>
EOF

if ($branti == 1) {
$ENV{'REQUEST_METHOD'} ='POST';
	print "post only。$ENV{'REQUEST_METHOD'} ='POST';<br>\n";
 &loadformdata();
} elsif ($branti == 2) {
	print "auto.<br>\n";
	 &loadformdata();
}else {
	print "呼びません。<br>\n";
}
# 解析の終わり
if ($branti  == 0) {
print <<"EOF";
<h2>終了</h2>
</body>
</html>
EOF
exit;
}
}

sub error {
	# エラー処理
	my $err_msg = $_[0];
	# &error("on_decoder_error $err_msg");
	print "Content-type:text/html\n\n";
	print <<"EOF";
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="UTF-8">
    <title>エラー</title>
</head>
<body>
    <h1>エラー1</h1>
    <p>$err_msg</p>
</body>
</html>
EOF
	exit;
}
sub loadformdata {
	# フォームデータの読み込み　(写真を撮ってAI画像認証を出来るように。将来的に受信QRに基づき画像生成QRコードど同送を可能に。)
	# 環境変数の初期化 \r\n と \n の両方に対応
	# グローバル変数の初期化
	my %MY_ENV; # 追加: %MY_ENVの宣言
	$ENV{'REQUEST_METHOD'} = ($ENV{'REQUEST_METHOD'} || 'GET'); # デフォルトはGET
	$ENV{'QUERY_STRING'} = ($ENV{'QUERY_STRING'} || ''); # デフォルトは空
	# 環境変数の初期化	
	$MY_ENV{'CONTENT_TYPE1'} = ($ENV{'CONTENT_TYPE'} || '');
	$MY_ENV{'CONTENT_TYPE2'} = ($ENV{'CONTENT_TYPE'} || '');
	# 予約変数の初期化
	$inhp{'imge_no'} = 0; # 添付ファイルの番号
	$inhp{'new_failename1'} = ''; # 新規ファイル名1
	$inhp{'old_failename1'} = ''; # 以前のファイル名1
	$inhp{'new_failename2'} = ''; # 新規ファイル名2
	$inhp{'old_failename2'} = ''; # 以前のファイル名2
	$inhp{'new_failename3'} = ''; # 新規ファイル名3
	$inhp{'old_failename3'} = ''; # 以前のファイル名3
	$upsize = $upsize || 2000; # フォーム投稿時の最大サイズ (単位：KB)
	my $get_geto_no = $get_no || 1; # GET の不許可　1
	my $filehead = '';
	$inhp{'filehead'.$inhp{'imge_no'}} = $filehead;
	my $kakutyousi = '';
	my $iwidth = 0;
	my $iheight = 0;
	my @f_jyouhou = ();
	$inhp{'kakutyousi'.$inhp{'imge_no'}} = $kakutyousi;
	$inhp{'iwidth'.$inhp{'imge_no'}} = $iwidth;
	$inhp{'iheight'.$inhp{'imge_no'}} = $iheight;
	$inhp{'f_jyouhou'.$inhp{'imge_no'}} = \@f_jyouhou;
	# 外部call関数　&error(),&ftflag(),&fileflag(),&checksize(),&filedel()
	# 内部関数 &dasu()
	# ローカル仕様変数　内部にて my $buf,など$my_bufa_img, $fnew_filename, $bak_failename
	my (@headers0, $header, @pairs, $pair, $name, $value, $filename, $filefooter, $tagok, $flag);
	my ($d_file2, $iwidth2, $iheight2, $filehead2, $kakutyousi2, @f_jyouhou2, $ss1, $ss2, $ss3);
	my ($tmp_name, $read_aru, $remain, $delimiter);
	my @spall = ();
	# フォームデータの初期化
	$tagok = 0; # タグ不可フラッグ	
	if($ENV{'REQUEST_METHOD'} eq "POST"){
		# print "1st $ENV{'REQUEST_METHOD'} eq \"POST\"<br>\n";#die("POST only1");
		# POSTの場合
		# 標準入力からデータを読みだす
		my $buf = "";
		my $read_data = "";
		my $remain = $ENV{'CONTENT_LENGTH'};
		# UPサイズのチェック
		if (checksize($remain) > $upsize * 1024) { error("フォーム投稿時の最大サイズは、${upsize}KB以内です。"); }
		binmode(STDIN);
		while ($remain) {
			$remain -= sysread(STDIN, $buf, $remain);
			$read_data .= $buf;
		}
		my $bak_failename = ""; # 以前のファイル名の初期化
		if ($read_data =~ m/^------WebKitFormBoundary/) {
			@headers0 = (); # 先頭の空白の削除
			my ($header0,$footer1) = split(/------WebKitFormBoundary/, $read_data,2);
			my ($header1,$footer2) = split(/------/, $footer1,2);
			push @headers0, '------WebKitFormBoundary'.$header0.$header1."-->\n"; # 先頭の空白の削除
			while ($footer2 ne "" &&  $footer2 !~ m/WebKitFormBoundary(.+)--$/) {
				($header0,$footer1) = split(/WebKitFormBoundary/, $footer2,2);
				($header1,$footer2) = split(/------/, $footer1,2);
				if ($header1 =~ m/filename=/) {
					$header = $header0.$header1;
				}
				if($header =~ m/Content-Disposition:\s([^;]+);\sname="([^;]+)";/i){
					$ss1 = $1;$ss2 = $2;					
					if($header =~ m/filename="(.+)"/i){
						$ss3 = $1;
						# print "filename: $1 <br>\n";
						# print "Content-Disposition type1: $ss1; name: $ss2 filename: $ss3<br>\n";
						$MY_ENV{'CONTENT_TYPE1'} = $ss1;
						# 添付ファイルのヘッダ
						$name = $ss2;
						if ($ss3) {
							# 拡張子の取り出し
							my @filefooter = ();
							@filefooter = split(/\./,$ss3);
							# 拡張子の判定 
							if ($ss2 =~ m/^.+1$/) {
								$inhp{'imge_no'} = 1; # 添付ファイルの番号
								$inhp{'new_failename1'} = $ss2.'.'.$filefooter[1];
								$inhp{'old_failename1'} = $ss3;
							} elsif ($ss2 =~ m/^.+2$/) {
								$inhp{'imge_no'} = 2; # 添付ファイルの番号
								$inhp{'new_failename2'} = $ss2.'.'.$filefooter[1];
								$inhp{'old_failename2'} = $ss3;
							} else {
								$inhp{'imge_no'} = 3; # 添付ファイルの番号
								$inhp{'new_failename3'} = $ss2.'.'.$filefooter[1];
								$inhp{'old_failename3'} = $ss3;
							}						
							# 拡張子を全て小文字に変換
							$filefooter[1] =~ tr/A-Z/a-z/;
							# 拡張子の判定
							if(&ftflag($filefooter[1])){&error("許可されていない拡張子です。$filefooter[1]");} 
							$filename = $name.'.'.$filefooter[1];
							if ($bak_failename eq $filename) {
								next; # 以前のファイルと同じ名前ならスキップ							
							} else {
								$bak_failename = $filename; # 以前のファイル名を更新
							}
						}
						if($name) {
							$name =~ s/\0//g; #2015-01-13-2019/10
							if($name) {$FORM{$name} = $name} # 2015-01-13-2019/1
							# print "name: $name, filename: $filename $FORM{$name} <br>\n";
						}
						#$header =~ s/\r\n/-rn-/g;$header =~ s/\s/SP/g;
						# print "<font color='red'>header: $header </font><br>\n";
						my $my_bufa_img;
						if ($header =~ /Content-Type:\s(.+)\r?\n\r?\n([\s\S]+)\r?\n$/i) {
							$my_bufa_img = $2;
							# print "Content-Type: $MY_ENV{'CONTENT_TYPE'} <br>\n";
							# print "<font color='blue'>Content-Data:$my_bufa_img</font><br>\n";
						}

						if (-e "$icon_dir$filename") {
							my $fnew_filename = $name.'_new.';
							my @filefooter;
							@filefooter = split(/\./,$ss3) unless @filefooter;
							$fnew_filename .= $filefooter[1];
							if(-e "$icon_dir$fnew_filename") {
								# print "以前のファイルが存在します。$icon_dir$fnew_filename<br>\n";
								unlink("$icon_dir$fnew_filename");
								unlink("$icon_dir$filename");
								# print "以前のファイルを削除しました。$icon_dir$fnew_filename<br>\n";
								$filename = $fnew_filename; # 新しいファイル名に変更
							}
						}
						# データのヘッダ
						if (open(OUT, "> $icon_dir$filename")) {
							binmode(OUT);
							print OUT substr($my_bufa_img, 0, length($my_bufa_img));
							close(OUT);
							# print "添付ファイルを保存しました。$icon_dir$filename<br>\n";
							$inhp{'new_failename'.$inhp{'imge_no'}} = $filename;
							# 添付ファイルの存在チェック
							my ($d_file, $iwidth, $iheight, $filehead, $kakutyousi, @f_jyouhou) = &fileflag($filename);
							if ($d_file) {
								# 添付ファイルの存在チェック
								$inhp{'filehead'.$inhp{'imge_no'}} = $filehead;
								$inhp{'kakutyousi'.$inhp{'imge_no'}} = $kakutyousi;
								$inhp{'iwidth'.$inhp{'imge_no'}} = $iwidth;
								$inhp{'iheight'.$inhp{'imge_no'}} = $iheight;
								$inhp{'f_jyouhou'.$inhp{'imge_no'}} = \@f_jyouhou;
							} else {
								# 添付ファイルの存在チェック
								&error("添付ファイルが保存されていません。$icon_dir$filename");
							}
						} else {
							# ファイルのオープンに失敗
							# print "ファイルのオープンに失敗しました。$icon_dir$filename<br>\n";
							&error("ファイルのオープンに失敗しました。$icon_dir$filename");
						}
					}
					# バイナリーファイルが終わる。
					next;
				}
				push @headers0, '------WebKitFormBoundary'.$header0.$header1."-->\n"; #((\r\n) 先頭の空白の削除
			}
			# print "headers0: @headers0 <br>\n";
			foreach my $header (@headers0) {
				# ヘッダの解析
				if($header =~ m/Content-Disposition:\s([^;]+);\sname="([^;]+)"\r?\n([\s\S]+\r?\n)-->/i){
					# print "Content-Disposition type2: $1; name: $2 $3<br>\n";
					$MY_ENV{'CONTENT_TYPE2'} = $1;
					# テキストデータのヘッダ					
					$2 =~ s/\0//g; #2015-01-13-2019/10
					($tmp_name, $value) =($2, $3);
					$value =~ s/^\r\n//g; #2015-01-13-2019/10 二重になってる?
					$value =~ s/\r\n$//g; #2015-01-13-2019/10 仮Chomp					
					# 変数の初期化
					if($tmp_name) {$FORM{$tmp_name} = $tmp_name} # 2015-01-13-2019/1
					$value =~ s/\0//g; #2015-01-13-2019/10
					#$value =~ tr/+/ /;
					$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2",$1)/eg; #2019/10
					if ($tagok == 1) {
						$value =~ s/&/&amp;/g;
						$value =~ s/&amp;\#/&#/g; #2019/10/27
						$value =~ s/<>/&lt\;&gt\;/g;
						$value =~ s/\"/&quot;/g;
						$value =~ s/</&lt;/g;
						$value =~ s/>/&gt;/g; #end20131029
						# TABを全てTab に置き換える
						$value =~ s/\t/Tab /g;
						# 改行コードは全て<br>に置き換える
						$value =~ s/\r\n/<br>/g;
					}
					$inhp{$tmp_name} = $value;
					# print "name: $tmp_name, value: $value disp: $inhp{$tmp_name}<br>\n";
				}
			}
			$name = ""; # 変数の初期化
			$tagok = 1; # タグ不可フラッグ
		} else {
			@pairs = split(/&/,$read_data);
		@spall = ();
		dasu(\@pairs, $tagok);
	}
	# POST 終わり。
}else{
	# print "1st $ENV{'REQUEST_METHOD'} eq \"get\"<br>\n";
	# GETの場合
	my $buffer = $ENV{'QUERY_STRING'};
	if($get_geto_no && $buffer > 50){&error('get禁止');}
	@pairs = split(/&/,$buffer);
	@spall =();
	dasu(\@pairs, $tagok);
	# GET 終わり。
}

} # <-- Add this closing bracket to end loadformdata

# dasuサブルーチンをloadformdataの外に移動し、$tagokを引数で渡す
sub dasu {
	my ($pairs_ref, $tagok) = @_;
	my ($pair, $name, $value);
	# データの解析
	foreach my $pair (@{$pairs_ref}) {
		($name, $value) = split(/=/, $pair);
		$name =~ s/\0//g; #2015-01-13-2019/10   \0(null) => "" に変わる。
		if($name) {$FORM{$name} = $name} # 2015-01-13-2019/1
		$value =~ s/\0//g; #2015-01-13-2019/10  \0(null) => "" に変わる。
		# 変数の初期化
		$name =~ s/\r?\n//g; #2015-01-13-2019/10
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",from_hex($1))/eg;
		$name =~ s/<br>//g; #2015-01-13-2019/10
		$name =~ s/\"/&quot;/g; #koko20131029
		$name =~ s/</&lt;/g;
		$name =~ s/>/&gt;/g;
		$value =~ s/^\r\n//g; #2015-01-13-2019/10　前方改行は削除していく。前complete　削除するならこっち。
		# $value =~ s/\r\n//g; #2015-01-13-2019/10 テキスト間の改行は有効とする。ファイル配列では、分行される。
		$value =~ s/\r\n$//g; #2015-01-13-2019/10 仮Chomp ファイルシステムは[0]に入れて配列化の時、後ろに\r\nが入る。
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2",$1)/eg; #2019/10
		if ($tagok == 1) {
			$value =~ s/&/&amp;/g;
			$value =~ s/&amp;\#/&#/g; #2019/10/27
			$value =~ s/\"/&quot;/g;
			$value =~ s/</&lt;/g;
			$value =~ s/>/&gt;/g; #end20131029
			$value =~ s/&lt\;&gt\;/<>/g;    #retun　<>　を有効にする。特殊。配列、単行化ユニット
			$value =~ s/&lt;br&gt;/<br>/ig; #return　<br>　を有効にする。特殊。
			# TABを全てTab に置き換える
			$value =~ s/\t/Tab /g;
			# 改行コードは全て<br>に置き換える
			$value =~ s/\r?\n/<br>/g;
			# $value =~ s/\n/<br>/g; 1個での使用は認めない\n\rのそのままのためにやらない。
			# $value =~ s/\r/<br>/g; \n\r の変換はしない
		}
		$inhp{$name} = $value;
	}
}
# //// 拡張子判定フラッグ ////
sub ftflag{
	# 許可しない拡張子だと1を返す
	my ($foot) = $_[0];
	my ($ftflag);
	# 許可しない拡張子フラッグ
	$ftflag = 1;
	foreach(@iconft){
		if($foot eq $_){
			$ftflag = 0;
			last;
		}
	}
	return($ftflag);
}

# //// ファイルサイズチェックフラッグ ////
sub checksize{
	# ファイルサイズが制限を越えると1を返す
	my ($readdata) = @_;
	my ($size,$checksize);
	# フラッグの初期化
	$checksize = 0;
	# 単位はKB
	$size = $upsize*1024;
	if($readdata>$size){$checksize = 1;}
	return($checksize);
}

# //// 添付ファイルの削除 ////
sub filedel{
	my ($filehead) = $_[0];
	my ($s,$d_file);
	$s = 0;
	&gazoudel ($filehead) ;
	while($s<@iconft){
		$d_file = $icon_dir.$filehead."\.".$iconft[$s];
		unlink($d_file);
		$s++;
	}
}

##----　ファイル削除管理（管理ファイル）---
sub gazoudel {
	my ($gasou_d) = $_[0];
	my $gazoufile = "./gazou.dat";
	open(my $fdetain, '<', $gazoufile) || &error("Can't open detafile,$gazoufile");
	eval{ flock ($fdetain, 1); };
	my @fdeta = <$fdetain>;
	close($fdetain);
	my ($sl) =0;
	my ($sc) =0;
	while ($sc < $#fdeta + 1){
		my $del_1f = $fdeta[$sl];
		my ($hedo,$kakutyo) = split(/\./,$del_1f);
		if ($hedo eq $gasou_d){
			splice @fdeta, $sl, 1;
		}
		++$sl;
		$sc++;
	}

	open(my $fdetaout, '>', $gazoufile) || &error("Can't write detafile,$gazoufile");
	eval{ flock ($fdetaout, 2); };
	print $fdetaout @fdeta;
	close($fdetaout);
}

# //// 添付ファイルの存在チェック ////
sub fileflag{
	my ($file_name) = $_[0];
	my ($s,$d_file,$fileflag,$iwidth,$iheight,$filehead,$kakutyousi,@f_jyouhou);
	# フラッグの初期化
	$fileflag = 0;
	$filehead = "";
	$kakutyousi = "";
	$iwidth = 0;
	$iheight = 0;
	my $tmp_ft = '';
	($filehead,$kakutyousi) = split(/\./,$file_name);
	$d_file = "$icon_dir$file_name";

	if(-e $d_file){
		(@f_jyouhou) = stat "$d_file";
		# 画像ファイルの大きさの取得
		open(STRM, "<$d_file");
		binmode(STRM);
		if($kakutyousi eq 'gif'){
			($iwidth,$iheight) = &gifsize(\*STRM);
		}elsif($kakutyousi eq 'jpg'){
			($iwidth,$iheight) = &jpegsize(\*STRM);
		}elsif($kakutyousi eq 'png'){
			($iwidth,$iheight) = &pngsize(\*STRM);
		}

		$fileflag = $d_file;
		$tmp_ft = $kakutyousi;
		close(STRM);
		#	last;
	}
	return($fileflag,$iwidth,$iheight,$tmp_ft,$f_jyouhou[7]);
}
# //// GIF,JPG,PNG サイズ取得 ////
#      ～ WWWimagesizeより (http://www.bloodyeck.com/wwwis/) ～

sub gifsize{
  my ($GIF) = @_;
  my ($type,$a,$b,$c,$d,$s)=(0,0,0,0,0,0);

  if(defined( $GIF )		&&
     read($GIF, $type, 6)	&&
     $type =~ /GIF8[7,9]a/	&&
     read($GIF, $s, 4) == 4	){
    ($a,$b,$c,$d)=unpack("C"x4,$s);
    return ($b<<8|$a,$d<<8|$c);
  }
  return (0,0);
}

sub jpegsize {
  my ($JPEG) = @_;
  my ($done)=0;
  my ($c1,$c2,$ch,$s,$length, $dummy)=(0,0,0,0,0,0);
  my ($a,$b,$c,$d);

  if(defined($JPEG)		&&
     read($JPEG, $c1, 1)	&&
     read($JPEG, $c2, 1)	&&
     ord($c1) == 0xFF		&&
     ord($c2) == 0xD8		){
    while (ord($ch) != 0xDA && !$done) {
      # Find next marker (JPEG markers begin with 0xFF)
      # This can hang the program!!
      while (ord($ch) != 0xFF) { return(0,0) unless read($JPEG, $ch, 1); }
      # JPEG markers can be padded with unlimited 0xFF's
      while (ord($ch) == 0xFF) { return(0,0) unless read($JPEG, $ch, 1); }
      # Now, $ch contains the value of the marker.
      if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
	return(0,0) unless read ($JPEG, $dummy, 3);
	return(0,0) unless read($JPEG, $s, 4);
	($a,$b,$c,$d)=unpack("C"x4,$s);
	return ($c<<8|$d, $a<<8|$b );
      } else {
	# We **MUST** skip variables, since FF's within variable names are
	# NOT valid JPEG markers
	return(0,0) unless read ($JPEG, $s, 2);
	($c1, $c2) = unpack("C"x2,$s);
	$length = $c1<<8|$c2;
	last if (!defined($length) || $length < 2);
	read($JPEG, $dummy, $length-2);
      }
    }
  }
  return (0,0);
}

sub pngsize {
  	my ($PNG) = @_;
  	my ($head) = "";
  	my ($a, $b, $c, $d, $e, $f, $g, $h)=0;

  	if(defined($PNG)				&&
    	read( $PNG, $head, 8 ) == 8		&&
     	$head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" &&
     	read($PNG, $head, 4) == 4			&&
     	read($PNG, $head, 4) == 4			&&
     	$head eq "IHDR"				&&
     	read($PNG, $head, 8) == 8 			){
    	($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head);
    	return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
  	}
  	return (0,0);
}


#-------------------------------------------------
#  時間取得
#-------------------------------------------------
sub get_time {
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();	
	my (@week) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	# 日時のフォーマット
	my $date = sprintf("%04d/%02d/%02d(%s) %02d:%02d", $year+1900,$mon+1,$mday,$week[$wday],$hour,$min);
    return $date;
}

sub main {
	if ($branti  >= 1) {
	print "Content-type:text/html charset=UTF-8\n\n" ;
	print <<"EOF";
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="UTF-8">

    <title>アップローター</title>
</head>
<body>
    <h1>ファイルをサーバーにアップロードする。</h1>
EOF
}
#    #  xx_yy.imge or xx_yy.zip
	print get_time();
	my $cout_ima = 0;
	my $cout_ima_f = $cout_ima + 1;
	my $randed = int(rand(99))+1;
	$cout_ima_f .= "_$randed";
	my $cout_ima_f1 = $cout_ima_f."1";
	my $cout_ima_f2 = $cout_ima_f."2"; # 1,2のファイル名を作成
#    #
	my $decoder = "imge"; # デコーダーの取得 action
	
	if ($decoder eq "text") {
    	print qq|<form name="main2_form" action="$cf{'this_cgi'}" method="post">|;
		print qq|<input type="hidden" name="name" value="">|;
		print qq|<input type="text" name="text_1" size="60" value="my mame is"> $inhp{'text_1'} <br>|;
		print qq|<input type="text" name="text_2" size="60" value="$inhp{'text_1'}"> $inhp{'text_2'}<br>|;
		print qq|<input type="submit" value="送信"><form>|;
	} elsif ($decoder eq "imge") {
    	print qq|<form name="main1_form" action="$cf{'this_cgi'}" method="POST" enctype="multipart/form-data">|;
		print qq|<input type="text" name="text_1" size="60" value="my mame is"> $inhp{'text_1'} <br>|;
		print qq|<input type="text" name="text_2" size="60" value="$inhp{'text_1'}"> $inhp{'text_2'}<br>|;
		print qq|<input type="file" name="$cout_ima_f1" size="60">: $inhp{'new_failename1'}: $inhp{'old_failename1'}<br>|;
		print qq|<input type="file" name="$cout_ima_f2" size="60">: $inhp{'new_failename2'}: $inhp{'old_failename2'}<br>|;
		print qq|<input type="submit" value="送信"><form>|;
	} else {
    	print qq|<form name="main1_form" action="$cf{'this_cgi'}" method="get">|;
		print qq|<input type="text" name="text_1" size="60" value="my mame is"> $inhp{'text_1'} <br>|;
		print qq|<input type="text" name="text_2" size="60" value="$inhp{'text_1'}"> $inhp{'text_2'}<br>|;
		print qq|<input type="submit" value="送信"><form>|;
    	print qq|<form name="main2_form" action="$cf{'this_cgi'}" method="post" enctype="multipart/form-data">|;
		print qq|<input type="text" name="text_1" size="60" value="my mame is"> $inhp{'text_1'} <br>|;
		print qq|<input type="text" name="text_2" size="60" value="$inhp{'text_1'}"> $inhp{'text_2'}<br>|;
		print qq|<input type="file" name="$cout_ima_f1" size="60"> $inhp{'imge1'} <br>|;
		print qq|<input type="file" name="$cout_ima_f2" size="60"> $inhp{'imge2'} <br>|;
		print qq|<input type="submit" value="送信"><form>|;
	}
	print "<h2>アップロードされたファイル</h2>\n";
	foreach my $key (keys %inhp) {
		print qq|$key: $inhp{$key} <br>\n|;	
	}
	print "<h2>アップロードされたファイルの一覧</h2>\n";
	my $total_up_saize = 0; # アップロードされたファイルの合計サイズ
	my @f_size = (); # ファイルサイズの配列
	my $new_failename = "";
	my $old_failename = "";
	for my $n (0 .. 1) {
		if ($n == 0){
		 $new_failename = $inhp{'new_failename1'};
		 $old_failename = $inhp{'old_failename1'};
		} elsif ($n == 1) {
		 $old_failename = $inhp{'old_failename2'};
		 $new_failename = $inhp{'new_failename2'};
		} elsif ($n == 2) {
		 $old_failename = $inhp{'old_failename3'};
		 $new_failename = $inhp{'new_failename3'};
		} elsif ($n == 3) {
		 $old_failename = $inhp{'old_failename4'};
		 $new_failename = $inhp{'new_failename4'};
		} else {
			print "不明な添付ファイル番号です。<br>";
		}
		# 添付ファイルの存在チェック
		if ($new_failename eq "") {
			print "$n ファイルはアップロードされていません。<br>";
		} elsif (-e "$icon_dir$new_failename") {
			print "$n: $new_failename, $old_failename <br>\n";
			print qq|<img src="$icon_dir$new_failename" alt="new imge"><br>\n|;
    		my $kaku = "";
			my $q_imge = 0;
    		print "ファイル名: $old_failename <br>";
    		print "新規ファイル名: $new_failename<br>";
			if($new_failename =~ m/jpg/){$kaku ="jpg";$q_imge = 0;}
			if($new_failename =~ m/gif/){$kaku ="gif";$q_imge = 0;}
			if($new_failename =~ m/png/){$kaku ="png";$q_imge = 0;}
			if($new_failename =~ m/lzh/){$kaku ="lzh";$q_imge = 1;}
			if($new_failename =~ m/zip/){$kaku ="zip";$q_imge = 1;}
    		(@f_size) = stat "$icon_dir$new_failename";
    		if($q_imge == 0){
        		# 画像ファイルに対してのアイコン
        		print qq|<img src="$icon_dir$new_failename" alt="new imge">$f_size[7]Byte <br>|;
    		} elsif($q_imge == 1){
        		# 画像以外の添付ファイルに対してのアイコン
         		print qq|<img src="sys_img/mem10.gif" alt="$kaku">$f_size[7]Byte <br>|;
    		}
			$total_up_saize += $f_size[7]; # アップロードされたファイルの合計サイズ
   		}
 	}
	print "<h2>アップロードされたファイルの合計サイズ</h2>\n";
	print "合計サイズ: $total_up_saize Byte<br>\n";
	print "アップロードされたファイルの合計サイズ: ".($total_up_saize/1000)." KB<br>\n";
	if ($branti  >= 1) {
		print "<h2>アップロード完了</h2>\n";
	}
	print "</body></html>";

    exit;
}
exit;