Planet Perl.jp

http://xslate.org/

ちゃんとしたプロダクトつくったら、サイトつくって紹介するべきだから、やりなはれ!と id:gfx にいったところ、「ドメインとサーバーがあればコンテンツはつくるよ」というので、ドメインとって github でグループつくって A record 設定して、ひながたを commit したら、Shibuya.pm の愉快な面々がもろもろととのえてくれたので、見栄えのいいサイトができました。

github pages は超管理が楽なのでまじおすすめ。マニュアルはここ → http://pages.github.com/

http://rakudo.org/announce/rakudo-star/2010.07

Rakudo* という Perl6 の Early Adapter むけの useful and usable distribution がでていたのでためしてみる(自分は二ヶ月に一回ぐらい rakudo をビルドしてるのでとくにめあたらしくもないですが)。

% wget http://github.com/downloads/rakudo/star/rakudo-star-2010.07.tar.gz
% tar xzvf rakudo-star-2010.07.ta
% make
% make install

r.gz

% cd rakudo-star-2010.07

% perl Configure.pl --gen-parrotみたいなかんじでセットアップ完了。楽ちんです。

実行速度は以下のようになっております。

./perl6 -e 'say "hello" for 1..100'  2.07s user 0.15s system 99% cpu 2.222 total

遅い原因としては以下の説があるようです。

• memory allocation が富豪的すぎる
• GCがよくない

cpan-outdated という、使っている CPAN module が古くないかどうかを確認できる便利なスクリプトがありますが、その cpan-outdated さんが local::lib に対応してました。

% cpan-outdated -L extlib | cpanm -L extlib

などとやると、extlib/ 以下のふるいモジュールを一気にアップグレードできます。

まあ気がむいたらやってみるといいんじゃないでしょうか。

先日、Yahoo!モバゲーのサンドボックス環境のリリースも何とかかんとかリリースいたしました。皆さん是非使って見て下さいね。*1

それはさておき8/6, 8/7は札幌で行われるイベントにお話しに行きます。

「モバゲータウン」のディー・エヌ・エー社、Japan Perl Association(JPA)から講師陣をお迎えして、北海道札幌で、 WebとPerlのテクノロジーについてのセミナーイベントを開催致します。 モバゲータウンやMovable Type で使用されているPerl言語についての講演や、オープンプラットフォームなどのWebテクノロジーについての講演を予定しております。 本セミナーは、WebやPerlといったテクノロジーを利用したビジネスやプロジェクト、コミュニティなどにご興味のあるエンジニアの方を対象としております。 Webテクノロジーセミナー in Hokkaido

Webテクノロジーセミナーではせっかくなので旬のネタであるヤバゲーの開発裏話とか OpenSocial の話、QUnit によるテストとかその辺りの事を話そうかなーとか思ってます。北海道在住の方や旅行でその時期にいらっしゃる方などふるってご参加頂けたらと思います。

次の日にあるHokkaido.pm #1 ではぐっと Perl よりの話をしようかなーと。多分テストの話になると思います。

話は変わりますが、fukuoka.pm の発起人である @sugmak さんこと杉山誠さんの訃報が突然伝えられ、ただただ驚いております。sugmak さんとは昨年の YAPC で初めてお会いしましたが、その際には YAPC のリアルタイムレポートを担当頂きました。きっとこのレポートを楽しみにされていた方も多かったのではないでしょうか。

sugmak さんのご冥福をお祈りすると同時にこの事で挫けず、fukuoka.pm がさらに盛り上がると良いなと思いました。

次の fukuoka.pm に予定が合えば参加しようかなとちょっと思ってます。

use 5.12.0;
use Text::Xslate;

my $xslate = Text::Xslate->new(
    module => ['Number::Format' => [':subs']],
    syntax => 'TTerse',
);
say $xslate->render_string('[% 100000000 | format_number %]');

こうかな。

あるいは

my $xslate = Text::Xslate->new(
    function => {
        commify => sub {
            local $_ = shift;
            1 while s/^([-+]?\d+)(\d\d\d)/$1,$2/;
            $_;
        },
    },
    syntax => 'TTerse',
);
say $xslate->render_string('[% 100000000 | commify %]');

