例えば任意のサイトのサマリを作りたい時、HTMLをテキスト化して一定文字数で削る訳ですが、どこからどこまでが本文かはそのサイト製作者の意図する所であってなかなか難しい処理かと思います。

今回ご紹介するHTML::ExtractContentはHTMLの内容を判断しコンテンツの本文らしき部分を抜き出せる凄いモジュールです。

ソースを見ましたがテキストに含めるかどうかの閾値が設定されており、かつ句読点まで判断しています。ソースはutf-8で書かれており、おそらく作者は日本人(もしくは日本通)かと思われます。

試しに先日の記事URLから本文を抜き出してみたいと思います。

use strict;
use warnings;
use HTML::ExtractContent;
use LWP::UserAgent;

my $agent = LWP::UserAgent->new;
my $res = $agent->get('http://perl-mongers.org/2008/09/template-refine.html');

my $extractor = HTML::ExtractContent->new;
$extractor->extract($res->decoded_content);
print $extractor->as_text;

コードもこれだけ。そして実行結果。

Template::Refineというモジュールを見つけました。リンク先にある通り、ruleを使うことで簡単にテンプレートの値を置き換える事が出来ます。このモジュールの良い所は、テンプレートファイルにテンプレートエンジン専用の識別子を記述しなくて良い所。どうやって指定するかというと、XPathを使います。リンク先から引用すると
my $username = 'Test User';
my $rule = simple_replace {
my $node = shift;
return replace_text $node, $username;
} '//*[@class="username"]';
といった感じにルールを決め
$frag = $frag->process($rule);
say $frag->render;
と実行する事でテンプレートへの反映が行われます。まるでWeb::Scraperの様ですね。
今日はサンプルとして、美輪明宏のチンコの有無を返すAPIから得た結果をテンプレートに反映してみたいと思います。
まずテンプレート
<p>美輪明宏にチンコは...<span class="miwa">...</span>。</p>
確かにテンプレート専用の識別子は使用していません。そしてperlのコード
use strict;
use warnings;
use Encode;
use Perl6::Say;
use LWP::Simple;
use JSON;
use Template::Refine::Fragment;
use Template::Refine::Utils qw(replace_text simple_replace);
my $miwa = from_json(get "http://dzfl.jp/mojo/");
my $rule = simple_replace {
my $node = shift;
return replace_text $node, encode_utf8($miwa->{miwa} ? 'ある' : 'ない');
} '//*[@class="miwa"]';
my $frag = Template::Refine::Fragment->new_from_file('template.html');
print $frag->process($rule)->render;
HTMLのmiwaというクラス属性を持ったノードに対して"ある"/"ない"というテキストで置換しています。
簡単ですね。テンプレートエンジン専用の識別子を使用しないので、HTMLの属性値さえ決めておけば、テンプレートの殆どをデザイナさんに任せてしまう事も出来る様になります。
すばらしいですね。

ちゃんと本文が取れています。ヘッダ部やページ右にあるナビゲータの文字は含まれていません。

すばらしいですね。他のアプリケーションにも簡単に取り込めそうですし期待が膨らみます。

どなたかこれを使ったウェブサービスを作ってみませんか。

my $username = 'Test User';
my $rule = simple_replace {
    my $node = shift;
    return replace_text $node, $username;
} '//*[@class="username"]';

といった感じにルールを決め

$frag = $frag->process($rule);
say $frag->render;

と実行する事でテンプレートへの反映が行われます。まるでWeb::Scraperの様ですね。

今日はサンプルとして、美輪明宏のチンコの有無を返すAPIから得た結果をテンプレートに反映してみたいと思います。

まずテンプレート

<p>美輪明宏にチンコは...<span class="miwa">...</span>。</p>

確かにテンプレート専用の識別子は使用していません。そしてperlのコード

use strict;
use warnings;
use Encode;
use Perl6::Say;
use LWP::Simple;
use JSON;
use Template::Refine::Fragment;
use Template::Refine::Utils qw(replace_text simple_replace);

my $miwa = from_json(get "http://dzfl.jp/mojo/");
my $rule = simple_replace {
    my $node = shift;
	return replace_text $node, encode_utf8($miwa->{miwa} ? 'ある' : 'ない');
} '//*[@class="miwa"]';

my $frag = Template::Refine::Fragment->new_from_file('template.html');
print $frag->process($rule)->render;

HTMLのmiwaというクラス属性を持ったノードに対して"ある"/"ない"というテキストで置換しています。

