File Coverage

blib/lib/Aniki.pm

Criterion	Covered	Total	%
statement	315	394	79.9
branch	108	170	63.5
condition	25	39	64.1
subroutine	70	90	77.7
pod	28	44	63.6
total	546	737	74.0

package Aniki;
use 5.014002;

use namespace::autoclean;
use Mouse v2.4.5;

use Module::Load ();
use Aniki::Filter;
use Aniki::Handler;
use Aniki::Row;
use Aniki::Result::Collection;
use Aniki::Schema;
use Aniki::QueryBuilder;
use Aniki::QueryBuilder::Canonical;

our $VERSION = '1.05';

use SQL::Maker::SQLType qw/sql_type/;
use Class::Inspector;
use Carp qw/croak confess/;
use Try::Tiny;
use Scalar::Util qw/blessed/;
use String::CamelCase qw/camelize/;
use SQL::NamedPlaceholder qw/bind_named/;

sub _noop {}

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my %args  = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    if (not exists $args{handler}) {
        my $connect_info     = delete $args{connect_info} or confess 'Attribute (connect_info) is required';
        my $on_connect_do    = delete $args{on_connect_do};
        my $on_disconnect_do = delete $args{on_disconnect_do};
        my $trace_query      = delete $args{trace_query} || 0;
        my $trace_ignore_if  = delete $args{trace_ignore_if} || \&_noop;
        $args{handler} = $class->handler_class->new(
            connect_info     => $connect_info,
            on_connect_do    => $on_connect_do,
            on_disconnect_do => $on_disconnect_do,
            trace_query      => $trace_query,
            trace_ignore_if  => $trace_ignore_if,
        );
    }

    return $class->$orig(\%args);
};

has handler => (
    is       => 'ro',
    required => 1,
);

has suppress_row_objects => (
    is      => 'rw',
    default => 0,
);

has suppress_result_objects => (
    is      => 'rw',
    default => 0,
);

sub _database2driver {
    my ($class, $database) = @_;
    state $map = {
        MySQL      => 'mysql',
        PostgreSQL => 'Pg',
        SQLite     => 'SQLite',
        Oracle     => 'Oracle',
        DB2        => 'DB2',
    };
    return $map->{$database};
}

sub schema              { croak 'This is abstract method. (required to call setup method before call it)' }
sub query_builder       { croak 'This is abstract method. (required to call setup method before call it)' }
sub filter              { croak 'This is abstract method. (required to call setup method before call it)' }
sub last_insert_id      { croak 'This is abstract method. (required to call setup method before call it)' }
sub root_row_class      { croak 'This is abstract method. (required to call setup method before call it)' }
sub guess_row_class     { croak 'This is abstract method. (required to call setup method before call it)' }
sub root_result_class   { croak 'This is abstract method. (required to call setup method before call it)' }
sub guess_result_class  { croak 'This is abstract method. (required to call setup method before call it)' }
sub handler_class       { 'Aniki::Handler' }

# You can override this method on your application.
sub use_prepare_cached       { 1 }
sub use_strict_query_builder { 1 }

sub setup {
    my ($class, %args) = @_;

    # schema
    if (my $schema_class = $args{schema}) {
        Module::Load::load($schema_class) unless Class::Inspector->loaded($schema_class);

        my $schema = Aniki::Schema->new(schema_class => $schema_class);
        $class->meta->add_method(schema => sub { $schema });
    }
    else {
        croak 'schema option is required.';
    }

    # filter
    if (my $filter_class = $args{filter}) {
        Module::Load::load($filter_class) unless Class::Inspector->loaded($filter_class);

        my $filter = $filter_class->instance();
        $class->meta->add_method(filter => sub { $filter });
    }
    else {
        my $filter = Aniki::Filter->new;
        $class->meta->add_method(filter => sub { $filter });
    }

    # handler
    if (my $handler_class = $args{handler}) {
        Module::Load::load($handler_class) unless Class::Inspector->loaded($handler_class);
        $class->meta->add_method(handler_class => sub { $handler_class });
    }

    # last_insert_id
    {
        my $driver = lc $class->_database2driver($class->schema->database);
        my $method = $class->can("_fetch_last_insert_id_from_$driver") or Carp::croak "Don't know how to get last insert id for $driver";
        $class->meta->add_method(last_insert_id => $method);
    }

    # query_builder
    {
        my $query_builder_class = $class->use_prepare_cached ? 'Aniki::QueryBuilder::Canonical' : 'Aniki::QueryBuilder';
        if ($args{query_builder}) {
            Module::Load::load($args{query_builder}) unless Class::Inspector->loaded($args{query_builder});
            $query_builder_class = $args{query_builder};
        }
        my $driver        = $class->_database2driver($class->schema->database);
        my $query_builder = $query_builder_class->new(driver => $driver, strict => $class->use_strict_query_builder);
        $class->meta->add_method(query_builder => sub { $query_builder });
    }

    # row
    {
        my $root_row_class = 'Aniki::Row';
        my $guess_row_class = sub { $root_row_class };
        if ($args{row}) {
            Module::Load::load($args{row}) unless Class::Inspector->loaded($args{row});
            $root_row_class = $args{row};

            my %table_row_class;
            $guess_row_class = sub {
                my $table_name = $_[1];
                return $table_row_class{$table_name} //= try {
                    my $table_row_class = sprintf '%s::%s', $root_row_class, camelize($table_name);
                    Module::Load::load($table_row_class);
                    return $table_row_class;
                } catch {
                    die $_ unless /\A\QCan't locate/imo;
                    return $root_row_class;
                };
            };
        }
        $class->meta->add_method(root_row_class => sub { $root_row_class });
        $class->meta->add_method(guess_row_class => $guess_row_class);
    }

    # result
    {
        my $root_result_class = 'Aniki::Result::Collection';
        my $guess_result_class = sub { $root_result_class };
        if ($args{result}) {
            Module::Load::load($args{result}) unless Class::Inspector->loaded($args{result});
            $root_result_class = $args{result};

            my %table_result_class;
            $guess_result_class = sub {
                my $table_name = $_[1];
                return $table_result_class{$table_name} //= try {
                    my $table_result_class = sprintf '%s::%s', $root_result_class, camelize($table_name);
                    Module::Load::load($table_result_class);
                    return $table_result_class;
                } catch {
                    die $_ unless /\A\QCan't locate/imo;
                    return $root_result_class;
                };
            };
        }

        $class->meta->add_method(root_result_class => sub { $root_result_class });
        $class->meta->add_method(guess_result_class => $guess_result_class);
    }
}

