CGI モジュール(1) パラメータを受け取る

CGI プログラムの基本的な作り方がわかってきたので、そろそろ CGI モジュールを勉強したいと思います。CGI モジュールは Perl5 標準の組み込みモジュールで、CGI プログラムを作るのに便利な機能が利用できるようになるモジュールです。(Japanized Perl Resources Project にて日本語に翻訳された POD も公開されています)
CGI モジュールの利用方法は、従来の「関数型」(関数をエクスポートして、モジュールの外部で関数を利用する)と、「オブジェクト型」(new クラスメソッドを呼び出して CGI パッケージのインスタンスを生成してメソッドを利用する)という2つの方法があります。前者の関数型は手軽に利用できますが、多くの関数がエクスポートされる事になりますので、識別子の衝突など名前空間の汚染が心配です。後者のオブジェクト型は多少手続きが必要ですが、名前空間の汚染はありません。
多くのモジュールは、このように「関数型」と「オブジェクト型」という2つのインターフェースを提供していますが、ぱるも日記では主にオブジェクト型を利用していきたいと思います。ただし、Perl によるオブジェクト指向プログラミングは「関数型に比べて遅い」という事を留意しておかなくてはいけませんね。(^_^)
CGI モジュールをオブジェクトとして利用するには、まず use してから、コンストラクタ new を呼び出します。慣例として CGI オブジェクトを入れる変数名には $q が使われるそうです。(query からきているのかな?)

use CGI;
my $q = CGI->new();


では、CGI モジュールの機能の一部を利用してみたいと思います。
「パラメータの受け取り」は、環境変数 QUERY_STRING を介する方法と、標準入力を介する方法という2通りの方法を勉強しました。

CGI モジュールを利用すると、このパラメータの受け取りをとても簡単に行なう事ができます。こうなると、上のエントリで勉強した方法は「車輪の再発明」と呼ばれてしまいそうですが、CGI の仕組みを理解する為でしたのでお許しください。(^_^;)
与えられたパラメータの値を取得するには、param メソッドを利用します。このメソッドは "GET" の QUERY_STRING 形式にも "POST" の標準入力形式にも対応しているので、これらのリクエストメソッドの違いを意識する事なく利用できます。
例えば、以下のような URL で GET リクエストされたとします。

/action.cgi?apple=red&banana=yellow&peach=pink

「名前=値」のリストが「&」で区切られてるのでしたね。(^_^)
この action.cgi の中で param メソッドを使えば、以下のように名前に対応する値を取得できます。

print $q->param('apple'), "\n";   # red
print $q->param('banana'), "\n";  # yellow
print $q->param('peach'), "\n";   # pink

また、引数を渡さずに param メソッドを呼び出すと、パラメータとして渡された名前のリストを取得できます。下のコードでは全てのパラメータを列挙しています。

for my $name ($q->param) {
  print "$name is ", $q->param($name), ",\n";
}

上のコードでは、全てのパラメータを列挙します。簡単ですね。(^_^)


POST でパラメータを受け取る」で作った echo.cgi を、CGI モジュールを使って作り変えると、以下のようになりました。テンプレートは流用しています。
echo2.cgi 実行結果 (ソースコードテンプレート
自前でパラメータ解析を実装していた echo.cgi と比べると、大分コードが短くなっています。
また、もう一つのメリットとして、param メソッドを通じて取得した値は自動的にアンエスケープされるので、日本語や改行を入力しても、ちゃんと表示されます。便利ですね。(^_^)

範囲演算子

スライスを勉強した時に「範囲構文」として勉強した「a..b」という書き方ですが、ラクダ本を読んでいたところ、これは構文というよりは「..」という「範囲演算子」によるもの、という事がわかりました。
今まで「整数と整数の間の範囲の整数リストを作り出す」という程度の認識で使っていたのですが、やはりちゃんと勉強しないとダメですね。知らなかった使い方が見つかりました。(^_^;)
というわけで、範囲演算子をちゃんと勉強したいと思います。


ラクダ本プログラミングPerl〈VOLUME1〉)によると、範囲演算子(range operator)は「コンテキスト」によってその意味が変わるそうです。
「コンテキスト」は、ぱるも日記でも何度か登場して勉強していますが、「文脈」の事ですね。スカラー変数への代入文の右辺や if 文の条件文など、「スカラー値」が必要と判断される場所は「スカラーコンテキスト」と呼ばれ、配列変数への代入文の右辺や foreach 文の対象など、「リスト値」(複数のスカラー値)が必要と判断される場所は「リストコンテキスト」になるのでした。


