#!/usr/local/bin/perl # Multiple Enquete v1.07.1 (2001/09/11) # このスクリプトはフリーウェアですが、著作権は作者(すこり)が保有します # このスクリプトを使用したいかなる損害に対しても作者は一切の責任を負いません # 利用規約→http://popup.tok2.com/home/skry/labo/rule.html # スクリプトに関する質問・要望・バグ報告等はサポート掲示板にお書きください # サポート掲示板→http://popup.tok2.com/home/skry/labo/support/wforum.cgi # すこり家 http://popup.tok2.com/home/skry/ # skry@post.tok2.com # 参照するライブラリの場所 require './jcode.pl'; require './multiqini.pl'; # マスターキー $masterkey = 'tosiko46'; # 以下、改造目的でないならいじらないでください # ---------- メイン処理 ---------- if ($tok2) { utime time(), time(), __FILE__; $tok2_cookie = ''; } if ($access_deny_sw) { &ip_deny; } &decode; if ($mode eq "newquest") { &newquest; } if ($mode eq "newquest2") { &newquest2; } if ($mode eq "newquest3") { &newquest3; } if ($mode eq "newquest_w") { &newquest_w; } if ($mode eq "enquete") { &enquete; } if ($mode eq "admin_q") { &admin_q; } if ($mode eq "admin_q_w") { &admin_q_w; } if ($mode eq "admin_del") { &admin_del; } if ($mode eq "admin_type") { &admin_type; } if ($mode eq "admin_type_w") { &admin_type_w; } if ($mode eq "admin_type_del") { &admin_type_del; } if ($mode eq "vote") { &vote; } if ($mode eq "detail") { &detail; } if ($mode eq "host") { &ex_host; } &html; # ----サブルーチン---- # -----メインページ----- sub html { open(IN,"$q_t_file") || &error("$q_t_fileが開けません"); @q_titles = ; close(IN); shift(@q_titles); #総曲名数部分を取り除く if ($tsort_sw) { &get_cookie("tsort"); if ($tsort) { &set_cookie("tsort"); } } &header("$title"); if ($countercgi) { print $countercgi; print "
\n"; } print "[使い方] [$back_nam]

\n"; if ($#q_titles < $maxquest-1) { print <<"EOM";

EOM } if (!@q_titles) { print "アンケートは一つもありません
\n"; } else { if ($tsort_sw) { if ($tsort == 2) { @q_titles = reverse(@q_titles); } elsif ($tsort == 3) { local @tmp2 = (); local $i = @q_titles; while ($i--) { my @tmp1 = split(/<>/,$q_titles[$#q_titles-$i]); $tmp1[13] =~ s/[\/ :]//g; push(@tmp2,$tmp1[13]); } @q_titles = @q_titles[sort { $tmp2[$b] <=> $tmp2[$a] } 0..$#tmp2]; } print "
\n\n\n
\n"; } my $i = @q_titles; print <<"EOM"; アンケート一覧
タイトルをクリックするとアンケートに飛びます
総曲名数:$i

EOM if ($tdisp[0]) { print ""; } if ($tdisp[1]) { print ""; } if ($tdisp[2]) { print ""; } print "\n"; foreach (@q_titles) { (@t_logs) = split /<>/; print "\n"; if ($tdisp[0]) { print ""; } if ($tdisp[1]) { print ""; } if ($tdisp[2]) { if ($t_logs[13]) { print "\n"; } else { print "\n"; } } print "\n"; } print "
No.タイトル曲名制作者作成日時最終投票日時
$t_logs[0]$t_logs[1]$t_logs[2]$t_logs[12]$t_logs[13]
\n"; } &footer; exit; } # -----新規曲名作成----- sub newquest { if (!$newquest_user_ok && !$passcode) { &header("新規曲名作成受付"); print <<"EOM"; 新規曲名作成

[使い方] [$back_nam]

マスターキーを入力してください。
EOM } elsif (!$newquest_user_ok && $passcode ne $masterkey) { &error("マスターキーが違います
"); } else { &header("新規曲名作成"); if ($name_ok) { $hissu[0] = "*"; } if ($mail_ok) { $hissu[1] = "*"; } print <<"EOM"; 新規曲名作成

[使い方] [$back_nam]

*の項目は必須です。
EOM print "\n\n"; print "\n"; local ($tmp,$tmp2,$i,@tmp); for (0..5) { $tmp2 = 0; print "\n"; } print "\n"; print "\n
$hissu[0]お名前
$hissu[1]e-mail
*タイトル
*曲名
*コード

ユーザーが選択肢を増やせる EOM if ($tag_ok) { print <<"EOM"; →タグの使用を許可する EOM } print <<"EOM";
コメントの入力を求める→ コメントを必須にする

複数選択式 単一選択式

連続投票について
同一項目の連続投票可能\
同一項目の連続投票不可
他項目についても連続投票不可

特徴設定
特徴を必須にする
"; if ($_ <= 2) { print "\n"; } else { $tmp = "ユーザー特徴"; $tmp .= $_ - 2; print "$tmp"; } print "
\n"; } &footer; exit; } # -----新規曲名作成第2段階----- sub newquest2 { #記入項目チェック if (!$newquest_user_ok && $passcode ne $masterkey) { &error("不正な操作です"); } if ($name_ok && !$name) { &error("お名前を記入してください"); } if (!$name) { $name = "匿名"; } if ($mail_ok && !$mail) { &error("e-mailを記入してください"); } if (!$enqname) { &error("曲名のタイトルを記入してください"); } if (!$quest_bf) { &error("曲名を記入してください"); } if (!$code) { &error("コードを入力してください"); } if (!$FORM{'pro_ess'}) { $FORM{'pro_ess'} = "0"; } #重複タイトルチェック open(IN,"$q_t_file") || &error("$q_t_fileが開けませんでした"); @q_titles = ; close(IN); shift(@q_titles); local ($tmp); foreach (@q_titles) { ($xx,$tmp) = split(/<>/,$_); if ($tmp eq $enqname) { &error("曲名のタイトル「$enqname」はすでに使われています
違うタイトルにしてください"); } } if (!$pro_3 && !$pro_4 && !$pro_5) { &newquest3; } #ユーザー特徴を使わないなら第3段階へ移行 $pro_user_0 = $pro_3 + $pro_4 + $pro_5; &header("新規曲名作成-ユーザー特徴設定"); print "ユーザー特徴を設定してください。

\n"; print "選択肢は10個まで設定できます。
\n"; print <<"EOM";
EOM local ($i = 2); for (3..5) { if ($FORM{"pro_$_"}) { $i++; print "\n"; } } print "\n"; for ($i=1;$i <= $pro_user_0;$i++) { print "\n"; } print "
\n"; print "
ユーザー特徴$i
特徴名\n
\n"; for (0..9) { $tmp = "pro_"; $tmp .= $i + 2; $tmp .= "_$_"; print "
\n"; } print "
\n"; &footer; exit; } # -----新規曲名作成第3段階----- sub newquest3 { if (!$newquest_user_ok && $passcode ne $masterkey) { &error("不正な操作です"); } $property = ""; for (0..2) { if ($FORM{"pro_$_"}) { $property .= $PROP{"$_"}; } $property .= "<,>"; } #ユーザー特徴を使う場合 local ($tmp); if ($pro_3) { for (3..5) { if ($FORM{"pro_$_"}) { $tmp = $_ -2; #第2段階の入力をチェック if (!$FORM{"pro_user_title_$tmp"}) { &error("ユーザー特徴$tmpの特徴名を記入してください"); } if (!$FORM{"pro_$_"."_0"}) { &error("ユーザー特徴$tmpの選択肢を記入してください"); } #ユーザー特徴をフォーマット $property .= "$FORM{\"pro_user_title_$tmp\"}"; for ($i = 0;$i <= 9;$i++) { if ($FORM{"pro_$_"."_$i"}) { $property .= "<,,>$FORM{\"pro_$_\".\"_$i\"}"; } } } if ($_ != 5) { $property .= "<,>"; } } } #html記述 &header("新規曲名作成-確認"); print "曲名制作者:$name