簡単ですね。テンプレートエンジン専用の識別子を使用しないので、HTMLの属性値さえ決めておけば、テンプレートの殆どをデザイナさんに任せてしまう事も出来る様になります。

すばらしいですね。

今回 Atompub サーバを書くことになり、一番まともな実装(Catalyst::Controller::Atompub) がある Perl を使うことにしました。

Catalyst::Controller::Atompub を使うからには当然 Catalyst を使うことになるわけですが、2年振りにPerlを書いたことと、フレームワークの流儀も全く解っていなかったことから結構ハマりました。以下では、それを脈絡なく書いていこうと思います。普段PHP使いだからって石を投げないでくだしあ( ;´Д⊂ヽ

Catalystを学ぶにあたって

「perl Catalyst」でぐぐったところ、まとまった記事がすぐに出てこなかったことから、私は Catalyst::Manual::Tutorial を順に読んでいろいろ試していきましたが、後で調べたら はじめてのCatalyst というマニュアルの翻訳を見つけました。MVCフレームワークに触れたことがある人には、凄くいい資料ではないでしょうか。Catalystクックブック も素晴らしいです。

以下では、こうして学びながら特に引っ掛かった点をピックアップして書いていきます。

Catalystのインストール

環境は Debian GNU/Linux etch を使いました。これには、既にパッケージとして libcatalyst-perl (5.7.006)等が用意されていますが、lazy-people.org の tomyheroさん から

(tomyhero) install Task::Catalyst
(tomyhero) install HTML::Parser
(tomyhero) install Template
(tomyhero) install Encode
(tomyhero) この辺ふるいのはいってると、文字コード周りでgdgdになる。
(tomyhero) FYI

という有難い情報があったので、CPAN から直接インストール(執筆時点での最新版は 5.7014) することにしました。256MBしか割り当てていないバーチャルマシン上での作業なので予想はしてたんですが、上の Task::Catalyst, HTML::Parser, Template, Encode を最新にするのに1時間掛かりました。依存関係でいろいろ聞かれたりしますが、「y」で通して（たぶん）大丈夫です。個人的には XML::LibXML が XML::LibXML::Common を先にインストールしてくれなくてエラーになったりしましたが、もう一度 XML::LibXML::Common -> XML::LibXML の順でインストールし直すと大丈夫でした。

最後に、肝心の Catalyst::Controller::Atompub のインストールです。これに30分。

これは滞りなくいきました。CPANから多数のモジュールをインストールするとなると、非常に時間が掛かるものですが、「y」を押しながら気長に他のことをしましょう。

# perl -MCPAN -e shell
cpan> install Catalyst::Runtime Catalyst::Plugin::ConfigLoader Catalyst::Plugin::Static::Simple Catalyst::Model::DBIC::Schema DBIx::Class::Schema::Loader DBD::SQLite Catalyst::View::TT Catalyst::Controller::Atompub Catalyst::Action::RenderView

インストールが終わったら、プロジェクトを作りましょう。今回は説明のため、Sample というプロジェクトにします。

$ catalyst.pl Sample
(....ディレクトリ構造とか最低限の雛形とかいろんなものが生成される)
$ cd Sample/

プロジェクトを作ったあとは、一応動作確認しておきます。Catalyst には、開発用のWebサーバが用意されています。以下のようにして起動します。

$ script/sample_server.pl
.....  Sampleプロジェクトの情報がずらずらと表示
[info] sample1 powered by Catalyst 5.7014
You can connect to your server at http://example.com:3000

無事起動したら、http://example.com:3000 にブラウザからアクセスしてみましょう。

以下のような画面にアクセスできるはずです。この開発用サーバ起動の操作は何度も使うことになります。

URLルーティング

Webアプリケーションフレームワークを実際に使うにあたって、私がまず関心を持つのはURLルーティング、すなわち「特定のURLに対応した処理をどこに書くか」ということです。Catalystにはこの点で多彩なやり方が用意されており、多少混乱しました。

Catalyst では コントローラー にURLに対応した処理をサブルーチン(関数)として記述します。まずは適当にコントローラーを生成します。script/sample_create.pl が様々な雛形を自動で生成してくれるようになっていますので、それを利用します。

$ script/sample_create.pl controller hello
 exists "/home/mumumu/Sample/script/../lib/Sample/Controller"
 exists "/home/mumumu/Sample/script/../t"
 created "/home/mumumu/Sample/script/../lib/Sample/Controller/hello.pm"
 created "/home/mumumu/Sample/script/../t/controller_hello.t"

hello コントローラーが追加されました。lib/Sample/Controller/hello.pm を開き、podの部分を除いた(間違っても use strict, use warnings は除かないように！)部分は以下のようになっています。ここでは、sub index ... の部分に注目します。

(lib/Sample/Controller/hello.pm)

package Sample::Controller::hello;

use strict;
use warnings;
use parent 'Catalyst::Controller';

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    #
    #    http://example.com/hello/ や http://example.com/hello へのリクエスト
    #    に対して、「Matched Sample::Controller::hello in hello.」を表示する。
    #
    $c->response->body('Matched Sample::Controller::hello in hello.');
}

