#! c:/perl/bin/perl # # chkbox.cgi # # 1.002 : 1/19/05 : エラーメッセージを修正 # 1.001 : 12/5/05 : オプションと項目のヘッダの色を変更できるように修正 # 1.0 : 12/4/05 : Created. # # $Id: chkbox.cgi,v 1.3 2006/01/19 06:59:16 Hideki Kanayama Exp $ use CGI qw(:cgi-lib); use strict; use CGI::Carp qw(fatalsToBrowser); use File::Basename; my $version = "1.002"; my $lastupdatedyear = "2006"; my $admindat = "adminpwd.dat"; my $setupfile = "checkbox_setup.pl"; my $script = basename($0); my $lang = 0; my $charset = ("Shift_JIS","ISO-8859-1")[$lang]; ########## 環境設定 ここから ########################### our $datafile = "checkbox.dat"; our $items = "items.lst"; # lockfile our $lockfile = "lockfile.dat"; # Title our $title = 'チェックボックス'; # Background our $bgimage_en = 0; our $bgimage_file = ''; our $bgcolor = "#ffffff"; # Back link our $backlink_en = 1; our $backlink = '..'; our $backlink_name = '戻る'; # Body width our $body_width = '100'; # option cell back ground color our $option_bg_color = "#ffcc33"; # option cell font color our $option_font_color = "black"; # item cell back ground color our $item_bg_color = "#66ff99"; # item cell font color our $item_font_color = "black"; #表示テーブルのカラム数 our $table_colms = 1; #参加者設定の初期登録可能人数 our $default_max = 15; #管理用リンク表示 1:有効 0:無効 our $setup_en = 1; #変更日表示 1:有効 0:無効 our $update_en = 0; #パスワード保護 1:有効 0:無効 our $password_en = 0; #カウント 1:有効 0:無効 our $count_en = 0; #管理人オンリーモード 1:有効 0:無効 our $adminonly_en = 1; #オプション オプション名,背景色 our $options = 'お知らせ済み,red アップ完了,blue 更新済み,green 更新予定,lightgreen 新規作成済み,black 新規作成予定,orange '; # body_head our $body_head = "

チェックボックス

"; # body_tail our $body_tail = ' '; # Style Sheet our $style_sheet_en = 0; our $style_sheet = ' '; # Head insert our $head_insert_en = 0; our $head_insert = ' '; #時間設定 1:localtime, 0:offset from GMT our $localtime_en = 1; our $offset_from_gmt = 9; #予備のアップデートファイル # 1: on, 0: off our $update1_file_en = 0; our $update2_file_en = 0; our $update1_file = "update1.log"; our $update2_file = "update2.log"; ########## 環境設定 ここまで ########################### require "$setupfile" if (-e "$setupfile"); my $q = CGI->new; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; if (-e "$setupfile") { require "$setupfile"; } if (! -e "$admindat"){ if ($in{mode} ne 'wradminpwd'){ &setadminpwd; } else { &wradminpwd($in{pwd}); } } if ($in{mode} eq 'atwrite'){ &atwrite; } elsif ($in{mode} eq 'setup'){ &setup; } elsif ($in{mode} eq 'setup_update'){ &setup_update; } else { &display; } ###################### 書き込み ############################ sub atwrite { &error('管理用パスワードが違います。') if (!&checkadmin($in{pwd}) and $adminonly_en == 1); &error('名前は必ず入れてください')if ($in{name} eq "" and $adminonly_en == 0); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= $localtime_en ? localtime(time) : gmtime(time + 3600 * $offset_from_gmt); my $update = sprintf("%s_%s_%s_%02s_%02s",$year+1900,$mon+1,$mday,$hour,$min); my @items = &get_items; my ($date, $lastname, $name, $status, $count, $eachpwd, $eachmod) = &get_data; my (@name, @status, @count, @eachpwd, @eachmod); @name = @{$name}; @status = @{$status}; @count = @{$count}; @eachpwd = @{$eachpwd}; @eachmod = @{$eachmod}; &lockfile; my $tmpfile = "tmp.$$"; open(WRDAT,">$tmpfile"); print WRDAT "0,$in{name},$update,\n"; my $endatt = $#items + 1; my $i; for ($i=1;$i<=$endatt;$i=$i+1){ my $pwdi = "pwd_$i"; chomp($items[$i-1]); if ($in{$i} ne $status[$i]) { $eachmod[$i] = "$update"; if ($password_en == 1 && "$eachpwd[$i]" ne '' && !&checkcrypt("$in{$pwdi}","$eachpwd[$i]")) { close(WRDAT); unlink("$tmpfile"); &error("$name[$i]を変更しようとしましたが、そのパスワードが違います。"); } } if ($password_en == 1 && ("$in{$pwdi}" ne '' && "$eachpwd[$i]" eq '')){ $eachpwd[$i] = &makecrypt("$in{$pwdi}"); } print WRDAT "$i,$items[$i-1],$in{$i},$in{\"count_$i\"},$eachmod[$i],$eachpwd[$i]\n"; } close(WRDAT); rename("$tmpfile","$datafile"); chmod(0666,"$datafile"); &unlockfile; &extraupdate; print "Location: $script\n\n"; } ###################### 表示 ############################ sub display { &htmlhead($title); my ($date, $lastname, $name, $status, $count, $eachpwd, $eachmod) = &get_data; my (@name, @status, @count, @eachpwd, @eachmod); @name = @{$name}; @status = @{$status}; @count = @{$count}; @eachpwd = @{$eachpwd}; @eachmod = @{$eachmod}; my @items_list = &get_items; print "$body_head"; print "

