has_manyなテーブルでAND検索 - Class::DBI::Sweet::Cake

has_manyなテーブルでAND検索 - Class::DBI::Sweet::Cake

MyData::Article->search({
  'tags.name' => {
    -and => [qw/ foo bar baz /],
  },
});

http://asakura.g.hatena.ne.jp/asakura-t/20060330/1143721817

――とか出来るようになるモノを作ってみた。

　NORを簡単に実現するSQLが思いつかなかったので半端モンですが。

　タグの検索に使うんであればQDBMでも使ったほうがいいんじゃないかと思いつつ。かぜぶろさんはSennaを直接叩いてるみたいです。

　いずれにしろこの手のヤツはSQLで扱うよりDBMのAPIを直接叩いたほうが楽な気がします。

簡単な解説

• whereメソッドでは
  1. $where の中に 'join_table.column' => {-and => \@list} なモノがあったら、
  2. join_table が has_many かどうかを確認して、
  3. $where に 'join_table__$count.column' => shift @list を追加する
• _resolve_joinでは
  1. join のデータを作るときに qr/^(.+)__\d+$/ なAlias名の時は$1を参照するようにした

――感じでしょうか。

　結局Class::DBI::Sweetで使っているClass::DBI::Sweet::SQL::Abstractのwhereと_resolve_joinを上書きして、useしたクラス以外に影響が出ないように小細工をした感じ。

　副作用がちょっとある*1けど、Class::DBI::Sweetに直接パッチをあてても大丈夫な気もします。が、テストしてみないとなんとも*2。

ソースコード

package Class::DBI::Sweet::Cake;
use strict;
our $VERSION = '0.01';

use base qw/Class::Data::Inheritable/;
__PACKAGE__->mk_classdata( ISA => {} );

use Carp qw/croak/;

sub import {
  my $class = shift;

  my $ISA = $class->ISA;
  $ISA->{ $class } = $class;

  require Class::DBI::Sweet;
  my $sub_where = UNIVERSAL::can('Class::DBI::Sweet::SQL::Abstract', 'where');

  no strict 'refs';
  undef *Class::DBI::Sweet::SQL::Abstract::where;
  *Class::DBI::Sweet::SQL::Abstract::where = sub {
      return $sub_where->( @_ ) unless $ISA->{ +caller(0) };

      my ($self, $where, $order, $must_join) = @_;
      my $me = $self->{cdbi_me_alias};
      $self->{cdbi_table_aliases} = { $me => $self->{cdbi_class} };
      $self->{cdbi_join_info}     = { };
      $self->{cdbi_column_cache}  = { };

      foreach my $join (@{$must_join || []}) {
        $self->_resolve_join($me => $join);
      }

## add
{
      my $l_alias = $me;
      my $l_class = $self->{cdbi_class};
      my $meta = $l_class->meta_info;
      foreach my $colum (keys %$where) {
        my $val = $where->{ $colum };
        next unless ref $val eq 'HASH';
        next unless exists $val->{'-and'};

        my ($f_alias, $match_col) = $colum =~ m/^(.+?)\.(.+)$/;
        next unless $meta->{has_many}{$f_alias};

        my $match_list  = delete $val->{'-and'};
        my $match_count = scalar @$match_list;

        for my $i (1 .. $match_count) {
          my $new_f_alias = "${f_alias}__$i";
          $where->{"$new_f_alias.$match_col"} = shift @$match_list;
        }
      }
}
## end

      my $sql = '';
      my (@ret) = $self->_recurse_where($where);

      if (@ret) {
        my $wh = shift @ret;
        $sql .= $self->_sqlcase(' where ') . $wh if $wh;
      }

      $sql =~ s/(\S+)( IS(?: NOT)? NULL)/$self->_default_tables($1).$2/ge;

      my $joins  = delete $self->{cdbi_join_info};
      my $tables = delete $self->{cdbi_table_aliases};

      my $from = $self->{cdbi_class}->table." ${me}";

      foreach my $join (keys %{$joins}) {
        my $table = $tables->{$join}->table;

        $from .= ", ${table} ${join}";
        my ($l_alias, $l_key, $f_key) =
             @{$joins->{$join}}{qw/l_alias l_key f_key/};
        $sql .= " AND ${l_alias}.${l_key} = ${join}.${f_key}";
      }

      # order by?
      #if ($order) {
      #    $sql .= $self->_order_by($order);
      #}

      delete $self->{cdbi_column_cache};

      return wantarray ? ($sql, $from, $tables, @ret) : $sql;
  };

  my $sub_resolve_join = UNIVERSAL::can('Class::DBI::Sweet::SQL::Abstract', '_resolve_join');
  undef *Class::DBI::Sweet::SQL::Abstract::_resolve_join;
  *Class::DBI::Sweet::SQL::Abstract::_resolve_join = sub {
      return $sub_resolve_join->( @_ ) unless $ISA->{ +caller(0) };

    my $self = shift;
    my ($l_alias, $f_alias) = @_;

    my $l_class = $self->{cdbi_table_aliases}->{$l_alias};
    my $meta = $l_class->meta_info;


    ## add
    my $org_f_alias;
    if ($f_alias =~ /^(.+)__\d+$/) {
        $org_f_alias = $f_alias;
        $f_alias = $1;
    }

    my ($rel, $f_class);
    if ($rel = $meta->{has_a}{$f_alias}) {
        $f_class = $rel->foreign_class;
        $self->{cdbi_join_info}{$f_alias} = {
            l_alias => $l_alias,
            l_key => $f_alias,
            f_key => ($f_class->columns('Primary'))[0] };
    }
    elsif ($rel = $meta->{has_many}{$f_alias}) {
        $f_class = $rel->foreign_class;
        $f_alias = $org_f_alias if $org_f_alias;	## add
        $self->{cdbi_join_info}{$f_alias} = {
            l_alias => $l_alias,
            l_key => ($l_class->columns('Primary'))[0],
            f_key => $rel->args->{foreign_key} };
    }
    elsif ($rel = $meta->{might_have}{$f_alias}) {
        $f_class = $rel->foreign_class;
        $self->{cdbi_join_info}{$f_alias} = {
            l_alias => $l_alias,
            l_key => ($l_class->columns('Primary'))[0],
            f_key => ($f_class->columns('Primary'))[0] };
    }
    else {
        croak("Unable to find join info for ${f_alias} from ${l_class}");
    }

    $self->{cdbi_table_aliases}{$f_alias} = $f_class;
  };
}

1;
__END__

*1：qr/^.+__\d+$/ なエイリアスが使えないのと、has_many なテーブルの検索に qr/^.+__\d+$/なエイリアスが使えちゃうトコかな。

*2：とりあえずClass::DBI::Sweetのテストは通った。