From: Ash Berlin Date: Wed, 7 Feb 2007 15:07:15 +0000 (+0000) Subject: initial "import" X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=32eab2da957ea33622610a8abc271c7855147904;p=scpubgit%2FQ-Branch.git initial "import" r2279@metis (orig r1): nwiger | 2006-09-28 04:06:33 +0100 --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm new file mode 100644 index 0000000..9cdae1a --- /dev/null +++ b/lib/SQL/Abstract.pm @@ -0,0 +1,1258 @@ + +package SQL::Abstract; + +=head1 NAME + +SQL::Abstract - Generate SQL from Perl data structures + +=head1 SYNOPSIS + + use SQL::Abstract; + + my $sql = SQL::Abstract->new; + + my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order); + + my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values); + + my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where); + + my($stmt, @bind) = $sql->delete($table, \%where); + + # Then, use these in your DBI statements + my $sth = $dbh->prepare($stmt); + $sth->execute(@bind); + + # Just generate the WHERE clause + my($stmt, @bind) = $sql->where(\%where, \@order); + + # Return values in the same order, for hashed queries + # See PERFORMANCE section for more details + my @bind = $sql->values(\%fieldvals); + +=head1 DESCRIPTION + +This module was inspired by the excellent L. +However, in using that module I found that what I really wanted +to do was generate SQL, but still retain complete control over my +statement handles and use the DBI interface. So, I set out to +create an abstract SQL generation module. + +While based on the concepts used by L, there are +several important differences, especially when it comes to WHERE +clauses. I have modified the concepts used to make the SQL easier +to generate from Perl data structures and, IMO, more intuitive. +The underlying idea is for this module to do what you mean, based +on the data structures you provide it. The big advantage is that +you don't have to modify your code every time your data changes, +as this module figures it out. + +To begin with, an SQL INSERT is as easy as just specifying a hash +of C pairs: + + my %data = ( + name => 'Jimbo Bobson', + phone => '123-456-7890', + address => '42 Sister Lane', + city => 'St. Louis', + state => 'Louisiana', + ); + +The SQL can then be generated with this: + + my($stmt, @bind) = $sql->insert('people', \%data); + +Which would give you something like this: + + $stmt = "INSERT INTO people + (address, city, name, phone, state) + VALUES (?, ?, ?, ?, ?)"; + @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson', + '123-456-7890', 'Louisiana'); + +These are then used directly in your DBI code: + + my $sth = $dbh->prepare($stmt); + $sth->execute(@bind); + +In addition, you can apply SQL functions to elements of your C<%data> +by specifying an arrayref for the given hash value. For example, if +you need to execute the Oracle C function on a value, you +can say something like this: + + my %data = ( + name => 'Bill', + date_entered => ["to_date(?,'MM/DD/YYYY')", "03/02/2003"], + ); + +The first value in the array is the actual SQL. Any other values are +optional and would be included in the bind values array. This gives +you: + + my($stmt, @bind) = $sql->insert('people', \%data); + + $stmt = "INSERT INTO people (name, date_entered) + VALUES (?, to_date(?,'MM/DD/YYYY'))"; + @bind = ('Bill', '03/02/2003'); + +An UPDATE is just as easy, all you change is the name of the function: + + my($stmt, @bind) = $sql->update('people', \%data); + +Notice that your C<%data> isn't touched; the module will generate +the appropriately quirky SQL for you automatically. Usually you'll +want to specify a WHERE clause for your UPDATE, though, which is +where handling C<%where> hashes comes in handy... + +This module can generate pretty complicated WHERE statements +easily. For example, simple C pairs are taken to mean +equality, and if you want to see if a field is within a set +of values, you can use an arrayref. Let's say we wanted to +SELECT some data based on this criteria: + + my %where = ( + requestor => 'inna', + worker => ['nwiger', 'rcwe', 'sfz'], + status => { '!=', 'completed' } + ); + + my($stmt, @bind) = $sql->select('tickets', '*', \%where); + +The above would give you something like this: + + $stmt = "SELECT * FROM tickets WHERE + ( requestor = ? ) AND ( status != ? ) + AND ( worker = ? OR worker = ? OR worker = ? )"; + @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz'); + +Which you could then use in DBI code like so: + + my $sth = $dbh->prepare($stmt); + $sth->execute(@bind); + +Easy, eh? + +=head1 FUNCTIONS + +The functions are simple. There's one for each major SQL operation, +and a constructor you use first. The arguments are specified in a +similar order to each function (table, then fields, then a where +clause) to try and simplify things. + +=cut + +use Carp; +use strict; + +our $VERSION = do { my @r=(q$Revision: 1.21 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; +our $AUTOLOAD; + +# Fix SQL case, if so requested +sub _sqlcase { + my $self = shift; + return $self->{case} ? $_[0] : uc($_[0]); +} + +# Anon copies of arrays/hashes +# Based on deep_copy example by merlyn +# http://www.stonehenge.com/merlyn/UnixReview/col30.html +sub _anoncopy { + my $orig = shift; + return (ref $orig eq 'HASH') ? +{map { $_ => _anoncopy($orig->{$_}) } keys %$orig} + : (ref $orig eq 'ARRAY') ? [map _anoncopy($_), @$orig] + : $orig; +} + +# Debug +sub _debug { + return unless $_[0]->{debug}; shift; # a little faster + my $func = (caller(1))[3]; + warn "[$func] ", @_, "\n"; +} + +sub belch (@) { + my($func) = (caller(1))[3]; + carp "[$func] Warning: ", @_; +} + +sub puke (@) { + my($func) = (caller(1))[3]; + croak "[$func] Fatal: ", @_; +} + +# Utility functions +sub _table { + my $self = shift; + my $tab = shift; + if (ref $tab eq 'ARRAY') { + return join ', ', map { $self->_quote($_) } @$tab; + } else { + return $self->_quote($tab); + } +} + +sub _quote { + my $self = shift; + my $label = shift; + + return $label + if $label eq '*'; + + return $self->{quote_char} . $label . $self->{quote_char} + if !defined $self->{name_sep}; + + return join $self->{name_sep}, + map { $self->{quote_char} . $_ . $self->{quote_char} } + split /\Q$self->{name_sep}\E/, $label; +} + +# Conversion, if applicable +sub _convert ($) { + my $self = shift; + return @_ unless $self->{convert}; + my $conv = $self->_sqlcase($self->{convert}); + my @ret = map { $conv.'('.$_.')' } @_; + return wantarray ? @ret : $ret[0]; +} + +# And bindtype +sub _bindtype (@) { + my $self = shift; + my($col,@val) = @_; + return $self->{bindtype} eq 'columns' ? [ @_ ] : @val; +} + +# Modified -logic or -nest +sub _modlogic ($) { + my $self = shift; + my $sym = @_ ? lc(shift) : $self->{logic}; + $sym =~ tr/_/ /; + $sym = $self->{logic} if $sym eq 'nest'; + return $self->_sqlcase($sym); # override join +} + +=head2 new(option => 'value') + +The C function takes a list of options and values, and returns +a new B object which can then be used to generate SQL +through the methods below. The options accepted are: + +=over + +=item case + +If set to 'lower', then SQL will be generated in all lowercase. By +default SQL is generated in "textbook" case meaning something like: + + SELECT a_field FROM a_table WHERE some_field LIKE '%someval%' + +=item cmp + +This determines what the default comparison operator is. By default +it is C<=>, meaning that a hash like this: + + %where = (name => 'nwiger', email => 'nate@wiger.org'); + +Will generate SQL like this: + + WHERE name = 'nwiger' AND email = 'nate@wiger.org' + +However, you may want loose comparisons by default, so if you set +C to C you would get SQL such as: + + WHERE name like 'nwiger' AND email like 'nate@wiger.org' + +You can also override the comparsion on an individual basis - see +the huge section on L at the bottom. + +=item logic + +This determines the default logical operator for multiple WHERE +statements in arrays. By default it is "or", meaning that a WHERE +array of the form: + + @where = ( + event_date => {'>=', '2/13/99'}, + event_date => {'<=', '4/24/03'}, + ); + +Will generate SQL like this: + + WHERE event_date >= '2/13/99' OR event_date <= '4/24/03' + +This is probably not what you want given this query, though (look +at the dates). To change the "OR" to an "AND", simply specify: + + my $sql = SQL::Abstract->new(logic => 'and'); + +Which will change the above C to: + + WHERE event_date >= '2/13/99' AND event_date <= '4/24/03' + +=item convert + +This will automatically convert comparisons using the specified SQL +function for both column and value. This is mostly used with an argument +of C or C, so that the SQL will have the effect of +case-insensitive "searches". For example, this: + + $sql = SQL::Abstract->new(convert => 'upper'); + %where = (keywords => 'MaKe iT CAse inSeNSItive'); + +Will turn out the following SQL: + + WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive') + +The conversion can be C, C, or any other SQL function +that can be applied symmetrically to fields (actually B does +not validate this option; it will just pass through what you specify verbatim). + +=item bindtype + +This is a kludge because many databases suck. For example, you can't +just bind values using DBI's C for Oracle C or C fields. +Instead, you have to use C: + + $sth->bind_param(1, 'reg data'); + $sth->bind_param(2, $lots, {ora_type => ORA_CLOB}); + +The problem is, B will normally just return a C<@bind> array, +which loses track of which field each slot refers to. Fear not. + +If you specify C in new, you can determine how C<@bind> is returned. +Currently, you can specify either C (default) or C. If you +specify C, you will get an array that looks like this: + + my $sql = SQL::Abstract->new(bindtype => 'columns'); + my($stmt, @bind) = $sql->insert(...); + + @bind = ( + [ 'column1', 'value1' ], + [ 'column2', 'value2' ], + [ 'column3', 'value3' ], + ); + +You can then iterate through this manually, using DBI's C. + + $sth->prepare($stmt); + my $i = 1; + for (@bind) { + my($col, $data) = @$_; + if ($col eq 'details' || $col eq 'comments') { + $sth->bind_param($i, $data, {ora_type => ORA_CLOB}); + } elsif ($col eq 'image') { + $sth->bind_param($i, $data, {ora_type => ORA_BLOB}); + } else { + $sth->bind_param($i, $data); + } + $i++; + } + $sth->execute; # execute without @bind now + +Now, why would you still use B if you have to do this crap? +Basically, the advantage is still that you don't have to care which fields +are or are not included. You could wrap that above C loop in a simple +sub called C or something and reuse it repeatedly. You still +get a layer of abstraction over manual SQL specification. + +=item quote_char + +This is the character that a table or column name will be quoted +with. By default this is an empty string, but you could set it to +the character C<`>, to generate SQL like this: + + SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%' + +This is useful if you have tables or columns that are reserved words +in your database's SQL dialect. + +=item name_sep + +This is the character that separates a table and column name. It is +necessary to specify this when the C option is selected, +so that tables and column names can be individually quoted like this: + + SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1 + +=back + +=cut + +sub new { + my $self = shift; + my $class = ref($self) || $self; + my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_; + + # choose our case by keeping an option around + delete $opt{case} if $opt{case} && $opt{case} ne 'lower'; + + # override logical operator + $opt{logic} = uc $opt{logic} if $opt{logic}; + + # how to return bind vars + $opt{bindtype} ||= delete($opt{bind_type}) || 'normal'; + + # default comparison is "=", but can be overridden + $opt{cmp} ||= '='; + + # default quotation character around tables/columns + $opt{quote_char} ||= ''; + + return bless \%opt, $class; +} + +=head2 insert($table, \@values || \%fieldvals) + +This is the simplest function. You simply give it a table name +and either an arrayref of values or hashref of field/value pairs. +It returns an SQL INSERT statement and a list of bind values. + +=cut + +sub insert { + my $self = shift; + my $table = $self->_table(shift); + my $data = shift || return; + + my $sql = $self->_sqlcase('insert into') . " $table "; + my(@sqlf, @sqlv, @sqlq) = (); + + my $ref = ref $data; + if ($ref eq 'HASH') { + for my $k (sort keys %$data) { + my $v = $data->{$k}; + my $r = ref $v; + # named fields, so must save names in order + push @sqlf, $self->_quote($k); + if ($r eq 'ARRAY') { + # SQL included for values + my @val = @$v; + push @sqlq, shift @val; + push @sqlv, $self->_bindtype($k, @val); + } elsif ($r eq 'SCALAR') { + # embedded literal SQL + push @sqlq, $$v; + } else { + push @sqlq, '?'; + push @sqlv, $self->_bindtype($k, $v); + } + } + $sql .= '(' . join(', ', @sqlf) .') '. $self->_sqlcase('values') . ' ('. join(', ', @sqlq) .')'; + } elsif ($ref eq 'ARRAY') { + # just generate values(?,?) part + # no names (arrayref) so can't generate bindtype + carp "Warning: ",__PACKAGE__,"->insert called with arrayref when bindtype set" + if $self->{bindtype} ne 'normal'; + for my $v (@$data) { + my $r = ref $v; + if ($r eq 'ARRAY') { + my @val = @$v; + push @sqlq, shift @val; + push @sqlv, @val; + } elsif ($r eq 'SCALAR') { + # embedded literal SQL + push @sqlq, $$v; + } else { + push @sqlq, '?'; + push @sqlv, $v; + } + } + $sql .= $self->_sqlcase('values') . ' ('. join(', ', @sqlq) .')'; + } elsif ($ref eq 'SCALAR') { + # literal SQL + $sql .= $$data; + } else { + puke "Unsupported data type specified to \$sql->insert"; + } + + return wantarray ? ($sql, @sqlv) : $sql; +} + +=head2 update($table, \%fieldvals, \%where) + +This takes a table, hashref of field/value pairs, and an optional +hashref WHERE clause. It returns an SQL UPDATE function and a list +of bind values. + +=cut + +sub update { + my $self = shift; + my $table = $self->_table(shift); + my $data = shift || return; + my $where = shift; + + my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set '); + my(@sqlf, @sqlv) = (); + + puke "Unsupported data type specified to \$sql->update" + unless ref $data eq 'HASH'; + + for my $k (sort keys %$data) { + my $v = $data->{$k}; + my $r = ref $v; + my $label = $self->_quote($k); + if ($r eq 'ARRAY') { + # SQL included for values + my @bind = @$v; + my $sql = shift @bind; + push @sqlf, "$label = $sql"; + push @sqlv, $self->_bindtype($k, @bind); + } elsif ($r eq 'SCALAR') { + # embedded literal SQL + push @sqlf, "$label = $$v"; + } else { + push @sqlf, "$label = ?"; + push @sqlv, $self->_bindtype($k, $v); + } + } + + $sql .= join ', ', @sqlf; + + if ($where) { + my($wsql, @wval) = $self->where($where); + $sql .= $wsql; + push @sqlv, @wval; + } + + return wantarray ? ($sql, @sqlv) : $sql; +} + +=head2 select($table, \@fields, \%where, \@order) + +This takes a table, arrayref of fields (or '*'), optional hashref +WHERE clause, and optional arrayref order by, and returns the +corresponding SQL SELECT statement and list of bind values. + +=cut + +sub select { + my $self = shift; + my $table = $self->_table(shift); + my $fields = shift || '*'; + my $where = shift; + my $order = shift; + + my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields : $fields; + my $sql = join ' ', $self->_sqlcase('select'), $f, $self->_sqlcase('from'), $table; + + my(@sqlf, @sqlv) = (); + my($wsql, @wval) = $self->where($where, $order); + $sql .= $wsql; + push @sqlv, @wval; + + return wantarray ? ($sql, @sqlv) : $sql; +} + +=head2 delete($table, \%where) + +This takes a table name and optional hashref WHERE clause. +It returns an SQL DELETE statement and list of bind values. + +=cut + +sub delete { + my $self = shift; + my $table = $self->_table(shift); + my $where = shift; + + my $sql = $self->_sqlcase('delete from') . " $table"; + my(@sqlf, @sqlv) = (); + + if ($where) { + my($wsql, @wval) = $self->where($where); + $sql .= $wsql; + push @sqlv, @wval; + } + + return wantarray ? ($sql, @sqlv) : $sql; +} + +=head2 where(\%where, \@order) + +This is used to generate just the WHERE clause. For example, +if you have an arbitrary data structure and know what the +rest of your SQL is going to look like, but want an easy way +to produce a WHERE clause, use this. It returns an SQL WHERE +clause and list of bind values. + +=cut + +# Finally, a separate routine just to handle WHERE clauses +sub where { + my $self = shift; + my $where = shift; + my $order = shift; + + # Need a separate routine to properly wrap w/ "where" + my $sql = ''; + my @ret = $self->_recurse_where($where); + if (@ret) { + my $wh = shift @ret; + $sql .= $self->_sqlcase(' where ') . $wh if $wh; + } + + # order by? + if ($order) { + $sql .= $self->_order_by($order); + } + + return wantarray ? ($sql, @ret) : $sql; +} + + +sub _recurse_where { + local $^W = 0; # really, you've gotta be fucking kidding me + my $self = shift; + my $where = _anoncopy(shift); # prevent destroying original + my $ref = ref $where || ''; + my $join = shift || $self->{logic} || + ($ref eq 'ARRAY' ? $self->_sqlcase('or') : $self->_sqlcase('and')); + + # For assembling SQL fields and values + my(@sqlf, @sqlv) = (); + + # 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 = shift @$where) { + + # skip empty elements, otherwise get invalid trailing AND stuff + if (my $ref2 = ref $el) { + if ($ref2 eq 'ARRAY') { + next unless @$el; + } elsif ($ref2 eq 'HASH') { + next unless %$el; + $subjoin ||= $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 = {$el => shift(@$where)}; + } + my @ret = $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 => value. So this be the end. + for my $k (sort keys %$where) { + my $v = $where->{$k}; + my $label = $self->_quote($k); + if ($k =~ /^-(\D+)/) { + # special nesting, like -and, -or, -nest, so shift over + my $subjoin = $self->_modlogic($1); + $self->_debug("OP(-$1) means special logic ($subjoin), recursing..."); + my @ret = $self->_recurse_where($v, $subjoin); + push @sqlf, shift @ret; + push @sqlv, @ret; + } elsif (! defined($v)) { + # undef = null + $self->_debug("UNDEF($k) means IS NULL"); + push @sqlf, $label . $self->_sqlcase(' is null'); + } elsif (ref $v eq 'ARRAY') { + my @v = @$v; + + # multiple elements: multiple options + $self->_debug("ARRAY($k) means multiple elements: [ @v ]"); + + # special nesting, like -and, -or, -nest, so shift over + my $subjoin = $self->_sqlcase('or'); + if ($v[0] =~ /^-(\D+)/) { + $subjoin = $self->_modlogic($1); # override subjoin + $self->_debug("OP(-$1) means special logic ($subjoin), shifting..."); + shift @v; + } + + # map into an array of hashrefs and recurse + my @ret = $self->_recurse_where([map { {$k => $_} } @v], $subjoin); + + # push results into our structure + push @sqlf, shift @ret; + push @sqlv, @ret; + } elsif (ref $v eq 'HASH') { + # modified operator { '!=', 'completed' } + for my $f (sort keys %$v) { + my $x = $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 =~ /^-?\s*(not[\s_]+)?(in|between)\s*$/i) { + my $u = $self->_modlogic($1 . $2); + $self->_debug("HASH($f => $x) uses special operator: [ $u ]"); + if ($u =~ /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); + } else { + # multiple elements: multiple options + $self->_debug("ARRAY($x) means multiple elements: [ @$x ]"); + + # map into an array of hashrefs and recurse + my @ret = $self->_recurse_where([map { {$k => {$f, $_}} } @$x]); + + # push results into our structure + push @sqlf, shift @ret; + push @sqlv, @ret; + } + } elsif (! defined($x)) { + # undef = NOT null + my $not = ($f eq '!=' || $f eq 'not like') ? ' not' : ''; + push @sqlf, $label . $self->_sqlcase(" is$not null"); + } else { + # regular ol' value + $f =~ s/^-//; # strip leading -like => + $f =~ s/_/ /; # _ => " " + 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 => val + $self->_debug("NOREF($k) means simple key=val: $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 = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : ''; + return wantarray ? ($wsql, @sqlv) : $wsql; +} + +sub _order_by { + my $self = shift; + my $ref = ref $_[0]; + + my @vals = $ref eq 'ARRAY' ? @{$_[0]} : + $ref eq 'SCALAR' ? ${$_[0]} : + $ref eq '' ? $_[0] : + puke "Unsupported data struct $ref for ORDER BY"; + + my $val = join ', ', map { $self->_quote($_) } @vals; + return $val ? $self->_sqlcase(' order by')." $val" : ''; +} + +=head2 values(\%data) + +This just returns the values from the hash C<%data>, in the same +order that would be returned from any of the other above queries. +Using this allows you to markedly speed up your queries if you +are affecting lots of rows. See below under the L section. + +=cut + +sub values { + my $self = shift; + my $data = shift || return; + puke "Argument to ", __PACKAGE__, "->values must be a \\%hash" + unless ref $data eq 'HASH'; + return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data; +} + +=head2 generate($any, 'number', $of, \@data, $struct, \%types) + +Warning: This is an experimental method and subject to change. + +This returns arbitrarily generated SQL. It's a really basic shortcut. +It will return two different things, depending on return context: + + my($stmt, @bind) = $sql->generate('create table', \$table, \@fields); + my $stmt_and_val = $sql->generate('create table', \$table, \@fields); + +These would return the following: + + # First calling form + $stmt = "CREATE TABLE test (?, ?)"; + @bind = (field1, field2); + + # Second calling form + $stmt_and_val = "CREATE TABLE test (field1, field2)"; + +Depending on what you're trying to do, it's up to you to choose the correct +format. In this example, the second form is what you would want. + +By the same token: + + $sql->generate('alter session', { nls_date_format => 'MM/YY' }); + +Might give you: + + ALTER SESSION SET nls_date_format = 'MM/YY' + +You get the idea. Strings get their case twiddled, but everything +else remains verbatim. + +=cut + +sub generate { + my $self = shift; + + my(@sql, @sqlq, @sqlv); + + for (@_) { + my $ref = ref $_; + if ($ref eq 'HASH') { + for my $k (sort keys %$_) { + my $v = $_->{$k}; + my $r = ref $v; + my $label = $self->_quote($k); + if ($r eq 'ARRAY') { + # SQL included for values + my @bind = @$v; + my $sql = shift @bind; + push @sqlq, "$label = $sql"; + push @sqlv, $self->_bindtype($k, @bind); + } elsif ($r eq 'SCALAR') { + # embedded literal SQL + push @sqlq, "$label = $$v"; + } else { + push @sqlq, "$label = ?"; + push @sqlv, $self->_bindtype($k, $v); + } + } + push @sql, $self->_sqlcase('set'), join ', ', @sqlq; + } elsif ($ref eq 'ARRAY') { + # unlike insert(), assume these are ONLY the column names, i.e. for SQL + for my $v (@$_) { + my $r = ref $v; + if ($r eq 'ARRAY') { + my @val = @$v; + push @sqlq, shift @val; + push @sqlv, @val; + } elsif ($r eq 'SCALAR') { + # embedded literal SQL + push @sqlq, $$v; + } else { + push @sqlq, '?'; + push @sqlv, $v; + } + } + push @sql, '(' . join(', ', @sqlq) . ')'; + } elsif ($ref eq 'SCALAR') { + # literal SQL + push @sql, $$_; + } else { + # strings get case twiddled + push @sql, $self->_sqlcase($_); + } + } + + my $sql = join ' ', @sql; + + # this is pretty tricky + # if ask for an array, return ($stmt, @bind) + # otherwise, s/?/shift @sqlv/ to put it inline + if (wantarray) { + return ($sql, @sqlv); + } else { + 1 while $sql =~ s/\?/my $d = shift(@sqlv); + ref $d ? $d->[1] : $d/e; + return $sql; + } +} + +sub DESTROY { 1 } +sub AUTOLOAD { + # This allows us to check for a local, then _form, attr + my $self = shift; + my($name) = $AUTOLOAD =~ /.*::(.+)/; + return $self->generate($name, @_); +} + +1; + +__END__ + +=head1 WHERE CLAUSES + +This module uses a variation on the idea from L. It +is B, repeat I 100% compatible. B + +The easiest way to explain is to show lots of examples. After +each C<%where> hash shown, it is assumed you used: + + my($stmt, @bind) = $sql->where(\%where); + +However, note that the C<%where> hash can be used directly in any +of the other functions as well, as described above. + +So, let's get started. To begin, a simple hash: + + my %where = ( + user => 'nwiger', + status => 'completed' + ); + +Is converted to SQL C statements: + + $stmt = "WHERE user = ? AND status = ?"; + @bind = ('nwiger', 'completed'); + +One common thing I end up doing is having a list of values that +a field can be in. To do this, simply specify a list inside of +an arrayref: + + my %where = ( + user => 'nwiger', + status => ['assigned', 'in-progress', 'pending']; + ); + +This simple code will create the following: + + $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )"; + @bind = ('nwiger', 'assigned', 'in-progress', 'pending'); + +If you want to specify a different type of operator for your comparison, +you can use a hashref for a given column: + + my %where = ( + user => 'nwiger', + status => { '!=', 'completed' } + ); + +Which would generate: + + $stmt = "WHERE user = ? AND status != ?"; + @bind = ('nwiger', 'completed'); + +To test against multiple values, just enclose the values in an arrayref: + + status => { '!=', ['assigned', 'in-progress', 'pending'] }; + +Which would give you: + + "WHERE status != ? OR status != ? OR status != ?" + +But, this is probably not what you want in this case (look at it). So +the hashref can also contain multiple pairs, in which case it is expanded +into an C of its elements: + + my %where = ( + user => 'nwiger', + status => { '!=', 'completed', -not_like => 'pending%' } + ); + + # Or more dynamically, like from a form + $where{user} = 'nwiger'; + $where{status}{'!='} = 'completed'; + $where{status}{'-not_like'} = 'pending%'; + + # Both generate this + $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?"; + @bind = ('nwiger', 'completed', 'pending%'); + +To get an OR instead, you can combine it with the arrayref idea: + + my %where => ( + user => 'nwiger', + priority => [ {'=', 2}, {'!=', 1} ] + ); + +Which would generate: + + $stmt = "WHERE user = ? AND priority = ? OR priority != ?"; + @bind = ('nwiger', '2', '1'); + +However, there is a subtle trap if you want to say something like +this (notice the C): + + WHERE priority != ? AND priority != ? + +Because, in Perl you I do this: + + priority => { '!=', 2, '!=', 1 } + +As the second C key will obliterate the first. The solution +is to use the special C<-modifier> form inside an arrayref: + + priority => [ -and => {'!=', 2}, {'!=', 1} ] + +Normally, these would be joined by C, but the modifier tells it +to use C instead. (Hint: You can use this in conjunction with the +C option to C in order to change the way your queries +work by default.) B Note that the C<-modifier> goes +B the arrayref, as an extra first element. This will +B do what you think it might: + + priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG! + +Here is a quick list of equivalencies, since there is some overlap: + + # Same + status => {'!=', 'completed', 'not like', 'pending%' } + status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}] + + # Same + status => {'=', ['assigned', 'in-progress']} + status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}] + status => [ {'=', 'assigned'}, {'=', 'in-progress'} ] + +In addition to C<-and> and C<-or>, there is also a special C<-nest> +operator which adds an additional set of parens, to create a subquery. +For example, to get something like this: + + $stmt = WHERE user = ? AND ( workhrs > ? OR geo = ? ) + @bind = ('nwiger', '20', 'ASIA'); + +You would do: + + my %where = ( + user => 'nwiger', + -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ], + ); + +You can also use the hashref format to compare a list of fields using the +C comparison operator, by specifying the list as an arrayref: + + my %where = ( + status => 'completed', + reportid => { -in => [567, 2335, 2] } + ); + +Which would generate: + + $stmt = "WHERE status = ? AND reportid IN (?,?,?)"; + @bind = ('completed', '567', '2335', '2'); + +You can use this same format to use other grouping functions, such +as C, C, and so forth. For example: + + my %where = ( + user => 'nwiger', + completion_date => { + -not_between => ['2002-10-01', '2003-02-06'] + } + ); + +Would give you: + + WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? ) + +So far, we've seen how multiple conditions are joined with a top-level +C. We can change this by putting the different conditions we want in +hashes and then putting those hashes in an array. For example: + + my @where = ( + { + user => 'nwiger', + status => { -like => ['pending%', 'dispatched'] }, + }, + { + user => 'robot', + status => 'unassigned', + } + ); + +This data structure would create the following: + + $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) ) + OR ( user = ? AND status = ? ) )"; + @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned'); + +This can be combined with the C<-nest> operator to properly group +SQL statements: + + my @where = ( + -and => [ + user => 'nwiger', + -nest => [ + -and => [workhrs => {'>', 20}, geo => 'ASIA' ], + -and => [workhrs => {'<', 50}, geo => 'EURO' ] + ], + ], + ); + +That would yield: + + WHERE ( user = ? AND + ( ( workhrs > ? AND geo = ? ) + OR ( workhrs < ? AND geo = ? ) ) ) + +Finally, sometimes only literal SQL will do. If you want to include +literal SQL verbatim, you can specify it as a scalar reference, namely: + + my $inn = 'is Not Null'; + my %where = ( + priority => { '<', 2 }, + requestor => \$inn + ); + +This would create: + + $stmt = "WHERE priority < ? AND requestor is Not Null"; + @bind = ('2'); + +Note that in this example, you only get one bind parameter back, since +the verbatim SQL is passed as part of the statement. + +Of course, just to prove a point, the above can also be accomplished +with this: + + my %where = ( + priority => { '<', 2 }, + requestor => { '!=', undef }, + ); + +TMTOWTDI. + +These pages could go on for a while, since the nesting of the data +structures this module can handle are pretty much unlimited (the +module implements the C expansion as a recursive function +internally). Your best bet is to "play around" with the module a +little to see how the data structures behave, and choose the best +format for your data based on that. + +And of course, all the values above will probably be replaced with +variables gotten from forms or the command line. After all, if you +knew everything ahead of time, you wouldn't have to worry about +dynamically-generating SQL and could just hardwire it into your +script. + +=head1 PERFORMANCE + +Thanks to some benchmarking by Mark Stosberg, it turns out that +this module is many orders of magnitude faster than using C. +I must admit this wasn't an intentional design issue, but it's a +byproduct of the fact that you get to control your C handles +yourself. + +To maximize performance, use a code snippet like the following: + + # prepare a statement handle using the first row + # and then reuse it for the rest of the rows + my($sth, $stmt); + for my $href (@array_of_hashrefs) { + $stmt ||= $sql->insert('table', $href); + $sth ||= $dbh->prepare($stmt); + $sth->execute($sql->values($href)); + } + +The reason this works is because the keys in your C<$href> are sorted +internally by B. Thus, as long as your data retains +the same structure, you only have to generate the SQL the first time +around. On subsequent queries, simply use the C function provided +by this module to return your values in the correct order. + +=head1 FORMBUILDER + +If you use my C module at all, you'll hopefully +really like this part (I do, at least). Building up a complex query +can be as simple as the following: + + #!/usr/bin/perl + + use CGI::FormBuilder; + use SQL::Abstract; + + my $form = CGI::FormBuilder->new(...); + my $sql = SQL::Abstract->new; + + if ($form->submitted) { + my $field = $form->field; + my $id = delete $field->{id}; + my($stmt, @bind) = $sql->update('table', $field, {id => $id}); + } + +Of course, you would still have to connect using C to run the +query, but the point is that if you make your form look like your +table, the actual query script can be extremely simplistic. + +If you're B lazy (I am), check out C for +a fast interface to returning and formatting data. I frequently +use these three modules together to write complex database query +apps in under 50 lines. + +=head1 NOTES + +There is not (yet) any explicit support for SQL compound logic +statements like "AND NOT". Instead, just do the de Morgan's +law transformations yourself. For example, this: + + "lname LIKE '%son%' AND NOT ( age < 10 OR age > 20 )" + +Becomes: + + "lname LIKE '%son%' AND ( age >= 10 AND age <= 20 )" + +With the corresponding C<%where> hash: + + %where = ( + lname => {like => '%son%'}, + age => [-and => {'>=', 10}, {'<=', 20}], + ); + +Again, remember that the C<-and> goes I the arrayref. + +=head1 ACKNOWLEDGEMENTS + +There are a number of individuals that have really helped out with +this module. Unfortunately, most of them submitted bugs via CPAN +so I have no idea who they are! But the people I do know are: + + Mark Stosberg (benchmarking) + Chas Owens (initial "IN" operator support) + Philip Collins (per-field SQL functions) + Eric Kolve (hashref "AND" support) + Mike Fragassi (enhancements to "BETWEEN" and "LIKE") + Dan Kubb (support for "quote_char" and "name_sep") + +Thanks! + +=head1 BUGS + +If found, please DO NOT submit anything via C - that +just causes me a ton of work. Email me a patch (or script demonstrating +the problem) to the below address, and include the VERSION string you'll +be seeing shortly. + +=head1 SEE ALSO + +L, L, L, L + +=head1 VERSION + +$Id: Abstract.pm,v 1.21 2006/03/08 01:27:56 nwiger Exp $ + +=head1 AUTHOR + +Copyright (c) 2001-2006 Nathan Wiger . All Rights Reserved. + +This module is free software; you may copy this under the terms of +the GNU General Public License, or the Artistic License, copies of +which should have accompanied your Perl kit. + +=cut + diff --git a/t/00new.t b/t/00new.t new file mode 100755 index 0000000..1952f94 --- /dev/null +++ b/t/00new.t @@ -0,0 +1,103 @@ +#!/usr/bin/perl -I. -w + +use strict; +use vars qw($TESTING); +$TESTING = 1; +use Test; + +# use a BEGIN block so we print our plan before SQL::Abstract is loaded +BEGIN { plan tests => 14 } + +use SQL::Abstract; + +my @handle_tests = ( + #1 + { + args => {logic => 'OR'}, + stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )' + }, + #2 + { + args => {}, + stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )' + }, + #3 + { + args => {case => "upper"}, + stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )' + }, + #4 + { + args => {case => "upper", cmp => "="}, + stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )' + }, + #5 + { + args => {cmp => "=", logic => 'or'}, + stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )' + }, + #6 + { + args => {cmp => "like"}, + stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )' + }, + #7 + { + args => {logic => "or", cmp => "like"}, + stmt => 'SELECT * FROM test WHERE ( a LIKE ? OR b LIKE ? )' + }, + #8 + { + args => {case => "lower"}, + stmt => 'select * from test where ( a = ? and b = ? )' + }, + #9 + { + args => {case => "lower", cmp => "="}, + stmt => 'select * from test where ( a = ? and b = ? )' + }, + #10 + { + args => {case => "lower", cmp => "like"}, + stmt => 'select * from test where ( a like ? and b like ? )' + }, + #11 + { + args => {case => "lower", convert => "lower", cmp => "like"}, + stmt => 'select * from test where ( lower(a) like lower(?) and lower(b) like lower(?) )' + }, + #12 + { + args => {convert => "Round"}, + stmt => 'SELECT * FROM test WHERE ( ROUND(a) = ROUND(?) AND ROUND(b) = ROUND(?) )', + }, + #13 + { + args => {convert => "lower"}, + stmt => 'SELECT * FROM test WHERE ( ( LOWER(ticket) = LOWER(?) ) OR ( LOWER(hostname) = LOWER(?) ) OR ( LOWER(taco) = LOWER(?) ) OR ( LOWER(salami) = LOWER(?) ) )', + bind => [ { ticket => 11 }, { hostname => 11 }, { taco => 'salad' }, { salami => 'punch' } ], + }, + #14 + { + args => {convert => "upper"}, + stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )', + bind => [ { ticket => [11, 12, 13], hostname => { in => ['ntf', 'avd', 'bvd', '123'] } }, + { tack => { between => [qw/tick tock/] } }, + { a => [qw/b c d/], e => { '!=', [qw(f g)] }, q => { 'not in', [14..20] } } ], + }, +); + +for (@handle_tests) { + local $" = ', '; + #print "creating a handle with args ($_->{args}): "; + my $sql = SQL::Abstract->new($_->{args}); + my $bind = $_->{bind} || { a => 4, b => 0}; + my($stmt, @bind) = $sql->select('test', '*', $bind); + ok($stmt eq $_->{stmt} && @bind) or + warn "got\n", + "[$stmt], [@bind]\n", + "instead of\n", + "[$_->{stmt}] [4, 0]\n\n"; +} + + diff --git a/t/01generate.t b/t/01generate.t new file mode 100755 index 0000000..e6e55e6 --- /dev/null +++ b/t/01generate.t @@ -0,0 +1,327 @@ +#!/usr/bin/perl -I. -w + +use strict; +use vars qw($TESTING); +$TESTING = 1; +use Test; + +# use a BEGIN block so we print our plan before SQL::Abstract is loaded +BEGIN { plan tests => 60 } + +use SQL::Abstract; + +my @tests = ( + #1 + { + func => 'select', + args => ['test', '*'], + stmt => 'SELECT * FROM test', + stmt_q => 'SELECT * FROM `test`', + bind => [] + }, + #2 + { + func => 'select', + args => ['test', [qw(one two three)]], + stmt => 'SELECT one, two, three FROM test', + stmt_q => 'SELECT `one`, `two`, `three` FROM `test`', + bind => [] + }, + #3 + { + func => 'select', + args => ['test', '*', { a => 0 }, [qw/boom bada bing/]], + stmt => 'SELECT * FROM test WHERE ( a = ? ) ORDER BY boom, bada, bing', + stmt_q => 'SELECT * FROM `test` WHERE ( `a` = ? ) ORDER BY `boom`, `bada`, `bing`', + bind => [0] + }, + #4 + { + func => 'select', + args => ['test', '*', [ { a => 5 }, { b => 6 } ]], + stmt => 'SELECT * FROM test WHERE ( ( a = ? ) OR ( b = ? ) )', + stmt_q => 'SELECT * FROM `test` WHERE ( ( `a` = ? ) OR ( `b` = ? ) )', + bind => [5,6] + }, + #5 + { + func => 'select', + args => ['test', '*', undef, ['id']], + stmt => 'SELECT * FROM test ORDER BY id', + stmt_q => 'SELECT * FROM `test` ORDER BY `id`', + bind => [] + }, + #6 + { + func => 'select', + args => ['test', '*', { a => 'boom' } , ['id']], + stmt => 'SELECT * FROM test WHERE ( a = ? ) ORDER BY id', + stmt_q => 'SELECT * FROM `test` WHERE ( `a` = ? ) ORDER BY `id`', + bind => ['boom'] + }, + #7 + { + func => 'select', + args => ['test', '*', { a => ['boom', 'bang'] }], + stmt => 'SELECT * FROM test WHERE ( ( ( a = ? ) OR ( a = ? ) ) )', + stmt_q => 'SELECT * FROM `test` WHERE ( ( ( `a` = ? ) OR ( `a` = ? ) ) )', + bind => ['boom', 'bang'] + }, + #8 + { + func => 'select', + args => [[qw/test1 test2/], '*', { 'test1.a' => { 'In', ['boom', 'bang'] } }], + stmt => 'SELECT * FROM test1, test2 WHERE ( test1.a IN ( ?, ? ) )', + stmt_q => 'SELECT * FROM `test1`, `test2` WHERE ( `test1`.`a` IN ( ?, ? ) )', + bind => ['boom', 'bang'] + }, + #9 + { + func => 'select', + args => ['test', '*', { a => { 'between', ['boom', 'bang'] } }], + stmt => 'SELECT * FROM test WHERE ( a BETWEEN ? AND ? )', + stmt_q => 'SELECT * FROM `test` WHERE ( `a` BETWEEN ? AND ? )', + bind => ['boom', 'bang'] + }, + #10 + { + func => 'select', + args => ['test', '*', { a => { '!=', 'boom' } }], + stmt => 'SELECT * FROM test WHERE ( a != ? )', + stmt_q => 'SELECT * FROM `test` WHERE ( `a` != ? )', + bind => ['boom'] + }, + #11 + { + func => 'update', + args => ['test', {a => 'boom'}, {a => undef}], + stmt => 'UPDATE test SET a = ? WHERE ( a IS NULL )', + stmt_q => 'UPDATE `test` SET `a` = ? WHERE ( `a` IS NULL )', + bind => ['boom'] + }, + #12 + { + func => 'update', + args => ['test', {a => 'boom'}, { a => {'!=', "bang" }} ], + stmt => 'UPDATE test SET a = ? WHERE ( a != ? )', + stmt_q => 'UPDATE `test` SET `a` = ? WHERE ( `a` != ? )', + bind => ['boom', 'bang'] + }, + #13 + { + func => 'update', + args => ['test', {'a-funny-flavored-candy' => 'yummy', b => 'oops'}, { a42 => "bang" }], + stmt => 'UPDATE test SET a-funny-flavored-candy = ?, b = ? WHERE ( a42 = ? )', + stmt_q => 'UPDATE `test` SET `a-funny-flavored-candy` = ?, `b` = ? WHERE ( `a42` = ? )', + bind => ['yummy', 'oops', 'bang'] + }, + #14 + { + func => 'delete', + args => ['test', {requestor => undef}], + stmt => 'DELETE FROM test WHERE ( requestor IS NULL )', + stmt_q => 'DELETE FROM `test` WHERE ( `requestor` IS NULL )', + bind => [] + }, + #15 + { + func => 'delete', + args => [[qw/test1 test2 test3/], + { 'test1.field' => \'!= test2.field', + user => {'!=','nwiger'} }, + ], + stmt => 'DELETE FROM test1, test2, test3 WHERE ( test1.field != test2.field AND user != ? )', + stmt_q => 'DELETE FROM `test1`, `test2`, `test3` WHERE ( `test1`.`field` != test2.field AND `user` != ? )', # test2.field is a literal value, cannnot be quoted. + bind => ['nwiger'] + }, + #16 + { + func => 'insert', + args => ['test', {a => 1, b => 2, c => 3, d => 4, e => 5}], + stmt => 'INSERT INTO test (a, b, c, d, e) VALUES (?, ?, ?, ?, ?)', + stmt_q => 'INSERT INTO `test` (`a`, `b`, `c`, `d`, `e`) VALUES (?, ?, ?, ?, ?)', + bind => [qw/1 2 3 4 5/], + }, + #17 + { + func => 'insert', + args => ['test', [qw/1 2 3 4 5/]], + stmt => 'INSERT INTO test VALUES (?, ?, ?, ?, ?)', + stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?)', + bind => [qw/1 2 3 4 5/], + }, + #18 + { + func => 'insert', + args => ['test', [qw/1 2 3 4 5/, undef]], + stmt => 'INSERT INTO test VALUES (?, ?, ?, ?, ?, ?)', + stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?, ?)', + bind => [qw/1 2 3 4 5/, undef], + }, + #19 + { + func => 'update', + args => ['test', {a => 1, b => 2, c => 3, d => 4, e => 5}], + stmt => 'UPDATE test SET a = ?, b = ?, c = ?, d = ?, e = ?', + stmt_q => 'UPDATE `test` SET `a` = ?, `b` = ?, `c` = ?, `d` = ?, `e` = ?', + bind => [qw/1 2 3 4 5/], + }, + #20 + { + func => 'update', + args => ['test', {a => 1, b => 2, c => 3, d => 4, e => 5}, {a => {'in', [1..5]}}], + stmt => 'UPDATE test SET a = ?, b = ?, c = ?, d = ?, e = ? WHERE ( a IN ( ?, ?, ?, ?, ? ) )', + stmt_q => 'UPDATE `test` SET `a` = ?, `b` = ?, `c` = ?, `d` = ?, `e` = ? WHERE ( `a` IN ( ?, ?, ?, ?, ? ) )', + bind => [qw/1 2 3 4 5 1 2 3 4 5/], + }, + #21 + { + func => 'update', + args => ['test', {a => 1, b => ["to_date(?, 'MM/DD/YY')", '02/02/02']}, {a => {'between', [1,2]}}], + stmt => 'UPDATE test SET a = ?, b = to_date(?, \'MM/DD/YY\') WHERE ( a BETWEEN ? AND ? )', + stmt_q => 'UPDATE `test` SET `a` = ?, `b` = to_date(?, \'MM/DD/YY\') WHERE ( `a` BETWEEN ? AND ? )', + bind => [qw(1 02/02/02 1 2)], + }, + #22 + { + func => 'insert', + args => ['test.table', {high_limit => \'max(all_limits)', low_limit => 4} ], + stmt => 'INSERT INTO test.table (high_limit, low_limit) VALUES (max(all_limits), ?)', + stmt_q => 'INSERT INTO `test`.`table` (`high_limit`, `low_limit`) VALUES (max(all_limits), ?)', + bind => ['4'], + }, + #23 + { + func => 'insert', + new => {bindtype => 'columns'}, + args => ['test.table', {one => 2, three => 4, five => 6} ], + stmt => 'INSERT INTO test.table (five, one, three) VALUES (?, ?, ?)', + stmt_q => 'INSERT INTO `test`.`table` (`five`, `one`, `three`) VALUES (?, ?, ?)', + bind => [['five', 6], ['one', 2], ['three', 4]], # alpha order, man... + }, + #24 + { + func => 'select', + new => {bindtype => 'columns', case => 'lower'}, + args => ['test.table', [qw/one two three/], {one => 2, three => 4, five => 6} ], + stmt => 'select one, two, three from test.table where ( five = ? and one = ? and three = ? )', + stmt_q => 'select `one`, `two`, `three` from `test`.`table` where ( `five` = ? and `one` = ? and `three` = ? )', + bind => [['five', 6], ['one', 2], ['three', 4]], # alpha order, man... + }, + #25 + { + func => 'update', + new => {bindtype => 'columns', cmp => 'like'}, + args => ['testin.table2', {One => 22, Three => 44, FIVE => 66}, + {Beer => 'is', Yummy => '%YES%', IT => ['IS','REALLY','GOOD']}], + stmt => 'UPDATE testin.table2 SET FIVE = ?, One = ?, Three = ? WHERE ' + . '( Beer LIKE ? AND ( ( IT LIKE ? ) OR ( IT LIKE ? ) OR ( IT LIKE ? ) ) AND Yummy LIKE ? )', + stmt_q => 'UPDATE `testin`.`table2` SET `FIVE` = ?, `One` = ?, `Three` = ? WHERE ' + . '( `Beer` LIKE ? AND ( ( `IT` LIKE ? ) OR ( `IT` LIKE ? ) OR ( `IT` LIKE ? ) ) AND `Yummy` LIKE ? )', + bind => [['FIVE', 66], ['One', 22], ['Three', 44], ['Beer','is'], + ['IT','IS'], ['IT','REALLY'], ['IT','GOOD'], ['Yummy','%YES%']], + }, + #26 + { + func => 'select', + args => ['test', '*', {priority => [ -and => {'!=', 2}, {'!=', 1} ]}], + stmt => 'SELECT * FROM test WHERE ( ( ( priority != ? ) AND ( priority != ? ) ) )', + stmt_q => 'SELECT * FROM `test` WHERE ( ( ( `priority` != ? ) AND ( `priority` != ? ) ) )', + bind => [qw(2 1)], + }, + #27 + { + func => 'select', + args => ['Yo Momma', '*', { user => 'nwiger', + -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ] }], + stmt => 'SELECT * FROM Yo Momma WHERE ( ( ( workhrs > ? ) OR ( geo = ? ) ) AND user = ? )', + stmt_q => 'SELECT * FROM `Yo Momma` WHERE ( ( ( `workhrs` > ? ) OR ( `geo` = ? ) ) AND `user` = ? )', + bind => [qw(20 ASIA nwiger)], + }, + #28 + { + func => 'update', + args => ['taco_punches', { one => 2, three => 4 }, + { bland => [ -and => {'!=', 'yes'}, {'!=', 'YES'} ], + tasty => { '!=', [qw(yes YES)] }, + -nest => [ face => [ -or => {'=', 'mr.happy'}, {'=', undef} ] ] }, + ], + stmt => 'UPDATE taco_punches SET one = ?, three = ? WHERE ( ( ( ( ( face = ? ) OR ( face IS NULL ) ) ) )' + . ' AND ( ( bland != ? ) AND ( bland != ? ) ) AND ( ( tasty != ? ) OR ( tasty != ? ) ) )', + stmt_q => 'UPDATE `taco_punches` SET `one` = ?, `three` = ? WHERE ( ( ( ( ( `face` = ? ) OR ( `face` IS NULL ) ) ) )' + . ' AND ( ( `bland` != ? ) AND ( `bland` != ? ) ) AND ( ( `tasty` != ? ) OR ( `tasty` != ? ) ) )', + bind => [qw(2 4 mr.happy yes YES yes YES)], + }, + #29 + { + func => 'select', + args => ['jeff', '*', { name => {'like', '%smith%', -not_in => ['Nate','Jim','Bob','Sally']}, + -nest => [ -or => [ -and => [age => { -between => [20,30] }, age => {'!=', 25} ], + yob => {'<', 1976} ] ] } ], + stmt => 'SELECT * FROM jeff WHERE ( ( ( ( ( ( ( age BETWEEN ? AND ? ) AND ( age != ? ) ) ) OR ( yob < ? ) ) ) )' + . ' AND name NOT IN ( ?, ?, ?, ? ) AND name LIKE ? )', + stmt_q => 'SELECT * FROM `jeff` WHERE ( ( ( ( ( ( ( `age` BETWEEN ? AND ? ) AND ( `age` != ? ) ) ) OR ( `yob` < ? ) ) ) )' + . ' AND `name` NOT IN ( ?, ?, ?, ? ) AND `name` LIKE ? )', + bind => [qw(20 30 25 1976 Nate Jim Bob Sally %smith%)] + }, + #30 + { + # The "-maybe" should be ignored, as it sits at the top level (bug?) + func => 'update', + args => ['fhole', {fpoles => 4}, [-maybe => {race => [-and => [qw(black white asian)]]}, + {-nest => {firsttime => [-or => {'=','yes'}, undef]}}, + [ -and => {firstname => {-not_like => 'candace'}}, {lastname => {-in => [qw(jugs canyon towers)]}} ] ] ], + stmt => 'UPDATE fhole SET fpoles = ? WHERE ( ( ( ( ( ( ( race = ? ) OR ( race = ? ) OR ( race = ? ) ) ) ) ) )' + . ' OR ( ( ( ( firsttime = ? ) OR ( firsttime IS NULL ) ) ) ) OR ( ( ( firstname NOT LIKE ? ) ) AND ( lastname IN ( ?, ?, ? ) ) ) )', + stmt_q => 'UPDATE `fhole` SET `fpoles` = ? WHERE ( ( ( ( ( ( ( `race` = ? ) OR ( `race` = ? ) OR ( `race` = ? ) ) ) ) ) )' + . ' OR ( ( ( ( `firsttime` = ? ) OR ( `firsttime` IS NULL ) ) ) ) OR ( ( ( `firstname` NOT LIKE ? ) ) AND ( `lastname` IN ( ?, ?, ? ) ) ) )', + bind => [qw(4 black white asian yes candace jugs canyon towers)] + }, +); + +use Data::Dumper; + +for (@tests) { + local $"=', '; + + my $new = $_->{new} || {}; + $new->{debug} = $ENV{DEBUG} || 0; + my $sql = SQL::Abstract->new(%$new); + + #print "testing with args (@{$_->{args}}): "; + my $func = $_->{func}; + my($stmt, @bind) = $sql->$func(@{$_->{args}}); + ok($stmt eq $_->{stmt} && equal(\@bind, $_->{bind})) or + print "got\n", + "[$stmt] [",Dumper(\@bind),"]\n", + "instead of\n", + "[$_->{stmt}] [",Dumper($_->{bind}),"]\n\n"; + + # test with quoted labels + my $sql_q = SQL::Abstract->new(%$new, quote_char => '`', name_sep => '.'); + + my $func_q = $_->{func}; + my($stmt_q, @bind_q) = $sql_q->$func_q(@{$_->{args}}); + ok($stmt_q eq $_->{stmt_q} && equal(\@bind_q, $_->{bind})) or + print "got\n", + "[$stmt_q] [",Dumper(\@bind_q),"]\n", + "instead of\n", + "[$_->{stmt_q}] [",Dumper($_->{bind}),"]\n\n"; +} + +sub equal { + my ($a, $b) = @_; + return 0 if @$a != @$b; + for (my $i = 0; $i < $#{$a}; $i++) { + next if (! defined($a->[$i])) && (! defined($b->[$i])); + if (ref $a->[$i] && ref $b->[$i]) { + return 0 if $a->[$i][0] ne $b->[$i][0] + || $a->[$i][1] ne $b->[$i][1]; + } else { + return 0 if $a->[$i] ne $b->[$i]; + } + } + return 1; +} + + diff --git a/t/02where.t b/t/02where.t new file mode 100755 index 0000000..0cfbe49 --- /dev/null +++ b/t/02where.t @@ -0,0 +1,174 @@ +#!/usr/bin/perl -I. -w + +use strict; +use vars qw($TESTING); +$TESTING = 1; +use Test; + +# use a BEGIN block so we print our plan before SQL::Abstract is loaded +# we run each test TWICE to make sure _anoncopy is working +BEGIN { plan tests => 24 } + +use SQL::Abstract; + +# Make sure to test the examples, since having them break is somewhat +# embarrassing. :-( + +my @handle_tests = ( + { + where => { + requestor => 'inna', + worker => ['nwiger', 'rcwe', 'sfz'], + status => { '!=', 'completed' } + }, + order => [], + stmt => " WHERE ( requestor = ? AND status != ? AND ( ( worker = ? ) OR" + . " ( worker = ? ) OR ( worker = ? ) ) )", + bind => [qw/inna completed nwiger rcwe sfz/], + }, + + { + where => { + user => 'nwiger', + status => 'completed' + }, + order => [qw/ticket/], + stmt => " WHERE ( status = ? AND user = ? ) ORDER BY ticket", + bind => [qw/completed nwiger/], + }, + + { + where => { + user => 'nwiger', + status => { '!=', 'completed' } + }, + order => [qw/ticket/], + stmt => " WHERE ( status != ? AND user = ? ) ORDER BY ticket", + bind => [qw/completed nwiger/], + }, + + { + where => { + status => 'completed', + reportid => { 'in', [567, 2335, 2] } + }, + order => [], + stmt => " WHERE ( reportid IN ( ?, ?, ? ) AND status = ? )", + bind => [qw/567 2335 2 completed/], + }, + + { + where => { + status => 'completed', + reportid => { 'not in', [567, 2335, 2] } + }, + order => [], + stmt => " WHERE ( reportid NOT IN ( ?, ?, ? ) AND status = ? )", + bind => [qw/567 2335 2 completed/], + }, + + { + where => { + status => 'completed', + completion_date => { 'between', ['2002-10-01', '2003-02-06'] }, + }, + order => \'ticket, requestor', + stmt => " WHERE ( completion_date BETWEEN ? AND ? AND status = ? ) ORDER BY ticket, requestor", + bind => [qw/2002-10-01 2003-02-06 completed/], + }, + + { + where => [ + { + user => 'nwiger', + status => { 'in', ['pending', 'dispatched'] }, + }, + { + user => 'robot', + status => 'unassigned', + }, + ], + order => [], + stmt => " WHERE ( ( status IN ( ?, ? ) AND user = ? ) OR ( status = ? AND user = ? ) )", + bind => [qw/pending dispatched nwiger unassigned robot/], + }, + + { + where => { + priority => [ {'>', 3}, {'<', 1} ], + requestor => \'is not null', + }, + order => 'priority', + stmt => " WHERE ( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor is not null ) ORDER BY priority", + bind => [qw/3 1/], + }, + + { + where => { + priority => [ {'>', 3}, {'<', 1} ], + requestor => { '!=', undef }, + }, + order => [qw/a b c d e f g/], + stmt => " WHERE ( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor IS NOT NULL )" + . " ORDER BY a, b, c, d, e, f, g", + bind => [qw/3 1/], + }, + + { + where => { + priority => { 'between', [1, 3] }, + requestor => { 'like', undef }, + }, + order => \'requestor, ticket', + stmt => " WHERE ( priority BETWEEN ? AND ? AND requestor IS NULL ) ORDER BY requestor, ticket", + bind => [qw/1 3/], + }, + + + { + where => { + id => 1, + num => { + '<=' => 20, + '>' => 10, + }, + }, + stmt => " WHERE ( id = ? AND num <= ? AND num > ? )", + bind => [qw/1 20 10/], + }, + + { + where => { foo => {-not_like => [7,8,9]}, + fum => {'like' => [qw/a b/]}, + nix => {'between' => [100,200] }, + nox => {'not between' => [150,160] }, + wix => {'in' => [qw/zz yy/]}, + wux => {'not_in' => [qw/30 40/]} + }, + stmt => " WHERE ( ( ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) ) AND ( ( fum LIKE ? ) OR ( fum LIKE ? ) ) AND nix BETWEEN ? AND ? AND nox NOT BETWEEN ? AND ? AND wix IN ( ?, ? ) AND wux NOT IN ( ?, ? ) )", + bind => [7,8,9,'a','b',100,200,150,160,'zz','yy','30','40'], + }, + +); + +for (@handle_tests) { + local $" = ', '; + #print "creating a handle with args ($_->{args}): "; + my $sql = SQL::Abstract->new; + + # run twice + for (my $i=0; $i < 2; $i++) { + my($stmt, @bind) = $sql->where($_->{where}, $_->{order}); + my $bad = 0; + for(my $i=0; $i < @{$_->{bind}}; $i++) { + $bad++ unless $_->{bind}[$i] eq $bind[$i]; + } + + ok($stmt eq $_->{stmt} && @bind == @{$_->{bind}} && ! $bad) or + print "got\n", + "[$stmt] [@bind]\n", + "instead of\n", + "[$_->{stmt}] [@{$_->{bind}}]\n\n"; + } +} + diff --git a/t/03values.t b/t/03values.t new file mode 100755 index 0000000..0c96caa --- /dev/null +++ b/t/03values.t @@ -0,0 +1,93 @@ +#!/usr/bin/perl -I. -w + +use strict; +use vars qw($TESTING); +$TESTING = 1; +use Test; + +# use a BEGIN block so we print our plan before SQL::Abstract is loaded +BEGIN { plan tests => 5 } + +use SQL::Abstract; + +my $sql = SQL::Abstract->new; + +my @data = ( + { + user => 'nwiger', + name => 'Nathan Wiger', + phone => '123-456-7890', + addr => 'Yeah, right', + city => 'Milwalkee', + state => 'Minnesota', + }, + + { + user => 'jimbo', + name => 'Jimbo Bobson', + phone => '321-456-0987', + addr => 'Yo Momma', + city => 'Yo City', + state => 'Minnesota', + }, + + { + user => 'mr.hat', + name => 'Mr. Garrison', + phone => '123-456-7890', + addr => undef, + city => 'South Park', + state => 'CO', + }, + + { + user => 'kennyg', + name => undef, + phone => '1-800-Sucky-Sucky', + addr => 'Mr. Garrison', + city => undef, + state => 'CO', + }, + + { + user => 'barbara_streisand', + name => 'MechaStreisand!', + phone => 0, + addr => -9230992340, + city => 42, + state => 'CO', + }, +); + +# Note to self: I have no idea what this does anymore +# It looks like a cool fucking segment of code though! +# I just wish I remembered writing it... :-\ + +my($sth, $stmt); +my($laststmt, $numfields); +for my $t (@data) { + local $"=', '; + + $stmt = $sql->insert('yo_table', $t); + my @val = $sql->values($t); + $numfields ||= @val; + + ok((! $laststmt || $stmt eq $laststmt) && @val == $numfields + && equal(\@val, [map { $t->{$_} } sort keys %$t])) or + print "got\n", + "[$stmt] [@val]\n", + "instead of\n", + "[$t->{stmt}] [stuff]\n\n"; + $laststmt = $stmt; +} + +sub equal { + my ($a, $b) = @_; + return 0 if @$a != @$b; + for (my $i = 0; $i < $#{$a}; $i++) { + next if (! defined($a->[$i])) && (! defined($b->[$i])); + return 0 if $a->[$i] ne $b->[$i]; + } + return 1; +} +