lib/DBIx/Class/ResultSet/Role/DQMethods.pm

   1 package DBIx::Class::ResultSet::Role::DQMethods;
   2
   3 use Data::Query::ExprHelpers;
   4 use Safe::Isa;
   5 use Moo::Role;
   6 use namespace::clean;
   7
   8 sub _dq_converter {
   9   shift->result_source->schema->storage->sql_maker->converter;
  10 }
  11
  12 sub where {
  13   my ($self, $where) = @_;
  14   if ($where->$_isa('Data::Query::ExprBuilder')) {
  15     return $self->_apply_dq_where($where->{expr});
  16   } elsif (ref($where) eq 'HASH') {
  17     return $self->_apply_dq_where(
  18              $self->_dq_converter->_where_to_dq($where)
  19            );
  20   }
  21   die "Argument to ->where must be ExprBuilder or SQL::Abstract hashref, got: "
  22       .(defined($where) ? $where : 'undef');
  23 }
  24
  25 sub _apply_dq_where {
  26   my ($self, $expr) = @_;
  27   my ($mapped, $need_join) = $self->_remap_identifiers($expr);
  28   $self->search_rs(\$mapped, (@$need_join ? { join => $need_join } : ()));
  29 }
  30
  31 sub _remap_identifiers {
  32   my ($self, $dq) = @_;
  33   my $map = {
  34     '' => {
  35       -alias => $self->current_source_alias,
  36       -rsrc => $self->result_source,
  37     }
  38   };
  39   my $attrs = $self->_resolved_attrs;
  40   foreach my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
  41     next unless $j->[0]{-alias};
  42     next unless $j->[0]{-join_path};
  43     my $p = $map;
  44     $p = $p->{$_} ||= {} for map { keys %$_ } @{$j->[0]{-join_path}};
  45     $p->{''} = $j->[0];
  46   }
  47
  48   my $seen_join = { %{$attrs->{seen_join}||{}} };
  49   my $storage = $self->result_source->storage;
  50   my @need_join;
  51   my %seen_op;
  52   my $mapped = map_dq_tree {
  53     return $_ unless is_Identifier;
  54     my @el = @{$_->{elements}};
  55     my $last = pop @el;
  56     my $p = $map;
  57     $p = $p->{$_} ||= {} for @el;
  58     unless ($p->{''}) {
  59       my $need = my $j = {};
  60       $j = $j->{$_} = {} for @el;
  61       my $rsrc = $map->{''}{-rsrc};
  62       $rsrc = $rsrc->related_source($_) for @el;
  63       push @need_join, $need;
  64       my $alias = $storage->relname_to_table_alias(
  65         $el[-1], ++$seen_join->{$el[-1]}
  66       );
  67       $p->{''} = { -alias => $alias, -rsrc => $rsrc };
  68     }
  69     my $info = $p->{''};
  70     if ($info->{-rsrc}->has_relationship($last)) {
  71       die "Invalid name on ".(join(',',@el)||'me').": $last is a relationship";
  72     }
  73     my $col_map = $info->{-column_mapping} ||= do {
  74       my $colinfo = $info->{-rsrc}->columns_info;
  75       +{ map +(($colinfo->{$_}{rename_for_dq}||$_) => $_), keys %$colinfo }
  76     };
  77     die "Invalid name on ".(join(',',@el)||'me').": $last"
  78       unless $col_map->{$last};
  79     return Identifier($info->{-alias}, $col_map->{$last});
  80   } $dq;
  81   return ($mapped, \@need_join);
  82 }
  83
  84 1;