範囲演算子を「リストコンテキスト」で使った場合は、今までの使い方である「整数と整数の間の整数リストを生成」という意味になります。

my @onetoten = (1..10);   # 配列変数への代入なのでリストコンテキスト
print "@onetoten\n";
1 2 3 4 5 6 7 8 9 10

また、Perl には「マジックインクリメント」という機能があり、/^[a-zA-Z]*[0-9]*$/ にマッチする文字列が入ったスカラー変数をインクリメント(++)する事ができます。数字の10文字にアルファベット26文字を加えて、「36進数」であるかのように振舞うのです。ケタ上がりにも対応しています。

my @nums = qw(A ab AZ Z9 01 perl);
print "$_ -> ", ++$_, "\n" for (@nums);

@nums に入れた文字列をそれぞれインクリメントして表示します。実行結果は以下の通りです。

A -> B
ab -> ac
AZ -> BA
Z9 -> AA0
01 -> 02
perl -> perm

範囲演算子は内部でマジックインクリメントを利用しているので、範囲演算子の項には文字列を渡す事もできます。

my @atoz = ('a'..'z');
print "@atoz\n";
a b c d e f g h i j k l m n o p q r s t u v w x y z

便利ですね。(^_^)


範囲演算子スカラーコンテキストで評価した場合の動作は全く異なります。
スカラーコンテキストでの範囲演算子は、左右に真偽値をとり、真偽値を返す、論理演算子のように振舞います。しかし、ただの演算子とは違い、それぞれの範囲演算子が個別の「内部状態」(ON/OFF)を持っている、というのがポイントです。どの範囲演算子の内部状態も最初は「OFF」となっています。
例えば「A..B」がスカラーコンテキストに書かれていて、繰り返し構文などで何度も評価されるとします。
この「A..B」を評価すると、内部状態が「OFF」の時は A が評価されます。A が偽の場合、範囲演算子は何もせずに偽を返します。ですが、A が真になると範囲演算子の内部状態は「ON」となり、範囲演算子は真を返します。「A..B」が評価された時に、内部状態が「ON」の時は B が評価されます。B が真の場合、範囲演算子は何もせずに真を返しますが、B が偽になると内部状態が「OFF」になり、範囲演算子は偽を返します。

つまり、スカラーコンテキストでの範囲演算子は、「ON 条件と OFF 条件をとるスイッチ」のように振舞うのです。最初は ON 条件だけを見張っていて、一度 ON 条件が真になれば次からは OFF 条件を見張りだす、というように動くわけですね。見張られていない方の条件は「評価されない」事に注意してください。
また、ON 条件が真になった時 OFF 条件も評価されますが、ドットを3つにする(...)と ON 条件が真になっても次回の評価まで OFF 条件の評価は始まりません。


このスカラーコンテキストでの範囲演算子は、使い道が思い浮かばないかもしれませんが、色々な場面で利用できます。スイッチの代わりになる、というのが便利なのです。

while (<DATA>) {
  chomp;
  print "$_\n" if ( /^_START_$/ .. /^_END_$/ );
}

__END__
AAA
_START_
BBB
CCC
_END_
DDD

特殊ファイルハンドル DATA には __END__ 以降のテキストが入っているのでしたね。DATA に入っているテキストを行入力演算子で毎行読み込んで、範囲演算子正規表現パターンを組み合わせて判定しています。
この場合 "_START_" という行が見つかったら、範囲演算子は "_END_" という行を見つけるまで真を返すようになります。("_START_" から "_END_" まで)
実行結果は以下の通りです。

_START_
BBB
CCC
_END_

_START_ と _END_ の間のテキストだけを表示する事ができました。


また、ON/OFF 条件として「リテラルな正の整数」(0, 1, 2...)を指定した場合、暗黙のルールとして特殊変数「$.」(最後に行入力演算子で読み込んだ行の行番号)と比較されます。

while (<DATA>) {
  chomp;
  print "$_\n" if (2..4);
}

__END__
AAA
BBB
CCC
DDD
EEE

この場合の範囲演算子は「2行目から4行目」と読み替えればいいわけですね。(^_^)
実行結果は以下の通りです。

BBB
CCC
DDD

