lib/DBIx/Class/SQLMaker.pm

   1 package DBIx::Class::SQLMaker;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
   9
  10 =head1 DESCRIPTION
  11
  12 This module is a subclass of L<SQL::Abstract> and includes a number of
  13 DBIC-specific workarounds, not yet suitable for inclusion into the
  14 L<SQL::Abstract> core. It also provides all (and more than) the functionality
  15 of L<SQL::Abstract::Limit>, see L<DBIx::Class::SQLMaker::LimitDialects> for
  16 more info.
  17
  18 Currently the enhancements to L<SQL::Abstract> are:
  19
  20 =over
  21
  22 =item * Support for C<JOIN> statements (via extended C<table/from> support)
  23
  24 =item * Support of functions in C<SELECT> lists
  25
  26 =item * C<GROUP BY>/C<HAVING> support (via extensions to the order_by parameter)
  27
  28 =item * Support of C<...FOR UPDATE> type of select statement modifiers
  29
  30 =item * The L</-ident> operator
  31
  32 =item * The L</-value> operator
  33
  34 =item * Date Functions:
  35
  36 Note that for the following functions use different functions for different
  37 RDBMS'.  See the SQLMaker docs for your database to see what functions are
  38 used.
  39
  40 =over
  41
  42 =item * -dt => $date_time_obj
  43
  44 This function will convert the passed datetime to whatever format the current
  45 database prefers
  46
  47 =item * -dt_diff => [$unit, \'foo.date_from', \'foo.date_to']
  48
  49 This function will diff two dates and return the units requested. Note that
  50 it correctly recurses if you pass it something like a function or a date value.
  51 Also note that not all RDBMS' are equal; some units supported on some databases
  52 and some are supported on others.  See the documentation for the SQLMaker class
  53 for your database.
  54
  55 =item * -dt_get => [$part, \'foo.date_col']
  56
  57 This function will extract the passed part from the passed column.  Note that
  58 it correctly recurses if you pass it something like a function or a date value.
  59 Also note that not all RDBMS' are equal; some parts supported on some databases
  60 and some are supported on others.  See the documentation for the SQLMaker class
  61 for your database.
  62
  63 =item * -dt_year => \'foo.date_col'
  64
  65 A shortcut for -dt_get => [year => ...]
  66
  67 =item * -dt_month => \'foo.date_col'
  68
  69 A shortcut for -dt_get => [month => ...]
  70
  71 =item * -dt_day => \'foo.date_col'
  72
  73 A shortcut for -dt_get => [day_of_month => ...]
  74
  75 =item * -dt_hour => \'foo.date_col'
  76
  77 A shortcut for -dt_get => [hour => ...]
  78
  79 =item * -dt_minute => \'foo.date_col'
  80
  81 A shortcut for -dt_get => [minute => ...]
  82
  83 =item * -dt_second => \'foo.date_col'
  84
  85 A shortcut for -dt_get => [second => ...]
  86
  87 =back
  88
  89 =back
  90
  91 Another operator is C<-func> that allows you to call SQL functions with
  92 arguments. It receives an array reference containing the function name
  93 as the 0th argument and the other arguments being its parameters. For example:
  94
  95     my %where = {
  96       -func => ['substr', 'Hello', 50, 5],
  97     };
  98
  99 Would give you:
 100
 101    $stmt = "WHERE (substr(?,?,?))";
 102    @bind = ("Hello", 50, 5);
 103
 104 Yet another operator is C<-op> that allows you to use SQL operators. It
 105 receives an array reference containing the operator 0th argument and the other
 106 arguments being its operands. For example:
 107
 108     my %where = {
 109       foo => { -op => ['+', \'bar', 50, 5] },
 110     };
 111
 112 Would give you:
 113
 114    $stmt = "WHERE (foo = bar + ? + ?)";
 115    @bind = (50, 5);
 116
 117 =cut
 118
 119 use base qw/
 120   DBIx::Class::SQLMaker::LimitDialects
 121   DBIx::Class::SQLMaker::DateOps
 122   SQL::Abstract
 123   DBIx::Class
 124 /;
 125 use mro 'c3';
 126
 127 use Sub::Name 'subname';
 128 use DBIx::Class::Carp;
 129 use DBIx::Class::Exception;
 130 use namespace::clean;
 131
 132 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
 133
 134 # for when I need a normalized l/r pair
 135 sub _quote_chars {
 136   map
 137     { defined $_ ? $_ : '' }
 138     ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
 139   ;
 140 }
 141
 142 # FIXME when we bring in the storage weaklink, check its schema
 143 # weaklink and channel through $schema->throw_exception
 144 sub throw_exception { DBIx::Class::Exception->throw($_[1]) }
 145
 146 BEGIN {
 147   # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
 148   # that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp
 149   no warnings qw/redefine/;
 150
 151   *SQL::Abstract::belch = subname 'SQL::Abstract::belch' => sub (@) {
 152     my($func) = (caller(1))[3];
 153     carp "[$func] Warning: ", @_;
 154   };
 155
 156   *SQL::Abstract::puke = subname 'SQL::Abstract::puke' => sub (@) {
 157     my($func) = (caller(1))[3];
 158     __PACKAGE__->throw_exception("[$func] Fatal: " . join ('',  @_));
 159   };
 160
 161   # Current SQLA pollutes its namespace - clean for the time being
 162   namespace::clean->clean_subroutines(qw/SQL::Abstract carp croak confess/);
 163 }
 164
 165 # the "oh noes offset/top without limit" constant
 166 # limited to 31 bits for sanity (and consistency,
 167 # since it may be handed to the like of sprintf %u)
 168 #
 169 # Also *some* builds of SQLite fail the test
 170 #   some_column BETWEEN ? AND ?: 1, 4294967295
 171 # with the proper integer bind attrs
 172 #
 173 # Implemented as a method, since ::Storage::DBI also
 174 # refers to it (i.e. for the case of software_limit or
 175 # as the value to abuse with MSSQL ordered subqueries)
 176 sub __max_int () { 0x7FFFFFFF };
 177
 178 # poor man's de-qualifier
 179 sub _quote {
 180   $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] )
 181     ? $_[1] =~ / ([^\.]+) $ /x
 182     : $_[1]
 183   );
 184 }
 185
 186 sub new {
 187   my $self = shift->next::method(@_);
 188
 189   # use the same coderefs, they are prepared to handle both cases
 190   my @extra_dbic_syntax = (
 191     { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
 192     { regex => qr/^ value $/xi, handler => '_where_op_VALUE' },
 193     { regex => qr/^ func  $/ix, handler => '_where_op_FUNC'  },
 194     { regex => qr/^ op    $/ix, handler => '_where_op_OP'    },
 195     { regex => qr/^ dt    $/xi, handler => '_where_op_CONVERT_DATETIME' },
 196     { regex => qr/^ dt_get $/xi, handler => '_where_op_GET_DATETIME' },
 197     { regex => qr/^ dt_diff $/xi, handler => '_where_op_DIFF_DATETIME' },
 198     { regex => qr/^ dt_add  $/xi, handler => '_where_op_ADD_DATETIME' },
 199     { regex => qr/^ dt_now  $/xi, handler => '_where_op_DATETIME_NOW' },
 200     { regex => qr/^ dt_(:?on_or_)?(:?before|after)  $/xi, handler => '_where_op_CIRCA_DATETIME' },
 201     map +{ regex => qr/^ dt_$_ $/xi, handler => '_where_op_GET_DATETIME_'.uc($_) },
 202       qw(year month day hour minute second)
 203   );
 204
 205   push @{$self->{special_ops}}, @extra_dbic_syntax;
 206   push @{$self->{unary_ops}}, @extra_dbic_syntax;
 207
 208   $self;
 209 }
 210
 211 sub _where_op_IDENT {
 212   my $self = shift;
 213   my ($op, $rhs) = splice @_, -2;
 214   if (ref $rhs) {
 215     $self->throw_exception("-$op takes a single scalar argument (a quotable identifier)");
 216   }
 217
 218   # in case we are called as a top level special op (no '=')
 219   my $lhs = shift;
 220
 221   $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
 222
 223   return $lhs
 224     ? "$lhs = $rhs"
 225     : $rhs
 226   ;
 227 }
 228
 229 sub _where_op_VALUE {
 230   my $self = shift;
 231   my ($op, $rhs) = splice @_, -2;
 232
 233   # in case we are called as a top level special op (no '=')
 234   my $lhs = shift;
 235
 236   my @bind = [
 237     ($lhs || $self->{_nested_func_lhs} || $self->throw_exception("Unable to find bindtype for -value $rhs") ),
 238     $rhs
 239   ];
 240
 241   return $lhs
 242     ? (
 243       $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
 244       @bind
 245     )
 246     : (
 247       $self->_convert('?'),
 248       @bind,
 249     )
 250   ;
 251 }
 252
 253 sub _where_op_NEST {
 254   carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
 255       .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
 256   );
 257
 258   shift->next::method(@_);
 259 }
 260
 261 # Handle limit-dialect selection
 262 sub select {
 263   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
 264
 265
 266   $fields = $self->_recurse_fields($fields);
 267
 268   if (defined $offset) {
 269     $self->throw_exception('A supplied offset must be a non-negative integer')
 270       if ( $offset =~ /\D/ or $offset < 0 );
 271   }
 272   $offset ||= 0;
 273
 274   if (defined $limit) {
 275     $self->throw_exception('A supplied limit must be a positive integer')
 276       if ( $limit =~ /\D/ or $limit <= 0 );
 277   }
 278   elsif ($offset) {
 279     $limit = $self->__max_int;
 280   }
 281
 282
 283   my ($sql, @bind);
 284   if ($limit) {
 285     # this is legacy code-flow from SQLA::Limit, it is not set in stone
 286
 287     ($sql, @bind) = $self->next::method ($table, $fields, $where);
 288
 289     my $limiter =
 290       $self->can ('emulate_limit')  # also backcompat hook from SQLA::Limit
 291         ||
 292       do {
 293         my $dialect = $self->limit_dialect
 294           or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self, and no emulate_limit method found" );
 295         $self->can ("_$dialect")
 296           or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'");
 297       }
 298     ;
 299
 300     $sql = $self->$limiter (
 301       $sql,
 302       { %{$rs_attrs||{}}, _selector_sql => $fields },
 303       $limit,
 304       $offset
 305     );
 306   }
 307   else {
 308     ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);
 309   }
 310
 311   push @{$self->{where_bind}}, @bind;
 312
 313 # this *must* be called, otherwise extra binds will remain in the sql-maker
 314   my @all_bind = $self->_assemble_binds;
 315
 316   $sql .= $self->_lock_select ($rs_attrs->{for})
 317     if $rs_attrs->{for};
 318
 319   return wantarray ? ($sql, @all_bind) : $sql;
 320 }
 321
 322 sub _assemble_binds {
 323   my $self = shift;
 324   return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/select from where group having order limit/);
 325 }
 326
 327 my $for_syntax = {
 328   update => 'FOR UPDATE',
 329   shared => 'FOR SHARE',
 330 };
 331 sub _lock_select {
 332   my ($self, $type) = @_;
 333   my $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" );
 334   return " $sql";
 335 }
 336
 337 # Handle default inserts
 338 sub insert {
 339 # optimized due to hotttnesss
 340 #  my ($self, $table, $data, $options) = @_;
 341
 342   # SQLA will emit INSERT INTO $table ( ) VALUES ( )
 343   # which is sadly understood only by MySQL. Change default behavior here,
 344   # until SQLA2 comes with proper dialect support
 345   if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) {
 346     my @bind;
 347     my $sql = sprintf(
 348       'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1])
 349     );
 350
 351     if ( ($_[3]||{})->{returning} ) {
 352       my $s;
 353       ($s, @bind) = $_[0]->_insert_returning ($_[3]);
 354       $sql .= $s;
 355     }
 356
 357     return ($sql, @bind);
 358   }
 359
 360   next::method(@_);
 361 }
 362
 363 sub _recurse_fields {
 364   my ($self, $fields, $depth) = @_;
 365   $depth ||= 0;
 366   my $ref = ref $fields;
 367   return $self->_quote($fields) unless $ref;
 368   return $$fields if $ref eq 'SCALAR';
 369
 370   if ($ref eq 'ARRAY') {
 371     return join(', ', map { $self->_recurse_fields($_, $depth + 1) } @$fields)
 372       if $depth != 1;
 373
 374     my ($sql, @bind) = $self->_recurse_where({@$fields});
 375
 376     push @{$self->{select_bind}}, @bind;
 377     return $sql;
 378   }
 379   elsif ($ref eq 'HASH') {
 380     my %hash = %$fields;  # shallow copy
 381
 382     my $as = delete $hash{-as};   # if supplied
 383
 384     my ($func, $args, @toomany) = %hash;
 385
 386     # there should be only one pair
 387     if (@toomany) {
 388       $self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) );
 389     }
 390
 391     if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
 392       $self->throw_exception (
 393         'The select => { distinct => ... } syntax is not supported for multiple columns.'
 394        .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
 395        .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
 396       );
 397     }
 398
 399     my $select = sprintf ('%s( %s )%s',
 400       $self->_sqlcase($func),
 401       $self->_recurse_fields($args, $depth + 1),
 402       $as
 403         ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
 404         : ''
 405     );
 406
 407     return $select;
 408   }
 409   # Is the second check absolutely necessary?
 410   elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
 411     push @{$self->{select_bind}}, @{$$fields}[1..$#$$fields];
 412     return $$fields->[0];
 413   }
 414   else {
 415     $self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} );
 416   }
 417 }
 418
 419
 420 # this used to be a part of _order_by but is broken out for clarity.
 421 # What we have been doing forever is hijacking the $order arg of
 422 # SQLA::select to pass in arbitrary pieces of data (first the group_by,
 423 # then pretty much the entire resultset attr-hash, as more and more
 424 # things in the SQLA space need to have mopre info about the $rs they
 425 # create SQL for. The alternative would be to keep expanding the
 426 # signature of _select with more and more positional parameters, which
 427 # is just gross. All hail SQLA2!
 428 sub _parse_rs_attrs {
 429   my ($self, $arg) = @_;
 430
 431   my $sql = '';
 432
 433   if ($arg->{group_by}) {
 434     # horible horrible, waiting for refactor
 435     local $self->{select_bind};
 436     if (my $g = $self->_recurse_fields($arg->{group_by}) ) {
 437       $sql .= $self->_sqlcase(' group by ') . $g;
 438       push @{$self->{group_bind} ||= []}, @{$self->{select_bind}||[]};
 439     }
 440   }
 441
 442   if (defined $arg->{having}) {
 443     my ($frag, @bind) = $self->_recurse_where($arg->{having});
 444     push(@{$self->{having_bind}}, @bind);
 445     $sql .= $self->_sqlcase(' having ') . $frag;
 446   }
 447
 448   if (defined $arg->{order_by}) {
 449     $sql .= $self->_order_by ($arg->{order_by});
 450   }
 451
 452   return $sql;
 453 }
 454
 455 sub _order_by {
 456   my ($self, $arg) = @_;
 457
 458   # check that we are not called in legacy mode (order_by as 4th argument)
 459   if (ref $arg eq 'HASH' and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
 460     return $self->_parse_rs_attrs ($arg);
 461   }
 462   else {
 463     my ($sql, @bind) = $self->next::method($arg);
 464     push @{$self->{order_bind}}, @bind;
 465     return $sql;
 466   }
 467 }
 468
 469 sub _table {
 470 # optimized due to hotttnesss
 471 #  my ($self, $from) = @_;
 472   if (my $ref = ref $_[1] ) {
 473     if ($ref eq 'ARRAY') {
 474       return $_[0]->_recurse_from(@{$_[1]});
 475     }
 476     elsif ($ref eq 'HASH') {
 477       return $_[0]->_recurse_from($_[1]);
 478     }
 479     elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') {
 480       my ($sql, @bind) = @{ ${$_[1]} };
 481       push @{$_[0]->{from_bind}}, @bind;
 482       return $sql
 483     }
 484   }
 485   return $_[0]->next::method ($_[1]);
 486 }
 487
 488 sub _generate_join_clause {
 489     my ($self, $join_type) = @_;
 490
 491     $join_type = $self->{_default_jointype}
 492       if ! defined $join_type;
 493
 494     return sprintf ('%s JOIN ',
 495       $join_type ?  $self->_sqlcase($join_type) : ''
 496     );
 497 }
 498
 499 sub _where_op_FUNC {
 500   my ($self) = @_;
 501
 502   my ($k, $vals);
 503
 504   if (@_ == 3) {
 505      # $_[1] gets set to "op"
 506      $vals = $_[2];
 507      $k = '';
 508   } elsif (@_ == 4) {
 509      $k = $_[1];
 510      # $_[2] gets set to "op"
 511      $vals = $_[3];
 512   }
 513
 514   my $label       = $self->_convert($self->_quote($k));
 515   my $placeholder = $self->_convert('?');
 516
 517   $self->throw_exception('-func must be an array') unless ref $vals eq 'ARRAY';
 518   $self->throw_exception('first arg for -func must be a scalar') unless !ref $vals->[0];
 519
 520   my ($func,@rest_of_vals) = @$vals;
 521
 522   $self->_assert_pass_injection_guard($func);
 523
 524   my (@all_sql, @all_bind);
 525   foreach my $val (@rest_of_vals) {
 526     my ($sql, @bind) = $self->_SWITCH_refkind($val, {
 527        SCALAR => sub {
 528          return ($placeholder, $self->_bindtype($k, $val) );
 529        },
 530        SCALARREF => sub {
 531          return $$val;
 532        },
 533        ARRAYREFREF => sub {
 534          my ($sql, @bind) = @$$val;
 535          $self->_assert_bindval_matches_bindtype(@bind);
 536          return ($sql, @bind);
 537        },
 538        HASHREF => sub {
 539          my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
 540          $self->$method('', $val);
 541        }
 542     });
 543     push @all_sql, $sql;
 544     push @all_bind, @bind;
 545   }
 546
 547   my ($clause, @bind) = ("$func(" . (join ",", @all_sql) . ")", @all_bind);
 548
 549   my $sql = $k ? "( $label = $clause )" : "( $clause )";
 550   return ($sql, @bind)
 551 }
 552
 553 sub _where_op_OP {
 554   my ($self) = @_;
 555
 556   my ($k, $vals);
 557
 558   if (@_ == 3) {
 559      # $_[1] gets set to "op"
 560      $vals = $_[2];
 561      $k = '';
 562   } elsif (@_ == 4) {
 563      $k = $_[1];
 564      # $_[2] gets set to "op"
 565      $vals = $_[3];
 566   }
 567
 568   my $label       = $self->_convert($self->_quote($k));
 569   my $placeholder = $self->_convert('?');
 570
 571   $self->throw_exception('argument to -op must be an arrayref') unless ref $vals eq 'ARRAY';
 572   $self->throw_exception('first arg for -op must be a scalar') unless !ref $vals->[0];
 573
 574   my ($op, @rest_of_vals) = @$vals;
 575
 576   $self->_assert_pass_injection_guard($op);
 577
 578   my (@all_sql, @all_bind);
 579   foreach my $val (@rest_of_vals) {
 580     my ($sql, @bind) = $self->_SWITCH_refkind($val, {
 581        SCALAR => sub {
 582          return ($placeholder, $self->_bindtype($k, $val) );
 583        },
 584        SCALARREF => sub {
 585          return $$val;
 586        },
 587        ARRAYREFREF => sub {
 588          my ($sql, @bind) = @$$val;
 589          $self->_assert_bindval_matches_bindtype(@bind);
 590          return ($sql, @bind);
 591        },
 592        HASHREF => sub {
 593          my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
 594          $self->$method('', $val);
 595        }
 596     });
 597     push @all_sql, $sql;
 598     push @all_bind, @bind;
 599   }
 600
 601   my ($clause, @bind) = ((join " $op ", @all_sql), @all_bind);
 602
 603   my $sql = $k ? "( $label = $clause )" : "( $clause )";
 604   return ($sql, @bind)
 605 }
 606
 607 sub _recurse_from {
 608   my $self = shift;
 609
 610   return join (' ', $self->_gen_from_blocks(@_) );
 611 }
 612
 613 sub _gen_from_blocks {
 614   my ($self, $from, @joins) = @_;
 615
 616   my @fchunks = $self->_from_chunk_to_sql($from);
 617
 618   for (@joins) {
 619     my ($to, $on) = @$_;
 620
 621     # check whether a join type exists
 622     my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
 623     my $join_type;
 624     if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
 625       $join_type = $to_jt->{-join_type};
 626       $join_type =~ s/^\s+ | \s+$//xg;
 627     }
 628
 629     my @j = $self->_generate_join_clause( $join_type );
 630
 631     if (ref $to eq 'ARRAY') {
 632       push(@j, '(', $self->_recurse_from(@$to), ')');
 633     }
 634     else {
 635       push(@j, $self->_from_chunk_to_sql($to));
 636     }
 637
 638     my ($sql, @bind) = $self->_join_condition($on);
 639     push(@j, ' ON ', $sql);
 640     push @{$self->{from_bind}}, @bind;
 641
 642     push @fchunks, join '', @j;
 643   }
 644
 645   return @fchunks;
 646 }
 647
 648 sub _from_chunk_to_sql {
 649   my ($self, $fromspec) = @_;
 650
 651   return join (' ', $self->_SWITCH_refkind($fromspec, {
 652     SCALARREF => sub {
 653       $$fromspec;
 654     },
 655     ARRAYREFREF => sub {
 656       push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec];
 657       $$fromspec->[0];
 658     },
 659     HASHREF => sub {
 660       my ($as, $table, $toomuch) = ( map
 661         { $_ => $fromspec->{$_} }
 662         ( grep { $_ !~ /^\-/ } keys %$fromspec )
 663       );
 664
 665       $self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" )
 666         if defined $toomuch;
 667
 668       ($self->_from_chunk_to_sql($table), $self->_quote($as) );
 669     },
 670     SCALAR => sub {
 671       $self->_quote($fromspec);
 672     },
 673   }));
 674 }
 675
 676 sub _join_condition {
 677   my ($self, $cond) = @_;
 678
 679   # Backcompat for the old days when a plain hashref
 680   # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
 681   # Once things settle we should start warning here so that
 682   # folks unroll their hacks
 683   if (
 684     ref $cond eq 'HASH'
 685       and
 686     keys %$cond == 1
 687       and
 688     (keys %$cond)[0] =~ /\./
 689       and
 690     ! ref ( (values %$cond)[0] )
 691   ) {
 692     $cond = { keys %$cond => { -ident => values %$cond } }
 693   }
 694   elsif ( ref $cond eq 'ARRAY' ) {
 695     # do our own ORing so that the hashref-shim above is invoked
 696     my @parts;
 697     my @binds;
 698     foreach my $c (@$cond) {
 699       my ($sql, @bind) = $self->_join_condition($c);
 700       push @binds, @bind;
 701       push @parts, $sql;
 702     }
 703     return join(' OR ', @parts), @binds;
 704   }
 705
 706   return $self->_recurse_where($cond);
 707 }
 708
 709 1;
 710
 711 =head1 OPERATORS
 712
 713 =head2 -ident
 714
 715 Used to explicitly specify an SQL identifier. Takes a plain string as value
 716 which is then invariably treated as a column name (and is being properly
 717 quoted if quoting has been requested). Most useful for comparison of two
 718 columns:
 719
 720     my %where = (
 721         priority => { '<', 2 },
 722         requestor => { -ident => 'submitter' }
 723     );
 724
 725 which results in:
 726
 727     $stmt = 'WHERE "priority" < ? AND "requestor" = "submitter"';
 728     @bind = ('2');
 729
 730 =head2 -value
 731
 732 The -value operator signals that the argument to the right is a raw bind value.
 733 It will be passed straight to DBI, without invoking any of the SQL::Abstract
 734 condition-parsing logic. This allows you to, for example, pass an array as a
 735 column value for databases that support array datatypes, e.g.:
 736
 737     my %where = (
 738         array => { -value => [1, 2, 3] }
 739     );
 740
 741 which results in:
 742
 743     $stmt = 'WHERE array = ?';
 744     @bind = ([1, 2, 3]);
 745
 746 =head1 AUTHORS
 747
 748 See L<DBIx::Class/CONTRIBUTORS>.
 749
 750 =head1 LICENSE
 751
 752 You may distribute this code under the same terms as Perl itself.
 753
 754 =cut