From: Robert Sedlacek <r.sedlacek@shadowcat.co.uk>
Date: Wed, 26 Aug 2015 16:07:02 +0000 (+0000)
Subject: first version
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=231ba12b377e7434a136b875bf7335b15fac789a;p=dbsrgits%2FDBIx-Class-RowCountStatistics.git

first version
---

231ba12b377e7434a136b875bf7335b15fac789a
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..d4736e6
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,10 @@
+use strict;
+use warnings FATAL => 'all';
+use ExtUtils::MakeMaker;
+
+(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
+
+WriteMakefile(
+  NAME => 'CtrlO::DBIC::Cursor::RowCountStatistics',
+  VERSION_FROM => 'lib/CtrlO/DBIC/Cursor/RowCountStatistics.pm'
+);
diff --git a/lib/CtrlO/DBIC/Cursor/RowCountStatistics.pm b/lib/CtrlO/DBIC/Cursor/RowCountStatistics.pm
new file mode 100644
index 0000000..ba0a828
--- /dev/null
+++ b/lib/CtrlO/DBIC/Cursor/RowCountStatistics.pm
@@ -0,0 +1,54 @@
+use strict;
+use warnings;
+
+package CtrlO::DBIC::Cursor::RowCountStatistics;
+use Class::Method::Modifiers;
+
+use parent 'DBIx::Class::Storage::DBI::Cursor';
+
+our $VERSION = '0.000001'; # 0.0.1
+$VERSION = eval $VERSION;
+
+after next => sub {
+    my ($self) = @_;
+    $self->{_ctrlo_rcs_count}++
+        unless $self->{_done};
+};
+
+before __finish_sth => sub {
+    my ($self) = @_;
+    my $sql = $self->sth->{Statement};
+    $self->storage->debugobj->query_complete(
+        $self->{_ctrlo_rcs_count} || 0,
+        $sql,
+        # TODO pass bind params
+    ) if $self->storage->debug;
+};
+
+1;
+
+=head1 NAME
+
+CtrlO::DBIC::Cursor::RowCountStatistics - Description goes here
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+ r.sedlacek@shadowcat.co.uk
+
+=head1 CONTRIBUTORS
+
+None yet - maybe this software is perfect! (ahahahahahahahahaha)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2015 the CtrlO::DBIC::Cursor::RowCountStatistics L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
diff --git a/maint/Makefile.PL.include b/maint/Makefile.PL.include
new file mode 100644
index 0000000..7cdeef0
--- /dev/null
+++ b/maint/Makefile.PL.include
@@ -0,0 +1,8 @@
+BEGIN {
+  -e 'Distar'
+    or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git")
+}
+use lib 'Distar/lib';
+use Distar;
+
+author 'r.sedlacek@shadowcat.co.uk';
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..9b7550a
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,83 @@
+use strict;
+use warnings;
+
+use Test::More;
+use FindBin;
+
+BEGIN {
+    push @INC, "$FindBin::Bin/lib";
+}
+
+use TestSchema;
+use CtrlO::DBIC::Cursor::RowCountStatistics;
+
+our @_COMPLETE;
+
+do {
+    package TestStats;
+    use parent 'DBIx::Class::Storage::Statistics';
+    sub new {
+        bless {}, shift;
+    }
+    sub query_start { }
+    sub query_end { }
+    sub query_complete {
+        my ($self, @args) = @_;
+        push @_COMPLETE, \@args;
+    }
+};
+
+my $schema = TestSchema->connect(
+    'dbi:SQLite:dbname=:memory:',
+    undef, undef,
+    {},
+    {
+        cursor_class => 'CtrlO::DBIC::Cursor::RowCountStatistics',
+    }
+);
+$schema->deploy();
+$schema->storage->debugobj(TestStats->new);
+$schema->storage->debug(1);
+
+ok $schema, 'schema created';
+is $schema->storage->cursor_class,
+    'CtrlO::DBIC::Cursor::RowCountStatistics',
+    'cursor_class set';
+
+my $rs = $schema->resultset('Test');
+
+subtest 'simple' => sub {
+    local @_COMPLETE;
+    $rs->create({ id => $_ }) for 1..10;
+    do {
+        my $rows = $rs->search_rs;
+        is ref($rows->cursor), 'CtrlO::DBIC::Cursor::RowCountStatistics',
+            'resultset cursor';
+        1 while $rows->next;
+    };
+    is scalar(@_COMPLETE), 1, 'single complete call';
+    is $_COMPLETE[0][0], 10, 'full count';
+    $rs->delete;
+};
+
+subtest 'empty' => sub {
+    local @_COMPLETE;
+    do {
+        my $rows = $rs->search_rs;
+        1 while $rows->next;
+    };
+    is scalar(@_COMPLETE), 1, 'single complete call';
+    is $_COMPLETE[0][0], 0, 'full count';
+};
+
+subtest 'no fetch' => sub {
+    local @_COMPLETE;
+    $rs->create({ id => $_ }) for 1..10;
+    do {
+        my $rows = $rs->search_rs;
+    };
+    is scalar(@_COMPLETE), 0, 'no complete calls';
+    $rs->delete;
+};
+
+done_testing;
diff --git a/t/lib/TestSchema.pm b/t/lib/TestSchema.pm
new file mode 100644
index 0000000..6812463
--- /dev/null
+++ b/t/lib/TestSchema.pm
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+
+package TestSchema;
+use parent 'DBIx::Class::Schema';
+
+__PACKAGE__->load_namespaces;
+
+1;
diff --git a/t/lib/TestSchema/Result/Test.pm b/t/lib/TestSchema/Result/Test.pm
new file mode 100644
index 0000000..fe99fef
--- /dev/null
+++ b/t/lib/TestSchema/Result/Test.pm
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+package TestSchema::Result::Test;
+use parent 'DBIx::Class::Core';
+
+__PACKAGE__->table('test');
+__PACKAGE__->add_columns(
+    id => { data_type => 'integer', },
+);
+__PACKAGE__->set_primary_key('id');
+
+1;