「○○から××まで」を直感的に書く事ができて、コードがとても簡潔になりますね。使いどころがちょっと難しいですが、色々と応用できそうです。

エスケープ処理された文字列を戻す

POST でパラメータを受け取る で作った echo.cgi に改行や日本語を含むテキストを送信してみると、ちゃんと表示されず「%」が含まれた文字列になってしまいますが、これは文字化けではありません。
例えば、名前(name)に「ぱるも」、本文(body)に「こんにちは(改行)かわいい犬ですね」と書いて送信すると

name  %82%CF%82%E9%82%E0
body  %82%B1%82%F1%82%C9%82%BF%82%CD%0D%0A%82%A9%82%ED%82%A2%82%A2%8C%A2%82%C5%82%B7%82%CB

と表示されます。(Shift-JIS の場合)
これは、パラメータがブラウザによって送信される時に「エスケープ処理」されているからです。TMPL_VAR の ESCAPE 属性でも勉強しましたが、エスケープ処理とは「特殊な記号の意味を打ち消す為の処理」です。この場合の「特殊な記号」とは英数字以外の文字の事で、改行や日本語のマルチバイト文字なども含まれます。
例えば、パラメータの一部として「&」や「=」が入力されていると、パラメータを受け取ったプログラムが正しく解釈する事ができません。もし、「&」や「=」がパラメータの一部に含まれているとすると、以下のような REQUEST_URI でリクエストされた場合

/foo.cgi?title=aaa&body=bbb

title に「aaa&body=bbb」を指定したのか、それとも title は「aaa」までで、別に body が「bbb」として指定されているのか判断できませんよね。
このように、「特殊な意味」を持つ記号はブラウザによってエスケープ処理されてからパラメータに渡される事になっているのです。ただ、どの記号が「特殊な意味」を持っているのか、というのはプログラムによって異なるので、ブラウザの場合は英数字以外の文字は全てエスケープされる事になっています。


エスケープ処理後の文字列に含まれる「%82」や「%CF」の後ろの二文字「82」「CF」は、16進数によって表された「文字コード」ですね。(^_^)
コンピュータは 0 か 1 かのデジタルなものですので、「文字」も内部では数字で表されています。文字に対応する数字の事を、文字の「文字コード」(キャラクターコード)と言います。
1バイトの文字は「0から255の間の数字どれか」で表す事ができますが、この「0から255」というのは、2ケタの16進数(00からFF)で表せる数字の範囲と一致しているので、1バイトの文字を2ケタの16進数で表す事ができるのです。
日本語の1文字は「2バイト」で表されているので、「ぱるも」は 6 バイトで表される事になります。だから「%82%CF%82%E9%82%E0」と、6つの「%xx」が並びます。(Shift-JIS や EUC-JP などの場合)


では、エスケープ処理された文字列を元に戻す処理(アンエスケープ : unescape)を作ってみます。
流れとしては

  1. 文字列の中から「%xx」を見つける
  2. 「%xx」の「xx」の部分を16進数→10進数の数字に変換する
  3. 数字を文字コードとして対応する文字を取得する
  4. 文字列の「%xx」の部分を取得した文字で置き換える

を繰り返せばいいですね。
2. の「16進数→10進数」の変換は、hex 関数でできます。

print hex("FF"), "\n";
print hex("80"), "\n";
print hex("10"), "\n";

実行結果は以下の通りです。

255
128
16

また、3. の「文字コード→文字」の変換は、chr 関数でできます。ちなみに、逆の「文字→文字コード」は ord 関数を使います。
例えば "A" の文字コードは「perl -e "print ord('A')"」で調べてみたところ「65」でした。

print chr(65), chr(66), chr(67), "\n";

実行すると

ABC

と表示されます。
これらの関数を利用して、さらに s/// 演算子/e オプションと組み合わせれば、簡単に変換できますね。(^_^)

use strict;

sub unescape($) {
  my $s = shift;
  $s =~ s/%([0-9A-F]{2})/chr(hex($1))/ieg;
  return $s;
}

my $name = "%82%CF%82%E9%82%E0";
my $body = "%82%B1%82%F1%82%C9%82%BF%82%CD%0D%0A"
         . "%82%A9%82%ED%82%A2%82%A2%8C%A2%82%C5%82%B7%82%CB";

print unescape($name), "\n";
print unescape($body), "\n";

