金曜日, 12月 22, 2006

[Perl]Exporter::Global-任意の関数をグローバルにエクスポートする

[Perl]useなしでどこでもDump(@INCにオブジェクトを格納するパターン)でやった@INCにオブジェクトを格納するコードを使って任意関数をグローバルにエクスポートするモジュールを作ってみました。名づけてExporter::Global

例えばErrorモジュールのtry catchを使いたいけどuse Error qw(:try)するのが面倒だとか、アプリケーション内で標準で使うことにしているようなケースで以下のようにしておくとどこでもtry - catch構文が使えるようになります。

# まずはエクスポートしたい関数を定義(またはインポート)する
use Error qw(:try)
# Exporter::Globalにエクスポートしたい関数を渡す
use Exporter::Global qw(try finally with);
# これ以降ロードされるモジュールではすべてtry catchが使える
no Exporter::Global; # Exporter::Globalをオフにする

また、;で区切ってエイリアスをつけられるようにしているので
perl -MYAML -MExporter::Global=YAML::Dump;p


perl -MData::Dumper -MExporter::Global=Data::Dumper::Dump;p

といった感じで任意のDump関数を指定することができます。また、前記事では想定されていなかった1ファイル内に複数のパッケージがあるケースにも対応しています。

ソース
package Exporter::Global;

use warnings;
use strict;
use Carp;
use Fatal qw(open close);

sub import {
    my $class = shift;
    my $args = ref $_[0] eq 'HASH'
     ? $_[0] : { subroutines => [ @_ ] };

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    unshift @INC, $class->new($args)
     unless (grep {ref $_ eq $class } @INC);
}

sub unimport {
    my $class = shift;

    @INC = grep { ref $_ ne $class } @INC;
}

sub new {
    my $class = shift;
    my $self = { %{ _parse_arguments(@_) } };
    croak "Pass the export subroutines"
     unless (@ { $self->{subroutines} });

    bless $self, $class;
    $self->{modules} ||= [];
    $self->{caller_pkg} ||= caller($Carp::CarpLevel);

    return $self;
}

sub _parse_arguments {
    my (@args) = @_;
    my $h;
    if (ref $args[0] eq 'HASH') {
     $h = $args[0];
    } else {
     my @subrutines = map { split /[\s,]+/, $_ } @args;
     $h = {
     subroutines => \@subrutines,
     };
    }
    return $h;
}

sub Exporter::Global::INC {
    my $self = shift;
    my $module = shift;

    my $mod_name = _mod_name($module);
    return unless ($self->_is_export_target($mod_name));

    my @pkgs = ($mod_name);
    push @pkgs, $self->_find_inner_packages($module);

    for my $export_sub ( @{ $self->{subroutines} } ){
     my ($import_sym_name, $export_alias)
     = $self->_extract_sym_name($export_sub);

     for my $pkg (@pkgs) {
     no strict 'refs';
     *{"$pkg\::$export_alias"} = \&{"$import_sym_name"};
     }
    }
    return;
}

sub _is_export_target {
    my $self = shift;
    my $mod_name = shift;

    if (my @modules = @{ $self->{modules} }) {
     return unless ( grep { $mod_name =~ qr($_) } @modules);
    }
    return 1;
}

sub _mod_name {
    (my $mod_name = shift) =~ s|/|::|g;
    $mod_name =~ s|\.pm$||;
    return $mod_name;
}

sub _extract_sym_name {
    my $self = shift;
    my $export_sub = shift;
    
    my ($sub_name, $alias) = split /;/, $export_sub, 2;
    die "Can't extract subroutine name" unless ($sub_name);

    $alias ||= $sub_name;

    my $import_sym_name
     = $sub_name =~ /::/ ? $sub_name : "$self->{caller_pkg}::$sub_name";

    return ($import_sym_name, $alias);
}

sub _find_inner_packages {
    my $self = shift;
    my $module = shift;

    my $mod_name = _mod_name($module);

    my @pkg;
    for my $inc (@INC) {
     next if (ref $inc);
     my $path = $inc;
     $path .= '/' unless ($path =~ m|/$|);
     $path .= $module;
     next unless (-e $path);
     open (my $fh, $path);
     while (<$fh>) {
     next if (/^=(?!cut)/ .. /^=cut/);
     last if (/^__END__$/);
     if (my ($pkg) = m|^package\s+(.+?);|) {
     next unless ($self->_is_export_target($pkg));
     next if ($mod_name eq $pkg);
     push @pkg, $pkg;
     }
     }
     close $fh;
    }
    return @pkg;
}
1; # End of Exporter::Global