sub preload_all_row_classes {
    my $class = shift;
    for my $table ($class->schema->get_tables) {
        $class->guess_row_class($table->name);
    }
}

sub preload_all_result_classes {
    my $class = shift;
    for my $table ($class->schema->get_tables) {
        $class->guess_result_class($table->name);
    }
}

sub dbh {
    my $self = shift;
    # (for mysql)
    # XXX: `DBIx::Handler#dbh` send a ping to mysql.
    #      But, It removes `$dbh->{mysql_insertid}`.
    return $self->{_context} if exists $self->{_context};
    return $self->handler->dbh;
}

sub insert {
    my ($self, $table_name, $row, $opt) = @_;
    $row = $self->filter_on_insert($table_name, $row) unless $opt->{no_filter};

    my $table = $self->schema->get_table($table_name);
    $row = $self->_bind_sql_type_to_args($table, $row) if $table;

    my ($sql, @bind) = $self->query_builder->insert($table_name, $row, $opt);
    $self->execute($sql, @bind);
    return;
}

sub filter_on_insert {
    my ($self, $table_name, $row) = @_;
    $row = $self->filter->apply_trigger(insert => $table_name, $row);
    return $self->filter->deflate_row($table_name, $row);
}

sub update {
    my ($self, $table_name, $set, $where, $opt) = @_;

    # migrate for ($self, $row, $set, $opt)
    if (blessed $_[1] && $_[1]->isa('Aniki::Row')) {
        my $row = $_[1];
        $table_name = $row->table_name;
        $set = $_[2];
        $where = $self->_where_row_cond($row->table, $row->row_data);
        $opt = $_[3];
    }

    croak '(Aniki#update) `set` is required for update ("SET" parameter)' unless $set && %$set;
    croak '(Aniki#update) `where` condition must be a reference' unless ref $where;

    $set = $self->filter_on_update($table_name, $set) unless $opt->{no_filter};

    my $table = $self->schema->get_table($table_name);
    if ($table) {
        $set   = $self->_bind_sql_type_to_args($table, $set);
        $where = $self->_bind_sql_type_to_args($table, $where);
    }

    my ($sql, @bind) = $self->query_builder->update($table_name, $set, $where);
    return $self->execute($sql, @bind)->rows;
}

sub update_and_fetch_row {
    my ($self, $row, $set) = @_;
    croak '(Aniki#update_and_fetch_row) condition must be a Aniki::Row object.'
        unless blessed $row && $row->isa('Aniki::Row');

    my $emulated_row_data = $self->_update_and_emulate_row_data($row, $set);

    my $where = $self->_where_row_cond($row->table, $emulated_row_data);
    return $self->select($row->table_name, $where, { limit => 1, suppress_result_objects => 1 })->[0];
}

sub update_and_emulate_row {
    my ($self, $row, $set) = @_;
    croak '(Aniki#update_and_emulate_row) condition must be a Aniki::Row object.' unless blessed $row && $row->isa('Aniki::Row');

    my $emulated_row_data = $self->_update_and_emulate_row_data($row, $set);
    return $emulated_row_data if $self->suppress_row_objects;

    return $self->guess_row_class($row->table_name)->new(
        table_name => $row->table_name,
        handler    => $self,
        row_data   => $emulated_row_data,
    );
}