\n"; if ($mail) { print "e-mail:$mail

\n"; } print "曲名タイトル:$enqname

\n"; print "曲名
\n"; print "
$quest_bf
\n"; print "
コード:$code

\n"; print "
ユーザーが選択肢を"; if ($inc_sel) { print "増やせる\n"; if ($inc_sel_tag) { print "
選択肢にタグの使用可\n"; } } else { print "増やせない\n"; } print "
コメントの入力を"; if ($comment_in || $comment_in_ess) { print "求める\n"; if ($comment_in_ess) { print "
コメントは必須\n"; } } else { print "求めない\n"; } print "
"; if ($sel_mul) { print "複数選択式"; } else { print "単一選択式"; } print "
\n"; if ($sel_cont == 0) { print "・同一項目への連続投票可能\"; } if ($sel_cont == 1) { print "・同一項目への連続投票不可"; } if ($sel_cont == 2) { print "・他項目についても連続投票不可"; } print "
\n"; print "


\n"; $flag = 0; print "使用する特徴
\n"; print "\n"; @tmps = split(/<,>/,$property); for (0..5) { @tmps2 = split(/<,,>/,$tmps[$_]); if ($FORM{"pro_$_"}) { print ""; print "\n"; $flag = 1; } } print "
\n
\n"; if (!$flag) { print "なし
\n"; } elsif ($FORM{'pro_ess'}) { print "特徴は必須"; } else { print "特徴は任意"; } $quest_bf =~ s/
/\n/ig; print <<"EOM";
以上の設定でよろしいですか?
EOM &footer; exit; } # -----新規曲名書き込み----- sub newquest_w { if (!$newquest_user_ok && $passcode ne $masterkey) { &error("不正な操作です"); } $lock = &lock or die 'error'; open(IN,"$q_t_file") || &error("$q_t_fileが開けません",1); @q_titles = ; close(IN); $number = shift(@q_titles); #一行目の総曲名数部分を取り除く $number =~ s/\n//g; $number++; #曲名数+1 @news =(); unshift(@news,"$number\n"); #総曲名数を新しい配列に入れる #重複タイトルチェック&更新するタイトルデータのフォーマット local $tmp=""; foreach (@q_titles) { ($xx,$tmp) = split(/<>/,$_); if ($tmp eq $enqname) { &error("曲名のタイトル「$enqname」はすでに使われています
違うタイトルにしてください",1); } push(@news,$_); #以前のタイトルを新しい配列に入れ直す } $comment = 0; if ($comment_in) { $comment = 1; } if ($comment_in_ess) { $comment = 2; } &get_time; $p_code = &cr_code("$code"); #コード暗号化 push(@news,"$number<>$enqname<>$name<>$mail<>$quest<>$p_code<>$inc_sel<>$inc_sel_tag<>$sel_mul<>$sel_cont<>$comment<>$FORM{'property'}<>$date<><>$FORM{'pro_ess'}<>\n"); #今回のタイトルデータを最後に付け足す #タイトルデータ更新 open(OUT,">$q_t_file") || &error("$q_t_fileが開けません","1"); print OUT @news; close(OUT); #新しい選択肢ファイルを作成 open(OUT,">$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが作成できません","1"); close(OUT); chmod(0666,"$q_file_dir$q_model$number.log"); #新しい詳細データファイルを作成 open(OUT,">$q_file_dir$q_detail$number.dat") || &error("$q_file_dir$q_detail$number.datが作成できません","1"); close(OUT); chmod(0666,"$q_file_dir$q_detail$number.dat"); &unlock($lock); } # -----アンケートメイン----- sub enquete { &get_cookie("$number"); #クッキー取得 &titles("$number"); #ログ取り出し #選択肢ファイルを開く open(IN,"$q_file_dir$q_model$logs[0].log") || &error("$q_file_dir$q_model$logs[0].logが開けません"); @q_options = ; close(IN); if (!$sort_num) { $sort_num = 0;} #初めは標準ソート &header("$logs[1]"); print <<"EOM"; [使い方] [アンケート一覧] [$back_nam]

