Class::DBI::Plugin::QueriesTime - Get your query's time.

Class-DBI-Plugin-QueriesTime documentation Contained in the Class-DBI-Plugin-QueriesTime distribution.

Index

Code Index:

NAME

Top

Class::DBI::Plugin::QueriesTime - Get your query's time.

VERSION

Top

This documentation refers to Class::DBI::Plugin::QueriesTime version 0.01

SYNOPSIS

Top

  package YourDB;
  use base qw/Class::DBI/;
  use Class::DBI::Plugin::QueriesTime;

DESCRIPTION

Top

Class::DBI::Plugin::QueriesTime is Extension to Class::DBI. Class::DBI::Plugin::QueriesTime get your query's time. Class::DBI::Plugin::QueriesTime is redefine Class::DBI::sth_to_objects.

DEPENDENCIES

Top

Class::DBI

Time::HiRes

BUGS AND LIMITATIONS

Top

There are no known bugs in this module. Please report problems to Atsushi Kobayashi (<nekokak@cpan.org>) Patches are welcome.

SEE ALSO

Top

Class::DBI

Time::HiRes

AUTHOR

Top

Atsushi Kobayashi, <nekokak@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2006 by Atsushi Kobayashi (<nekokak@cpan.org>). All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic.

Class-DBI-Plugin-QueriesTime documentation Contained in the Class-DBI-Plugin-QueriesTime distribution. 
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;