てきとうなメモ

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

CGI::Application (2)

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を用いて表示させている.