=item * Support of C<...FOR UPDATE> type of select statement modifiers
+=item * The -ident operator
+
+=item * The -value operator
+
=back
=cut
__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
*{"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;
# 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) = @_;
# 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;
}
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
# 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(@_);
}
}
-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
$sql .= $self->_order_by ($arg->{order_by});
}
- if (my $for = $arg->{for}) {
- $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
- }
-
return $sql;
}