\n"; print "\n"; if ($date =~ /(\d+)_(\d+)_(\d+)_(\d+)_(\d+)/) { $date = sprintf("%s年%s月%s日%s時%s分",$1,$2,$3,$4,$5); } else { $date = " "; } print "$backlink_name

\n" if ($backlink_en); if ($adminonly_en == 0){ print "

最終更新者は "; print "$lastname"; print "、最終更新日は "; print "$dateです"; print qq(
更新者のお名前:

); } else { print "最終更新日:"; print "$date

"; print qq(管理用パスワード:
); } print qq( ←決定ボタンはここ); my @option_list = grep !/^\s*$/, split /[\r\n]/, $options; my $select_items = $#option_list + 2 + $update_en + $count_en + $password_en; my $cols = $table_colms * $select_items; print "\n"; print "\n"; my $i; for ($i=1;$i<=$table_colms;$i=$i+1){ print "\n"; my $j; for ($j=0;$j<=$#option_list;$j++) { my ($option,$color) = split /,/, $option_list[$j]; print "\n"; } print "\n" if ($count_en == 1); print "\n" if ($update_en == 1); print "\n" if ($password_en == 1); } print "\n"; my $i = 1; my $totalcheckbox; my @total; while ($#items_list >= 0){ print "\n"; my $j; for ($j=1;$j<=$table_colms;$j=$j+1){ if ($#items_list < 0) { my $h; for ($h=0;$h<$select_items;$h=$h+1){ print "\n"; } last; } print "\n"; my @checked; $checked[$status[$i]] = 'checked'; my $k; for ($k=0;$k<=$#option_list;$k++) { my ($item,$color) = split /,/, $option_list[$k]; if ($checked[$k] eq 'checked') { print "\n"; } if ($count_en == 1){ $count[$i] = 0 if (!$count[$i]); print "\n"; } if ($update_en == 1){ print "\n"; } if ($password_en == 1){ print "\n"; } else { print "\n"; } $totalcheckbox = $totalcheckbox + $count[$i]; shift(@items_list); $i = $i + 1; } print "\n"; } print ""; print "\n"; my $rightcolspan = $update_en + $count_en + $password_en; my $leftcol = $cols - $rightcolspan - 2; for ($i=0;$i<=$leftcol;$i++){ if ($total[$i] ne '') { print "\n"; } else { print "\n"; } } if ($count_en == 1){ print "\n"; } else { for ($i=1;$i<=$rightcolspan;$i++){ print "\n"; } } print "\n"; print "
項目$option数量更新日パスワード
 "; chomp($items_list[0]); print "$items_list[0]"; print ""; $total[$k]++; } else { print ""; } print ""; print ""; print ""; if ($eachmod[$i] =~ /(\d+)_(\d+)_(\d+)_(\d+)_(\d+)/) { print "$2/$3/$1"; } else { print " "; } print ""; print ""; print "
