Refactor: change passthru strategy

.github/workflows/linux.yml

@@ -10,10 +10,12 @@ jobs:
     strategy:
       matrix:
         perl-version:
-          - '5.22'
           - '5.30'
           - '5.32'
           - '5.34'
+          - '5.36'
+          - '5.38'
+          - '5.40'
     container:
       image: perl:${{ matrix.perl-version }}
     steps:

Changes

@@ -1,5 +1,11 @@
 {{$NEXT}}
 
+  *BREAKING CHANGE*
+  - Change passthrough methods for insert/update to pull any values out of a -sqla2 key
+    instead of special casing ones we support.
+  - Add an `upsert` method to the ResultSet component which handles resolving the PK
+    constraint, and also automates RETURNING the upserted values correctly (see the docs)
+
 0.01_4 2023-06-29T17:10:15Z
 
   Fix ExtraClausesFixed 🤦; `using` now is actually correct

cpanfile

@@ -1,9 +1,9 @@
 # -*- mode: perl -*-
-requires 'perl'          => 'v5.22';
+requires 'perl'          => 'v5.30';
 requires 'DBIx::Class'   => '0.082843';
 requires 'SQL::Abstract' => '2.000001';
 
-test_requires 'DBD::SQLite'     => '0';
+test_requires 'DBD::SQLite'     => '1.68';
 test_requires 'SQL::Translator' => '1.62';
 test_requires 'Test::More'      => '0.98';
 test_requires 'Test2::V0'       => '0.000155';

lib/DBIx/Class/ResultSet/SQLA2Support.pm

@@ -1,14 +1,112 @@
 package DBIx::Class::ResultSet::SQLA2Support;
 use strict;
 use warnings;
+use experimental 'signatures';
 use parent 'DBIx::Class::ResultSet';
+use List::Util 'pairmap';
+use Carp 'croak';
 
-sub populate {
-  my ($self, $to_insert, $attrs) = @_;
+my sub _create_upsert_clause ($self, $columns_ary, $overrides) {
+  my %pks = map +($_ => 1), $self->result_source->primary_columns;
+  return +{
+    -target => [ keys %pks ],
+    -set    => {
+      # create a hash of non-pk cols w/ the value excluded.$_, which does the upsert
+      (map +($_ => { -ident => "excluded.$_" }), grep !$pks{$_}, $columns_ary->@*),
+      # and allow overrides from the caller
+      $overrides->%*
+    }
+  };
+}
+
+sub upsert ($self, $to_insert, $overrides = {}) {
+  # in case there are other passthroughs, you never know
+  my $sqla2_passthru = delete $to_insert->{-sqla2} || {};
+
+  # evil handling for RETURNING, b/c DBIC doesn't give us a place to do it properly.
+  # Basically force each input value to be a ref, and update the column config to use
+  # RETURNING, thus ensuring we get RETURNING handling
+  for my $col (keys $overrides->%*) {
+    next if ref $to_insert->{$col};
+    $to_insert->{$col} = \[ '?' => $to_insert->{$col} ];
+  }
+  my $source = $self->result_source;
+  local $source->{_columns}
+      = { pairmap { $a => { $b->%*, exists $overrides->{$a} ? (retrieve_on_insert => 1) : () } }
+        $source->{_columns}->%* };
+
+  $sqla2_passthru->{on_conflict} = _create_upsert_clause($self, [ keys $to_insert->%* ], $overrides);
+  $self->create({ $to_insert->%*, -sqla2 => $sqla2_passthru });
+}
+
+sub populate ($self, $to_insert, $attrs = undef) {
   # NOTE - hrm, relations is a hard problem here. A "DO NOTHING" should be global, which
   # is why we don't stomp when empty
   local $self->result_source->storage->sql_maker->{_sqla2_insert_attrs} = $attrs if $attrs;
-  shift->next::method(@_);
+  $self->next::method($to_insert);
+}
+
+sub populate_upsert ($self, $to_insert, $overrides = {}) {
+  croak "populate_upsert must be called in void context" if defined wantarray;
+  my @inserted_cols;
+  if (ref $to_insert->[0] eq 'ARRAY') {
+    @inserted_cols = $to_insert->[0]->@*;
+  } else {
+    @inserted_cols = keys $to_insert->[0]->%*;
+  }
+  $self->populate($to_insert, { on_conflict => _create_upsert_clause($self, \@inserted_cols, $overrides) });
 }
 
-1
+1;
+
+=encoding utf8
+
+=head1 NAME
+
+DBIx::Class::SQLA2 - SQL::Abstract v2 support in DBIx::Class
+
+=head1 SYNOPSIS
+
+  # resultset code
+  package MyApp::Schema::ResultSet;
+  __PACKAGE__->load_components('ResultSet::SQLA2Support');
+
+
+  # client code
+  my $rs = $schema->resultset('Album')->populate([{ name => 'thing' }, { name => 'stuff' } ], -sqla2 => { on_conflict => 0 }})
+
+=head1 DESCRIPTION
+
+This is a work in progress for simplifying using SQLA2 with DBIC. This is for using w/ the
+most recent version of DBIC.
+
+B<EXPERIMENTAL>
+
+Allows you to passthru sqla2 options as an extra arg to populate, as in the SYNOPSIS. In
+addition, provides some extra methods.
+
+=head2 METHODS
+
+=over 2 
+
+=item upsert
+
+  # on conflict, add this name to the existing name
+  $rs->upsert({ name => 'thingy', id => 9001 }, { name => \"name || ' ' || excluded.name" });
+
+The first argument is the same as you would pass to a call to C<insert>, except we generate
+an ON CONFLICT clause which will upsert all non-primary-key values. You can pass a hashref
+as the second argument to override the default on conflict value. You can pass in anything
+(literal SQL is quite helpful here) and it will be retrieved by DBIC on the insert using
+DBIC's return_on_insert functionality.
+
+=item populate_upsert
+
+  # on conflict, add this name to the existing name
+  $rs->populate_upsert([{ name => 'thingy', id => 9001 }, { name => 'over 9000', id => 9002 }], { name => \"name || ' ' || excluded.name" });
+
+Same as C<upsert> above, just for C<populate>. Dies a horrible death if called in non-void context.
+
+=back
+
+=cut

