CGIがなんであるか、とか、Perlの基本とか、そういうのは他のサイトや本にいっぱいあると思います。ここでは、「私はこういう風にコーディングしてる。」というパターンを書いておきます。
実は私はPerlは大嫌いです。読みづらいし、変数がどこからでも参照可能なグローバル変数が基本というのは、プログラマーとしては気が狂いそうなスペックです。「文字列の扱いが簡単」というだけでここまで流行るというのはどうかとも思います。
が、インターネットプロバイダが用意する言語環境ってPerlくらいですから、仕方ないですね。早くJavaを用意してくれないかなぁ。
まあ、気を取り直してメモっておきましょう。
Perlはメインから代表的なルーチンを呼ぶというパターンを取るのが普通です。
これらをひとつのサブルーチン集とします。全体図はこちらをご覧ください。上で触れていないのは共通変数の初期化がふくまれているところと、最も最後に１を置いているところです。
フォームのデコード
#--------------------------------------------------------------
#? ?フォームからのデータを読み取るルーチン
#? ? 例: if ($in{'NAME'} eq '')
#--------------------------------------------------------------
sub read_form {?
? my($method, $accoc) = @_;
? my($buffer,$pair,@pairs,$key,$val);
? if ($ENV{'REQUEST_METHOD'} eq "POST" && ($method eq 'POST' ||
? !defined $method)) {
? ?? ?? read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
? ?? ?? @pairs = split(/&/,$buffer);
? } elsif ($ENV{'REQUEST_METHOD'} eq "GET" && ($method eq 'GET' ||
? ?!defined $method)) {
? ? @pairs = split(/&/, $ENV{'QUERY_STRING'});
? }
? ?? ?? foreach $pair (@pairs) {
? ?? ?? ?? ?? ? ($key,$val) = split(/=/,$pair);
? ?? ?? ?? ?? ? $key =~ tr/+/ /;
? ?? ?? ?? ?? ? $key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
? ?? ?? ?? ?? ? $val =~ tr/+/ /;
? ?? ?? ?? ?? ? $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
? ?? ?? ?? ?? ? &jcode'h2z_sjis(*val); # 半角カナ→全角(SJIS)変換
? ?? ?? ?? ?? ? &jcode'convert(*val,'sjis'); # SJIS変換
? ?? ?? ?? ?? ? $val =~ s/t//g; # タブコードを無効
? ?? ?? ?? ?? ? $val =~ s/rn//g; # Win → Mac (文中の改行はCRとする)
? ?? ?? ?? ?? ? $val =~ s/n//g; # Unix → Mac
? ?? ?? ?? ?? ? $val =~ s/&/&/g; # タグ禁止
? ?? ?? ?? ?? ? $val =~ s/"/"/g;
? ?? ?? ?? ?? ? $val =~ s/</</g;
? ?? ?? ?? ?? ? $val =~ s/>/>/g;
? ?? ?? ?? ?? ? $in{$key} = $val; # 入力データは%inへ
? ?? ?? }
}
|
| はい、これです。$in{‘キーワード’}にフォームで定義した値がはいってきます。 タブコードを無効というように、これからCGIプログラムの中で特別な役割で使う文字は無視するようにします。 |
日付の形式変換
#----------------------------------------------------------------
#? ?? ? 日付けの形式化
#? ?? 例： $reg_date? ?= &format_date($reg_date)
#----------------------------------------------------------------
sub format_date {
? ? local($_) = @_;
? ? local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($_);
? ? $mon++;
? ? $min? = "0$min"? if $min? < 10;
? ? $hour = "0$hour" if $hour < 10;
? ? $sec? = "0$sec"? if $sec? < 10;
? ? $mday = "0$mday" if $mday < 10;
? ? $year += 1900;
? ? local($week) = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$wday];
? ? $_? ? = "$year/$mon/$mday($week) $hour:$min";
? ? $_;
}
|
| 入力に任意の日付を指定できますが、今の時間を入手するには&format_date(time)です。 |
Cookieのセット
#--------------------------------------------------------------
#? ? Cookieをセット
# 例: &set_cookie()
# $mycookie ='BMG'? ?# CookieのIDを共通変数としてセット
#--------------------------------------------------------------
sub set_cookie {
? ?? ?? my($text) = "id:$id,password:$password";
#Expiration Dateの計算
? ?? ?? ($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg) = gmtime(time + $expday*24*60*60);
? ?? ?? $y0="Sunday"; $y1="Monday"; $y2="Tuesday"; $y3="Wednesday"; $y4="Thursday"; $y5="Friday"; $y6="Saturday";
? ?? ?? $m0="Jan"; $m1="Feb"; $m2="Mar"; $m3="Apr"; $m4="May"; $m5="Jun"; $m6="Jul"; $m7="Aug"; $m8="Sep"; $m9="Oct"; $m10="Nov"; $m11="Dec";
? ?? ?? @youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6);
? ?? ?? @monthg = ($m0,$m1,$m2,$m3,$m4,$m5,$m6,$m7,$m8,$m9,$m10,$m11);
? ?? ?? $date_gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$youbi[$wdayg],$mdayg,$monthg[$mong],$yearg +1900,$hourg,$ming,$secg);
? ?? ?? print "Set-Cookie: $mycookie=$text; ", "expires=", $date_gmt, "; n";
}
|
| まず、有効期間を所定の形式にします。Cookieの書き込み自身は最後のPRINT文でできるのですが、クッキーのテキストは’キーワード＝値’の形式ひとつです。
したがって、値の中をさらに’キーワード:値,キーワード:値’というようにします。それをやっているのが冒頭の$textをセットしているところです。 |
Cookieの読み取り
#--------------------------------------------------------------
#? ? Cookieを得る
# 例: &get_cookies()
#--------------------------------------------------------------
sub get_cookie {
? ?? ?? my($cookies) = $ENV{'HTTP_COOKIE'}; # 入力
? ?? ?? my(@pairs) = split(/;/,$cookies);
? ?? ?? # データの展開? 項目名1:内容1,項目名2:内容2,...
? ?? ?? foreach $pair (@pairs) {
? ?? ?? ?? ?? ? ($key,$val) = split(/=/,$pair,2);
? ?? ?? ?? ?? ? $key =~ s/ //g;
? ?? ?? ?? ?? ? if ($key eq $mycookie) {
? ?? ?? ?? ?? ?? ?? ?? ?@pairs = split(/,/,$val);
? ?? ?? ?? ?? ?? ?? ?? ?foreach $pair (@pairs) {
? ?? ?? ?? ?? ?? ?? ?? ?? ?? ?? ($key,$val) = split(/:/,$pair,2);
? ?? ?? ?? ?? ?? ?? ?? ?? ?? ?? $COOKIE{$key} = $val;
? ?? ?? ?? ?? ?? ?? ?? ?}
? ?? ?? ?? ?? ?? ?? ?? ?last;
? ?? ?? ?? ?? ? }
? ?? ?? }
}
|
| Cookieを読み取るのは$ENVを見ればいいことになっています。 面倒なのは、それの展開です。フォームのデコードと同じ要領です。 結果は、 |
スケルトンHTMLの書き出し
#---------------------------------------------------------------
#? ?? ?? ?? ?HTMLスケルトンファイルを標準出力に書き出す
# 引数? ?? | $_:スケルトンファイル名
#? ?? ?? ?? ?
# 戻り値? ?| ない
#---------------------------------------------------------------
sub skelton_write {
? open(FH,"<@_") or error('Open error',@_);
? while (<FH>) {
? ? s/__%(.+?)%__/$htsvals{$1}/g;
? ? print;
? }
}
|
| $htsvalsというハッシュ関数にキーワードと値をセットしておきます。仮に$htsvals{‘id’}=’TAKAO’ $htsvals{‘password’}=’stynee’としたとしましょう。 入力ファイルにHTMLのスケルトンを用意します。例えば、次のようなものです。
このファイルを入力とすることでhtsvalsに定義された変数でhtmlが埋められて書き出されます。 HTMLの装飾とCGIを切り離すことができ、メンテナンスが大変ラクです。 |
メイルの送信
#--------------------------------------------------------------
#? ?メイル送り出し
#
# $sendmail = '/usr/bin/sendmail'? ?を共通変数としてセット
#--------------------------------------------------------------
sub sendmail {
? ? local($mailto, $from, $subject, $mail_data) = @_;
? ? $subject =~ s/&/&/g;
? ? $subject =~ s/"/"/g;
? ? $subject =~ s/>/>/g;
? ? $subject =~ s/</</g;
? ? &jcode'convert(*subject,'jis');
? ? &jcode'convert(*mail_data,'jis');
? ? $subject = &enc_b64($subject);
? ? open(SEND, "| $sendmail -t $mailto")
? ?? ?? ?|| &error("Can't send mail to $mailto: $!");
? ? print SEND "X-Mailer: $prod_name v$version $a_emailn";
? ? print SEND "To: $mailton";
? ? print SEND "From: $fromn";
? ? print SEND "Subject: $subjectn";
? ? print SEND "Content-Transfer-Encoding: 7bitn";
? ? print SEND "Content-Type: text/plain; charset=iso-2022-jpnn";
? ? print SEND $mail_data;
? ? close(SEND);
}
sub enc_b64 {
? ? my($subject) = @_;
? ? my($str, $padding);
? ? while ($subject =~ /(.{1,45})/gs) {
? ?? ?? $str .= substr(pack('u', $1), 1);
? ?? ?? chop($str);
? ? }
? ? $str =~ tr|` -_|AA-Za-z0-9+/|;
? ? $padding = (3 - length($subject) % 3) % 3;
? ? $str =~ s/.{$padding}$/'=' x $padding/e if $padding;
? ? "=?ISO-2022-JP?B?$str?=";
}
|
| 必要なパラメータは一行目を見ていただくといいと思います。$sendmailはシステムによってSENDMAILの置き場所が違うので共通変数でセットします。 |
