勝手に添削 - WEB+DB Press Vol.32 オレオレコード版

私もWEB+DB Pressへの連載をはじめたので、同誌のますますの反映を祈ってやまないのだけど、それだけに、同誌にこういうサンプルコードがあるのは気になる。一応きちんと動くので、blogとかのentryであればこれでもよいのだけど、この手の雑誌はかなり長い間保管され、読者に何度も参照されることを考えれば、「その後」のことを考えて推敲しておく方がいいだろう。Damianも言っていたように、「ソースコードは未来の自分へのラブレター」なのだ。

という弾さんのリファクタリング結果に対し

わたしなんかよりよっぽど perl を知っている人なのだろうから機能的な
点についてはコメントしないが、はたしてこの添削後のコードはきれいなのか?

となかなか手厳しい突っ込みもあり

そうそう。なぜこのRefactor版を使わなかったかと言えば、それはこのサンプルコードがまさに書籍という容量制限の厳しいメディアに掲載されているからである。そこにおけるbest practiceは、smallest practiceであることも強く要求される。しかもこのスクリプトは、実際にはずっとカラム幅が少ないのだ。
(中略)
それにしても惜しい。「無精で短気で傲慢なプログラマ」さんは、こうした議論を進めるにあたって、サンプルコードを用意すべきであった。私のそれはきちんと動作検証までしてある(もちろんAPPIDは私のに変えてある)。少々傲慢さが足りないのではないだろうか。

という返答があったりして。

おうそうか、ということで短期短気で傲慢なおれもきてみました。いっちょここらでオレオレコードに仕立てあげてみようじゃないか、ということでグループ日記の方にもちょっと書いたけど解説つきでお送りします。

yahoo_search.cgi

#!/usr/local/bin/perl
use strict;
use warnings;
use File::Spec;
use FindBin;
use lib File::Spec->catdir($FindBin::Bin, "lib");

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Readonly;
use Yahoo::Search;

Readonly my $MYYDN_APPID => 'YahooDemo';
Readonly my $MAX_RESULTS => 10;

my $q = CGI->new;

sub search_result {
    my $q = shift;
    return unless $q->param("query");
    my $yahoo = Yahoo::Search->new({appid => $MYYDN_APPID});
    my $result = $yahoo->search(word  => $q->param('query'), limit => $MAX_RESULTS)
        or die $yahoo->errstr;
    return &format_result($result);
}

sub format_result {
    my $result = shift;
    my @html = ($result->{'totalResultsAvailable'},  "hits");
    push @html, "<ol>";
    push @html, sprintf qq(<li><a href="%s">%s</a></li>), $_->{'ClickUrl'}, $_->{'Title'}
        for @{$result->{'Result'}};
    push @html, "</ol>";
    return @html;
}

print
    $q->header(-charset => 'UTF-8'),
    $q->start_html(-lang=> 'ja',  -title=>$ENV{SCRIPT_NAME}, -encoding=>'UTF-8'),
    $q->start_form(
        -method  => 'get',
        -enctype => 'application/x-www-form-urlencoded',
    ),
    $q->textfield("query"), 
    $q->submit(-value=>"search"),
    $q->end_form(),
    search_result($q),
    $q->end_html();

lib/Yahoo/Search.pm

package Yahoo::Search;
use strict;
use warnings;
use base qw(Class::ErrorHandler Class::Accessor::Fast);

our $VERSION = 0.01;

use Carp;
use Encode qw/encode_utf8/; # to drop utf8 flag from XML::Simple
use LWP::UserAgent;
use Readonly;
use Unicode::RecursiveDowngrade;
use URI;
use URI::QueryParam;
use XML::Simple;

Readonly my $WEBAPI_BASEURL => 'http://api.search.yahoo.co.jp/';
Readonly my $WEBAPI_PATH    => '/WebSearchService/V1/webSearch';

__PACKAGE__->mk_accessors(qw(appid));

sub search {
    my $self = shift;
    my %args = @_;
    $args{word} or croak "No search keywords given";
    my $uri = $self->api_uri;
    $uri->query_param(query   => $args{word});
    $uri->query_param(results => $args{limit} || 10);
    my $res = $self->ua->get($uri);
    $res->is_success ? $self->_xml2result($res->content)
                     : $self->error($res->status_line);
}

sub ua {
    my $self = shift;
    $self->{_ua} and return $self->{_ua};
    $self->{_ua} = LWP::UserAgent->new;
    $self->{_ua}->timeout(10);
    $self->{_ua}->agent(join('/', __PACKAGE__, $self->VERSION));
    $self->{_ua};
}

sub api_uri {
    my $self = shift;
    my $uri = URI->new_abs($WEBAPI_PATH, $WEBAPI_BASEURL);
    $uri->query_param(appid => $self->appid);
    return $uri;
}

sub _xml2result {
    my $self = shift;
    my $xml  = shift or croak "No xml given";
    return Unicode::RecursiveDowngrade->new->downgrade(
        XML::Simple->new->XMLin($xml, ForceArray=>['Result'])
    );
}

1;

ツンな人から「ちょっと、長くなってるじゃないのよ!」という突っ込みがきそうです。どうみてもやり過ぎでリファクタリングの域を超えています。

検索周りのロジックは別モジュールに切り出してすっきりさせる。
モジュールは OO インタフェースにする
Unicode フラグを落とす処理は汚くなりがちなので Unicode::RecursiveDowngrade に任せる
URI->query_form ではなく URI::QueryParam で URI を段階的に作っていってみる
例外は Class::ErrorHandler を使って一応上位で処理できるようにしつつ楽してみる
むやみやたらに Class::Accessor::Fast とか使ってかっこつけてみる
use lib File::Spec->catdir($FindBin::Bin, 'lib') とかやり過ぎてみる

