1package Alzabo::SQLMaker;
2
3use strict;
4use vars qw($VERSION $AUTOLOAD);
5
6use Alzabo::Exceptions;
7use Alzabo::Utils;
8
9use Class::Factory::Util;
10use Params::Validate qw( :all );
11Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
12
13$VERSION = 2.0;
14
151;
16
17sub make_function
18{
19    my $class = caller;
20
21    my %p =
22	validate( @_,
23		  { function => { type => SCALAR },
24		    min => { type => SCALAR, optional => 1 },
25		    max => { type => UNDEF | SCALAR, optional => 1 },
26		    groups => { type => ARRAYREF },
27		    quote => { type => ARRAYREF, optional => 1 },
28		    format => { type => SCALAR, optional => 1 },
29		    is_modifier => { type => SCALAR, default => 0 },
30		    has_spaces => { type => SCALAR, default => 0 },
31		    allows_alias => { type => SCALAR, default => 1 },
32		    no_parens => { type => SCALAR, default => 0 },
33		  } );
34
35    my $valid = '';
36    if ( $p{min} || $p{max} )
37    {
38	$valid .= 'validate_pos( @_, ';
39	$valid .= join ', ', ('1') x $p{min};
40    }
41
42    if ( defined $p{min} && defined $p{max} && $p{max} > $p{min} )
43    {
44	$valid .= ', ';
45	$valid .= join ', ', ('0') x ( $p{max} - $p{min} );
46    }
47    elsif ( exists $p{min} && ! defined $p{max} )
48    {
49	$valid .= ", ('1') x (\@_ - $p{min})";
50    }
51    $valid .= ' );' if $valid;
52
53    my @args = "function => '$p{function}'";
54
55    if ( ! defined $p{max} || $p{max} > 0 )
56    {
57	push @args, '                                      args => [@_]';
58    }
59
60    if ( $p{format} )
61    {
62	push @args, "                                      format => '$p{format}'";
63    }
64
65    if ( $p{quote} )
66    {
67	my $quote .= '                                     quote => [';
68	$quote .= join ', ', @{ $p{quote} };
69	$quote .= ']';
70	push @args, $quote;
71    }
72
73    for my $k ( qw( is_modifier has_spaces allows_alias no_parens ) )
74    {
75        if ( $p{$k} )
76        {
77            push @args, "                                      $k => 1";
78        }
79    }
80
81    my $args = join ",\n", @args;
82
83    my $code = <<"EOF";
84sub ${class}::$p{function}
85{
86    shift if defined \$_[0] && Alzabo::Utils::safe_isa( \$_[0], 'Alzabo::SQLMaker' );
87    $valid
88    return Alzabo::SQLMaker::Function->new( $args );
89}
90EOF
91
92    eval $code;
93
94    {
95	no strict 'refs';
96	push @{ "$class\::EXPORT_OK" }, $p{function};
97	my $exp = \%{ "$class\::EXPORT_TAGS" };
98	foreach ( @{ $p{groups} } )
99	{
100	    push @{ $exp->{$_}  }, $p{function};
101	}
102	push @{ $exp->{all} }, $p{function};
103    }
104}
105
106sub load
107{
108    shift;
109    my %p = @_;
110
111    my $class = "Alzabo::SQLMaker::$p{rdbms}";
112    eval "use $class";
113    Alzabo::Exception::Eval->throw( error => $@ ) if $@;
114
115    $class->init(@_);
116
117    return $class;
118}
119
120sub available { __PACKAGE__->subclasses }
121
122sub init
123{
124    1;
125}
126
127use constant NEW_SPEC => { driver => { isa => 'Alzabo::Driver' },
128                           quote_identifiers  => { type => BOOLEAN,
129                                                   default => 0 },
130                         };
131
132sub new
133{
134    my $class = shift;
135    my %p = validate( @_, NEW_SPEC );
136
137    return bless { last_op => undef,
138		   expect => undef,
139		   type => undef,
140		   sql => '',
141		   bind => [],
142		   placeholders => [],
143		   as_id => 'aaaaa10000',
144                   alias_in_having => 1,
145                   %p,
146		 }, $class;
147}
148
149# this just needs to be some unique thing that won't ever look like a
150# valid bound parameter
151my $placeholder = do { my $x = 1; bless \$x, 'Alzabo::SQLMaker::Placeholder' };
152sub placeholder { $placeholder }
153
154sub last_op
155{
156    return shift->{last_op};
157}
158
159sub select
160{
161    my $self = shift;
162
163    Alzabo::Exception::Params->throw( error => "The select method requires at least one parameter" )
164	unless @_;
165
166    $self->{sql} .= 'SELECT ';
167
168    if ( lc $_[0] eq 'distinct' )
169    {
170	$self->{sql} .= ' DISTINCT ';
171	shift;
172    }
173
174    my @sql;
175    foreach my $elt (@_)
176    {
177	if ( Alzabo::Utils::safe_can( $elt, 'table' ) )
178	{
179            my $table = $elt->table;
180
181	    $self->{column_tables}{"$table"} = 1;
182
183            my $sql =
184                ( $self->{quote_identifiers} ?
185                  $self->{driver}->quote_identifier
186                      ( $table->alias_name, $elt->name ) :
187                  $table->alias_name . '.' . $elt->name );
188
189            $sql .= ' AS ' .
190                ( $self->{quote_identifiers} ?
191                  $self->{driver}->quote_identifier( $elt->alias_name ) :
192                  $elt->alias_name );
193
194	    push @sql, $sql;
195	}
196	elsif ( Alzabo::Utils::safe_can( $elt, 'columns' ) )
197	{
198	    $self->{column_tables}{"$elt"} = 1;
199
200            my @cols;
201
202            foreach my $col ( $elt->columns )
203            {
204                my $sql =
205                    ( $self->{quote_identifiers} ?
206                      $self->{driver}->quote_identifier
207                      ( $elt->alias_name, $col->name ) :
208                      $elt->alias_name . '.' . $col->name );
209
210                $sql .= ' AS ' .
211                    ( $self->{quote_identifiers} ?
212                      $self->{driver}->quote_identifier( $elt->alias_name ) :
213                      $elt->alias_name );
214
215                push @cols, $sql;
216            }
217
218	    push @sql, join ', ', @cols;
219	}
220	elsif ( Alzabo::Utils::safe_isa( $elt, 'Alzabo::SQLMaker::Function' ) )
221	{
222	    my $string = $elt->as_string( $self->{driver}, $self->{quote_identifiers} );
223
224	    if ( $elt->allows_alias )
225	    {
226		push @sql, " $string AS " . $self->{as_id};
227		$self->{functions}{$string} = $self->{as_id};
228		++$self->{as_id};
229	    }
230	    else
231	    {
232		push @sql, $string;
233	    }
234	}
235	elsif ( ! ref $elt )
236	{
237	    push @sql, $elt;
238	}
239	else
240	{
241	    Alzabo::Exception::SQL->throw
242                    ( error => 'Arguments to select must be either column objects,' .
243                               ' table objects, function objects, or plain scalars' );
244	}
245    }
246
247    $self->{sql} .= join ', ', @sql;
248
249    $self->{type} = 'select';
250    $self->{last_op} = 'select';
251
252    return $self;
253}
254
255sub from
256{
257    my $self = shift;
258
259    $self->_assert_last_op( qw( select delete function ) );
260
261    my $spec =
262        $self->{last_op} eq 'select' ? { type => OBJECT | ARRAYREF } : { can => 'alias_name' };
263
264    validate_pos( @_, ( $spec ) x @_ );
265
266    $self->{sql} .= ' FROM ';
267
268    if ( $self->{last_op} eq 'delete' )
269    {
270	$self->{sql} .=
271	    join ', ', map { ( $self->{quote_identifiers} ?
272                               $self->{driver}->quote_identifier( $_->name ) :
273                               $_->name ) } @_;
274
275	$self->{tables} = { map { $_ => 1 } @_ };
276    }
277    else
278    {
279        my $sql;
280
281	$self->{tables} = {};
282
283        my @plain;
284	foreach my $elt (@_)
285	{
286	    if ( Alzabo::Utils::is_arrayref($elt) )
287	    {
288		$sql .= ' ' if $sql;
289
290                $sql .= $self->_outer_join(@$elt);
291	    }
292            else
293            {
294                push @plain, $elt;
295            }
296        }
297
298        foreach my $elt ( grep { ! exists $self->{tables}{$_ } } @plain )
299        {
300            $sql .= ', ' if $sql;
301
302            if ( $self->{quote_identifiers} )
303            {
304                $sql .=
305                    ( $self->{driver}->quote_identifier( $elt->name ) .
306                      ' AS ' .
307                      $self->{driver}->quote_identifier( $elt->alias_name ) );
308            }
309            else
310            {
311                $sql .= $elt->name . ' AS ' . $elt->alias_name;
312            }
313
314            $self->{tables}{$elt} = 1;
315	}
316
317        $self->{sql} .= $sql;
318    }
319
320    if ($self->{type} eq 'select')
321    {
322        foreach my $t ( keys %{ $self->{column_tables} } )
323        {
324	    unless ( $self->{tables}{$t} )
325	    {
326		my $err = 'Cannot select column ';
327		$err .= 'unless its table is included in the FROM clause';
328		Alzabo::Exception::SQL->throw( error => $err );
329	    }
330	}
331    }
332
333    $self->{last_op} = 'from';
334
335    return $self;
336}
337
338use constant _OUTER_JOIN_SPEC => ( { type => SCALAR },
339                                   ( { can => 'alias_name' } ) x 2,
340                                   { type => UNDEF | ARRAYREF | OBJECT, optional => 1 },
341                                   { type => UNDEF | ARRAYREF, optional => 1 },
342                                 );
343
344sub _outer_join
345{
346    my $self = shift;
347
348    my $tables = @_ - 1;
349    validate_pos( @_, _OUTER_JOIN_SPEC );
350
351    my $type = uc shift;
352
353    my $join_from = shift;
354    my $join_on = shift;
355    my $fk;
356    $fk = shift if $_[0] && Alzabo::Utils::safe_isa( $_[0], 'Alzabo::ForeignKey' );
357    my $where = shift;
358
359    unless ($fk)
360    {
361	my @fk = $join_from->foreign_keys_by_table($join_on);
362
363	Alzabo::Exception::Params->throw( error => "The " . $join_from->name . " table has no foreign keys to the " . $join_on->name . " table" )
364	    unless @fk;
365
366	Alzabo::Exception::Params->throw( error => "The " . $join_from->name . " table has more than 1 foreign key to the " . $join_on->name . " table" )
367	    if @fk > 1;
368
369	$fk = $fk[0];
370    }
371
372    my $sql;
373    unless ( $self->{tables}{$join_from} )
374    {
375        $sql .=
376            ( $self->{quote_identifiers} ?
377              $self->{driver}->quote_identifier( $join_from->name ) :
378              $join_from->name );
379
380        $sql .= ' AS ';
381        $sql .=
382            ( $self->{quote_identifiers} ?
383              $self->{driver}->quote_identifier( $join_from->alias_name ) :
384              $join_from->alias_name );
385    }
386
387    $sql .= " $type OUTER JOIN ";
388
389    $sql .= ( $self->{quote_identifiers} ?
390              $self->{driver}->quote_identifier( $join_on->name ) :
391              $join_on->name );
392
393    $sql .= ' AS ';
394
395    $sql .=
396        ( $self->{quote_identifiers} ?
397          $self->{driver}->quote_identifier( $join_on->alias_name ) :
398          $join_on->alias_name );
399
400    $sql .= ' ON ';
401
402    if ( $self->{quote_identifiers} )
403    {
404        $sql .=
405            ( join ' AND ',
406              map { $self->{driver}->quote_identifier
407                        ( $join_from->alias_name, $_->[0]->name ) .
408                    ' = ' .
409                    $self->{driver}->quote_identifier
410                        ( $join_on->alias_name, $_->[1]->name )
411                  } $fk->column_pairs );
412    }
413    else
414    {
415        $sql .=
416            ( join ' AND ',
417              map { $join_from->alias_name . '.' . $_->[0]->name .
418                    ' = ' .
419                    $join_on->alias_name . '.' .  $_->[1]->name
420                  } $fk->column_pairs );
421    }
422
423    @{ $self->{tables} }{ $join_from, $join_on } = (1, 1);
424
425    if ($where)
426    {
427        $sql .= ' AND ';
428
429        # make a clone
430        my $sql_maker = bless { %$self }, ref $self;
431        $sql_maker->{sql} = '';
432        # sharing same ref intentionally
433        $sql_maker->{bind} = $self->{bind};
434        $sql_maker->{tables} = $self->{tables};
435
436        # lie to Alzabo::Runtime::process_where_clause
437        $sql_maker->{last_op} = 'where';
438
439        Alzabo::Runtime::process_where_clause( $sql_maker, $where );
440
441        $sql .= $sql_maker->sql;
442
443        $sql .= ' ';
444
445        $self->{as_id} = $sql_maker->{as_id};
446    }
447
448    return $sql;
449}
450
451sub where
452{
453    my $self = shift;
454
455    $self->_assert_last_op( qw( from set ) );
456
457    $self->{sql} .= ' WHERE ';
458
459    $self->{last_op} = 'where';
460
461    $self->condition(@_) if @_;
462
463    return $self;
464}
465
466sub having
467{
468    my $self = shift;
469
470    $self->_assert_last_op( qw( group_by ) );
471
472    $self->{sql} .= ' HAVING ';
473
474    $self->{last_op} = 'having';
475
476    $self->condition(@_) if @_;
477
478    return $self;
479}
480
481sub and
482{
483    my $self = shift;
484
485    $self->_assert_last_op( qw( subgroup_end condition ) );
486
487    return $self->_and_or( 'and', @_ );
488}
489
490sub or
491{
492    my $self = shift;
493
494    $self->_assert_last_op( qw( subgroup_end condition ) );
495
496    return $self->_and_or( 'or', @_ );
497}
498
499sub _and_or
500{
501    my $self = shift;
502    my $op = shift;
503
504    $self->{sql} .= " \U$op ";
505
506    $self->{last_op} = $op;
507
508    $self->condition(@_) if @_;
509
510    return $self;
511}
512
513sub subgroup_start
514{
515    my $self = shift;
516
517    $self->_assert_last_op( qw( where having and or subgroup_start ) );
518
519    $self->{sql} .= ' (';
520    $self->{subgroup} ||= 0;
521    $self->{subgroup}++;
522
523    $self->{last_op} = 'subgroup_start';
524
525    return $self;
526}
527
528sub subgroup_end
529{
530    my $self = shift;
531
532    $self->_assert_last_op( qw( condition subgroup_end ) );
533
534    Alzabo::Exception::SQL->throw( error => "Can't end a subgroup unless one has been started already" )
535	unless $self->{subgroup};
536
537    $self->{sql} .= ' )';
538    $self->{subgroup}--;
539
540    $self->{last_op} = $self->{subgroup} ? 'subgroup_end' : 'condition';
541
542    return $self;
543}
544
545sub condition
546{
547    my $self = shift;
548
549    validate_pos( @_,
550		  { type => OBJECT },
551		  { type => SCALAR },
552		  { type => UNDEF | SCALAR | OBJECT },
553		  ( { type => UNDEF | SCALAR | OBJECT, optional => 1 } ) x (@_ - 3) );
554
555    my $lhs = shift;
556    my $comp = uc shift;
557    my $rhs = shift;
558
559    my $in_having = $self->{last_op} eq 'having' ? 1 : 0;
560
561    $self->{last_op} = 'condition';
562
563    if ( $lhs->can('table') && $lhs->can('name') )
564    {
565	unless ( $self->{tables}{ $lhs->table } )
566	{
567	    my $err = 'Cannot use column (';
568	    $err .= join '.', $lhs->table->name, $lhs->name;
569	    $err .= ") in $self->{type} unless its table is included in the ";
570	    $err .= $self->{type} eq 'update' ? 'UPDATE' : 'FROM';
571	    $err .= ' clause';
572	    Alzabo::Exception::SQL->throw( error => $err );
573	}
574
575	$self->{sql} .=
576	    ( $self->{quote_identifiers} ?
577              $self->{driver}->quote_identifier( $lhs->table->alias_name, $lhs->name ) :
578              $lhs->table->alias_name . '.' . $lhs->name );
579    }
580    elsif ( $lhs->isa('Alzabo::SQLMaker::Function') )
581    {
582	my $string = $lhs->as_string( $self->{driver}, $self->{quote_identifiers} );
583
584        if ( exists $self->{functions}{$string} &&
585             ( ! $in_having || $self->{alias_in_having} ) )
586        {
587            $self->{sql} .= $self->{functions}{$string};
588        }
589        else
590        {
591            $self->{sql} .= $string;
592        }
593    }
594    else
595    {
596        Alzabo::Exception::SQL->throw
597            ( error => "Cannot use " . (ref $lhs) . " object as part of condition" );
598    }
599
600    if ( $comp eq 'BETWEEN' )
601    {
602	Alzabo::Exception::SQL->throw
603	    ( error => "The BETWEEN comparison operator requires an additional argument" )
604		unless @_ == 1;
605
606	my $rhs2 = shift;
607
608	Alzabo::Exception::SQL->throw
609	    ( error => "The BETWEEN comparison operator cannot accept a subselect" )
610		if grep { Alzabo::Utils::safe_isa( $_, 'Alzabo::SQLMaker' ) } $rhs, $rhs2;
611
612	$self->{sql} .= ' BETWEEN ';
613	$self->{sql} .= $self->_rhs($rhs);
614	$self->{sql} .= " AND ";
615	$self->{sql} .= $self->_rhs($rhs2);
616
617	return;
618    }
619
620    if ( $comp eq 'IN' || $comp eq 'NOT IN' )
621    {
622	$self->{sql} .= " $comp (";
623
624	$self->{sql} .=
625	    join ', ', map { Alzabo::Utils::safe_isa( $_, 'Alzabo::SQLMaker' )
626			     ?  '(' . $self->_subselect($_) . ')'
627                             : $self->_rhs($_) } $rhs, @_;
628	$self->{sql} .= ')';
629
630	return;
631    }
632
633    Alzabo::Exception::Params->throw
634	( error => 'Too many parameters to Alzabo::SQLMaker->condition method' )
635	    if @_;
636
637    if ( ! ref $rhs && defined $rhs )
638    {
639	$self->{sql} .= " $comp ";
640	$self->{sql} .= $self->_rhs($rhs);
641    }
642    elsif ( ! defined $rhs )
643    {
644	if ( $comp eq '=' )
645	{
646	    $self->{sql} .= ' IS NULL';
647	}
648	elsif ( $comp eq '!=' || $comp eq '<>' )
649	{
650	    $self->{sql} .= ' IS NOT NULL';
651	}
652	else
653	{
654	    Alzabo::Exception::SQL->throw
655		( error => "Cannot compare a column to a NULL with '$comp'" );
656	}
657    }
658    elsif ( ref $rhs )
659    {
660	$self->{sql} .= " $comp ";
661	if( $rhs->isa('Alzabo::SQLMaker') )
662	{
663	    $self->{sql} .= '(';
664	    $self->{sql} .= $self->_subselect($rhs);
665	    $self->{sql} .= ')';
666	}
667	else
668	{
669	    $self->{sql} .= $self->_rhs($rhs);
670	}
671    }
672}
673
674sub _rhs
675{
676    my $self = shift;
677    my $rhs = shift;
678
679    if ( Alzabo::Utils::safe_can( $rhs, 'table' ) )
680    {
681	unless ( $self->{tables}{ $rhs->table } )
682	{
683	    my $err = 'Cannot use column (';
684	    $err .= join '.', $rhs->table->name, $rhs->name;
685	    $err .= ") in $self->{type} unless its table is included in the ";
686	    $err .= $self->{type} eq 'update' ? 'UPDATE' : 'FROM';
687	    $err .= ' clause';
688	    Alzabo::Exception::SQL->throw( error => $err );
689	}
690
691	return ( $self->{quote_identifiers} ?
692                 $self->{driver}->quote_identifier( $rhs->table->alias_name, $rhs->name ) :
693                 $rhs->table->alias_name . '.' . $rhs->name );
694    }
695    else
696    {
697	return $self->_bind_val($rhs);
698    }
699}
700
701sub _subselect
702{
703    my $self = shift;
704    my $sql = shift;
705
706    push @{ $self->{bind} }, @{ $sql->bind };
707
708    return $sql->sql;
709}
710
711sub order_by
712{
713    my $self = shift;
714
715    $self->_assert_last_op( qw( select from condition group_by ) );
716
717    Alzabo::Exception::SQL->throw
718	( error => "Cannot use order by in a '$self->{type}' statement" )
719	    unless $self->{type} eq 'select';
720
721    validate_pos( @_, ( { type => SCALAR | OBJECT,
722			  callbacks =>
723			  { 'column_or_function_or_sort' =>
724			    sub { Alzabo::Utils::safe_can( $_[0], 'table' ) ||
725				  Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' ) ||
726				  $_[0] =~ /^(?:ASC|DESC)$/i } } }
727		      ) x @_ );
728
729    $self->{sql} .= ' ORDER BY ';
730
731    my $x = 0;
732    my $last = '';
733    foreach my $i (@_)
734    {
735	if ( Alzabo::Utils::safe_can( $i, 'table' ) )
736	{
737	    unless ( $self->{tables}{ $i->table } )
738	    {
739		my $err = 'Cannot use column (';
740		$err .= join '.', $i->table->name, $i->name;
741		$err .= ") in $self->{type} unless its table is included in the FROM clause";
742		Alzabo::Exception::SQL->throw( error => $err );
743	    }
744
745	    # no comma needed for first column
746	    $self->{sql} .= ', ', if $x++;
747	    $self->{sql} .=
748		( $self->{quote_identifiers} ?
749                  $self->{driver}->quote_identifier( $i->table->alias_name, $i->alias_name ) :
750                  $i->table->alias_name . '.' . $i->alias_name );
751
752	    $last = 'column';
753	}
754	elsif ( Alzabo::Utils::safe_isa( $i, 'Alzabo::SQLMaker::Function' ) )
755	{
756	    my $string = $i->as_string( $self->{driver}, $self->{quote_identifiers} );
757	    if ( exists $self->{functions}{$string} )
758	    {
759		$self->{sql} .= ', ', if $x++;
760		$self->{sql} .= $self->{functions}{$string};
761	    }
762	    else
763	    {
764		$self->{sql} .= ', ', if $x++;
765		$self->{sql} .= $string;
766	    }
767
768            $last = 'function';
769	}
770	else
771	{
772	    Alzabo::Exception::Params->throw
773		( error => 'A sort specifier cannot follow another sort specifier in an ORDER BY clause' )
774		    if $last eq 'sort';
775
776	    $self->{sql} .= " \U$i";
777
778	    $last = 'sort';
779	}
780    }
781
782    $self->{last_op} = 'order_by';
783
784    return $self;
785}
786
787sub group_by
788{
789    my $self = shift;
790
791    $self->_assert_last_op( qw( select from condition ) );
792
793    Alzabo::Exception::SQL->throw
794	( error => "Cannot use group by in a '$self->{type}' statement" )
795	    unless $self->{type} eq 'select';
796
797    validate_pos( @_, ( { can => 'table' } ) x @_ );
798
799    foreach my $c (@_)
800    {
801	unless ( $self->{tables}{ $c->table } )
802	{
803	    my $err = 'Cannot use column (';
804	    $err .= join '.', $c->table->name, $c->name;
805	    $err .= ") in $self->{type} unless its table is included in the FROM clause";
806	    Alzabo::Exception::SQL->throw( error => $err );
807	}
808    }
809
810    $self->{sql} .= ' GROUP BY ';
811    $self->{sql} .=
812	( join ', ',
813	  map { ( $self->{quote_identifiers} ?
814                  $self->{driver}->quote_identifier( $_->table->alias_name, $_->alias_name ) :
815                  $_->table->alias_name . '.' . $_->alias_name ) }
816	  @_ );
817
818    $self->{last_op} = 'group_by';
819
820    return $self;
821}
822
823sub insert
824{
825    my $self = shift;
826
827    $self->{sql} .= 'INSERT ';
828
829    $self->{type} = 'insert';
830    $self->{last_op} = 'insert';
831
832    return $self;
833}
834
835sub into
836{
837    my $self = shift;
838
839    $self->_assert_last_op( qw( insert ) );
840
841    validate_pos( @_, { can => 'alias_name' }, ( { can => 'table' } ) x (@_ - 1) );
842
843    my $table = shift;
844    $self->{tables} = { $table => 1 };
845
846    foreach my $c (@_)
847    {
848	unless ( $c->table eq $table )
849	{
850	    my $err = 'Cannot into column (';
851	    $err .= join '.', $c->table->name, $c->name;
852	    $err .= ') because its table was not the one specified in the INTO clause';
853	    Alzabo::Exception::SQL->throw( error => $err );
854	}
855    }
856
857    $self->{columns} = [ @_ ? @_ : $table->columns ];
858
859    $self->{sql} .= 'INTO ';
860
861    $self->{sql} .= ( $self->{quote_identifiers} ?
862                      $self->{driver}->quote_identifier( $table->name ) :
863                      $table->name );
864
865    $self->{sql} .= ' (';
866
867    $self->{sql} .=
868	( join ', ',
869	  map { ( $self->{quote_identifiers} ?
870                  $self->{driver}->quote_identifier( $_->name ) :
871                  $_->name ) }
872	  @{ $self->{columns} } );
873
874    $self->{sql} .= ') ';
875
876    $self->{last_op} = 'into';
877
878    return $self;
879}
880
881sub values
882{
883    my $self = shift;
884
885    $self->_assert_last_op( qw( into ) );
886
887    validate_pos( @_, ( { type => UNDEF | SCALAR | OBJECT } ) x @_ );
888
889    if ( ref $_[0] && $_[0]->isa('Alzabo::SQLMaker') )
890    {
891	$self->{sql} = $_[0]->sql;
892	push @{ $self->{bind} }, $_[0]->bind;
893    }
894    else
895    {
896	my @vals = @_;
897
898	Alzabo::Exception::Params->throw
899	    ( error => "'values' method expects key/value pairs of column objects and values'" )
900		if !@vals || @vals % 2;
901
902	my %vals = map { ref $_ && $_->can('table') ? $_->name : $_ } @vals;
903	foreach my $c ( @vals[ map { $_ * 2 } 0 .. int($#vals/2) ] )
904	{
905	    Alzabo::Exception::SQL->throw
906		( error => $c->name . " column was not specified in the into method call" )
907		    unless grep { $c eq $_ } @{ $self->{columns} };
908	}
909
910	foreach my $c ( @{ $self->{columns } } )
911	{
912	    Alzabo::Exception::SQL->throw
913		( error => $c->name . " was specified in the into method call but no value was provided" )
914		    unless exists $vals{ $c->name };
915	}
916
917	$self->{sql} .= 'VALUES (';
918	$self->{sql} .=
919            join ', ', ( map { $self->_bind_val_for_insert( $_, $vals{ $_->name } ) }
920                         @{ $self->{columns} }
921                       );
922	$self->{sql} .= ')';
923    }
924
925    if ( @{ $self->{placeholders} } && @{ $self->{bind} } )
926    {
927        Alzabo::Exception::SQL->throw
928	    ( error => "Cannot mix actual bound values and placeholders in call to values()" );
929    }
930
931    $self->{last_op} = 'values';
932
933    return $self;
934}
935
936use constant UPDATE_SPEC => { can => 'alias_name' };
937
938sub update
939{
940    my $self = shift;
941
942    validate_pos( @_, UPDATE_SPEC );
943
944    my $table = shift;
945
946    $self->{sql} = 'UPDATE ';
947
948    $self->{sql} .= ( $self->{quote_identifiers} ?
949                      $self->{driver}->quote_identifier( $table->name ) :
950                      $table->name );
951
952    $self->{tables} = { $table => 1 };
953
954    $self->{type} = 'update';
955    $self->{last_op} = 'update';
956
957    return $self;
958}
959
960sub set
961{
962    my $self = shift;
963    my @vals = @_;
964
965    $self->_assert_last_op('update');
966
967    Alzabo::Exception::Params->throw
968	( error => "'set' method expects key/value pairs of column objects and values'" )
969	    if !@vals || @vals % 2;
970
971    validate_pos( @_, ( { can => 'table' },
972			{ type => UNDEF | SCALAR | OBJECT } ) x (@vals / 2) );
973
974    $self->{sql} .= ' SET ';
975
976    my @set;
977    my $table = ( keys %{ $self->{tables} } )[0];
978    while ( my ($col, $val) = splice @vals, 0, 2 )
979    {
980	unless ( $table eq $col->table )
981	{
982	    my $err = 'Cannot set column (';
983	    $err .= join '.', $col->table->name, $col->name;
984	    $err .= ') unless its table is included in the UPDATE clause';
985	    Alzabo::Exception::SQL->throw( error => $err );
986	}
987
988	push @set,
989	    ( $self->{quote_identifiers} ?
990              $self->{driver}->quote_identifier( $col->name ) :
991              $col->name ) .
992            ' = ' . $self->_bind_val($val);
993    }
994    $self->{sql} .= join ', ', @set;
995
996    $self->{last_op} = 'set';
997
998    return $self;
999}
1000
1001sub delete
1002{
1003    my $self = shift;
1004
1005    $self->{sql} .= 'DELETE ';
1006
1007    $self->{type} = 'delete';
1008    $self->{last_op} = 'delete';
1009
1010    return $self;
1011}
1012
1013sub _assert_last_op
1014{
1015    my $self = shift;
1016
1017    unless ( grep { $self->{last_op} eq $_ } @_ )
1018    {
1019	my $op = (caller(1))[3];
1020	$op =~ s/.*::(.*?)$/$1/;
1021	Alzabo::Exception::SQL->throw( error => "Cannot follow $self->{last_op} with $op" );
1022    }
1023}
1024
1025use constant _BIND_VAL_FOR_INSERT_SPEC => ( { isa => 'Alzabo::Runtime::Column' },
1026                                            { type => UNDEF | SCALAR | OBJECT }
1027                                          );
1028
1029
1030sub _bind_val_for_insert
1031{
1032    my $self = shift;
1033
1034    my ( $col, $val ) =
1035        validate_pos( @_, _BIND_VAL_FOR_INSERT_SPEC );
1036
1037    if ( defined $val && $val eq $placeholder )
1038    {
1039        push @{ $self->{placeholders} }, $col->name;
1040        return '?';
1041    }
1042    else
1043    {
1044        return $self->_bind_val($val);
1045    }
1046}
1047
1048use constant _BIND_VAL_SPEC => { type => UNDEF | SCALAR | OBJECT };
1049
1050sub _bind_val
1051{
1052    my $self = shift;
1053
1054    validate_pos( @_, _BIND_VAL_SPEC );
1055
1056    return $_[0]->as_string( $self->{driver}, $self->{quote_identifiers} )
1057        if Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' );
1058
1059    push @{ $self->{bind} }, $_[0];
1060    return '?';
1061}
1062
1063sub sql
1064{
1065    my $self = shift;
1066
1067    Alzabo::Exception::SQL->throw( error => "SQL contains unbalanced parentheses subgrouping: $self->{sql}" )
1068	if $self->{subgroup};
1069
1070    return $self->{sql};
1071}
1072
1073sub bind
1074{
1075    my $self = shift;
1076    return $self->{bind};
1077}
1078
1079sub placeholders
1080{
1081    my $self = shift;
1082
1083    my $x = 0;
1084
1085    return map { $_ => $x++ } @{ $self->{placeholders} };
1086}
1087
1088sub limit
1089{
1090    shift()->_virtual;
1091}
1092
1093sub get_limit
1094{
1095    shift()->_virtual;
1096}
1097
1098sub sqlmaker_id
1099{
1100    shift()->_virtual;
1101}
1102
1103sub distinct_requires_order_by_in_select { 0 }
1104
1105sub _virtual
1106{
1107    my $self = shift;
1108
1109    my $sub = (caller(1))[3];
1110    $sub =~ s/.*::(.*?)$/$1/;
1111    Alzabo::Exception::VirtualMethod->throw( error =>
1112					     "$sub is a virtual method and must be subclassed in " . ref $self );
1113}
1114
1115sub debug
1116{
1117    my $self = shift;
1118    my $fh = shift;
1119
1120    print $fh '-' x 75 . "\n";
1121    print $fh "SQL\n - " . $self->sql . "\n";
1122    print $fh "Bound values\n";
1123
1124    foreach my $b ( @{ $self->bind } )
1125    {
1126        my $out = $b;
1127
1128        if ( defined $out )
1129        {
1130            if ( length $out > 75 )
1131            {
1132                $out = substr( $out, 0, 71 ) . ' ...';
1133            }
1134        }
1135        else
1136        {
1137            $out = 'NULL';
1138        }
1139
1140        print $fh " - [$out]\n";
1141    }
1142}
1143
1144package Alzabo::SQLMaker::Function;
1145
1146use Params::Validate qw( :all );
1147Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
1148
1149sub new
1150{
1151    my $class = shift;
1152    my %p = @_;
1153
1154    $p{args} = [] unless defined $p{args};
1155    $p{quote} ||= [];
1156
1157    return bless \%p, $class;
1158}
1159
1160sub allows_alias { shift->{allows_alias} }
1161
1162sub as_string
1163{
1164    my $self = shift;
1165    my $driver = shift;
1166    my $quote = shift;
1167
1168    my @args;
1169    foreach ( 0..$#{ $self->{args} } )
1170    {
1171	if ( Alzabo::Utils::safe_can( $self->{args}[$_], 'table' ) )
1172	{
1173	    push @args,
1174		( $quote ?
1175                  $driver->quote_identifier( $self->{args}[$_]->table->alias_name,
1176                                             $self->{args}[$_]->name ) :
1177                  $self->{args}[$_]->table->alias_name . '.' .
1178                  $self->{args}[$_]->name );
1179	    next;
1180	}
1181	elsif ( Alzabo::Utils::safe_isa( $self->{args}[$_], 'Alzabo::SQLMaker::Function' ) )
1182	{
1183	    push @args, $self->{args}[$_]->as_string( $driver, $quote );
1184	    next;
1185	}
1186
1187	# if there are more args than specified in the quote param
1188	# then this function must allow an unlimited number of
1189	# arguments, in which case the last value in the quote param
1190	# is the value that should be used for all of the extra
1191	# arguments.
1192	my $i = $_ > $#{ $self->{quote} } ? -1 : $_;
1193	push @args,
1194            $self->{quote}[$i] ? $driver->quote( $self->{args}[$_] ) : $self->{args}[$_];
1195    }
1196
1197    my $sql = $self->{function};
1198    $sql =~ s/_/ /g if $self->{has_spaces};
1199
1200    return $sql if $self->{is_modifier};
1201
1202    $sql .= '('
1203        unless $self->{no_parens};
1204
1205    if ( $self->{format} )
1206    {
1207	$sql .= sprintf( $self->{format}, @args );
1208    }
1209    else
1210    {
1211	$sql .= join ', ', @args;
1212    }
1213
1214    $sql .= ')'
1215        unless $self->{no_parens};
1216
1217    return $sql;
1218}
1219
1220__END__
1221
1222=head1 NAME
1223
1224Alzabo::SQLMaker - Alzabo base class for RDBMS drivers
1225
1226=head1 SYNOPSIS
1227
1228  use Alzabo::SQLMaker::MySQL;
1229
1230  my $sql = Alzabo::SQLMaker::MySQL->new( driver => $driver_object );
1231
1232  # or better yet
1233
1234  my $sql = $runtime_schema->sqlmaker;
1235
1236=head1 DESCRIPTION
1237
1238This is the base class for all Alzabo::SQLMaker modules.  To
1239instantiate a driver call this class's C<new> method.  See
1240L<SUBCLASSING Alzabo::SQLMaker> for information on how to make a
1241driver for the RDBMS of your choice.
1242
1243=head1 METHODS
1244
1245=head2 available
1246
1247Returns A list of names representing the available C<Alzabo::SQLMaker>
1248subclasses.  Any one of these names would be appropriate as a
1249parameter for the L<C<< Alzabo::SQLMaker->load() >>|"load"> method.
1250
1251=head2 load
1252
1253Load the specified subclass.
1254
1255This takes one parameter, the name of the RDBMS being used.
1256
1257Throws: L<C<Alzabo::Exception::Eval>|Alzabo::Exceptions>
1258
1259=head2 new
1260
1261This takes two parameters:
1262
1263=over 4
1264
1265=item * driver
1266
1267The driver object being used by the schema.
1268
1269=item * quote_identifiers
1270
1271A boolean value indicating whether or not identifiers should be
1272quoted.  This defaults to false.
1273
1274=back
1275
1276=head1 GENERATING SQL
1277
1278This class can be used to generate SQL by calling methods that are the
1279same as those used in SQL (C<select()>, C<update()>, etc.) in
1280sequence, with the appropriate parameters.
1281
1282There are four entry point methods, L<C<select()>|"select
1283(Alzabo::Table and/or Alzabo::Column objects)">,
1284L<C<insert()>|"insert">, L<C<update()>|"update (Alzabo::Table)">, and
1285L<C<delete()>|"delete">.  Attempting to call any other method without
1286first calling one of these is an error.
1287
1288=head2 Entry Points
1289
1290These methods are called as class methods and return a new object.
1291
1292=head2 select (C<Alzabo::Table> and/or C<Alzabo::Column> objects)
1293
1294This begins a select.  The columns to be selected are the column(s)
1295passed in, and/or the columns of the table(s) passed in as arguments.
1296
1297Followed by:
1298
1299=over 4
1300
1301L<C<from()>|"from (Alzabo::Table object, ...)">
1302
1303L<C<** function>|"** function (Alzabo::Table object(s) and/or $string(s))">
1304
1305=back
1306
1307=head2 insert
1308
1309Followed by:
1310
1311=over 4
1312
1313L<C<into()>|"into (Alzabo::Table object, optional Alzabo::Column objects)">
1314
1315=back
1316
1317=head2 update (C<Alzabo::Table>)
1318
1319Followed by:
1320
1321=over 4
1322
1323L<C<set()>|"set (Alzabo::Column object =E<gt> $value, ...)">
1324
1325=back
1326
1327=head2 delete
1328
1329Followed by:
1330
1331=over 4
1332
1333L<C<from()>|"from (Alzabo::Table object, ...)">
1334
1335=back
1336
1337=head2 Other Methods
1338
1339All of these methods return the object itself, making it possible to
1340chain together method calls such as:
1341
1342 Alzabo::SQLMaker->select($column)->from($table)->where($other_column, '>', 2);
1343
1344=head2 from (C<Alzabo::Table> object, ...)
1345
1346The table(s) from which we are selecting data.
1347
1348Follows:
1349
1350=over 4
1351
1352L<C<select()>|"select (Alzabo::Table and/or Alzabo::Column objects)">
1353
1354L<C<** function>|"** function (Alzabo::Table object(s) and/or $string(s))">
1355
1356L<C<delete()>|"delete">
1357
1358=back
1359
1360Followed by:
1361
1362=over 4
1363
1364L<C<where()>|"where <see below>">
1365
1366L<C<order_by()>|"order_by (Alzabo::Column objects)">
1367
1368=back
1369
1370Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1371
1372=head2 where <see below>
1373
1374The first parameter to where must be an C<Alzabo::Column> object or
1375SQL function.  The second is a comparison operator of some sort, given
1376as a string.  The third argument can be an C<Alzabo::Column> object, a
1377value (a number or string), or an C<Alzabo::SQLMaker> object.  The
1378latter is treated as a subselect.
1379
1380Values given as parameters will be properly quoted and escaped.
1381
1382Some comparison operators allow additional parameters.
1383
1384The C<BETWEEN> comparison operator requires a fourth argument.  This
1385must be either an C<Alzabo::Column> object or a value.
1386
1387The C<IN> and <NOT IN> operators allow any number of additional
1388parameters, which may be C<Alzabo::Column> objects, values, or
1389C<Alzabo::SQLMaker> objects.
1390
1391Follows:
1392
1393=over 4
1394
1395L<C<from()>|"from (Alzabo::Table object, ...)">
1396
1397=back
1398
1399Followed by:
1400
1401=over 4
1402
1403L<C<and()>|"and (same as where)">
1404
1405L<C<or()>|"or (same as where)">
1406
1407L<C<order_by()>|"order_by (Alzabo::Column objects)">
1408
1409=back
1410
1411Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1412
1413=head2 and (same as C<where>)
1414
1415=head2 or (same as C<where>)
1416
1417These methods take the same parameters as the L<C<where()>|"where <see
1418below>"> method.
1419
1420Follows:
1421
1422=over 4
1423
1424L<C<where()>|"where <see below>">
1425
1426L<C<and()>|"and (same as where)">
1427
1428L<C<or()>|"or (same as where)">
1429
1430=back
1431
1432Followed by:
1433
1434=over 4
1435
1436L<C<and()>|"and (same as where)">
1437
1438L<C<or()>|"or (same as where)">
1439
1440L<C<order_by()>|"order_by (Alzabo::Column objects)">
1441
1442=back
1443
1444Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1445
1446=head2 order_by (C<Alzabo::Column> objects)
1447
1448Adds an C<ORDER BY> clause to your SQL.
1449
1450Follows:
1451
1452=over 4
1453
1454L<C<from()>|"from (Alzabo::Table object, ...)">
1455
1456L<C<where()>|"where <see below>">
1457
1458L<C<and()>|"and (same as where)">
1459
1460L<C<or()>|"or (same as where)">
1461
1462=back
1463
1464Followed by:
1465
1466=over 4
1467
1468L<C<limit()>|"limit ($max, optional $offset)">
1469
1470=back
1471
1472Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1473
1474=head2 limit ($max, optional $offset)
1475
1476Specifies a limit on the number of rows to be returned.  The offset
1477parameter is optional.
1478
1479Follows:
1480
1481=over 4
1482
1483L<C<from()>|"from (Alzabo::Table object, ...)">
1484
1485L<C<where()>|"where <see below>">
1486
1487L<C<and()>|"and (same as where)">
1488
1489L<C<or()>|"or (same as where)">
1490
1491L<C<order_by()>|"order_by (Alzabo::Column objects)">
1492
1493=back
1494
1495=over 4
1496
1497L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1498
1499=back
1500
1501=head2 into (C<Alzabo::Table> object, optional C<Alzabo::Column> objects)
1502
1503Used to specify what table an insert is into.  If column objects are
1504given then it is expected that values will only be given for that
1505object.  Otherwise, it assumed that all columns will be specified in
1506the L<C<values()>|"values (Alzabo::Column object =E<gt> $value, ...)">
1507method.
1508
1509Follows:
1510
1511=over 4
1512
1513L<C<insert()>|"insert">
1514
1515=back
1516
1517Followed by:
1518
1519=over 4
1520
1521L<C<values()>|"values (Alzabo::Column object =E<gt> $value, ...)">
1522
1523=back
1524
1525Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1526
1527=head2 values (C<Alzabo::Column> object => $value, ...)
1528
1529This method expects to recive an structured like a hash where the keys
1530are C<Alzabo::Column> objects and the values are the value to be
1531inserted into that column.
1532
1533Follows:
1534
1535=over 4
1536
1537L<C<into()>|"into (Alzabo::Table object, optional Alzabo::Column objects)">
1538
1539=back
1540
1541Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1542
1543=head2 set (C<Alzabo::Column> object => $value, ...)
1544
1545This method'a parameter are exactly like those given to the
1546L<C<values>|values ( Alzabo::Column object =E<gt> $value, ... )>
1547method.
1548
1549Follows:
1550
1551=over 4
1552
1553L<C<update()>|"update (Alzabo::Table)">
1554
1555=back
1556
1557Followed by:
1558
1559=over 4
1560
1561L<C<where()>|"where <see below>">
1562
1563=back
1564
1565Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
1566
1567=head1 RETRIEVING SQL FROM THE OBJECT
1568
1569=head2 sql
1570
1571This method can be called at any time, though obviously it will not
1572return valid SQL unless called at a natural end point.  In the future,
1573an exception may be thrown if called when the SQL is not in a valid
1574state.
1575
1576Returns the SQL generated so far as a string.
1577
1578=head2 bind
1579
1580Returns an array reference containing the parameters to be bound to
1581the SQL statement.
1582
1583=head1 SUBCLASSING Alzabo::SQLMaker
1584
1585To create a subclass of C<Alzabo::SQLMaker> for your particular RDBMS
1586requires only that the L<virtual methods|"Virtual Methods"> listed
1587below be implemented.
1588
1589In addition, you may choose to override any of the other methods
1590described in this documentation.  For example, the MySQL subclass
1591override the L<C<_subselect()>|"_subselect"> method because MySQL
1592cannot support sub-selects.
1593
1594Subclasses are also expected to offer for export various sets of
1595functions matching SQL functions.  See the C<Alzabo::SQLMaker::MySQL>
1596subclass implementation for details.
1597
1598=head1 VIRTUAL METHODS
1599
1600The following methods must be implemented by the subclass:
1601
1602=head2 limit
1603
1604See above for the definition of this method.
1605
1606=head2 get_limit
1607
1608This method may return C<undef> even if the L<C<limit()>|"limit ($max,
1609optional $offset)"> method was called.  Some RDBMS's have special SQL
1610syntax for C<LIMIT> clauses.  For those that don't support this, the
1611L<C<Alzabo::Driver>|Alzabo::Driver> module takes a "limit" parameter.
1612
1613The return value of this method can be passed in as that parameter.
1614
1615If the RDBMS does not support C<LIMIT> clauses, the return value is an
1616array reference containing two values, the maximum number of rows
1617allowed and the row offset (the first row that should be used).
1618
1619If the RDBMS does support C<LIMIT> clauses, then the return value is
1620C<undef>.
1621
1622=head2 sqlmaker_id
1623
1624Returns the subclass's name.  This should be something that can be
1625passed to C<< Alzabo::SQLMaker->load() >> as a parameter.
1626
1627=head1 AUTHOR
1628
1629Dave Rolsky, <dave@urth.org>
1630
1631=cut
1632