sub _update_and_emulate_row_data {
    my ($self, $row, $set) = @_;
    $set = $self->filter_on_update($row->table_name, $set);
    $self->update($row, $set, { no_filter => 1 });
    return {
        %{ $row->row_data },
        %$set,
    };
}

sub delete :method {
    my $self = shift;
    if (blessed $_[0] && $_[0]->isa('Aniki::Row')) {
        return $self->delete($_[0]->table_name, $self->_where_row_cond($_[0]->table, $_[0]->row_data), @_);
    }
    else {
        my ($table_name, $where, $opt) = @_;
        croak '(Aniki#delete) `where` condition must be a reference' unless ref $where;

        my $table = $self->schema->get_table($table_name);
        if ($table) {
            $where = $self->_bind_sql_type_to_args($table, $where);
        }

        my ($sql, @bind) = $self->query_builder->delete($table_name, $where, $opt);
        return $self->execute($sql, @bind)->rows;
    }
}

sub filter_on_update {
    my ($self, $table_name, $row) = @_;
    $row = $self->filter->apply_trigger(update => $table_name, $row);
    return $self->filter->deflate_row($table_name, $row);
}

sub insert_and_fetch_id {
    my $self = shift;

    local $self->{_context} = $self->dbh;
    $self->insert(@_);
    return unless defined wantarray;

    my $table_name = shift;
    return $self->last_insert_id($table_name);
}

sub insert_and_fetch_row {
    my $self       = shift;
    my $table_name = shift;
    my $row_data   = shift;

    my $table = $self->schema->get_table($table_name) or croak "$table_name is not defined in schema.";

    local $self->{_context} = $self->dbh;

    $self->insert($table_name, $row_data, @_);
    return unless defined wantarray;

    my $row = $self->select($table_name, $self->_where_row_cond($table, $row_data), { limit => 1, suppress_result_objects => 1 })->[0];
    return $row if $self->suppress_row_objects;

    $row->is_new(1);
    return $row;
}

sub insert_and_emulate_row {
    my ($self, $table_name, $row, $opt) = @_;

    my $table = $self->schema->get_table($table_name) or croak "$table_name is not defined in schema.";

    local $self->{_context} = $self->dbh;

    $row = $self->filter_on_insert($table_name, $row) unless $opt->{no_filter};

    $self->insert($table_name, $row, { %$opt, no_filter => 1 });
    return unless defined wantarray;

    my %row_data;
    for my $field ($table->get_fields) {
        if (exists $row->{$field->name}) {
            $row_data{$field->name} = $row->{$field->name};
        }
        elsif (defined(my $default_value = $field->default_value)) {
            $row_data{$field->name} = ref $default_value eq 'SCALAR' ? undef : $default_value;
        }
        elsif ($field->is_auto_increment) {
            $row_data{$field->name} = $self->last_insert_id($table_name, $field->name);
        }
        else {
            $row_data{$field->name} = undef;
        }
    }
    return \%row_data if $self->suppress_row_objects;
    return $self->guess_row_class($table_name)->new(
        table_name => $table_name,
        handler    => $self,
        row_data   => \%row_data,
        is_new     => 1,
    );
}

sub insert_on_duplicate {
    my ($self, $table_name, $insert, $update) = @_;
    if ($self->schema->database ne 'MySQL') {
        Carp::croak 'Cannot use insert_on_duplicate (unsupported without MySQL)';
    }

    $insert = $self->filter_on_insert($table_name, $insert);
    $update = $self->filter_on_update($table_name, $update);

    my $table = $self->schema->get_table($table_name);
    if ($table) {
        $insert = $self->_bind_sql_type_to_args($table, $insert);
        $update = $self->_bind_sql_type_to_args($table, $update);
    }

    my ($sql, @bind) = $self->query_builder->insert_on_duplicate($table_name, $insert, $update);
    $self->execute($sql, @bind);
    return;
}

sub insert_multi {
    my ($self, $table_name, $values, $opts) = @_;
    return unless @$values;

    $opts = defined $opts ? {%$opts} : {};

    my @values = map { $self->filter_on_insert($table_name, $_) } @$values;
    if (exists $opts->{update}) {
        if ($self->schema->database ne 'MySQL') {
            Carp::croak 'Cannot use insert_multi with update option (unsupported without MySQL)';
        }
        $opts->{update} = $self->filter_on_update($table_name, $opts->{update});
    }

    my $table = $self->schema->get_table($table_name);
    if ($table) {
        $_ = $self->_bind_sql_type_to_args($table, $_) for @values;
        if (exists $opts->{update}) {
            $opts->{update} = $self->_bind_sql_type_to_args($table, $opts->{update});
        }
    }

    if ($self->schema->database eq 'MySQL') {
        my ($sql, @bind) = $self->query_builder->insert_multi($table_name, \@values, $opts);
        $self->execute($sql, @bind);
    }
    else {
        $self->txn(sub {
            local $self->{_context} = shift;
            $self->insert($table_name, $_, $opts) for @values;
        });
    }
    return;
}

