File Coverage

blib/lib/SQL/QueryBuilder/OO.pm

Criterion	Covered	Total	%
statement	219	747	29.3
branch	0	208	0.0
condition	0	85	0.0
subroutine	73	180	40.5
pod			n/a
total	292	1220	23.9

line

stmt

bran

cond

sub

pod

time

code

package SQL::QueryBuilder::OO;

4549

use 5.010;

use strict;

use vars qw($VERSION);

101

$VERSION = '0.2.1';

=pod

=head1 NAME

SQL::QueryBuilder::OO - Object oriented SQL query builder

=head1 SYNOPSIS

use SQL::QueryBuilder::OO;

$sql = sqlQueryBase::select(qw(id title description), {name => 'author'})

->from('article')

->innerJoin('users', 'userId')

->leftJoin({'comments' => 'c'}, sqlCondition::EQ('userId', 'c.from'))

->where(sqlCondition::AND(

sqlCondition::EQ('category')->bind($cat),

sqlCondition::NE('hidden')->bind(1)))

->limit(10,20)

->groupBy('title')

->orderBy({'timestamp' => 'DESC'});

$dbh->do($sql, undef, $sql->gatherBoundArgs());

=head1 DESCRIPTION

This module provides for an object oriented way to create complex SQL queries

while maintaining code readability. It supports conditions construction and

bound query parameters. While the module is named C, this

name is actually not used when constructing queries. The three main packages to

build queries are C, C and C.

The project is actually a port of PHP classes to construct queries used in one

