Data::ObjectDriverにDOD_TRACEが欲しい

perlのORMの中には hoge_TRACE=1 することで発行されるクエリを見る事が出来るものがある。

# DBI
DBI_TRACE=1

# DBIx::Class
DBIC_TRACE=1

# DBIx::Skinny
SKINNY_TRACE=1

Data::ObjectDriverにも欲しい。ので書いた。

use Data::ObjectDriver::Driver::DBI;

my $fetch = sub {
    my $driver = shift;
    my($rec, $class, $orig_terms, $orig_args) = @_;

    my ($sql, $bind, $stmt) = $driver->prepare_fetch($class, $orig_terms, $orig_args);

    my @bind;
    my $map = $stmt->select_map;
    for my $col (@{ $stmt->select }) {
        push @bind, \$rec->{ $map->{$col} };
    }

    my $dbh = $driver->r_handle($class->properties->{db});
    $driver->start_query($sql, $stmt->{bind});


    my $sth = $orig_args->{no_cached_prepare} ? $dbh->prepare($sql) : $driver->_prepare_cached($dbh, $sql);
    if ($ENV{DOD_TRACE}) {
        warn $sql;
        p $stmt->{bind};
    }
    $sth->execute(@{ $stmt->{bind} });
    $sth->bind_columns(undef, @bind);

    # need to slurp 'offset' rows for DBs that cannot do it themselves
    if (!$driver->dbd->offset_implemented && $orig_args->{offset}) {
        for (1..$orig_args->{offset}) {
            $sth->fetch;
        }
    }

    return $sth;
};

no warnings "redefine";
*Data::ObjectDriver::Driver::DBI::fetch = $fetch;

見てのとおり元メソッドに数行足しただけのアレ実装。
まぁ見れるからこれでいいやーと思っていたら、ある日ボスにかっこよくされていた。

use base qw/Data::ObjectDriver::Driver::DBI/;

sub prepare_statement {
    my $driver = shift;

    my $stmt = $driver->SUPER::prepare_statement(@_);
    if ($ENV{DOD_TRACE}) {
        warn $stmt->as_sql;
        p $stmt->{bind};
    }
    $stmt;
}

むしろボスがかっこいい。

later

• DODでも $ENV{DOD_DEBUG} で似たようなものが吐けると他の人から教わった。
• 書く前に「DODでクエリ見たいときってどうしてますか？」って訊いたら「DBI_TRACE」って2名から返ってきた。
  • 僕にはDBI_TRACEが使える（読める）日は来ない気がするんです