[Dbix-class] SQL functions in WHERE clause
Oleg Pronin
syber.rus at gmail.com
Sun Apr 15 10:54:29 GMT 2007
>> birth_date =3D> { '>' =3D> [ \'CURDATE() - INTERVAL ? YEAR', 27 ]=
},
this is not the solution, this is just a workaround.
You got the error with "last_insert_rowid" because you do not load component
for database driver (in this case
DBIx::Class::Storabe::DBI::Pg i suppose )
2007/4/14, Ivan Fomichev <ifomichev at gmail.com>:
>
> 2007/4/14, Oleg Pronin <syber.rus at gmail.com>:
> > This can be solved with operator overloading. There is a very good idea
> in
> > module 'ORM' (another DB abstraction module). Please see its docs (
> > http://search.cpan.org/~akimov/ORM-0.85/lib/ORM.pod) for information.
> > Thus this module is less powerfull then DBIx-Class, there are some cool
> > things. I think this would be great to merge this ideas with DBIx-Class.
>
> Actually I have already written a patch :-) There is
> SQL::Abstract::_recurse_where sub, which does all stuff. I've added
> two syntactic constructs there.
>
> my %where =3D (
> first_name =3D> { like =3D> 'J%' },
> wedding_datetime =3D> { '<' =3D> \'NOW()' },
> );
>
> Which produces
>
> $stmt =3D "WHERE ( first_name LIKE ? AND wedding_datetime < ( NOW() ) =
)";
> @bind =3D ('J%');
>
> And
>
> $where =3D (
> birth_date =3D> { '>' =3D> [ \'CURDATE() - INTERVAL ? YEAR', 27 ] =
},
> sex =3D> 'male',
> );
>
> Which results in:
>
> $stmt =3D "WHERE ( birth_date > ( CURDATE() - INTERVAL ? YEAR )
> AND sex =3D ? )";
> @bind =3D qw/27 male/;
>
> I've made a subclass of DBIx::Class::Storage::DBI, which implements
> its own sql_maker with this sub overriden. I'm just confused how to
> make this stuff work to keep profit of automated determination of SQL
> dialect. When I make my DBIx::Class::Storage class inherit from
> DBIx::Class::Storage::DBI:BindExpressions, I get errors like:
>
> Can't locate DBI object method "last_insert_rowid" via package
> "DBD::mysql::db" at
> /usr/local/lib/perl5/site_perl/5.8.8/DBIx/Class/Storage/DBI.pm line
> 964,
> <DATA> line 1.
>
> I have a feeling this can be resolved by proper subclassing and, may
> be, load_components calls. See module code below.
>
> Also I've written a patch for SQL::Abstract and wrote a message to
> Nate Wiger, if he looks forward to include these enhancements directly
> in SQL::Abstract.
>
> Regards,
> Ivan
>
> package DBIx::Class::Storage::DBI::BindExpressions;
>
> use strict;
> use warnings;
>
> use base qw/DBIx::Class::Storage::DBI/;
>
> __PACKAGE__->mk_group_accessors('component_class' =3D> qw/sql_maker_class=
/);
>
> sub new {
> my $class =3D shift;
> my $new =3D $class->next::method(@_);
> $new->{sql_maker_class} ||=3D 'DBIC::SQL::Abstract::BindExpressions';
> return $new;
> }
>
> sub sql_maker {
> my ($self) =3D @_;
> unless ($self->_sql_maker) {
> $self->_sql_maker($self->{sql_maker_class}->new(
> limit_dialect =3D> $self->dbh,
> ) );
> }
> return $self->_sql_maker;
> }
>
> BEGIN {
>
> package DBIC::SQL::Abstract::BindExpressions;
>
> use base qw/DBIC::SQL::Abstract/;
>
> sub _recurse_where {
> local $^W =3D 0; # really, you've gotta be fucking kidding me
> my $self =3D shift;
> my $where =3D SQL::Abstract::_anoncopy(shift); # prevent destroying
> original
> my $ref =3D ref $where || '';
> my $join =3D shift || $self->{logic} ||
> ($ref eq 'ARRAY' ? $self->_sqlcase('or') :
> $self->_sqlcase('and'));
>
> # For assembling SQL fields and values
> my(@sqlf, @sqlv) =3D ();
>
> # If an arrayref, then we join each element
> if ($ref eq 'ARRAY') {
> # need to use while() so can shift() for arrays
> my $subjoin;
> while (my $el =3D shift @$where) {
>
> # skip empty elements, otherwise get invalid trailing AND stuff
> if (my $ref2 =3D ref $el) {
> if ($ref2 eq 'ARRAY') {
> next unless @$el;
> } elsif ($ref2 eq 'HASH') {
> next unless %$el;
> $subjoin ||=3D $self->_sqlcase('and');
> } elsif ($ref2 eq 'SCALAR') {
> # literal SQL
> push @sqlf, $$el;
> next;
> }
> $self->_debug("$ref2(*top) means join with $subjoin");
> } else {
> # top-level arrayref with scalars, recurse in pairs
> $self->_debug("NOREF(*top) means join with $subjoin");
> $el =3D {$el =3D> shift(@$where)};
> }
> my @ret =3D $self->_recurse_where($el, $subjoin);
> push @sqlf, shift @ret;
> push @sqlv, @ret;
> }
> }
> elsif ($ref eq 'HASH') {
> # Note: during recursion, the last element will always be a
> hashref,
> # since it needs to point a column =3D> value. So this be the end.
> for my $k (sort keys %$where) {
> my $v =3D $where->{$k};
> my $label =3D $self->_quote($k);
> if ($k =3D~ /^-(\D+)/) {
> # special nesting, like -and, -or, -nest, so shift over
> my $subjoin =3D $self->_modlogic($1);
> $self->_debug("OP(-$1) means special logic ($subjoin),
> recursing...");
> my @ret =3D $self->_recurse_where($v, $subjoin);
> push @sqlf, shift @ret;
> push @sqlv, @ret;
> } elsif (! defined($v)) {
> # undef =3D null
> $self->_debug("UNDEF($k) means IS NULL");
> push @sqlf, $label . $self->_sqlcase(' is null');
> } elsif (ref $v eq 'ARRAY') {
> my @v =3D @$v;
>
> # multiple elements: multiple options
> $self->_debug("ARRAY($k) means multiple elements: [ @v ]");
>
> # special nesting, like -and, -or, -nest, so shift over
> my $subjoin =3D $self->_sqlcase('or');
> if ($v[0] =3D~ /^-(\D+)/) {
> $subjoin =3D $self->_modlogic($1); # override subjo=
in
> $self->_debug("OP(-$1) means special logic
> ($subjoin), shifting...");
> shift @v;
> }
>
> # map into an array of hashrefs and recurse
> my @ret =3D $self->_recurse_where([map { {$k =3D> $_} }
> @v], $subjoin);
>
> # push results into our structure
> push @sqlf, shift @ret;
> push @sqlv, @ret;
> } elsif (ref $v eq 'HASH') {
> # modified operator { '!=3D', 'completed' }
> for my $f (sort keys %$v) {
> my $x =3D $v->{$f};
> $self->_debug("HASH($k) means modified operator: { $f
> }");
>
> # check for the operator being "IN" or "BETWEEN" or
> whatever
> if (ref $x eq 'ARRAY') {
> if ($f =3D~ /^-?\s*(not[\s_]+)?(in|between)\s*$/=
i)
> {
> my $u =3D $self->_modlogic($1 . $2);
> $self->_debug("HASH($f =3D> $x) uses
> special operator: [ $u ]");
> if ($u =3D~ /between/i) {
> # SQL sucks
> push @sqlf, join ' ',
> $self->_convert($label), $u, $self->_convert('?'),
>
> $self->_sqlcase('and'), $self->_convert('?');
> } else {
> push @sqlf, join ' ',
> $self->_convert($label), $u, '(',
> join(', ', map {
> $self->_convert('?') } @$x),
> ')';
> }
> push @sqlv, $self->_bindtype($k, @$x);
> } elsif (ref $x->[0] eq 'SCALAR') {
> my ($stmt, @bind) =3D @$x;
>
> # { '<' =3D> [ \'NOW() - INTERVAL ? DAY', 1 =
] }
> $self->_debug("ARRAY($x) means literal
> SQL with bind params: $$stmt : @bind");
>
> push @sqlf, join(' ',
> $self->_convert($label),
> $self->_sqlcase($f),
> '(',
> $self->_sqlcase($$stmt), ')');
> push @sqlv, @bind;
> } else {
> # multiple elements: multiple options
> $self->_debug("ARRAY($x) means multiple
> elements: [ @$x ]");
>
> # map into an array of hashrefs and recurse
> my @ret =3D $self->_recurse_where([map {
> {$k =3D> {$f, $_}} } @$x]);
>
> # push results into our structure
> push @sqlf, shift @ret;
> push @sqlv, @ret;
> }
> } elsif (ref $x eq 'SCALAR') {
> # { start_datetime =3D> { '<' =3D> \'NOW()' } }
> $self->_debug("HASH($f =3D> $x) means literal SQL:
> $$x");
> push @sqlf, join(' ', $self->_convert($label),
> $self->_sqlcase($f),
> '(', $self->_sqlcase($$x),
> ')');
> } elsif (! defined($x)) {
> # undef =3D NOT null
> my $not =3D ($f eq '!=3D' || $f eq 'not like') ? '
> not' : '';
> push @sqlf, $label . $self->_sqlcase(" is$not
> null");
> } else {
> # regular ol' value
> $f =3D~ s/^-//; # strip leading -like =3D>
> $f =3D~ s/_/ /; # _ =3D> " "
> push @sqlf, join ' ', $self->_convert($label),
> $self->_sqlcase($f), $self->_convert('?');
> push @sqlv, $self->_bindtype($k, $x);
> }
> }
> } elsif (ref $v eq 'SCALAR') {
> # literal SQL
> $self->_debug("SCALAR($k) means literal SQL: $$v");
> push @sqlf, "$label $$v";
> } else {
> # standard key =3D> val
> $self->_debug("NOREF($k) means simple key=3Dval: $k
> $self->{cmp} $v");
> push @sqlf, join ' ', $self->_convert($label),
> $self->_sqlcase($self->{cmp}), $self->_convert('?');
> push @sqlv, $self->_bindtype($k, $v);
> }
> }
> }
> elsif ($ref eq 'SCALAR') {
> # literal sql
> $self->_debug("SCALAR(*top) means literal SQL: $$where");
> push @sqlf, $$where;
> }
> elsif (defined $where) {
> # literal sql
> $self->_debug("NOREF(*top) means literal SQL: $where");
> push @sqlf, $where;
> }
>
> # assemble and return sql
> my $wsql =3D @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : '';
> return wantarray ? ($wsql, @sqlv) : $wsql;
> }
>
> }
>
> 1;
>
> _______________________________________________
> List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
> Wiki: http://dbix-class.shadowcatsystems.co.uk/
> IRC: irc.perl.org#dbix-class
> SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/
> Searchable Archive:
> http://www.mail-archive.com/dbix-class@lists.rawmode.org/
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.scsys.co.uk/pipermail/dbix-class/attachments/20070415/499=
5da93/attachment-0001.htm
More information about the Dbix-class
mailing list