$logs[1]
$logs[4]
曲名制作者: EOM if ($logs[3]) { print "$logs[2]\n"; } else { print "$logs[2]"; } print "

\n"; if (!@q_options) { print "選択肢なし

"; } else { @props = split(/<,>/,$logs[11]); if (@props) { #特徴を使う場合 print "
\n"; print "\n"; print "\n"; print "\n"; print "の多い順番で
\n"; if ($logs[14] != 1) { print " (特徴の$bra[0]タイトル$bra[1]を選ぶと「不明」順でソ\ートされます)\n"; } else { print "(特徴の$bra[0]タイトル$bra[1]を選んでも変化しません)\n"; } print "
\n"; } if ($sort_num) { ($pro_t,$pro_n) = split(/_/,$sort_num); } &v_sort("$sort_num"); #ソートする print "総投票数:$total_c

\n"; if ($logs[10] || @props) { print "◇をクリックすると詳細データが見れます
\n"; } print <<"EOM"; EOM if ($logs[10] || @props) { print "\n"; if ($logs[10] || @props) { print ""; } print "\n"; $rank = 1; $rank_bf = ""; $rank_ad = ""; #グラフの幅を調整 if ($width_relative) { if ($total_c) { $width_times = $width_basis / (($top_cnt / $total_c) * 100); } } else { $width_times = $width_basis / 100; } foreach (@sort_op) { @options = split(/<>/,$_); ($s_num,$s_nam,$s_cnt,$t_pro,$xx,$p_date) = split(/<>/,$_); $option_name[$s_num] = $s_nam; if ($sort_num) { @tmps = split(/<,>/,$t_pro); @tmps2 = split(/,/,$tmps[$pro_t]); $p_cnt = $tmps2[$pro_n]; $count = $p_cnt; } else { $count = $s_cnt; } print "\n"; if ($logs[10] || @props) { print ""; } if ($s_cnt) { $percent = ($s_cnt / $total_c) * 100; #割合 $total_cはv_sortルーチンより $c_width = $percent * $width_times; #グラフ用割合 } else { $percent = 0; } if ($sort_num) { #ソートする場合 if ($p_cnt) { $p_percent = ($p_cnt / $s_cnt) * 100; #特徴の割合 $p_width = ($p_cnt / $total_c) * 100 * $width_times; #グラフ用の全体での割合 } else { $p_percent = 0; } } print "\n\n"; $rank_bf = $count; } print ""; if ($logs[10] || @props) { print "\n"; print "
"; } else { print ""; } @props = split(/<,>/,$logs[11]); @pro_titles = (); if (@props) { print "
特徴を選択してから投票してください\n"; if ($logs[14] == 1) { print "特徴の選択は必須です
"; } print "\n"; for $i (0..5) { if ($props[$i]) { @prop_data = split(/<,,>/,$props[$i]); if ($i == 3) { print "\n"; } print "\n"; if ($_ == 2) { print "\n"; } } } print "
\n
\n"; } $pollmean = ""; if ($sort_num) { if (!$pro_n) { $pro_n2 = '不明'; } print "\n"; print "
[$pro_t2-$pro_n2]の多い順番で表\示
$pro_n2の得票数グラフ
\n"; print "全体の得票数グラフ
\n"; $pollmean = "  「$pro_n2」の得票数 / 全体の得票数"; } print "
投票順位選択肢詳細得票数$pollmean最終投票日時
"; #チェックボックスorラジオボタン if ($logs[8]) { print ""; } else { print ""; } #順位を付ける if ($count == $rank_bf) { $rank_ad++; } else { $rank += $rank_ad;$rank_ad = 1; } print "$rank$s_nam$count"; if ($sort_num) { print " / $s_cnt【"; printf ("%4.1f% / ",$p_percent); $c_height = 8; } else { print "【"; $c_height = 10; } printf ("%4.1f%",$percent); print "】"; if ($s_cnt) { print "
\n"; if ($sort_num && $p_cnt) { print "
\n"; } print ""; print "
\n"; } else { print "
"; } print "
"; if ($p_date) { print "$p_date"; } else { print "
"; } print "
"; } else { print ""; } if ($logs[10]) { #コメントの入力を求めるか print "コメント"; if ($logs[10] ==2) { print "(必須)"; } print "
($c_maxlength文字以内  タグ使用不可)
"; print "
\n"; } print "
\n"; } if ($logs[6]) { #ユーザーが選択肢を増やせる場合 print <<"EOM"; \n
追加する選択肢を記入してください ($s_maxlength文字以内)

EOM if (!$logs[7]) { print "(タグ使用不可)\n"; } print "