sub _where_row_cond {
    my ($self, $table, $row_data) = @_;
    die "@{[ $table->name ]} doesn't have primary key." unless $table->primary_key;

    # fetch by primary key
    my %where;
    for my $pk ($table->primary_key->fields) {
        $where{$pk->name} = exists $row_data->{$pk->name} ? $row_data->{$pk->name}
                          : $pk->is_auto_increment        ? $self->last_insert_id($table->name, $pk->name)
                          : undef
                          ;
    }

    return \%where;
}

my $WILDCARD_COLUMNS = ['*'];

sub select :method {
    my ($self, $table_name, $where, $opt) = @_;
    $where //= {};
    $opt //= {};

    croak '(Aniki#select) `where` condition must be a reference.' unless ref $where;

    my $table = $self->schema->get_table($table_name);

    my $columns = exists $opt->{columns} ? $opt->{columns}
                : defined $table ? $table->field_names
                : $WILDCARD_COLUMNS;

    $where = $self->_bind_sql_type_to_args($table, $where) if defined $table;

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    my ($sql, @bind) = $self->query_builder->select($table_name, $columns, $where, $opt);
    return $self->select_by_sql($sql, \@bind, {
        %$opt,
        table_name => $table_name,
        columns    => $columns,
    });
}

sub fetch_and_attach_relay_data {
    my ($self, $table_name, $prefetch, $rows) = @_;
    return unless @$rows;

    $prefetch = [$prefetch] if ref $prefetch eq 'HASH';

    my $relationships = $self->schema->get_table($table_name)->get_relationships;
    for my $key (@$prefetch) {
        if (ref $key && ref $key eq 'HASH') {
            my %prefetch = %$key;
            for my $key (keys %prefetch) {
                $self->_fetch_and_attach_relay_data($relationships, $rows, $key, $prefetch{$key});
            }
        }
        else {
            $self->_fetch_and_attach_relay_data($relationships, $rows, $key, []);
        }
    }
}

sub _fetch_and_attach_relay_data {
    my ($self, $relationships, $rows, $key, $prefetch) = @_;
    my $relationship = $relationships->get($key);
    unless ($relationship) {
        croak "'$key' is not defined as relationship. (maybe possible typo?)";
    }
    $relationship->fetcher->execute($self, $rows, $prefetch);
}

sub select_named {
    my ($self, $sql, $bind, $opt) = @_;
    return $self->select_by_sql(bind_named($sql, $bind), $opt);
}

sub select_by_sql {
    my ($self, $sql, $bind, $opt) = @_;
    $opt //= {};

    local $self->{suppress_row_objects}    = 1 if $opt->{suppress_row_objects};
    local $self->{suppress_result_objects} = 1 if $opt->{suppress_result_objects};

    my $table_name = exists $opt->{table_name}  ? $opt->{table_name} : $self->_guess_table_name($sql);
    my $columns    = exists $opt->{columns}     ? $opt->{columns}    : undef;
    my $prefetch   = exists $opt->{prefetch}    ? $opt->{prefetch}      : [];
       $prefetch   = [$prefetch] if ref $prefetch eq 'HASH';

    my $prefetch_enabled_fg = @$prefetch && !$self->suppress_row_objects && defined wantarray;
    if ($prefetch_enabled_fg) {
        my $txn; $txn = $self->txn_scope(caller => [caller]) unless $self->in_txn;

        my $sth = $self->execute($sql, @$bind);
        my $result = $self->_fetch_by_sth($sth, $table_name, $columns);
        $self->fetch_and_attach_relay_data($table_name, $prefetch, $result->rows);

        $txn->rollback if defined $txn; ## for read only
        return $result;
    }

    my $sth = $self->execute($sql, @$bind);

    # When the return value is never used, should not create object
    # case example: use `FOR UPDATE` query for global locking
    unless (defined wantarray) {
        $sth->finish();
        return;
    }

    return $self->_fetch_by_sth($sth, $table_name, $columns);
}

sub _fetch_by_sth {
    my ($self, $sth, $table_name, $columns) = @_;
    $columns //= $sth->{NAME};
    $columns   = $sth->{NAME} if $columns == $WILDCARD_COLUMNS;

    my @rows;

    my %row;
    $sth->bind_columns(\@row{@$columns});
    push @rows => {%row} while $sth->fetch;
    $sth->finish;

    if ($self->suppress_result_objects) {
        return \@rows if $self->suppress_row_objects;

        my $row_class = $self->guess_row_class($table_name);
        return [
            map {
                $row_class->new(
                    table_name => $table_name,
                    handler    => $self,
                    row_data   => $_,
                )
            } @rows
        ];
    }

    my $result_class = $self->guess_result_class($table_name);
    return $result_class->new(
        table_name           => $table_name,
        handler              => $self,
        row_datas            => \@rows,
        suppress_row_objects => $self->suppress_row_objects,
    );
}

