#!/usr/local/bin/perl

#↑perlのパスを自分の環境に合わせて書き直します。
#大抵は、「#!/usr/bin/perl」　か　「#!/usr/local/bin/perl」です。
#解らない場合はサーバー管理者(もしくはプロバイダー)に
#確認してください。

$ver="1.12";
################################################################
# WL-Enq [ウェブアンケート] (Since:2001/06/26)
#   (C) 2001-2003 by yomi
#   Eメール: yomi@pekori.to
#   ホームページ: http://yomi.pekori.to/
################################################################

## ---[利用規約]------------------------------------------------------------+
## 1. このスクリプトはフリーソフトです。このスクリプトを使用した
##    いかなる損害に対して作者は一切の責任を負いません。
## 2. このスクリプトを使用した時点で利用規約(http://yomi.pekori.to/kiyaku.html)
##    に同意したものとみなさせていただきます。
##    ご使用になる前に必ずお読みください。
## -------------------------------------------------------------------------+

$HTTP_HEADER_CONTENT_TYPE = "Content-type: text/html; charset=Shift_JIS\n\n";

BEGIN{ #サーバエラーをトラップ
$DIE_CGI_ERROR_FL=undef;
	sub main::DIE_CGI_ERROR{
		my $mes=shift;
		my $back=$ENV{'HTTP_REFERER'}?qq([<a href="$ENV{'HTTP_REFERER'}">戻る</a>]):
			"<form><input type=button value=\" 戻 る \" onClick=\"history.back()\"></form>";
		print $HTTP_HEADER_CONTENT_TYPE unless $DIE_CGI_ERROR_FL;
		$DIE_CGI_ERROR_FL=1;
		print qq(
			<h1>CGI エラー</h1>
			エラーメッセージ：<br>
			$mes
			<hr>
			$back
		);
	}
$main::SIG{__DIE__}=\&main::DIE_CGI_ERROR;
};

require './we_lib/jcode.pl';
require './we_data/cfg.cgi';

&form_decode;

require './we_lib/we_lib.pl';

if($FORM{mode} eq "kanri"){&kanri;}
elsif($FORM{mode} eq "kanri_user"){&kanri_user;}
elsif($FORM{mode} eq "kanri_admin"){&kanri_admin;}
elsif($FORM{mode} eq "send"){&send;}
elsif($FORM{mode} eq "result"){&result;}
elsif($FORM{mode} eq "result_mente"){&result_mente;}
else{ #送信画面＆ログイン画面
if(!$FORM{id}){
	print $HTTP_HEADER_CONTENT_TYPE;
	require "./we_template/login.html";
	exit;
}
elsif(-f "./we_data/u_$FORM{id}.cgi"){require "./we_data/u_$FORM{id}.cgi";}
else{&mes("指定されたアンケートフォームはありません$FORM{id}","エラー","java");}

	if($FORM{mode} eq "preview"){
		local($PRlog)=&PRlog_preview; #確認用ログ
		print $HTTP_HEADER_CONTENT_TYPE;

		require "./we_template/we_preview.html";

	}
	else{
		print $HTTP_HEADER_CONTENT_TYPE;
		require "./we_template/we.html";
	}

}
exit;


#項目を表示
sub PRlog{
	local($line,$st);
	foreach $line(@koumoku){
		my @arg=split(/<>/,$line);
		my($class)="ST_" . $arg[4];
		my $st=$class->new($line);
		$st->as_html;
	}
}

#集計結果項目を表示
sub PRresult_log{
	local($line,$st);
	print qq(<tr><td colspan=2><hr style="margin-right:4%;margin-left:4%"></td></tr>);
	foreach $line(@result){
		my @arg=split(/<>/,$line);
		if(!$arg[5] || $pass_ok){ #表示属性がON又は管理人権限なら
		if($arg[2] eq "sel"){ #選択肢タイプの場合
			print qq(<tr><td id="title">$arg[1]</td><td>);
			my(@sel)=split(/<1>/,$arg[3]);
			foreach(@sel){
				my($name,$value)=split(/<2>/,$_);
				print qq|<div style="margin-bottom:7px">$name (| . sprintf("%.1f",$value/$arg[4]*100) . qq|\%)<br> <img src="$EST{img_path}bar.gif" width="| . int($value/$arg[4]*100*3) . qq|" height=15> | . &split_c(${value}) . qq|<i>pt</i></div>|;
			}
			print qq(<div style="margin-bottom:7px">[ <b>合計：</b>) . &split_c($arg[4]) . qq(<i>pt</i> ]</div></td></tr><tr><td colspan=2><hr style="margin-right:4%;margin-left:4%"></td></tr>);
		}
		else{ #テキストタイプの場合
			print qq(<tr><td id="title">$arg[1]</td><td><textarea cols=60 rows=6>);
				foreach(split(/<1>/,$arg[3])){
					$_=~s/&lt;br&gt;/\n/g;
					print $_ . "\n\n---------------------------------------\n" if $_;
				}
			print qq|</textarea><div style="margin-bottom:7px">[ <b>合計：</b>$arg[4]<i>pt</i> ]</div></td></tr><tr><td colspan=2><hr style="margin-right:4%;margin-left:4%"></td></tr>|;
		}
		}
	}
}

