CGI.pm

CGI.pm はPerlの標準モジュールですので、利用できるプロバイダも多いです。提供される関数も多く覚えると非常に便利ですが、速度は遅いです。利用場面を考えた使い方をしましょう。

• HTML形式のタグを吐き出す方法
• サブルーチンをグループごとにインポートする
• CGIからのパラメータの受け取り
• httpヘッダの生成（header関数）
• フォーム使用時の注意
• ファイルのアップロード処理
• サンプル掲示板
• クッキーの使い方

HTML形式のタグを吐き出す方法

バージョンの新しいCGI.pm だと、デフォルトで XHTML形式のタグが出力されます。（<BR/>など）普通のHTMLタグを利用したい場合は、引数にno_xhtmlプラグマを指定します。

 use CGI qw/-no_xhtml/;
 
 my $cgi = new CGI;
 print $cgi->header;
 print $cgi->start_html;
 print 'CGI.pm のテストです。';
 print $cgi->end_html;

サブルーチンをグループごとにインポートする

サブルーチンをインポートしたい場合は、グループごとにインポートすることができます。

よく使うグループ一覧

 use CGI qw/:standard/;

普通に利用するならこれでOKでしょう。

CGIからのパラメータの受け取り

paramを使います。

param()の戻り値はスカラーコンテキストでは、最初の値がセットされます。よく使うのは、name の入力があれば、$nameに値をセットし、無ければデフォルトの文字をセット。

 my $name = param('name') || '匿名さん';

とか、name が入力されていなければエラーを表示する。

 my $name = param('name') or error('名前を入力してください！');

とかです。

戻り値がリストコンテキストの時は、値のリストを返します。これはチェックボックスなどに同じ名前を付けて置いて、処理を簡単にしたりするときに利用します。

例えばHTML側がこんな感じで、

 問５ 好きな果物は？（当てはまるもの全てにチェックして下さい）
 <input type="checkbox" name="Q5" value="みかん">みかん
 <input type="checkbox" name="Q5" value="りんご">りんご
 <input type="checkbox" name="Q5" value="いちご">いちご

CGI側は

 my @Q5 = param('Q5');
 print '好きな果物は、', join('、', @Q5);

のようにリストで処理できます。アンケートの処理や、一覧から削除するものにチェックを付けて一括削除したり・・・なにかと便利です。

httpヘッダの生成（header関数）

header()はhttpヘッダを返します。

 use CGI qw(:standard);
 print header;

デフォルトではcharsetがISO-8859-1となります。charsetを指定するには、

 print header(-charset=>'Shift_JIS');

のように引数指定するか、charset()関数でデフォルトのcharsetを変更します。

 charset('Shift_JIS');   # 以後省略するとShift_JISになる
 print header;

フォーム使用時の注意

開発の容易なマルチスクリーンのCGIを書く場合などで良く使われますが、hiddenでCGIの動作モードを仕込んだりします。

 <input type="hidden" name="mode" value="do_disp">

このようにしておき、同じCGI内でmodeの値によって、別々の処理を行ったりします。この機能をCGI.pmで行おうとすると、はまることがあるので注意が必要です。CGI.pm では、

 print hidden('mode', 'do_disp');

とすれば、<input type="hidden"... を生成できますが、このhidden() は呼出し元ページのparam値を保持するのです。textfield()なども同様にparam値を保持するのですが、プログラムをシンプルに書ける反面、注意が必要です。この機能は諸刃の剣とも言えます。

