autoboxでDBIとか

sql->doとかできたらおもろいかなとおもってやってみた。

use strict;
use warnings;
use autobox;
use autobox::DBI ['dbi:SQLite:/tmp/autobox_dbi.db'], {RaiseError => 1,AutoCommit =>1};
use Test::More tests => 8;

'CREATE TABLE foo(id INT, body TEXT)'->do;
'INSERT INTO foo(id,body) VALUES(1,"fooo")'->do;
['INSERT INTO foo(id,body) VALUES(?,?)','2','bar']->do;
['INSERT INTO foo(id,body) VALUES(?,?)','3','baz']->do;

my @list = 'SELECT * FROM foo'->list;
is_deeply \@list, [[1,'fooo'],[2,'bar'],[3,'baz']];

my $list = 'SELECT * FROM foo'->list;
is_deeply $list, [[1,'fooo'],[2,'bar'],[3,'baz']];

@list = ['SELECT * FROM foo WHERE id IN (?,?)',1,2] ->list;
is_deeply \@list, [[1,'fooo'],[2,'bar']];

$list = ['SELECT * FROM foo WHERE id IN (?,?)',1,2] ->list;
is_deeply $list, [[1,'fooo'],[2,'bar']];

my $hash = 'SELECT * FROM foo'->hash;
is_deeply $hash, [{id=>1,body=>'fooo'},{id=>2,body=>'bar'},{id=>3,body=>'baz'}];

my @hash = 'SELECT * FROM foo'->hash;
is_deeply \@hash, [{id=>1,body=>'fooo'},{id=>2,body=>'bar'},{id=>3,body=>'baz'}];

$hash = ['SELECT * FROM foo WHERE id IN (?,?)',1,2]->hash;
is_deeply $hash, [{id=>1,body=>'fooo'},{id=>2,body=>'bar'}];

@hash = ['SELECT * FROM foo WHERE id IN (?,?)',1,2]->hash;
is_deeply \@hash, [{id=>1,body=>'fooo'},{id=>2,body=>'bar'}];

unlink '/tmp/autobox_dbi.db';

こんな感じでつかえるの。

ソースは

package autobox::DBI;
use strict;
use warnings;
use DBI;
use Carp;
use autobox;
use autobox::Core;

my $dbh;
sub import {
    shift;
    my $info = shift;
    my $args = shift;
    $dbh = DBI->connect(@{$info},$args) or croak $@;
}

sub SCALAR::do {
    my $sql = shift;
    $sql->_execute;
}

sub ARRAY::do {
    my $args = shift;
    my $sql  = shift @{$args};
    my @bind = @{$args};
    $sql->_execute(@bind);
}

sub SCALAR::list {
    my $sql = shift;
    my $sth = $sql->_execute;
    return wantarray ? @{$sth->fetchall_arrayref} : $sth->fetchall_arrayref;
}

sub ARRAY::list {
    my $args = shift;
    my $sql  = shift @{$args};
    my @bind = @{$args};
    my $sth = $sql->_execute(@bind);
    return wantarray ? @{$sth->fetchall_arrayref} : $sth->fetchall_arrayref;
}

sub SCALAR::hash {
    my $sql = shift;

    my $sth = $sql->_execute;
    my (@return, $row);
    push @return, $row while $row = $sth->fetchrow_hashref;

    return wantarray ? @return : \@return;
}

sub ARRAY::hash {
    my $args = shift;
    my $sql  = shift @{$args};
    my @bind = @{$args};

    my $sth = $sql->_execute(@bind);
    my (@return, $row);
    push @return, $row while $row = $sth->fetchrow_hashref;

    return wantarray ? @return : \@return;
}

sub SCALAR::_execute {
    my $sql  = shift;
    my @bind = @_;

    my $sth;
    eval {
        $sth = $dbh->prepare($sql);
        $sth->execute(@bind);
    };
    croak $sth->errstr if $@;
    return $sth;
}

1;

適当にこんなん。

（追記）

そうそう、一応
autobox::SQLにrenameしてcodereposにいれてあります