sub PRlog_preview{
	local($line,$st,@lines,$PR_html);

	foreach $line(@koumoku){
		my @arg=split(/<>/,$line);
		my($class)="ST_" . $arg[4];
		my $st=$class->new($line);
		if(my $error=$st->check($arg[0])){&mes($error,"エラー","java");}
		$PR_html .=$st->as_preview_html;
	}

	return $PR_html;
}

sub result{
if(-f "./we_data/u_$FORM{id}.cgi"){
	require "./we_data/u_$FORM{id}.cgi";
	require "./we_data/d_$FORM{id}.cgi";
}
else{&mes("指定されたアンケートフォームはありません$FORM{id}","エラー","java");}

$pass_ok="1";
	if($EST{crypt} && $EST_u{pass} ne crypt($FORM{pass},$EST_u{pass})){
		$pass_ok="0";
	}
	elsif(!$EST{crypt} && $EST_u{pass} ne $EST_u{pass}){
		$pass_ok="0";
	}

	if($EST_u{close}){
		if(!$pass_ok){&mes("パスワードが違います","エラー","java");}
	}

		print $HTTP_HEADER_CONTENT_TYPE;
		require "./we_template/result.html";
}

sub result_mente{
if(-f "./we_data/u_$FORM{id}.cgi"){
	require "./we_data/u_$FORM{id}.cgi";
	require "./we_data/d_$FORM{id}.cgi";
}
else{&mes("指定されたアンケートフォームはありません$FORM{id}","エラー","java");}

$pass_ok="1";
	if($EST{crypt} && $EST_u{pass} ne crypt($FORM{pass},$EST_u{pass})){
		$pass_ok="0";
	}
	elsif(!$EST{crypt} && $EST_u{pass} ne $EST_u{pass}){
		$pass_ok="0";
	}

		if(!$pass_ok){&mes("パスワードが違います","エラー","java");}

	if($FORM{set} eq "数値をリセット"){ #数値リセット
		if($FORM{del_check} ne "on"){&mes("(確認)にチェックしてください","チェックミス","java");}
		if(!$EST{debug}){
		open(OUT,">./we_data/d_$FORM{id}.cgi");
print OUT<<"EOM";
\@result=();
\@ip_list=();
1;
EOM
		close(OUT);
		}
		my($debug_mes)=""; if($EST{debug}){$debug_mes="<br>※サンプルですので実際にはリセットされません";}
		&mes("数値のリセットが完了しました$debug_mes","リセット完了",$EST_u{back});
	}
	elsif($FORM{set} eq "E-Mailで送信"){ #E-Mail送信
		if($FORM{email_check} ne "on"){&mes("(確認)にチェックしてください","チェックミス","java");}
		if(!$EST{email_fl}){&mes("メール送信はできない設定になっています","エラー","java");}
		my($subject)="$EST_u{title} アンケート集計結果";
		my($honbun)= "+-- $EST_u{title} アンケート集計結果 --+\n\n";
		foreach(@result){
			my(@data)=split(/<>/,$_);
			if($data[2] eq "sel"){ #選択肢の場合
				$honbun.="【$data[1]】[合計$data[4]pt]\n";
				foreach(split(/<1>/,$data[3])){
					my($name,$value)=split(/<2>/,$_);
					$honbun.="[$name]\n";
					$honbun.="*"x int($value/$data[4]*20) . " (${value}pt)\n";
				}
				$honbun.="\n";
			}
			else{ #テキストの場合
				$honbun.="【$data[1]】[合計$data[4]pt]\n";
				foreach(split(/<1>/,$data[3])){
				$_=~s/&lt;br&gt;/\n/g;
					$honbun.="$_\n\n+------------------------------------+\n\n" if $_;
				}
				$honbun.="\n";
			}
		}
		$honbun.="+-------------------------------[ END ]-----+\n\n";
		
		$head=<<"EOM";
From: $EST_u{email}
To: $EST_u{email}
Subject: $subject
X-Mailer: WL-Enq $ver
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset="ISO-2022-JP"


EOM

		if(!$EST{debug}){
		require "./we_lib/mimew.pl";

		if(!open(OUT,"| $EST{sendmail} -t")){&mes("メール送信に失敗しました","エラー","java");}
		print OUT &mimeencode($head);

		$honbun=~s/\n\.\n/\n\.\.\n/g;
		&jcode'convert(*honbun,"jis");
		print OUT $honbun;

		close(OUT);
		}
		my($debug_mes)=""; if($EST{debug}){$debug_mes="<br>※サンプルですので実際には送信されません";}
		&mes("メールの送信が完了しました$debug_mes","送信完了",$EST_u{back});
	}
	elsif($FORM{set} eq "CSV形式でダウンロード"){ #CSVダウンロード
		print "Content-type: application/octet-stream .csv\n\n";
		foreach(@result){
			my(@data)=split(/<>/,$_);
			if($data[2] eq "sel"){ #選択肢の場合
				my(@write)=($data[1],"ポイント数","合計$data[4]pt");
				print &csv_conv(\@write);
				foreach(split(/<1>/,$data[3])){
					my($name,$value)=split(/<2>/,$_);
					my(@write)=($name,$value);
					print &csv_conv(\@write);
				}
				print "\n";
			}
			else{ #テキストの場合
				my(@write)=($data[1],"合計$data[4]pt");
				print &csv_conv(\@write);
				foreach(split(/<1>/,$data[3])){
				$_=~s/&lt;br&gt;/\n/g;
					my(@write)=($_);
					print &csv_conv(\@write);
				}
				print "\n";
			}
		}
	}
	else{&mes("setが不正です","エラー","java");}

}