\n"; } #コメントの表示 if ($logs[10]) { print "\n"; print "\n"; open(IN,"$q_file_dir$q_detail$number.dat") || &error("$q_file_dir$q_detail$number.datが開けません"); @q_details = ; close(IN); local $tmpcnt = 1; foreach (@q_details) { ($v_num,$S_PRO{"0"},$S_PRO{"1"},$S_PRO{"2"},$S_PRO{"3"},$S_PRO{"4"},$S_PRO{"5"},$IP,$p_date,$v_comment) = split(/<>/,$_); if ($v_comment) { print "\n"; if ($tmpcnt >= $max_comment) { last; } $tmpcnt++; } } print "
最近のコメント
$v_comment
\n"; print "  選択項目:"; @sp_num = split(/,/,$v_num); @tmps = (); foreach (@sp_num) { push(@tmps,"$option_name[$_]"); } print join(",",@tmps)."
\n"; if (@props) { print "  "; for (0..5) { @prop_data = split(/<,,>/,$props[$_]); if ($prop_data[0]) { print "$prop_data[0]:"; if (!$S_PRO{"$_"}) { print "不明"; } else { print "$prop_data[$S_PRO{\"$_\"}]"; } print "  \n"; } } print "\n"; } print "
  $p_date
\n"; } print <<"EOM";
コード
EOM &footer; exit; } # -----詳細データ----- sub detail { &titles("$number"); open(IN,"$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません"); @q_options = ; close(IN); &v_sort(""); $rank = 1; $rank_bf = ""; $rank_ad = ""; foreach (@sort_op) { ($s_num,$s_nam,$s_cnt,$s_pro,$s_ip,$p_date) = split(/<>/,$_); if ($s_cnt == $rank_bf) { $rank_ad++ } else { $rank += $rank_ad;$rank_ad = 1; } if ($s_num == $select) { last; } #目的のデータを取り出す $rank_bf = $s_cnt; } open(IN,"$q_file_dir$q_detail$number.dat") || &error("$q_file_dir$q_detail$number.datが開けません"); @q_details = ; close(IN); &header("詳細データ_$s_nam"); if ($p_date) { print "最終投票日時
\n$p_date
\n"; } local @tmps = split(/<,>/,$s_pro); #特徴毎の得票数 local @tmps2 = split(/<,>/,$logs[11]); if (@tmps2) { #特徴を使う場合 print <<"EOM";
EOM } print "\n"; for (0..$#tmps) { local @tmps3 = split(/,/,$tmps[$_]); local @tmps4 = split(/<,,>/,$tmps2[$_]); $pro_title = shift(@tmps4); if ($logs[14] != 1) { unshift(@tmps4,"不明"); } else { shift(@tmps3); } if ($pro_title) { @pro_sort = (); for (0..$#tmps3) { push(@pro_sort,"$tmps4[$_],$tmps3[$_]"); } if ($FORM{"sort_flag"}) { local @tmps1 = (); foreach (@pro_sort) { my ($xx,$t_pro) = split(/,/,$_); push(@tmps1,$t_pro); } @pro_sort = @pro_sort[sort { $tmps1[$b] <=> $tmps1[$a] } 0..$#tmps1]; } print "\n"; foreach (@pro_sort) { ($pro_t,$pro_n) = split(/,/,$_); print "\n"; } } } print "
$s_nam $s_cnt票 ($rank位)
$pro_title得票数
$pro_t$pro_n 【"; if ($pro_n) { $percent = ($pro_n / $s_cnt) * 100; } else { $percent = 0; } printf ("%4.1f",$percent); $c_width = $percent * 3; print "%】"; if ($pro_n) { print ""; } else { print "
"; } print "
\n"; if ($logs[10]) { #コメントの入力を求めるなら $comm_sw = 0; print "
\n"; foreach (@q_details) { ($v_num,$S_PRO{"0"},$S_PRO{"1"},$S_PRO{"2"},$S_PRO{"3"},$S_PRO{"4"},$S_PRO{"5"},$IP,$p_date,$v_comment) = split(/<>/,$_); if ($logs[8] && $v_comment) { #複数選択式の場合 @selects = split(/,/,$v_num); #選んだ番号毎に分ける foreach (@selects) { if ($_ == $select) { $v_num = $select; } #択一選択式と合わせるため、番号を変数へ入れ直す } } if ($v_num == $select && $v_comment) { $comm_sw = 1; print "\n"; } } if (!$comm_sw) { print "\n"; } print "
コメント
$v_comment
"; if (@tmps2) { #特徴を使うなら print ""; for (0..5) { @tmps4 = split(/<,,>/,$tmps2[$_]); if ($tmps4[0]) { print "$tmps4[0]:"; if (!$S_PRO{"$_"}) { print "不明  "; } else { print "$tmps4[$S_PRO{\"$_\"}]  "; } } } print " $p_date"; } print "
コメントはありません
\n"; } &footer; exit; } # -----投票----- sub vote { if ($comment !~ /[^\s|(\x81\x40)]/) { $comment = ""; } ## else { ## $comment =~ s/\s{2,}/ /g; ## $comment =~ s/^[(\x81\x40)|\s]+//; ## $comment =~ s/[(\x81\x40)|\s]+$//; ## } if ($c_maxlength*2 < length($comment)) { my $tmp = $c_maxlength*2; &error("コメントは$c_maxlength文字(半角$tmp文字)以内で記述してください"); } $lock = &lock or die 'error'; &titles("$number"); #ログ取り出し open(IN,"$q_file_dir$q_detail$number.dat") || &error("$q_file_dir$q_detail$number.datが開けません","1"); @details = ; close(IN); $IP = $ENV{'REMOTE_ADDR'}; #投票が1回のみ許されている場合 if ($logs[9] == 2) { &get_cookie("$number"); if ($vote_end eq "end") { &error("投票は1回しかできません","1"); } foreach (@details) { ($xx,$xx,$xx,$xx,$xx,$xx,$xx,$s_ip) = split(/<>/,$_); if ($IP eq $s_ip) { &error("投票は1回しかできません","1"); } } } open(IN,"$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません","1"); @q_options = ; close(IN); if ((!@option && $logs[8]) || (!$select && !$logs[8])) { &error("選択肢を選んでください","1"); } if ($logs[10] == 2 && !$comment) { &error("コメントは必須です","1"); } local $i = ""; @news = (); &get_time; #複数選択式の場合 if ($logs[8]) { #詳細データフォーマット $selects = join(",",@option); unshift(@details,"$selects<>$FORM{\"pro_sel_0\"}<>$FORM{\"pro_sel_1\"}<>$FORM{\"pro_sel_2\"}<>$FORM{\"pro_sel_3\"}<>$FORM{\"pro_sel_4\"}<>$FORM{\"pro_sel_5\"}<>$IP<>$date<>$comment<>\n"); foreach $select (@option) { foreach (@q_options) { ($s_num,$s_nam,$s_cnt,$s_pro,$s_ip) = split(/<>/,$_); if ($select == $s_num) { #選択されていたら if ($IP eq $s_ip && $logs[9]) { &error("$s_namへはすでに投票済みです
同一項目への投票は1回しかできません","1"); } local @tmps = split(/<,>/,$s_pro); #特徴チェック for ($i = 0;$i <= 5;$i++) { if ($tmps[$i]) { #特徴$iを使用するなら if ($logs[14] == 1 && !$FORM{"pro_sel_$i"}) { &error("特徴は必須です","1"); } local @tmps2 = split(/,/,$tmps[$i]); #特徴の各項目 $tmps2[$FORM{"pro_sel_$i"}]++; #特徴ユーザー数+1 $tmps[$i] = join(",",@tmps2); #特徴$iを@tmpsに入れ直す } else { $tmps[$i] = ""; } } $s_pro = join("<,>",@tmps); #@tmpsを$s_proに入れ直す $s_cnt++; $_ = "$s_num<>$s_nam<>$s_cnt<>$s_pro<>$IP<>$date<>\n"; last; } } } } #単一選択式の場合 else { foreach (@q_options) { ($s_num,$s_nam,$s_cnt,$s_pro,$s_ip) = split(/<>/,$_); if ($s_num == $select) { #選択した項目なら if ($IP eq $s_ip && $logs[9]) { &error("$s_namへはすでに投票済みです
同一項目への投票は1回しかできません","1"); } unshift(@details,"$select<>$FORM{\"pro_sel_0\"}<>$FORM{\"pro_sel_1\"}<>$FORM{\"pro_sel_2\"}<>$FORM{\"pro_sel_3\"}<>$FORM{\"pro_sel_4\"}<>$FORM{\"pro_sel_5\"}<>$IP<>$date<>$comment<>\n"); local @tmps = split(/<,>/,$s_pro); #特徴チェック for ($i = 0;$i <= 5;$i++) { if ($tmps[$i]) { #特徴$iを使用するなら if ($logs[14] == 1 && !$FORM{"pro_sel_$i"}) { &error("特徴は必須です","1"); } local @tmps2 = split(/,/,$tmps[$i]); #特徴の各項目 $tmps2[$FORM{"pro_sel_$i"}]++; #特徴ユーザー数+1 $tmps[$i] = join(",",@tmps2); #特徴$iを@tmpsに入れ直す } else { $tmps[$i] = ""; } } $s_pro = join("<,>",@tmps); #@tmpsを$s_proに入れ直す $s_cnt++; $_ = "$s_num<>$s_nam<>$s_cnt<>$s_pro<>$IP<>$date<>\n"; } } } #詳細データファイルを更新 while ($#details >= $max_details) { pop(@details); } open(OUT,">$q_file_dir$q_detail$number.dat") || &error("$q_file_dir$q_detail$number.datが開けません","1"); print OUT @details; close(OUT); #選択肢ファイルを更新 open(OUT,">$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません","1"); print OUT @q_options; close(OUT); #タイトルファイルを更新 foreach (@q_titles) { $_ =~ s/\n//g; @tmps = split(/<>/,$_); if ($tmps[0] == $number) { $tmps[13] = $date; #最終投票日時だけ変更 $tmp = join("<>",@tmps); $tmp .= "<>\n"; push(@new_titles,$tmp); } else { push(@new_titles,"$_\n"); } } unshift(@new_titles,"$titlenumber\n"); open(OUT,">$q_t_file") || &error("$q_t_fileが開けません","1"); print OUT @new_titles; close(OUT); &set_cookie("$number"); #クッキー発行 &unlock($lock); &enquete; exit; } # -----ソートルーチン----- sub v_sort { local @tmps = @tmps1 = @tmps2 = (); $total_c = 0; #全投票数 foreach (@q_options) { local ($xx,$xx,$t_count,$t_pro) = split /<>/; $total_c += $t_count; $pro_n = 0; if ($_[0]) { local ($S_PRO{'0'},$S_PRO{'1'},$S_PRO{'2'},$S_PRO{'3'},$S_PRO{'4'},$S_PRO{'5'}) = split(/<,>/,$t_pro); ($pro_t,$pro_n) = split(/_/,$_[0]); local @tmps = split(/,/,$S_PRO{"$pro_t"}); push(@tmps1,$tmps[$pro_n]); } push(@tmps2,$t_count); } #標準ソート @sort_op = @q_options[sort { $tmps2[$b] <=> $tmps2[$a] } 0 .. $#tmps2]; ($xx,$xx,$top_cnt) = split(/<>/,$sort_op[0]); if ($_[0] && $pro_n) { @sort_op = @q_options[sort { $tmps1[$b] <=> $tmps1[$a] or $tmps2[$b] <=> $tmps2[$a] } 0 .. $#tmps1]; } } # -----アンケート管理----- sub admin_q { &titles("$number"); #目的のログ取り出し→@logs if ($code ne $masterkey && &ch_code("$code","$logs[5]") eq "ng") { &error("コードが違います"); } #コードチェック #選択肢ファイルを開く open(IN,"$q_file_dir$q_model$logs[0].log") || &error("$q_file_dir$q_model$logs[0].logが開けません"); @q_options = ; close(IN); &header("アンケート管理"); print <<"EOM"; [使い方] [$back_nam]
追加する選択肢を記入してください

  ($s_maxlength文字以内)

EOM if (!@q_options) { print "選択肢なし

"; } else { print <<"EOM"; EOM foreach (@q_options) { @options = split(/<>/,$_); print "\n"; } print "\n"; print "
削除選択肢
$options[1]
\n"; } &footer; exit; } # -----仕様変更----- sub admin_type { &titles("$number"); #ログ取り出し if ($code ne $masterkey && &ch_code("$code","$logs[5]") eq "ng") { &error("不正な操作です"); } &header("仕様変更"); $quest_bf = $logs[4]; $quest_bf =~ s/
/\n/ig; print <<"EOM"; 仕様変更
\n\n\n\n\n\n\n\n\n\n"; local @tmps = split(/<,>/,$logs[11]); if (@tmps) { print "\n"; } print "\n"; print "
お名前
e-mail
タイトル
曲名
EOM if ($logs[6]) { print ""; } else { print ""; } print "ユーザーが選択肢を増やせる
\n"; if ($logs[7]) { print ""; } else { print ""; } print "タグの使用を許可する

\n"; if ($logs[10]) { print ""; } else { print ""; } print "コメントの入力を求める
\n"; if ($logs[10] == 2) { print ""; } else { print ""; } print "コメントを必須にする

\n"; if ($logs[8]) { print "複数選択式
\n"; print ""; } else { print "複数選択式
\n"; print ""; } print "単一選択式

\n"; if ($logs[9] == 0) { print ""; } else { print ""; } print "同一項目の連続投票可能\
\n"; if ($logs[9] == 1) { print ""; } else { print ""; } print "同一項目の連続投票不可
\n"; if ($logs[9] == 2) { print ""; } else { print ""; } print "他項目についても連続投票不可
\n
特徴を必須にする
 
\n"; &footer; exit; } # -----アンケート削除受付----- sub admin_type_del { &header("アンケート削除"); print <<"EOM";
アンケートを削除します。

コードを入力してください。
EOM &footer; exit; } # -----仕様変更書き込み----- sub admin_type_w { &titles("$number"); #ログ取り出し if ($code ne $masterkey && &ch_code("$code","$logs[5]") eq "ng") { &error("不正な操作です"); } $lock = &lock or die 'error'; @news = (); # &titlesで読み込んだ@q_titlesを使う foreach (@q_titles) { @q_tmp = split(/<>/,$_); if ($q_tmp[0] == $number) { #目的のログなら if (!$del_quest) { #削除でなければ if ($comment_in_ess) { $comment_in = 2; } if (!$FORM{'pro_ess'}) { $FORM{'pro_ess'} = "0"; } push(@news,"$q_tmp[0]<>$enqname<>$name<>$mail<>$quest<>$q_tmp[5]<>$inc_sel<>$inc_sel_tag<>$sel_mul<>$sel_cont<>$comment_in<>$q_tmp[11]<>$q_tmp[12]<>$q_tmp[13]<>$FORM{'pro_ess'}<>\n"); } } else { push(@news,$_); } } unshift(@news,"$titlenumber\n"); # &titlesで取り除いた総出題数部分を付け直す open(OUT,">$q_t_file") || &error("$q_t_fileが開けません","1"); print OUT @news; close(OUT); if ($del_quest) { #削除なら詳細と選択肢ファイルも削除する if (-e "$q_file_dir$q_detail$number.dat") { unlink("$q_file_dir$q_detail$number.dat"); } if (-e "$q_file_dir$q_model$number.log") { unlink("$q_file_dir$q_model$number.log"); } } &unlock($lock); if ($del_quest) { &html; } else { &admin_type; } } # -----選択肢削除----- sub admin_del { &titles("$number"); #ログ取り出し if ($code ne $masterkey && &ch_code("$code","$logs[5]") eq "ng") { &error("不正な操作です"); } $lock = &lock or die 'error'; open(IN,"$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません","1"); @q_options = ; close(IN); foreach (@q_options) { $tmp = 0; @tmps = split(/<>/,$_); foreach $del_op (@option) { if ($del_op == $tmps[0]) { $tmp = 1;last; } } if (!$tmp) { push(@news,$_); } } open(OUT,">$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません","1"); print OUT @news; close(OUT); &unlock($lock); &admin_q; } # -----選択肢追加----- sub admin_q_w { if ($option_name !~ /[^\s|(\x81\x40)]/) { $option_name = ""; } elsif ($fake_deny) { # いたずら的選択肢排除 $option_name =~ s/^(\x81\x40|\s)+//; $option_name =~ s/(\x81\x40|\s)+$//; $option_name =~ s/(\x81\x40|\s){2,}/$1/g; } if ($s_maxlength*2 < length($option_name)) { my $tmp = $s_maxlength*2; &error("選択肢は全角$s_maxlength文字(半角$tmp文字)以内で記述してください"); } if (!$option_name) { &error("追加する選択肢を入力してください"); } &titles("$number"); if ($FORM{'code2'} eq "user") { #ユーザーの場合、urlベタ打ち回避、タグ処理 if (!$logs[6]) { &error("不正な操作です"); } if (!$logs[7]) { #タグを許可しないなら #<,>,"をそれぞれ変換する $option_name =~ s//>/g; $option_name =~ s/\"/"/g; } } if ($code ne $masterkey && &ch_code("$code","$logs[5]") eq "ng" && !$FORM{'code2'}) { &error("不正な操作です"); } #URLベタ打ち回避 $lock = &lock or die 'error'; $property = $logs[11]; open(IN,"$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません","1"); @q_options = ; close(IN); local @tmps=(); foreach (@q_options) { @tmps = split(/<>/,$_); if ($tmps[1] eq $option_name) { &error("$option_nameという選択肢はすでに存在します","1"); } } local ($tmp); if (!@q_options) { $tmp = 0; } else { ($tmp) = split(/<>/,$q_options[$#q_options]); } $tmp++; @tmps = split(/<,>/,$property); #各特徴に分ける local @tmps2 = (); for (0..5) { @tmps2 = split(/<,,>/,$tmps[$_]); #特徴の選択肢毎に分ける if (@tmps2) { $tmps3[$_] = '0,' x $#tmps2; $tmps3[$_] .= "0"; } else { $tmps3[$_] = ""; } } $IP = $ENV{'REMOTE_ADDR'}; push(@q_options,"$tmp<>$option_name<>0<>$tmps3[0]<,>$tmps3[1]<,>$tmps3[2]<,>$tmps3[3]<,>$tmps3[4]<,>$tmps3[5]<>make_$IP<><>\n"); open(OUT,">$q_file_dir$q_model$number.log") || &error("$q_file_dir$q_model$number.logが開けません","1"); print OUT @q_options; close(OUT); &unlock($lock); if ($FORM{'code2'} eq "user") { &enquete; } else { &admin_q; } } # -----目的のタイトルログ取り出し----- sub titles { # &titles("$number");→@logs取り出し open(IN,"$q_t_file") || &error("$q_t_fileが開けません"); @q_titles = ; close(IN); $titlenumber = $q_titles[0]; $titlenumber =~ s/\n//g; shift(@q_titles); #総曲名数部分を取り除く foreach (@q_titles) { @logs = split(/<>/,$_); if ($logs[0] == $_[0]) { last; } #目的のログを取り出す } } # -----デコード----- sub decode { @option = (); if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name,$value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; &jcode'h2z_sjis(*value); &jcode'convert(*value,'sjis'); #タグを許可する if ($tag_ok && $name ne "property") { $value =~ s//<!--$1-->/g; $value =~ s/<([^>]*javascript\:[^>]*|![\s]*-[\s]*-[^>]*--)>/<$1>/ig; $value =~ s/<(\/?(table|th|tr|td|xmp|plaintext|script|listing|form)[^>]*)>/<$1>/ig; $value =~ s/<>/<>/g; $value =~ s/<,>/<,>/g; $value =~ s/<,,>/<,,>/g; #タグを許可しない } elsif ($name ne "property") { $value =~ s//>/g; $value =~ s/\"/"/g; } $value =~ s/\r\n/
/g; $value =~ s/\r/
/g; $value =~ s/\n/
/g; if ($name eq 'option' || $name eq 'q_delete') { push(@option,$value); } else { $FORM{$name} = $value; } } $mode = $FORM{'mode'}; $name = $FORM{'name'}; $enqname = $FORM{'enqname'}; $quest_bf = $FORM{'quest_bf'}; $quest = $FORM{'quest'}; $code = $FORM{'code'}; $inc_sel = $FORM{'inc_sel'}; $inc_sel_tag = $FORM{'inc_sel_tag'}; $pro_0 = $FORM{'pro_0'}; $pro_1 = $FORM{'pro_1'}; $pro_2 = $FORM{'pro_2'}; $pro_3 = $FORM{'pro_3'}; $pro_4 = $FORM{'pro_4'}; $pro_5 = $FORM{'pro_5'}; $passcode = $FORM{'passcode'}; $mail = $FORM{'mail'}; $sel_mul = $FORM{'sel_mul'}; $sel_cont = $FORM{'sel_cont'}; $number = $FORM{'number'}; $option_name = $FORM{'option_name'}; $property = $FORM{'property'}; $comment_in = $FORM{'comment_in'}; $comment_in_ess = $FORM{'comment_in_ess'}; $comment = $FORM{'comment'}; $select = $FORM{'select'}; $sort_num = $FORM{'sort_num'}; $del_quest = $FORM{'del_quest'}; $tsort = $FORM{'tsort'}; } # -----時間取得----- sub get_time { $ENV{'TZ'} = "JST-$d_time"; ($d,$min,$hour,$mday,$mon,$year,$wday,$d,$d) = localtime(time); $year += 1900; $mon++; if ($mon < 10) { $mon = "0$mon"; } if ($mday < 10) { $mday = "0$mday"; } if ($hour < 10) { $hour = "0$hour"; } if ($min < 10) { $min = "0$min"; } $date = "$year\/$mon\/$mday $hour:$min"; } # -----コード暗号化------ sub cr_code{ local $code = $_[0]; $time2 = time; $salt = substr($time2,-2,2); return crypt($code,$salt); } # ------被暗号コードの照合------ sub ch_code{ ($form_code,$log_code)= @_; #(未暗号,被暗号) if ($log_code =~ /^\$1\$/) { $key=3;} else{ $key = 0; } if (crypt($form_code,substr($log_code,$key,2)) eq "$log_code"){ return 'ok'; }else{ return 'ng'; } } # ----- クッキーの発行 ----- sub set_cookie { $cookie_time = 120*24*60*60; ($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg) = gmtime(time + $cookie_time); $yearg += 1900; if ($secg < 10) { $secg = "0$secg"; } if ($ming < 10) { $ming = "0$ming"; } if ($hourg < 10) { $hourg = "0$hourg"; } if ($mdayg < 10) { $mdayg = "0$mdayg"; } $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mong]; $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wdayg]; $date_gmt = "$youbi, $mdayg\-$month\-$yearg $hourg:$ming:$secg GMT"; if ($_[0] eq 'tsort') { $cookie = "ctsort\:$tsort"; } else { $cookie = "c_pro0\:$FORM{'pro_sel_0'}\,c_pro1\:$FORM{'pro_sel_1'}\,c_pro2\:$FORM{'pro_sel_2'}\,c_pro3\:$FORM{'pro_sel_3'}\,c_pro4\:$FORM{'pro_sel_4'}\,c_pro5\:$FORM{'pro_sel_5'}\,vote\:end"; } print "Set-Cookie: MultiQ_$_[0]=$cookie; expires=$date_gmt\n"; if ($tok2) { $tok2_cookie .= "\n"; } } # ----- クッキーの取得 ----- sub get_cookie { @cookie = split(/\;/, $ENV{'HTTP_COOKIE'}); foreach $cookie (@cookie) { local($name, $value) = split(/\=/, $cookie); $name =~ s/ //g; $DUMMY{$name} = $value; } @cookie = split(/\,/, $DUMMY{"MultiQ_$_[0]"}); foreach $cookie (@cookie) { local($name, $value) = split(/\:/, $cookie); $COOKIE{$name} = $value; } if ($_[0] eq 'tsort') { if (!$tsort) { $tsort = $COOKIE{'ctsort'}; } } else { @cookie_pro = (); for (0..5) { if ($FORM{"pro_sel_$_"} || $FORM{"pro_sel_$_"} eq "0") { push(@cookie_pro,$FORM{"pro_sel_$_"}); } else { push(@cookie_pro,$COOKIE{"c_pro$_"}); } } $vote_end = $COOKIE{'vote'}; } } # -----アクセス制限----- sub ip_deny { $deny_sw = 0; if (@ip_list) { $denyip = $ENV{'REMOTE_ADDR'}; foreach (@ip_list) { if (!$_) { next; } s/\*/[\\d]\+/g; s/\./\\./g; if ($denyip =~ /$_/) { $deny=$_;$deny_sw = 1;last; } } if ($deny_sw) { &error("現在、IPアドレス「$denyip」は規制の対象になっているためアクセスできません"); } } $deny_sw = 0; if (@host_list) { $denyip = $ENV{'REMOTE_ADDR'}; $denyhost = $ENV{'REMOTE_HOST'}; if (!$denyhost || $denyhost eq $denyip) { $denyhost = gethostbyaddr(pack("C4", split(/\./, $denyip)), 2); } if (!$denyhost) { $denyhost = $denyip; } foreach (@host_list) { if (!$_) { next; } s/\./\\./g; s/\*/[^\\.]\+/g; if ($denyhost =~ /$_/) { $deny=$_;$deny_sw = 1;last; } } if ($deny_sw) { &error("現在、ホスト「$denyhost」は規制の対象になっているためアクセスできません"); } } } # -----IPからホストを求める----- sub ex_host { ## 「〜/multiq.cgi?mode=host&ip=○.△.□.◇」にアクセスする $ip = $FORM{'ip'}; if (!$ip) { &error('IPアドレスを入力してください'); } $host = gethostbyaddr(pack("C4", split(/\./,$ip)), 2); &header("ホスト表\示_$ip"); print "IPアドレス:$ip

"; if ($ip eq $host || !$host) { print "ホストが取得できませんでした
"; } else { print "ホスト:$host
"; } &footer; exit; } # ------エラー処理------ sub error { if ($_[1]) { &unlock($lock); } &header("エラー"); print <<"EOM"; エラー!!

$_[0]

EOM &footer; exit; } # -----ファイルロック----- sub lock { my %lock = (dir => "$lockdir", basename => "$lockfile", timeout => 60, trytime => 10, @_); $lock{path} = $lock{dir} . $lock{basename}; for (my $i = 0; $i < $lock{trytime}; $i++, sleep 1) { return \%lock if (rename($lock{path}, $lock{current} = $lock{path} . time)); } opendir(LOCKDIR, $lock{dir}); my @filelist = readdir(LOCKDIR); closedir(LOCKDIR); foreach (@filelist) { if (/^$lock{basename}(\d+)/) { return \%lock if (time - $1 > $lock{timeout} and rename($lock{dir} . $_, $lock{current} = $lock{path} . time)); last; } } undef; &error("ファイルがロックされています"); } # -----ロック解除----- sub unlock { rename($_[0]->{current}, $_[0]->{path}); } # -----ヘッダー出力----- sub header { print "Content-type:text/html\n\n\n"; if ($tok2_cookie && $tok2) { print "$tok2_cookie"; } print <<"EOM"; $_[0] $body
$headerban EOM if ($title_i) { # タイトルに画像を使う場合 print "\"$title\"\n
\n"; } else { print "$title\n

\n"; } } # ------フッター出力------ sub footer { ## 著作権表示は削除してはいけません。 print <<"EOM";

- $ver -
+ The House of SKR +


$footerban
EOM }