

Class::DBI、ActiveRecordの影響が大きい?
たぶん全部Active Recordパターン
use DBIx::ObjectMapper;
use DBIx::ObjectMapper::Engine::DBI;
my $mapper = DBIx::ObjectMapper->new(
engine => DBIx::ObjectMapper::Engine::DBI->new({
dsn => 'DBI:SQLite:',
username => undef,
password => undef,
}),
);
CREATE TABLE users (
id INTEGER NOT NULL PRIMARY KEY,
name TEXT
);
package User;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'name' => ( is => 'rw', isa => 'Str' );
__PACKAGE__->meta->make_immutable;
my $user_table = $mapper->metadata->table(
'users' => 'autoload'
);
$mapper->maps( $user_table => 'User' );
my $session = $mapper->begin_session( autocommit => 0 );
my $user = User->new( name => 'username' );
$session->add($user);
$session->commit;
# BEGIN;
# INSERT INTO users ( name ) VALUES ('username');
# COMMIT;
my $session = $mapper->begin_session( autocommit => 0 );
my $user = $session->get( 'User' => 1 );
# SELECT users.id, users.name FROM users WHERE ( users.id = 1 );
$user->id;
$user->title;
my $session = $mapper->begin_session( autocommit => 0 );
my $user = $session->get( 'User' => 1 );
# SELECT users.id, users.name FROM users WHERE ( users.id = 1 );
$user->name('名前');
$session->commit;
# BEGIN;
# UPDATE users SET name = '名前' WHERE ( users.id = 1 );
# COMMIT;
my $session = $mapper->begin_session( autocommit => 0 );
my $user = $session->get( 'User' => 1 );
# SELECT users.id, users.name FROM users WHERE ( users.id = 1 );
$session->delete($user);
$session->commit;
# BEGIN;
# DELETE FROM users WHERE ( users.id = 1 );
# COMMIT;
データベースへの操作はSessionを経由してMapperに伝える
my $session = $mapper->begin_session;
$session->add($obj);
$session->get( 'ClassName' => 'primary key' );
$session->delete($obj);
my $session = $mapper->begin_session(
# autocommit => 1,
# autoflush => 0,
);
$obj->name('なまえ');
$session->add($obj2);
$session->delete($obj3);
undef($session);
# UPDATE ...
# INSERT ...
# DELETE ...
my $session = $mapper->begin_session(
autocommit => 0,
autoflush => 0,
);
# BEGIN;
$obj->name('なまえ');
$session->add($obj2);
$session->delete($obj3);
undef($session);
# UPDATE ...
# INSERT ...
# DELETE ...
# ROLLBACK;
my $session = $mapper->begin_session(
autocommit => 0,
autoflush => 0,
);
# BEGIN;
$obj->name('なまえ');
$session->add($obj2);
$session->delete($obj3);
$session->commit;
# UPDATE ...
# INSERT ...
# DELETE ...
# COMMIT;
undef($session);
my $session = $mapper->begin_session(
autocommit => 0,
autoflush => 0,
);
# BEGIN;
$obj->name('なまえ');
$session->add($obj2);
$session->delete($obj3);
$session->flush;
# UPDATE ...
# INSERT ...
# DELETE ...
$session->commit;
# COMMIT;
undef($session);
my $session = $mapper->begin_session( share_object => 0 );
my $obj1 = $session->get( 'User' => 1 );
my $obj2 = $session->get( 'User' => 1 ); # cache
# $obj1 != $obj2
my $session = $mapper->begin_session( share_object => 1 );
my $obj1 = $session->get( 'User' => 1 );
my $obj2 = $session->get( 'User' => 1 ); # cache
# $obj1 == $obj2
use DBIx::ObjectMapper;
use DBIx::ObjectMapper::Engine::DBI;
my $mapper = DBIx::ObjectMapper->new(
engine => DBIx::ObjectMapper::Engine::DBI->new({
dsn => 'DBI:SQLite:',
username => undef,
password => undef,
}),
session_attr => {
autocommit => 0,
no_cache => 1,
},
);
my $session = $mapper->begin_session();
# autocommit => 0, no_cache => 1
my $session = $mapper->begin_session( autocommit => 1 );
my $attr = $mapper->attribute('User');
my $it = $session->search('User')
->filter( $attr->prop('id') > 10 )
->execute;
while( my $user = $it->next ) {
# SELECT users.id, users.name FROM users WHERE ( users.id > 10 ) ORDER BY users.id;
$user->id;
$user->name;
}
my $attr = $mapper->attribute('User');
$attr->prop('id') == 1; # => users.id = 1
$attr->prop('id') > 1; # => users.id > 1
$attr->prop('id') >= 1; # => users.id >= 1
$attr->prop('id') < 1; # => users.id < 1
$attr->prop('id') <= 1; # => users.id <= 1
$attr->prop('id') != 1; # => users.id <> 1
$attr->prop('id') == undef; # => users.id IS NULL
$attr->prop('id') != undef; # => users.id IS NOT NULL
$attr->prop('id') == [1,2,3,4]; # => users.id IN (1,2,3,4)
$attr->prop('id')->between( 1,4 ); # => users.id BETWEEN 1 AND 4
$attr->prop('name')->like( '%name%' );# => users.name LIKE '%name%'
$attr->prop('name')->not_like( '%name%' );# => users.name NOT LIKE '%name%'
$attr->prop('name')->op( '%%', 'あ' );# => users.name %% 'あ'
my $it = $session->search('User')
->filter(
$attr->prop('id') > 10,
$attr->prop('name')->like('%name%'),
);
# id > 10 AND name LIKE '%name%'
my $it = $session->search('User')
->filter(
{
OR => [
$attr->prop('id') > 10,
$attr->prop('name')->like('%name%'),
],
},
);
# id > 10 OR name LIKE '%name%'
my $session = $mapper->begin_session( autocommit => 1 );
my $attr = $mapper->attribute('User');
my $id = $attr->prop('id');
my $name = $attr->prop('name');
my $query = $session->search('User')
->filter( $id == [1,2,3,4] )
->order_by( $id );
$query->add_filter( $name->like('%name%') );
->add_order_by( $name->desc );
my $it = $query->execute;
while( my $user = $it->next ) {
# .....
}
my $session = $mapper->begin_session( autocommit => 1 );
my $attr = $mapper->attribute('User');
my $query = $session->search('User')
->limit(10)
->order_by( $attr->prop('id') );
my ( $it, $pager ) = $query->page(1);
# ref($pager) eq 'Data::Page';
while( my $user = $it->next ) {
# ....
}
CREATE TABLE addresses (
id INTEGER NOT NULL PRIMARY KEY,
user_id INTEGER NOT NULL REFERENCES users(id),
address TEXT
);
package Address;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'user_id' => ( is => 'rw', isa => 'Int' );
has 'address' => ( is => 'rw' );
__PACKAGE__->meta->make_immutable;
package User;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'name' => ( is => 'rw', isa => 'Str' );
has 'addresses' => ( is => 'rw', isa => 'Maybe[ArrayRef[Address]]' );
__PACKAGE__->meta->make_immutable;
my $address_table = $mapper->metadata->table(
'addresses' => 'autoload' );
$mapper->maps( $address_table => 'Address' );
$mapper->maps(
$user_table => 'User',
attributes => {
properties => {
addresses => {
isa => $mapper->relation(
has_many => 'Address',
{ order_by => $address_table->c('id') }
),
}
}
}
);
my $session = $mapper->begin_session( autocommit => 0 );
my $user = $session->get( 'User' => 1 );
# SELECT users.id, users.title FROM users WHERE users.id = 1;
my $addresses = $user->addresses;
# SELECT addresses.id, addresses.user_id, addresses.address FROM addresses WHERE addresses.user_id = 1 ORDER BY addresses.id
for my $address ( @$addresses ) {
$address->address;
}
package Address;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'user_id' => ( is => 'rw', isa => 'Int' );
has 'address' => ( is => 'rw' );
has 'user' => ( is => 'rw', isa => 'User' );
__PACKAGE__->meta->make_immutable;
my $address_table = $mapper->metadata->table('addresses');
$mapper->maps(
$address_table => 'Address',
attributes => {
properties => {
user => {
isa => $mapper->relation(
'belongs_to' => 'User'
),
}
}
},
);
my $session = $mapper->begin_session( autocommit => 0 );
my $address = $session->get( 'Address' => 1 );
# SELECT address.id, address.address, address.user_id FROM address WHERE address.id = 1;
$address->user_id;
$address->user;
# SELECT users.id, users.name FROM users WHERE users.id = 1
$address->user->name;
CREATE TABLE profile (
id INTEGER NOT NULL PRIMARY KEY REFERENCES users(id),
body_text TEXT
);
package Profile;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'body_text' => ( is => 'rw' );
__PACKAGE__->meta->make_immutable;
package User;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'name' => ( is => 'rw', isa => 'Str' );
has 'addresses' => ( is => 'rw', isa => 'Maybe[ArrayRef[Address]]' );
has 'profile' => ( is => 'rw', isa => 'Maybe[Profile]' );
__PACKAGE__->meta->make_immutable;
my $profile_table = $mapper->metadata->t(
'profile' => 'autoload'
);
$mapper->maps( $profile_table => 'Profile' );
$mapper->maps(
$user_table => 'User',
attributes => {
properties => {
addresses => {
isa => $mapper->relation(
has_many => 'Address',
{ order_by => $address_table->c('id') }
),
},
profile => {
isa => $mapper->relation(
has_one => 'Profile'
)
},
}
}
);
CREATE TABLE issues (
id INTEGER NOT NULL PRIMARY KEY,
title TEXT
);
CREATE TABLE user_issues (
user_id INTEGER NOT NULL REFERENCES users(id),
issue_id INTEGER NOT NULL REFERENCES issues(id)
);
my $issue_table = $mapper->metadata->t('issues' => 'autoload');
my $user_issue_table = $mapper->metadata->t(
'user_issues' => 'autoload');
$mapper->maps(
$issue_table => 'Issue',
constructor => { auto => 1 },
accessors => { auto => 1 },
); # 自動でIssueクラスが作成される
$mapper->maps(
$user_table => 'User',
attributes => {
properties => {
issues => {
isa => $mapper->relation(
many_to_many
=> $user_issue_table => 'Issue',
)
}
}
}
);
my $session = $mapper->begin_session( autocommit => 0 );
my $user = $session->get( 'User' => 1 );
my $issues = $user->issues;
for my $issue (@$issues) {
$issue->title;
}
push @$issues, Issue->new( title => 'new issue' );
$session->commit;
# INSERT INTO issues ( title ) VALUES ('new issue');
# INSERT INTO user_issues ( issue_id, user_id ) VALUES (2,1)
CREATE TABLE comments (
id INTEGER NOT NULL PRIMARY KEY,
comment TEXT,
reply_to INTEGER REFERENCES comments(id)
);
my $comment_table = $mapper->metadata->table('comments');
$mapper->maps(
$comment_table => 'Comment',
constructor => { auto => 1 },
accessors => { auto => 1 },
attributes => {
properties => {
replies => {
isa => $mapper->relation(
'has_many' => 'Comment'
),
},
parent => {
isa => $mapper->relation(
'belongs_to' => 'Comment'
),
}
}
}
);
my $session = $mapper->begin_session( autocommit => 0 );
my $first = Comment->new( comment => 'first comment' );
$session->add($first);
$session->commit;
# INSERT INTO comments ( comment ) VALUES ('first comment');
my $second = Comment->new(
comment => 'second comment',
reply_to => $first->id,
);
# SELECT comments.id, comments.comment, comments.reply_to FROM comments WHERE ( comments.id = 1 )
$session->add($second);
$session->commit;
# INSERT INTO comments ( comment, reply_to ) VALUES ('second comment',1);
for my $reply ( @{$first->replies} ) {
# SELECT comments.comment, comments.reply_to, comments.id FROM comments WHERE ( comments.reply_to = 1 ) ORDER BY comments.id
$reply->comment;
$reply->parent->comment; # cache
}
my $session = $mapper->begin_session( autocommit => 0 );
my $attr = $mapper->attribute('User');
my $it = $session->search('User')->filter(
$attr->prop('addresses.address')->like('東京都%') )->execute;
while ( my $user = $it->next ) {
# SELECT users.name, users.id FROM users LEFT OUTER JOIN address AS addresses ON ( addresses.user_id = users.id ) WHERE ( addresses.address LIKE '東京都%' ) GROUP BY users.name, users.id
}
Relationを設定している属性にドット(.)をつけて、その先の属性を参照できる(addresses => Address => address )
ただし、Relation先のデータはとってこない
リレーションのデータまで一気に1回で取得
my $attr = $mapper->attribute('User');
my $it = $session->search('User')
->eagerload( $attr->prop('addresses') )
->execute;
while( my $u = $it->next ) {
# SELECT users.name, users.id, addresses.id, addresses.user_id, addresses.address FROM users LEFT OUTER JOIN address AS addresses ON ( addresses.user_id = users.id )
$u->id;
$u->addresses;
}
my $session = $mapper->begin_session( autocommit => 0 );
$session->get( 'User' => 1, { eagerload => 'addresses' } );
# SELECT users.name, users.id, addresses.id, addresses.user_id, addresses.address FROM users LEFT OUTER JOIN address AS addresses ON ( addresses.user_id = users.id ) WHERE ( users.id = ? )
$mapper->maps(
$table_metadata => 'ClassName',
constructor => {
name => 'new',
arg_type => 'HASHREF',
auto => 0,
}
);
$mapper->maps(
$table_metadata => 'ClassName',
attributes => {
prefix => '',
include => [],
exclude => [],
properties => +{},
}
);
$mapper->maps(
$table_metadata => 'ClassName',
attributes => {
properties => +{
col => {
isa => $table_metadata->column('col'),
getter => 'col',
setter => 'col',
lazy => 0,
}
},
}
);
$mapper->maps(
$table_metadata => 'ClassName',
accessors => {
auto => 0,
do_replace => 0,
exclude => [],
generic_getter => '',
generic_setter => '',
}
)
package User;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
__PACAKGE__->mk_accessors(qw(id name));
sub new {
my $class = shift;
my ( $id, $title ) = @_;
bless {
id => $id,
name => $name,
}, $class;
}
1;
$mapper->maps(
$user_table => 'User',
contstructor => { arg_type => 'ARRAY' },
attributes => {
properties => [
{ isa => $user_table->c('id') },
{ isa => $user_table->c('name') },
]
}
);
package User;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
__PACAKGE__->mk_accessors(qw(id name));
sub new {
my $class = shift;
my ( $id, $title ) = @{$_[0]};
bless {
id => $id,
name => $name,
}, $class;
}
1;
$mapper->maps(
$user_table => 'User',
contstructor => { arg_type => 'ARRAYREF' },
attributes => {
properties => [
{ isa => $user_table->c('id') },
{ isa => $user_table->c('name') },
]
}
);
package User;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
sub param {
my $self = shift;
if( @_ == 2 ) {
$self->{$_[0]} = $_[1];
}
elsif( @_ == 1 ) {
$self->{$_[0]};
}
}
1;
$mapper->maps(
$user_table => 'User',
accessors => {
generic_getter => 'param',
generic_setter => 'param',
},
);
$mapper->maps(
$user_table => 'User',
contstructor => { auto => 1 },
accessors => { auto => 1 },
);
CREATE TABLE users (
id INTEGER NOT NULL PRIMARY KEY,
name TEXT,
type TEXT
);
package User;
use Any::Moose;
has 'id' => ( is => 'rw', isa => 'Int' );
has 'name' => ( is => 'rw', isa => 'Str' );
has 'type' => ( is => 'rw', isa => 'Maybe[Str]' );
__PACKAGE__->meta->make_immutable;
package User::Gold;
use Any::Moose;
extends 'User';
__PACKAGE__->meta->make_immutable;
package User::Silver;
use Any::Moose;
extends 'User';
__PACKAGE__->meta->make_immutable;
$mapper->maps(
$user_table => 'User',
polymorphic_on => 'type',
);
$mapper->maps(
$user_table => 'User::Gold',
polymorphic_identity => 'gold',
inherits => 'User',
);
$mapper->maps(
$user_table => 'User::Silver',
polymorphic_identity => 'silver',
inherits => 'User',
);
!mappingの設定は単一継承
my $session = $mapper->begin_session( autocommit => 0 );
$session->add( User->new( name => 'normal user' ) );
$session->add( User::Gold->new( name => 'gold user' ) );
$session->add( User::Silver->new( name => 'silver user' ) );
$session->commit;
# INSERT INTO users ( name ) VALUES ( 'normal user' );
# INSERT INTO users ( name, type ) VALUES ( 'gold user', 'gold');
# INSERT INTO users ( name, type ) VALUES ( 'silver user', 'silver');
my $session = $mapper->begin_session( autocommit => 0 );
my @all = @{ $session->search('User')->execute };
# SELECT users.name, users.type, users.id FROM users;
my @gold = @{ $session->search('User::Gold')->execute };
# SELECT users.name, users.type, users.id FROM users WHERE ( users.type = 'gold';
my @silver = @{ $session->search('User::Silver')->execute };
# SELECT users.name, users.type, users.id FROM users WHERE ( users.type = 'silver';
my $session = $mapper->begin_session( autocommit => 0 );
my @all = @{ $session->search('User')
->with_polymorphic('*')->execute };
# SELECT users.name, users.type, users.id FROM users;
(
bless({ id => 1, name => "normal user", type => undef }, "User"),
bless({ id => 2, name => "gold user", type => "gold" }, "User::Gold"),
bless({ id => 3, name => "silver user", type => "silver" }, "User::Silver"),
)
CREATE TABLE gold_users (
id INTEGER NOT NULL PRIMARY KEY,
point INTEGER NOT NULL,
FOREIGN KEY(id) REFERENCES users(id)
);
my $gold_user_table = $mapper->metadata->table(
'gold_users' => 'autoload'
);
$mapper->maps(
$gold_user_table => 'User::Gold',
polymorphic_identity => 'gold',
inherits => 'User',
);
package User::Gold;
use Any::Moose;
extends 'User';
has 'point' => ( is => 'rw', point => 'Int' );
__PACKAGE__->meta->make_immutable;
my $session = $mapper->begin_session( autocommit => 0 );
$session->add(
User::Gold->new( name => 'gold user', point => 100 ) );
$session->commit;
# INSERT INTO users ( name, type ) VALUES ('gold user', 'gold');)
# INSERT INTO gold_users ( id, point ) VALUES (2, 100);
my $session = $mapper->begin_session( autocommit => 0 );
my @all = @{ $session->search('User')
->with_polymorphic('*')->execute };
# SELECT users.name, users.type, users.id, gold_users.point FROM users LEFT OUTER JOIN gold_users ON ( gold_users.id = users.id )
データベーススキーマを保持している
MapperはMetadataを経由してEngineと通信している
Foreign Keyを定義したいけど、データベースには定義されていない場合
use DBIx::ObjectMapper::Metadata::Sugar qw(:all);
$mapper->metadata->table(
'addresses' => [
Col( 'user_id' => ForeignKey( 'users' => 'id' ) ),
] => { autoload => 1 },
);
use DBIx::ObjectMapper::Metadata::Sugar qw(:all);
$mapper->metadata->table(
'user' => [
Col( 'yaml_data' => Yaml ), # TEXT
Col( 'stotorable_data' => Mush ), # TEXT
Col( 'myuri' => Uri ), # VARCHAR(256)
] => { autoload => 1 },
);
Array, BigInt, Binary, Bit, Boolean, Date, Datetime, Float, Int, Interval, Mush, Numeric, SmallInt, String, Text, Time, Undef, Uri, Yaml
use DBIx::ObjectMapper::Metadata::Sugar qw(:all);
$mapper->metadata->table(
'user' => [
Col( created => Default{ DateTime->now() } ),
Col( modified => OnUpdate{ DateTime->now() } ),
]
);
use DBIx::ObjectMapper::Metadata::Sugar qw(:all);
$mapper->metadata->table(
'user' => [
Col( modified =>
OnUpdate{ DateTime->now() },
FromStorage { ... CODE ... },
ToStorage { ... CODE ... },
),
]
);
my $metadata = $mapper->metadata;
my $user_table = $metadata->table('users');
# insert
$metadata->insert
->into('users')
->values( name => 'user1' )
->execute;
# or
$user_table->insert->values( name => 'user2' )->execute;
my $metadata = $mapper->metadata;
my $user_table = $metadata->table('users');
$metadata->update->table('users')
->set( name => 'ユーザ1')
->where( $user_table->c('id') == 1 )
->execute();
$user_table->update->set( name => 'ユーザ1')
->where( $user_table->c('id') == 1 )
->execute;
my $metadata = $mapper->metadata;
my $user_table = $metadata->table('users');
$metadata->delete->table('users')
->where( $user_table->c('id') == 1 )
->execute();
$user_table->delete
->where( $user_table->c('id') == 1 )
->execute;
my $metadata = $mapper->metadata;
my $user_table = $metadata->table('users');
my $it = $metadata->select
->table('users')
->where( $user_table->c('id') == 1 )
->execute();
# or
my $it = $user_table->select
->where( $user_table->c('id') == 1 )
->execute;
while( my $result = $it->next ) {
# SELECT * FROM users WHERE users.id = 1;
$result->{id};
$result->{name};
}
my $metadata = $mapper->metadata;
my $user_table = $metadata->table('users');
my $it = $user_table->select
->column( $user_table->c('name') )
->where( $user_table->c('id') == 1 )
->execute;
while( my $result = $it->next ) {
# SELECT users.name FROM users WHERE users.id = 1;
$result->{name};
}
my $user_table = $mapper->metadata->table('users');
my $user = $user_table->find(1);
$user->{id};
$user->{name};
my $user_table = $mapper->metadata->table('users');
$user_table->select
->column({count=>'*'})
->first->{count};
my $cnt = $user_table->count->execute;
my $user_table = $mapper->metadata->table('users');
$user_table->select
->column({count=>'*'})
->first->{count};
my $cnt = $user_table->count->execute;
my $user_table = $mapper->metadata->table('users');
my $addr_table = $mapper->metadata->table('addresses');
my $query = $user_table->select
->join([
$addr_tables => [
$address->c('person') == $person->c('id')
]
])
->column( @{$user_table->columns} )
->order_by( $user_table->c('id') );
$query->add_column(@{$addr_table->columns});
my $it = $query->execute;
while( my $result = $it->next ) {
$result->{id};
$result->{name};
$result->{addresses}{address};
$result->{addresses}{user_id};
}
my $it = $user_table->select->where(
$user_table->c('id')->in(
$user_table->select->column( $user_table->c('id') )
)
)->execute;