unescape 関数が、アンエスケープ処理を行なっている関数です。「[0-9A-F]{2}」というのは、「0から9とAからFまでの文字が2つ続いてる」という意味なので %xx にマッチします。16進数の部分をキャプチャして、先ほどの2つの関数を使って文字に変換してから置き換えます。
/e オプションを指定しているので「chr(hex($1))」がコードとして評価され、その返り値が置換後の文字列になるのでしたね。(^_^)
このスクリプトの実行結果は以下の通りです。

ぱるも
こんにちは
かわいい犬ですね

うまく変換できました。(^_^)

注意: 文字セットについて

文字と、その文字のコードの対応を決めるのが「文字セット」または「エンコーディング」などと呼ばれる規格です。例えば、上のスクリプトでは「Shift-JIS」という文字セットを利用しました。
「Shift-JIS」は主に Windows で利用される文字セットで、他にも「EUC-JP」や「JIS」など、様々な文字セットが存在します。これらは日本国内でよく使われる文字セットですが、各国が独自の文字セットを持っていたりするので、文字セットは数限りなく存在します。*1
例えば各文字セットで書いた「ぱるも」をエスケープ処理すると

Shift-JIS: %82%CF%82%E9%82%E0
EUC-JP:    %A4%D1%A4%EB%A4%E2
JIS:       %1B%24%42%24%51%24%6B%24%62%1B%28%42

と、全く違うものになります。


厄介なのが、パラメータを受け取る CGI プログラムを作る場合、与えられるパラメータに使われている文字セットが「わからない」という点です。多くのブラウザは、ページの HTML を書くのに使われている文字セットをパラメータの文字セットに利用するので、自分でページを作る場合は予想が付きます。
ですが、もし CGI プログラムを自由に利用できるように不特定多数に公開した場合、どんな文字コードでパラメータが渡されるかは全く予想できません。Perl 内部の文字セットと違う文字セットのパラメータをそのまま使おうとすると、正規表現がマッチしなくなったり、文字化けしたりと、色々な不具合が生じます。
この問題を解消する為には、かの Dan Kogai さんによってメンテナンスされている Encode モジュールを利用して、文字セットを Perl 内部のものに変換する必要があります。Encode::Guess を利用すれば、文字列に使われている文字セットを推測する事ができます。とても便利ですね。(^_^)
Encode モジュールの使い方については、別のエントリで勉強したいと思います。

*1:これらを統一する為に「Unicode」と呼ばれる UTF-8UTF-16 などの統一文字セットが策定されたので、外国語を扱う場合はこちらを利用すればいいですね

POST でパラメータを受け取る

QUERY_STRING でパラメータを受け取る」で勉強した、URL の最後に「?」をつけ、その後にパラメータ(QUERY_STRING)を記述する、という方法は HTTP リクエストのメソッドが「GET」の時に使われるものでした。
ですが、ブラウザやサーバーソフトウェアには URL の長さに制限がある場合が多く、あまり長いパラメータは送る事ができません。「GET」メソッドはあくまでも「コンテンツの取得」が主な目的であるべきで、あまり多くのパラメータを送信すべきではないのです。
「データの送信」が主な目的な時には「POST」メソッドを使います。例えば「掲示板への書き込み」は、投稿者の名前やメールアドレス、本文などの「データの送信」が目的ですので、「POST」メソッドですね。(^_^)
「POST」メソッドではパラメータの長さに制限がなく、サイズの大きいデータでも受け取る事ができます。というわけで、今回は「POST」メソッドが使われた時のパラメータの受け取り方を勉強したいと思います。


といっても、その方法は「GET」とほとんど変わりません。ただ、読み込む先が違うのです。「POST」の場合、渡されたパラメータは「標準入力」に入っています。QUERY_STRING と同じく、「名前=値」の形式が使われ、複数の値がある場合は「&」でつながっています。
標準入力の内容は特殊ファイルハンドル「STDIN」から読み込む事ができます。

my $query;
if ($ENV{'REQUEST_METHOD'} eq "POST") {
  $query = join "", <STDIN>;
} else {
  $query = $ENV{'QUERY_STRING'};
}

REQUEST_METHOD には、リクエストに使われたメソッドが入っているので、"POST" ならば STDIN の内容を行入力演算子と join を組み合わせて全て読み込み、"GET" ならば QUERY_STRING の内容を読み込みます。これで GET と POST 両方に対応できますね。
あとは、QUERY_STRING の時と同じように

