Hatena::Groupcatalyst

dann@catalyst このページをアンテナに追加 RSSフィード

2008-03-20

CatalystのREST API用のベースクラス

| 02:23 |  CatalystのREST API用のベースクラス - dann@catalyst を含むブックマーク はてなブックマーク -  CatalystのREST API用のベースクラス - dann@catalyst  CatalystのREST API用のベースクラス - dann@catalyst のブックマークコメント

を作ってみた。

  • dispatch部分は、Catalyst::Controller::Resources
    • Catalyst::Controller::RESTは、dispatchする部分が綺麗にかけないので、Catalyst::Controller::Resourcesを使う
  • エンドポイントへのデータのデシリアライズとシリアライズはCatalyst::Action::SerializeとDeserializeを使う

という形にしてみた。

これで、Content-Typeによって、シリアライザ・デシリアライザが切り替わるので、APIで複数のフォーマットに簡単に対応できるんじゃないかなぁ。かつ、エンドポイントはRailsライクに綺麗に扱えると。

Catalyst::Controller::RESTを使ってみて、一通りやりたいことはできたのだけれどあまりにdispatchしたところのコードが汚くなるので、こりゃあかんということでいいとこどりをしてみた。

APIのベースクラス

package MyApp::Web::Controller::API;
use strict;
use warnings;
use Params::Validate qw(SCALAR OBJECT);
use base 'Catalyst::Controller::Resources';

__PACKAGE__->config(
    'stash_key' => 'entity',
    'default'   => 'text/x-json',
    'map'       => {
        'text/html'          => 'YAML::HTML',
        'text/xml'           => 'XML::Simple',
        'text/x-yaml'        => 'YAML',
        'text/x-json'        => 'JSON',
    }
);

sub begin : ActionClass('Deserialize') {
}

sub end : ActionClass('Serialize') {
}


=item status_ok

Returns a "200 OK" response.  Takes an "entity" to serialize.

Example:

  $self->status_ok(
    $c,
    entity => {
        radiohead => "Is a good band!",
    }
  );

=cut

sub status_ok {
    my $self = shift;
    my $c    = shift;
    my %p    = Params::Validate::validate( @_, { entity => 1, }, );

    $c->response->status(200);
    $self->_set_entity( $c, $p{'entity'} );
    return 1;
}

=item status_created

Returns a "201 CREATED" response.  Takes an "entity" to serialize,
and a "location" where the created object can be found.

Example:

  $self->status_created(
    $c,
    location => $c->req->uri->as_string,
    entity => {
        radiohead => "Is a good band!",
    }
  );

In the above example, we use the requested URI as our location.
This is probably what you want for most PUT requests.

=cut

sub status_created {
    my $self = shift;
    my $c    = shift;
    my %p    = Params::Validate::validate(
        @_,
        {
            location => { type     => SCALAR | OBJECT },
            entity   => { optional => 1 },
        },
    );

    my $location;
    if ( ref( $p{'location'} ) ) {
        $location = $p{'location'}->as_string;
    } else {
        $location = $p{'location'};
    }
    $c->response->status(201);
    $c->response->header( 'Location' => $location );
    $self->_set_entity( $c, $p{'entity'} );
    return 1;
}

=item status_accepted

Returns a "202 ACCEPTED" response.  Takes an "entity" to serialize.

Example:

  $self->status_accepted(
    $c,
    entity => {
        status => "queued",
    }
  );

=cut

sub status_accepted {
    my $self = shift;
    my $c    = shift;
    my %p    = Params::Validate::validate( @_, { entity => 1, }, );

    $c->response->status(202);
    $self->_set_entity( $c, $p{'entity'} );
    return 1;
}

=item status_bad_request

Returns a "400 BAD REQUEST" response.  Takes a "message" argument
as a scalar, which will become the value of "error" in the serialized
response.

Example:

  $self->status_bad_request(
    $c,
    message => "Cannot do what you have asked!",
  );

=cut

sub status_bad_request {
    my $self = shift;
    my $c    = shift;
    my %p    = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );

    $c->response->status(400);
    $c->log->debug( "Status Bad Request: " . $p{'message'} ) if $c->debug;
    $self->_set_entity( $c, { error => $p{'message'} } );
    return 1;
}

=item status_not_found

Returns a "404 NOT FOUND" response.  Takes a "message" argument
as a scalar, which will become the value of "error" in the serialized
response.

Example:

  $self->status_not_found(
    $c,
    message => "Cannot find what you were looking for!",
  );

=cut

sub status_not_found {
    my $self = shift;
    my $c    = shift;
    my %p    = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );

    $c->response->status(404);
    $c->log->debug( "Status Not Found: " . $p{'message'} ) if $c->debug;
  $self->_set_entity( $c, { error => $p{'message'} } );
    return 1;
}

sub _set_entity {
    my $self   = shift;
    my $c      = shift;
    my $entity = shift;
    if ( defined($entity) ) {
        $c->stash->{ $self->{'stash_key'} } = $entity;
    }
    return 1;
}

1;

