DBIx::Class в примерах

$ dancer -a Web::Log
$ cd Web-Log
CREATE TABLE authors (
    authorid    INTEGER PRIMARY KEY AUTOINCREMENT,
    author      VARCHAR(255) UNIQUE
);

CREATE TABLE posts (
    postid      INTEGER PRIMARY KEY AUTOINCREMENT,
    post        TEXT,
    postime     DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP,
    authorid    REFERENCES authors(authorid)
);

CREATE TABLE comments (
    commentid   INTEGER PRIMARY KEY AUTOINCREMENT,
    comment     TEXT,
    comtime     DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP,
    authorid    REFERENCES authors(authorid),
    postid      REFERENCES posts(postid)
);
$ sqlite3 weblog.db < weblog.sql
$ dbicdump -o dump_directory=./lib  \
    -o components='["InflateColumn::DateTime"]' \
    Web::Blog::Schema    dbi:SQLite:./weblog.db
use utf8;
package Web::Log::Schema;

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_namespaces;

1;
use utf8;
package Web::Log::Schema::Result::Author;

use strict;
use warnings;

use base 'DBIx::Class::Core';

__PACKAGE__->load_components("InflateColumn::DateTime");
__PACKAGE__->table("authors");
__PACKAGE__->add_columns(
  "authorid",
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
  "author",
  { data_type => "varchar", is_nullable => 0, size => 255 },
);

__PACKAGE__->set_primary_key("authorid");

__PACKAGE__->add_unique_constraint("author_unique", ["author"]);

__PACKAGE__->has_many(
  "comments",
  "Web::Log::Schema::Result::Comment",
  { "foreign.authorid" => "self.authorid" },
  { cascade_copy => 0, cascade_delete => 0 },
);

__PACKAGE__->has_many(
  "posts",
  "Web::Log::Schema::Result::Post",
  { "foreign.authorid" => "self.authorid" },
  { cascade_copy => 0, cascade_delete => 0 },
);

1;
use utf8;
package Web::Log::Schema::Result::Post;

use strict;
use warnings;

use base 'DBIx::Class::Core';

__PACKAGE__->load_components("InflateColumn::DateTime");

__PACKAGE__->table("posts");

__PACKAGE__->add_columns(
  "postid",
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
  "post",
  { data_type => "text", is_nullable => 1 },
  "postime",
  {
    data_type     => "datetime",
    default_value => \"current_timestamp",
    is_nullable   => 0,
  },
  "authorid",
  { data_type => "", is_foreign_key => 1, is_nullable => 1 },
);

__PACKAGE__->set_primary_key("postid");

__PACKAGE__->belongs_to(
  "authorid",
  "Web::Log::Schema::Result::Author",
  { authorid => "authorid" },
  {
    is_deferrable => 0,
    join_type     => "LEFT",
    on_delete     => "NO ACTION",
    on_update     => "NO ACTION",
  },
);

__PACKAGE__->has_many(
  "comments",
  "Web::Log::Schema::Result::Comment",
  { "foreign.postid" => "self.postid" },
  { cascade_copy => 0, cascade_delete => 0 },
);

1;
use Web::Log::Schema;

Web::Log::Schema->connect('dbi:SQLite:weblog.db')->deploy;
package Web::Log::DB;
use strict;
use warnings;
use Web::Log::Schema;

my $db;
my $db_file = $ENV{'WEB_LOG_DB'} || 'weblog.db';

# db singleton
sub db {
    $db ||= Web::Log::Schema->connect('dbi:SQLite:'. $db_file);
}

1;
package Web::Log::API;
use Dancer ':syntax';
use Web::Log::DB;

prefix '/api';
set serializer   => 'JSON';
set content_type => 'application/json';
...
get '/authors' => sub {
    my $db = Web::Log::DB->db;
    my $rs = $db->resultset('Author');
    [ $rs->get_column('author')->all ];
};
SELECT author FROM authors
put '/authors/:author' => sub {

    my $author = param('author');
    my $db = Web::Log::DB->db;
    my $rs = $db->resultset('Author');

    eval {
        $rs->create( { author => $author } );
    };

    { status => $@ ? 'failure' : 'success' };
};
INSERT INTO authors(author) VALUES ($author)
get '/posts/post:postid' => sub {
    my $postid = param('postid');
    my $db = Web::Log::DB->db;
    my $post = $db->resultset('Post')->find($postid);

    {
        postid  => $post->postid,
        postime => $post->postime->datetime,
        post => $post->post,
        author => $post->authorid->author,
    }
};
my $post =
  $db->resultset('Post')
  ->find( $postid,
    { result_class => 'DBIx::Class::ResultClass::HashRefInflator' } );