my %param = map { /([^=]+)=(.+)/ } split /&/, $query;

とすればハッシュ変数 %param に名前と値の組が収まりますね。(^_^)


「POST」メソッドを使ったフォームは、以下のようになります。

<form action="post.cgi" method="POST">
  <p>
    <label for="name">名前:</label>
    <input type="text" name="name" id="name" />
  </p>
  <p>
    <label for="body">本文:</label>
    <textarea name="body" id="body" cols="20" rows="3"></textarea>
  </p>
  <input type="submit" value="送信" />
</form>

この場合、以下のように表示されます。









複数行のテキストボックス(<textarea>)を入れてみました。上のフォームの動作を確かめる為に、CGI にしてみました。(実は上で例示したフォームも動作します)
echo.cgi 実行結果ソースコードテンプレート
送られてきたパラメータをそのまま表示します。
GET の時とあまり違いがないので、簡単ですね。(^_^)

ファイルテスト演算子と優先順位

先日作ったソースコードビューアのコード中で「ファイルテスト演算子」というものを使いました。
ファイルテスト演算子とは、文字通り「“ファイル”を“テスト”する為の“演算子”」です。ファイル演算子を使う事で、「ファイルが存在するか」「ファイルに書き込めるか」「ファイルを所持しているか(UNIX系OSの場合)」などを確かめたり、「ファイルの最終更新日時」を取得できたり、ファイルの色々な情報を取得する事ができます。
ファイル演算子は「ファイル名」(ファイルへのパス)もしくは「ファイルハンドル」を受け取る単項演算子で、「-」(ハイフン)+「英文字1字」で構成されます。例えば、以下のように使います。

if (-e "hello.pl") {
  print "hello.pl exists.";
} else {
  print "hello.pl does not exist.";
}

「-e」は、「ファイルが存在するかどうか」を確かめる為のファイルテスト演算子です。ファイルが存在すれば真(1)を、存在しなければ偽(空文字列 "")を返します。つまり、この場合は "hello.pl" がカレントディレクトリに存在するなら "hello.pl exists." と表示されます。存在しなければ else のメッセージが表示されます。「演算子」と呼んではいるものの、「-e」という名前の組み込み関数のようですね。(^_^)
他にも、ファイルテスト演算子には色々なものがあります。以下の表に、よく使うと思われる演算子をまとめてみました。ファイルテスト演算子はこれだけではないので、必要があればその都度勉強したいと思います。

演算子 意味 返り値
-e ファイルが存在するかどうか 存在すれば真
-s ファイルのサイズを取得 バイト単位でのサイズ
-z ファイルのサイズが 0 かどうか サイズが 0 ならば真
-f 普通のファイルのパスかどうか ファイルのパスならば真
-d ディレクトリ(フォルダ)のパスかどうか ディレクトリのパスならば真
-r 現在のユーザーで読み込めるかどうか 読み込めるならば真
-w 現在のユーザーで書き込めるかどうか 書き込めるならば真
-o 現在のユーザーが所有しているかどうか 所有しているならば真
-M ファイルの最終更新日を取得 更新されてからの日数*1
-A ファイルへの最終アクセス日を取得 アクセスされてからの日数

色々あって便利ですね。(^_^)


演算子としての優先順位をラクダ本で調べてみたところ、比較演算子(==, < など)よりも高く、加算減算などの算術演算子よりは低い、という位置にあるようです。(普通の組み込み関数と同じかな?)
例えば、この場合は

my $fn = "hello";
if (-e $fn . ".pl") {
  print "$fn!";
}

ファイルテスト演算子 -e よりも、文字列結合演算子「.」が優先されるので(加算減算と同じ優先順位)、思った通りに動きます。"hello.pl" が存在すれば、"hello!" と表示されます。


では、ファイル名を指定する為に「三項演算子」(?:)を使ってみるとどうでしょうか。

my $afternoon = 0;
if (-e $afternoon ? "hello.pl" : "goodnight.pl") {
  print "Exists!";
}

