From 3353bd2c967fc95c55328c51d0169b5e9d2fbea8 Mon Sep 17 00:00:00 2001
From: Nick Tonkin <1nickt@users.noreply.github.com>
Date: Wed, 29 Nov 2017 17:57:17 -0500
Subject: [PATCH 1/3] Add method `limit_per_dist`. Test not passing.

---
 lib/CPAN/Testers/Schema/ResultSet/Release.pm | 26 ++++++++++++++++++++
 t/resultset/release.t                        |  9 +++++++
 2 files changed, 35 insertions(+)

diff --git a/lib/CPAN/Testers/Schema/ResultSet/Release.pm b/lib/CPAN/Testers/Schema/ResultSet/Release.pm
index b8e99f1..58c19d6 100644
--- a/lib/CPAN/Testers/Schema/ResultSet/Release.pm
+++ b/lib/CPAN/Testers/Schema/ResultSet/Release.pm
@@ -81,5 +81,31 @@ sub maturity( $self, $maturity ) {
     return $self->search( { 'me.distmat' => $maturity } );
 }
 
+=method limit_per_dist
+
+    $rs = $rs->limit_per_dist( 2 );
+
+Restrict results to a maximum number per distribution.
+
+=cut
+
+sub limit_per_dist( $self, $limit ) {
+    my $rs = $self->search(
+        {
+            -and => [
+                \[ '( SELECT COUNT(*)
+                      FROM uploads
+                      WHERE uploads.dist = me.dist
+                      AND uploads.version >= me.version ) <= ?' => $limit ],
+            ],
+        },
+        { join => 'upload' },
+    );
+
+    use Data::Dumper;
+    #warn Dumper($rs->as_query);
+    return $rs;
+}
+
 1;
 __END__
diff --git a/t/resultset/release.t b/t/resultset/release.t
index 8a1d218..5160158 100644
--- a/t/resultset/release.t
+++ b/t/resultset/release.t
@@ -240,6 +240,15 @@ subtest 'maturity' => sub {
     };
 };
 
+subtest 'limit_per_dist' => sub {
+    my $rs = $schema->resultset( 'Release' )->limit_per_dist( 1 );
+    $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
+    $schema->storage->debug(1);
+    is_deeply [ $rs->all ], [ $data{Release}->@[1,3] ], 'limit 1 results per dist'
+        or diag explain [ $rs->all ];
+    $schema->storage->debug(0);
+};
+
 subtest 'since and maturity' => sub {
      my $rs = $schema->resultset( 'Release' )
        ->since( '2016-08-20T00:00:00' )

From db073d0a1f2d30adf987fdd670946e8fbe95da81 Mon Sep 17 00:00:00 2001
From: Nick Tonkin <1nickt@users.noreply.github.com>
Date: Wed, 29 Nov 2017 18:17:31 -0500
Subject: [PATCH 2/3] Update test

---
 lib/CPAN/Testers/Schema/ResultSet/Release.pm | 2 --
 t/resultset/release.t                        | 9 +++++++++
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/lib/CPAN/Testers/Schema/ResultSet/Release.pm b/lib/CPAN/Testers/Schema/ResultSet/Release.pm
index 58c19d6..227a277 100644
--- a/lib/CPAN/Testers/Schema/ResultSet/Release.pm
+++ b/lib/CPAN/Testers/Schema/ResultSet/Release.pm
@@ -102,8 +102,6 @@ sub limit_per_dist( $self, $limit ) {
         { join => 'upload' },
     );
 
-    use Data::Dumper;
-    #warn Dumper($rs->as_query);
     return $rs;
 }
 
diff --git a/t/resultset/release.t b/t/resultset/release.t
index 5160158..5ec1c43 100644
--- a/t/resultset/release.t
+++ b/t/resultset/release.t
@@ -280,6 +280,15 @@ subtest 'by_dist' => sub {
             or diag explain [ $rs->all ];
     };
 