get '/posts/page:page' => sub {

    my $page = param('page');
    my $db = Web::Log::DB->db;
    [
        $db->resultset('Post')->search(
            undef,
            {
                page         => $page,
                rows         => 10,
                result_class => 'DBIx::Class::ResultClass::HashRefInflator'
            }
        )->all
    ];
};
SELECT * FROM posts LIMIT $row, ($page-1)*$row
$db->resultset('Post')->search(
    undef,
    {
        join         => 'comments',
        '+select'    => [ { count => 'commentid' } ],
        '+as'        => [qw(comments_count)],
        group_by     => ['me.postid'],
        page         => $page,
        rows         => 10,
        result_class => 'DBIx::Class::ResultClass::HashRefInflator'
    }
  )->all
SELECT me.postid, me.post, me.postime, me.authorid, COUNT( commentid )
FROM   posts me LEFT JOIN comments comments ON comments.postid = me.postid
GROUP BY me.postid
LIMIT  $row, ($page-1)* $row
post '/posts' => sub {

    my $author = param('author');
    my $post   = param('post');
    my $id;

    eval {
        my $post_ref = Web::Log::DB->db->resultset('Post')->create(
            {
                post     => $post,
                authorid => { author => $author }
            }
        );
        $id = $post_ref->id;
    };

    { status => $@ ? 'failure' : 'success', id => $id };
};
SELECT authorid, author FROM authors WHERE author= "$author"
INSERT INTO posts ( authorid, post) VALUES ( "$post", "$authorid" )
my $post_ref =
  Web::Log::DB->db->resultset('Author')->find( { author => $author } )
  ->create_related( posts => { post => $post } );
put '/posts/post:postid' => sub {
    my $post   = param('post');
    my $postid = param('postid');

    eval {
        Web::Log::DB->db->resultset('Post')->find($postid)
          ->update( { post => $post } );
    };
    { status => $@ ? 'failure' : 'success' };
};
my $p = Web::Log::DB->db->resultset('Post')->find($postid);
$p->post($post);
$p->update();
post '/comments/post:postid' => sub {

    my $author  = param('author');
    my $comment = param('comment');
    my $postid  = param('postid');
    my $id;

    eval {
        $id =
          Web::Log::DB->db->resultset('Author')
          ->find( { author => $author } )
          ->create_related(
            comments => {
                {
                    comment => $comment,
                    postid  => $postid,
                }
            }
          )->id();
    };

    { status => $@ ? 'failure' : 'success', id => $id };
};
get '/comments/post:postid' => sub {
    my $postid = param('postid');
    [
        Web::Log::DB->db->resultset('Comment')->search(
            { postid => $postid },
            {
                order_by => 'commentid',
                result_class => 'DBIx::Class::ResultClass::HashRefInflator'
            }
        )->all
    ];
};
del '/comments/comment:commentid' => sub {

    my $commentid = param('commentid');

    eval {
        Web::Log::DB->db->resultset('Comment')
          ->find($commentid)->delete();
    };

    { status => $@ ? 'failure' : 'success' };
};
package Web::Log;
use Dancer ':syntax';
use Web::Log::API;

our $VERSION = '0.1';

prefix undef;
set content_type => 'text/html';

get '/' => sub {
    template 'index';
};

true;
$ perl -Ilib bin/app.pl

Pragmatic Perl

Выпуск 6. Август 2013

DBIx::Class в примерах

Зачем нужен DBIx::Class да и ORM вообще?

История DBIx::Class

Создание приложения на DBIx::Class

Схема базы данных

Объектное представление схемы базы данных

Подключение к базе данных

RESTful API

Авторы

Посты

Комментарии

Запуск приложения

Заключение

Комментарии к статье