fixup passthrough and add example
Matt S Trout [Sun, 13 Oct 2019 16:45:14 +0000 (16:45 +0000)]
examples/sqla2passthrough.pl [new file with mode: 0644]
lib/DBIx/Class/SQLMaker/Role/SQLA2Passthrough.pm

diff --git a/examples/sqla2passthrough.pl b/examples/sqla2passthrough.pl
new file mode 100644 (file)
index 0000000..4cf87b9
--- /dev/null
@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+use Devel::Dwarn;
+use With::Roles;
+{
+  package MySchema;
+  use Object::Tap;
+  use base qw(DBIx::Class::Schema);
+  use DBIx::Class::ResultSource::Table;
+  __PACKAGE__->register_source(
+    Foo => DBIx::Class::ResultSource::Table->new({ name => 'foo' })
+             ->$_tap(add_columns => qw(x y z))
+  );
+  __PACKAGE__->register_source(
+    Bar => DBIx::Class::ResultSource::Table->new({ name => 'bar' })
+             ->$_tap(add_columns => qw(x y1 y2 z))
+  );
+}
+{
+  package MyScratchpad;
+  use DBIx::Class::SQLMaker::Role::SQLA2Passthrough qw(on);
+  MySchema->source('Foo')->add_relationship(bars => 'Bar' => on {
+    +{ 'foreign.x' => 'self.x',
+       'self.y' => { -between => [ qw(foreign.y1 foreign.y2) ] }
+    };
+  });
+}
+
+my $s = MySchema->connect('dbi:SQLite:dbname=:memory:');
+::Dwarn([ $s->source('Foo')->columns ]);
+
+my $rs = $s->resultset('Foo')->search({ z => 1 });
+
+::Dwarn(${$rs->as_query}->[0]);
+
+$s->storage->ensure_connected;
+
+$s->storage
+  ->sql_maker
+  ->with::roles('DBIx::Class::SQLMaker::Role::SQLA2Passthrough')
+  ->plugin('+ExtraClauses')
+  ->plugin('+BangOverrides');
+
+warn ref($s->storage->sql_maker);
+
+my $rs2 = $s->resultset('Foo')->search({
+  -op => [ '=', { -ident => 'outer.y' }, { -ident => 'me.x' } ]
+}, {
+  'select' => [ 'me.x', { -ident => 'me.z' } ],
+  '!with' => [ outer => $rs->get_column('x')->as_query ],
+});
+
+::Dwarn(${$rs2->as_query}->[0]);
+
+my $rs3 = $s->resultset('Foo')
+            ->search({}, { prefetch => 'bars' });
+
+::Dwarn(${$rs3->as_query}->[0]);
index 572184f..a678f4d 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Exporter 'import';
 
-our @EXPORT = qw('on');
+our @EXPORT = qw(on);
 
 sub on (&) {
   my ($on) = @_;
@@ -31,7 +31,7 @@ around select => sub {
               my %f = %$_;
               my $as = delete $f{-as};
               my ($f, $rhs) = %f;
-              my $func = +{ "-${f}" => $rhs };
+              my $func = +{ ($f =~ /^-/ ? $f : "-${f}") => $rhs };
               ($as
                 ? +{ -op => [ 'as', $func, { -ident => [ $as ] } ] }
                 : $func)
@@ -46,7 +46,7 @@ around select => sub {
     };
   }
   $self->$orig($table, $fields, $where, $rs_attrs, $limit, $offset);
-});
+};
 
 sub expand_join_condition {
   my ($self, $cond, $args) = @_;