火曜日, 12月 19, 2006

[Service]ブログバトラー

ブログバトラーなるサービスがリリースされたそうです。

ブログバトラーβオープン

ブログに貼り付けて使うタイプのサービスで、ブログのフィードからキーワードを抽出してブログに会ったキャラクターの特性を作ってくれるとのこと。面白そうなので早速貼り付けて見ました>右下参照

そして対戦してみたら見事に勝利!!w

というわけで勝ち逃げにて失礼しますm(_ _)m

金曜日, 12月 15, 2006

[感想]はてなの開発体制

ライブドアでやってるセミナーは一度行ってみたいのですがいつも気付いたときには締め切られているのでこうやって資料をアップしてもらえるのは非常にありがたい。

ライブドアのテクノロジーセミナーでしゃべってきました。

技術的な点もLVSとか興味深くて試してみたいことはたくさんあるのですが、特に気になったのが開発体制のところの話。以下いくつか抜粋してみますと。。。

開発者が企画/運用
新しいことの正しさは本人にしか分からない

まさにそうですよね。
うちの会社の場合は企画者も開発者も運用者も全部別の人なので、新しい技術でサービスをといっても距離を感じてしまいます。自分の力量不足もあるんでしょうが。別の人でもいいんですがもうちょっと見通しがよくなるようにしていけたらなぁと。

デュアルモニタ購入サポート

これ羨ましいw

休日選択制 (水 or 土)

平日休めるのいいなぁ。

半年続けると流行るの法則。継続は力。

流行ってるサービスを真似するんじゃなくて流行るサービスを生み出したい。

プログラマのモチベーションは会社の原動力です。

すばらしい。開発者主導で楽しんでサービスを作っていっている感じが伝わってきます。
うちもそういう部分を出していきたいなぁ。

木曜日, 12月 14, 2006

[Perl]UMLクラス図の自動生成(UML::Class::Simple)

UML続きでこんどはこれを試してみました。

http://search.cpan.org/~agent/UML-Class-Simple/


まずGraphvizをインストールしておく必要があります。

私はソースからインストールしました。(Graphviz version 2.12)

./configure
make
make install

で問題なくインストールできました。
つづいてcpanコマンドでUML::Class::Simple(0.07)をインストール。
大量のモジュールをインストールした後最後にこれをインストールしようとするがテストでこけまくる。
とりあえずforceでインストールしてみてだめだったら考えようということでインストールしてしまいました。

とりあえず以下のような簡単なクラス構成で実行してみます。
package Base;
sub new { bless {}, shift }
sub base_method {
    print "I am base\n";
    shift->protected_method();
}
1;

package Foo;
use strict;
use base 'Base';

sub new { bless {} };
sub method_foo {
    print "method_foo called\n";
    shift->base_method;
};

sub protected_method {
    print "overrided\n";
}

1;

package Hoge;
use Foo;
sub foo {
    my $self = shift;
    return $self->{foo} ||= Foo->new();
}

1;


# umlclass.pl -M Hoge -o hoge.png -p "^(Hoge|Foo|Base)$"
Error: syntax error in line 8
... ...
in label of node class_1
at /usr/bin/umlclass.pl line 102

となりエラー。。。追記(2007/04/11)作者の方が上記内容をパッチとしてアップデートしてくださいました(コメント参照)。


どうもfontタグの中身が空だからエラーを出しているんじゃないかと思い、
仕方ないのでデバッガでソースを追っていると、Graphvizのdotコマンドに渡すファイルをTTで作っていることがわかったので、その結果を一時ファイルに保存するようにコードを変えて見てみると、属性にあたるところだということが分かりました。そこで属性が無いときはfontタグを出さないように変更してやると上手く動きました。(その後操作の部分も同様に修正)

# diff Simple.pm Simple.org 
327,329d326
< open (my $fh, '>', 'dotresult.txt');
< print $fh $dot;
< close $fh;
359c356
< <td>[% IF class.properties.size > 0 %]<font color="red">
---
> <td><font color="red">
363c360
< [%- END %]</font>[% END %]</td>
---
> [%- END %]</font></td>
377c374
< <td>[% IF class.methods.size > 0 %]<font color="red">
---
> <td><font color="red">
381c378
< [%- END %]</font>[% END %]</td>
---
> [%- END %]</font></td>


結果