以下はCGI.pm を使ったマルチスクリーンタイプのCGIサンプルです。confirm関数の # modeを上書きする という行で、param()を使って、'mode' の値を設定しています。この行を注釈にして、次の行で、hidden('mode', 'end') とは出来ないので注意。

 #!/usr/bin/perl -w
 # formtest.cgi - CGI.pmのform関連をテストする
 use strict;
 use CGI qw/-no_xhtml :standard/;
 
 # 画面表示用関数のハッシュリファレンス
 my $func = {
     default => \&inputform,
     confirm => \&confirm,
     end     => \&thanks,
 };
 my $mode = param('mode') || 'default';
 
 # 関数呼び出し
 $func->{$mode}->();
 exit;
 
 sub inputform {
     html_header('入力画面');
     print hidden('mode', 'confirm');
     print '名前：', textfield('name'), br;
     print '住所：', textfield('addr'), submit;
     html_footer();
 }
 
 sub confirm {
     my $name = param('name') || '匿名';
     my $addr = param('addr') || '入力しない';
     html_header('入力確認');
     param('mode', 'end');    # modeを上書きする
     print hidden('mode'), hidden('name'), hidden('addr');
     print '名前：', $name,br, '住所：', $addr,
           p('宜しいですか？'), submit;
     html_footer();
 }
 
 sub thanks {
     html_header('入力完了');
     print '名前：', param('name'),br, '住所：', param('addr'),
           p('が入力されました。');
     html_footer();
 }
 
 sub html_header {
     my $title = shift;
     charset('Shift_JIS');
     print header;
     print start_html(-title=> $title);
     print start_form, h1($title);
 }
 
 sub html_footer {
     print end_form, end_html;
     exit;
 }

ファイルのアップロード処理

CGI.pmを使うとファイルアップロード処理が簡単にできます。フォームからアップロードされたデータはparam()で取得します。param()で取得するデータは、ファイル名であると同時にファイルハンドルでもあります。以下の例は、マルチスクリーン（といっても２画面ですが）のCGIサンプルです。アップロードしたデータを同名でサーバに保存し、保存したファイルにリンクを付けます。$basename = basename($upfile); でファイル名（ベース名）を取得し、read($upfile, my $buf, 256) で、ファイルハンドルとしても利用しデータを取得します。

 #!/usr/bin/perl -w
 # upload.cgi - ファイルアップロードCGIのサンプル
 use strict;
 use CGI qw/:standard/;
 use File::Basename;
 
 my $upfile = param('upfile') or dispform();
 uploadtest();
 
 sub dispform {
     print header(-charset=>'Shift_JIS');
     print start_html, start_multipart_form;
     print filefield('upfile'), submit;
     print end_form, end_html;
     exit;
 }
 
 sub uploadtest {
     my $basename = basename($upfile);
 
     open(WF, '>'.$basename);
     binmode WF;
     while(read($upfile, my $buf, 256)){
         print WF $buf;
     }
     close(WF);
 
     print header(-charset=>'Shift_JIS');
     print start_html;
     print a({href=>$basename}, $basename);
     print end_html;
     exit;
 }

サンプル掲示板

CGI.pm を使った掲示板のサンプルを公開してほしいという要望があったので作成しました。サンプルゆえ、ほぼ全てのことをCGI.pmに依存しています。動作させるには、空のデータファイル bbs.txt が必要です。

