Tengの最近の雛形

MyApp::DB.pm

package MyApp::DB;
use 5.016;
use warnings;
use utf8;

use Time::Piece::Plus;
use Class::Method::Modifiers;
use Teng::Schema::Loader;
use MyApp::DB::ResultSet;
use MyApp::Exception;

use parent qw(Teng);
__PACKAGE__->load_plugin('Pager::MySQLFoundRows');
__PACKAGE__->load_plugin('Count');
__PACKAGE__->load_plugin('FindOrCreate');

sub load {
    my ($kls, $args) = @_;

    my $connect_info = delete $args->{connect_info} or die 'no connect_info';
    $connect_info->[3] = {
        mysql_enable_utf8 => 1,
        %{ $connect_info->[3] || {} },
    };
    $args = {
        on_connect_do => [
            'SET NAMES utf8mb4',
            q[SET SESSION sql_mode='TRADITIONAL'],
        ],
        connect_info => $connect_info,
        %$args,
    };
    my    $dbh;
    state $schema;
    if ( !defined $schema ) {
        my $teng = Teng::Schema::Loader->load(
            namespace => $kls,
            %$args,
        );
        $schema = $teng->schema;
        $dbh    = $teng->dbh;

        for my $table (keys %{$schema->tables}) {
            my $primary_keys = $schema->tables->{$table}->primary_keys;
            if ('id' ~~ $primary_keys) {
                $schema->tables->{$table}->primary_keys(['id']);
            }
        }

        for my $table_name (keys %{$schema->tables}) {
            my $table = $schema->get_table($table_name);
            $table->add_deflator(qr/^.+_at$/ => sub {
                my $col_value = shift;
                return undef unless $col_value;

                if (ref($col_value) && $col_value->isa('Time::Piece::Plus')) {
                    return $col_value->mysql_datetime;
                }

                return $col_value;
            });

            $table->add_inflator( qr/^.+_at$/ => sub {
                my $col_value = shift;
                $col_value && Time::Piece::Plus->parse_mysql_datetime(str => $col_value);
            });
        }
    }

    $kls->new(
        fields_case => 'NAME',
        dbh    => $dbh,
        schema => $schema,
        %$args,
    );
}

before do_update => sub {
    my ($self, $table_name, $args, $where) = @_;

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

    my $localtime = localtime;
    if (!$args->{updated_at} && $table->row_class->can('updated_at')) {
        $args->{updated_at} = $localtime->datetime;
    }
};

before do_insert => sub {
    my ($self, $table_name, $args, $where) = @_;

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

    my $localtime = localtime;
    if (!$args->{created_at} && $table->row_class->can('created_at')) {
        $args->{created_at} = $localtime->datetime;
    }

    if (!$args->{updated_at} && $table->row_class->can('updated_at')) {
        $args->{updated_at} = $localtime->datetime;
    }
};

around search => sub {
    my $orig = shift;
    my ($self, $table_name, $where, $opt) = @_;

    return $orig->(@_) if wantarray;

    MyApp::DB::ResultSet->new(
        teng             => $self,
        table_name       => $table_name,
        row_class        => $self->schema->get_row_class($table_name),
        table            => $self->schema->get_table( $table_name ),
        suppress_object_creation => $self->suppress_row_objects,
        where            => $where,
        opt              => $opt,
    );
};

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

    state %tables;
    return $tables{$table_name} //= MyApp::DB::ResultSet->new(
        teng       => $self,
        table_name => $table_name,
    );
}

sub handle_error {
    my $self = shift;
    my ($stmt, $bind, $reason) = @_;

    $bind = [map {ref $_ eq 'ARRAY' ? $_->[0] : $_} @$bind];
    my $err = do {
        require Data::Dumper;
        local $Data::Dumper::Maxdepth = 2;
        local $Data::Dumper::Terse    = 1;
        local $Data::Dumper::Indent   = 0;
        sprintf <<"TRACE", $reason =~ s/\n\z//msr, $stmt =~ s/\n/ /gmr, Data::Dumper::Dumper($bind)
@@@@@ Teng 's Exception @@@@@
Reason  : %s
SQL     : %s
BIND    : %s
TRACE
    };

    if ($reason =~ /DBD::mysql::st execute failed: Duplicate entry/) {
        MyApp::DB::DuplicateException->throw($err);
    }
    else {
        MyApp::DB::Exception->throw($err);
    }
}

package MyApp::DB::Exception {
    use parent 'MyApp::Exception';
}

package MyApp::DB::DuplicateException {
    use parent -norequire, 'MyApp::DB::Exception';
}

1;

MyApp::DB::ResultSet.pm

package MyApp::DB::ResultSet;
use 5.016;
use strict;
use warnings;
use utf8;

use String::CamelCase ();

use Class::Load ();
use Class::Method::Modifiers;
use Class::Accessor::Lite::Lazy (
    ro_lazy => [qw/count sth/],
    ro      => [qw/teng table table_name row_class/],
    rw      => [qw/where opt/],
);
use parent 'Teng::Iterator';

sub new {
    my $class = shift;
    my %args = ref $_[0] ? %{$_[0]}: @_;

    $args{table}     = $args{teng}->schema->get_table($args{table_name})     unless $args{table};
    $args{row_class} = $args{teng}->schema->get_row_class($args{table_name}) unless $args{row_class};

    state $CACHE;
    my $sub_class = $CACHE->{$args{table_name}} ||= do {
        my $pkg = __PACKAGE__. '::'. String::CamelCase::camelize($args{table_name});
        Class::Load::load_optional_class($pkg) or do {
            no strict 'refs'; @{"$pkg\::ISA"} = __PACKAGE__;
        };
        $pkg;
    };

    bless \%args, $sub_class;
}

sub _build_count {
    my $self = shift;
    $self->teng->count($self->table_name, '*', $self->where, $self->opt);
}

sub _build_sth {
    my $self = shift;

    my ($sql, @binds) = $self->teng->sql_builder->select(
        $self->table_name,
        $self->teng->_get_select_columns($self->table, $self->opt),
        $self->where,
        $self->opt
    );

    $self->teng->execute($sql, \@binds);
}

sub has_sth {
    shift->{sth};
}

# surely assign sth
before [qw/all next/] => sub { shift->sth };

sub search {
    my ($self, $where, $opt) = @_;

    my $teng = $self->teng;
    @_ = (
        $teng,
        $self->table_name, {
            %{ $self->where || {} },
            %{ $where       || {} },
        }, {
            %{ $self->opt   || {} },
            %{ $opt         || {} },
        },
    );
    goto $teng->can('search');
}

for my $method (qw/find_or_create insert bulk_insert fast_insert search_with_pager delete/) {
    no strict 'refs';
    *{__PACKAGE__."::$method"} = sub {
        use strict 'refs';
        my $self = shift;

        my $teng = $self->teng;
        unshift @_, $teng, $self->table_name;
        goto $teng->can($method);
    };
}

sub single {
    my ($self, $where, $opt) = @_;
    $opt ||= {};
    $opt->{limit} = 1;

    $self->search($where, $opt)->next;
}

sub find {
    my ($self, $where) = @_;

    $where = {id => $where} unless ref $where;
    $self->search($where, {limit => 1})->next;
}

1;