of my proprietary projects (which may explain the excessive use of the scope

resolution operator (C<::>) in the module's sytax).

=head1 BUILDING QUERIES

The package to provide builder interfaces is called C and has

these methods:

=head2 SELECT queries

=over 4

=item select(I[, I])

Creates a SELECT query object. Columns to select default to C<*> if none are

given. They are otherwise to be specified as a list of expressions that can be

literal column names or HASH references with column aliases.

Column names are quoted where appropriate:

# Build SELECT * query

$all = sqlQueryBase::select();

# Build SELECT ... query

$sql = sqlQueryBase::select(

# literal column names

qw(id title),

# column alias

{'u.username' => 'author', timestamp => 'authored'},

# SELECT specific options

[qw(SQL_CACHE SQL_CALC_FOUND_ROWS)]);

The references returned from the above statements are blessed into an internal

package. Those internal packages will not be documented here, since they may be

subject to change. Their methods, however, are those of a valid SQL SELECT

statement. When constructing queries you'll B of

SQL syntax. This means, that the following will be treated as an error

$sql = sqlQueryBase::select()

->from('table')

->limit(10)

->where(...);

Can't locate object method "where" via package "sqlSelectAssemble" at ...

The correct order would have been:

$sql = sqlQueryBase::select()

->from('table')

->where(...)

->limit(10);

The following methods are available to construct the query further:

=item from(I)

This obviously represents the "FROM" part of a select query. It accepts a list

of string literals as table names or table aliases:

100

101

$sql = sqlQueryBase::select()->from('posts', {'user' => 'u'});

102

103

=item leftJoin(I, I)

104

105

=item innerJoin(I, I)

106

107

=item rightJoin(I, I)

108
109						These methods extend the "FROM" fragment with a left, inner or right table join.
110						The table name can either be a string literal or a HASH reference for aliasing
111						table names.
112
113						The condition should either be an C object (see L):
114
115						# SELECT * FROM `table_a` LEFT JOIN `table_b` ON(`column_a` = `column_b`)
116						$sql = sqlQueryBase::select()
117						->from('table_a')
118						->leftJoin('table_b', sqlCondition::EQ('column_a', 'column_b'));
119
120						...or a string literal of a common column name for the USING clause:
121
122						# SELECT * FROM `table_a` LEFT JOIN `table_b` USING(`id`)
123						$sql = sqlQueryBase::select()
124						->from('table_a')
125						->leftJoin('table_b', 'id');
126
127						=item where(I)
128
129						This represents the "WHERE" part of a SELECT query. It will accept B object
130						of the C package (see L).
131
132						=item groupBy(I)
133
134						This represents the "GROUP BY" statement of a SELECT query.
135
136						=item having(I)
137
138						This represents the "HAVING" part of a SELECT query. It will accept B object
139						of the C package (see L).
140
141						=item orderBy(I)
142
143						This represents the "ORDER BY" statement of a SELECT query. Columns are expected
144						to be string literals or HASH references (B member only) with ordering
145						directions:
146
147						$sql = sqlQueryBase::select()
148						->from('table')
149						->orderBy('id', {timestamp => 'DESC'}, 'title');
150
151						=item limit(I[, I])
152
153						This represents the "LIMIT" fragment of a SELECT query. It deviates from the
154						standard SQL expression, as the limit count B the first argument to
155						this method, regardless of a given offset.
156
157						=back
158
159						=head2 Creating conditions
160
161						Conditions can be used as a parameter for C, C, C,
162						C or C. They are constructed with the C package,
163						whose methods are not exported due to their generic names. Instead, the
164						"namespace" has to be mentioned for each conditional:
165
166						$cond = sqlCondition::AND(
167						sqlCondition::EQ('id')->bind(1337),
168						sqlCondition::BETWEEN('stamp', "2013-01-06", "2014-03-31"));
169
170						Those are all operators:
171
172						=head3 Booleans
173
174						To logically connect conditions, the following to methods are available:
175
176						=over 4
177
178						=item AND(I)
179
180						Connect one or more conditions with a boolean AND.
181
182						=item OR(I)
183
184						Connect one or more conditions with a boolean OR.
185
186						=item NOT(I)
187
188						Negate a condition with an unary NOT.
189
190						=back
191
192						=head3 Relational operators
193
194						All relational operators expect a mandatory column name as their first argument
195						and a second optional ride-hand-side column name.
196
197						If the optional second parameter is left out, the conditional can be bound (see
198						L).
199
200						=over 4
201
202						=item EQ(I[, I])
203
204						Bual to operator (C<=>).
205
206						=item NE(I[, I])
207
208						Bot Bqual to operator (C).
209
210						=item LT(I[, I])
211
212						Bess Bhan operator (C>).
213
214						=item GT(I[, I])
215
216						Breater Bhan operator (C>).
217
218						=item LTE(I[, I])
219
220						Bess Bhan or Bqual to operator (C=>).
221
222						=item GTE(I[, I])
223
224						Breater Bhan or Bqual to operator (C=>).
225
226						=back
227
228						=head3 SQL specific operators
229
230						=over 4
231
232						=item BETWEEN(I, I, I)
233
234						Creates an "x BETWEEN start AND end" conditional.
235
236						=item IN(I)
237
238						Creates an "x IN(...)" conditional.
239
240						B that, if bound, this method B croak if it encounters an empty
241						list. I
242						will be reduced to a "falsy" statement and a warning will be issued.>
243
244						=item ISNULL(I)
245
246						Creates an "x IS NULL" conditional.
247
248						=item ISNOTNULL(I)
249
250						Creates an "x IS NOT NULL" conditional.
251
252						=item LIKE(I, I)
253
254						Creates an "x LIKE pattern" conditional.
255
256						B that the pattern is passed unmodified. Beware of the LIKE pitfalls
257						concerning the characters C<%> and C<_>.
258
259						=back
260
261						=head2 Binding parameters
262
263						An SQL conditional can be bound against a parameter via its C method:
264
265						$cond = sqlCondition::AND(
266						sqlCondition::EQ('id')->bind(1337),
267						sqlCondition::NOT(
268						sqlCondition::IN('category')->bind([1,2,3,4])));
269
270						print $cond; # "`id` = ? AND NOT(`category` IN(?))"
271						@args = $cond->gatherBoundArgs(); # (sqlValueInt(1337),sqlValueList([1,2,3,4]))
272
273						A special case are conditionals bound against C (which is the equivalent
274						to SQL C):
275
276						$cat = undef;
277						$cond = sqlCondition::OR(
278						sqlCondition::EQ('author')->bind(undef),
279						sqlCondition::NE('category')->bind($cat));
280
281						print $cond; # `author` IS NULL OR `category` IS NOT NULL
282						@args = $cond->gatherBoundArgs(); # ()
283
284						Since C<`author` = NULL> would never be "true", the condition is replaced with
285						the correct C<`author` IS NULL> statement. (Note that the first conditional
286						could actually be written C. The substitution is
287						thus useful when binding against variables of unknown content).
288
289						=head1 TODO
290
291						=over
292
293						=item *
294
295						Implement support for UPDATE, INSERT, REPLACE and DELETE statements.
296
297						=item *
298
299						Implement support for UNION.
300
301						=back
302
303						=head1 DEPENDENCIES
304
305						L
306
307						=head1 COPYRIGHT
308
309						Copyright (C) 2013-2014 Oliver Schieche.
310
311						This software is a free library. You can modify and/or distribute it
312						under the same terms as Perl itself.
313
314						=head1 AUTHOR
315
316						Oliver Schieche Eschiecheo@cpan.orgE
317
318						http://perfect-co.de/
319
320						$Id: OO.pm 43 2015-02-11 09:02:16Z schieche $
321
322						=cut
323						##------------------------------------------------------------------------------
324						package sqlQuery;
325
326	1			1	3	use strict;
	1				2
	1				24
327	1			1	4	use warnings;
	1				1
	1				26
328	1			1	1098	use overload '""' => '_getInterpolatedQuery';
	1				883
	1				5
329
330	1			1	690	use Data::Dumper; # vital
	1				5981
	1				68
331	1			1	6	use Carp qw(croak);
	1				1
	1				42
332	1			1	4	use Scalar::Util qw(blessed looks_like_number);
	1				1
	1				75
333	1			1	458	use Params::Validate qw(:all);
	1				7245
	1				2081
334
335						$sqlQuery::DBI = undef;
336						%sqlQuery::params = ();
337						$sqlQuery::PARAMETER_PLACEHOLDER = '?';
338
339						sub setup
340						{
341	0			0		my %params = validate @_, {
342						-dbh => {isa => 'DBI::db', default => undef},
343						-connect => {type => CODEREF, default => undef}
344						};
345
346	0	0	0			if (defined($params{'-dbh'}) && defined($params{'-connect'}))
347						{
348	0					croak('Make up your mind: either use "-dbh" to pass a handle or "-connect" for ad-hoc connecting');
349						}
350
351	0					%sqlQuery::params = %params;
352
353	0					1
354						}
355
356						sub dbh
357						{
358	0	0		0		unless (defined($sqlQuery::DBI)) {
359	0	0				if (defined($sqlQuery::params{'-dbh'})) {
		0
360	0					$sqlQuery::DBI = $sqlQuery::params{'-dbh'};
361						} elsif (defined($sqlQuery::params{'-connect'})) {
362	0					$sqlQuery::DBI = eval {$sqlQuery::params{'-connect'}->()};
	0
363	0	0				croak 'Setup failed; ad-hoc connector died: '.$@ if $@;
364						} else {
365	0					croak 'sqlQuery is not setup, yet.';
366						}
367						}
368
369						$sqlQuery::DBI
370	0					}
371
372						sub q
373						{
374	0			0		local $Carp::CarpLevel = $Carp::CarpLevel + 2;
375	0					__PACKAGE__->new(@_);
376						}
377
378						sub exec
379						{
380	0			0		my $sql = shift;
381	0					my $q = __PACKAGE__->new($sql);
382	0					my $res = $q->execute(@_);
383	0					my $rows = $res->numRows;
384	0					$res->freeResource();
385	0					undef($q);
386
387	0					$rows
388						}
389
390						sub foundRows
391						{
392	0			0		my $res = __PACKAGE__->new(q(SELECT FOUND_ROWS()))->execute;
393	0					my $rows = $res->fetchColumn(0);
394	0					$res->freeResource();
395
396	0					$rows
397						}
398
399						sub getLastInsertId
400						{
401	0			0		my $res = __PACKAGE__->new(q(SELECT LAST_INSERT_ID()))->execute;
402	0					my $id = $res->fetchColumn(0);
403	0					$res->freeResource();
404
405	0					$id
406						}
407
408						sub new
409						{
410	0	0		0		my $class = ref $_[0] ? ref shift : shift;
411	0					my $sql = shift;
412	0					my $self = {-sql => undef, -params => undef, -named => 0};
413
414	0	0				unless (blessed($sql)) {
415	0	0	0			croak 'Not a scalar argument; query must either be a string or an instance of "sqlSelectAssemble"'
			0
416						if !defined($sql) \|\| ref $sql \|\| looks_like_number $sql;
417						} else {
418	0	0				croak sprintf('Parameter is not an instance of "sqlSelectAssemble" (got "%s")', ref $sql)
419						unless $sql->isa('sqlSelectAssemble');
420	0					$self->{'-params'} = undef
421						}
422
423	0					$self->{'-sql'} = $sql;
424	0					bless $self, $class
425						}
426
427						sub debugQuery
428						{
429	0			0		my $self = shift;
430	0					my $sql = "$self->{-sql}";
431
432	0					$sql =~ s/(?:\r?\n)+$//;
433	0					print "$sql\n";
434
435	0	0				if (@_) {
		0
436	0					$self->_populateParameters(@_);
437						} elsif (blessed $self->{'-sql'}) {
438	0					$self->_populateParameters($self->{'-sql'}->gatherBoundArgs());
439						}
440
441	0	0				if (defined($self->{'-params'})) {
442	0					printf "%s\n%s\n%s\n", ('-'x80), Dumper($self->{'-params'}), ('-'x80);
443	0					$self->_interpolateQuery();
444	0					printf "%s\n", $self->{'-interpolated-query'};
445						}
446						}
447
448						sub execute
449						{
450	0			0		my $self = shift;
451
452	0	0				if (@_) {
		0
453	0					$self->_populateParameters(@_);
454						} elsif (blessed $self->{'-sql'}) {
455	0					$self->_populateParameters($self->{'-sql'}->gatherBoundArgs());
456						}
457
458	0					$self->_interpolateQuery();
459
460	0					my $res = eval {$self->_query($self->{'-interpolated-query'})};
	0
461	0					$self->{'-params'} = undef;
462	0	0				die $@ if $@;
463
464	0					$res
465						}
466
467						sub setParameters
468						{
469	0			0		my $self = shift;
470	0					$self->_populateParameters(@_);
471	0					$self
472						}
473
474						sub _getInterpolatedQuery
475						{
476	0			0		my $self = shift;
477	0					$self->_interpolateQuery();
478	0					$self->{'-interpolated-query'}
479						}
480
481						sub _populateParameters
482						{
483	0			0		my $self = shift;
484
485	0	0				if (defined($self->{'-params'})) {
486	0					local $Carp::CarpLevel = $Carp::CarpLevel + 2;
487	0					croak 'Query parameters are already populated'
488						}
489
490	0	0	0			if (1 == scalar @_ && 'HASH' eq ref $_[0]) {
491	0					$self->{'-named'} = 1;
492	0					$self->{'-params'} = shift;
493	0					foreach my $p (keys %{$self->{'-params'}}) {
	0
494	0					$self->{'-params'}->{$p} = _convertArgument($self->{'-params'}->{$p});
495	0	0				croak "Argument '$p' could not be converted"
496						unless defined($self->{'-params'}->{$p});
497						}
498						} else {
499	0					croak 'Mixed named and positional parameters are unsupported'
500	0	0				if grep {'HASH' eq ref $_} @_;
501	0					$self->{'-named'} = 0;
502	0					$self->{'-params'} = [@_];
503
504	0					foreach my $index (0..$#_) {
505	0					$self->{'-params'}->[$index] = _convertArgument($self->{'-params'}->[$index]);
506	0	0				croak "Argument at index '$index' could not be converted"
507						unless defined($self->{'-params'}->[$index]);
508						}
509						}
510						}
511
512						sub _interpolateQuery
513						{
514	0			0		my $self = shift;
515
516	0	0				if ($self->{'-named'}) {
517	0					$self->_interpolateByName();
518						} else {
519	0					$self->_interpolateByIndex();
520						}
521
522	0					$self->_checkLeftoverParameters();
523						}
524
525						sub _interpolateByIndex
526						{
527	0			0		my $self = shift;
528	0					my $sql = "$self->{-sql}";
529
530	0		0			for (my $pos = 0; $pos < length($sql) && -1 != ($pos = index($sql, $sqlQuery::PARAMETER_PLACEHOLDER, $pos));) {
531	0					my $param = $self->_fetchParameter();
532	0					my $value = "$param";
533
534	0	0				$sql =
535						(0 < $pos ? substr($sql, 0, $pos) : '')
536						. $value
537						. substr($sql, $pos + 1);
538	0					$pos += length $value;
539						}
540
541	0					$self->{'-interpolated-query'} = $sql;
542						}
543
544						sub _interpolateByName
545						{
546	0			0		my $self = shift;
547	0					my $sql = "$self->{-sql}";
548
549	0		0			for (my $pos = 0; $pos < length($sql) && -1 != ($pos = index($sql, ':', $pos));) {
550	0					my ($name) = substr($sql, $pos) =~ m~^:([a-zA-Z_\d-]+)~;
551	0					my $param = $self->_fetchParameter($name);
552	0					my $value = "$param";
553
554	0	0				$sql =
555						(0 < $pos ? substr($sql, 0, $pos) : '')
556						. $value
557						. substr($sql, $pos + 1 + length($name));
558	0					$pos += length $value;
559						}
560
561	0					$self->{'-interpolated-query'} = $sql;
562						}
563
564						sub _fetchParameter
565						{
566	0			0		my $self = shift;
567	0					my $name = shift;
568
569	0	0				if (defined($name)) {
570	0	0				if (!exists($self->{'-params'}->{$name})) {
571	0					croak sprintf('No such query parameter "%s"', $name);
572						}
573	0					return $self->{'-params'}->{$name};
574						} else {
575	0	0	0			unless (ref $self->{'-params'} && @{$self->{'-params'}}) {
	0
576	0					croak 'Too few query parameters provided';
577						}
578						}
579
580	0					shift @{$self->{'-params'}};
	0
581						}
582
583						sub _checkLeftoverParameters
584						{
585	0			0		my $self = shift;
586
587	0	0	0			if ('ARRAY' eq ref $self->{'-params'} && @{$self->{'-params'}}) {
	0
588	0					croak 'Too many query parameters provided';
589						}
590						}
591
592						sub _query
593						{
594	0			0		my $self = shift;
595	0					my $sql = shift;
596	0					my $dbh = sqlQuery::dbh();
597
598	0					$self->{'-sth'} = $dbh->prepare($sql);
599
600	0					local $self->{'-sth'}->{RaiseError} = 1;
601	0					local $self->{'-sth'}->{PrintError} = 0;
602	0					eval {$self->{'-sth'}->execute};
	0
603	0	0				if ($@) {
604	0					my $err = $@;
605	0					my $file = __FILE__;
606
607	0					$self->{'-sth'} = undef;
608
609	0					$err =~ s/\s+at $file line \d+\.\r?\n//;
610	0					$err =~ s/\s*at line \d$//;
611	0					$sql =~ s/(?:\r?\n)+$//;
612	0					croak "$err\n\n<
613						}
614
615	0					sqlQueryResult->new($self, $self->{'-sth'});
616						}
617
618						sub quoteTable
619						{
620	0			0		my $table = shift;
621
622	0	0				if (ref $table)
623						{
624	0					my ($k,$v);
625	0					($k) = keys %$table;
626	0					($v) = values %$table;
627	0					return sprintf('%s AS %s', sqlQuery::quoteTable($k), sqlQuery::quoteTable($v));
628						}
629
630	0	0				return '*'
631						if '*' eq $table;
632	0					$table = join '.', map {"`$_`"} split('\.', $table);
	0
633	0					$table =~ s/`+/`/g;
634	0					$table
635						}
636
637						sub quoteWhenTable
638						{
639	0			0		my $table = shift;
640
641	0	0	0			return sqlQuery::quoteTable($table)
642						if ref $table \|\| ".$table" =~ m/^(?:\.[a-z_][a-z\d_]*){1,2}$/i;
643	0	0				return $table
644						if $table !~ m/^([a-z_][a-z\d_])\.\$/i;
645	0					return sqlQuery::quoteTable($1).'.*';
646						}
647
648						sub convertArgument
649						{
650	0			0		my $arg = shift;
651	0					my $value = _convertArgument($arg);
652
653	0	0				unless (defined($value)) {
654	0					local $Carp::CarpLevel = $Carp::CarpLevel + 1;
655	0					croak 'Argument to "sqlCondition::bind()" cannot be converted; consider using an implicit "sqlValue" instance instead'
656						}
657
658						$value
659	0					}
660
661						sub _convertArgument
662						{
663	0			0		my $arg = shift;
664
665	0	0	0			unless(ref $arg) {
		0
		0
666	0	0				return sqlValueNull->new
667						unless defined($arg);
668	0	0				return sqlValueInt->new($arg)
669						if $arg =~ m/^-?\d+$/;
670	0	0				return sqlValueFloat->new($arg)
671						if $arg =~ m/^-?\d+[.]\d+$/;
672	0					return sqlValueString->new($arg);
673						} elsif ('ARRAY' eq ref $arg) {
674	0					return sqlValueList->new($arg);
675						} elsif (blessed $arg && $arg->isa('sqlParameter')) {
676	0					return $arg;
677						}
678	0					undef;
679						}
680						##------------------------------------------------------------------------------
681						package sqlQueryResult;
682
683	1			1	10	use strict;
	1				2
	1				41
684	1			1	6	use warnings;
	1				2
	1				43
685	1			1	6	use Carp qw(croak);
	1				2
	1				60
686	1			1	26	use Scalar::Util qw(looks_like_number);
	1				2
	1				322
687
688						sub new
689						{
690	0	0		0		my $class = ref $_[0] ? ref shift : shift;
691	0					my $query = shift;
692	0					my $result = shift;
693
694	0					bless {-query => $query, -result => $result}, $class;
695						}
696
697	0			0		sub fetchAssoc {goto &fetchRow}
698						sub fetchRow
699						{
700	0			0		my $self = shift;
701	0					$self->{'-result'}->fetchrow_hashref
702						}
703
704						sub fetchArray
705						{
706	0			0		my $self = shift;
707	0					$self->{'-result'}->fetchrow_array;
708						}
709
710						sub fetchColumn
711						{
712	0			0		my $self = shift;
713	0		0			my $column = shift \|\| '0';
714
715	0	0				if (looks_like_number $column) {
716	0					my @row = $self->{'-result'}->fetchrow_array;
717	0	0				croak "No such query result offset $column"
718						if $column > $#row;
719	0					return $row[$column];
720						} else {
721	0					my $row = $self->fetchRow();
722	0	0				croak "No such query result column $column"
723						unless exists($row->{$column});
724	0					return $row->{$column};
725						}
726						}
727
728						sub fetchAll
729						{
730	0			0		my $self = shift;
731	0					my ($row,@rows);
732
733	0					push @rows, $row
734						while defined($row = $self->fetchAssoc());
735						@rows
736	0					}
737
738	0			0		sub numRows {goto &getNumRows}
739						sub getNumRows
740						{
741	0			0		shift->{'-result'}->rows;
742						}
743
744						sub freeResource
745						{
746	0			0		my $self = shift;
747
748	0	0				croak 'Statement seems unexecuted'
749						unless defined($self->{'-result'});
750	0					$self->{'-result'}->finish();
751	0					undef($self->{'-result'});
752
753	0					$self;
754						}
755						##------------------------------------------------------------------------------
756						package sqlQueryBase;
757
758	1			1	4	use strict;
	1				1
	1				26
759	1			1	4	use warnings;
	1				1
	1				128
760						##------------------------------------------------------------------------------
761						sub select
762						{
763	0			0		my @fields;
764						my @params;
765
766	0	0	0			if (@_ && 'ARRAY' eq ref $_[-1]) {
767	0					@params = @{pop()};
	0
768						}
769
770	0	0				unless (@_) {
771	0					@fields = '*';
772						} else {
773	0					@fields = (
774	0					split(',', join(',', grep {!ref} @_)),
775	0					grep {ref} @_);
776						}
777
778	0					sqlSelectFrom->new(
779						fields => [@fields],
780						params => [@params]
781						);
782						}
783						##------------------------------------------------------------------------------
784						package sqlParameter;
785
786	1			1	3	use strict;
	1				1
	1				24
787	1			1	4	use warnings;
	1				1
	1				59
788	1			1	4	use overload '""' => 'getSafeQuotedValue';
	1				1
	1				7
789	1			1	103	use Carp qw(croak);
	1				2
	1				44
790
791						BEGIN {
792	1			1	3	no strict 'refs';
	1				1
	1				85
793	1			1	3	foreach my $k (qw(getSafeQuotedValue)) {
794	1			0	93	*{__PACKAGE__."::$k"} = sub {croak __PACKAGE__."::$k() is abstract; implement it in ".(ref $_[0])}
	0				0
795	1				11	}
796						}
797
798						sub new
799						{
800	0	0		0		my $class = ref $_[0] ? ref shift : shift;
801	0					bless {-value => shift}, $class;
802						}
803						##------------------------------------------------------------------------------
804						package sqlValueNull;
805
806	1			1	5	use strict;
	1				1
	1				37
807	1			1	7	use warnings;
	1				1
	1				39
808	1			1	5	use base 'sqlParameter';
	1				1
	1				326
809
810	0			0		sub getSafeQuotedValue {'NULL'}
811						##------------------------------------------------------------------------------
812						package sqlValueLiteral;
813
814	1			1	5	use strict;
	1				1
	1				21
815	1			1	3	use warnings;
	1				0
	1				26
816	1			1	3	use base 'sqlParameter';
	1				1
	1				249
817
818	0			0		sub getSafeQuotedValue {shift->{-value}}
819						##------------------------------------------------------------------------------
820						package sqlValueString;
821
822	1			1	4	use strict;
	1				1
	1				25
823	1			1	3	use warnings;
	1				1
	1				20
824	1			1	3	use base 'sqlParameter';
	1				1
	1				276
825
826						sub getSafeQuotedValue {
827	0			0		my $self = shift;
828	0					sqlQuery::dbh()->quote($self->{-value});
829						}
830						##------------------------------------------------------------------------------
831						package sqlValueInt;
832
833	1			1	7	use strict;
	1				2
	1				43
834	1			1	4	use warnings;
	1				1
	1				28
835	1			1	3	use base 'sqlParameter';
	1				1
	1				234
836
837						sub getSafeQuotedValue {
838	0			0		int(shift->{-value})
839						}
840						##------------------------------------------------------------------------------
841						package sqlValueFloat;
842
843	1			1	6	use strict;
	1				17
	1				36
844	1			1	6	use warnings;
	1				1
	1				27
845	1			1	8	use base 'sqlParameter';
	1				1
	1				267
846
847						sub new {
848	0			0		my $self = shift->SUPER::new(@_);
849	0		0			$self->{-precision} = $_[1] \|\| 8;
850	0					$self
851						}
852
853						sub getSafeQuotedValue {
854	0			0		my $self = shift;
855	0					sprintf("%.$self->{-precision}f", $self->{-value})
856						}
857						##------------------------------------------------------------------------------
858						package sqlValueList;
859
860	1			1	4	use strict;
	1				1
	1				24
861	1			1	4	use warnings;
	1				1
	1				20
862	1			1	3	use base 'sqlParameter';
	1				4
	1				230
863	1			1	5	use Carp qw(croak);
	1				1
	1				162
864
865						sub new {
866	0			0		my $self = shift->SUPER::new(@_);
867
868	0	0				unless (@{$self->{-value}}) {
	0
869	0					local $Carp::CarpLevel = $Carp::CarpLevel + 2;
870	0					croak 'Empty lists can break SQL syntax.';
871						}
872
873						$self
874	0					}
875
876						sub getSafeQuotedValue {
877	0			0		join ',', map {"$_"} @{shift->{-value}};
	0
	0
878						}
879						##------------------------------------------------------------------------------
880						package sqlSelectAssemble;
881
882	1			1	4	use strict;
	1				1
	1				22
883	1			1	4	use warnings;
	1				1
	1				25
884	1			1	3	use Carp qw/confess/;
	1				1
	1				41
885	1			1	4	use overload '""' => 'assemble';
	1				1
	1				3
886
887						sub new
888						{
889	0			0		my $class = shift;
890	0					my ($prev,$prevClass,%args) = @_;
891	0					my $self = bless {boundArgs => undef, prev => $prev, %args}, $class;
892
893	0	0				if ($prevClass) {
894	0	0	0			confess sprintf('Invalid predecessor. Got "%s". Wanted "%s"', ref $self->{prev}, $prevClass)
895						unless ref $self->{prev} && $self->{prev}->isa($prevClass);
896						}
897
898						$self
899	0					}
900
901						sub addBoundArgs
902						{
903	0			0		my $self = shift;
904	0					push @{$self->{boundArgs}}, @_;
	0
905	0					$self
906						}
907
908						sub gatherBoundArgs
909						{
910	0			0		my $self = shift;
911	0					my (@args);
912
913	0	0				push @args, @{$self->{boundArgs}}
	0
914						if $self->{boundArgs};
915	0					push @args, $self->gatherConditionArgs();
916
917	0	0				if ($self->{prev}) {
918	0					push @args, $self->{prev}->gatherBoundArgs();
919						}
920
921						@args
922	0					}
923
924	0			0		sub gatherConditionArgs {}
925
926						sub assemble
927						{
928	0			0		my $self = shift;
929	0					my $assembled = $self->_assemble();
930
931	0	0				$assembled = $self->{prev}->assemble() . $assembled
932						if $self->{prev};
933
934	0					$assembled
935						}
936
937						sub _assemble
938						{
939	0			0		''
940						}
941						##------------------------------------------------------------------------------
942						package sqlSelectFrom;
943
944	1			1	267	use strict;
	1				1
	1				42
945	1			1	6	use warnings;
	1				1
	1				26
946	1			1	3	use base 'sqlSelectAssemble';
	1				1
	1				309
947	1			1	7	use Scalar::Util qw(blessed);
	1				2
	1				505
948
949						sub new
950						{
951	0	0		0		my $class = ref $_[0] ? ref shift : shift;
952	0					my (%args) = @_;
953	0					my (@fields);
954
955	0					@fields = @{$args{fields}};
	0
956
957	0					my $self = bless {
958						queryFields => undef,
959						tables => undef,
960						params => $args{params}
961						}, $class;
962
963	0					$self->{queryFields} = [$self->translateQueryFields(@fields)];
964	0					$self
965						}
966
967						sub from
968						{
969	0			0		my $self = shift;
970	0					$self->{tables} = [@_];
971	0					sqlSelectJoin->new($self);
972						}
973
974						sub translateQueryFields
975						{
976	0			0		my $self = shift;
977	0					my (@fields) = @_;
978	0					my @columns;
979
980	0					foreach my $fieldIn (@fields)
981						{
982	0					my (@parts);
983
984	0	0				unless ('HASH' eq ref $fieldIn) {
985	0					@parts = ($fieldIn, undef);
986						} else {
987	0					@parts = %$fieldIn;
988						}
989
990	0					while (@parts) {
991	0					my ($field,$alias) = splice(@parts, 0, 2);
992
993	0	0	0			if (blessed $field && $field->isa('sqlParameter'))
994						{
995	0	0				push @columns, $sqlQuery::PARAMETER_PLACEHOLDER
996						unless $alias;
997	0	0				push @columns, sprintf('%s AS %s',
998						$sqlQuery::PARAMETER_PLACEHOLDER,
999						sqlQuery::quoteTable($alias))
1000						if $alias;
1001	0					$self->addBoundArgs($field);
1002	0					next;
1003						}
1004
1005	0	0	0			$field = sqlQuery::quoteWhenTable($field)
1006						if '*' ne $field && 0 == ~index($field, ' ');
1007
1008	0	0				unless ($alias) {
1009	0					push @columns, $field
1010						} else {
1011	0	0				$alias = sqlQuery::quoteWhenTable($alias)
1012						unless ~index($alias, ' ');
1013	0					push @columns, "\n\t$field AS $alias";
1014						}
1015						}
1016						}
1017
1018						@columns
1019	0					}
1020
1021						sub _assemble
1022						{
1023	0			0		my $self = shift;
1024	0					my $s = 'SELECT';
1025
1026	0					$s .= ' ' . join(',', @{$self->{params}})
	0
1027	0	0				if @{$self->{params}};
1028	0					$s .= ' ' . join(',', @{$self->{queryFields}});
	0
1029
1030	0	0				if (defined($self->{tables})) {
1031	0					$s .= "\nFROM ";
1032	0					my @t;
1033
1034	0					foreach my $tableSpec (@{$self->{tables}}) {
	0
1035	0					my (@tables);
1036
1037	0	0				if ('HASH' eq ref $tableSpec) {
1038	0					@tables = %$tableSpec;
1039						} else {
1040	0					@tables = ($tableSpec,undef);
1041						}
1042
1043	0					while (@tables) {
1044	0					my ($table,$alias) = splice(@tables, 0, 2);
1045
1046	0	0				push @t, sqlQuery::quoteTable($table)
1047						unless $alias;
1048	0	0				push @t, sqlQuery::quoteTable($table)." AS `$alias`"
1049						if $alias;
1050						}
1051						}
1052
1053	0					$s .= join ',', @t;
1054						}
1055
1056	0					return "$s\n";
1057						}
1058						##------------------------------------------------------------------------------
1059						package sqlSelectLimit;
1060
1061	1			1	5	use strict;
	1				1
	1				28
1062	1			1	3	use base 'sqlSelectAssemble';
	1				1
	1				409
1063
1064						sub new
1065						{
1066	0			0		sqlSelectAssemble::new(@_, 'sqlSelectOrderBy',
1067						limit => undef,
1068						offset => undef);
1069						}
1070
1071						sub limit
1072						{
1073	0			0		my $self = shift;
1074
1075	0	0	0			if (!@_ \|\| (1 == @_ && !defined($_[0])) \|\| (2 == @_ && !defined($_[0]) && !defined($_[1]))) {
			0
			0
			0
			0
1076	0					$self->{limit} = undef;
1077						} else {
1078	0					$self->{limit} = int(shift());
1079	0	0				$self->{offset} = int(shift()) if @_;
1080						}
1081	0					sqlSelectAssemble->new($self);
1082						}
1083
1084						sub _assemble
1085						{
1086	0			0		my $self = shift;
1087	0					my $s;
1088
1089	0	0				unless (defined($self->{limit})) {
		0
1090	0					$s = '';
1091						} elsif (defined($self->{offset})) {
1092	0					$s = "LIMIT $self->{offset},$self->{limit}";
1093						} else {
1094	0					$s = "LIMIT $self->{limit}";
1095						}
1096
1097	0					$s
1098						}
1099						##------------------------------------------------------------------------------
1100						package sqlSelectOrderBy;
1101
1102	1			1	5	use strict;
	1				1
	1				34
1103	1			1	5	use base 'sqlSelectLimit';
	1				2
	1				473
1104
1105						sub new
1106						{
1107	0			0		sqlSelectAssemble::new(@_, 'sqlSelectHaving', ordering => undef);
1108						}
1109
1110						sub orderBy
1111						{
1112	0			0		my $self = shift;
1113	0					$self->{ordering} = [@_];
1114	0					sqlSelectLimit->new($self);
1115						}
1116
1117						sub _assemble
1118						{
1119	0			0		my $self = shift;
1120	0					my $s;
1121
1122	0	0				unless(defined($self->{ordering})) {
1123	0					$s = '';
1124						} else {
1125	0					$s = [];
1126
1127	0					foreach my $order (@{$self->{ordering}}) {
	0
1128	0					my ($theOrder,$direction) = ($order);
1129	0	0				if ('HASH' eq ref $theOrder) {
1130	0					($direction) = values %$theOrder;
1131	0					($theOrder) = keys %$theOrder;
1132						}
1133
1134	0	0				push @$s, sqlQuery::quoteWhenTable($theOrder)
1135						unless $direction;
1136	0	0				push @$s, sqlQuery::quoteWhenTable($theOrder)." $direction"
1137						if $direction;
1138						}
1139
1140	0					$s = join ',', @$s;
1141	0					$s = "ORDER BY $s\n";
1142						}
1143
1144	0					$s . $self->SUPER::_assemble();
1145						}
1146						##------------------------------------------------------------------------------
1147						package sqlSelectHaving;
1148
1149	1			1	5	use strict;
	1				1
	1				31
1150	1			1	3	use base 'sqlSelectOrderBy';
	1				1
	1				414
1151
1152						sub new
1153						{
1154	0			0		sqlSelectAssemble::new(@_, 'sqlSelectGroupBy', havingCond => undef);
1155						}
1156
1157						sub having
1158						{
1159	0			0		my $self = shift;
1160	0					my $condition = shift;
1161
1162	0	0	0			die 'Invalid condition'
1163						unless ref $condition && $condition->isa('sqlCondition');
1164
1165	0					$self->{havingCond} = $condition;
1166	0					sqlSelectOrderBy->new($self);
1167						}
1168
1169						sub gatherConditionArgs
1170						{
1171	0			0		my $self = shift;
1172	0					my @args;
1173
1174	0	0				push @args, $self->{havingCond}->getBoundArgs()
1175						if $self->{havingCond};
1176						@args
1177	0					}
1178
1179						sub _assemble
1180						{
1181	0			0		my $self = shift;
1182	0					my $s;
1183
1184	0	0	0			unless (defined($self->{havingCond}) && defined($s = $self->{havingCond}->assemble())) {
1185	0					$s = '';
1186						} else {
1187	0					$s = "HAVING $s\n";
1188						}
1189
1190	0					$s . $self->SUPER::_assemble();
1191						}
1192						##------------------------------------------------------------------------------
1193						package sqlSelectGroupBy;
1194
1195	1			1	4	use strict;
	1				1
	1				27
1196	1			1	3	use base 'sqlSelectHaving';
	1				1
	1				308
1197	1			1	4	use overload '+' => 'union';
	1				1
	1				4
1198
1199						sub union
1200						{
1201	0			0		my ($left,$right) = @_;
1202
1203	0					"($left) UNION ($right)";
1204						}
1205
1206						sub new
1207						{
1208	0			0		sqlSelectAssemble::new(@_, 'sqlSelectWhere', grouping => undef);
1209						}
1210
1211						sub groupBy
1212						{
1213	0			0		my $self = shift;
1214	0					$self->{grouping} = [@_];
1215	0					sqlSelectHaving->new($self);
1216						}
1217
1218						sub _assemble
1219						{
1220	0			0		my $self = shift;
1221	0					my $s = '';
1222
1223	0	0				if (defined($self->{grouping}))
1224						{
1225	0					$s = join ',', map {sqlQuery::quoteWhenTable($_)} @{$self->{grouping}};
	0
	0
1226	0					$s = "GROUP BY $s\n";
1227						}
1228
1229	0					$s . $self->SUPER::_assemble();
1230						}
1231						##------------------------------------------------------------------------------
1232						package sqlSelectWhere;
1233
1234	1			1	205	use strict;
	1				1
	1				24
1235	1			1	6	use base 'sqlSelectGroupBy';
	1				1
	1				386
1236
1237						sub where
1238						{
1239	0			0		my $self = shift;
1240	0					my $condition = shift;
1241
1242	0	0	0			die 'Invalid condition'
1243						unless ref $condition && $condition->isa('sqlCondition');
1244
1245	0					$self->{whereCond} = $condition;
1246	0					sqlSelectGroupBy->new($self);
1247						}
1248
1249						sub gatherConditionArgs
1250						{
1251	0			0		my $self = shift;
1252	0					my @args;
1253
1254	0	0				push @args, $self->{whereCond}->getBoundArgs()
1255						if $self->{whereCond};
1256						@args
1257	0					}
1258
1259						sub _assemble
1260						{
1261	0			0		my $self = shift;
1262	0					my ($s,$c) = ('');
1263
1264	0	0	0			if ($self->{whereCond} && defined($c = $self->{whereCond}->assemble()))
1265						{
1266	0					$s = "WHERE $c\n";
1267						}
1268	0					$s . $self->SUPER::_assemble();
1269						}
1270						##------------------------------------------------------------------------------
1271						package sqlSelectJoin;
1272
1273	1			1	4	use strict;
	1				1
	1				24
1274	1			1	3	use base 'sqlSelectWhere';
	1				0
	1				308
1275
1276	1			1	5	use Carp qw(confess);
	1				1
	1				422
1277
1278						sub new
1279						{
1280	0			0		sqlSelectAssemble::new(@_, 'sqlSelectFrom', joins => []);
1281						}
1282
1283						sub gatherConditionArgs
1284						{
1285	0			0		my $self = shift;
1286	0					my (@args);
1287
1288	0	0				if ($self->isa('sqlSelectJoin')) {
1289	0					foreach my $join (@{$self->{joins}}) {
	0
1290	0					my ($type,$table,$condition) = @$join;
1291	0	0				push @args, $condition->getBoundArgs()
1292						if ref $condition;
1293						}
1294						}
1295
1296	0					(@args, $self->SUPER::gatherConditionArgs())
1297						}
1298
1299	0			0		sub innerJoin {shift->_addJoin('INNER', @_)}
1300	0			0		sub rightJoin {shift->_addJoin('RIGHT', @_)}
1301	0			0		sub leftJoin {shift->_addJoin('LEFT', @_)}
1302
1303						sub _addJoin
1304						{
1305	0			0		my $self = shift;
1306	0					my ($type,$table,$condition) = @_;
1307	0					push @{$self->{joins}}, [$type, $table, $condition];
	0
1308
1309	0					$self
1310						}
1311
1312						sub _assemble
1313						{
1314	0			0		my $self = shift;
1315	0					my $s;
1316
1317	0	0				unless ($self->isa('sqlSelectJoin')) {
1318	0					$s = ref $self;
1319						} else {
1320	0					$s = [];
1321
1322	0					foreach my $join (@{$self->{joins}}) {
	0
1323	0					my ($type, $table, $condition) = @$join;
1324	0					$table = sqlQuery::quoteTable($table);
1325	0					my $j = "$type JOIN $table ";
1326
1327	0	0				unless (ref $condition) {
		0
1328	0					$j .= "USING(`$condition`)";
1329						} elsif ($condition->isa('sqlCondition')) {
1330	0					$_ = $condition->assemble();
1331	0					$j .= "ON($_)";
1332						} else {
1333	0					confess sprintf('Cannot use argument "%s" as join condition', $condition);
1334						}
1335
1336	0					push @$s, "$j\n";
1337						}
1338
1339	0					$s = join '', @$s;
1340						}
1341
1342	0					$s . $self->SUPER::_assemble();
1343						}
1344						##------------------------------------------------------------------------------
1345						package sqlCondition;
1346
1347	1			1	4	use strict;
	1				1
	1				26
1348	1			1	4	use warnings;
	1				1
	1				22
1349	1			1	3	use feature 'switch';
	1				4
	1				101
1350						use overload
1351	1				4	'""' => 'assemble',
1352	1			1	4	'+' => 'overloadAdd';
	1				1
1353	1			1	51	use constant TYPE_DEFAULT => 1;
	1				1
	1				63
1354	1			1	5	use constant TYPE_CONNECT_AND => 2;
	1				1
	1				31
1355	1			1	4	use constant TYPE_CONNECT_OR => 3;
	1				1
	1				31
1356	1			1	4	use constant TYPE_UNARY_NOT => 4;
	1				1
	1				57
1357
1358	1			1	7	use Carp qw(confess);
	1				1
	1				46
1359	1			1	5	use Params::Validate qw(:all);
	1				1
	1				2046
1360
1361						sub new
1362						{
1363	0	0		0		my $class = ref $_[0] ? ref shift : shift;
1364	0					my $self = bless{
1365						parent => undef,
1366						type => shift,
1367						_parts => undef,
1368						_condition => undef,
1369						_alterForNull => undef,
1370						_argument => undef,
1371						_queryArguments => []
1372						}, $class;
1373
1374	0	0				if (TYPE_UNARY_NOT == $self->{type})
1375						{
1376	0					$self->{_argument} = shift;
1377	0	0	0			die 'Invalid argument' unless
1378						ref $self->{_argument} && $self->{_argument}->isa('sqlCondition');
1379	0					$self->{_argument}->setParent($self);
1380						}
1381
1382						$self
1383	0					}
1384
1385						sub assemble
1386						{
1387	0			0		my $self = shift;
1388
1389	0					given($self->{type}) {
1390
1391	0					when([TYPE_CONNECT_AND, TYPE_CONNECT_OR]) {
1392	0	0				return undef unless $self->{_parts};
1393	0	0				my ($glue) = (TYPE_CONNECT_AND == $self->{type} ? ' AND ' : ' OR ');
1394	0					return '('.join($glue, map {$_->assemble()} @{$self->{_parts}}).')';
	0
	0
1395						}
1396
1397	0					when([TYPE_DEFAULT]) {
1398	0	0	0			return $self->{_condition}
1399						unless ref $self->{_condition} && $self->{_condition}->isa('sqlCondition');
1400	0					return $self->{_condition}->assemble();
1401						}
1402
1403	0					when([TYPE_UNARY_NOT]) {
1404	0					$_ = $self->{_argument}->assemble();
1405	0					return "NOT($_)";
1406						}
1407						}
1408						}
1409
1410						sub overloadAdd
1411						{
1412	0			0		my ($left,$right,$leftConstant) = @_;
1413
1414	0	0				warn "sqlCondition + sqlCondition will modify the left operand"
1415						if defined $leftConstant;
1416	0					$left->add($right);
1417						}
1418
1419						sub add
1420						{
1421	0			0		my $self = shift;
1422	0	0				$self->{_parts} = [] unless $self->{_parts};
1423
1424	0					push @{$self->{_parts}}, @_;
	0
1425	0					$_->setParent($self) foreach @_;
1426
1427	0					$self
1428						}
1429
1430						sub addSql
1431						{
1432	0			0		my $self = shift;
1433	0					my $format = shift;
1434
1435	0					$self->add(C(sprintf($format, @_)));
1436						}
1437
1438						sub bind
1439						{
1440	0			0		my $self = shift;
1441
1442	0	0	0			if (1 == scalar @_ && !defined($_[0]) && defined($self->{_alterForNull})) {
			0
1443	0					($self->{_condition}) = split(' ', $self->{_condition}, 2);
1444	0	0				$self->{_condition} .= ' IS '.($self->{_alterForNull} ? '' : 'NOT ').'NULL';
1445	0					return $self;
1446						}
1447
1448						$self->_bind(sqlQuery::convertArgument($_))
1449	0					foreach (@_);
1450	0					$self
1451						}
1452
1453						sub getBoundArgs
1454						{
1455	0			0		@{shift->{_queryArguments}};
	0
1456						}
1457
1458						sub releaseBoundArgs
1459						{
1460	0			0		my $self = shift;
1461	0					my @args = $self->getBoundArgs();
1462	0					$self->{_queryArguments} = [];
1463	0					@args;
1464						}
1465
1466	0			0		sub _OR {goto &OR}
1467						sub OR
1468						{
1469	0	0		0		confess 'OR() expects at least 1 parameter.' unless @_;
1470	0					connectedList(TYPE_CONNECT_OR, @_);
1471						}
1472
1473	0			0		sub _AND {goto &AND}
1474						sub AND
1475						{
1476	0	0		0		confess 'AND() expects at least 1 parameter.' unless @_;
1477	0					connectedList(TYPE_CONNECT_AND, @_);
1478						}
1479
1480						sub NOT
1481						{
1482	0			0		sqlCondition->new(TYPE_UNARY_NOT, @_);
1483						}
1484
1485						sub C
1486						{
1487	0			0		my $cond = sqlCondition->new(TYPE_DEFAULT);
1488
1489	0	0				if (1 == scalar @_) {
1490	0					$cond->{_condition} = shift;
1491						} else {
1492	0					$cond->{_condition} = sprintf($_[0], @_[1..$#_]);
1493						}
1494
1495	0					$cond
1496						}
1497
1498						sub IN
1499						{
1500	0			0		my $column = shift;
1501	0					C("%s IN($sqlQuery::PARAMETER_PLACEHOLDER)", sqlQuery::quoteWhenTable($column));
1502						}
1503
1504						sub LIKE
1505						{
1506	0			0		my ($column,$pattern) = validate_pos @_,
1507						{column => {type => SCALAR}},
1508						{pattern => {type => SCALAR}};
1509
1510	0					$pattern =~ s/"/""/g;
1511	0					$column = sqlQuery::quoteWhenTable($column);
1512	0					C("$column LIKE \"$pattern\"");
1513						}
1514
1515						sub BETWEEN
1516						{
1517	0			0		my ($column,$start,$end) = validate_pos @_,
1518						{column => {type => SCALAR}},
1519						{start => {isa => 'sqlParameter'}},
1520						{end => {isa => 'sqlParameter'}};
1521	0					$column = sqlQuery::quoteWhenTable($column);
1522
1523	0					C("$column BETWEEN $sqlQuery::PARAMETER_PLACEHOLDER AND $sqlQuery::PARAMETER_PLACEHOLDER")
1524						->bind($start)->bind($end);
1525						}
1526
1527						sub ISNULL
1528						{
1529	0			0		my ($column) = validate_pos @_,
1530						{column => {type => SCALAR}};
1531	0					$column = sqlQuery::quoteWhenTable($column);
1532
1533	0					C("$column IS NULL")
1534						}
1535
1536						sub ISNOTNULL
1537						{
1538	0			0		my ($column) = validate_pos @_,
1539						{column => {type => SCALAR}};
1540	0					$column = sqlQuery::quoteWhenTable($column);
1541
1542	0					C("$column IS NOT NULL")
1543						}
1544
1545						sub EQ
1546						{
1547	0			0		my $cond = _OP('=', @_);
1548	0					$cond->{_alterForNull} = 1;
1549	0					$cond
1550						}
1551
1552						sub NE
1553						{
1554	0			0		my $cond = _OP('!=', @_);
1555	0					$cond->{_alterForNull} = 0;
1556	0					$cond
1557						}
1558
1559	0			0		sub LT {_OP('<', @_)}
1560	0			0		sub GT {_OP('>', @_)}
1561	0			0		sub LTE {_OP('<=', @_)}
1562	0			0		sub GTE {_OP('>=', @_)}
1563
1564						sub _OP
1565						{
1566	0			0		my ($operator, $left, $right) = @_;
1567	0	0				C('%s %s %s',
1568						sqlQuery::quoteWhenTable($left),
1569						$operator,
1570						3 != scalar @_
1571						? $sqlQuery::PARAMETER_PLACEHOLDER
1572						: sqlQuery::quoteWhenTable($right));
1573						}
1574
1575						sub connectedList
1576						{
1577	0			0		my $type = shift;
1578	0					my $cond = sqlCondition->new($type);
1579
1580	0					$cond->insert($_) foreach @_;
1581	0					$cond
1582						}
1583
1584						sub insert
1585						{
1586	0			0		my $self = shift;
1587
1588	0	0				$self->{_parts} = [] unless $self->{_parts};
1589	0					$self->add(@_);
1590						}
1591
1592						sub _bind
1593						{
1594	0			0		my $self = shift;
1595	0					my ($parameter) = validate_pos @_,
1596						{parameter => {isa => 'sqlParameter'}};
1597
1598	0	0				push @{$self->{_queryArguments}}, $parameter
	0
1599						unless $self->{parent};
1600	0	0				$self->{parent}->up()->_bind($parameter)
1601						if $self->{parent};
1602	0					$self
1603						}
1604
1605						sub setParent
1606						{
1607	0			0		my $self = shift;
1608	0					my ($parent) = validate_pos @_,
1609						{parameter => {isa => 'sqlCondition'}};
1610
1611	0					$self->{parent} = $parent;
1612	0					$self->{parent}->up()->_bind($_)
1613	0					foreach @{$self->{_queryArguments}};
1614	0					$self->{_queryArguments} = [];
1615	0					$self
1616						}
1617
1618						sub up
1619						{
1620	0			0		my $self = shift;
1621
1622	0	0				return $self
1623						unless defined($self->{parent});
1624	0					$self->{parent}->up();
1625						}
1626
1627						1