合計$total[$i]0合計 $totalcheckbox 
\n"; if ($password_en == 1){ if ($adminonly_en) { print "各項目のパスワードを入力して更新すると個別のパスワードを設定できます。
\n"; } else { print "パスワードをブランクで登録すると誰でも変更できるようになります。ブランク以外の時だけ保護されます。
\n"; } } ©right; if ($setup_en == 1){ print "
管理用
\n"; } print "

"; print "$body_tail"; &htmltail; } ###################### セットアップ ############################ sub setup { &setadminpwd if ($in{pwd} eq ''); &error('管理用パスワードが違います。') unless &checkadmin($in{pwd}); &htmlhead('管理用セットアップ'); print "
\n"; print "\n"; print "\n"; print "\n"; my @setup_check; my @update_check; my @password_check; my @count_check; my @update1_file_check; my @update2_file_check; my @localtime_check; my @adminonly_check; $setup_check[$setup_en] = "checked"; $update_check[$update_en] = "checked"; $password_check[$password_en] = "checked"; $count_check[$count_en] = "checked"; $update1_file_check[$update1_file_en] = "checked"; $update2_file_check[$update2_file_en] = "checked"; $localtime_check[$localtime_en] = "checked"; $adminonly_check[$adminonly_en] = "checked"; my %check; $check{bgimage}[$bgimage_en] = "checked"; $check{backlink}[$backlink_en] = "checked"; $check{style_sheet}[$style_sheet_en] = "checked"; $check{head_insert}[$head_insert_en] = "checked"; print <
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $scriptがバージョンアップされた場合、単純に$scriptだけを置き換えるだけで設定はそのまま使えます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理用リンクを非表\示にしている場合にこのページにアクセスするには、$script?mode=setupを実行するとアクセスできます。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとCGIが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
データファイル
出席者登録ファイル
ロックファイル
タイトル
ブラウザのタイトルバーに表\示されるタイトルです。ページのタイトルは「ページ上部」で自由にタイトル表\示させることができます。
バックグランド 画像を使う カラー設定にする
画像を使う場合の画像ファイル
カラー設定の場合のカラー番号(白:\#ffffff 又は white)
トップへのリンク 表\示 非表\示
リンク名
URL
表\示幅 ブラウザ全体の
ヘッダーセルの色 オプションセルの背景色
オプションセルのフォント色
項目セルの背景色
項目セルのフォント色
管理人オンリーモード 管理人オンリーモード ユーザーモード
オプション設定 選択可能\なオプションを「オプション名,背景色」で並べてください。
例)
参加,red
不参加,#ff0000
未定,green
項目の初期登録可能\数
管理用リンク表\示 表\示 非表\示
変更時間表\示 表\示 非表\示
数量 有効 無効
パスワード保護 有効 無効
ページ上部 ページ上部に表\示させるものをHTML表\記

ページ下部 ページ下部に表\示させるものをHTML表\記

スタイルシート 有効 無効

<head>内挿入文 有効 無効
HTML書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。

時間設定 GMTからのオフセット ローカルタイム
GMTからのオフセットに設定した場合、GMTより時間(日本:+9時間)
予\備のアップデートファイル 使用 非使用 ファイル名
使用 非使用 ファイル名
END_SETUP print "

"; # 項目 my @items_list = &get_items; print "


項目設定

\n"; print "\n"; print "\n"; my $i = 1; while (@items_list){ $_=shift(@items_list); print "\n"; print "\n"; $i = $i + 1; if ($table_colms == 2){ $_=shift(@items_list); print "\n"; $i = $i + 1; } print "\n"; } my $extra_items = 3; my $extra_max; if ($i < $default_max - $extra_items){ $extra_max = $default_max; } else { $extra_max = $i + $extra_items; } my $j; for ($j=$i;$j<=$extra_max;$j=$j+1){ print "\n"; print "\n"; $i = $i + 1; if ($table_colms == 2){ $_=shift(@items_list); print "\n"; $i = $i + 1; $j = $j + 1; } } print "\n"; print "
\n"; print "\n"; print "