#データ送信
sub send{

	if(-f "./we_data/u_$FORM{id}.cgi"){require "./we_data/u_$FORM{id}.cgi";}
	else{&mes("指定されたフォームはありません$FORM{id}","エラー","java");}
	if(-f "./we_data/d_$FORM{id}.cgi"){require "./we_data/d_$FORM{id}.cgi";}
	else{&mes("指定されたデータはありません$FORM{id}","エラー","java");}

	if(!$EST{debug}){

	&lock();
	
	my($mes)=&ip_check;
	if($mes ne "0"){&unlock(); &mes($mes,"エラー","java");}

	my $enq_data=Enq_data->new; #集計データを読み込み
	
	foreach $line(@koumoku){
		my @arg=split(/<>/,$line);
		my($class)="ST_" . $arg[4];
		my $st=$class->new($line);
		if(my $error=$st->check($arg[0])){&unlock(); &mes($error,"エラー","java");}
		$enq_data->add_data($st,$st->get_enq_data);
	}
	
	
	
	open(OUT,">./we_data/d_$FORM{id}.cgi");
	print OUT "\@result=(\n";
	$enq_data->get_data;
	print OUT ");\n\@ip_list=(\n";
		foreach(@ip_list){
			print OUT qq|'| . &quote_str($_) . qq|',\n|;
		}
	print OUT ");\n1;\n";
	close(OUT);
	
	&unlock();
	
	}


print $HTTP_HEADER_CONTENT_TYPE;
require "./we_template/we_end.html";
exit;
}

#メッセージ出力
sub mes{
local($MES,$Munlock=$_[3],$BACK_URL);
	if($Munlock eq "unlock"){&unlock($FORM{id});}
print $HTTP_HEADER_CONTENT_TYPE;
$MES=$_[0];
		if($_[1]){$TITLE=$_[1];}
		else{$TITLE="メッセージ画面";}
	if($_[2] eq "java"){
	$BACK_URL='<form><input type=button value=" 戻る " onClick="history.back()"></form>';
	}
	elsif($_[2] eq "env"){
	$BACK_URL=qq(【<a href="$ENV{'HTTP_REFERER'}">戻る</a>】);
	}
	elsif(!$_[2]){$BACK_URL="";}
	else{$BACK_URL="【<a href=\"$_[2]\">戻る</a>】";}

require "./we_template/mes.html";

exit;
}