わりといい感じに見えますがメソッドと継承関係しか出してくれないことと、pngとかで出されても修正できないのであまりうれしくないかもしれません。
UML::Sequenceとあわせてこの辺がXMIで出力してくれたら便利なんですけどね。
誰か作ってくれないですかね。



[Perl]UMLシーケンス図の自動生成(UML::Sequence)

UMLのシーケンス図を出力してくれるというので試してみました。

http://search.cpan.org/~philcrow/UML-Sequence/

インストールした環境は以下のとおりです。


  • CentOS 4.3

  • Perl 5.8.5(CentOS 4.3のデフォルト)


svgで出力するだけならGDが無くても大丈夫ですが、イメージにしたい場合はGDをインストールしておく必要があります。

まずこんなパッケージを作ってみます。
package Base;
sub new { bless {}, shift }
sub base_method {
    print "I am base\n";
    shift->protected_method();
}

package Foo;
our @ISA = qw(Base);

sub method_foo {
    print "method_foo called\n";
    shift->base_method;
};

sub protected_method {
    print "overrided\n";
}

package Hoge;
sub new { bless {} };

sub call_foo {
    my $foo = Foo->new();
    $foo->method_foo();
}

1;


つづいて起動ファイル
use Hoge;

my $h = Hoge->new();
$h->call_foo;


シーケンスを出力するためには、監視するメソッドの名前をパッケージ名つきでリストアップしておく必要があります。
listとしてこんな感じで作っておきます。
Base::new
Base::base_method
Foo::new
Foo::method_foo
Foo::protected_method
Hoge::new
Hoge::call_foo

これらを使ってシーケンス図を生成してみます。

まずはgenericseq.plコマンドでコールシーケンスをXMLファイル化します。
genericseq.pl UML::Sequence::PerlSeq list main.pl >sequence.xml


あとはこれをグラフィック形式に変換します。
SVGの場合はseq2svgを、jpegやpngの場合はseq2rast.plを使用します。
seq2svg.pl sequence.xml > sequence.svg


PNGに変換
seq2rast.pl -o sequence.png sequence.xml


画像タイプは拡張子で判断してくれるようです。

サンプル画像


とりあえずいい感じに出てはいますがリストを作らないといけないのが若干面倒な感じです。想像ですがこのリストからサブルーチンを置き換えてトレースできるようにしているためだと思われます。
パッケージが多くなってくると手動でリストを作るのはきついのでワンライナーあたりで生成するのが現実的でしょう。
サブルーチン呼び出しのグローバルフックみたいなのってないんですかね。



水曜日, 12月 13, 2006

[Perl]useなしでどこでもDump(@INCにオブジェクトを格納するパターン)

PERL HACKSを読んでいたら@INCにはhookが仕込めるということが書いてありました。

■[Perl]use無しでどこでも変数をダンプするpackage P;p

でも言及されているとおりかねてからuseがめんどうだと思っていたのですが、これを使えばうまくいくんじゃないか?ということでやってみました。

@INCの仕組み

http://perldoc.perl.org/functions/require.html


によると@INCにはCODEやオブジェクトを格納することができます。
これを利用するとモジュールロード前にhookを仕込むことができます。

There are three forms of hooks: subroutine references,
array references and blessed objects.


とあります。subroutine referencesが簡単ですがどーせならblessed objectsの方がということでこちらでやってみます。
オブジェクトの場合はINCというメソッドを定義するとモジュールをロードするたびにそのメソッドを呼び出してくれます。ただmainパッケージになってしまう(ここがよくわらかなかった)らしいのでパッケージ名をフル指定しないといけないようです。

package P;
use strict;
use YAML;

sub new {
  my $class = shift;
  return bless { modules => [ @_ ] }, $class;
}

sub import {
  my $class = shift;
  my (@modules) = @_;
  push @modules, split /[,\s]+/msx, $ENV{P} || q{};

  unshift @INC, P->new(@modules)
     unless (grep {ref $_ eq __PACKAGE__ } @INC);
  
}

sub p {
  my ($package, $file, $line) = caller();

  warn "[$file at line $line] " . YAML::Dump(@_);
}

sub P::INC {
  my ($self, $module) = @_;
  if (my @modules = @{$self->{modules}}) {
   return unless ( grep { $module =~ m|^$_| } @modules);
  }

  (my $mod_name = $module) =~ s|/|::|g;
  $mod_name =~ s|\.pm$||;

  no strict 'refs';
  *{"$mod_name\::p"} = \&p;
  return;
}

1;

こんな感じで実装してみました。

pを使う方

package PUser;
use strict;
use base 'Class::Accessor';

