lib/CtrlO/DBIC/Cursor/RowCountStatistics.pm

   1 use strict;
   2 use warnings;
   3
   4 package CtrlO::DBIC::Cursor::RowCountStatistics;
   5 use Class::Method::Modifiers;
   6
   7 use CtrlO::DBIC::Cursor::RowCountStatistics::Storage;
   8
   9 use parent 'DBIx::Class::Storage::DBI::Cursor';
  10
  11 our $VERSION = '0.000001'; # 0.0.1
  12 $VERSION = eval $VERSION;
  13
  14 around new => sub {
  15     my $orig = shift;
  16     my ($class, $storage, @rest) = @_;
  17     return $orig->(
  18         $class,
  19         CtrlO::DBIC::Cursor::RowCountStatistics::Storage->new($storage),
  20         @rest,
  21     );
  22 };
  23
  24 after next => sub {
  25     my ($self) = @_;
  26     $self->{_ctrlo_rcs_count}++
  27         unless $self->{_done};
  28 };
  29
  30 around all => sub {
  31     my $orig = shift;
  32     my ($self) = @_;
  33     my @rows = $orig->(@_);
  34     $self->_emit_query_complete(scalar(@rows));
  35     return @rows;
  36 };
  37
  38 before __finish_sth => sub {
  39     my ($self) = @_;
  40     my $sql = $self->sth->{Statement};
  41     $self->_emit_query_complete($self->{_ctrlo_rcs_count} || 0);
  42 };
  43
  44 sub _emit_query_complete {
  45     my ($self, $count) = @_;
  46     $self->storage->debugobj->query_complete(
  47         $count,
  48         $self->storage->_cached_sql,
  49         # TODO pass bind params
  50     ) if $self->storage->debug
  51         and $self->storage->debugobj->can('query_complete');
  52 }
  53
  54 1;
  55
  56 =head1 NAME
  57
  58 CtrlO::DBIC::Cursor::RowCountStatistics - Description goes here
  59
  60 =head1 SYNOPSIS
  61
  62 =head1 DESCRIPTION
  63
  64 =head1 AUTHOR
  65
  66  r.sedlacek@shadowcat.co.uk
  67
  68 =head1 CONTRIBUTORS
  69
  70 None yet - maybe this software is perfect! (ahahahahahahahahaha)
  71
  72 =head1 COPYRIGHT
  73
  74 Copyright (c) 2015 the CtrlO::DBIC::Cursor::RowCountStatistics L</AUTHOR> and L</CONTRIBUTORS>
  75 as listed above.
  76
  77 =head1 LICENSE
  78
  79 This library is free software and may be distributed under the same terms
  80 as perl itself.