2009年12月8日:サンプルコードを現在のバージョンで動作するよう修正しました。
一行掲示板を移植してみよう
連載の1回目では、Mojoのスタンドアロンサーバを使って簡単な画面を表示してみました。今回は簡単なCGIをMojoに移植しながら、リクエストの扱い方やテストの仕方を見ていきましょう。まずはこれから移植していくCGIのソースを掲載します。あきらかに穴だらけのものですが、
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $q = CGI->new;
my $file = 'data.txt';
unless (-f $file) {
    open my $fh, '>', $file or die $!;
    close $fh;
}
if ($q->param('text')) {
    open my $fh, '>>', $file or die $!;
    print $fh $q->param('text'), "\n";
    close $fh;
}
open my $fh, '<', $file or die $!;
my @lines = <$fh>;
close $fh;
print "Status: 200 OK\n";
print "Content-Type: text/html; charset=utf-8\n\n";
print <<"END";
<html><head><title>Simple BBS</title></head><body>
<form method="POST"><input type="text" name="text"></form>
@{[ map{ "<p>$_</p>" } @lines ]}
</body></html>
END最後のヒアドキュメントのなかにPerlの式を埋め込むテクニックはあまりなじみがないものかもしれません。詳しくは竹迫良範さんがJPerl Advent Calendar 2008に寄稿された記事
書き直すのはリクエストとレスポンスだけ
さて、
まずは連載1回目と同じく、
> perl script/mojo generate app SimpleBBS > cd simple_bbs
続いて、
package SimpleBBS;
use strict;
use warnings;
use base 'Mojo';
sub handler {
    my ($self, $tx) = @_;
    my $file = 'data.txt';
    unless (-f $file) {
        open my $fh, '>', $file or die $!;
        close $fh;
    }
    if ($tx->req->param('text')) {
        open my $fh, '>>', $file or die $!;
        print $fh $tx->req->param('text'), "\n";
        close $fh;
    }
    open my $fh, '<', $file or die $!;
    my @lines = <$fh>;
    close $fh;
    $tx->res->code(200);
    $tx->res->headers->content_type('text/html; charset=utf-8');
    $tx->res->body(<<"END");
<html><head><title>Simple BBS</title></head><body>
<form method="POST"><input type="text" name="text"></form>
@{[ map{ "<p>$_</p>" } @lines ]}
</body></html>
END
    return $tx;
}
1;連載第1回でも説明した通り、
リクエストオブジェクトの中身
このリクエストオブジェクトの正体は、
- $tx->req->param(パラメータ名)
- クエリストリングやフォームデータのパラメータを返します。 
- $tx->req->method
- リクエストのメソッド - (GET、 - POSTなど) - を返します。 
- $tx->req->is_multipart 
- リクエストがマルチパートのフォームデータかどうかを返します。 
- $tx->req->cookie(クッキー名)->value
- クッキーの値を返します。 
- $tx->req->headers->content_length 
- Content-Lengthヘッダの値を返します。 
- $tx->req->headers->content_type 
- Content-Typeヘッダの値を返します。 
- $tx->req->headers->header(ヘッダ名)
- 任意のヘッダの値を返します。 
- $tx->req->url->path
- PATH_ - INFOの値を返します。 
- $tx->req->upload(パラメータ名)->file->move_to(移動先) 
- アップロードされたファイルを移動します。 
そのほかのメソッドや、
CGIとして動かしてみる
さて、
本当はシェル
#!/usr/bin/perl
use strict;
use warnings;
use lib qw(
  /home/ishigaki/mojo/lib
  /home/ishigaki/mojo/simple_bbs/lib
);
use Mojo::Server::CGI;
$ENV{MOJO_APP} = 'SimpleBBS';
Mojo::Server::CGI->new->run;サーバの設定ファイルにCGIの実行権限を追加して再起動したら、
テストを書こう
ところで、
このような場合、
この程度の分量であれば、
ウェブアプリケーションをテストする場合、
use strict;
use warnings;
use Test::More tests => 1;
use SimpleBBS;
use Mojo::Transaction::Single;
my $app = SimpleBBS->new;
{
    my $tx = Mojo::Transaction::Single->new;
    $tx->req->param('text' => 0);
    $app->handler($tx);
    like $tx->res->body => qr{<p>0</p>};
}テストを実行してみる
このテストをt/
> perl script/simple_bbs test
いまの段階では当然テストは失敗します。問題の箇所を修正しましょう。差分はこうなります。
@@ -13,7 +13,7 @@
         open my $fh, '>', $file or die $!;
         close $fh;
     }
-    if ($tx->req->param('text')) {
+    if (defined $tx->req->param('text')) {
         open my $fh, '>>', $file or die $!;
         print $fh $tx->req->param('text'), "\n";
         close $fh;テストは正常に見えるバグも見つけてくれます
これでブラウザからは直ったように見えますが、
Running tests from '/home/ishigaki/mojo/simple_bbs/t'. t/basic..........ok t/false_value....1/1 # Failed test at t/false_value.t line 12. # '<html><head><title>Simple BBS</title></head><body> # <form method="POST"><input type="text" name="text"></form> # <p>0 # </p> # </body></html> # ' # doesn't match '(?-xism:<p>0</p>)' # Looks like you failed 1 test of 1. t/false_value.... Dubious, test returned 1 (wstat 256, 0x100) Failed 1/1 subtests
改行が落ちていなかったのですね。
@@ -19,7 +19,7 @@
         close $fh;
     }
     open my $fh, '<', $file or die $!;
-    my @lines = <$fh>;
+    my @lines = map { chomp; $_ } <$fh>;
     close $fh;
     $tx->res->code(200);これでひとまずt/
設定は外から変更できるように
テストを実行したときに、
このような場合、
lib/
@@ -5,10 +5,12 @@
 use base 'Mojo';
+__PACKAGE__->attr(datafile => 'data.txt');
+
 sub handler {
     my ($self, $tx) = @_;
-    my $file = 'data.txt';
+    my $file = $self->datafile;
     unless (-f $file) {
         open my $fh, '>', $file or die $!;
         close $fh;t/
@@ -6,8 +6,10 @@
 my $app = SimpleBBS->new;
 {
+    $app->datafile('test_false_value.txt');
     my $tx = Mojo::Transaction::Single->new;
     $tx->req->param('text' => 0);
     $app->handler($tx);
     like $tx->res->body => qr{<p>0</p>};
+    unlink $app->datafile;
 }これで何度テストを実行しても、
同じ要領でt/
Mojoを使うと、
次回は画面遷移のあるもう少し複雑なアプリケーションに挑戦してみます。お楽しみに。
