#! c:/perl/bin/perl # # attlist.cgi # # 4.0 : 10/12/05 : Created as a Non-SSI versoin # # $Id: attlist2.cgi,v 1.8 2005/10/13 05:21:20 Hideki Kanayama Exp $ use CGI qw(:cgi-lib); use strict; use CGI::Carp qw(fatalsToBrowser); use File::Basename; my $version = "4.0"; my $lastupdatedyear = "2005"; my $admindat = "adminpwd.dat"; my $setupfile = "attend_setup.pl"; my $script = basename($0); my $charset = "Shift_JIS"; my $lang = 1; ########## 環境設定 ここから ########################### our $datafile = "attend.dat"; our $attendees = "attendees.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'; #表示テーブルのカラム数 our $table_colms = 2; #参加者設定の初期登録可能人数 our $default_max = 30; #管理用リンク表示 1:有効 0:無効 our $setup_en = 1; #変更日表示 1:有効 0:無効 our $update_en = 0; #パスワード保護 1:有効 0:無効 our $password_en = 0; #参加人数 1:有効 0:無効 our $family_en = 0; #初期状態 1:あり 0:なし our $init_state_en = 0; # 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 = ' '; #時間設定 our $offset = 9; #トップからのSSI表示による更新時間のための予備のアップデートファイル # 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; &postprocess; 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 ($in{name} eq ""); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime(time + 3600 * $offset); my $update = sprintf("%s_%s_%s_%02s_%02s",$year+1900,$mon+1,$mday,$hour,$min); my @attendees = &get_attendees; my ($date, $lastname, $name, $status, $family, $eachpwd, $eachmod) = &get_data; my (@name, @status, @family, @eachpwd, @eachmod); @name = @{$name}; @status = @{$status}; @family = @{$family}; @eachpwd = @{$eachpwd}; @eachmod = @{$eachmod}; &lockfile; my $tmpfile = "tmp.$$"; open(WRDAT,">$tmpfile"); print WRDAT "0,$in{name},$update,\n"; my $endatt = $#attendees + 1; my $i; for ($i=1;$i<=$endatt;$i=$i+1){ my $pwdi = "pwd_$i"; chomp($attendees[$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,$attendees[$i-1],$in{$i},$in{\"family_$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, $family, $eachpwd, $eachmod) = &get_data; my (@name, @status, @family, @eachpwd, @eachmod); @name = @{$name}; @status = @{$status}; @family = @{$family}; @eachpwd = @{$eachpwd}; @eachmod = @{$eachmod}; my @attendees_list = &get_attendees; 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); print "

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

 ←決定ボタンはここ FINISH_1 my $select_items = 4 + $init_state_en + $update_en + $family_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"; print "\n"; print "\n"; print "\n"; print "\n" if ($init_state_en == 1); print "\n" if ($family_en == 1); print "\n" if ($update_en == 1); print "\n" if ($password_en == 1); } print "\n"; my $i = 1; my $totalattend; while ($#attendees_list >= 0){ print "\n"; my $j; for ($j=1;$j<=$table_colms;$j=$j+1){ if ($#attendees_list < 0) { my $h; for ($h=0;$h<$select_items;$h=$h+1){ print "\n"; } last; } my $person = $attendees_list[0]; my $chkatt=""; my $chkabt=""; my $chktbd=""; my $chkdef=""; if ("$status[$i]" eq 'attend'){ $chkatt="CHECKED"; $chkabt=""; $chktbd=""; $chkdef=""; if ($family[$i] < 1){ $family[$i]=1; }; } elsif ($status[$i] eq 'absent'){ $chkatt=""; $chkabt="CHECKED"; $chktbd=""; $chkdef=""; $family[$i]=0; } elsif ($status[$i] eq 'tbd'){ $chkatt=""; $chkabt=""; $chktbd="CHECKED"; $chkdef=""; $family[$i]=0; } elsif ($status[$i] eq 'default'){ $chkatt=""; $chkabt=""; $chktbd=""; $chkdef="CHECKED"; $family[$i]=0; } else { $chkatt=""; $chkabt=""; $chktbd=""; $chkdef=""; $family[$i]=0; } print "\n"; if ($chkatt eq 'CHECKED'){ print "\n"; if ($chkabt eq 'CHECKED'){ print "\n"; if ($chktbd eq 'CHECKED'){ print "\n"; if ($init_state_en == 1){ if ($chkdef eq 'CHECKED'){ print "\n"; } if ($family_en == 1){ print "\n"; } if ($update_en == 1){ print "\n"; } if ($password_en == 1){ print "\n"; } else { print "\n"; } $totalattend = $totalattend + $family[$i]; shift(@attendees_list); $i = $i + 1; } print "\n"; } if ($family_en == 1){ my $rightcolspan = $update_en + $family_en + $password_en; my $leftcolspan = $cols - $rightcolspan; print ""; print ""; print ""; print "\n"; } print "
