ＮａｓｕｐｉｉのＰｅｒｌ書抜帳
名札を返すプログラムソースコード
Perl ソースコード及びデータファイル
#!c:/perl64/bin/perl.exe
#!/usr/bin/perl
#######################################################################
# nafuda.cgi UTF-8 版
# 2012.05.04 Nasupii 出勤名札 （S-JIS版として新規作成）
# テレビドラマ相棒の主人公たちが出勤と帰宅の時に返す名札をCGIで
# 作ってみました
# 2017.02.04 Nasupii IEで表示が崩れるので、名札の表示を汎用ボタンからdivに変更した
# 2020.09.09 Nasupii S-JIS版 から UTF-8版に変更した
#
# 動作するのに必要なファイルは３個あります
# nafuda.cgi このプログラム
# nafuda.txt 名札に表示する氏名と出勤/帰宅の状態を書き込んだもの
# nafuda.loc ファイルのロック制御用ファイル
#
# 設置にあたって、
# 1.Perlへのパス設定
# お使いのHTTPサーバーの設定方法に従って先頭行で設定してください。
# Apache では、Perl へのパスを先頭行で設定します。
# Nasupii の自宅PCでは次のように設定しています
# #!c:/perl64/bin/perl.exe
# なお、IISでは、IIS側で設定するので、cgiプログラムでは設定不要です。
# 2.データファイルのパス指定
# データファイルとロック制御用ファイルは、このプログラムと同じフォルダー
# におくようになっています。別のフォルダーに置く場合は$HDPATHにフォルダー
# のパスを入れてください。CGIプログラムからの相対パスで指定すると良いでしょう。
# なお、IISの場合は、絶対パスで指定する必要があるようです。
# 3.データファイルの作り方
# タブ区切りテキストファイルで項目は氏名と出勤帰宅を表す数字の２種類です
# 例では２名だけですが１行に１名として行を増やせば何人でも並べて表示できます
# 氏名[tab]1[crlf]
# 氏名[tab]1[crlf]
# 数字は 1:出勤（名前が黒) 0:帰宅（名前が赤）を表します
# 4.背景の色や文字の大きさ
# サブルーチン show()で書き出す html の ヘッダー部にあるスタイルシート
# を適宜書き換えることで変えることができます
#######################################################################
use utf8; #perlソースファイルがUTF-8で記述されていることを示す
# ====== 初期設定 ======
#$HDPATH = "c:/Apache24/htdocs"; #データファイルとロック制御用ファイルのあるフォルダー
$HDPATH = "."; #データファイルとロック制御用ファイルのあるフォルダー
$FNAME_D = "nafuda.txt"; #データファイル名
$FNAME_L = "nafuda.loc"; #ロック制御用ファイル
$CHARSET = 'Shift_JIS'; #文字セットをSIFT-JISとする
$TITLTXT= '名札を返す'; #フォームの一番上に表示する文字
# ====== 処理 =======
loadFormdata(); # フォームデータ取り込み
if(exists($FORM{"BB"})) {
rfile(); # ファイル読み込み
}else{
rwfile(); # ファイル書き換え
}
show(); # 画面表示
exit;
# ================================================================================
# データファイル読み込み
# ================================================================================
sub rfile{
open(LOCK, "$HDPATH/$FNAME_L" ) || return(0); #ロックファイルを開く
flock(LOCK, 2); #ブロックモード書き込み宣言ロック
open( FILE, "<:utf8", "$HDPATH/$FNAME_D" ) || last; #ファイルを読み込みモードでオープン
# "<:utf8" はデータファイルがUTF-8で記述されていることを示す
$i=0;
while($line=<FILE>) {
$line =~ s/\n//;
($name, $st) = split(/\t/, $line);
push(@names, $name);
push(@sts, $st);
$i++;
}
close(FILE);
close(LOCK);
return;
}
# ================================================================================
# データファイル書き換え
# ================================================================================
sub rwfile{
open(LOCK, "$HDPATH/$FNAME_L" ) || return(0); #ロックファイルを開く
flock(LOCK, 2); #ブロックモード書き込み宣言ロック
open( FILE, "<:utf8", "$HDPATH/$FNAME_D" ) || last; #ファイルを読み込みモードでオープン
$i=0;
while($line=<FILE>) {
$line =~ s/\n//;
($name, $st) = split(/\t/, $line);
if(exists($FORM{"B$i"})) {
if($st eq "1") {
$st= "0";
}else{
$st= "1";
}
}
push(@names, $name);
push(@sts, $st);
$i++;
}
close(FILE);
open( FILE, ">:utf8", "$HDPATH/$FNAME_D" ) || last; #ファイルを書き込みモードでオープン
for($i=0; $i<=$#names; $i++) {
print FILE $names[$i], "\t", $sts[$i], "\n";
}
close(FILE);
close(LOCK);
return;
}
# ================================================================================
# 画面表示
# ================================================================================
sub show{
print <<END;
Content-type:text/html
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html lang="ja">
<head>
<title>$TITLTXT</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<style type="text/css"><!--
body { background-color: #ffddee; font-size: 1em; font-family: "ＭＳ ゴシック",sans-serif;
margin: 0em 0.2em; padding: 0.3em 0.3em; }
.subject { text-align: center; font-size: 1.5em; margin: 0em; padding: 0em;}
a:visited { color :#0033ff; text-decoration: none; }
a:link { color: #0033ff; text-decoration: none; }
a:hover { color: Black; background-color: #ffff66; text-decoration: none; }
.card { background-color: #ffcc66; font-size: 2em; font-family: "ＭＳ 明朝", serif;
font-weight: bold; margin: 0.3em; padding: 1.5em 0.5em 1.5em 0.5em; border-width: 0.3em;
border-style: solid; border-color: #ffddee; }
--></style>
</head>
<body>
<hr>
<div class="subject">ＮａｓｕｐｉｉのＰｅｒｌ書抜帳</div>
<hr>
<div class="link_gd">
<a href="../index.html">ホーム</a> >
<a href="../perl03.html">Perlのページ３</a> >
<a href="../perl03.html#nafuda">名札を返す</a> >
名札のページ
</div>
<hr>
<div class="subject">$TITLTXT</div>
<form name="F1" method="GET" action="#">
<div align="center">
<input type="submit" value="最新表示" name="BB" >
<table border=1 style="border-style: none;">
<tr valign=top>
END
# ====== 名札表示 ======
for($i=$#names; $i>=0; $i--) {
$namesx = "";
for($j=0; $j<length($names[$i]); $j++) {
$namesx .= "<br>" . substr($names[$i], $j, 1);
}
$namesx =~ s/^<br>//; #先頭の改行を削除
if($sts[$i] eq "1") {
print qq|<td class="card"><a href="$ENV{'SCRIPT_NAME'}?B$i=1"><div style="color: black;">$namesx</div></a></td>\n|;
}else{
print qq|<td class="card"><a href="$ENV{'SCRIPT_NAME'}?B$i=1"><div style="color: red;">$namesx</div></a></td>\n|;
}
}
print <<END;
</tr></table>
<hr>
名札をクリックすると文字の色が変わり、出勤／帰宅が入れ替わります。<br>
テレビドラマ「相棒」の主人公が、出勤した時と帰宅するときに返す名札をWebで実現してみました。<br>
これなら、ほかの部署で仕事をした後直帰するときも、自分の部屋に戻らずに名札を返すことができますね。
</div>
</form>
<hr>
</body>
</html>
END
return;
}
# ================================================================================
# フォームデータ取り込み
# ================================================================================
# $ENV{ } 参照
# $FORM{ } 代入
# ================================================================================
sub loadFormdata{
my ($query, $pair);
if($ENV{'REQUEST_METHOD'} eq 'GET') {
$query = $ENV{'QUERY_STRING'};
}elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
return if($ENV{'CONTENT_LENGTH'} > 10000); #10000バイトを超えるデータが来た場合は無視する
read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
}
foreach $pair (split(/&/, $query)) {
my ($key, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
$value =~ s/&/&/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/\x0D\x0A/<br>/g;
$value =~ tr/\t/ /;
$FORM{$key} = $value;
}
return;
}
データファイル
松下 右京 1
鶴山 馨 0
神部 尊 0
歌意 享 0
鏑木 亘 1
蒼木 年男 1
Copyright (C) Nasupii