• 動作サンプル
• Download >> bbs.lzh

 #!/usr/bin/perl -w
 # bbs.cgi - CGI.pmを利用した掲示板CGIサンプル
 # 2003/11/30 by tuka.
 use strict;
 use CGI qw/-no_xhtml :standard/;
 use CGI::Carp qw/fatalsToBrowser/;
 charset('Shift_JIS');
 
 # リテラル・初期設定
 my $DATA      = 'bbs.txt';
 my $TITLE     = 'ぷるぷるぼ〜ど';
 my $ANONYMOUS = '匿名さん';
 my $PAGESIZE  = 10;
 my $TOP_TEXT  = 'ぷるぷるぼ〜どはシンプルでサンプルな掲示板です。';
 my $PREV_TEXT = escapeHTML('<<');
 my $NEXT_TEXT = escapeHTML('>>');
 my $REFERER   = 'http://tuka.s12.xrea.com/';    # 設置するREFERERに変更して！
 
 # パラメータ取得
 my $name = param('name') || cookie('name') || $ANONYMOUS;
 my $mail = param('mail') || cookie('mail') || '';
 my $mess = param('mess') || '';
 my $page = param('page') || 1;
 
 if($mess){
     (referer =~ /^$REFERER/) or die("不正なアクセスです\n");
     $name = escapeHTML($name);
     $mail = escapeHTML($mail);
     $mess = escapeHTML($mess);
     $mess =~ s/\r\n|\r|\n/br/eg;
 }
 
 open(FH, "+< $DATA") or die("ファイルのオープンに失敗しました\n");
 flock(FH, 2);
 1 while <FH>;
 my $no = $.;
 print FH ++$no, "\t", time, "\t$name\t$mail\t$mess\n" if($mess);
 close(FH);
 
 # ページナビ
 my $end   = $page * $PAGESIZE;
 my $start = $end - $PAGESIZE + 1;
 $end = $no if($no < $end);
 ($start, $end) = ($no - $end + 1, $no - $start + 1);
 
 my(@page, $i);
 my $prev = $page - 1;
 my $next = $page + 1;
 push(@page, ($page==1) ? $PREV_TEXT : a({href=>"?page=$prev"}, $PREV_TEXT));
 for($i=1; $i<=int(($no-1) / $PAGESIZE) + 1; $i++){
         push(@page, ($page==$i) ? $i : a({href=>"?page=$i"}, $i));
 }
 push(@page, ($page+1==$i) ? $NEXT_TEXT : a({href=>"?page=$next"}, $NEXT_TEXT));
 my $navi = ($i > 2) ? join(' ', @page).hr :'';
 
 # データ取得
 my(@data, $idx);
 open(FH, "< $DATA") or die("読み込みオープンに失敗しました\n");
 while(<FH>){
     $idx++;
     if($start <= $idx && $end >= $idx){
         my($no, $time, $name, $mail, $mess) = split(/\t/);
         my $timestr = localtime($time);
         $name = a({href=>'mailto:'.$mail}, $name) if($mail);
         push(@data, div($no.' : '.strong($name).' '.em($timestr)) .
                     div({style=>'padding:1em'}, $mess).hr);
     }
 }
 close(FH);
 
 my $cookname = cookie(-name=>'name', -value=>$name, -expires=>'+1y');
 my $cookmail = cookie(-name=>'mail', -value=>$mail, -expires=>'+1y');
 
 # 画面表示
 print header(-cookie=>[$cookname, $cookmail]);
 print start_html({title=>$TITLE, lang=>'ja'});
 print h1($TITLE).hr;
 print $TOP_TEXT.hr;
 print start_form({onsubmit=>'return confirm("投稿します。宜しいですか？");'});
 print '名前'.textfield({name=>'name', value=>$name, size=>20});
 print 'E-mail'.textfield({name=>'mail', value=>$mail, size=>30}).br;
 print textarea({name=>'mess', rows=>6, cols=>50, default=>'', override=>1}).br;
 print submit('投稿する').reset('クリア').br, end_form.hr;
 print $navi, reverse(@data), $navi;
 print div(a({href=>'http://tuka.s12.xrea.com/'}, 'ぷるぷるぼ〜ど Ver1.30'));
 print end_html;
 exit;

クッキーの使い方

CGI.pmを使うと、cookieも簡単に扱うことができます。cookie文字列の取得には、cookie関数を使います。

 cookie [NAME], [VALUE], [PATH], [DOMAIN], [SECURE], [EXPIRES]

取得した文字列をheader関数で指定してあげます。サンプルはアクセスする度にカウントアップし表示するCGIです。

 #!/usr/bin/perl -w
 use strict;
 use CGI qw/:all/;
 
 my $count  = cookie('count');
 my $cookie = cookie('count', ++$count);
 
 print header(-cookie=>$cookie);
 print start_html();
 print 'Count: '. $count;
 print end_html();
 exit;

あと、複数cookieがある時は、headerで-cookieに配列のリファレンスを渡します。

 $cookname = cookie(-name=>'name', -value=>$name, -expires=>'+1y');
 $cookmail = cookie(-name=>'mail', -value=>$mail, -expires=>'+1y');
 print header(-cookie=>[$cookname, $cookmail]);