かな。

http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2007-4829

つかってる人はアップグレードしておいた方がいいですね。

Web Application を構築するための部品が十分にそろいつつある今日この頃ですから、今となっては Web Application Framework をつかうのではなく、ライブラリの glue 部分を Code Generator で吐いてしまうのも選択肢にはいるのではないでしょうか。

というわけで、サラっとかいてみた。400行程度のジェネレータだけで、本質的なコードはない。実はこういうので十分なのではないだろうか。

(なんとなく Path::AttrRouter をつかって Catalyst 風にしてある)

一般的な Web Application の構成要素はすべてふくんでいるが、出力されるコードはおどろくほどみじかいし、実際これで十分だとおもう。

use strict;
use warnings;
use utf8;
use Getopt::Long;
use Pod::Usage;
use Data::Section::Simple qw/get_data_section/;
use Text::Xslate;
use File::Path qw/mkpath/;
use File::Basename;
use Text::Xslate::Syntax::TTerse;

GetOptions(
    'h|help' => \my $help,
);
pod2usage() if $help;
my $appname = shift @ARGV or pod2usage();

exit;

sub main {
    my $data = get_data_section();
    my $tx = Text::Xslate->new(
        path => [ $data ],
        syntax => 'TTerse',
        tag_start => '<%',
        tag_end   => '%>',
    );

    print "making $appname\n";
    (my $appdir = $appname) =~ s/::/-/g;
    mkdir($appdir);
    chdir($appdir);
    (my $path = $appname) =~ s!::!/!g;
    (my $package = $appname);

    my $opt = {
        name      => $appdir,     # My-App
        path      => $path,       # My/App
        'package' => $package,    # My::App
    };

    while (my ($fname, $val) = each %$data) {
        $fname =~ s!^\s+!!;
        $fname =~ s{\s+$}{};
        if ($val =~ /\S/) {
            print "  rendering $fname\n";
            my $dstpath = $tx->render_string($fname, $opt);
            mkpath(dirname($dstpath));

            open my $fh, '>:utf8', $dstpath or die "cannot open file: $dstpath: $!";
            print {$fh} $tx->render($fname, $opt);
            close $fh;
        } else {
            print "  mkdir $fname\n";
            mkpath($fname);
        }
    }

    system $^X, 'Makefile.PL';
    system 'make';
    system 'make', 'test';
}

=pod

=head1 SYNOPSIS

    % webapp-starter.pl MyApp

=cut

__DATA__

@@ Makefile.PL
use inc::Module::Install;
name '<% name %>';
all_from 'lib/<% path %>.pm';

requires 'Text::Xslate' => 0.1047;
requires 'Mouse';
requires 'Log::Dispatch';
requires 'parent';
requires 'DBIx::Skinny';

tests 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t';
test_requires 'Test::More';
test_requires 'YAML';
test_requires 'Test::WWW::Mechanize::PSGI';
test_requires 'Test::Requires';
author_tests('xt');
auto_include;
WriteAll;

@@ <% name %>.psgi
use strict;
use warnings;
use <% package %>::Web;
use Plack::Builder;
use Plack::MIME;

delete $Plack::MIME::MIME_TYPES->{$_} for qw/.pl .pm .yml .json/;

builder {
    enable 'Plack::Middleware::Static',
        path => qr{^/static/},
        root => './htdocs/';

    <% package %>::Web->to_app();
};

@@ lib/<% path %>.pm
package <% package %>;
use Mouse;
use <% path %>::ConfigLoader;
use Cwd ();
use <% package %>::DB;

has config => (
    is       => 'ro',
    isa      => 'HashRef',
    required => 1,
);

my $root = do {
    my $p = __FILE__;
    $p = Cwd::abs_path($p) || $p;
    (my $q = __PACKAGE__) =~ s{::}{/}g;
    $p =~ s{$q\.pm$}{};
    $p =~ s{/lib/?$}{}g;
    $p =~ s{/blib/?$}{}g;
    $p;
};
sub root { $root }

sub context { die "cannot find context" }

