Merge branch 'master' into refactor/change-passthru

Changes

@@ -1,3 +1,10 @@
 {{$NEXT}}
-  Initial release; ExtraClauses, BangOverrides and Upsert support!
+
+0.01_2 2023-05-27T20:34:54Z
+
+  Update hashrefref support to hook _recurse_fields such that join pruning no longer
+  explodes
+
+0.01 2023-05-21T15:01:10Z
+  Initial release; ExtraClauses, BangOverrides, Upsert, WindowFunction and CaseExpr support!
   SUPER EXPERIMENTAL!

META.json

@@ -43,7 +43,8 @@
       "runtime" : {
          "requires" : {
             "DBIx::Class" : "0.082843",
-            "SQL::Abstract" : "2.000001"
+            "SQL::Abstract" : "2.000001",
+            "perl" : "5.22"
          }
       },
       "test" : {
@@ -66,7 +67,7 @@
          "web" : "https://github.com/rabbiveesh/dbic-sqla2"
       }
    },
-   "version" : "0.01",
+   "version" : "0.01_2",
    "x_contributors" : [
       "Roy Storey <[email protected]>",
       "Veesh Goldman <[email protected]>"

README.md

@@ -15,6 +15,10 @@ For a simple way of using this, take a look at [DBIx::Class::Schema::SQLA2Suppor
 
 **EXPERIMENTAL**
 
+This role itself will add handling of hashref-refs to select lists + group by clauses,
+which will render the inner hashref as if it had been passed through to SQLA2 rather than
+doing the recursive function rendering that DBIC does.
+
 ## Included Plugins
 
 This will add the following SQLA2 plugins:
@@ -23,6 +27,10 @@ This will add the following SQLA2 plugins:
 
     Adds support for CTEs, and other fun new SQL syntax
 
+- [SQL::Abstract::Plugin::WindowFunctions](https://metacpan.org/pod/SQL%3A%3AAbstract%3A%3APlugin%3A%3AWindowFunctions)
+
+    Adds support for window functions and advanced aggregates.
+
 - [SQL::Abstract::Plugin::Upsert](https://metacpan.org/pod/SQL%3A%3AAbstract%3A%3APlugin%3A%3AUpsert)
 
     Adds support for Upserts (ON CONFLICT clause)

cpanfile

@@ -1,4 +1,5 @@
 # -*- mode: perl -*-
+requires 'perl'          => '5.22';
 requires 'DBIx::Class'   => '0.082843';
 requires 'SQL::Abstract' => '2.000001';
 

lib/DBIx/Class/SQLA2.pm

@@ -13,31 +13,40 @@ use base qw(
 
 use Role::Tiny;
 
+sub _render_hashrefrefs {
+  my ($self, $list) = @_;
+  my @fields = ref $list eq 'ARRAY' ? @$list : $list;
+  return [
+    map {
+      ref $_ eq 'REF' && ref $$_ eq 'HASH'
+          ? do {
+            my %f  = $$_->%*;
+            my $as = delete $f{-as};
+            \[
+                $as
+              ? $self->render_expr({ -op => [ 'as', \%f, { -ident => $as } ] })
+              : $self->render_expr(\%f)
+            ];
+      }
+          : $_
+    } @fields
+  ];
+}
+
+sub _recurse_fields {
+  my ($self, $fields) = @_;
+  if (ref $fields eq 'REF' && ref $$fields eq 'HASH') {
+    return $self->next::method($self->_render_hashrefrefs($fields)->[0]);
+  }
+  return $self->next::method($fields);
+
+}
+
 sub select {
   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
 
-  my $expand_hashrefref = sub {
-    my $list   = shift;
-    my @fields = ref $list eq 'ARRAY' ? @$list : $list;
-    return [
-      map {
-        ref $_ eq 'REF' && ref $$_ eq 'HASH'
-            ? do {
-              my %f  = $$_->%*;
-              my $as = delete $f{-as};
-              \[
-                  $as
-                ? $self->render_expr({ -op => [ 'as', \%f, { -ident => $as } ] })
-                : $self->render_expr(\%f)
-              ];
-        }
-            : $_
-      } @fields
-    ];
-  };
-  $fields = $expand_hashrefref->($fields);
   if (my $gb = $rs_attrs->{group_by}) {
-    $rs_attrs = { %$rs_attrs, group_by => $expand_hashrefref->($gb) };
+    $rs_attrs = { %$rs_attrs, group_by => $self->_render_hashrefrefs($gb) };
   }
   $self->next::method($table, $fields, $where, $rs_attrs, $limit, $offset);
 }
@@ -68,11 +77,13 @@ sub expand_clause {
 
 sub new {
   my $new = shift->next::method(@_);
-  $new->plugin('+ExtraClauses')->plugin('+WindowFunctions')->plugin('+Upsert')->plugin('+BangOverrides')
-      unless (grep {m/^with$/} $new->clauses_of('select'));
+  unless (grep {m/^with$/} $new->clauses_of('select')) {
+    $new->plugin("+$_") for qw/ExtraClauses WindowFunctions Upsert BangOverrides CaseExpr/;
+  }
+  return $new;
 }
 
-our $VERSION = '0.01';
+our $VERSION = '0.01_2';
 
 1;
 

lib/SQL/Abstract/Plugin/CaseExpr.pm

@@ -0,0 +1,103 @@
+package SQL::Abstract::Plugin::CaseExpr;
+use feature qw/signatures postderef/;
+
+our $VERSION = '0.01_2';
+use Moo;
+with 'SQL::Abstract::Role::Plugin';
+use List::Util qw/pairmap/;
+
+no warnings 'experimental::signatures';
+
+sub register_extensions ($self, $sqla) {
+
+  $sqla->expander(
+    case => sub ($sqla, $name, $value) {
+      # if the user passed in the double array-ref, then we assume it's already expanded
+      return { -case => $value } if ref $value->[0] eq 'ARRAY';
+      my $else;
+      my @conditions = $value->@*;
+      $else = pop @conditions unless @conditions * %2;
+      return {
+        -case => [
+          [ map +($sqla->expand_expr($_->{if}, -ident), $sqla->expand_expr($_->{then}, -value)), @conditions ],
+          $else ? $sqla->expand_expr($else, -value) : ()
+        ]
+      };
+    }
+  );
+  $sqla->renderer(
+    case => sub ($sqla, $name, $value) {
+      my $else = $value->[1];
+      $sqla->join_query_parts(
+        ' ',
+        { -keyword => 'CASE' },
+        (pairmap { ({ -keyword => 'WHEN' }, $a, { -keyword => 'THEN' }, $b) } $value->[0]->@*),
+        $else ? ({ -keyword => 'ELSE' }, $else) : (),
+        { -keyword => 'END' }
+      );
+    }
+  );
+
+}
+
+1;
+
+=encoding utf8
+
+=head1 NAME
+
+SQL::Abstract::Plugin::CaseExpr - Case Expression support for SQLA2!
+
+=head1 SYNOPSIS
+
+  # pass this to anything that SQLA will render
+  # arrayref b/c order matters
+  { -case => [
+    # if/then is a bit more familiar than WHEN/THEN
+    {
+      if   => { sales => { '>' => 9000 } },
+      # scalars default to bind params
+      then => 'Scouter Breaking'
+    },
+    {
+      if   => { sales => { '>' => 0 } },
+      then => 'At least something'
+    },
+    # if the final node does not contain if, it's the ELSE clause
+    'How did this happen?'
+  ]}
+  # CASE WHEN sales > 9000 THEN ? WHEN sales > 0 THEN ? ELSE ? END
+  # [ 'Scouter Breaking', 'At least something', 'How did this happen?' ]
+
+=head1 DESCRIPTION
+
+This is a work in progress to support CASE expressions in SQLA2
+
+B<EXPERIMENTAL>
+
+=head2 Using with DBIx::Class
+
+In order to use this with DBIx::Class, you simply need to apply the DBIC-SQLA2 plugin, and
+then your SQLMaker will support this syntax!
+
+=head2 New Syntax
+
+=head3 -case node
+
+The entry point for the new handling is the -case node. This takes an arrayref of hashrefs which represent the branches of the conditional tree, and optionally a final entry as the default clause.
+
+The hashrefs must have the following two keys:
+
+=over 4
+
+=item if
+
+The condition to be checked against. It is processed like a WHERE clause.
+
+=item then
+
+The value to be returned if this condition is true. Scalars here default to -value, which means they are taken as bind parameters
+
+=back
+
+=cut

lib/SQL/Abstract/Plugin/Upsert.pm

@@ -50,7 +50,7 @@ sub register_extensions {
   );
 }
 
-our $VERSION = '0.01';
+our $VERSION = '0.01_2';
 
 1;
 

lib/SQL/Abstract/Plugin/WindowFunctions.pm

@@ -1,7 +1,7 @@
 package SQL::Abstract::Plugin::WindowFunctions;
 use feature qw/signatures postderef/;
 
-our $VERSION = '0.01';
+our $VERSION = '0.01_2';
 use Moo;
 with 'SQL::Abstract::Role::Plugin';
 

minil.toml

@@ -1 +1,4 @@
 name = 'DBIx-Class-SQLA2'
+
+[FileGatherer]
+exclude_match = [ '^ideas/*' ]

t/case_expr.t

@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Temp ();
+use lib 't/lib';
+use Local::Schema;
+
+my $tmpdir = File::Temp->newdir;
+my $schema = Local::Schema->connect("dbi:SQLite:$tmpdir/on_conflict.sqlite");
+ok $schema, 'created';
+$schema->storage->ensure_connected;
+
+# deploy + populate
+$schema->deploy({ add_drop_table => 1 });
+$schema->resultset('Artist')->populate([
+  {
+    artistid => 2,
+    name     => 'Portishead',
+    albums   =>
+        [ { title => 'Portishead', rank => 2 }, { title => 'Dummy', rank => 3 }, { title => 'Third', rank => 4 }, ]
+  },
+  { artistid => 1, name => 'Stone Roses', albums => [ { title => 'Second Coming', rank => 1 }, ] },
+  { artistid => 3, name => 'LSG' }
+]);
+
+subtest 'using a CASE expression' => sub {
+  my @oddity = $schema->resultset('Album')->search(undef, {
+      'columns' => [
+        'rank',
+        'title',
+        { oddity => \{ -case => [
+              { if => { -mod => [ 'rank', 2 ] }, then => 'Quite Odd' },
+              'Even'
+            ] ,
+        -as => 'oddity'}
+    }],
+        order_by => { -asc => 'rank'}
+    })->all;
+
+  is_deeply \@oddity, [
+    { title => 'Second Coming', rank => 1, oddity => 'Quite Odd'},
+    { title => 'Portishead', rank => 2, oddity => 'Even'},
+    { title => 'Dummy', rank => 3, oddity => 'Quite Odd'},
+    { title => 'Third', rank => 4, oddity => 'Even'},
+  ], 'got expected result';
+};
+
+subtest 'passes through the double arrayref syntax' => sub {
+  my @oddity = $schema->resultset('Album')->search(undef, {
+      'columns' => [
+        'rank',
+        'title',
+        { oddity => \{ -case => [
+              [{ -func => [ 'mod', 'rank', 2 ] } => { -bind => [ undef, 'Quite Odd' ] }],
+              { -bind => [ undef, 'Even']}
+            ] ,
+        -as => 'oddity'}
+    }],
+        order_by => { -asc => 'rank'}
+    })->all;
+
+  is_deeply \@oddity, [
+    { title => 'Second Coming', rank => 1, oddity => 'Quite Odd'},
+    { title => 'Portishead', rank => 2, oddity => 'Even'},
+    { title => 'Dummy', rank => 3, oddity => 'Quite Odd'},
+    { title => 'Third', rank => 4, oddity => 'Even'},
+  ], 'got expected result';
+
+};
+
+done_testing;