package SQL::Abstract; # see doc at end of file
+use SQL::Abstract::_TempExtlib;
+
use Carp ();
use List::Util ();
use Scalar::Util ();
use Moo;
use namespace::clean;
-our $VERSION = '1.72';
+# DO NOT INCREMENT TO 2.0 WITHOUT COORDINATING WITH mst OR ribasushi
+ our $VERSION = '1.99_01';
+# DO NOT INCREMENT TO 2.0 WITHOUT COORDINATING WITH mst OR ribasushi
-$VERSION = eval $VERSION;
+# This would confuse some packagers
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub belch (@) {
my($func) = (caller(1))[3];
Carp::croak "[$func] Fatal: ", @_;
}
+# original SQLA treated anything false as "use the default"
+# in addition a lot of CPAN seems to supply undef's for "use the default"
+# (say hi to Class::DBI::Sweet)
+sub BUILDARGS {
+ my $class = shift;
+ my $args = { ref $_[0] eq 'HASH' ? %{$_[0]} : @_ };
+
+ defined $args->{$_} or delete $args->{$_}
+ for keys %$args;
+
+ $args;
+}
+
+# many subclasses on CPAN assume they can dump a bunch of extra new()
+# parameters, and then get back at them via $obj->{foo}. YAY
+# (Class::DBI::Sweet says hi back)
+sub BUILD {
+ my ($self, $args) = @_;
+ %{$self} = (%$args, %$self);
+ $self;
+}
+
has converter => (is => 'lazy', clearer => 'clear_converter');
has case => (
after clear_renderer_class => sub { shift->clear_renderer };
sub _build_renderer_class {
+ my ($self) = @_;
+ my ($class, @roles) = (
+ $self->_build_base_renderer_class, $self->_build_renderer_roles
+ );
+ return $class unless @roles;
+ return use_module('Moo::Role')->create_class_with_roles($class, @roles);
+}
+
+sub _build_base_renderer_class {
use_module('Data::Query::Renderer::SQL::Naive')
}
+sub _build_renderer_roles { () }
+
sub _converter_args {
my ($self) = @_;
Scalar::Util::weaken($self);
+
+{
+ sqla_instance => $self,
lower_case => $self->case,
default_logic => $self->logic,
bind_meta => not($self->bindtype eq 'normal'),
renderer_will_quote => (
defined($self->quote_char) and $self->always_quote
),
+
+ legacy_convert_handler => ($self->can('_convert') != \&_convert) ? 1 : 0,
}
}
sub _assert_pass_injection_guard {
if ($_[1] =~ $_[0]->{injection_guard}) {
my $class = ref $_[0];
- die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the
- "
- . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own
-"
- . "{injection_guard} attribute to ${class}->new()"
+ die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of "
+ . "the desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply "
+ . "your own {injection_guard} attribute to ${class}->new()"
}
}
# Conversion, if applicable
sub _convert ($) {
#my ($self, $arg) = @_;
-
-# LDNOTE : modified the previous implementation below because
-# it was not consistent : the first "return" is always an array,
-# the second "return" is context-dependent. Anyway, _convert
-# seems always used with just a single argument, so make it a
-# scalar function.
-# return @_ unless $self->{convert};
-# my $conv = $self->_sqlcase($self->{convert});
-# my @ret = map { $conv.'('.$_.')' } @_;
-# return wantarray ? @ret : $ret[0];
if ($_[0]->{convert}) {
return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
}
# And bindtype
sub _bindtype (@) {
#my ($self, $col, @vals) = @_;
-
- #LDNOTE : changed original implementation below because it did not make
- # sense when bindtype eq 'columns' and @vals > 1.
-# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
-
# called often - tighten code
return $_[0]->{bindtype} eq 'columns'
? map {[$_[1], $_]} @_[2 .. $#_]
my $sql = SQL::Abstract->new;
- my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
+ my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
WHERE name like 'nwiger' AND email like 'nate@wiger.org'
-You can also override the comparsion on an individual basis - see
+You can also override the comparison on an individual basis - see
the huge section on L</"WHERE CLAUSES"> at the bottom.
=item sqltrue, sqlfalse
The argument can be either an arrayref (interpreted as a list
of field names, will be joined by commas and quoted), or a
plain scalar (literal SQL, not quoted).
-Please observe that this API is not as flexible as for
-the first argument C<$table>, for backwards compatibility reasons.
+Please observe that this API is not as flexible as that of
+the first argument C<$source>, for backwards compatibility reasons.
=item $where
)";
@bind = ('2000');
-
+Finally, if the argument to C<-in> is not a reference, it will be
+treated as a single-element array.
Another pair of operators is C<-between> and C<-not_between>,
used with an arrayref of two values:
my %where = (
-and => [
-bool => 'one',
- -bool => 'two',
- -bool => 'three',
- -not_bool => 'four',
+ -not_bool => { two=> { -rlike => 'bar' } },
+ -not_bool => { three => [ { '=', 2 }, { '>', 5 } ] },
],
);
Would give you:
- WHERE one AND two AND three AND NOT four
+ WHERE
+ one
+ AND
+ (NOT two RLIKE ?)
+ AND
+ (NOT ( three = ? OR three > ? ))
=head2 Nested conditions, -and/-or prefixes
array => [1, 2, 3]
);
-the result would porbably be not what you wanted:
+the result would probably not be what you wanted:
$stmt = 'WHERE array = ? OR array = ? OR array = ?';
@bind = (1, 2, 3);
#!/usr/bin/perl
+ use warnings;
+ use strict;
+
use CGI::FormBuilder;
use SQL::Abstract;
projects / dbsrgits/SQL-Abstract.git / blobdiff