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