sub bootstrap {
    my ($class) = @_;
    my $c = $class->new(config => <% package %>::ConfigLoader->load);
    no warnings 'redefine';
    *<% package %>::context = sub { $c };
    return $c;
}

sub db {
    my ($self) = @_;
    $self->{db} ||= do {
        <% package %>::DB->new($self->config->{'DB'});
    };
}

no Mouse; __PACKAGE__->meta->make_immutable;

@@ lib/<% path %>/DB.pm
package <% package %>::DB;
use DBIx::Skinny;
1;

@@ lib/<% path %>/DB/Schema.pm
package <% package %>::DB::Schema;
use DBIx::Skinny::Schema;

# install_table user => schema {
#     pk 'id';
#     columns qw/
#     id
#     name
#     /;
# };

1;

@@ lib/<% path %>/Web.pm
package <% package %>::Web;
use Mouse;
use <% path %>;
use <% path %>::ConfigLoader;
use Text::Xslate 0.1047;
use Plack::Request;
use Plack::Response;
use Path::AttrRouter;
use Module::Find qw/useall/;
use Encode;
use Log::Dispatch;

extends '<% package %>';

useall '<% path %>::Web';

our $VERSION = '0.01';

has 'log' => (
    is => 'ro',
    isa => 'Log::Dispatch',
    lazy => 1,
    default => sub {
        my $self = shift;
        Log::Dispatch->new(%{$self->config->{'Log::Dispatch'} || {}});
    },
);

has config => (
    is       => 'ro',
    isa      => 'HashRef',
    required => 1,
);

has env => (
    is => 'ro',
    isa => 'HashRef',
    required => 1,
);

has req => (
    is      => 'ro',
    isa     => 'Plack::Request',
    lazy    => 1,
    default => sub {
        my $self = shift;
        Plack::Request->new( $self->env );
    }
);

has args => (
    is       => 'rw',
    isa      => 'ArrayRef',
);

has res => (
    is      => 'ro',
    isa     => 'Plack::Response',
    default => sub {
        Plack::Response->new;
    },
);

sub request  { shift->req(@_) }
sub response { shift->res(@_) }

sub to_app {
    my ($class) = @_;

    my $router = Path::AttrRouter->new( search_path => '<% package %>::Web::C' );
    my $config = <% package %>::ConfigLoader->load;
    sub {
        my $env = shift;
        my $c = $class->new(env => $env, config => $config);
        no warnings 'redefine';
        local *<% name %>::context = sub { $c };
        if (my $m = $router->match($env->{PATH_INFO})) {
            $c->args($m->args);
            my $meth = $m->action->name;
            $m->action->controller->$meth($c);
            return $c->res->finalize;
        } else {
            my $content = 'not found';
            return [404, ['Content-Length' => length($content)], [$content]];
        }
    };
}

my $tx = Text::Xslate->new(
    syntax => 'TTerse',
    module => ['Text::Xslate::Bridge::TT2Like'],
    path   => [__PACKAGE__->root . "/tmpl"],
);
sub default_content_type { 'text/html; charset=utf-8' }
sub default_encoding     { 'utf-8' }
sub render {
    my ($self, @args) = @_;
    my $body = $tx->render(@args);
    $self->res->status(200);
    $self->res->content_type($self->default_content_type);
    $self->res->body(encode($self->default_encoding, $body));
}

no Mouse;__PACKAGE__->meta->make_immutable;

@@ lib/<% path %>/Web/C.pm
package <% package %>::Web::C;
use strict;
use base 'Path::AttrRouter::Controller';

sub index :Path {
    my ($class, $c) = @_;
    $c->render('index.tx');
}

1;

@@ lib/<% path %>/ConfigLoader.pm
package <% path %>::ConfigLoader;
use strict;
use warnings;
use File::Spec;
use Cwd ();
use <% package %>;

sub load {
    my $class = shift;
    my $env = $ENV{PLACK_ENV} || 'development';
    my $fname = File::Spec->catfile(<% package %>->root(), 'config', "${env}.pl");
    my $conf = do $fname or die "Cannot load configuration file: $fname";
    return $conf;
}

1;

@@ tmpl/
@@ tmpl/index.tx
[% INCLUDE 'include/header.tt' %]

