X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker.pm;h=b45fd68a49a5863274e6fe28b164d3270e260161;hb=67341081b1a57cc8549e51a8fb1b8cd4661543c5;hp=66b6c735de4f4af692ff06bac16c509a6b7ea0c5;hpb=2bb4c37b6a5f36d851c4a8ee6f5791e179491fd0;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm index 66b6c73..b45fd68 100644 --- a/lib/DBIx/Class/SQLMaker.pm +++ b/lib/DBIx/Class/SQLMaker.pm @@ -27,10 +27,6 @@ Currently the enhancements to L are: =item * Support of C<...FOR UPDATE> type of select statement modifiers -=item * The L operator - -=item * The L operator - =back =cut @@ -101,63 +97,6 @@ sub _quote { ); } -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) { - $self->throw_exception("-$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} || $self->throw_exception("Unable to find bindtype for -value $rhs") ), - $rhs - ]; - - return $lhs - ? ( - $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'), - @bind - ) - : ( - $self->_convert('?'), - @bind, - ) - ; -} - sub _where_op_NEST { carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n" .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }| @@ -194,18 +133,32 @@ sub select { ($sql, @bind) = $self->next::method ($table, $fields, $where); - my $limiter = - $self->can ('emulate_limit') # also backcompat hook from SQLA::Limit - || - do { - my $dialect = $self->limit_dialect - or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self, and no emulate_limit method found" ); - $self->can ("_$dialect") - or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'"); - } - ; - - $sql = $self->$limiter ($sql, $rs_attrs, $limit, $offset); + my $limiter; + + if( $limiter = $self->can ('emulate_limit') ) { + carp_unique( + 'Support for the legacy emulate_limit() mechanism inherited from ' + . 'SQL::Abstract::Limit has been deprecated, and will be removed when ' + . 'DBIC transitions to Data::Query. If your code uses this type of ' + . 'limit specification please file an RT and provide the source of ' + . 'your emulate_limit() implementation, so an acceptable upgrade-path ' + . 'can be devised' + ); + } + else { + my $dialect = $self->limit_dialect + or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" ); + + $limiter = $self->can ("_$dialect") + or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'"); + } + + $sql = $self->$limiter ( + $sql, + { %{$rs_attrs||{}}, _selector_sql => $fields }, + $limit, + $offset + ); } else { ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs); @@ -224,7 +177,7 @@ sub select { sub _assemble_binds { my $self = shift; - return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/select from where group having order limit/); + return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/); } my $for_syntax = { @@ -233,7 +186,15 @@ my $for_syntax = { }; sub _lock_select { my ($self, $type) = @_; - my $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" ); + + my $sql; + if (ref($type) eq 'SCALAR') { + $sql = "FOR $$type"; + } + else { + $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" ); + } + return " $sql"; } @@ -436,15 +397,18 @@ sub _gen_from_blocks { sub _from_chunk_to_sql { my ($self, $fromspec) = @_; - return join (' ', $self->_SWITCH_refkind($fromspec, { - SCALARREF => sub { + return join (' ', do { + if (! ref $fromspec) { + $self->_quote($fromspec); + } + elsif (ref $fromspec eq 'SCALAR') { $$fromspec; - }, - ARRAYREFREF => sub { + } + elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') { push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec]; $$fromspec->[0]; - }, - HASHREF => sub { + } + elsif (ref $fromspec eq 'HASH') { my ($as, $table, $toomuch) = ( map { $_ => $fromspec->{$_} } ( grep { $_ !~ /^\-/ } keys %$fromspec ) @@ -454,11 +418,11 @@ sub _from_chunk_to_sql { if defined $toomuch; ($self->_from_chunk_to_sql($table), $self->_quote($as) ); - }, - SCALAR => sub { - $self->_quote($fromspec); - }, - })); + } + else { + $self->throw_exception('Unsupported from refkind: ' . ref $fromspec ); + } + }); } sub _join_condition { @@ -496,41 +460,6 @@ sub _join_condition { 1; -=head1 OPERATORS - -=head2 -ident - -Used to explicitly specify an SQL identifier. Takes a plain string as value -which is then invariably treated as a column name (and is being properly -quoted if quoting has been requested). Most useful for comparison of two -columns: - - my %where = ( - priority => { '<', 2 }, - requestor => { -ident => 'submitter' } - ); - -which results in: - - $stmt = 'WHERE "priority" < ? AND "requestor" = "submitter"'; - @bind = ('2'); - -=head2 -value - -The -value operator signals that the argument to the right is a raw bind value. -It will be passed straight to DBI, without invoking any of the SQL::Abstract -condition-parsing logic. This allows you to, for example, pass an array as a -column value for databases that support array datatypes, e.g.: - - my %where = ( - array => { -value => [1, 2, 3] } - ); - -which results in: - - $stmt = 'WHERE array = ?'; - @bind = ([1, 2, 3]); - =head1 AUTHORS See L.