lib/DBIx/Class/SQLMaker/Role/SQLA2Passthrough.pm

   1 package DBIx::Class::SQLMaker::Role::SQLA2Passthrough;
   2
   3 use strict;
   4 use warnings;
   5 use Exporter 'import';
   6
   7 our @EXPORT = qw(on);
   8
   9 sub on (&) {
  10   my ($on) = @_;
  11   sub {
  12     my ($args) = @_;
  13     $args->{self_resultsource}
  14          ->schema->storage->sql_maker
  15          ->expand_join_condition(
  16              $on->($args),
  17              $args
  18            );
  19   }
  20 }
  21
  22 use Role::Tiny;
  23
  24 around select => sub {
  25   my ($orig, $self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
  26
  27   $fields = \[ $self->render_expr({ -list => [
  28     grep defined,
  29     map +(ref($_) eq 'HASH'
  30           ? do {
  31               my %f = %$_;
  32               my $as = delete $f{-as};
  33               my ($f, $rhs) = %f;
  34               my $func = +{ ($f =~ /^-/ ? $f : "-${f}") => $rhs };
  35               ($as
  36                 ? +{ -op => [ 'as', $func, { -ident => [ $as ] } ] }
  37                 : $func)
  38             }
  39           : $_), ref($fields) eq 'ARRAY' ? @$fields : $fields
  40   ] }, -ident) ];
  41
  42   if (my $gb = $rs_attrs->{group_by}) {
  43     $rs_attrs = {
  44       %$rs_attrs,
  45       group_by => \[ $self->render_expr({ -list => $gb }, -ident) ]
  46     };
  47   }
  48   $self->$orig($table, $fields, $where, $rs_attrs, $limit, $offset);
  49 };
  50
  51 sub expand_join_condition {
  52   my ($self, $cond, $args) = @_;
  53   my ($type, %known) = do {
  54     if (my $obj = $args->{self_result_object}) {
  55       (self => $obj->get_columns)
  56     } elsif (my $val = $args->{foreign_values}) {
  57       (foreign => %$val)
  58     } else {
  59       ('')
  60     }
  61   };
  62   my $maybe = $type ? 1 : 0;
  63   my $outside;
  64   my $wrap = sub {
  65     my ($orig) = @_;
  66     $outside = $orig;
  67     sub {
  68       my $res = $orig->(@_);
  69       my ($name, $col) = @{$res->{-ident}};
  70       if ($name eq 'self' or $name eq 'foreign') {
  71         if ($type eq $name) {
  72           $maybe = 0 unless exists $known{$col};
  73         }
  74         return { -ident => [ $args->{"${name}_alias"}, $col ] };
  75       }
  76       return $res;
  77     };
  78   };
  79   my $sqla = $self->clone->wrap_op_expander(ident => $wrap);
  80   my $aqt = $sqla->expand_expr($cond, -ident);
  81   return $aqt unless $maybe;
  82   my $inner_wrap = sub {
  83     my $res = $outside->(@_);
  84     my ($name, $col) = @{$res->{-ident}};
  85     if ($name eq 'self' or $name eq 'foreign') {
  86       if ($type eq $name) {
  87         return { -bind => [ $args->{"${name}_alias"}.'.'.$col, $known{$col} ] };
  88       }
  89       return { -ident => [ $args->{"${name}_alias"}, $col ] };
  90     }
  91     return $res;
  92   };
  93   $sqla->op_expander(ident => $inner_wrap);
  94   my $inner_aqt = $self->_collapsify($sqla->expand_expr($cond, -ident));
  95   return ($aqt, $inner_aqt);
  96 }
  97
  98 sub _collapsify {
  99   my ($self, $aqt) = @_;
 100   return $aqt unless my @opargs = @{$aqt->{-op}};
 101   my ($logop, @args) = @opargs;
 102   return $aqt unless $logop eq 'and';
 103   my %collapsed = map {
 104     my $q = $_;
 105     return $aqt unless my @opargs = @{$q->{-op}};
 106     my ($op, $lhs, @rest) = @opargs;
 107     return $aqt unless my @ident = @{$lhs->{-ident}};
 108     (join('.', @ident), { $op => \@rest });
 109   } @args;
 110   return \%collapsed;
 111 }
 112
 113 1;
 114
 115 __END__
 116
 117 =head1 NAME
 118
 119 DBIx::Class::SQLMaker::Role::SQLA2Passthrough - A test of future possibilities
 120
 121 =head1 SYNOPSIS
 122
 123 =over 4
 124
 125 =item * select and group_by options are processed using the richer SQLA2 code
 126
 127 =item * expand_join_condition is provided to more easily express rich joins
 128
 129 =back
 130
 131 See C<examples/sqla2passthrough.pl> for a small amount of running code.
 132
 133 =head1 SETUP
 134
 135   (on_connect_call => sub {
 136      my ($storage) = @_;
 137      $storage->sql_maker
 138              ->with::roles('DBIx::Class::SQLMaker::Role::SQLA2Passthrough');
 139   })
 140
 141 =head2 expand_join_condition
 142
 143   __PACKAGE__->has_many(minions => 'Blah::Person' => sub {
 144     my ($args) = @_;
 145     $args->{self_resultsource}
 146          ->schema->storage->sql_maker
 147          ->expand_join_condition(
 148              $args
 149            );
 150   });
 151
 152 =head2 on
 153
 154   __PACKAGE__->has_many(minions => 'Blah::Person' => on {
 155     { 'self.group_id' => 'foreign.group_id',
 156       'self.rank' => { '>', 'foreign.rank' } }
 157   });
 158
 159 Or with ParameterizedJoinHack,
 160
 161   __PACKAGE__->parameterized_has_many(
 162       priority_tasks => 'MySchema::Result::Task',
 163       [['min_priority'] => sub {
 164           my $args = shift;
 165           return +{
 166               "$args->{foreign_alias}.owner_id" => {
 167                   -ident => "$args->{self_alias}.id",
 168               },
 169               "$args->{foreign_alias}.priority" => {
 170                   '>=' => $_{min_priority},
 171               },
 172           };
 173       }],
 174   );
 175
 176 becomes
 177
 178   __PACKAGE__->parameterized_has_many(
 179       priority_tasks => 'MySchema::Result::Task',
 180       [['min_priority'] => on {
 181         { 'foreign.owner_id' => 'self.id',
 182           'foreign.priority' => { '>=', { -value => $_{min_priority} } } }
 183       }]
 184   );
 185
 186 =cut