APIを実装するサブクラス

package MyApp::Web::Controller::API::Articles;

use strict;
use warnings;
use base 'MyApp::Web::Controller::API';

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut


=head2 index

=cut
sub list {
    my ($self, $c) = @_;

    // Implement me!

    $self->status_ok(
            $c,
            entity => {
                some => 'data',
                foo  => 'is real bar-y',
            },
    );

}

# POST /articles
sub create {
    my ($self, $c) = @_;
    my $article_data = $c->req->data;
    use Data::Dumper;
    warn Dumper $article_data;
    // Implement me!
}

# GET /articles/{article_id}
sub show {
    my ($self, $c, $article_id) = @_;
}

# PUT /articles/{article_id}
sub update {
    my ($self, $c, $article_id) = @_;
}

# DELETE /articles/{article_id}
sub destroy {
    my ($self, $c, $article_id) = @_;
}

# GET /articles/new
sub post {
    my ($self, $c) = @_;
}

# GET /articles/{article_id}/edit
sub edit {
    my ($self, $c, $article_id) = @_;
}


=head1 AUTHOR

dann,,,

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

簡単なテスト

GET

curl -X GET -H 'Content-Type: text/x-json' http://192.168.0.30:3000/articles

POST

curl -X POST -H 'Content-Type: text/x-yaml' -T article.yml http://192.168.0.30:3000/articles

これくらいしか動作確認してないけど... 元のコード丸ぱくりだから、まぁ動くんじゃないかしら。

TODO

  • content typeでAPIの入出力のフォーマットを切り替えるというのが流行っていない気もするけれど、その辺も気がむいたら調査しよう
トラックバック - http://catalyst.g.hatena.ne.jp/dann/20080320

2008-03-16

Catalyst用のCLI作成

| 14:11 |  Catalyst用のCLI作成 - dann@catalyst を含むブックマーク はてなブックマーク -  Catalyst用のCLI作成 - dann@catalyst  Catalyst用のCLI作成 - dann@catalyst のブックマークコメント

昨日のエントリのtomyheroさんのCatApp::CLIをベースに、

  • Catalystに依存しないでConfigを読む仕組み
  • CLIのスクリプトのコマンドを拡張する仕組み
  • CLIのコマンドからSchemaを参照する仕組み

を用意してみた。

Catalystに依存しないで使えるので、Catalyst外でも使えるし、App::CmdベースでCLIのコマンドそのもののテストができる。大分、テスタビリティも高いし、いいかなと。

これで、starterで一通りクラスを生成すれば、CLIを拡張していくときには、新規にMyApp::CLI::Commandを拡張していくだけになりました。

  • 簡単にコマンドが追加できること
  • コマンド中からSchemaとconfigを参照できること
  • Catalystに依存せずにCLIを作れること

という用件をひとまずは満たしたので、一応満足。

Schemaを直接参照ではなくて、ここでCというクラスを参照という形にするのがBetterなんだけれど、その仕組みを用意するには、ちと幾つか足りないのでまた今度。

コマンドライン用の管理スクリプト admin.pl

#!/usr/bin/env perl

use MyApp::CLI;
MyApp::CLI->new->run;

使うときは、

script/admin.pl list --open

など。

コマンドラインのコマンドの実装

CLIクラス
package MyApp::CLI;
use base qw(App::Cmd);

1;
コマンドのベースクラス

全てのコマンドでyamlschemaが参照できるようにする。コマンドラインのコマンドのベースクラス。

package MyApp::CLI::Command;
use base qw/App::Cmd::Command/;
use MyApp::ConfigLoader;
use MyApp::Schema;

sub config {
    my $self = shift;
    $self->{config} ||= MyApp::ConfigLoader->new->config;
    return $self->{config};
}

sub schema {
    my $self = shift;
    $app->{schema}  = MyApp::Schema->connect( @{ $self->config->{'Model::DBIC'}{'connect_info'} } );
}

1;
コマンドのクラス

後は、上記のベースクラスを継承して、実装を追加すればコマンドラインオプションが追加できる。

package MyApp::CLI::Command::List;
use base qw/MyApp::CLI::Command/;

=head1 NAME
MyApp::CLI::Command::List - list events
=cut

sub opt_desk {
    return (
        ["open", "only unfinished events"],
    );
}

sub validate_args {
    my ($self, $opt, $args) = @_;
    # we need at least one argument beyond the options
    die $self->usage->text unless @$args;
}

sub run {
    my ($self, $opt, $args) = @_;
    use Data::Dumper;
    warn Dumper $self->schema;
    warn Dumper $self->config;
}

1;