sub hoge {
  p "Hello Debug P";
  p { hoge => 'foo' }, "bar bar";
  warn "hoge called";
}

1;


起動ファイル(run_p.pl)
use strict;
use PUser;
PUser->hoge();



これで

perl -MP run_p.pl
とやると全てのパッケージでp関数が利用できます。

水曜日, 12月 06, 2006

[JavaScript]JSONPでdel.icio.usのfeedを取得する

JavaScript学習。JSONPを試してみました。

JSONPとはJavaScriptでのRemote Procedure Callの一種です。同様なものとしてXMLHttpRequestが一般的ですが、これはリクエストの送信先が同じドメイン内に限定されているのに対し、JSONPでは異なるドメインにリクエストを送信し、結果を受け取ることができます。
JSONPではscriptタグのsrc属性はドメインが限定されていないことを利用します。
リクエストを受け取ったサーバはレスポンスをJavaScriptの関数呼び出しの形式で返します。クライアントは側ではそれをscriptタグを使って読み込むとコードが関数呼び出しとして評価されるので、その関数を実装しておくことでサーバのレスポンスを処理できるという仕組みです。
例としてdel.icio.usを使ってみます。
以下にリクエストを投げると

http://del.icio.us/feeds/json/usuihiro?callback=handleResponse
handleResponse([{ .. }, ... ])
という形式でレスポンスが返されます。クライアント側はこのhandleRequest関数を定義しておき、引数から受け取ったデータを処理すればよいという仕組みです。

実装手順

まずsubmitボタンが押されるとsendJSONPが呼ばれるようにイベントハンドラを登録します。onSubmitでも充分なのですがここではprototype.jsを使用してみました。

function startup() {
Event.observe('form', 'submit', sendJSONP );
}

つづいてJSONPリクエストを送信するためのスクリプトタグを生成し、HTMLの要素に追加します。

var src = 'http://del.icio.us/feeds/json/'
+ user_name + '?callback=handleResponse';
var script = document.createElement("script");
script.setAttribute('type', 'text/javascript');
script.setAttribute('charset', 'utf-8');
script.setAttribute('src', src);
var head = document.getElementsByTagName('head').item(0);
head.appendChild(script);

最後にレスポンスを処理する関数を定義します。del.icio.usの場合はリクエスト送信時にcallbackパラメータで指定した名前の関数を呼び出す形でレスポンスが返されるので、その名前で関数を作成します。

function handleResponse(json) {
// ...
}
こんな感じで外部ドメインとのやり取りをJavaScriptで実現できます。


サンプルコード
以下のサンプルではアカウント名を入力してsubmitするとdel.icio.usのfeedsを取得して表示します。

<html><head>
<script language="JavaScript" src="lib/prototype-1.4.0.js" />
<script language="JavaScript">
<!--
function startup() {
Event.observe('form', 'submit', sendJSONP );
}

// JSONPの結果呼び出される関数
function handleResponse(json) {
var html = "";
if (json.length == 0) {
var user_name = $F('user_name');
alert("Feeds not found of " + user_name);
return false;
}

json.each( function (elem) {
var text = '<a href="' + elem["u"] + '">'
+ elem["d"] + '</a>';
// タグがあれば追加する
if ( elem["t"] && elem["t"].length > 0) {
text += ' tags: (' + elem["t"].join(',') + ')';
}
html += "<li>" + text + "</li>\n";
} );
$("list_html").innerHTML = html;
return true;
}

// JSONPリクエストを送信。結果が関数呼び出し形式で返ってくるので
// それを評価させる為にscriptタグを生成する

function sendJSONP(e) {
var user_name = $F('user_name');
if (!user_name) {
alert ('input user_name');
return false;
}

// scriptタグの生成
var src = 'http://del.icio.us/feeds/json/'
+ user_name + '?callback=handleResponse';
var script = document.createElement("script");
script.setAttribute('type', 'text/javascript');
script.setAttribute('charset', 'utf-8');
script.setAttribute('src', src);
var head = document.getElementsByTagName('head').item(0);
head.appendChild(script);

// これを呼ばないと通常のGETリクエストも送信されてしまう。
Event.stop(e);
return false;
}
//-->
</script>
</head>
<body onload="startup()">
<h1>del.icio.usからJSONPを利用してfeedを取得します。</h1>
<form id="form" method="get">
user_name: <input id="user_name" type="text" />
<input type="submit" value="Get del.icio.us feeds"/>
</form>
<ul id="list" />
</body>
</html>