$afternoon が 0 (偽)なので、「$afternoon ? "hello.pl" : "goodnight.pl"」という三項演算子は「goodnight.pl」を返すはずです。「goodnight.pl」は存在しません。それにもかかわらず、このプログラムは "Exists!" と表示してしまいます。$afternoon を 1 にしてみても、常に "Exists!" と表示されてしまうので、条件文が常に「真」として判定されている事になりますね。
これは、三項演算子がファイルテスト演算子よりも「低い優先順位を持っている」のが原因です。つまり、三項演算子よりも先に「-e $afternoon」が評価されてしまうのです。「"0" という名前のファイルは存在しない」ので、結果として「偽」(空文字)が返ります。そして、その結果が三項演算子の条件として使われて

"" ? "hello.pl" : "goodnight.pl"

が評価されます。「""」(空文字)は偽なので、当然この式は "goodnight.pl" を返します。文字列を論理値として評価する場合(ブール値コンテキスト)、空文字("")は「偽」、それ以外は「真」として評価されます。"goodnight.pl" は「真」、つまり、式全体の評価結果は常に「真」という事になってしまうわけです。
これを解消するには、三項演算子が優先して評価されるようにカッコで括ればいいですね。

my $afternoon = 0;
if ( -e ($afternoon ? "hello.pl" : "goodnight.pl") ) {
  print "Exists!";
}

実行してみると、$afternoon が 0 の時は何も表示されず、1 の時は "Exists!" と表示されるようになりました。(^_^)


Perl には演算子がたくさんあるので、それぞれ優先順位を覚えるのはとても大変ですね。直感的な優先順位になってはいますが、それでも思った通りの順番で評価されない事もあります。特に Perl では「カッコをなるべく省略する」という慣習があるので、こういった間違いが起こりやすいと思います。
優先順位の間違いは、文法上の誤りではないので Perl は「エラー」だと気づいてくれません。その結果、他の部分でエラーになってしまい、エラーの出る位置と原因の位置が離れている「原因がなかなかわからないバグ」を作り出してしまいます。
あまり自信がなければ、多少読みづらくなるとしても、カッコで括るようにしたほうがいいですね。(^_^)

*1:その日付から、プログラムの開始日時までの経過日数を小数で表したものが返ってきます

ソースコードビューア CGI を作る

