てきとうなメモ

本の感想とか技術メモとか

CGI::Application (2)

Perl Web

CGI::Applicationの練習としてソーシャルブックマークみたいなのを作ってみた．

概要

ちゃんとしたソーシャルブックマークを作るわけではないので，ユーザ管理などはしない．ブックマークの登録，編集，一覧表示，タグを用いた検索などができればいい，ということで．

DB

bookmarkのテーブルとtagから検索するためにtagテーブルを作成した．bookmarkテーブルではuriを主キーにしており，各uriに対してタイトル，説明，タグを登録する．tagテーブルはuriとtagの対応関係を表している．

create table bookmark (
       uri varchar(255) not null,
       title text not null,
       description text,
       tags varchar(255),
       primary key (uri)
);

create table tag (
       uri varchar(255) not null,
       tag varchar(255) not null,
       primary key (uri,tag)
);

bookmark.cgi

hello, worldのやつとほぼ同じ．モジュール名を変更しただけ．

#!/usr/bin/perl
use strict;
use CGI::Carp qw/fatalsToBrowser/;
use MyApp::Bookmark;

my $webapp = MyApp::Bookmark->new();
$webapp->run();

MyApp/Boomkark.pm

package MyApp::Bookmark;
use strict;
use base 'CGI::Application';
use CGI::Application::Plugin::DBH (qw/dbh_config dbh/);
use HTML::Template;

sub cgiapp_prerun {
  my $self = shift;
  $self->dbh_config('dbname', 'user', 'pass');
  $self->tmpl_path('templates/');
  $self->header_props(-type => 'text/html', -charset => 'EUC-JP');
}

sub setup {
  my $self = shift;
  $self->start_mode('list');
  $self->run_modes(
          'list' => 'list',
          'save' => 'save',
          'input' => 'input',
          'search' => 'search',
  );
}

sub list {
  my $self = shift;
  my $dbh = $self->dbh;
  my $sql = "select * from bookmark";
  my $sth = $dbh->prepare($sql);
  
  $sth->execute or die "Couldn't execute statement: " . $sth->errstr;

  my $all_bm = [];
  while (my $hash_ref = $sth->fetchrow_hashref) {
    $hash_ref->{'tags'} = [map {{'name' => $_, }} split / /, $hash_ref->{'tags'}];
    push @$all_bm, $hash_ref;
  }
  my $template = $self->load_tmpl('list.tmpl');
  $template->param('bookmarklist', $all_bm);
  return $template->output;
}

sub input {
  my $self = shift;
  my $q = $self->query;
  my $dbh = $self->dbh;
  my ($title, $uri, $description, $tags);
  $title = $q->param('title');
  $uri = $q->param('uri');
  $description = $q->param('description');
  $tags = $q->param('tags');

  if ($uri) {
    my $sql = 'select title,description,tags from bookmark where uri=?';
    my $sth = $dbh->prepare($sql);
    $sth->execute($uri)
      or die "Could't execute statement: " . $sth->errstr;
    my @data = $sth->fetchrow_array;
    $title ||= $data[0];
    $description ||= $data[1];
    $tags ||= $data[2];
  }

  my $template = $self->load_tmpl('input.tmpl');

  $template->param('title' => $title);
  $template->param('uri' => $uri);
  $template->param('description' =>  $description);
  $template->param('tags' => $tags);
  return $template->output;
}

sub save {
  my $self = shift;
  my $q = $self->query;
  my $dbh = $self->dbh;
  my ($title, $uri, $description, $tags);
  $title = $q->param('title');
  $uri = $q->param('uri');
  $description = $q->param('description');
  $tags = $q->param('tags');

  my $sql = 'insert bookmark (uri,title,description,tags) values (?,?,?,?)' .
            ' on duplicate key update title=?, description=?, tags=?';
  my $sth = $dbh->prepare($sql);

  $sth->execute($uri, $title, $description, $tags, $title, $description,
	        $tags)
    or die "Could't execute statement: " . $sth->errstr;

  $sql = 'delete from tag where uri=?';
  $sth = $dbh->prepare($sql);
  $sth->execute($uri)
    or die "Could't execute statement: " . $sth->errstr;

  my @tags = split / /, $tags;
  for my $t (@tags) {
    $sql = 'insert tag (uri,tag) values (?,?)' .
           ' on duplicate key update uri=?, tag=?';
    $sth = $dbh->prepare($sql);
    $sth->execute($uri, $t, $uri, $t)
      or die "Could't execute statement: " . $sth->errstr;
  }

  $self->list;
}