[% INCLUDE 'include/footer.tt' %]
@@ tmpl/include/header.tt
<!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">
<head>
    <meta http-equiv="content-type" content="text/html; charset=utf-8" />
    <title><% name %></title>
    <meta http-equiv="Content-Style-Type" content="text/css" />  
    <meta http-equiv="Content-Script-Type" content="text/javascript" />  
    <link href="/static/css/app.css" rel="stylesheet" type="text/css" media="screen" />
</head>
<body id="[% IF bodyID %][% bodyID %][% ELSE %]Default[% END %]">
    <div id="Container">
        <div id="Header">
            <a href="/"><% name %></a>
        </div>
        <div id="Content">
@@ tmpl/include/footer.tt
        </div>
        <div class="clear-both"></div>
    </div>
</body>
</html>
@@ sql/
@@ t/

@@ t/Util.pm
package t::Util;
use strict;
use warnings;
use parent qw/Exporter/;
1;

@@ t/01_router.t
use strict;
use warnings;
use Path::AttrRouter;
use Test::More;
use <% package %>::Web;

my $router = Path::AttrRouter->new( search_path => '<% package %>::Web::C' );
ok $router->match('/');

done_testing;

@@ t/02_mech.t
use strict;
use warnings;
use Plack::Test;
use Plack::Util;
use Test::More;
use Test::Requires 'Test::WWW::Mechanize::PSGI';
use t::Util;

my $app = Plack::Util::load_psgi '<% name %>.psgi';

my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
$mech->get_ok('/');

done_testing;

@@ xt/
@@ htdocs/
@@ htdocs/static/img/
@@ htdocs/static/js/
@@ htdocs/static/css/app.css
/* place holder */

@@ script/dummy.pl
use strict;
use warnings;
use <% package %>;

my $c = <% package %>->bootstrap;

...

@@ config/development.pl
+{
    'Log::Dispatch' => {
        outputs => [
            [ 'Screen', min_level => 'warning' ],
        ]
    }
}
@@ config/production.pl
+{
}

use strict;
use 5.10.0;

{
    package xai;
    use constant {cron => 1 };
}

given (2) {
    when (xai->cron) {
        print "FAIL\n";
    }
}

これは FAIL と出力する。when の中におけるメソッドコールは、その返り値の boolean 値そのものが評価値として利用され、

when ($_ ~~ xai->cron) { }

相当にはならないのだ。

ちょっとはまるかも。

午後、Rさんが府立図書館へ本を返す必要があるというので、ついでに岡崎探訪。用事を済ませて、二条から岡崎通を上がった蕎麦とうどんのお店「岡北」へ。冷やし山かけうどん、親子丼のミニ丼、冷やし中華をいただく。うどんは、麺に腰がありつつもとてもつるつるしていて、食べていて気持ちがいい。お出汁もさっぱり、かつ、しっかり風味が出ていていい感じ。親子丼は、卵がやたらぷりぷりしていて、どうやって作ったのかさっぱり謎な感じなのだけど、そんなことはどうでもよくて、おいしい。冷やし中華は、前日にいただいた冷やし担々麺が大しておいしくなかったこともあって、なおさらおいしく感じられた。ともあれ、いただいたものが全部おいしくて、感激。

岡北

• ジャンル：うどん
• 住所： 京都市左京区岡崎南御所町34
• このお店を含むブログ (1件) を見る
• (写真提供：フェリー)

先日訪ねた時は、普通にお茶をいただきにいったものの、うつわの展示即売会が行われていて、うつわが好きなのでそれはそれでいいのだけど、お茶をいただけなくてちょっと残念だった好日居に、せっかく岡崎にきたのだからってんで、再度よってみる。結果、またしても蚤の市とのことで、ゆっくりお茶をいただける感じではなかった……。

好日居

• ジャンル：喫茶店
• 住所： 京都市 左京区 岡崎円勝寺町91-82
• このお店を含むブログ (1件) を見る
• (写真提供：京都のきょう)

さて、どこ行こうかってんで、とりあえず神宮道へ出ると、きねや岡崎店にて「京うつわ 阿以波展」などという催しをやっているのを見つけた。Rさんは、ずっとここのうちわが欲しかったのだといって、大興奮。確かに、なかなか素敵なものが多くて、うちわを2枚、うちわ立てを購入。思わぬ出費だったけど、よい買い物。

