Sledge::Plugin::JSON 進化してます

id:nekokak さんがモバイルファクトリーのレポジトリで公開されている Sledge::Plugin::JSONに、ライブドアの金子さんがパッチを書いて公開されてました。


実は何を隠そう、僕もちょうど1年ほど前に、同名のプラグインをでっち上げwてみたりしてたんですが、ちゃんとここも見つけてくださって、ちょろっと触れていただいてました。

ちなみに、 d:id:hi-rocks さんが一年くらい前に同名のプラグインを公開されてたんですね。こちらも CPAN にはアップしていないようで。 AUTHOR: nekokak, originally-devised by hi-rocks で改めて CPAN にアップとか、どうですかね?

こちらとしましては、そんなところに名前を入れていただくのももったいないような気がしないでもないんですが、いずれにしろ「AUTHOR: nekokak」でアップしていただくことに異論はありませんです。


そんで、ちょっと話は逸れますが、Sledge といえばまずはライブドアモバイルファクトリーってな状況で、われらがフリップクリップとしてはその次くらいの存在になりたいなーとか思ってます。まあ、僕は外向けにはほとんどなんもやってないんですけどねw。そのかわり?に相方の horiuchi がいろいろがんばってますので、どうぞよろしくお願いします。(人材も募集中です。興味のある方はhoriuchiのblogからどうぞ〜)


でもって、基本的に nekokak さんバージョン+金子さんパッチな構成でいいんじゃないかと思うんですが、僕のほうでも、非公開ながらもコツコツと改良(ってほどでもないけど)してきた部分もありまして、このへんもうまいことマージして取り込んでもらえたらいいなーとか思ったりもします。まあこんな↓感じなんですが、どうでしょう、使えそうなとこはありますかねえ。。。

(いちおう)JSON::Syck だけじゃなく JSON.pm もサポート

フリップクリップでも JSON::Syck を使ってるので、ウチ的にはなくてもかまわないんですが。手元のやつはいちおう JSON.pm でも使えるようにしています。import 時にモジュールの有無をチェックしてクロージャを作って mk_json メソッドとしてます。
まあ、これはなくてもいいのかなあ?よくよく考えてみたら、Sledge は使えるのに JSON::Syck がインストールできない環境ってありえないよね。

$self->json で param()

$self->tmpl->param( foo => 'bar' );

とかのように

$self->json->param( foo => 'bar' );

ってできたらいいかなー、と。
あとは $self->output_json するだけ。

TT で整形して出力

普通にハッシュを dump して JSON にするだけならいいんだけど、例えばオブジェクトとかイテレータとかを渡してあとはよきにはからってくれたらなーとか考えると、やっぱりテンプレートに頼ってしまうってのもありかな、ということです。

$self->output_json_tt();

こうすると

$self->load_template($self->page.'.json');
$self->tmpl->param(%$obj);
my $content = $self->make_content;

こんな感じでテンプレートを読み替えてTTで普通に出力するってだけなんだけど。んで、テンプレート名とかは柔軟に変更できるほうがいいのかな。


てな感じで、以下コードの抜粋です。もうちょっと絞ったほうがよかったかな。
そんで、ところどころなんかおかしいような気もするんで、添削も歓迎しますです。

sub import {
    my $class = shift;
    my $pkg   = caller;

    no strict 'refs';
    *{"$pkg?::json"} = sub {
        my $self = shift;
        return $self->{_json};
    };
    *{"$pkg?::mk_json"}        = $class->_mk_json_closure();
    *{"$pkg?::output_json"}    = ?&_output_json;
    *{"$pkg?::output_json_tt"} = ?&_output_json_tt;

    $pkg->register_hook(
        AFTER_INIT => sub {
            my $self = shift;
            $self->{_json} = $class->new;
        },
    );
}

sub _mk_json_closure {
    my $pkg = shift;

    if ( "JSON::Syck"->require ) {
        return sub {
            my ( $self, $obj ) = @_;
            $obj ||= $self->{_json};
            return JSON::Syck::Dump($obj);
        };
    }
    elsif ( "JSON::Converter"->require ) {
        my $j = JSON::Converter->new;
        return sub {
            my ( $self, $obj ) = @_;
            $obj ||= { %{ $self->{_json} } };
            return $j->objToJson($obj);
        };
    }
    else {
        croak("$pkg requires either JSON::Syck or JSON");
    }
}

sub _output_json {
    my ( $self, $obj, $charset ) = @_;
    my $content = Encode::encode("UTF-8", $self->mk_json($obj));
    $self->json->output( $self, $content );
}

sub _output_json_tt {
    my ( $self, $obj ) = @_;
    $obj ||= $self->{_json};
    $self->load_template( $self->page . '.json' );
    $self->tmpl->param(%$obj);
    my $content = $self->make_content;
    $self->json->output( $self, $content );
}

sub output {
    my ( $self, $page, $content ) = @_;

    if ( my $callback = $self->callback ) {
        utf8::decode($callback);
        if ( $callback =? /^[a-zA-Z0-9?.?_?[?]]+$/ ) {
            $content = sprintf "%s(%s);", $callback, $content;
        }
    }

    $page->r->content_type('application/x-javascript; charset=utf-8');
    $page->set_content_length( length $content );
    $page->r->send_http_header;
    $page->r->print($content);
    $page->invoke_hook('AFTER_OUTPUT');
    $page->finished(1);
}

sub param {
    my $self = shift;
    if ( @_ == 0 ) {
        return keys %$self;
    }
    elsif ( @_ == 1 ) {
        return $self->{ $_[0] };
    }
    else {
        $self->{ $_[0] } = $_[1];
    }
}

1;