日記内に登場した CGIソースコードが簡単に見られるように、簡単なソースコードビューア view.cgi を作ってみたいと思います。(^_^)
考えたのは「view.cgi?ソースファイル名」と、QUERY_STRING を使って表示したいソースファイルの名前を渡し、色分けして表示させる、というものです。
この手の「ファイル名をパラメータとして渡す」スクリプトで絶対に注意しなくてはいけないのが、セキュリティの問題ですね。この場合 QUERY_STRING で渡されたファイル名をそのまま open に使うと、表示させたくないファイルの中身まで見る事ができてしまいます。
例えば「view.cgi?/etc/passwd」や「view.cgi?../../../.htpasswd」などの「絶対パス」や「親方向への相対パス」などを渡されてしまうと、実際にはアクセスできないはずのパスワードファイルの内容や各種設定情報などが簡単に漏れてしまい、とても危険です。
この種のセキュリティホールを放置してしまい、クラックされてしまった方も実際にいらっしゃいます。(猿真似は危険『「Ajax + PHP」でRSSリーダーを作る』で破滅


今回の CGI スクリプトでは、この問題の解決策として

  • 「/」で始まる絶対パスは受け付けない
  • 英数字と拡張子用の「.」で構成されたパスしか受け付けない
  • 決められた拡張子のファイルしか受け付けない

という3つのルールを決めました。これにより、指定したディレクトリ以下の、決められた拡張子のファイルしか見れないようにします。


構文を色分けする為に CPAN を「Highlight」で検索すると、ソースコードを HTML でマークアップしてくれるモジュールがいくつか見つかりました。今回は、使い方が簡単で、依存関係が少ない Text::Highlight モジュールを利用したいと思います。Perl や HTML などの色分けに対応しています。
CPAN からローカルにインストールします。

perl -MCPAN -e shell
cpan> install Text::Highlight

これでインストールできました。「perldoc Text::Highlight」を実行してみると、ドキュメントが表示されます。

NAME
    Text::Highlight - Syntax highlighting framework

SYNOPSIS
       use Text::Highlight 'preload';
       my $th = new Text::Highlight(wrapper => "<pre>%s</pre>\n");
       print $th->highlight('Perl', $code);

使い方も簡単ですね。(^_^)


Text::Highlight の使用例(SYNOPSIS)を見てもわかるように、色分けする「言語」を指定しなければいけません。そこで、以下のようなハッシュを用意して、拡張子に関連付けられた言語(ファイルタイプ)がわかるようにします。

my %file_types = (
  pl   => 'Perl',
  pm   => 'Perl',
  cgi  => 'Perl',
  tmpl => 'HTML',
);

この場合、拡張子が「pl」「pm」「cgi」のどれかなら「Perl」として、「tmpl」なら「HTML」として色分けされるようにしたいと思います。
そこで、パスから拡張子を自動的に取得して、ファイルタイプを返す関数を作りました。

# ファイルに関連付けられたファイルタイプを返す
# 関連付けられていない場合は undef を返す
sub get_file_type($) {
  my $fpath = shift;

  my $ftype = undef;
  if ($fpath && $fpath =~ /\.([^.]+?)$/) {
    my $ext = lc($1);
    $ftype = $file_types{$ext} if exists $file_types{$ext};
  }
  return $ftype;
}

正規表現を使って拡張子を取得し、lc 関数で全て小文字に変換します。%file_types に拡張子があれば、そのファイルタイプを、なければ undef が返ります。


また %file_types ハッシュを利用して、先ほど決めたルールをチェックする為の正規表現も作りました。

my $allowed_path = q!^\w[\w\/]+\.(! . join('|', keys %file_types) . q!)$!;
  • 「/」で始まる絶対パスは受け付けない
    • 先頭が英数字(\w)から始まるものにのみマッチする事で対応
  • 英数字と拡張子用の「.」で構成されたパスしか受け付けない
    • 英数字(\w)と「/」(スラッシュ)で構成されたパスにのみマッチするので「..」などは使えない
    • 「.」は拡張子の前でしか使えない
  • 決められた拡張子のファイルしか受け付けない
    • 先ほど作った %file_types を利用して、そのキー(拡張子)のリストを「|」(OR)で join する事により、%file_types に存在する拡張子のファイルしか受け付けない

この正規表現を、渡されたパスに対して適用する事で、有効なパスかどうか調べる事ができます。

# 読み込みが許可されたパスなら真を返す
sub is_allowed_path($) {
  my $fpath = shift;
  return ($fpath && $fpath =~ /$allowed_path/);
}


パスとファイルタイプを受け取って、ソースファイルを読み込む関数も作りました。

# ソースファイルを読み込んでマークアップされた内容を返す
# 読み込めなかった場合は undef を返す
sub load_source_file($$) {
  my ($fpath, $ftype) = @_;

  open IN, $fpath or return undef;
  my $content = join "", <IN>;
  close IN;

  my $th = Text::Highlight->new(wrapper => "%s");
  return $th->highlight($ftype, $content);
}

Text::Highlight を使って色分けした結果を返しています。


あとは、定義した関数を使ってメイン処理を書くだけです。勉強した HTML::Template を使って、HTML 文はテンプレートファイルに切り分ける事にしました。

my $tmpl = HTML::Template->new(filename => $tmpl_path);

my $fname = $ENV{'QUERY_STRING'};   # 渡されたファイル名
my $fpath = "$base_path$fname";     # 実際のファイルパス
my $ftype = get_file_type($fpath);  # 関連付けられたファイルタイプ

# 読み込み可能で関連付けられたパスなら内容を読み込んで設定
if (is_allowed_path($fname) && -r $fpath && $ftype) {
  $tmpl->param(
    FILENAME => $fname,
    FILEPATH => $fpath,
    FILETYPE => $ftype,
    CODE => load_source_file($fpath, $ftype) || "",
  );
}

# ページを出力
my $output = $tmpl->output() || "Template Output Error";
print "Content-Type: text/html\n";
print "Content-Length: " . length($output) . "\n\n";
print $output;

QUERY_STRING でファイル名を受け取ります。$fpath には、実際のファイルパスが入るようにしました。「渡されたファイルパス」と「実際のファイルパス」を区別する為に、2つの変数に分けています。あらかじめ $base_path に、実際に表示するファイルが置かれているディレクトリのパスを指定しておきます。
「-r $fpath」ですが、これは「$fpath が読み込み可能かどうか」を調べる「ファイルテスト演算子」の一種です。ファイルテスト演算子については、別のエントリで詳しく勉強したいと思います。(^_^)
読み込みが可能で(許可されていて)、ファイルタイプが関連付けられたファイルパスなら、HTML::Template オブジェクトの param メソッドで、各種パラメータを設定します。テンプレート側で、パラメータがある場合とない場合の表示を切り替えられるので、これで十分ですね。とても便利です。(^_^)
最後に、ページを出力します。ヘッダーとして Content-Length (ページのサイズ)を出力するようにしました。無くても構わないのですが、Content-Length を示しておくと、ウェブブラウザ側でダウンロードの進行状態を表示する事ができます。
メイン処理がちょっと長くなってしまいましたが……、ページの出力を関数化するのも冗長だと思いますし、テンプレートオブジェクトを関数に渡すというのもちょっと気持ち悪いので、このようになりました。コードの切り分けは難しいですね。(^_^;)


というわけで、完成したソースコードを、完成したソースビューアで見たのがこちらです。(^_^)
http://palmo.is.land.to/cgi/view.cgi?view.cgi
ただ色分け表示するだけではつまらないので、フォントや文字の大きさ、色のテーマなどを設定できるようにしてみました。JavaScript が必要です。「設定を記憶」ボタンを押すと、現在の設定をクッキーに記憶します。クッキーを削除するには「設定を忘れる」ボタンを押します。
また、書き忘れていましたが CGI::Carp モジュールを使って、致命的なエラーが発生した時はブラウザに表示するようにしました。
ちなみに、テンプレートファイルはこちらになります。
view.tmpl をソースビューアで見る
CGI を作るのはとても楽しいですね。JavaScript のようにクライアントサイドで動くものも楽しいですが、サーバーサイドだとファイルの読み書きなども制限無くできますし、どんな環境でもブラウザさえあれば利用できます。


ところで、サーバーで Text::Highlight モジュールを利用する為に、view.cgi と同じディレクトリに「Text」ディレクトリ、その中に「Highlight」ディレクトリを作り、CPAN でダウンロードしてきた Text::Highlight のコードをアップロードしたのですが、コンパイルが必要なモジュールはサーバー側で make しないとまずいのでしょうか……?
だとすると、TelnetSSH が使えないとダメですよね。うーん、どうしよう。(^_^;)

HTML::Template(4) TMPL_IF

HTML::Template のテンプレートタグの勉強です。
今回は、テンプレートの中で条件分岐をする為の <TMPL_IF> タグについて勉強します。


使い方は http://d.hatena.ne.jp/palmo/20060715/htmpl3:TMPL_LOOP とほとんど同じで、NAME 属性で「条件」として使う値を指定します。指定した条件の値は、Perl と全く同じように真偽判定されます。例えば「空の文字列」や「数字の 0」、「未定義(undef)」だったりすると「偽」、それ以外なら「真」として判定されるわけですね。
条件が真として判定された場合、<TMPL_IF> という開始タグと、</TMPL_IF> という終了タグで挟みこんだ部分が表示されます。逆に、偽になった場合は全く表示されません。
例えば、このようなテンプレートを書いたとして

<TMPL_IF NAME="TITLE">
  <h1><TMPL_VAR NAME="TITLE"></h1>
</TMPL_IF>

Perl スクリプト側で、param メソッドを使って「TITLE」の値を設定すると

$tmpl->param( TITLE => "Hello, world!" );

TMPL_IF の条件は「真」として判定されるので、TMPL_IF の中身が表示されて

  <h1>Hello, world!</h1>

と出力されます。
逆に TITLE に何も設定しなかったり、TITLE に「偽」として判定される値を設定すると、何も表示されなくなります。
また、条件の真偽を逆にする「TMPL_UNLESS」も存在するので、「値が無い場合」にだけ出力する、という事も可能ですね。(^_^)


さらに、「TMPL_ELSE」も存在します。Perl での if 文と同じく、条件が「偽」であった場合に出力されます。TMPL_IF で挟んだ部分の中で使う事ができます。

<TMPL_IF NAME="VALUE">
  <p>あなたが入力したのは「<TMPL_VAR NAME="VALUE">」です。</p>
<TMPL_ELSE>
  <p>入力してください。</p>
</TMPL_IF>

VALUE」として設定した値が「真」だった場合は、その値を表示しますが、「偽」だった場合は「入力してください」と表示します。


とっても簡単ですね。条件分岐ができれば、テンプレートの表現の幅も広がるはずです。
HTML::Template を利用して、今度は少し実用的な CGI スクリプトを作ってみたいと思います。(^_^)