それにしても暑い。歩いているだけで暑さに体力を奪われていくので涼を取ろうと、四条河原町、かき氷をいただこうというわけで「弥次喜多」へ。2階へ通されたのだが、クーラーが入っておらず、わりと往生する。が、僕らにはいましがた購入したばかりのうちわがある!!1ってんで、風情のある日本建築で、うちわを扇いで風を受けつつかき氷をいただくのは、それはそれで趣のある感じであった。

弥次喜多

• ジャンル：甘味処
• 住所： 京都市下京区四条河原町下ル三筋目東入ル北市之町240-2
• このお店を含むブログ (1件) を見る
• (写真提供：Atty)

帰宅して、買ってきたうちわをしつらえてみると、なかなかかわいらしくていい感じ。

夕食。僕はとうもろこしの天麩羅を作ったのだけど、なかなかうまく行かず難儀をした。難しい。しかしまあ、とうもろこし自体がおいしいので、味はまあまあだった。次はもっと上手に作りたいところ。ところで、Rさんが作ったゆで鶏がとてもおいしくて、胸肉ってあんまり好きではないのだけど、これはとてもやわらかくぷりぷりしていて、とてもよかった。

昨日の山鉾巡行と同時に梅雨が明け、異常に暑い。昼食はさっぱりと。盛り付けが微妙な感じだ……。

• 鶏ささみのレモン焼き
• きゅうり、トマト、鶏ささみのサラダ
• たまねぎとニンジンのスープ

たまった洗濯などを片付ける。日射しが強い分、洗濯ものがすぐに乾くのはいいですね。

夜、二条に「借りぐらしのアリエッティ」を観にでかける。その前に「大鵬」で食事を、と思ったけど満席でひとが溢れていたので諦めて、ViViの中のなんとかいう中華料理屋さん。

「アリエッティ」は、家政婦のオバサンがやたら腹立たしく描かれていて鬱陶しい気分にさせられる以外は、あっさりとした映画だった。

ところで、最近ベランダ菜園を始めて、バジルとパクチーを育て始めました。植物を育てること自体に興味はあるのだけど、いかんせん根気が続かないので、食べられるものを。バジルはすぐに芽が出たのだけどパクチーは全然出なくてやきもきしていたのが、いったん出始めるとどんどん伸びるので楽しい。早く食べられるぐらい大きくなってほしい。楽しみ。写真の手前がバジル、奥がパクチー。

夜は吉井勇の『東京・京都・大阪』を読んだり。面白エピソードがいっぱい。

東京・京都・大阪 (平凡社ライブラリー)

• 作者: 吉井勇
• 出版社/メーカー: 平凡社
• 発売日: 2006/07/11
• メディア: 単行本（ソフトカバー）
• クリック: 2回
• この商品を含むブログ (8件) を見る

恵文社一乗寺店で行われている「うつわハートフル展 　器はもっと、愛おしい。 - 恵文社一乗寺店｜スタッフ日記」へ。「ハートフル」ってどうなの。。。とか思ってたのだけど、好きな作家さんのものが多く出ていたので、けっこう買ってしまった。村田森さん、尾形アツシさんなど。

おなかがすいたので、恵文社にほど近い「つばめ」でごはん。

つばめ

• ジャンル：カフェ
• 住所： 京都市左京区一乗寺払殿町30-2
• このお店を含むブログ (1件) を見る
• (写真提供：kuroks)

先日行った時にはお休みだったので、今度こそってんで、壬生の骨董屋さん「幾一里」へ。今度は開いていて、よかった。おじいさんの代から住んでいらっしゃる町屋を改装したという店内は、うつわはもちろん、古布や板切れなどいろいろとあるものが、どれも素敵な感じで、とてもよかった。古伊万里の真っ白なそば猪口を購入。またちょくちょく寄らせてもらいたいと思う。

夜は、さっそく購入した猪口で晩酌。竹鶴、しばらくおいておいたら味がまろやかになってきて、よくなった。おいしい。