PerlでSeasar2のコンポーネントを使う

Perl(CPAN)は最強だ。
Inline::Javaを使えば、こんなこともできてしまう。

lib/               ... 依存ライブラリ全て
  s2-framework-2.2.11.jar
  s2-extension-2.2.11.jar
  ...などなど
classes/           ... classファイルディレクトリ
  app.dicon
  ...などなど
component_list.pl  ... Seasar2コンポーネント一覧出力Perlスクリプト（中身は以下）

Seasar2のバージョンが、2.2 なのはつっこまないでください。

component_list.pl

use strict;
use warnings;
use Encode;

use Inline
  Java  => 'STUDY',
  STUDY => [
    qw(
      java.lang.Class
      java.util.List
      org.seasar.framework.container.factory.SingletonS2ContainerFactory
      org.seasar.framework.container.S2Container
      )
  ],
  AUTOSTUDY => 1;
use Inline::Java qw(cast);

eval {
    org::seasar::framework::container::factory::SingletonS2ContainerFactory
      ->init;
    my $root =
      org::seasar::framework::container::factory::SingletonS2ContainerFactory
      ->getContainer;
    my $num        = $root->getComponentDefSize;
    my @list       = ();
    my %namespaces = ();
    &push_component( \@list, \%namespaces, $root );
    my $currns = '';
    for my $c (@list) {
        if ( $currns ne $c->{namespace} ) {
            print $c->{namespace} . "\n";
            $currns = $c->{namespace};
        }
        print "    " . $c->{class} . " : " . $c->{name} . "\n";
    }
};
if ($@) {
    die $@;
}

sub push_component {
    my ( $list, $namespaces, $container ) = @_;
    my $namespace = $container->getNamespace || 'root';
    return if exists $namespaces->{$namespace};

    $namespaces->{$namespace} = 1;

    my $num = $container->getComponentDefSize;
    for ( my $i = 0 ; $i < $num ; $i++ ) {
        my $def = $container->getComponentDef($i);
        push(
            @{$list},
            {
                namespace => $namespace,
                class     => $def->getComponentClass->getName,
                name      => $def->getComponentName || '-'
            }
        );
    }
    my $childSize = $container->getChildSize;
    if ( $childSize > 0 ) {
        for ( my $i = 0 ; $i < $childSize ; $i++ ) {
            &push_component( $list, $namespaces, $container->getChild($i) );
        }
    }
}

実行

export CLASSPATH=$CLASSPATH:classes:`echo lib/*.jar | tr ' ' ':'`
perl component_list.pl

結果

root
    jp.co.nulab.backlog.webwork.project.ProjectAction : -
    jp.co.nulab.backlog.webwork.wiki.WikiAction : -
    ...
service
    org.seasar.framework.aop.interceptors.InterceptorChain : defaultInterceptor
    ...
alldao
    jp.co.nulab.backlog.dao.ProjectDao : -
    ...
dao
    org.seasar.dao.impl.DaoMetaDataFactoryImpl : -
    org.seasar.dao.pager.PagerS2DaoInterceptorWrapper : interceptor
j2ee
    org.seasar.extension.jta.TransactionManagerImpl : transactionManager
    org.seasar.extension.tx.RequiredInterceptor : requiredTx
    ...

...以下省略

もちろん各コンポーネントのメソッド実行もできます。
Seasar2から取得したオブジェクトの型が判別できない場合がある(？)などありましたが、

    my $dao = $container->getComponent(
        java::lang::Class->forName("jp.co.nulab.backlog.dao.UserDao")
    );
    $dao = cast( 'jp.co.nulab.backlog.dao.UserDao', $dao );
    my $users = cast( 'java.util.List', $dao->getUsers(11) );
    print "first user name = "
      . cast( 'jp.co.nulab.backlog.entity.User', $users->get(0) )->getName
      . "\n";

みたいな感じでした。

とても感動したので、久々の（笑）技術ネタでした。