sub execute {
    my ($self, $sql, @bind) = @_;
    $sql = $self->handler->trace_query_set_comment($sql);

    my $sth = $self->use_prepare_cached ? $self->dbh->prepare_cached($sql) : $self->dbh->prepare($sql);
    $self->_bind_to_sth($sth, \@bind);
    eval {
        $sth->execute();
    };
    if ($@) {
        $self->handle_error($sql, \@bind, $@);
    }

    return $sth;
}

sub _bind_sql_type_to_args {
    my ($self, $table, $args) = @_;

    my %bind_args;
    for my $col (keys %{$args}) {
        # if $args->{$col} is a ref, it is scalar ref or already
        # sql type bined parameter. so ignored.
        if (ref $args->{$col}) {
            $bind_args{$col} = $args->{$col};
        }
        elsif (my $field = $table->get_field($col)) {
            $bind_args{$col} = sql_type(\$args->{$col}, $field->sql_data_type);
        }
        else {
            $bind_args{$col} = $args->{$col};
        }
    }

    return \%bind_args;
}

sub _bind_to_sth {
    my ($self, $sth, $bind) = @_;
    for my $i (keys @$bind) {
        my $v = $bind->[$i];
        if (blessed $v && $v->isa('SQL::Maker::SQLType')) {
            $sth->bind_param($i + 1, ${$v->value_ref}, $v->type);
        } else {
            $sth->bind_param($i + 1, $v);
        }
    }
}

has _row_class_cache => (
    is      => 'rw',
    default => sub {
        my $self = shift;
        my %cache = map { $_->name => undef } $self->schema->get_tables();
        return \%cache;
    },
);

has _result_class_cache => (
    is      => 'rw',
    default => sub {
        my $self = shift;
        my %cache = map { $_->name => undef } $self->schema->get_tables();
        return \%cache;
    },
);

sub new_row_from_hashref {
    my ($self, $table_name, $row_data) = @_;
    return $row_data if $self->suppress_row_objects;

    my $row_class = $self->guess_row_class($table_name);
    return $row_class->new(
        table_name => $table_name,
        handler    => $self,
        row_data   => $row_data,
    );
}

sub new_collection_from_arrayref {
    my ($self, $table_name, $row_datas) = @_;
    return $row_datas if $self->suppress_result_objects;

    my $result_class = $self->guess_result_class($table_name);
    return $result_class->new(
        table_name           => $table_name,
        handler              => $self,
        row_datas            => $row_datas,
        suppress_row_objects => $self->suppress_row_objects,
    );
}