名前出席欠席未定初期
状態
参加
人数
更新日パスワード
 "; chomp($person); print "$person"; print ""; } else { print ""; } print ""; } else { print ""; } print ""; } else { print ""; } print ""; } else { print ""; } print ""; print ""; print ""; if ($eachmod[$i] =~ /(\d+)_(\d+)_(\d+)_(\d+)_(\d+)/) { print "$2/$3/$1"; } else { print " "; } print ""; print ""; print "
"; print "参加合計"; print "$totalattend 人
\n"; if ($password_en == 1){ 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 @table_colms_check; my @setup_check; my @update_check; my @password_check; my @family_check; my @update1_file_check; my @update2_file_check; my @init_state_check; $table_colms_check[$table_colms] = "checked"; $setup_check[$setup_en] = "checked"; $update_check[$update_en] = "checked"; $password_check[$password_en] = "checked"; $family_check[$family_en] = "checked"; $update1_file_check[$update1_file_en] = "checked"; $update2_file_check[$update2_file_en] = "checked"; $init_state_check[$init_state_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
表\示幅 ブラウザ全体の
参加者設定の初期登録可能\人数
表\示テーブルのカラム数
管理用リンク表\示 表\示 非表\示
初期状態項目 あり なし
変更時間表\示 表\示 非表\示
参加人数 有効 無効
パスワード保護 有効 無効
ページ上部 ページ上部に表\示させるものをHTML表\記

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

スタイルシート 有効 無効

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

時間設定 GMTより時間(日本:+9時間)
予\備のアップデートファイル 使用 非使用 ファイル名
使用 非使用 ファイル名
END_SETUP print "

"; # 参加者設定 my @attendees_list = &get_attendees; print "


参加者設定

\n"; print "\n"; print "\n"; my $i = 1; while (@attendees_list){ $_=shift(@attendees_list); print "\n"; print "\n"; $i = $i + 1; if ($table_colms == 2){ $_=shift(@attendees_list); print "\n"; $i = $i + 1; } print "\n"; } my $extra_attendees = 3; my $extra_max; if ($i < $default_max - $extra_attendees){ $extra_max = $default_max; } else { $extra_max = $i + $extra_attendees; } my $j; for ($j=$i;$j<=$extra_max;$j=$j+1){ print "\n"; print "\n"; $i = $i + 1; if ($table_colms == 2){ $_=shift(@attendees_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 < $attendees") || &error("$attendeesを作成できません。"); 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_attendees}){ &wrattendees; } else { &wrsetup; &wrattendees; } print "Location: $script\n\n"; } sub checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd" or &checkadmin($pwd)); } sub postprocess { my $key; foreach $key (keys %in){ my $br; $br = "
"; $in{$key} =~ s//>/g; if ($in{$key} =~ /\r\n/) { $in{$key} =~ s/\r\n/$br/g; } if ($in{$key} =~ /\n/) { $in{$key} =~ s/\n/$br/g; } if ($in{$key} =~ /\r/) { $in{$key} =~ s/\r/$br/g; } if ($in{$key} =~ /,/) { $in{$key} =~ s/,/&\#44;/g; } } } 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) 1997-$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(FILE,"< $admindat")){ my $filepwd = ; close(FILE); 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_attendees { my @attendees_list; if (open(ATTENDEE,"< $attendees")){ @attendees_list = ; map {chomp} @attendees_list; close(ATTENDEE); } return (@attendees_list); } sub get_data { my ($date, $lastname); my (@name, @status, @family, @eachpwd, @eachmod); if (open(ATTEND,"< $datafile")) { foreach (){ chomp; my ($key,$name,$value,$family,$moddate,$pwd)=split(/,/); if ($key == 0){ $date = $value;; $lastname = $name; } else { $name[$key] = "$name"; $status[$key] = "$value"; $family[$key] = "$family"; $eachpwd[$key] = "$pwd"; $eachmod[$key] = "$moddate"; } } close(ATTEND); } return ($date, $lastname, \@name, \@status, \@family, \@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"); } }