Perl の autobox で遊ぶ - naoyaのはてなダイアリー

autobox を使ったコードをここ最近よく見たので、ややいまさらですが自分もすこし遊んでみました。autobox は Perl の組み込みのデータ (bless されていないスカラー、リスト、ハッシュほか) をファーストクラスオブジェクトとして扱うための機構を提供するモジュール(レキシカルプラグマ)です。

#!/usr/local/bin/perl
use strict;
use warnings;
use FindBin::libs;

use autobox;
use autobox::Core;
use autobox::Encode;

use autobox::Hatena::Feed;
use autobox::Accessor;

shift->b(qw/perl autobox/)->items->foreach(sub { $_[0]->title->encode('utf-8')->say });

と、Perl にしては奇怪なシンタックスに見えますが、ちゃんと動きます。items->foreach(sub {...}) をもう少し手軽に書くために Ruby のブロック相当のシンタックスが欲しくなります。

このスクリプトを実行すると

% perl hatena.pl naoya
猫的怠惰Days - autobox::Core
autoboxがかっこいい件 - はこべにっき#
Journal of miyagawa (1653) - ActiveSupport equivalent to Perl
autobox::Encode 0.01 released - TokuLog 改め だまってコードを書けよハゲ

という結果が帰ってきます。http://b.hatena.ne.jp/naoya/perl/autobox/ のフィードを取得して各アイテムのエントリを出力しています。"naoya"->b で b:id:naoya のフィードが取れますが、これを "hatenacinnamon"->d にすると d:id:hatenacinnamon のフィードが取れます。*1

作ったモジュールは二つです。一つははてな id のスカラーに対して autobox な a, b, d, f, r メソッド = それぞれのサービスのフィードをとって処理する、を追加する autobox::Hatena::Feed です。

package autobox::Hatena::Feed;
use strict;
use warnings;
use autobox;

use Carp qw/croak/;
use URI;
use URI::Fetch;
use URI::QueryParam;
use XML::RSS::LibXML;

for my $service (qw/antenna bookmark diary fotolife rss/) {
    no strict 'refs';
    my $sym = substr($service, 0, 1);

    *{"SCALAR::$sym"} = *{"SCALAR::$service"} = sub {
        my $id = shift;

        my $uri = URI->new_abs("/$id/rss", "http://$sym.hatena.ne.jp/");
        $uri->query_param(tag => @_) if @_;

        my $res = URI::Fetch->fetch($uri)
            or croak sprintf "%s (%s)", URI::Fetch->errstr, $uri;

        my $rss = XML::RSS::LibXML->new;
        $rss->parse($res->content);
        $rss;
    };
}

1;

もう一つは XML::RSS::LibXML のパース結果は生ハッシュですので通常 $entry->{title} というアクセスになりますが、これを Template Toolkit のように $entry->title でアクセスしたい、そのための autobox::Accessor です。

package autobox::Accessor;
use strict;
use warnings;
package HASH;

use autobox;

our $AUTOLOAD;
sub AUTOLOAD {
    (my $key = $AUTOLOAD) =~ s!.+::!!;
    return if $key eq 'DESTOROY';

    {
        no strict 'refs';
        *$AUTOLOAD = sub { $_[0]->{$key} };
    }

    goto &$AUTOLOAD;
}

1;

HASH::AUTOLOAD をいじるというやや強引な実装です。

おまけ

autobox::Path::Class というのも作ってみました。

#!/usr/local/bin/perl
use strict;
use warnings;

use FindBin::libs;

use autobox;
use autobox::Core;
use autobox::Path::Class;

"/etc/passwd"->openr->getline->print;

が

% perl path.pl
root:x:0:0:root:/root:/bin/bash

という結果を返します。

package autobox::Path::Class;
use strict;
use warnings;

use autobox;
use Path::Class;
use Class::Inspector;

for my $method (grep { $_ ne 'new'} @{Class::Inspector->methods('Path::Class::File', qw/public/)}) {
    no strict 'refs';
    *{"SCALAR::$method"} = sub {
        Path::Class::File->new($_[0])->$method;
    };
}

1;

Class::Inspector で public なメソッドをとってきて、SCALAR のシンボルに代入しているだけです。作ってはみたものの autobox で Path::Class::Dir と Path::Class::File 両方をどううまく扱うかいいアイデアが思い浮かびません。結局 file(...)->openr という普通の使い方がベターのようで、このモジュールはボツ気味です。

参考 URL

この参考 URL のリストのはてな記法は

"naoya"->b(qw/perl autobox/)->items->reverse->foreach(
    sub {
        printf "- [%s]\n",  $_[0]->link->concat(":title");
    }
);

として生成しました。

*1:タグで絞り込む機能はブックマークのみ