\n"; print "\n"; print "

\n"; print "

"; ©right; print "
"; &htmltail; } ###################### セットアップ作成 ############################ sub wrsetup { &error('パスワードが違います。') unless (&checkadmin($in{pwd})); open(SETUP,"> $setupfile") || &error('セットアップファイルが作成できません。
CGIを置いてあるディレクトリが書き込み可能\か確認してください。'); foreach (keys(%in)){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/,/,/g; $in{$_} =~ s/<//g; $in{$_} =~ s/\s*$//; } print SETUP < $items") || &error("$itemsを作成できません。"); my $i; for ($i=1;$i<=$default_max+3;$i=$i+1){ my $attname = 'attname' . $i; if ($in{$attname} ne ''){ print FILE "$in{$attname}\n"; } } close(FILE); } sub setup_update { if (defined $in{update_admin}){ &wrsetup; } elsif (defined $in{update_items}){ &writems; } else { &wrsetup; &writems; } print "Location: $script\n\n"; } sub checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd" or &checkadmin($pwd)); } sub htmlhead { my $title = shift; my $bgimage; if ($bgimage_en == 1){ $bgimage = "background=\"$bgimage_file\""; } else { $bgimage = "bgcolor=\"$bgcolor\""; } print $q->header(-charset=>$charset); print "\n"; print "\n"; print "\n"; print "$title\n"; if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } print "\n"; print "\n"; print "
\n"; } sub copyright { my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "$script Ver. $version\n"; print "Copyright(C) 2005-$lastupdatedyear, hidekik.com\n"; } sub htmltail { print "
\n"; exit; } sub error { my ($msg) = shift; &unlockfile; &htmlhead($msg); print "
$msg
\n"; print "
"; ©right; print "
"; &htmltail; exit; } sub makecrypt { my $plain = shift; my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$'); return $result; } sub setadminpwd { my $subname = 'setadminpwd'; &htmlhead('管理者用パスワードを入力してください'); print "
\n"; if ($in{mode} eq 'setup'){ print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "\n"; print "\n"; } else { print "
管理者用パスワードを設定してください。
\n"; print "\n"; print "\n"; print "\n"; } print "

"; ©right; print "
"; &htmltail; exit; } sub wradminpwd { my $plain = shift; my $passwd = &makecrypt($plain); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { &error('パスワードファイル作成に失敗しました'); } print "Location: $script\n\n"; } sub checkadmin { my $pwd = shift; if (open(ADMINFILE,"< $admindat")){ my $filepwd = ; close(ADMINFILE); my $inpwd = crypt($pwd,$filepwd); return ("$inpwd" eq "$filepwd"); } else { &error('パスワードファイルが存在しません'); } } sub lockfile { while(-e "$lockfile"){ sleep(1); } open(LOCK,"> $lockfile"); close(LOCK); } sub unlockfile { unlink("tmp.$$") if (-e "tmp.$$"); unlink("$lockfile") if (-e $lockfile); } sub get_items { my @items_list; if (open(ITEM,"< $items")){ @items_list = ; map {chomp} @items_list; close(ITEM); } return (@items_list); } sub get_data { my ($date, $lastname); my (@name, @status, @count, @eachpwd, @eachmod); if (open(CHECKBOX,"< $datafile")) { foreach (){ chomp; my ($key,$name,$value,$count,$moddate,$pwd)=split(/,/); if ($key == 0){ $date = $value;; $lastname = $name; } else { $name[$key] = "$name"; $status[$key] = "$value"; $count[$key] = "$count"; $eachpwd[$key] = "$pwd"; $eachmod[$key] = "$moddate"; } } close(CHECKBOX); } return ($date, $lastname, \@name, \@status, \@count, \@eachpwd, \@eachmod); } sub extraupdate { if ($update1_file_en == 1){ open(UPDATE,">$update1_file"); print UPDATE "dummy file1\n"; close(UPDATE); chmod(0666,"$update1_file"); } if ($update2_file_en == 1){ open(UPDATE,">$update2_file"); print UPDATE "dummy file2\n"; close(UPDATE); chmod(0666,"$update2_file"); } }