+    subtest 'limit_per_dist' => sub {
+        my $rs = $schema->resultset( 'Release' )->by_dist( 'My-Dist' )
+                ->limit_per_dist( 1 );
+        $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
+        $schema->storage->debug(1);
+        is_deeply [ $rs->all ], [ $data{Release}[2] ], 'get maximum 1 item for My-Dist'
+            or diag explain [ $rs->all ];
+        $schema->storage->debug(0);
+    };
 };
 
 subtest 'by_author' => sub {

From bfa1e608ca5d86398c84cb1f4a8976d1252190d0 Mon Sep 17 00:00:00 2001
From: Nick Tonkin <1nickt@users.noreply.github.com>
Date: Sat, 2 Dec 2017 12:42:47 -0500
Subject: [PATCH 3/3] Added ugly code to limit_per_dist() to accept other
 arguments (ie the other query params) and include same in the
 sequence-generating sub-query. This is working for by_author, but not for
 distmat (see failing test).

---
 lib/CPAN/Testers/Schema/ResultSet/Release.pm | 34 +++++++--
 t/resultset/release.t                        | 72 +++++++++++++++++---
 2 files changed, 92 insertions(+), 14 deletions(-)

diff --git a/lib/CPAN/Testers/Schema/ResultSet/Release.pm b/lib/CPAN/Testers/Schema/ResultSet/Release.pm
index 227a277..3141a7e 100644
--- a/lib/CPAN/Testers/Schema/ResultSet/Release.pm
+++ b/lib/CPAN/Testers/Schema/ResultSet/Release.pm
@@ -89,14 +89,38 @@ Restrict results to a maximum number per distribution.
 
 =cut
 
-sub limit_per_dist( $self, $limit ) {
+sub limit_per_dist( $self, $limit, %args ) {
+    my $seq_sql = q{
+        SELECT COUNT(*)
+        FROM uploads
+        WHERE uploads.dist = me.dist
+        AND uploads.version >= me.version
+    };
+
+    my @bind;
+
+    if ( $args{'maturity'} ) {
+        $seq_sql .= qq{
+            AND me.distmat = ?
+        };
+        push @bind, $args{'maturity'};
+    }
+
+    if ( $args{'author'} ) {
+        $seq_sql .= q{
+            AND uploads.author = ?
+        };
+        push @bind, $args{'author'};
+    };
+
+    $seq_sql = "( $seq_sql ) <= ?";
+
+    push @bind, $limit;
+
     my $rs = $self->search(
         {
             -and => [
-                \[ '( SELECT COUNT(*)
-                      FROM uploads
-                      WHERE uploads.dist = me.dist
-                      AND uploads.version >= me.version ) <= ?' => $limit ],
+                \[ $seq_sql => @bind ],
             ],
         },
         { join => 'upload' },
diff --git a/t/resultset/release.t b/t/resultset/release.t
index 5ec1c43..878ed62 100644
--- a/t/resultset/release.t
+++ b/t/resultset/release.t
@@ -208,8 +208,36 @@ my %data = (
     ],
 );
 
-my $schema = prepare_temp_schema;
-$schema->populate( $_, $data{ $_ } ) for keys %data;
+if ( !eval { require Test::mysqld; 1 } ) {
+    plan skip_all => 'Requires Test::mysqld';
+    return;
+}
+
+no warnings 'once';
+my $mysqld = Test::mysqld->new(
+    my_cnf => {
+        'skip-networking' => '', # no TCP socket
+    },
+);
+if ( !$mysqld ) {
+    plan skip_all => "Failed to start up server: $Test::mysqld::errstr";
+    return;
+}
+
+my ( undef, $version ) = DBI->connect( $mysqld->dsn(dbname => 'test') )->selectrow_array( q{SHOW VARIABLES LIKE 'version'} );
+my ( $mversion ) = $version =~ /^(\d+[.]\d+)/;
+if ( $mversion < 5.7 ) {
+    plan skip_all => "Need MySQL version 5.7 or higher. This is $version";
+    return;
+}
+
+my $schema = CPAN::Testers::Schema->connect(
+    $mysqld->dsn(dbname => 'test'), undef, undef, { ignore_version => 1 },
+);
+$schema->deploy;
+
+# Order is important else we can get a FK error on insert
+$schema->populate( $_, $data{ $_ } ) for ( qw/ Upload Stats Release / );
 
 my $rs = $schema->resultset( 'Release' );
 $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
@@ -243,10 +271,8 @@ subtest 'maturity' => sub {
 subtest 'limit_per_dist' => sub {
     my $rs = $schema->resultset( 'Release' )->limit_per_dist( 1 );
     $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
-    $schema->storage->debug(1);
-    is_deeply [ $rs->all ], [ $data{Release}->@[1,3] ], 'limit 1 results per dist'
+    is_deeply [ $rs->all ], [ $data{Release}->@[1,3] ], 'limit 1 result per dist'
         or diag explain [ $rs->all ];
-    $schema->storage->debug(0);
 };
 
 subtest 'since and maturity' => sub {
@@ -254,10 +280,32 @@ subtest 'since and maturity' => sub {
        ->since( '2016-08-20T00:00:00' )
        ->maturity( 'stable' );
     $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
-    is_deeply [ $rs->all ], [ $data{Release}->@[1..2] ], 'get stable items since 2016-08-20'
+    is_deeply [ $rs->all ], [ $data{Release}->@[1,2] ], 'get stable items since 2016-08-20'
+        or diag explain [ $rs->all ];
+};
+
+subtest 'since and limit_per_dist' => sub {
+     my $rs = $schema->resultset( 'Release' )
+       ->since( '2016-08-20T00:00:00' )
+       ->limit_per_dist( 1 );
+    $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
+    is_deeply [ $rs->all ], [ $data{Release}->@[1,3] ], 'get one item per dist since 2016-08-20'
         or diag explain [ $rs->all ];
 };
 
+subtest 'maturity and limit_per_dist' => sub {
+    my $rs = $schema->resultset( 'Release' )
+       ->maturity( 'stable' )
+       ->limit_per_dist( 1, maturity => 1 );
+    $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
+$schema->storage->debug(1);
+    my $res = $rs->all;
+$schema->storage->debug(0);
+    is_deeply [ $rs->all ], [ $data{Release}->@[1,2] ], 'get one stable item per dist'
+        or diag explain [ $rs->all ];
+};
+
+
 subtest 'by_dist' => sub {
     my $rs = $schema->resultset( 'Release' )->by_dist( 'My-Dist' );
     $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
@@ -284,10 +332,8 @@ subtest 'by_dist' => sub {
         my $rs = $schema->resultset( 'Release' )->by_dist( 'My-Dist' )
                 ->limit_per_dist( 1 );
         $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
-        $schema->storage->debug(1);
-        is_deeply [ $rs->all ], [ $data{Release}[2] ], 'get maximum 1 item for My-Dist'
+        is_deeply [ $rs->all ], [ $data{Release}[1] ], 'get maximum 1 item for My-Dist'
             or diag explain [ $rs->all ];
-        $schema->storage->debug(0);
     };
 };
 
@@ -312,6 +358,14 @@ subtest 'by_author' => sub {
         is_deeply [ $rs->all ], [ $data{Release}[3] ], 'get dev items for PREACTION'
             or diag explain [ $rs->all ];
     };
+
+    subtest 'limit_per_dist' => sub {
+        my $rs = $schema->resultset( 'Release' )->by_author( 'PREACTION' )
+                ->limit_per_dist( 1, author => 'PREACTION' );
+        $rs->result_class( 'DBIx::Class::ResultClass::HashRefInflator' );
+        is_deeply [ $rs->all ], [ $data{Release}->@[0,3] ], 'get maximum 1 item for each PREACTION dist'
+            or diag explain [ $rs->all ];
+    };
 };
 
 done_testing;