1;

indexって何か意味あるの？ それ以前に :Path とか :Args とか Perlの文法的にアリなの？ と調べること2時間。:Path や :Args は アトリビュート と呼ばれる、属性を変更するハンドラを呼び出すためのおまじないみたいですが、ここは黒魔術だと思ってあまりキニシナイことにしました。とりあえず、「:ほげほげ」をサブルーチン名の後に書くことで、ルーティングのやり方を指定できるようです。このほげほげを Catalyst の世界ではアクションと呼ぶようです。

上の 「index :Path :Args(0)」のアクション指定は、 Catalyst にビルトインされた特別なアクションで、http://example.com/hello/ や、http://example.com/hello のように、パッケージ名から、Controllerまでの部分を除いたもの(ここではhello) のあとに引数を何も与えなかった場合に呼び出されるアクションらしいです。

また、サブルーチンの引数について説明をしておくと、第1引数 $self は、Sample::Controller::hello オブジェクト(オブジェクト指向でいうところの this) です。 第2引数に $c が指定されていますが、これは「コンテキストオブジェクト」というもので、ここからリクエストやレスポンスのオブジェクトはもちろん、データベース操作に使えるModelなど、Webアプリケーションにおける処理に必要な様々なオブジェクトを取り出すことができます。アクション指定をしたサブルーチンの引数には必ずこの $c がついている（はず）ですので、様々な操作が行えるはずです。

私が主に使ったアクションを「ちょっとだけ」以下に並べておきます。正直たくさんあって参りました。

ここでアクション指定をすべて説明はできないので、詳細はマニュアルにあるアクションの一覧 を見るとよいと思います。私自身も未だによくわかってないアクションがかなりありますネ(´ー｀; )

package Sample::Controller::hello;
#
#  Path アクション
#  
#  Path の引数の先頭にスラッシュを入れないと、パッケージ名から Controller まで
#  を除いた部分(ここではhello) からの相対URLにマッチする。
#  以下の場合は http://example.com/hello/foo/bar や、
#  http://example.com/hello/foo/bar/baz などのリクエストに対して hoge が呼ば
#  れる。
#  
#  これに対して:Path('/foo/bar') として先頭にスラッシュを入れると、絶対指定となり、
#  http://example.com/foo/bar や、http://example.com/foo/bar/baz などが呼ばれたと
# きに hoge が呼ばれる
#
sub hoge :Path('foo/bar') {
    # ....
}

#
#  Regex アクション
#  
#  パッケージ名に関係なく、マッチするURLを正規表現で指定する
#  以下の場合は、http://example.com/foo/hoge としたときは サブルーチンhoge
#  が呼ばれるが、http://example.com/hoge では呼ばれない
#
sub hoge :Regex('^(\w+?)/hoge') {
    # ....
}

package Sample::Controller::hello;
#
#  Local アクション
#  
#  URLが、必ずパッケージ名から、Controllerまでの部分を除いたもの
#  (ここではhello) で始まり、あとにサブルーチン名が続いたものにマッチすること
#  を指定する。
#
#  以下の場合は、http://example.com/hello/hoge/foo や 
#  http://example.com/hello/hoge としたときに、サブルーチンhoge
#  が呼ばれるが、http://example.com/hoge では呼ばれない
#
sub hoge :Local {
    # ....
}

#
#  default アクション
#
#  どのアクションにもURLがマッチしない場合に呼ばれる。404ページやエラーページ
#  の作成に便利
#
sub default :Private {
    # ....
}

データベース操作

さて、アクション指定をしたサブルーチン内では、マッチしたURLに対して様々な操作ができることがわかりました。URLルーティングに続いて、私が次に関心を持つのは、Webアプリケーションに欠かせないデータベースの操作です。Catalyst ではどうしたらいいのでしょうか？

