view release on metacpan or  search on metacpan

lib/Aniki.pm  view on Meta::CPAN

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;
            };