Class::DBI::Plugin::QueriesTime

Class::DBI使ってるときにqueryにどれだけ時間掛かってるか見てみたかったので作ってみた。
sth_to_objectsをredefineする感じ。

package Class::DBI::Plugin::QueriesTime;

use strict;

use warnings;

use Time::HiRes qw( tv_interval gettimeofday );

use vars qw($VERSION);

$VERSION = 0.01;

sub import {

    my $class = shift;

    my $pkg   = caller(0);

    my $befor_query;

    no strict 'refs';

    no warnings 'redefine';

    *{"$pkg\::sth_to_objects"} = sub {

        my ($class, $sth, $args) = @_;

        $class->_croak("sth_to_objects needs a statement handle") unless $sth;

        unless (UNIVERSAL::isa($sth => "DBI::st")) {

            my $meth = "sql_$sth";

            $sth = $class->$meth();

        }

        my (%data, @rows);

        eval {

            $befor_query = [gettimeofday];

            $sth->execute(@$args) unless $sth->{Active};

            $sth->bind_columns(\(@data{ @{ $sth->{NAME_lc} } }));

            warn "query time: ",tv_interval ( $befor_query );

            push @rows, {%data} while $sth->fetch;

        };

        return $class->_croak("$class can't $sth->{Statement}: $@", err => $@)

            if $@;

        return $class->_ids_to_objects(\@rows);

    };

}

1;

こんな感じで出力される。

query time: 0.294209 at Class/DBI/Plugin/QueriesTime.pm line 30.

こういうの他にありそうだなぁ。