というわけでだいぶすっきりした(?)。がこうなってくると今時 CGI.pm で出力作ってたりするのが気持ち悪くなってくるので変更したい欲求に駆られる。ついでなのでなんとなく MVC にもしたくなってくる。

ということで更にリファクタを進める。

yahoo_search.cgi

#!/usr/local/bin/perl
use strict;
use warnings;
use File::Spec;
use FindBin;
use lib File::Spec->catdir($FindBin::Bin, "lib");
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use MyApp;

my $myapp = MyApp->new(CGI->new);
$myapp->run or die $myapp->errstr;

lib/MyApp.pm

package MyApp;
use strict;
use warnings;

our $VERSION = 0.01;

use base qw(Class::ErrorHandler Class::Accessor::Fast);
use Carp;
use Readonly;
use Yahoo::Search;
use MyApp::View;

Readonly my $MYYDN_APPID    => 'YahooDemo';
Readonly my $MAX_RESULTS    => 10;

__PACKAGE__->mk_accessors(qw(query));

sub new {
    my ($class, $q) = @_;
    $q or croak 'usage MyApp->new($cgi)';
    bless {query => $q}, $class;
}

sub run {
    my $self = shift;
    my $results;
    if (my $word = $self->query->param("query")) {
        my $yahoo = Yahoo::Search->new({appid => $MYYDN_APPID});
        $results = $yahoo->search(word  => $word, limit => $MAX_RESULTS)
            or return $self->error($yahoo->errstr);
    }
    $self->forward_to_view({
        results => $results
    });
}

sub forward_to_view {
    my $self = shift;
    my $params = shift || {};
    my $view = MyApp::View->new($self->query);
    my $body = $view->body($params) or return $self->error($view->errstr);
    print $view->header, $body;
}

1;

lib/MyApp/View.pm

package MyApp::View;
use strict;
use warnings;
use base qw (Class::ErrorHandler Class::Accessor::Fast);
use Carp;
use Template;

__PACKAGE__->mk_accessors(qw(query template));

sub new {
    my ($class, $q) = @_;
    $q or croak 'usage MyApp->View->new($cgi)';
    bless {
        query    => $q,
        template => Template->new,
    }, $class;
}

sub header {
    shift->query->header(-charset => 'utf-8');
}

sub body {
    my $self = shift;
    my $params = shift || {};
    $params->{query} = $self->query;
    my $template = $self->template;
    $template->process(?*DATA, $params, ?my $output)
        or return $self->error($template->error);
    $output;
}

1;

__DATA__
<!DOCTYPE html
	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
	 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="ja" xml:lang="ja">
<head>
<title>[% template.name %]</title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
</head>
<body>

[% USE FillInForm -%]
[% FILTER fillinform fobject => query -%]
<form method="get">
<input type="text" name="query" />
<input type="submit" value="search" />
</form>
[% END -%]

[% PROCESS search_result IF results -%]

</body>
</html>

[% BLOCK search_result -%]
<p>[% results.totalResultsAvailable %] hits</p>
<ol>
[% FOREACH r IN results.Result %]
<li><a href="[% r.ClickUrl %]">[% r.Title %]</a></li>
[% END %]
</ol>
[% END -%]

lib/Yahoo/Search.pm

前と同じ。

主にウェブアプリケーションとしての処理周りをリファクタリングした。

HTML生成部分は Template-Toolkit に任せる
MyApp が Controller / MyApp::View が View / Yahoo::Search が Model で一応 MVC

というかここまでくるといい加減フレームワーク使えよという感じになってくる。このコードの Contoller と View の一部のメソッドを抽象化した親クラスを作って Template Method でも適応すればフレームワークのできあがりだ。が、そこまでやったらコードが長くなりすぎる、雑誌の紙面にはとてもじゃないが載せられない!

そこで以下のように書き換えてみる。

package MyApp;

use strict;
use warnings;

use Catalyst;
use Yahoo::Search;

our $VERSION = '0.01';

Readonly my $MYYDN_APPID => 'YahooDemo';
Readonly my $MAX_RESULTS => 10;

__PACKAGE__->config( name => 'MyApp' );

sub default : Private {
    my ( $self, $c ) = @_;
    my $results;
    if (my $word = $c->request->param('query')) {
        my $yahoo = Yahoo::Search->new({appid => $MYYDN_APPID});
        $results = $yahoo->search(word  => $word, limit => $MAX_RESULTS)
            or $c->error(($yahoo->errstr));
    }
    $c->stash(results => $results);
    $c->forward->($c->view('TT'));
}

1;

「ちょｗCatalystｗｗｗｗ」

Yahoo! API の解説で Catalyst の解説にページ使う余裕はどこにもないYO!!

とこんなツッコミくること間違いなしな雰囲気なんだけど、それに対する解はこうです。

なお Catalyst については本誌新連載 Recent Perl World Perl フレームワークの大本命Catalyst入門をご覧ください。

自演ｋｔｋｒ!

WEB+DB PRESS Vol.32

作者: WEB+DB PRESS編集部
出版社/メーカー: 技術評論社
発売日: 2006/04/25
メディア: 単行本
クリック: 8回
この商品を含むブログ (33件) を見る

というわけで WEB+DB PRESS Vol.32 をよろしくお願いします。

まあマジレスすると、僕だったらこの最初のリファクタリング版で CGI.pm の HTML 出力を使ってるとこだけ TT にした一枚っぺらの CGI 作って載せるかなあ。