以下、順を追って説明したいと思います。なお、私は今回 sqlite3 を使いました。

まずはデータベースの構造（スキーマ）です。本当は Atompub 用のスキーマを書きたいのですが、そこは割愛して、説明のための簡単なスキーマを作ります。

$ cd Sample
$ sqlite3 sample.db
SQLite version 3.5.9
Enter ".help" for instructions
sqlite> CREATE TABLE sample (
     ...>   id            INTEGER PRIMARY KEY,
     ...>   sample_text        TEXT
     ...>);
sqlite>

次にデータベースにアクセスするための Model クラスを作ります。Perl では、ORM(Object Relational Mapping) という、DBアクセスを楽にプログラムから行うためのモジュールとして、DBICというものがあります。ここではそれを利用するように指定してクラスを生成します。コントローラーを作ったときと同じく、script/sample_create.pl を使います。

script/sample_create.pl への引数として、いろいろごちゃごちゃと指定していますが、順番に以下の表の通りです。

 $ script/sample_create.pl model DB DBIC::Schema Sample::Schema create=static dbi:SQLite:sample.db 
 exists "/home/mumumu/Sample/script/../lib/Sample/Model"
 exists "/home/mumumu/Sample/script/../t"
Dumping manual schema for Sample::Schema to directory /home/mumumu/Sample/script/../lib ...
Schema dump completed.
created "/home/mumumu/Sample/script/../lib/Sample/Model/DB.pm"
created "/home/mumumu/Sample/script/../t/model_DB.t"

いろいろと生成されたようです。具体的には、lib/Sample/Schema/Sample.pm に、テーブルの定義がdumpされてクラスが自動生成されているのがわかると思います。また、lib/Sample/Schema.pm には、スキーマをロードするクラス、そしてlib/Sample/Model/DB.pm には、DBの接続設定が書かれているようです。皆さんの目で確認してみて下さい。

これらを使って、Perlプログラムからレコードを挿入してみます。URLルーティングのところで説明した、hello コントローラーを以下のように書き換えてみます。

(lib/Sample/Controller/hello.pm)

package Sample::Controller::hello;

use strict;
use warnings;
use parent 'Catalyst::Controller';

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    #    自動生成した sample スキーマクラスを使って sample_text カラムに
    #    挿入する 
    $c->model('DB::sample')->update_or_create({
        sample_text => 'im catalyst newbie. testing hello!',
    });

    #
    #    http://example.com/hello/ や http://example.com/hello へのリクエスト
    #    に対して、「Matched Sample::Controller::hello in hello.」を表示する。
    #
    $c->response->body('Matched Sample::Controller::hello in hello.');
}

1;

自動生成したクラスは、「$c->model('スキーマ名')->DBアクセスのメソッド」 のようにして使います。上記の例では DB::sample がスキーマ名で、 DBアクセスのメソッドとして update_or_create を使っています。とりあえずこの使い方は「おまじない」のようなもの、としておきましょう。

しかし、「DBアクセスのメソッド」は他にもたくさんあるはずです。SELECT や DELETE, UPDATE とか、、それらの詳細については、DBIX::Class::Manual 等を参考にしてみてください。

書き換えたあと、プロジェクトを作り、動作確認したときの要領で開発用サーバを起動し、http://example.com:3000/hello にアクセスしてみましょう。相も変わらず「Matched Sample::Controller::hello in hello.」と表示されるだけですが、データベースの中身は変わっています。ちょっと確かめてみましょう。

$ sqlite3 sample.db
SQLite version 3.5.9
Enter ".help" for instructions
sqlite> select * from sample;
1|im catalyst newbie. testing hello!  <- 挿入されたレコード！
sqlite>

1番のidで、im catalyst newbie. testing hello!　と挿入されているのがわかると思います。これは lib/Sample/Controller/hello.pm の indexアクションに書いたものです。

sqliteに関する注意点

sqlite は単一ファイルにデータベースの情報を格納します。よって、Webサーバ経由でPerlからアクセスする場合は、sqliteコマンドで作ったファイル(ここではsample.db) がWebサーバの権限で読み書きできなければいけません。「Unable to Open Database!」のようなエラーが出る場合は、この点を真っ先に疑うようにしましょう。

また、こうした問題は往々にして sample_server.pl を使った開発サーバにおいてよりも、Apache + mod_perl のような、デプロイ後の環境で往々にして起こりがちです。パーミッションとdbファイルのパスはきちんと確認しておくようにしましょう。