lib/DBIx/Class/Row/SQLA2Support.pm

@@ -5,18 +5,9 @@ use parent 'DBIx::Class::Row';
 
 sub new {
   my ($class, $attrs) = @_;
-  my $on_conflict = delete $attrs->{-on_conflict};
-  my $to_upsert   = 1 if delete $attrs->{-upsert};
-  my $new         = $class->next::method($attrs);
-  $new->{_sqla2_attrs} = { on_conflict => $on_conflict } if defined $on_conflict;
-  if ($to_upsert) {
-    $to_upsert = {%$attrs};
-    my @pks = $new->result_source->primary_columns;
-    delete @$to_upsert{@pks};
-    $new->{_sqla2_attrs}
-        = {
-          on_conflict => { -target => \@pks, -set => { map +($_ => { -ident => "excluded.$_" }), keys %$to_upsert } } };
-  }
+  my $sqla2_passthru = delete $attrs->{-sqla2} || {};
+  my $new            = $class->next::method($attrs);
+  $new->{_sqla2_attrs} = $sqla2_passthru;
 
   return $new;
 }

lib/DBIx/Class/SQLA2.pm

@@ -105,6 +105,17 @@ most recent version of DBIC.
 
 For a simple way of using this, take a look at L<DBIx::Class::Schema::SQLA2Support>.
 
+In order to have inserts passthru SQLA2 keys, you should use the
+L<DBIx::Class::Row::SQLA2Support> component, which allows you to add a C<-sqla2> key w/ a
+hashref containing your passthroughs.
+
+In order to support SQLA2 keys for bulk inserts (C<populate>), use the
+L<DBIx::Class::ResultSet::SQLA2Support> component. It adds a second arg to C<populate> which
+allows you to add things to the final query (though you may get undefined behavior if
+you're creating deep relationships - real world experience would be nice here). In
+addition, it adds an C<upsert> method to simplify the case of update on a primary
+key conflict (see there for more details).
+
 B<EXPERIMENTAL>
 
 This role itself will add handling of hashref-refs to select lists + group by clauses,
@@ -137,7 +148,7 @@ Adds some hacky stuff so you can bypass/supplement DBIC's handling of certain cl
 
 =head1 AUTHOR
 
-Copyright (c) 2022 Veesh Goldman <[email protected]>
+Copyright (c) 2022-24 Veesh Goldman <[email protected]>
 
 =head1 LICENSE
 

t/lib/Local/Schema/Result/Artist.pm

@@ -7,7 +7,7 @@ __PACKAGE__->table("artist");
 
 __PACKAGE__->add_columns(
   artistid => { data_type => 'integer', is_auto_increment => 1 },
-  name     => { data_type => 'text', },
+  name     => { data_type => 'text' },
 );
 
 __PACKAGE__->set_primary_key('artistid');

t/upsert.t

@@ -25,7 +25,7 @@ $schema->resultset('Artist')->populate([
 ]);
 
 subtest 'do nothing' => sub {
-  $schema->resultset('Artist')->create({ artistid => 3, name => 'LSD', -on_conflict => 0 });
+  $schema->resultset('Artist')->create({ artistid => 3, name => 'LSD', -sqla2 => { on_conflict => 0 } });
   is $schema->resultset('Artist')->find(3)->{name}, 'LSG', '0 is DO NOTHING';
 };
 
@@ -52,17 +52,28 @@ subtest 'do nothing on populate' => sub {
 };
 
 subtest 'update' => sub {
-  $schema->resultset('Artist')
-      ->create({
-        artistid     => 3,
-        name         => 'LSD',
-        -on_conflict => { artistid => { name => \"name || ' ' || excluded.name" } }
-      });
+  my $updated = $schema->resultset('Artist')
+      ->upsert({ artistid => 3, name => 'LSD' }, { name => \"name || ' ' || excluded.name" });
+  is $updated->name,                                'LSG LSD', 'holycrud, our fancy RETURNING werkz';
   is $schema->resultset('Artist')->find(3)->{name}, 'LSG LSD', 'a hash sets';
 
-  $schema->resultset('Artist')
-      ->create({ artistid => 3, name => 'LSB', -upsert => 1 });
+  my $returned = $schema->resultset('Artist')
+      ->upsert({ artistid => 3, name => 'LSB' });
+  is $returned->name,                               'LSB', 'returned row is properly updated';
   is $schema->resultset('Artist')->find(3)->{name}, 'LSB', '-upsert is a shortcut!';
 };
 
+subtest 'populate_upsert' => sub {
+  my $artist_rs = $schema->resultset('Artist');
+  $artist_rs->populate([ { artistid => 9000, name => 'Fame' }, { artistid => 9001, name => 'Lame' }]);
+
+  $artist_rs->populate_upsert([ { artistid => 9000, name => 'Fame' }, { artistid => 9001, name => 'Lame' }], { name => \"name || '--' || excluded.name" });
+
+  my @artists = $artist_rs->search({ artistid => { '>=' => 9000 }}, { order_by => 'artistid' });
+
+  is $artists[0]->{name}, 'Fame--Fame', 'first artist updated';
+  is $artists[1]->{name}, 'Lame--Lame', 'second artist updated';
+
+};
+
 done_testing;