NanoAプラグインの書き方

そのまま使っても簡単にCGIが書けるNanoAですが、プラグインを書くとアプリケーションのコード全体的が見通しよくなります。

単純なプラグインの例を見ていきます。

app/plugin/hello.pm

package plugin::hello;

use strict;
use warnings;
use utf8;

use base qw(NanoA::Plugin);

sub init_plugin {
    my ($klass, $controller) = @_;

    NanoA::register_hook($controller, 'prerun', \&_prerun);
    NanoA::register_hook($controller, 'postrun', \&_postrun);

    no strict 'refs';
    no warnings 'redefine';
    *{$controller . '::hello'} = sub {
        my $app  = shift;
        my $name = $app->query->param('name');
        return 'Hello ' . $name;
    };
}

sub _prerun {
    my $app = shift;

    my $query = $app->query;
    $query->param('name' => 'World') unless $query->param('name');
}

sub _postrun {
    my ($app,$bodyref) = @_;

    $app->header( -charset => 'Shift_JIS');
}

__PACKAGE__->init_plugin(__PACKAGE__);
sub run {
    my $app = shift;
    return $app->hello;
}

1;

頭から順々に説明すると

package plugin::hello;

use strict;
use warnings;
use utf8;

use base qw(NanoA::Plugin);

NanoA::Pluginを継承して、パッケージ名をplugin::*としてapp/plugin/以下に置くことよってアプリケーションからuse plugnin::hello;として使うことが出来るようになります。
この例ではapp/plugin/hello.pmとして保存します。

