２つ（もしくはそれ以上）の異なったデータを、同じファイルへ同時に書き込んでしまうような事がもし起これば、そのデータは、本来あるべき姿からは遠く離れた状態になるでしょう（直訳みたいな文だ（笑））。
要は、データを書き込んでいる最中に、他から書き込んでしまうと、ファイルの中身が滅茶苦茶になるって事。
いかにプログラムでも、実行中の他のプログラムの中までは見る事ができないので、こういった事は対策をしていないと起きる可能性が高い。だから、外に存在するファイルなどの「プログラムが共通で扱えるもの」を媒介にして現在の状況を報告しあうことで、実行（特にファイルへの書き込み）を制御する。その制御方法が「排他処理」で、「ロック」と呼ばれている（と思いこんでいる）。
実際にロックをしないで、ファイルを壊す実験をしてみた。実験で使ったファイルは２種類。最初のテストでは、なかなかうまく壊せなかったけど、次のテストでは、簡単に壊れた。どちらの実験もJavaScriptの「window.open(実行ファイル)」で２，３枚のウィンドウを開くだけ。ウィンドウの起動が速いブラウザだと、「最初のテスト」でも時間が重複するようだ。でも、書き込み処理の間に「sleep」で眠ってもらったらいちころですね。それを思いつくまで色々大変でした。
ファイルのロックを敬遠していたというのもあるけど、今回はいろいろなことを試したような気がする。ホントに書ききれるのか・・・。まず、やった（と思われる）ことを整理してみる。
ファイルのロック（ロック形式はmkdir。）
それにしても、このソフトは、環境変数の「SERVER_SOFTWARE」では「AnWeb」という名前だったりする。そして、ヘルプでは「HTTP Daemon」だったり。なんと呼べばいいんだろうか？
とにかく、CGIのデバッグ（というか、開発時の間違い発見）は簡単にできるようになった。今までの苦労はこれで少しは報われる（と思いたい）。
ではまず、ファイルのロック。
通常だと「flock」という命令でファイルにロックを掛けることができる。Windowsでは使えない（らしい。試していない）ので、詳しいことは抜きにする。ファイルのロックが確実なら、それだけファイルの安全性が保証される。ただし、ロックが確実だからといって、確実にファイルが守られるわけではない。ファイル書込み中に停電になったとか、システムが止まったとか、など継続実行ができない状態になる要素は色々あるから。
データファイルの保全を考えると、ファイルのロックは基本だということ。ロック以外にも色々とコツがあるようだが、それについてはとりあえず置いておく。でも、実際に掲示板などで使用する場合はデータの保全をちゃんと考える必要がある。特にバックアップは必要な事でしょう。
で、ロックの方法で「flock」以外だと、書込み中だけファイルなどを作成して、それが存在する間は、書き込みできないようにする方法がある。
「ファイルなど」と書いているのに、何故ここではファイルではなくディレクトリなのかというと、ディレクトリの方が扱いが簡単だから。
perlでは、ファイルの扱いが難しい。特に、「ファイルを作成する」だけの命令がないし、普通に書き込むように「open」すると上書きしてしまう。これではロックに使う意味がないので、まず最初にファイルの存在をチェックする必要があり、面倒な手間がかかる。
それに、もし「存在をチェックしてから、ロック用ファイルを作成するまでの間」に、他のプログラムがロック用ファイルを作成していたら・・・。当然それに気づかないので「ロック用ファイルを上書き」してしまい、ロックは失敗してしまう。
その点、ディレクトリだと、「ディレクトリを作成する命令（mkdir）」がある。それに、同じ名前のディレクトリがあると、作成しようとしても上書きができないので作成に失敗する。「mkdir」は作成に失敗すると「0（もしくはperlで偽を示す値）」を返し、成功すれば、ディレクトリを作成した後に「1（もしくはperlで真を示す値）」を返す。つまり、if文の中で使う事で「すでに存在しているか」のチェックと「ディレクトリの作成」が同時にできることになり、ファイルの時の様にタイムラグが発生しないので、ロックが失敗する事もない。
そういうわけで、ディレクトリをロックのフラグに使っている。プログラムの中で、この「ロック用ディレクトリ」が存在している間は「データファイルに書き込みができない」ようにしておけば、そのプログラムが２つ以上同時に起動していても、ファイルを上書きしてしまう事は無い。
当然データファイル自体をロックしているわけではないので、他のプログラムからは改変される事もある。もし、別のプログラムでも同じ「データファイル」を扱うならば、「ロック用ディレクトリ」も同じ名前（もちろん作成する場所も）にする必要がある。このサンプルには３種類のプログラム（厳密に言うと漢字コードと改行コードが違うだけ）があるけど、データファイルが同じでも、ロック形式が同じなので、ロック不全によるファイルの破損はおきない。
ただ、このロック方法は、ロックを掛けることについては完全だけど、ロックを解除する方に問題がある。何事もおきなければ「rmdir」によってディレクトリは削除され、同時にロックも解除される。しかし、ロック中に何かの影響でプログラムが中断されると、ディレクトリが削除されないままになってしまうのでロックが解除されない。放っておけば永遠にそのプログラムは機能しない事になる。
ここで出てくるのがシグナル処理。
ハッキリ言って仕組みはよくわからないけど、なにかアクシデントが起きたときに、実行中のプログラムに対してシグナル（信号でいいのか？）が送られてくる。シグナル処理は、その「シグナルを受け取ったときに実行させるプログラム」を設定する事で、不慮の事故に対応しようというもの。というように解釈している。
Windowsでは、そのシグナルが送られないのか、「不慮の事故」を故意に起こしても削除されていなかった・・・。よくわからない。是非ともUNIXで実行してみたいぞ・・・。
・・・と思っていたけど、サーバによるみたいな気がしてきた。「Apache/1.3.9 (Win32)」だと、ちゃんと処理されているみたい。
・・・と思っていたんだけどね?。ディレクトリが削除されるのは、先に送った実行プロセス（？）が、ちゃんと動作していたからのようだ。シグナルが本当に送られているのか調べる方法があったので、一応調べてみたけど、何も送られていなかった。う?ん・・・。Windowsがいけないのか？？？
ともかく、シグナル処理がうまく働かなければ、ロックが解除されないので、ロックを掛ける段階でロックディレクトリが存在するとき、その作られた時間を見て、１分以上前に作られたものなら削除する。という事をしている。強制的にロックを解除するので、あまり良くはないけど・・・。
話は変わって、ブラウザへのエラーメッセージ出力。
「die」という命令（？）を、例えば
open(OUT, “» $file”)||die “File open Error!!n”;
のように使うと、「$file」のファイルを追加書き込み形式で開けない時に、文字列「File open Error!!」を標準エラー出力に吐き出して、プログラムの実行が中止される。文字列の最後に「n」が無い場合（または文字列が無い場合）は、perlが出すエラーメッセージも追加される。普通だとこのメッセージはブラウザでは読めない。「AnHttpd」なら設定さえすれば、このエラーメッセージをブラウザに対して送信してくれるけど、「Apache」では「エラー５００（Internal Server Error）」が出るだけ。ただ、これらのサーバは、エラーが発生した際に表示する、ファイル（CGIも可能）を設定できるので、そちらでうまくやれば出来るのかもしれないけど・・・。
ともかく、標準エラー出力（ハンドル：STDERR）を、標準出力（ハンドル：STDOUT）で表示させるためには
print “Content-type: text/htmlnn”;
open(STDERR, “>&STDOUT”);
$|=1;
を最初の方に書く。こうすれば、エラーもブラウザに出力されるので、パーミッション（Windows95/98では「読み取り専用」とか）の影響で、ファイルに書き込みが出来ないなどのエラーが把握できる。ただ、このファイルが正しく実行されるようになって、はじめて有効になるので、純粋な「文法間違い」のようなエラーは無理。
本来なら、デバッグのために出力するなら、「Content-type」は「text/plain」が良いと思うんだけど、IE4などでは、何故かダウンロード画面になったりするので、使いにくい。サーバの言う事をちゃんと聞いてくれないブラウザは困ります・・・。また、デバッグが終わったら、コメントにするか、削除しないと、余計な文字が見えるし、基本的に出力が「HTML」ではないので、表示できないブラウザもあるかもしれないから注意しよう。
あと、これは「||」の（特殊な？）使い方になるけど、先の例で言う「open」が失敗すると、「||」の後ろにある構文を実行するようだ。つまり、「die」の変わりに、サブルーチンを実行するようにしておけば、そちらが実行されることになる。この場合は、最終的に「exit」なり「die」を使わないと、サブルーチンから処理が戻ってくるので、注意が必要だけど。
それで、この「エラーをブラウザで表示する」やり方から、「標準出力をファイルにする」方法として考えてしまったのがこれ。
open(STDOUT, “> $file”);
ただ、これをやってしまうと、「close」して、再度「STDOUT」に対して「open」しなおしても、ブラウザには何も出力されないようなので、きっと間違った使い方なんだろう・・・。ハンドルを指定せずに「print」をすると、普通は「標準出力（STDOUT）」に出力される。ただ、「select」という命令（？）を使うと、ハンドルの切替ができるらしい。情報不足で良くわからないから試してないけど・・・。こっちの方が、たぶん正しいやり方なのだろう。
次はセキュリティ対策・・・と言うには少しお粗末すぎるけど、自分以外から送信されたデータは受付けないようにしてみた。
やっている事は単純。環境変数の「HTTP_REFERER」に、「SCRIPT_NAME」と「HTTP_HOST」が入っているかを調べているだけ。これなら、もし余所から間違ったデータが送られても受付けない。はず。本当はもう少し考えたけど、実際に稼動しているスクリプトのソースを見れるようにしているので、「あまり意味が無い」と思ってやめた。
で、ファイルの蓄積。
ただ単に「追加書き込み」をしているだけだけど・・・。
それでも、実際に追加書き込みをしてみると、なんとなく嬉しく思ってしまう・・・。ちゃんとファイルの操作をしてるんですね?。
この他にもいろいろとあった。
「sleep」はプログラムを中断（？）できる。厳密な動作は良くわからないけど、「sleep 10;」で「10秒間」プログラムを中断する。これはカッコで囲んでも、囲まなくてもいいみたい。この命令に限らず、「print」などでもカッコがあっても無くても動作する。基本的につけた方が安心はするけど・・・。とくに、「print」は、日本語が混ざった場合はサブルーチンで出力するようにしているので、カッコをつけておいた方が後々変更しやすい。・・・そう言いながら、ほとんどつけていないような気がするけど。
あと、フォームからのデータの変換方法を、少し付け足してみた。この変換については、入力データについての色々な情報が必要だと思うので、今後も注意してみたい。このような（正規表現での？）変換処理は時間がかかるらしいので、次は時間でも測定してみようかと思っていたり。
それで、これまでは送信データの漢字コードは「OSに依存している（例えばWindowsならShift_JIS）」と思っていたけど、少なくともIE4/5では表示されている漢字コードで送信されるようだ。これを調べるのに、画面に表示されているコードと、入力したコードを出力できるようにしてみた。いろんなブラウザで試してみると面白いかもしれない。
「Jcode」は「use」でも使えるらしい。でも、「use」と「require」とで何が違うのかは・・・さっぱりわからない。それに「jcode.pl」にも「use」が使えるかもしれないし・・・。「Jcode.pm」についてきた書類や、配布サイトを見てサンプルコード（全然意味がわからない）を真似してみたけど、うまくいかなかった・・・。文法がわかっていないから、このあたりは苦労する。やっぱり本は必要だなぁ・・・。
「など」と書いていたけど、この他に何をしたのか、何を書きたかったのか覚えていない。ソースを見ても思い出せないから、きっと大したことじゃないとは思うけど・・・。ちょっと気になる。
それにしても、長すぎ。
・・・
今回、ローカル環境から完全に移行するために「jcode.pl」に変更しました。よって「Unicode（UTF-8）」は使えなくなってます。
あと、「jcode.pl」では、リファレンスで渡さないと「getcode」できないのを思い出したので、ここからは変更します・・・。
ついでに「画面表示」が「sjis」のスクリプトで文字化けしているのは愛嬌という事で・・・。
ソースコード
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
#!/usr/bin/perl
# print "Content-type: text/htmlnn";
# open(STDERR, ">&STDOUT");
# $|=1;
# 初期設定
# require Jcode;
# $JcodeVer = "Jcode $Jcode::VERSION";
# *Jgetcode = &Jcode::getcode;
# *Jconvert = &Jcode::convert;
require "../../../cgi-bin/jcode.pl";
$JcodeVer = "jcode.pl $jcode::version";
*Jgetcode = &jcode::getcode;
*Jconvert = sub { &jcode::to($_[1], $_[0], $_[2]); };
@G_styles = ("../../ipp.css","../test.css");
$G_title = "テスト２０";
# $G_myCode = &Jgetcode("漢字");
$G_myCode = &Jgetcode("漢字");
$G_code = "jis";
$G_charset = "iso-2022-jp";
%G_form=();
$G_scrName = $ENV{'SCRIPT_NAME'};
if($G_scrName =~ /ts[0-9]{4}/){ # _1,_uなどと共通で使用する項目
$G_scrName = $&;
$G_dataFile = "dat/$G_scrName.dat";
$G_lock = "lock/$G_scrName";
$G_linkFile = "../$G_scrName.htm";
$G_linkName = $G_title;
}
{
&sigInit;
if($#ARGV == -1){
&selectCode;
}elsif( $ENV{'HTTP_REFERER'} !~ /$ENV{'SCRIPT_NAME'}/ ||
$ENV{'HTTP_REFERER'} !~ /$ENV{'HTTP_HOST'}/ ){
exit;
# }elsif($ARGV[0] eq "utf8"){
# $G_code = "utf8";
# $G_charset = "UTF-8";
# &printForm("post");
}elsif($ARGV[0] eq "sjis"){
$G_code = "sjis";
$G_charset = "shift_jis";
&printForm("post");
}elsif($ARGV[0] eq "euc"){
$G_code = "euc";
$G_charset = "euc-jp";
&printForm("post");
}elsif($ARGV[0] eq "jis"){
&printForm("post");
}elsif($ARGV[0] eq "output"){
&formRead;
&formWrite;
}elsif($ARGV[0] eq "read"){
&dataOpen;
}else{
&error("<h2>無効なコマンドが渡されました。</h2>");
}
exit;
}
sub sigInit{
$SIG{'PIPE'} = "sigExit";
$SIG{'INT'} = "sigExit";
$SIG{'HUP'} = "sigExit";
$SIG{'QUIT'} = "sigExit";
$SIG{'TERM'} = "sigExit";
}
sub sigExit{
&dataUnlock;
exit;
}
sub error{
$G_title .= "（エラー）";
&printHeader;
&Jprint(@_);
&printFooter;
exit;
}
sub selectCode{
$G_title .= "（漢字コード選択）";
&printHeader;
print "<div class=test>n";
&Jprint("<p>入力フォームで使用する漢字コードを選んでください。</p>n");
print <<EOM;
<form method=post action="$ENV{'SCRIPT_NAME'}?jis"><input type=submit value="JIS(iso-2022-jp)"></form>
<form method=post action="$ENV{'SCRIPT_NAME'}?sjis"><input type=submit value="Shift_JIS"></form>
<form method=post action="$ENV{'SCRIPT_NAME'}?euc"><input type=submit value="EUC-JP"></form>
EOM
# 以下の一行を削除した
# <form method=post action="$ENV{'SCRIPT_NAME'}?utf8"><input type=submit value="Unicode(UTF-8)"></form>
print qq(<form method=post action="$ENV{'SCRIPT_NAME'}?read">n);
&Jprint(qq(<input type=submit value="過去ログ（？）を見る">n));
print "</form>n";
print "</div>n";
&printFooter;
}
sub dataLock{
local($i, $mtime);
for($i=0;$i<2;$i++){
if(mkdir($G_lock, 0755)){
return;
}else{
unless($i){
($mtime) = (stat($G_lock))[9];
if ($mtime < time() - 60) { # １分以上前のロックは解除
rmdir($G_lock);
}
}
}
}
&error("<h2>現在、ロック中です。ごめんなさい。</h2>");
}
sub dataUnlock{
if(-d $G_lock){
rmdir($G_lock);
}
}
sub dataOpen{
$G_title .= "（過去ログ）";
&printHeader;
print "<div class=test>n";
&dataLock;
open(IN, "<$ G_dataFile")||die "Can not open $G_dataFile....";
# データファイルはEUC記録なので時間短縮のつもり。
# 標準出力は「jis」だけど・・・。
if($G_code eq "euc"){
print while (<IN>);
}else{
while (<IN>){
print &Jconvert($_, $G_code, "euc");
}
}
close(IN);
&dataUnlock;
print "</div>n";
&printFooter;
}
sub formWrite{
local($name, $value);
&dataLock;
open(OUT, ">> $G_dataFile")||die "Can not open $G_dataFile....";
print(OUT "<table border=1>n");
print(OUT "<tr><th>Name<th>Value</tr>n");
while (($name, $value) = each(%G_form)){
print(OUT "<tr><td>$name<td>$value</tr>n");
}
sleep 5;
print(OUT "</table>n");
close(OUT);
&dataUnlock;
$G_title .= "（送信完了）";
&printHeader;
print "<div class=test>n";
&Jprint("<p>たぶん、無事に送信されました。n");
&Jprint(qq(<p><a href="$ENV{'SCRIPT_NAME'}?read">心配だから、過去ログを見る。</a>n));
print "</p>n";
print "</div>n";
&printFooter;
}
sub formRead{
local($query_string, @elements, $elm, $name, $value, $code, $method);
$method = $ENV{'REQUEST_METHOD'};
if($method eq "POST"){
read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
}elsif($method eq "GET"){
$query_string = $ENV{'QUERY_STRING'};
}else{
&error("<h2>「POST」か「GET」のデータしか受け取れません。</h2>");
}
@elements = split(/&/, $query_string); # 中身はpostもgetも同じ
foreach $elm (@elements){
($name, $value) = split(/=/, $elm);
$value =~ tr/+/ /;
$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
# $code = &Jgetcode($value);
$code = &Jgetcode($value);
if($code ne "euc"){
$value = &Jconvert($value, "euc", $code); # とりあえずEUCに変換
}
$value =~ s/&/&amp;/g; # メタ文字（？）を無効化
# $value =~ s/<!--/&lt;!--/g; # SSI入力を無効化
# $value =~ s/-->/--&gt;/g; # SSI入力を無効化
$value =~ s/</&lt;/g; # タグを無効化
$value =~ s/>/&gt;/g; # タグを無効化
$value =~ s/rn*/n/g; # 改行を統一
$value =~ s/nnn+/nn/g; # 長い改行（３回以上）を２回（１行空き）に
$value =~ s/[ns]+$//g; # 最後の連続した空白、改行を削除
$value =~ s/n/<br>/g; # 改行を<br>に変換
$G_form{$name} = $value ."<br>InputCode : $coden";
}
}
sub printForm{
$G_title .= "（入力画面）";
&printHeader;
print "<div class=test>n";
print qq(<form method=$_[0] action="$ENV{'SCRIPT_NAME'}?output">n);
&Jprint(qq(<input type=hidden name=tx0 value="画面表示：$G_codenブラウザ：$ENV{'HTTP_USER_AGENT'}nスクリプト：$G_myCode"><br>n));
print qq(<input type=text name=tx1 value="tx1"><br>n);
&Jprint("<textarea name=ta1 cols=40 rows=4>ta1n何か適当にどうぞ。n</textarea><br>n");
&Jprint("<p>送信し、データを書き込んでいる最中に５秒間待ちます。</p>n");
&Jprint("<p>この間は、しばらく待つか、他のブラウザなどから「送信」を試してみてください。</p>n");
&Jprint(qq(<p><a href="$ENV{'SCRIPT_NAME'}">ブラウザをもう一枚開く</a></p>n));
&Jprint(qq(<input type=submit value="送信する">n));
print "</form>n";
print qq(<form method=$_[0] action="$ENV{'SCRIPT_NAME'}?read">n);
&Jprint(qq(<input type=submit value="過去ログ（？）を見る">n));
print "</form>n";
print "</div>n";
&printFooter;
}
sub printHeader{
if($G_charset){
print "Content-type: text/html; charset=$G_charsetnn";
}else{
print "Content-type: text/htmlnn";
}
print qq(<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">n);
print "<html lang=ja>n<head>n";
if($G_charset){
print qq(<meta http-equiv="Content-Type" content="text/html; charset=$G_charset">n);
}
print qq(<meta http-equiv="Content-Script-Type" content="text/javascript">n);
print qq(<meta http-equiv="Content-Style-Type" content="text/css">n);
&Jprint("<title>$G_title</title>n");
foreach (@G_styles){
print qq(<link rel="stylesheet" type="text/css" href="$_">n);
}
print "</head>n<body>n";
print "<div class=head>n";
&Jprint("<h1>$G_title</h1><hr>n");
&printlinks;
print "<hr></div>n";
# print $ENV{'HTTP_REFERER'}."<br>".$ENV{'SCRIPT_NAME'}."<br>".$ENV{'HTTP_HOST'};
}
sub printFooter{
print "<div class=foot><hr>n";
&printlinks;
print "<hr>n";
&Jprint("漢字コード変換 ： $JcodeVer<br>n");
open(IN, "../../sig.txt");
print while (<IN>);
close(IN);
print "</div>n";
print "</body></html>n";
}
sub printlinks{
print qq(<a href="../../../index.htm">Home</a>n);
print qq(/n<a href="../../">Perl</a>n);
print qq(/n<a href="../">TestCGI Index</a>n);
if($G_linkFile){
&Jprint(qq(/n<a href="$G_linkFile">$G_linkNameの解説</a>n));
}
}
sub Jprint{
if($G_code eq $G_myCode){
foreach (@_){ print; }
}else{
foreach (@_){ print &Jconvert($_, $G_code, $G_myCode); }
}
}
sub JconvPrint{
foreach (@_){ print &Jconvert($_, $G_code, &Jgetcode($_)); }
}
Copy