Catalyst と sqlite は面倒な関係にあるようです。lazy-people.org の tomyhero氏は以下のようにIRCで叫んでいました。

 (tomyhero) sqliteで十分ではなくて、sqliteのほうが
 (tomyhero) めんどうなんだお！
 (tomyhero) myssqlとかつかったほうがいいお

その他びっくりしたこと、小さな疑問等（ひとりごと的に）

• DBIC と DBIx::Class って同じものかどうか未だに区別がつかない
• 入力の validate はどこに書けばいいの？と思ったら、validateのフローはばっさりカットされているようだ。型にハマったLazyな方法ないかしら
• 設定ファイルは 2方式あるらしく、Catalyst::Manual::Tutorial では、Apacheの設定ファイルライクな方式が使われていた。どっちがいいんだろうねーと思いつつ、結局慣れ親しんだyamlに走った
• デプロイしてみて、動かすのにこれだけ苦労したのは久しぶりかも。SSLを絡めたらとたんにfastCGIで動かなくなったりとかあったけど、最終的には Apache + mod_perl2 に落ち着いた

とりあえずのおわり

あれ、View はどうしたの？ とか、Atompubの記述が全く出てこないぢゃないかとか、いろいろツッコミどころはあるとは思いますが、長くなってきたので今回はこの辺で。。ということで(´ー｀; ) View 以外にも Basic 認証についても結構ひっかかったりしたので、それについても機会があったら書きたいと思います。

最後に、lazy-people.org の皆さんには多くの助言を頂きました。この場を借りて御礼申し上げます。

のダイジェスト。

Scalarによるデフォルト値

sub num{
    my $num = shift || -1; 
    # ....
}

0や''を入力値として用いたい場合は

sub num{
    my $num = shift;
    $num = -1 if not defined $num;
    # ....
}

Perl 5.10.0 以降なら

sub num{
    my $num = shift // -1;
    # ....
}

Hashによるデフォルト値

以下で一発!

sub conf{
    my %arg = (
        lang => 'perl',
        rank => 1,
        @_ # ここが決め手!           
    );
    # ...
}

オブジェクトをnewしたいなら、以下がお手軽。

package A::Module
sub new{
    my $pkg = shift;
    bless {
        lang => 'perl',
        rank => 1,
        @_
    }, ref $pkg || $pkg;
}

Dan the Perl Monger

今回の流れは、

• とりあえず投稿できるスクリプトを作ってみる
• コマンドラインから投稿できるものにグレードアップ

となっています。

とりあえず投稿できるスクリプトを作ってみる

まず、固定文字列だったらこんな感じで。「もへもへ」という文字列を投げます。username、passwordは自分のを使おう。

Filename:twit_test.pl　(UTF-8で)

#!/usr/bin/perl
use strict;
use warnings;
use Net::Twitter;
my $twit = Net::Twitter->new(
  username => 'username',  #ユーザー名
  password => 'password',  #パスワード
);
$twit->update('もへもへ');

実行すると、Twitterに投稿されるはずです。文字化けしてたら、おそらく文字エンコーディングがUTF-8以外です。UTF-8で保存し直すか、Encodeモジュールで適切に変換してあげましょう。

コマンドラインから投稿できるものにグレードアップ

上のスクリプトを生かして、コマンドラインからの文字列を投稿するスクリプトに改造します。今回はタイプ量減らしたいので、コンソールがUTF-8の場合に限定。他の環境の場合、Encodeモジュールやらなにやら使用のこと。

Filename: twitter

#!/usr/bin/perl
use strict;
use warnings;
use Net::Twitter;
my $twit = Net::Twitter->new(
  username => 'username',  #ユーザー名
  password => 'password',  #パスワード
);
$twit->update($_) for @ARGV;

上記twitterというファイルに実行権限を与えておいて、個人用実行ファイルを置くディレクトリ（$HOME/bin とかにpath通しておくと便利）に入れるとかしておくと、

$ twitter エロス

とか

$ twitter 'エロス カワユス'

とかで投稿できます。

今回のスクリプトを改造して、定期的にビーコン打ち出すとか、作業が終わったらnotify出すとか応用できます。ちょっと考えたら、うちの業界のサーバには、製版が終わったらメールを送信する機能が付き始めていますが、こういうのもついていてもいいかとも思いました。

※調子こいて投稿しまくっていると連投制限に引っかかるみたいなので注意しましょう。