#フォームデータのデコード(&form_decode)
sub form_decode{
	if($ENV{'REQUEST_METHOD'} eq "POST"){ read(STDIN,$form,$ENV{'CONTENT_LENGTH'}); }
	else{ $form=$ENV{'QUERY_STRING'}; }
	my @pairs = split(/&/,$form);
	foreach $pair(@pairs){
	my($name,$value)=split(/=/,$pair);
	$value=~tr/+/ /;
	$value=~s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
	$name=~s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
	$value=~s/>/&gt;/g;
	$value=~s/</&lt;/g;
	$value=~s/\t/ /g;
	$value=~s/\n/\t/g;
	$value=~s/\r//g;
	&jcode::convert(\$value,'sjis');
	&jcode::convert(\$name,'sjis');
	$FORM{$name}=$value;
	}
}

#著作権表示(削除・変更をしないでください。ただし、中寄せ・左寄せは可)
sub cr{
print "<p align=center>- <a href=\"http://yomi.pekori.to\" target=\"_blank\">WL-Enq Ver$ver</a> -</p>";
}

sub get_time{
	my ($PR_data,$time_fl);
	$time=$_[0]; $time_fl=$_[1];
	$ENV{'TZ'}='JST-9';
	if(!$time){$time=time();}
	my ($min,$hour,$day,$mon,$year,$week)=(localtime($time))[1 .. 6];
	
	$year+=1900; ++$mon;
	$week=('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$week];
	if(!$time_fl){$PR_data=sprintf("$year/%02d/%02d",$mon,$day);}
	else{$PR_data=sprintf("$year/%02d/%02d($week) %02d:%02d",$mon,$day,$hour,$min);}
	return $PR_data;
}

#管理室(&kanri)
sub kanri{
	if(&pass_check($FORM{pass},$FORM{id}) eq "admin"){ #メイン管理室
		print $HTTP_HEADER_CONTENT_TYPE;
		require "./$EST{template_path}kanri_admin.html";
	}
	else{ #ユーザ管理室
		print $HTTP_HEADER_CONTENT_TYPE;
		require "./$EST{template_path}kanri_user.html";
	}
}

#パスワードチェック&環境設定ロード
sub pass_check{
	my($in_pass,$user_name)=@_;
	my $ret;
	if($user_name eq "admin"){
		my $cr_pass=$EST{pass};
		my $fl=0;
		if($EST{pass} ne "setup"){
			if($EST{crypt}){
				if(crypt($in_pass,$cr_pass) ne $cr_pass){$fl=1;}
			}
			else{
				if($in_pass ne $cr_pass){$fl=1;}
			}
			if($fl){&mes("パスワードが違います","エラー","java");}
		}
		$ret="admin";
	}
	else{
		if(-f "./we_data/u_${user_name}.cgi"){require "./we_data/u_${user_name}.cgi";}
		else{&mes("指定されたアンケートフォームはありません${user_name}","エラー","java");}
		my $cr_pass=$EST_u{pass};
		my $fl=0;
		if($EST{crypt}){
			if(crypt($in_pass,$cr_pass) ne $cr_pass){$fl=1;}
		}
		else{
			if($in_pass ne $cr_pass){$fl=1;}
		}
		if($fl){&mes("パスワードが違います","エラー","java");}
		$ret="user";
	}
	return $ret;
}

#ユーザ管理室メニュー実行(&kanri_user)
sub kanri_user{
if(&pass_check($FORM{pass},$FORM{id}) eq "admin"){&mes("パスワードが違います","エラー","java");}
	#mode2で分岐
	if($FORM{mode2} eq "u_make_cfg"){&u_make_cfg;}
	elsif($FORM{mode2} eq "u_make_cfg"){&u_make_cfg;}
	elsif($FORM{mode2} eq "u_make_koumoku"){&u_make_koumoku;}
	elsif($FORM{mode2} eq "u_mente_koumoku"){&u_mente_koumoku;}
	else{&mes("指定されたモードは存在しません:$FORM{mode2}","エラー","java");}
}

#(u1)環境設定実行
sub u_make_cfg{

	my($bf_pass)=$FORM{pass};
	if($FORM{Fpass}){$bf_pass=$FORM{Fpass};}
	if($EST{crypt} && $FORM{Fpass}){$bf_pass=$FORM{Fpass}; $FORM{Fpass}=crypt($FORM{Fpass},"we");}
	$FORM{Fuser_id}=$FORM{Fkigen}="";
	
	#フォームチェック
	$FORM{Fip_check}=~s/[^\d\-]//g; if(!$FORM{Fip_check}){$FORM{Fip_check}=0;}
	
	my(%copy_EST_u);
	while(my($key,$value)=each %EST_u){
		if(defined $FORM{"F$key"}){
			if($key eq "end_mes" || $key eq "css"){$FORM{"F$key"}=~s/\t/\n/g; chomp $FORM{"F$key"};}
			else{
				$copy_EST_u{$key}=$FORM{"F$key"};
				$FORM{"F$key"}=&quote_str($FORM{"F$key"});
			}
			$EST_u{$key}=$FORM{"F$key"};
		}
	}

if(!$EST{debug}){

	&lock($FORM{id});

	open(OUT,">./we_data/u_$FORM{id}.cgi") || &mes("./we_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock");
		#$FORM{mode3}がdesignならテンプレートデザインに戻す
	require "./we_lib/cfg_user_lib.cgi";
	close(OUT);
	
	&unlock($FORM{id});

}

	while(my($key,$value)=each %copy_EST_u){$EST_u{$key}=$copy_EST_u{$key};}

	%FORM=(id=>$FORM{id},pass=>$bf_pass,mode=>"kanri");
	&kanri;
}

#(u2)新規項目作成実行
sub u_make_koumoku{
	if(!$FORM{Fform}){&mes("形式が指定されていません","エラー","java");}
	elsif(!$FORM{Ftitle}){&mes("項目名が記入されていません","エラー","java");}
	elsif(!$FORM{Fjyunjyo}){&mes("何番目に作成するかが指定されていません","エラー","java");}
	
	my $line="$FORM{Fjyunjyo}<>$FORM{Ftitle}<><><>$FORM{Fform}<>:<>0<>";

	my @af_koumoku; my($i,$fl)=(1,0);
	foreach(@koumoku){
		my(@arg)=split(/<>/,$_);
		if($FORM{Fjyunjyo} eq $arg[0]){
			push(@af_koumoku,$line);
			$i++; $fl=1;
		}
		$arg[0]=$i;
		my($log)=join("<>",@arg);
		push(@af_koumoku,$log); $i++;
	}
	if(!$fl && $FORM{Fjyunjyo} eq $#koumoku+2){push(@af_koumoku,$line);}
	elsif($#koumoku<0){push(@af_koumoku,$line);}
	@koumoku=@af_koumoku;

if(!$EST{debug}){

	&lock($FORM{id});

	open(OUT,">./we_data/u_$FORM{id}.cgi") || &mes("./we_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock");
	require "./we_lib/cfg_user_lib.cgi";
	close(OUT);

	&unlock($FORM{id});

}

	%FORM=(id=>$FORM{id},pass=>$FORM{pass},mode=>"kanri");
	&kanri;

}

#(u3)項目の内容変更
sub u_mente_koumoku{
	
	if($FORM{set} eq "削除" && $FORM{del} ne "on"){&mes("削除確認のチェックを入れてから削除ボタンを押してください","エラー","java");}

if(!$EST{debug}){

	&lock($FORM{id});
	
		my($i,$j)=(0,1);
		my(@af_koumoku);
		foreach $line(@koumoku){
			my(@arg)=split(/<>/,$line);
			if($FORM{Fid} eq $arg[0]){
				my($class)="ST_" . $arg[4];
				my $st=$class->new($line);
					if($FORM{set} eq "変更"){$st->mente;} #内容変更用の修正
					elsif($FORM{set} eq "形式変更"){$st->ch_form;} #形式変更
					elsif($FORM{set} eq "順序変更"){ #順序変更
						$arg[0]=$FORM{Fjyunjyo}; $line=join("<>",@arg);
						push(@af_koumoku,$line);
					}
					elsif($FORM{set} eq "削除"){ } #削除
					else{&mes("指定したセットは存在しません:$FORM{set}","エラー","java","unlock");}
				$koumoku[$i]=$st->as_mente_log;
			}
			elsif($FORM{set} eq "順序変更"){
				if($j eq $FORM{Fjyunjyo}){$j++;}
				$arg[0]=$j; $line=join("<>",@arg);
				push(@af_koumoku,$line);
				$j++;
			}
			elsif($FORM{set} eq "削除"){
				$arg[0]=$j; push(@af_koumoku,join("<>",@arg));
				$j++;
			}
			$i++;
		}
		if($FORM{set} eq "順序変更"){
			@koumoku=sort{(split(/<>/,$a,2))[0] <=> (split(/<>/,$b,2))[0]}@af_koumoku;
		}
		elsif($FORM{set} eq "削除"){
			@koumoku=@af_koumoku;
		}
		
	
	open(OUT,">./we_data/u_$FORM{id}.cgi") || &mes("./we_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock");
	require "./we_lib/cfg_user_lib.cgi";
	close(OUT);
	
	&unlock($FORM{id});

}

	%FORM=(id=>$FORM{id},pass=>$FORM{pass},mode=>"kanri");
	&kanri;

}


#メイン管理室メニュー実行(&kanri_admin)
sub kanri_admin{
if(&pass_check($FORM{pass},$FORM{id}) ne "admin"){&mes("パスワードが違います","エラー","java");}
	#mode2で分岐
	if($FORM{mode2} eq "a_del_koumoku"){&a_del_koumoku;} #ユーザ削除
	elsif($FORM{mode2} eq "a_make_koumoku"){&a_make_koumoku;} #新規ユーザ作成
	elsif($FORM{mode2} eq "a_copy_koumoku"){&a_copy_koumoku;} #新規ユーザ作成(コピー)
	elsif($FORM{mode2} eq "a_make_cfg"){&a_make_cfg;} #環境設定
	elsif($FORM{mode2} eq "a_ch_user_pass"){&a_ch_user_pass;} #ユーザ環境設定
	else{&mes("指定されたモードは存在しません:$FORM{mode2}","エラー","java");}
}

#(a1)ユーザ削除
sub a_del_koumoku{
	if($FORM{del} ne "on"){&mes("削除チェックがしてありません","エラー","java");}
	unless(-f "./we_data/u_$FORM{user_id}.cgi"){&mes("指定したユーザは存在しません","エラー","java");}
	
	$FORM{"id"}=$FORM{"user_id"};

	&lock($FORM{"id"});
	
	require "./we_data/acount.cgi";
	
	open(OUT,">./we_data/acount.cgi") || &mes("./we_data/acount.cgi に書き込めません","エラー","java","unlock");
	print OUT "\@acount=(\n";
	my(@af_acount);
	foreach(@acount){
		if($FORM{user_id} ne $_){print OUT "'" . $_ . "',\n"; push(@af_acount,$_);}
	}
	print OUT ");\n1;\n";
	close(OUT);
	@acount=@af_acount;
	
	unlink("./we_data/u_$FORM{user_id}.cgi");
	unlink("./we_data/d_$FORM{user_id}.cgi");
	
	&unlock($FORM{"id"});

	%FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri");
	&kanri;
}

#(a2)新規ユーザ作成
sub a_make_koumoku{
	if($FORM{user_id} eq "admin"){&mes("ユーザ名: <b>admin</b> は作成できません","エラー","java");}
	if(-f "./we_data/u_$FORM{user_id}.cgi"){&mes("そのユーザ名はすでに使用されています:$FORM{user_id}","エラー","java");}
	if(!$FORM{user_pass}){&mes("パスワードが未記入です","エラー","java");}
	
	if($EST{crypt}){$FORM{user_pass}=crypt($FORM{user_pass},"we");}

	require "./$EST{template_path}defo_user_data.cgi";

	open(OUT,">./we_data/u_$FORM{user_id}.cgi") || &mes("./we_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java",);
	require "./we_lib/cfg_user_lib.cgi";
	close(OUT);
	
	open(OUT,">./we_data/d_$FORM{user_id}.cgi") || &mes("./we_data/d_$FORM{user_id}.cgi に書き込めません","エラー","java",);
print OUT<<'EOM';
@result=(
);
@ip_list=(

);
1;
EOM
	close(OUT);

	require "./we_data/acount.cgi";
	push(@acount,$FORM{user_id});
	open(OUT,">./we_data/acount.cgi");
	print OUT "\@acount=(\n";
	foreach(@acount){
	print OUT "'" . $_ . "',\n";
	}
	print OUT ");\n1;\n";
	close(OUT);

	%FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri");
	&kanri;

}

#(a2.1)新規ユーザ作成(コピー)
sub a_copy_koumoku{
	if($FORM{new_id} eq "admin"){&mes("ユーザ名: <b>admin</b> は作成できません","エラー","java");}
	if(-f "./we_data/u_$FORM{new_id}.cgi"){&mes("そのユーザ名はすでに使用されています:$FORM{new_id}","エラー","java");}
	if(!$FORM{user_pass}){&mes("パスワードが未記入です","エラー","java");}
	
	if($EST{crypt}){$FORM{user_pass}=crypt($FORM{user_pass},"we");}

	unless(-f "./we_data/u_$FORM{old_id}.cgi"){&mes("コピー元の設定ファイルが読み込めません:$FORM{old_id}","エラー","java");}
		require "./we_data/u_$FORM{old_id}.cgi";
		$EST_u{user_id}=$FORM{new_id}; #ユーザID
		$EST_u{pass}=$FORM{user_pass}; #パスワード

	unless(-f "./we_data/d_$FORM{old_id}.cgi"){&mes("コピー元の設定ファイルが読み込めません:$FORM{old_id}","エラー","java");}
		require "./we_data/d_$FORM{old_id}.cgi";


	open(OUT,">./we_data/u_$FORM{new_id}.cgi") || &mes("./we_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java",);
	require "./we_lib/cfg_user_lib.cgi";
	close(OUT);
	
	open(OUT,">./we_data/d_$FORM{new_id}.cgi") || &mes("./we_data/d_$FORM{user_id}.cgi に書き込めません","エラー","java",);
	print OUT qq|\@result=(\n|;
	foreach(@result){
		print OUT "'" . $_ . "',\n";
	}
	print OUT ");\n";
	
	print OUT "\@ip_list=(\n";
	foreach(@ip_list){
		print OUT "'" . $_ . "',\n";
	}
	print OUT ");\n1;\n";
	close(OUT);

	require "./we_data/acount.cgi";
	push(@acount,$FORM{new_id});
	open(OUT,">./we_data/acount.cgi");
	print OUT "\@acount=(\n";
	foreach(@acount){
	print OUT "'" . $_ . "',\n";
	}
	print OUT ");\n1;\n";
	close(OUT);

	%FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri");
	&kanri;

}


#(a3)メイン環境設定変更
sub a_make_cfg{
	my($bf_pass)=$FORM{pass};
	if($FORM{Fpass}){$bf_pass=$FORM{Fpass};}
	if($EST{crypt} && $FORM{Fpass}){$bf_pass=$FORM{Fpass}; $FORM{Fpass}=crypt($FORM{Fpass},"we");}
	
	while(my($key,$value)=each %EST){
		if(defined $FORM{"F$key"}){
			$EST{$key}=$FORM{"F$key"};
		}
	}
	
	#&mes($EST{debug});


	open(OUT,">./we_data/cfg.cgi") || &mes("./we_data/cfg.cgi に書き込めません","エラー","java");
	require "./we_lib/cfg_admin_lib.cgi";
	close(OUT);


	%FORM=(id=>$FORM{id},pass=>$bf_pass,mode=>"kanri");
	&kanri;

}

#(a4)ユーザ環境設定実行
sub a_ch_user_pass{

	if(-f "./we_data/u_$FORM{user_id}.cgi"){require "./we_data/u_$FORM{user_id}.cgi";}
	else{&mes("指定されたユーザは存在しません$FORM{user_id}","エラー","java");}

	if(!$FORM{Fpass}){&mes("ユーザパスワードを設定してください","エラー","java");}
	if($EST{crypt}){$FORM{Fpass}=crypt($FORM{Fpass},"we");}
	$FORM{Fuser_id}=$FORM{Fkigen}="";
	
	my(%copy_EST_u);
	while(my($key,$value)=each %EST_u){
		if($FORM{"F$key"}){
			if($key eq "end_mes" || $key eq "css"){$FORM{"F$key"}=~s/\t/\n/g; chomp $FORM{"F$key"};}
			else{
				$copy_EST_u{$key}=$FORM{"F$key"};
				$FORM{"F$key"}=&quote_str($FORM{"F$key"});
			}
			$EST_u{$key}=$FORM{"F$key"};
		}
	}

	&lock($FORM{user_id});

	open(OUT,">./we_data/u_$FORM{user_id}.cgi") || &mes("./we_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java","unlock");
	require "./we_lib/cfg_user_lib.cgi";
	close(OUT);
	
	&unlock($FORM{user_id});

	while(my($key,$value)=each %copy_EST_u){$EST_u{$key}=$copy_EST_u{$key};}

	%FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri");
	&kanri;
}



sub lock{
#(lock1.1)ロック(&lock)
local($PRE_TIME,$TIME_FLAG,$RET,$i,$times,$lockfile,$retry,$id=$_[0]);

if(-e "$EST{lock_path}we_$id"){
$times=time();
	($PRE_TIME) = (stat("$EST{lock_path}we_$id"))[9];
	$TIME_FLAG = $times - $PRE_TIME;
	
		if($TIME_FLAG > 60){ #ロックの強制解除
			&unlock($id);
		}
}

if(!$EST{lock_method}){ #ディレクトリロック
$times=time();
	($PRE_TIME) = (stat("$EST{lock_path}we_$id"))[9];
	$TIME_FLAG = $times - $PRE_TIME;
	$i=1;
	while(1){
	if (mkdir("$EST{lock_path}we_$id", 0755)) { $RET=1; last; } #ロック成功
	if ($i==1) {
		if($TIME_FLAG > 180){ #ロックの強制解除
			rmdir("$EST{lock_path}we_$id");
		}
	}
	elsif ($i < 6) { sleep(1); }
	else { $RET=0; last; } #ロック失敗
	$i++;
	}
}
else{ #symlinkロック
	local($retry) = 5;
	while (!symlink("./","$EST{lock_path}we_$id")) {
		if (--$retry <= 0) {
		&mes("タイムアウトエラーです。<br>もう一度「戻る」ボタンで戻ってからやり直してください。<br>Lockmode:symlinkロック","タイムアウトエラー","java");
		}
		sleep(1);
	}
	$RET=1;
}

	if(!$RET){
	&mes("タイムアウトエラーです。<br>もう一度「戻る」ボタンで戻ってからやり直してください。<br>Lockmode:ディレクトリロック","タイムアウトエラー","java");
	}
}

sub unlock{
#(lock2.1)ロック解除(&unlock_key)
local($id=$_[0]);
if(!$EST{lock_method}){
	rmdir("$EST{lock_path}we_$id");
}
else{
	unlink("$EST{lock_path}we_$id");
}
}

#メタ文字をクオート
sub quote_str{
	my $ret=shift;
	if(substr($ret,-1,1) eq "\\"){$ret.="\\";}
	#$ret=~s/'/\\'/g;
	return $ret;
}

#桁区切り
#※Perlメモ( http://www.din.or.jp/~ohzaki/perl.htm )を参考にさせていただきました
sub split_c{
if ($_[0] =~ /^[-+]?\d\d\d\d+/g) {
  for ($i = pos($_[0]) - 3, $j = $_[0] =~ /^[-+]/; $i > $j; $i -= 3) {
    substr($_[0], $i, 0) = ',';
  }
}
return $_[0];
}

#CSV形式に変換
#※Perlメモ( http://www.din.or.jp/~ohzaki/perl.htm )を参考にさせていただきました
sub csv_conv{
#[0]=書き込み用配列
	my($line)=join ',', map {(s/"/""/g or /[\r\n,]/) ? qq("$_") : $_} @{$_[0]};
	$line=~s/\n//g; $line.="\n";
	return $line;
}

#ipをチェック
sub ip_check{
	#禁止IP/ホスト名チェック
	my(@diny_words)=split(/,/,$EST_u{diny_words});
	if(!$ENV{'REMOTE_HOST'}){$ENV{'REMOTE_HOST'}=gethostbyaddr(pack("C4", split(/\./, $ENV{'REMOTE_ADDR'})), 2);}
	foreach(@diny_words){
		if($ENV{'REMOTE_ADDR'} eq $_){return 'このIP/ホスト名は送信が禁止されています';}
		if($ENV{'REMOTE_HOST'} eq $_){return 'このIP/ホスト名は送信が禁止されています';}
	}
	if($EST_u{ip_check} eq "0"){return 0;}
	elsif($EST_u{ip_check}>0){
		#日付変更ならIPリストを初期化（[0]はエポック秒を記録）
		if(time()-$ip_list[0]>86400*$EST_u{ip_check}){@ip_list=(time());}
		for(my $i=1;$i<=$#ip_list;$i++){
			if($ENV{'REMOTE_ADDR'} eq $ip_list[$i]){return "$EST_u{ip_check}日以内の複数回の投票はできません";}
		}
		push(@ip_list,$ENV{'REMOTE_ADDR'});
	}
	elsif($EST_u{ip_check} eq "-1"){
		if($ip_list[0]!~/[\.]/){$ip_list[0]="";}
		for(my $i=0;$i<=$#ip_list;$i++){
			if($ENV{'REMOTE_ADDR'} eq $ip_list[$i]){return "複数回の投票はできません";}
		}
		push(@ip_list,$ENV{'REMOTE_ADDR'});
	}
	else{return "\$EST_u{ip_check}の値が不正です";}
	return 0;
}


##-- end of enq.cgi --##