#!/usr/local/bin/perl
#上記はperlのパス。サーバー管理者の指示に従う。
use strict;
#---------------------#
#席替えCGI Ver.0.21
#---------------------#
#-----設定-----#
my $listfile = "list.dat"; #生徒リストファイル
my $cookie_name = "sekigaekekka"; #クッキー名
my $stylesheet = "style.css"; #スタイルシートファイル
my $body = ""; #BODYタグ
my $home = '
Home
'; #HOME等へのリンク（HTMLタグで）。'は使わないこと
my $bbscgi = "sekigaebbs.cgi"; #感想用BBSのCGIファイル名
my $sonota = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn"; #生徒リストファイルで設定した名前以外の生徒名（半角アルファベットで。1文字ずつ）
my $sonotacolor = "white"; #生徒リストファイルで設定された席以外の席の色
#----------設定は以上--------
my %FORM;
my @datas = &get_cookie;
my @list = &open_file($listfile,"生徒リスト");
chomp @list;
my @names;
my (%color,%image);
my $total = 40; #席数
my @sonota = split("",$sonota);
@sonota = splice(@sonota, 0,$total-scalar(@list));
push(@list,@sonota);
foreach (@list){
my ($name,$color,$image) = split(/\t/,$_);
push (@names,$name);
($color) || ($color = $sonotacolor);
$color{$name} = $color;
$image{$name} = $image;
}
($datas[0]) ? ($datas[0]++) : (@datas = &change(@names));
print &set_cookie(\@datas);
&view(@datas);
exit;
#########Cookie関係
#Cookie取得
sub get_cookie{
my (%DUMMY,@cookies);
my @pairs = split(/\;/,$ENV{'HTTP_COOKIE'});
foreach (@pairs) {
my ($name, $value) = split(/\=/, $_);
$name =~ s/ //g;
$DUMMY{$name} = $value;
}
@pairs = split(/\,/,$DUMMY{"$cookie_name"});
foreach (@pairs) {
@cookies = split(/\:/, $_);
}
return @cookies;
}
#Cookieをセット。
sub set_cookie{
my ($cookies) = @_;
my $expires;
($$cookies[0]>1) ? ($expires = &get_time_GMT($$cookies[1]+60*60*24)) :($expires = &get_time_GMT($^T + 60*60*24));
my $cook = join("\:",@$cookies);
return "Set-Cookie: $cookie_name=$cook; expires=$expires;\n";
}
#Cookie用にGMTを得る。
sub get_time_GMT{
my($time) = @_;
my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
$wday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday];
$mon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon];
$year += 1900;
return sprintf("$wday, %02d-$mon-$year %02d:%02d:%02d GMT", $mday, $hour, $min, $sec);
}
sub change{
my @names = @_;
srand;
for (my $i = @names; --$i; ) {
my $j = int rand ($i + 1);
next if $i == $j;
@names[$i, $j] = @names[$j, $i];
}
unshift(@names,$^T);
unshift(@names,1);
return @names;
}
sub view{
&html_header("席替え結果");
if ($datas[0]>1){
print "席替えは１日に１回ですよ。今日はこれで$datas[0]度目です！
\n";
print "今日は".&gettime($datas[1])."に席替えしてるじゃないですか。
\n";
print "何度引いても席順は変わりませんよ？また".&nokoritime($datas[1])."後にどうぞー。
\n";
}
else{
print "いい席とれましたか？
\n";
}
print "\n";
print "| 黒板 |
\n";
print "窓
側 | | \n";
for(my $i=2;$i<=5;$i++){
print "\n";
($image{$datas[$i]} ne "") && (print "![](\"$image{$datas[$i]}\")
\n");
print "$datas[$i] | \n";
}
print " | 廊
下
側 |
\n";
for (my $i=6;$i<=41;$i++){
($i%6==0) && print "";
print "\n";
($image{$datas[$i]} ne "") && (print "
\n");
print "$datas[$i] | \n";
($i%6==5) && print "
\n";
}
print "
\n";
@datas = splice(@datas,2,40);
my $seats = join(",",@datas);
print <<"_HTML_";
よかったら感想をお願いします♪
送信すると、席替え結果も一緒に記録されます。
_HTML_
&html_footer;
}
#残り時間を計算
sub nokoritime{
my ($time) = @_;
my $time =$time + 24*60*60 - $^T;
my $hour = int($time/3600);
my $min = int(($time-$hour*3600)/60);
my $sec = $time-$hour*3600-$min*60;
($hour>0) ? ($hour = "$hour時間"):($hour="");
($min>0) ? ($min = "$min分"):($min="");
($sec>0)?($sec="$sec秒"):($sec="");
return "$hour$min$sec";
}
#秒数を年月日に変換
sub gettime{
my($time) = @_;
my ($sec,$min,$hour,$dy,$mon,$year,$wday,$yday,$isdst) = gmtime($time+60*60*9);
my @week = ('日','月','火','水','木','金','土');
$time = sprintf("%04d年%01d月%01d日\($week[$wday]\)%02d:%02d",$year+1900,$mon+1,$dy,$hour,$min);
return $time;
}
#&open_file("ファイル名","ファイル名称");ファイルの中身を配列として返す。
sub open_file{
my ($file,$filename) = @_;
open (IN,"$file") || &error(1, "$filenameが開けません。");
my @datas = ;
close (IN);
return @datas;
}
#htmlヘッダー
sub html_header{
my ($title) = @_;
print "Content-type: text/html\n\n";
print <<"_HTML_";
$title
$body
$home
$title
_HTML_
}
#htmlフッタ
sub html_footer{
print <<"_HTML_";
$home
_HTML_
}
#エラーメッセージ
#----------&error($id, "$msg")の形で渡される。$idは数字、$msgはメッセージ
sub error{
my ($id,$msg) = @_;
my @fmsg;
$fmsg[0] = "Backを押して戻ってください";
$fmsg[1] = "管理者に連絡してください";
&html_header("お知らせ");
print "$msg
\n";
print "$fmsg[$id]\n";
&html_footer;
exit;
}