lcipavlcipav2011/03/24 10:164IGWLn <a href="http://glbzfqoqlaox.com/">glbzfqoqlaox</a>, [url=http://ikimzilitduw.com/]ikimzilitduw[/url], [link=http://koddoycduxbb.com/]koddoycduxbb[/link], http://licjkrlymalo.com/

トラックバック - http://catalyst.g.hatena.ne.jp/dann/20080316

2008-03-15

Catalyst appでCLI

| 04:08 |  Catalyst appでCLI - dann@catalyst を含むブックマーク はてなブックマーク -  Catalyst appでCLI - dann@catalyst  Catalyst appでCLI - dann@catalyst のブックマークコメント

tomyhero++

http://d.hatena.ne.jp/tomyhero/20080315/1205598628

Catalyst::Utilsへの依存を切って、後は自分の構成にあわせれば殆どそのまんま使えそう! App::Cmdと組み合わせてベースクラスを作ろうかな。tomyheroさんのやつをCommandのベースクラスに押し込んでしまえばいい気がする。後で作って、starterに組み込む!

App::Cmdは、以下のスライドが分かりやすい。http://www.slideshare.net/rjbs/writing-modular-commandline-apps-with-appcmd/

トラックバック - http://catalyst.g.hatena.ne.jp/dann/20080315

2008-03-13

モデルのfunctional test

| 22:54 |  モデルのfunctional test - dann@catalyst を含むブックマーク はてなブックマーク -  モデルのfunctional test - dann@catalyst  モデルのfunctional test - dann@catalyst のブックマークコメント

DBICx::TestDatabaseとTest::Fixture::DBIC::Schemaを使ってモデルのテストをしてみた。大体イメージどおりの感じで使えるかなぁと。

テスト用のDBクラス

DBICx::TestDatabaseを使っている。将来的に拡張する可能性があるため継承をしておく。

package MyApp::Test::DBIC::Database;
use strict;
use warnings;
use base qw(DBICx::TestDatabase::Subclass MyApp::Schema);

1;

モデルのテスト用のベースクラス。

setupでfixture作成. Test::Fixture::DBIC::Schemaでfixtureのロード.

package MyApp::Test::Model::Base;
use strict;
use warnings;
use base qw/Test::Class/;
use MyApp::Test::DBIC::Database;
use Test::Fixture::DBIC::Schema;
use File::Spec;

sub setup: Test(setup) {
    my $self = shift;
    $self->_make_fixture($self->model,$self->fixture);
}

sub _make_fixture {
    my $self = shift;
    my $model = shift;
    my $fixture = shift;

    $self->{schema} = MyApp::Test::DBIC::Database->connect();
    my $fixture_path = File::Spec->catfile('t','fixtures', $self->fixture . ".yaml");
    my $data = construct_fixture(
        schema  => $self->{schema},
        fixture => $fixture_path,
    );
    $self->{model} = $self->{schema}->resultset($model);
}

sub teardown : Test(teardown) {
};

sub fixture {
    my $self = shift;
    die "need to override";
}

sub model {
    my $self = shift;
    die "need to override";
}

1;

テストコード

モデルのテストクラスは、MyApp::Test::Model::Baseを継承する。fixtureとmodelメソッドをオーバーライドすると、該当するfixtureがロードされる。各テストメソッド間では、テーブルの内容は削除されるので、メソッド間に依存関係はない。

#!perl
use strict;
use warnings;

MyApp::Test::Model::Feeds->runtests;

package MyApp::Test::Model::Feeds;
use base qw/MyApp::Test::Model::Base/;
use Test::More;

sub test_feed : Tests {
    my $self = shift;

    my $feed = $self->{model}->find(1);
    is $feed->id, 1;
    is $feed->feedlink, "http://example.net/rss";
}

sub fixture {
    return "feeds";
}

sub model {
    return "Feeds";
}

1;

fixture

t/fixtures/feeds.yaml

t/fixturesに置くのは、Railsのパクリ。

- schema: Feeds
  name: entry1
  data:
    id: 1
    feedlink: http://example.net/rss
    link: http://example.net
    title: Example
    description: This is Example site
    subscribers_count: 1

- schema: Feeds
  name: entry2
  data:
    id: 2
    feedlink: http://example2.net/rss
    link: http://example2.net
    title: Example2
    description: This is Example2 site
    subscribers_count: 2

検討事項

  • SQLiteでテストする必要がなければ、Test::Fixture::DBIC::Schemaだけでいいなぁ。ここらはSQLiteでのテストが必要かも含めて少し検討かな。
    • モデルのテストはSQLiteだけ、結合テストのときだけMySQLでという選択肢もありえるかもしれない。
  • DB使わないでモデルをテストするユニットテスト用のベースクラスも作成する
  • fixture作るのが面倒. SQLでデータ流し込んで、YAMLDBからDumpする仕組みを用意したほうがいいかも

CarrieCarrie2011/08/02 22:59This website makes tghins hella easy.

uqkmntyamuqkmntyam2011/08/04 23:04LV0GWW , [url=http://ssntczkglidm.com/]ssntczkglidm[/url], [link=http://ybwyazadkvxq.com/]ybwyazadkvxq[/link], http://tnhbhzdyqjob.com/

xixywzesscxxixywzesscx2011/08/05 22:32WrlimC , [url=http://uxhjuacepxav.com/]uxhjuacepxav[/url], [link=http://mgietljruzer.com/]mgietljruzer[/link], http://tumkfemdvdet.com/