sub _guess_table_name {
    my ($self, $sql) = @_;
    return $2 if $sql =~ /\sfrom\s+(["`]?)([\w]+)\1\s*/sio;
    return;
}

# --------------------------------------------------
# last_insert_id
sub _fetch_last_insert_id_from_mysql { shift->dbh->{mysql_insertid} }
sub _fetch_last_insert_id_from_pg {
    my ($self, $table_name, $column) = @_;
    my $dbh = $self->dbh;
    return $dbh->last_insert_id(undef, undef, $table_name, undef) unless defined $column;

    my $sequence = join '_', $table_name, $column, 'seq';
    return $dbh->last_insert_id(undef, undef, undef, undef, { sequence => $sequence });
}
sub _fetch_last_insert_id_from_sqlite { shift->dbh->sqlite_last_insert_rowid }
sub _fetch_last_insert_id_from_oracle { undef } ## XXX: Oracle haven't implement AUTO INCREMENT

# --------------------------------------------------
# for transaction
sub txn_manager  { shift->handler->txn_manager }
sub txn          { shift->handler->txn(@_)          }
sub in_txn       { shift->handler->in_txn(@_)       }
sub txn_scope    { shift->handler->txn_scope(@_)    }
sub txn_begin    { shift->handler->txn_begin(@_)    }
sub txn_rollback { shift->handler->txn_rollback(@_) }
sub txn_commit   { shift->handler->txn_commit(@_)   }

# --------------------------------------------------
# error handling
sub handle_error {
    my ($self, $sql, $bind, $e) = @_;
    require Data::Dumper;

    local $Data::Dumper::Maxdepth = 2;
    $sql =~ s/\n/\n          /gm;
    croak sprintf $self->exception_template, $e, $sql, Data::Dumper::Dumper($bind);
}

sub exception_template {
    return <<'__TRACE__';
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@ Aniki 's Exception @@@@@
Reason  : %s
SQL     : %s
BIND    : %s
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
__TRACE__
}

sub DEMOLISH {
    my $self = shift;
    $self->handler->disconnect() if $self->handler;
}

__PACKAGE__->meta->make_immutable();
__END__

=encoding utf-8

=head1 NAME

Aniki - The ORM as our great brother.

=head1 SYNOPSIS

    use 5.014002;
    package MyProj::DB::Schema {
        use DBIx::Schema::DSL;

        create_table 'module' => columns {
            integer 'id', primary_key, auto_increment;
            varchar 'name';
            integer 'author_id';

            add_index 'author_id_idx' => ['author_id'];

            belongs_to 'author';
        };

        create_table 'author' => columns {
            integer 'id', primary_key, auto_increment;
            varchar 'name', unique;
        };
    };

    package MyProj::DB::Filter {
        use Aniki::Filter::Declare;
        use Scalar::Util qw/blessed/;
        use Time::Moment;

        # define inflate/deflate filters in table context.
        table author => sub {
            inflate name => sub {
                my $name = shift;
                return uc $name;
            };

            deflate name => sub {
                my $name = shift;
                return lc $name;
            };
        };

        inflate qr/_at$/ => sub {
            my $datetime = shift;
            $datetime =~ tr/ /T/;
            $datetime .= 'Z';
            return Time::Moment->from_string($datetime);
        };

        deflate qr/_at$/ => sub {
            my $datetime = shift;
            return $datetime->at_utc->strftime('%F %T') if blessed $datetime and $datetime->isa('Time::Moment');
            return $datetime;
        };
    };

    package MyProj::DB {
        use Mouse v2.4.5;
        extends qw/Aniki/;

        __PACKAGE__->setup(
            schema => 'MyProj::DB::Schema',
            filter => 'MyProj::DB::Filter',
            row    => 'MyProj::DB::Row',
        );
    };

    package main {
        my $db = MyProj::DB->new(connect_info => ["dbi:SQLite:dbname=:memory:", "", ""]);
        $db->execute($_) for split /;/, MyProj::DB::Schema->output;

        my $author_id = $db->insert_and_fetch_id(author => { name => 'songmu' });

        $db->insert(module => {
            name      => 'DBIx::Schema::DSL',
            author_id => $author_id,
        });
        $db->insert(module => {
            name      => 'Riji',
            author_id => $author_id,
        });

        my $module = $db->select(module => {
            name => 'Riji',
        }, {
            limit => 1,
        })->first;
        say '$module->name:         ', $module->name;         ## Riji
        say '$module->author->name: ', $module->author->name; ## SONGMU

        my $author = $db->select(author => {
            name => 'songmu',
        }, {
            limit    => 1,
            prefetch => [qw/modules/],
        })->first;

        say '$author->name:   ', $author->name;                 ## SONGMU
        say 'modules[]->name: ', $_->name for $author->modules; ## DBIx::Schema::DSL, Riji
    };

    1;

=head1 DESCRIPTION

Aniki is ORM.
Lite, but powerful.

=head2 FEATURES

=over 4

=item Small & Simple

You can read codes easily.

=item Object mapping

Inflates rows to L<Aniki::Result::Collection> object.
And inflates row to L<Aniki::Row> object.

You can change result class, also we can change row class.
Aniki dispatches result/row class by table. (e.g. C<foo> table to C<MyDB::Row::Foo>)

=item Raw SQL support

Supports to execute raw C<SELECT> SQL and fetch rows of result.
Of course, Aniki can inflate to result/row also.

=item Query builder

Aniki includes query builder powered by L<SQL::Maker>.
L<SQL::Maker> is fast and secure SQL builder.

=item Fork safe & Transaction support

Aniki includes L<DBI> handler powered by L<DBIx::Handler>.

=item Error handling

Easy to handle execution errors by C<handle_error> method.
You can override it.

=item Extendable

You can extend Aniki by L<Mouse::Role>.
Aniki provides some default plugins as L<Mouse::Role>.

=back

=head2 RELATIONSHIP

Aniki supports relationship.
Extracts relationship from schema class.

Example:

    use 5.014002;
    package MyProj::DB::Schema {
        use DBIx::Schema::DSL;

        create_table 'module' => columns {
            integer 'id', primary_key, auto_increment;
            varchar 'name';
            integer 'author_id';

            add_index 'author_id_idx' => ['author_id'];

            belongs_to 'author';
        };

        create_table 'author' => columns {
            integer 'id', primary_key, auto_increment;
            varchar 'name', unique;
        };
    };

A C<author> has many C<modules>.
So you can access C<author> row object to C<modules>.

    my $author = $db->select(author => { name => 'songmu' })->first;
    say 'modules[]->name: ', $_->name for $author->modules; ## DBIx::Schema::DSL, Riji

Also C<module> has a C<author>.
So you can access C<module> row object to C<author> also.

    my $module = $db->select(module => { name => 'Riji' })->first;
    say "Riji's author is ", $module->author->name; ## SONGMU

And you can pre-fetch related rows.

    my @modules = $db->select(module => {}, { prefetch => [qw/author/] });
    say $_->name, "'s author is ", $_->author->name for @modules;

=head1 SETUP

Install Aniki from CPAN:

    cpanm Aniki

And run C<install-aniki> command.

    install-aniki --lib=./lib MyApp::DB

C<install-aniki> creates skeleton modules.

=head1 METHODS

=head2 CLASS METHODS

=head3 C<setup(%args)>

Initialize and customize Aniki class.
C<schema> is required. Others are optional.

=head4 Arguments

=over 4

=item schema : ClassName

=item handler : ClassName

=item filter : ClassName

=item row : ClassName

=item result : ClassName

=item query_builder : ClassName

=back

=head3 C<use_prepare_cached>

If this method returns true value, Aniki uses C<preare_cached>.
This method returns true value default.
So you don't need to use C<preare_cached>, override it and return false value.

=head3 C<use_strict_query_builder>

If this method returns true value, Aniki enables L<SQL::Maker>'s strict mode.
This method returns true value default.
So you need to disable L<SQL::Maker>'s strict mode, override it and return false value.

SEE ALSO: L<The JSON SQL Injection Vulnerability|http://blog.kazuhooku.com/2014/07/the-json-sql-injection-vulnerability.html>

=head3 C<preload_all_row_classes>

Preload all row classes.

=head3 C<preload_all_result_classes>

Preload all result classes.

=head3 C<guess_result_class($table_name) : ClassName>

Guesses result class by table name.

=head3 C<guess_row_class($table_name) : ClassName>

Guesses row class by table name.

=head3 C<new(%args) : Aniki>

Create instance of Aniki.

=head4 Arguments

=over 4

=item C<handler : Aniki::Handler>

Instance of Aniki::Hanlder.
If this argument is given, not required to give C<connect_info> for arguments.

=item C<connect_info : ArrayRef>

Auguments for L<DBI>'s connect method.

=item on_connect_do : CodeRef|ArrayRef[Str]|Str

=item on_disconnect_do : CodeRef|ArrayRef[Str]|Str

Execute SQL or CodeRef when connected/disconnected.

=item trace_query : Bool

Enables to inject a caller information as SQL comment.
SEE ALSO: L<DBIx::Handler>

=item trace_ignore_if : CodeRef

Ignore to inject the SQL comment when trace_ignore_if's return value is true.
SEE ALSO: L<DBIx::Handler>

=item C<suppress_row_objects : Bool>

If this option is true, no create row objects.
Aniki's methods returns hash reference instead of row object.

=item C<suppress_result_objects : Bool>

If this option is true, no create result objects.
Aniki's methods returns array reference instead of result object.

=back

=head2 INSTANCE METHODS

=head3 C<select($table_name, \%where, \%opt)>

Execute C<SELECT> query by generated SQL, and returns result object.

    my $result = $db->select(foo => { id => 1 }, { limit => 1 });
    # stmt: SELECT FROM foo WHERE id = ? LIMIT 1
    # bind: [1]

=head4 Options

There are the options of C<SELECT> query.
See also L<SQL::Maker|https://metacpan.org/pod/SQL::Maker#opt>.

And you can use there options:

=over 4

=item C<suppress_row_objects : Bool>

If this option is true, no create row objects.
This methods returns hash reference instead of row object.

=item C<suppress_result_objects : Bool>

If this option is true, no create result objects.
This method returns array reference instead of result object.

=item C<columns : ArrayRef[Str]>

List for retrieving columns from database.

=item C<prefetch : ArrayRef|HashRef>

Pre-fetch specified related rows.
See also L</"RELATIONSHIP"> section.

=back

=head3 C<select_named($sql, \%bind, \%opt)>

=head3 C<select_by_sql($sql, \@bind, \%opt)>

Execute C<SELECT> query by specified SQL, and returns result object.

    my $result = $db->select_by_sql('SELECT FROM foo WHERE id = ? LIMIT 1', [1]);
    # stmt: SELECT FROM foo WHERE id = ? LIMIT 1
    # bind: [1]

=head4 Options

You can use there options:

=over 4

=item C<table_name: Str>

This is table name using row/result class guessing.

=item C<columns: ArrayRef[Str]>

List for retrieving columns from database.

=item C<prefetch: ArrayRef|HashRef>

Pre-fetch specified related rows.
See also L</"RELATIONSHIP"> section.

=back

=head3 C<insert($table_name, \%values, \%opt)>

Execute C<INSERT INTO> query.

    $db->insert(foo => { bar => 1 });
    # stmt: INSERT INTO foo (bar) VALUES (?)
    # bind: [1]


=head3 C<insert_and_fetch_id($table_name, \%values, \%opt)>

Execute C<INSERT INTO> query, and returns C<last_insert_id>.

    my $id = $db->insert_and_fetch_id(foo => { bar => 1 });
    # stmt: INSERT INTO foo (bar) VALUES (?)
    # bind: [1]

=head3 C<insert_and_fetch_row($table_name, \%values, \%opt)>

Execute C<INSERT INTO> query, and C<SELECT> it, and returns row object.

    my $row = $db->insert_and_fetch_row(foo => { bar => 1 });
    # stmt: INSERT INTO foo (bar) VALUES (?)
    # bind: [1]

=head3 C<insert_and_emulate_row($table_name, \%values, \%opt)>

Execute C<INSERT INTO> query, and returns row object created by C<$row> and schema definition.

    my $row = $db->insert_and_fetch_row(foo => { bar => 1 });
    # stmt: INSERT INTO foo (bar) VALUES (?)
    # bind: [1]

This method is faster than C<insert_and_fetch_row>.

=head4 WARNING

If you use SQL C<TRIGGER> or dynamic default value, this method don't return the correct value, maybe.
In this case, you should use C<insert_and_fetch_row> instead of this method.

=head3 C<insert_on_duplicate($table_name, \%insert, \%update)>

Execute C<INSERT ... ON DUPLICATE KEY UPDATE> query for MySQL.

    my $row = $db->insert_on_duplicate(foo => { bar => 1 }, { bar => \'VALUE(bar) + 1' });
    # stmt: INSERT INTO foo (bar) VALUES (?) ON DUPLICATE KEY UPDATE bar = VALUE(bar) + 1
    # bind: [1]

SEE ALSO: L<INSERT ... ON DUPLICATE KEY UPDATE Syntax|https://dev.mysql.com/doc/refman/5.6/en/insert-on-duplicate.html>

=head3 C<insert_multi($table_name, \@values, \%opts)>

Execute C<INSERT INTO ... (...) VALUES (...), (...), ...> query for MySQL.
Insert multiple rows at once.

    my $row = $db->insert_multi(foo => [{ bar => 1 }, { bar => 2 }, { bar => 3 }]);
    # stmt: INSERT INTO foo (bar) VALUES (?),(?),(?)
    # bind: [1, 2, 3]

SEE ALSO: L<INSERT Syntax|https://dev.mysql.com/doc/refman/5.6/en/insert.html>

=head3 C<update($table_name, \%set, \%where)>

Execute C<UPDATE> query, and returns changed rows count.

    my $count = $db->update(foo => { bar => 2 }, { id => 1 });
    # stmt: UPDATE foo SET bar = ? WHERE id = ?
    # bind: [2, 1]

=head3 C<update($row, \%set)>

Execute C<UPDATE> query, and returns changed rows count.

    my $row = $db->select(foo => { id => 1 }, { limit => 1 })->first;
    my $count = $db->update($row => { bar => 2 });
    # stmt: UPDATE foo SET bar = ? WHERE id = ?
    # bind: [2, 1]

=head3 C<update_and_fetch_row($row, \%set)>

Execute C<UPDATE> query, and C<SELECT> it, and returns row object.

    my $row = $db->select(foo => { id => 1 }, { limit => 1 })->first;
    my $new_row = $db->update_and_fetch_row($row => { bar => 2 });
    # stmt: UPDATE foo SET bar = ? WHERE id = ?
    # bind: [2, 1]

=head3 C<update_and_emulate_row($row, \%set)>

Execute C<UPDATE> query, and returns row object created by C<$row> and C<%set>.

    my $row = $db->select(foo => { id => 1 }, { limit => 1 })->first;
    my $new_row = $db->update_and_emulate_row($row => { bar => 2 });
    # stmt: UPDATE foo SET bar = ? WHERE id = ?
    # bind: [2, 1]

This method is faster than C<update_and_fetch_row>.

=head4 WARNING

If you use SQL C<TRIGGER> or C<AutoCommit>, this method don't return the correct value, maybe.
In this case, you should use C<update_and_fetch_row> instead of this method.

=head3 C<delete($table_name, \%where)>

Execute C<DELETE> query, and returns changed rows count.

    my $count = $db->delete(foo => { id => 1 });
    # stmt: DELETE FROM foo WHERE id = ?
    # bind: [1]

=head3 C<delete($row)>

Execute C<DELETE> query, and returns changed rows count.

    my $row = $db->select(foo => { id => 1 }, { limit => 1 })->first;
    my $count = $db->delete($row);
    # stmt: DELETE foo WHERE id = ?
    # bind: [1]

=head2 ACCESSORS

=over 4

=item C<schema : Aniki::Schema>

=item C<filter : Aniki::Filter>

=item C<query_builder : Aniki::QueryBuilder>

=item C<root_row_class : Aniki::Row>

=item C<root_result_class : Aniki::Result>

=item C<connect_info : ArrayRef>

=item C<on_connect_do : CodeRef|ArrayRef[Str]|Str>

=item C<on_disconnect_do : CodeRef|ArrayRef[Str]|Str>

=item C<suppress_row_objects : Bool>

=item C<suppress_result_objects : Bool>

=item C<dbh : DBI::db>

=item C<handler : Aniki::Handler>

=item C<txn_manager : DBIx::TransactionManager>

=back

=head1 CONTRIBUTE

I need to support documentation and reviewing my english.
This module is developed on L<Github|http://github.com/karupanerura/Aniki>.

=head1 LICENSE

Copyright (C) karupanerura.

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

=head1 CONTRIBUTORS

=over 2

=item watanabe-yocihi

=item Pine Mizune

=item Syohei YOSHIDA

=back

=head1 AUTHOR

karupanerura E<lt>[e-mail]<gt>

=cut