sub init_plugin {
    my ($klass, $controller) = @_;

    NanoA::register_hook($controller, 'prerun', \&_prerun);
    NanoA::register_hook($controller, 'postrun', \&_postrun);

init_pluginの中でプラグインの初期化を行います。
NanoAにはprerunとposutrunというトリガーが用意されています。
それぞれにサブルーチンのリファレンスをトリガーに渡すことによってアプリケーションがそれぞれのタイミングでフックします。

    no strict 'refs';
    no warnings 'redefine';
    *{$controller . '::hello'} = sub {
        my $app  = shift;
        my $name = $app->query->param('name');
        return 'Hello ' . $name;
    };

NanoAでは型グロブを使うことによって動的にメソッドを生やします。
上の例で$はapp->helloというメソッドが使えるようになります。

__PACKAGE__->init_plugin(__PACKAGE__);
sub run {
    my $app = shift;
    return $app->hello;
}

NanoAではプラグイン自身もrunメソッドを書くことによってアプリケーションとして起動することが出来ます。
使い方やサンプル動作などに使うと良いでしょう。
ちなみに__PACKAGE__->init_plugin(__PACKAGE__);は自分自身をロードするおまじないです。

このようにNanoAでは極シンプルなフックポイントと単純なメソッド追加をすることによってプラグイン機構を実現しています。

NanoWikiでも全体的にスッキリさせるため意図的にプラグインを作って使っています。

スカラーリファレンスのbless

JPerl Advend Calendarで無名スカラーリファレンスネタをやったんだけど

さくらとかでFreeBSD6.1で

bless \do{""}, "class";

とかやるとModification of a read-only value attemptedとか言って怒られる。
CentOSとかだとだいじょぶなんだけどなー
なんでだ?

$perl -V
Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
  Platform:
    osname=freebsd, osvers=6.1-release-p20, archname=i386-freebsd-64int
    uname='freebsd www900.sakura.ne.jp 6.1-release-p20 freebsd 6.1-release-p20 #0: wed oct 17                                                                                                                                               10:22:04 jst 2007 root@www900.sakura.ne.jp:usrsrcsysi386compilesakura9 i386 '
    config_args='-sde -Dprefix=/usr/local -Darchlib=/usr/local/lib/perl5/5.8.8/mach -Dprivlib=                                                                                                                                              /usr/local/lib/perl5/5.8.8 -Dman3dir=/usr/local/lib/perl5/5.8.8/perl/man/man3 -Dman1dir=/usr/l                                                                                                                                              ocal/man/man1 -Dsitearch=/usr/local/lib/perl5/site_perl/5.8.8/mach -Dsitelib=/usr/local/lib/pe                                                                                                                                              rl5/site_perl/5.8.8 -Dscriptdir=/usr/local/bin -Dsiteman3dir=/usr/local/lib/perl5/5.8.8/man/ma                                                                                                                                              n3 -Dsiteman1dir=/usr/local/man/man1 -Ui_malloc -Ui_iconv -Uinstallusrbinperl -Dcc=cc -Duseshr                                                                                                                                              plib -Dccflags=-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -Doptimize=-O2 -fno-strict-al                                                                                                                                              iasing -pipe  -Ud_dosuid -Ui_gdbm -Dusethreads=n -Dusemymalloc=y -Duse64bitint'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=define use64bitall=undef uselongdouble=undef
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -DHAS_FPSETMASK -DHAS                                                                                                                                              _FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement',
    optimize='-O2 -fno-strict-aliasing -pipe ',
    cppflags='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATING                                                                                                                                              POINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement'
    ccversion='', gccversion='3.4.4 [FreeBSD] 20050518', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -Wl,-E'
    libpth=/usr/lib
    libs=-lm -lcrypt -lutil
    perllibs=-lm -lcrypt -lutil
    libc=, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='  -Wl,-R/usr/local/lib/perl5/5.8                                                                                                                                              .8/mach/CORE'
    cccdlflags='-DPIC -fPIC', lddlflags='-shared '


Characteristics of this binary (from libperl):
  Compile-time options: MYMALLOC PERL_MALLOC_WRAP USE_64_BIT_INT
                        USE_LARGE_FILES USE_PERLIO
  Locally applied patches:
        defined-or
  Built under freebsd
  Compiled at Nov  8 2007 08:36:03

CentOSでkeychain

最近GitHubを使っているのですが、pushのたびにパスワード入力めんどうだからこのへん見てssh-agentを使ってパスワード入力を省くようにしてました。

が、keychainを使えばさらにログイン間で共有できるようになることを今さら知りました。

CentOSではrpmforgeからyumでインストールできます。

# yum install keychain

で、.zshrcに

/usr/bin/keychain $HOME/.ssh/id_rsa
source $HOME/.keychain/$HOST-sh

とか書いておけば、ssh-agentが実行されていなかったら実行するし、されていたら自動的に使うようになってくれるので新しいシェルを上げるたびにssh-agentを上げて、パスワード入力して…といった作業から開放されます。

JPerl Advent Calendar 2008 - 4日目

事後報告。

http://perl-users.jp/articles/advent-calendar/2008/04.html

書きました。
さらっと書いたら、あらゆる方面から色んなご指摘が入って大幅加筆させていただきました。
ありがとうございました。

で、すでにupされてるけど次はid:hirose31さんで。

Red5 Streaming packets

Connection

=> [invoke] method:connect id:1 args:{"pageUrl":"http://hidek.dyndns.tv/red5/publisher.html","audioCodecs":3191,"app":"oflaDemo","videoCodecs":252,"tcUrl":"rtmp:/oflaDemo","swfUrl":"http://hidek.dyndns.tv/red5/publisher.swf","videoFunction":1,"flashVer":"WIN 10,0,12,36","fpad":0,"capabilities":15,"objectEncoding":0}
<= [invoke] method:onBWDone id:2 args:null
<= [server_bw]
<= [ping]
<= [invoke] method:_result id:1 args:null, {"level":"status","description":"Connection succeeded.","code":"NetConnection.Connect.Success"}
=> [invoke] method:_result id:2 args:null, null

Publish

=> [invoke] method:createStream id:2 args:null
<= [invoke] method:_result id:2 args:null, 1
=> [ping]
=> [invoke] method:publish id:0 args:null, "test", "live"
<= [invoke] method:onStatus id:1 args:null, {"clientid":1,"level":"status","details":"test","description":"","code":"NetStream.Publish.Start"}

Unpublish

=> [invoke] method:closeStream id:0 args:null
<= [invoke] method:onStatus id:1 args:null, {"clientid":1,"level":"status","details":"test","description":"","code":"NetStream.Play.UnpublishNotify"}
<= [invoke] method:onStatus id:1 args:null, {"clientid":2,"level":"status","details":"test","description":"","code":"NetStream.Unpublish.Success"}

Play

=> [invoke] method:createStream id:2 args:null
=> [ping]
<= [invoke] method:_result id:2 args:null, 1
=> [invoke] method:receiveAudio id:0 args:null, 1
=> [ping]
=> [invoke] method:receiveVideo id:0 args:null, 1
=> [invoke] method:play id:0 args:null, "test"
<= [ping]
<= [invoke] method:onStatus id:1 args:null, {"clientid":1,"level":"status","details":"test","description":"Playing and resetting test.","code":"NetStream.Play.Reset"}
<= [invoke] method:onStatus id:1 args:null, {"clientid":1,"level":"status","details":"test","description":"Started playing test.","code":"NetStream.Play.Start"}

Pause

=> [invoke] method:pause id:0 args:null, 1, 62309
<= [ping]
<= [invoke] method:onStatus id:1 args:null, {"clientid":2,"level":"status","details":"test","description":"","code":"NetStream.Pause.Notify"}

Unpause

=> [invoke] method:pause id:0 args:null, 0, 62309
<= [ping]
<= [invoke] method:onStatus id:1 args:null, {"clientid":2,"level":"status","details":"test","description":"","code":"NetStream.Unpause.Notify"}

Stop

=> [invoke] method:closeStream id:0 args:null
<= [ping]