sub search {
  my $self = shift;
  my $dbh = $self->dbh;
  my $q = $self->query;
  my $tag = $q->param('tag');

  my $sql = 'select uri from tag where tag=?';
  my $sth = $dbh->prepare($sql);
  $sth->execute($tag)
    or die "Couldn't execute statement: " . $sth->errstr;

  my $all_bm = [];
  while (my ($uri) = $sth->fetchrow_array) {
    my $sql2 = 'select * from bookmark where uri=?';
    my $sth2 = $dbh->prepare($sql2);
    $sth2->execute($uri)
      or die "Couldn't execute statement: " . $sth->errstr;
    my $hash_ref = $sth2->fetchrow_hashref;
    $hash_ref->{'tags'} = [map {{'name' => $_}} split / /, $hash_ref->{'tags'}];
    push @$all_bm, $hash_ref;
  }

  my $template = $self->load_tmpl('list.tmpl');
  $template->param('bookmarklist' => $all_bm);
  $template->output;
}

1;

setup

まず，コンストラクタが呼び出すsetupメソッドを説明する．

sub setup {
  my $self = shift;
  $self->start_mode('list');
  $self->run_modes(
          'list' => 'list',
          'save' => 'save',
          'input' => 'input',
          'search' => 'search',
  );
}

これは4つのrun mode(list,save,input,search)を持ち，デフォルトがlistであることを意味する．各run modeは，それぞれ次のような動作をする．

  • list ... ブックマークのリスト表示
  • input ... 登録フォームの表示
  • save ... 登録データの保存
  • search ... tag search

cgiapp_prerun

これは，各run modeが実行される前に実行されるメソッドである．データベースへの接続，テンプレートへのパス設定などの各モードに共通する初期設定などを行う．

sub cgiapp_prerun {
  my $self = shift;
  $self->dbh_config('dbname', 'user', 'pass');
  $self->tmpl_path('templates/');
  $self->header_props(-type => 'text/html', -charset => 'EUC-JP');
}

dbh_configはデータベースの設定をする．これはDBI->connect()と同じフォーマットであり，C::A::Plugin::DBHからimportすることで呼び出すことができる．tmpl_path()はload_tmpl()を実行する時のパスを指定する．header_props()はHTTPヘッダを設定する．デフォルトではcharsetがEUC-JPになっていないので，これを設定する．

C::A::Plugin::DBH

dbh_config()を用いてデータベースの設定をし，dbh()を用いてDBIのdbhにアクセスすることがでる．このため，通常DBIでやっているようにprepareしてexecuteしてfetchすることができる．

list

listは登録されているブックマークを全件表示する．

sub list {
  my $self = shift;
  my $dbh = $self->dbh;
  my $sql = "select * from bookmark";
  my $sth = $dbh->prepare($sql);
  
  $sth->execute or die "Couldn't execute statement: " . $sth->errstr;

  my $all_bm = [];
  while (my $hash_ref = $sth->fetchrow_hashref) {
    $hash_ref->{'tags'} = [map {{'name' => $_, }} split / /, $hash_ref->{'tags'}];
    push @$all_bm, $hash_ref;
  }
  my $template = $self->load_tmpl('list.tmpl');
  $template->param('bookmarklist', $all_bm);
  return $template->output;
}

$self->dbh()用いてdbhを取得しデータベースにアクセスする．listはデータベースから全件データを取ってきて表示する．load_tmpl()テンプレートファイルを読み込み，HTML::Templateオブジェクトを返す．$template->param()はテンプレートの変数を置換する．さらに$template->outputで置換した結果を出力する．

HTML::Template

HTML::TemplateはHTMLテンプレートを扱うモジュールである．HTML::Templateでは特殊なタグを用いてテンプレートを記述する．一番シンプルなのはであり，と記述されている部分は$template->param('foo', 'bar')でbarに変更される．

templates/list.tmpl

<html>
<head>
<title>ブックマークのリスト</title>
</head>
<body>
<a href="bookmark.cgi?rm=input">新規登録</a> | <a href="bookmark.cgi?rm=list">リスト表示</a>
<hr>
<tmpl_loop name="bookmarklist">
<a href="<tmpl_var name="uri">"><tmpl_var name="title" escape="html"></a><br/>
<tmpl_var name="description" escape="html"><br/>
to 
<tmpl_loop name="tags">
<a href="bookmark.cgi?rm=search&tag=<tmpl_var name="name">"><tmpl_var name=name></a>
</tmpl_loop><br/>
<a href="bookmark.cgi?rm=input&uri=<tmpl_var name="uri">">編集</a>
<p/>
</tmpl_loop>
</body>
</html>

ここでは，という特殊なタグを用いている．これはループを扱うタグであり，例えば，

<tmpl_loop name="foo">
<tmpl_var name="bar"> <tmpl_var name="baz"><br/>
</tmpl_loop>

に対して

$template->param('foo' => [ { 
                              'bar' => 'one', 
		              'baz' => 'two',
                            },
                            { 
                              'bar' => 'three',
                              'baz' => 'four', 
                            },
                          ]);

を実行すると

one two<br/>
three four<br/>

になる．

list.tmplはネストしているが考え方は同じである．ブックマークを全件表示するところと，あるブックマークのタグを表示するところにループを用いている．

