無料ホームページスペース無料メールアドレスをご提供します。　　　　KANSAI　WEBサービス会員規約

kansai.homelinux.com

コンピュータ／通信総合サイト・広島の関西商事　　　　　　　　　　　管理人：大内　雅司

Perlマニュアル for ActivePerl CGI応用編

１．HTMLドキュメント生成ルーチン
２．データ書き込みルーチン
３．エラー処理ルーチン
４．ワードチェック機能を付ける
５．ファイルロック機能を付ける
６．自動メール送信機能を付ける
７．インラインリンク機能を付ける
など、Perlを使った高度なテクニックをご紹介します。

補足説明
　【Section9補足】新「落書帳」(notebook2.cgi)にロック機能を付ける
　【Section10補足】自動メール送信機能の追加
　【Section11補足】インラインリンク機能の追加

Question & Answers

【Section9補足】新「落書帳」(notebook2.cgi)にロック機能を付ける

[cgilabo\sec9\lock.pl]
　P88のロック機能の完全版の補足説明です。

1.notebook2.cgiスクリプトの最後にdata_save関数（lock.pl）を追加します。

●data_save関数（lock.pl）

sub data_save { #指定したデータファイルと同じ名前で拡張子が「.tmp」の #ファイル名を作成 $datafile =~ /(.+)\..+$/; local($filename) = $1; if ($filename !~ /.+/) { &error(bad_filename); } local($tmpfile) = "$filename.tmp"; local($tmpflag) = 0; #NTサーバーとそれ以外のサーバで処理を分岐 if ($NT_Server) { #NTサーバでrename出来ないものがあるため #テンポラリーは書き込み中を知らせるダミーとしてだけに使用 foreach (1 .. 10) { unless (-f $tmpfile) { if (open(TMP,">$tmpfile")) { close(TMP); if (open(DAT,">$datafile")) { print DAT @DATA; close(DAT); $tmpflag = 1; } unlink $tmpfile; if ($tmpflag) { last; } } } sleep(1); } } else { #リネームや、ＣＧＩのファイル作成が許可されている場合は、 #より強固なロックが可能 #データはテンポラリーに書き込まれるためバッティングの可能性は #非常に低くなる #現在、他のプロセスが書き込み中かをテンポラリーの有無で調べる foreach (1 .. 10) { #書き込み中で無い場合はフラグを立ててループから出る unless (-f $tmpfile) { $tmpflag = 1; last; } $tmpflag = 0; #書き込み中なら１秒待つ sleep(1); } #書き込み中でないフラグが立っている場合にだけ #実際の書き込みを実行する if ($tmpflag == 1) { $tmp_dummy = "$$\.tmp"; if (!open(TMP,">$tmp_dummy")) { &error(bad_tmpfile); } close(TMP); chmod 0666,$tmp_dummy; if (!open(TMP,">$tmp_dummy")) { &error(bad_tmpfile); } print TMP @DATA; close(TMP); foreach (1 .. 10) { unless (-f $tmpfile) { if (!open(TMP,">$tmpfile")) { &error(bad_tmpfile); } close(TMP); rename($tmp_dummy,$datafile); unlink $tmpfile; $tmpflag = 1; last; } $tmpflag = 0; sleep(1); } } } $tmpflag; }

2.NTサーバーの場合は、次の1行を追加します。

require 'jcode.pl' $NT_Server = 1;　　　←追加する

3.データ書き込みルーチンを削除して、関数を呼び出すコマンドを追加します。


●削除する書き込みルーチン

if (!open(NOTE,">$datafile")) { &error(bad_file); } print NOTE @DATA; close(NOTE);

上記のコードを削除した個所に、次のコードを追加します。

&data_save;

削除&訂正する場所は「記事をファイルに書き込むサブルーチン」と「削除モードルーチン」の２ヶ所です。忘れずに変更してください。なお、青色の部分が訂正する個所です。

#===============================記事をファイルに書き込むサブルーチン=========================== sub regist { #入力されたデータをチェックして、投稿者、コメント、メールアドレスが #入力されていなければエラーを出力し、再入力を促す if ($FORM{'name'} eq "") { &error(bad_name); } if ($FORM{'comment'} eq "") { &error(bad_comment); } #メールアドレスの未記入を許可する場合は、下の行の先頭に「#」をつけて無効にする #if ($FORM{'email'} ne "") { if (!($FORM{'email'} =~ /(.*)\@(.*)\.(.*)/)) { &error(bad_email); }} #クッキーの日付、時刻を２桁に統一 $c_year = sprintf("%02d",$c_year); $c_sec = sprintf("%02d",$c_sec); $c_min = sprintf("%02d",$c_min); $c_hour = sprintf("%02d",$c_hour); $c_mday = sprintf("%02d",$c_mday); $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$c_wday]; $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') [$c_mon]; $date_gmt = "$youbi, $c_mday\-$month\-$c_year $c_hour:$c_min:$c_sec GMT"; $cookie="name\!$FORM{'name'}\,email\!$FORM{'email'}\,sex\!$FORM{'sex'}\,val\!$FORM{'val'}\,HP\!$FORM{'HP'}"; #クッキーに書き込み print "Set-Cookie: $CookieName=$cookie; expires=$date_gmt\n"; $count = @DATA; #最大登録数$maxを超えるデータを切り捨てます if ($count >= $max) { pop(@DATA); } #追加する記事のコードを取得 if ($count < 1) { #記事がない場合は、コードを１に $new_code = 1; } else { #記事ある場合は、最後に投稿された記事のコードに１プラスする ($date,$code,$name,$email,$comment,$subject,$sex,$val,$HP) = split(/\,/,$DATA[0]); $new_code = $code + 1; } #書き込みデータのフォーマットを整えます $value = "$date_now\,$new_code,$FORM{'ress'}\,$FORM{'name'}\,$FORM{'email'}\,$FORM{'comment'}\,$FORM{'subject'}\,$FORM{'sex'}\,$FORM{'val'}\,$FORM{'HP'}\n"; #最後に投稿された記事を先頭に追加する unshift(@DATA,$value); #データベースファイルを上書きする if (!open(NOTE,">$datafile")) { &error(bad_file); } print NOTE @DATA; close(NOTE); $FORM{'ress'} = 0; $COOKIE{'name'} = $FORM{'name'}; $COOKIE{'email'} = $FORM{'email'}; $COOKIE{'sex'} = $FORM{'sex'}; $COOKIE{'val'} = $FORM{'val'}; $COOKIE{'HP'} = $FORM{'HP'}; }

#=========================削除モード=================== sub delete { @CODE = split(/ /,$FORM{'delcode'}); $keycount = @CODE; #削除する番号が指定されていなければ戻る if ($keycount eq 0) { &html; } $count = @DATA; foreach $line (@DATA) { ($date,$code,$ress,$name,$email,$comment,$subject,$sex,$val,$HP) = split(/\,/,$line); $match = "false"; foreach $delcode (@CODE) { if ($code == $delcode || $ress == $delcode) { $match = "true"; } } if ($match eq "false") { push (@new_data,$line); } } @DATA = @new_data; #データベースファイルを上書きする if (!open(NOTE,">$datafile")) { &error(bad_file); } print NOTE @DATA; close(NOTE); }

これだけの変更であなたの大切なデータを守ってくれる強力なロック機能の完成です。

【Section10補足】自動メール送信機能の追加

[cgilabo\sec10\automail_sub.txt]
　P93の自動メール送信機能を実現するreturnmail関数の補足説明です。

1.rakugaki.cgiスクリプトの最後にreturnmail関数を追加します。
　必要に応じて赤色の部分を修正してください。

●returnmail関数

#================returnmail関数============================- sub returnmail { 　　$email = $FORM{'email'}; 　　#ゲストブックにメールアドレスが記入されていなければそのまま帰る 　　if ($email =~ /\w+\@\w+\.\w+/) {? 　　　　#あなたのメールアドレスを指定します。 　　　　$mailto = 'xxxxx@xx.xxxxxx.ne.jp'; 　　　　#メールを格納しているサーバーのsendmailパス 　　　　#わからない場合はこのまま一度実行してみてください 　　　　#私の加入しているmeshnetや、inforyomaもこの設定で大丈夫 　　　　$sendmail = '/usr/lib/sendmail'; 　　　　#メールの題名を設定 　　　　$subject = 'ありがとうございます'; 　　　　$comment = $FORM{'name'}; 　　　　$comment .= "さん 始めまして、パピオです。ゲストブックにご登録ありがとうございました。"; 　　　　$comment .= "またのお越しをお待ちしております。" ; 　　　　#メール用に文字コードをjisに設定する 　　　　&jcode'convert(*subject,'jis'); 　　　　&jcode'convert(*comment,'jis'); 　　　　#sendmailのオープンに失敗したら何もしない 　　　　if (open(OUT,"| $sendmail $email")) { 　　　　　　#メールを送信する? 　　　　　　print OUT "FormMailer: guestbook v2.0\n"; 　　　　　　print OUT "To: $email\n"; 　　　　　　print OUT "From: $mailto\n"; 　　　　　　print OUT "Subject: $subject\n"; 　　　　　　print OUT "Content-Transfer-Encoding: 7bit\n"; 　　　　　　print OUT "Content-Type: text/plain\n"; 　　　　　　print OUT "\n\n"; 　　　　　　print OUT "$comment\n"; 　　　　　　print OUT "\n"; 　　　　　　close(OUT); 　　　　} 　　} }

2.returnmail関数を呼び出すコマンドを追加します。ファイルの保存が終了した処理の後に追加します。

print NOTE $value; close(NOTE);

　青色の部分が追加したコマンドです。

sub regist { if ($FORM{'name'} eq "") { &error(bad_name); } if ($FORM{'comment'} eq "") { &error(bad_comment); } if (!open(NOTE,">>$rakugakifile")) { &error(bad_file); } $value = "$date_now\,$FORM{'name'}\,$FORM{'email'}\,$FORM{'comment'}\,\,\,\,\n"; print NOTE $value; close(NOTE); #returnmail関数を呼び出すコマンドを追加する &returnmail; print "Location: $rakugakiurl" . '?' . "\n\n"; }

　これでrakugaki.cgiにメール送信機能が使えるようになりました。rakugaki2.cgiという名前のスクリプトはメール送信機能が組み込まれています。

●必要なファイルと設定

ファイル名	種　類	転送モード	パーミッション
rakugaki2.cgi	CGIスクリプト	アスキー	755
rakugaki.txt	データ用	アスキー	666

【Section11補足】インラインリンク機能の追加

[cgilabo\sec11\InLineLink.txt]
　P100のインラインリンク機能を実現するInLineLink関数の補足説明です。

1.rakugaki.cgiスクリプトの最後にInLineLink関数を追加します。

●InLineLink関数

#===========InLineLink関数=============================== sub inline_link { local($_) = $_[0]; $_ =~ s/([^=^\"]|^)((http|ftp):[!#-9A-~]+)/$1<a href=$2 target=_top>ここを押して<\/a>/g; $_ =~ s/([!#-9A-~\-\_]+\@[!#-9A-~\-\_\.]+)/<a href=mailto:$1>$1<\/a>/g; $_; }

2.InLineLink関数を呼び出すコマンドを追加します。記事の内容が表示されるときにコマンドを追加します。コメントが格納されている変数は「$comment」です。

$comment = &inline_link($comment);　　　　　　　　←追加する $comment =~ s/\r/<br>/g;

　青色の部分が追加したコマンドです。

　これでrakugaki.cgiでインラインリンク機能が使えるようになりました。rakugaki3.cgiiという名前のスクリプトはインラインリンク機能が組み込まれています。また、domain_check関数も組み込まれています。

●必要なファイルと設定

ファイル名	種　類	転送モード	パーミッション
rakugaki2.cgi	CGIスクリプト	アスキー	755
rakugaki.txt	データ用	アスキー	666

アスキーモード送信時の文字化け
CGIのプログラムをFTP送信する場合、アスキーモードにするということですが、日本語が化けてしまいます。どうしたらよいですか。

テキストの編集後に保存する文字セットの問題です。「jis」「sjis」「euc」のすべて試して文字化けしない文字セットが、あなたのサーバーの文字セットです。 CGIのHTMLを生成するセクションに「print "\n";」 のメタコマンドを挿入すると訪問者のブラウザを自動でsjisに設定することができます。

print "Content-type: text/html\n\n"; 　print "<html><head>\n"; 　print "<meta http-equiv=Content-Type content=text/html; charset=x-sjis>\n"; 　print "<title>$title</title></head>\n"; 　print "<body bgcolor=$bg_color text=$text_color link=$link_color vlink=$vlink_color background=$bg_gif>\n";

Netscape対策
IEで見るのと、Netscapeで見るのとではフォームのテキスト欄の長さが違うのですが揃えることはできますか？

落書き帳SPは自動調整しています。

$agentsoft = $ENV{'HTTP_USER_AGENT'}; 　$hosei = 1; 　if ($agentsoft =~ /Mozilla\/4/i && $agentsoft !~ /compatible/i) { $hosei = 0.8; }

このコードでブラウザを取得して、Netscape4ならIEの80％になるようにしています。 この他にも、IE3の複数行テキストエリアも自動調整しています。

ファイルが丸見え
たとえば、「/cgi-bin/custombbs.cgi」などで「/cgi-bin/」とだけ、区切ってしまえば、cgi-binフォルダ内のファイルはまる見えになりますよね。サンタックなど答えがまる見えです。

そのcgi-binディレクトリ内にダミーのindex.htmlファイルを置いておきます。

<HTML><HEAD> 　<TITLE>404 Not Found</TITLE> 　</HEAD><BODY> 　　　<H1>Not Found</H1> 　　　The requested URL index.html was not found on this server.<P> 　<HR> 　</BODY></HTML>

これだけ記述したファイルをindex.htmlとしてアップしておけば、index.htmlというファイルさえ存在しないと思わせることができます。

AddType application/x-httpd-cgi .cgi 　AddType application/x-httpd-cgi .pl 　AddType application/x-sh .sh 　AddType audio/x-midi .mid 　AddType audio/midi .mid 　Options FollowSymLinks ExecCGI Includes 　AddType audio/x-pn-realaudio .ra

といった内容をテキストで作り「.htaccess」という名で保存、アスキーモードで転送します。これが置かれた以下の階層全部に有効になりますから「public_html」に置けばいいかと思います。 サーバーによりいろいろあるようですから（書き方も）、プロバイダまたはレンタルサーバー会社に確かめた方がいいかも知れません。元々用意してくれているところもあります。

記事を書き込むregistルーチンでログを検索するしかないでしょうね。スクリプトによって変数が違いますのでそのままでは使用できませんが、

foreach $line (@DATA) { 　($date,$code,$name,$email,$subject,$comment) = split(/\,/,$line); 　$comment =~ s/\n//g; 　if ($QUERY{'comment'} eq $comment) { return; } 　}

このコードは投稿した記事と同じ記事が存在すれば記事保存ルーチンから何もしないで元の画面に戻ります。

配列を組み替えるのは簡単なのですが、それより大きな問題が起こります。 挑戦者が挑戦するたびに並べ替えたデータを書き込まなくてはならなくなり、処理が重くなりクイズになりません。 50問で200点は裏技のせいだと思います。現バージョンではこの裏技を排除しています。 ちなみに、rand関数を使った

push(@RAND_DATA, splice(@DATA, rand(@DATA), 1)) while @DATA; 　@DATA = @RAND_DATA;

で配列変数「@DATA」の内容をランダムに並び替えることはできます。出題もランダムに行なっていますから、ファイルをランダムにしても同じようなものですが．．．

sub htmlルーチン内の

print " <font size=2>[$host]</font>"; 　print "<br><font size=2>$agent</font>";

と、そのもう少し下の

print " <font size=2>[$ho]</font>\n"; 　print "<br><font size=2>$ag</font>\n";

の2行を消すか、行頭に「#」を付けてコメント行にします。

を

$record = "DATE=$DATE";

に変更します。

高速に処理を行なうため連想配列を使用しています。 連想配列はランダムにで並んでしまいます。50音順に並び替えることは可能です。

インラインJavaで新しいウィンドウをオープンするにはwindow.openメソッドを使用します。

print "<input type=button value=HomePage onclick=\'location.href=\"$homepage\"\'>\n";

 を

print "<input type=button value=HomePage onclick=\'myWin= window.open($homepage)\'>\n";

に変換します。

(1)メッセージを格納するデータベースファイルにある

$datafile = 'treebbs.txt';

を次のように2行のコードに変更します。

$DIR = '/usr/home/*********/*****/html/PCG-C1'; 　$datafile = "$DIR/treebbs.txt";

（2）data_saveルーチン内にあるコードを次のように変更します。

$tmpfile = 'treebbs.tmp';　　　　→　$tmpfile = "$DIR/treebbs.tmp"; 　$tmp_dummy = "$$\.tmp";　 　→　$tmp_dummy = "$DIR/$$\.tmp";

このスクリプトでは連想配列を使用しているのでランダムに作成されます。 50音順で良ければ

foreach (keys %DROPMENU) {

を

foreach (sort keys %DROPMENU) {

に変更することで並べ返ることができます。

アクセスは記録されますが、Javaスクリプトが正確なリンク先を返さなくなり、リンク統計が正確に収集できません。

リムネットの場合は環境変数$ENV{'HTTP_FORWARDED'}にドメイン名が格納されています。

sub domain_name { 　　　local($_) = $ENV{'HTTP_FORWARDED'}; 　　　local($host) = ''; 　　　if (/(\d+)\.(\d+)\.(\d+)\.(\d+)/) { 　　　　　local($ip) = "$1.$2.$3.$4"; 　　　　　$host = gethostbyaddr(pack('C4',split(/\./,$ip)),2); 　　　　　if ($host eq '') { $host = $ip; } 　　　} 　　　$host; 　}

if ($QUERY{'comment'} =~ /\r$/) { $QUERY{'comment'} =~ s/\r$//g; }

このコードは、受信したコメントから最後の改行コード(\r)を削除しています。 これだけなら最後の1つしか削除できないのでループにします。

while (1) { 　　　　if ($QUERY{'comment'} =~ /\r$/) { $QUERY{'comment'} =~ s/\r$//g; } 　　　　else { last; } 　}

このコードをフォームからデータ受信してデコード直後に挿入します。

NTでは、すでに存在するファイル名に他のファイルをリネームすることができません。 多少ロック機能は低下しますがリネームしない関数をご使用ください。

sub data_save { 　　　$datafile =~ /(.+)\..+$/; 　　　　　local($filename) = $1; 　　　　　if ($filename !~ /.+/) { &error(bad_filename); } 　　　　　local($tmpfile) = "$filename.tmp"; 　　　　　local($tmpflag) = 0; 　　　　　foreach (1 .. 10) { 　　　　　　　unless (-f $tmpfile) { 　　　　　　　　　if (open(TMP,">$tmpfile")) { 　　　　　　　　　　　close(TMP); 　　　　　　　　　　　if (open(DAT,">$datafile")) { 　　　　　　　　　　　　　print DAT @DATA; 　　　　　　　　　　　　　close(DAT); 　　　　　　　　　　　　　$tmpflag = 1; 　　　　　　　　　　　} 　　　　　　　　　　　unlink $tmpfile; 　　　　　　　　　　　if ($tmpflag) { last; } 　　　　　　　　} 　　　　　　} 　　　　　　sleep(1); 　　　　} 　　　　$tmpflag; 　}