X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker.pm;h=1dd46f58837863e677dd6aedbcfdd85d09c5a57b;hb=b1d821deddb9183fb96810d71a046ee8abe71d13;hp=d0fbc7790833752d8b89923e94d29678ef78aa09;hpb=d5dedbd62928f65a9071b4d9b6d56c6b663a073b;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm
index d0fbc77..1dd46f5 100644
--- a/lib/DBIx/Class/SQLMaker.pm
+++ b/lib/DBIx/Class/SQLMaker.pm
@@ -24,6 +24,10 @@ Currently the enhancements to L<SQL::Abstract> are:
 
 =item * Support of C<...FOR UPDATE> type of select statement modifiers
 
+=item * The -ident operator
+
+=item * The -value operator
+
 =back
 
 =cut
@@ -42,6 +46,14 @@ use namespace::clean;
 
 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
 
+# for when I need a normalized l/r pair
+sub _quote_chars {
+  map
+    { defined $_ ? $_ : '' }
+    ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
+  ;
+}
+
 BEGIN {
   # reinstall the carp()/croak() functions imported into SQL::Abstract
   # as Carp and Carp::Clan do not like each other much
@@ -54,7 +66,7 @@ BEGIN {
     *{"SQL::Abstract::$f"} = subname "SQL::Abstract::$f" =>
       sub {
         if (Carp::longmess() =~ /DBIx::Class::SQLMaker::[\w]+ .+? called \s at/x) {
-          $clan_import->(@_);
+          goto $clan_import;
         }
         else {
           goto $orig;
@@ -71,6 +83,80 @@ BEGIN {
 # as the value to abuse with MSSQL ordered subqueries)
 sub __max_int { 0xFFFFFFFF };
 
+sub new {
+  my $self = shift->next::method(@_);
+
+  # use the same coderefs, they are prepared to handle both cases
+  my @extra_dbic_syntax = (
+    { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
+    { regex => qr/^ value $/xi, handler => '_where_op_VALUE' },
+  );
+
+  push @{$self->{special_ops}}, @extra_dbic_syntax;
+  push @{$self->{unary_ops}}, @extra_dbic_syntax;
+
+  $self;
+}
+
+sub _where_op_IDENT {
+  my $self = shift;
+  my ($op, $rhs) = splice @_, -2;
+  if (ref $rhs) {
+    croak "-$op takes a single scalar argument (a quotable identifier)";
+  }
+
+  # in case we are called as a top level special op (no '=')
+  my $lhs = shift;
+
+  $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
+
+  return $lhs
+    ? "$lhs = $rhs"
+    : $rhs
+  ;
+}
+
+sub _where_op_VALUE {
+  my $self = shift;
+  my ($op, $rhs) = splice @_, -2;
+
+  # in case we are called as a top level special op (no '=')
+  my $lhs = shift;
+
+  my @bind = [
+    ($lhs || $self->{_nested_func_lhs} || croak "Unable to find bindtype for -value $rhs"),
+    $rhs
+  ];
+
+  return $lhs
+    ? (
+      $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
+      @bind
+    )
+    : (
+      $self->_convert('?'),
+      @bind,
+    )
+  ;
+}
+
+my $callsites_warned;
+sub _where_op_NEST {
+  # determine callsite obeying Carp::Clan rules (fucking ugly but don't have better ideas)
+  my $callsite = do {
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+    carp;
+    $w
+  };
+
+  carp ("-nest in search conditions is deprecated, you most probably wanted:\n"
+      .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
+  ) unless $callsites_warned->{$callsite}++;
+
+  shift->next::method(@_);
+}
+
 # Handle limit-dialect selection
 sub select {
   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
@@ -121,6 +207,9 @@ sub select {
 # this *must* be called, otherwise extra binds will remain in the sql-maker
   my @all_bind = $self->_assemble_binds;
 
+  $sql .= $self->_lock_select ($rs_attrs->{for})
+    if $rs_attrs->{for};
+
   return wantarray ? ($sql, @all_bind) : $sql;
 }
 
@@ -129,6 +218,16 @@ sub _assemble_binds {
   return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/from where having order/);
 }
 
+my $for_syntax = {
+  update => 'FOR UPDATE',
+  shared => 'FOR SHARE',
+};
+sub _lock_select {
+  my ($self, $type) = @_;
+  my $sql = $for_syntax->{$type} || croak "Unknown SELECT .. FOR type '$type' requested";
+  return " $sql";
+}
+
 # Handle default inserts
 sub insert {
 # optimized due to hotttnesss
@@ -138,13 +237,18 @@ sub insert {
   # which is sadly understood only by MySQL. Change default behavior here,
   # until SQLA2 comes with proper dialect support
   if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) {
-    my $sql = "INSERT INTO $_[1] DEFAULT VALUES";
+    my @bind;
+    my $sql = sprintf(
+      'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1])
+    );
 
-    if (my $ret = ($_[3]||{})->{returning} ) {
-      $sql .= $_[0]->_insert_returning ($ret);
+    if ( ($_[3]||{})->{returning} ) {
+      my $s;
+      ($s, @bind) = $_[0]->_insert_returning ($_[3]);
+      $sql .= $s;
     }
 
-    return $sql;
+    return ($sql, @bind);
   }
 
   next::method(@_);
@@ -198,10 +302,6 @@ sub _recurse_fields {
   }
 }
 
-my $for_syntax = {
-  update => 'FOR UPDATE',
-  shared => 'FOR SHARE',
-};
 
 # this used to be a part of _order_by but is broken out for clarity.
 # What we have been doing forever is hijacking the $order arg of
@@ -230,10 +330,6 @@ sub _parse_rs_attrs {
     $sql .= $self->_order_by ($arg->{order_by});
   }
 
-  if (my $for = $arg->{for}) {
-    $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
-  }
-
   return $sql;
 }