また，となっているのは，表示するときにHTMLの'<'などをエスケープするためである．

input

sub input {
  my $self = shift;
  my $q = $self->query;
  my $dbh = $self->dbh;
  my ($title, $uri, $description, $tags);
  $title = $q->param('title');
  $uri = $q->param('uri');
  $description = $q->param('description');
  $tags = $q->param('tags');

  if ($uri) {
    my $sql = 'select title,description,tags from bookmark where uri=?';
    my $sth = $dbh->prepare($sql);
    $sth->execute($uri)
      or die "Could't execute statement: " . $sth->errstr;
    my @data = $sth->fetchrow_array;
    $title ||= $data[0];
    $description ||= $data[1];
    $tags ||= $data[2];
  }

  my $template = $self->load_tmpl('input.tmpl');

  $template->param('title' => $title);
  $template->param('uri' => $uri);
  $template->param('description' =>  $description);
  $template->param('tags' => $tags);
  return $template->output;
}

ここではCGIのパラメタを用いている．まず，$self->queryでCGIモジュールのqueryにアクセスできる．uriのパラメタが与えられていれば，データベースに登録されているかもしれないので，selectしてデータベースから情報を取得する．そして「パラメタの値＞データベースの値」の優先順位でフォームにデフォルトで表示する値を決定する．

templates/input.tmpl

<html>
<head>
<title>新規登録</title>
</head>
<body>
<form action="" method="post">
<table>
<tr><td align="right">タイトル: </td><td><input type="text" name="title" size="100" value="<tmpl_var name=title>"/></td></tr>
<tr><td align="right">URI: </td><td><input type="text" name="uri" size="100" value="<tmpl_var name=uri>"/></td></tr>
<tr><td align="right">説明: </td><td><input type="text" name="description" size="100" value="<tmpl_var name=description>"/></td></tr>
<tr><td align="right">タグ: </td><td><input type="text" name="tags" size="100" value="<tmpl_var name=tags>"/></td></tr>
</table>
<input type="hidden"  name="rm" value="save">
<input type="submit" value="保存"/>
</form>
</body>
</html>

これは入力フォームを用いている．パラメタが与えられると

<input ... value="<tmpl_var name=title>">

などが置換され，フォームにデフォルトの値を表示することができる．

save

sub save {
  my $self = shift;
  my $q = $self->query;
  my $dbh = $self->dbh;
  my ($title, $uri, $description, $tags);
  $title = $q->param('title');
  $uri = $q->param('uri');
  $description = $q->param('description');
  $tags = $q->param('tags');

  my $sql = 'insert bookmark (uri,title,description,tags) values (?,?,?,?)' .
            ' on duplicate key update title=?, description=?, tags=?';
  my $sth = $dbh->prepare($sql);

  $sth->execute($uri, $title, $description, $tags, $title, $description,
	        $tags)
    or die "Could't execute statement: " . $sth->errstr;

  $sql = 'delete from tag where uri=?';
  $sth = $dbh->prepare($sql);
  $sth->execute($uri)
    or die "Could't execute statement: " . $sth->errstr;

  my @tags = split / /, $tags;
  for my $t (@tags) {
    $sql = 'insert tag (uri,tag) values (?,?)' .
           ' on duplicate key update uri=?, tag=?';
    $sth = $dbh->prepare($sql);
    $sth->execute($uri, $t, $uri, $t)
      or die "Could't execute statement: " . $sth->errstr;
  }

  $self->list;
}

これはデータベースにCGIのパラメタを保存している．bookmarkテーブルにフォームに入力されたままのデータを登録し，tagテーブルにはuriとtagの対応関係を登録する．登録が終わると，listを実行してブックマークを全件表示する．

search

sub search {
  my $self = shift;
  my $dbh = $self->dbh;
  my $q = $self->query;
  my $tag = $q->param('tag');

  my $sql = 'select uri from tag where tag=?';
  my $sth = $dbh->prepare($sql);
  $sth->execute($tag)
    or die "Couldn't execute statement: " . $sth->errstr;

  my $all_bm = [];
  while (my ($uri) = $sth->fetchrow_array) {
    my $sql2 = 'select * from bookmark where uri=?';
    my $sth2 = $dbh->prepare($sql2);
    $sth2->execute($uri)
      or die "Couldn't execute statement: " . $sth->errstr;
    my $hash_ref = $sth2->fetchrow_hashref;
    $hash_ref->{'tags'} = [map {{'name' => $_}} split / /, $hash_ref->{'tags'}];
    push @$all_bm, $hash_ref;
  }

  my $template = $self->load_tmpl('list.tmpl');
  $template->param('bookmarklist' => $all_bm);
  $template->output;
}

tagテーブルからtagに対応するuriのリストを取得し，各uriの情報をbookmarkテーブルから取得する．それをlist.tmplを用いて表示させている．