1package SQL::Maker; 2use strict; 3use warnings; 4use 5.008001; 5our $VERSION = '1.21'; 6use Class::Accessor::Lite 0.05 ( 7 ro => [qw/quote_char name_sep new_line strict driver select_class/], 8); 9 10use Carp (); 11use SQL::Maker::Select; 12use SQL::Maker::Select::Oracle; 13use SQL::Maker::Condition; 14use SQL::Maker::Util; 15use Module::Load (); 16use Scalar::Util (); 17 18sub load_plugin { 19 my ($class, $role) = @_; 20 $role = $role =~ s/^\+// ? $role : "SQL::Maker::Plugin::$role"; 21 Module::Load::load($role); 22 23 no strict 'refs'; 24 for (@{"${role}::EXPORT"}) { 25 *{"${class}::$_"} = *{"${role}::$_"}; 26 } 27} 28 29sub new { 30 my $class = shift; 31 my %args = @_ == 1 ? %{$_[0]} : @_; 32 unless ($args{driver}) { 33 Carp::croak("'driver' is required for creating new instance of $class"); 34 } 35 my $driver = $args{driver}; 36 unless ( defined $args{quote_char} ) { 37 $args{quote_char} = do{ 38 if ($driver eq 'mysql') { 39 q{`} 40 } else { 41 q{"} 42 } 43 }; 44 } 45 $args{select_class} = $driver eq 'Oracle' ? 'SQL::Maker::Select::Oracle' : 'SQL::Maker::Select'; 46 47 return bless { 48 name_sep => '.', 49 new_line => "\n", 50 strict => 0, 51 %args 52 }, $class; 53} 54 55sub new_condition { 56 my $self = shift; 57 58 SQL::Maker::Condition->new( 59 quote_char => $self->{quote_char}, 60 name_sep => $self->{name_sep}, 61 strict => $self->{strict}, 62 ); 63} 64 65sub new_select { 66 my $self = shift; 67 my %args = @_==1 ? %{$_[0]} : @_; 68 69 return $self->select_class->new( 70 name_sep => $self->name_sep, 71 quote_char => $self->quote_char, 72 new_line => $self->new_line, 73 strict => $self->strict, 74 %args, 75 ); 76} 77 78# $builder->insert($table, \%values, \%opt); 79# $builder->insert($table, \@values, \%opt); 80sub insert { 81 my ($self, $table, $values, $opt) = @_; 82 my $prefix = $opt->{prefix} || 'INSERT INTO'; 83 84 my $quoted_table = $self->_quote($table); 85 86 my (@columns, @bind_columns, @quoted_columns, @values); 87 @values = ref $values eq 'HASH' ? %$values : @$values; 88 while (my ($col, $val) = splice(@values, 0, 2)) { 89 push @quoted_columns, $self->_quote($col); 90 if (Scalar::Util::blessed($val)) { 91 if ($val->can('as_sql')) { 92 push @columns, $val->as_sql(undef, sub { $self->_quote($_[0]) }); 93 push @bind_columns, $val->bind(); 94 } else { 95 push @columns, '?'; 96 push @bind_columns, $val; 97 } 98 } else { 99 Carp::croak("cannot pass in an unblessed ref as an argument in strict mode") 100 if ref($val) && $self->strict; 101 if (ref($val) eq 'SCALAR') { 102 # $builder->insert(foo => { created_on => \"NOW()" }); 103 push @columns, $$val; 104 } 105 elsif (ref($val) eq 'REF' && ref($$val) eq 'ARRAY') { 106 # $builder->insert( foo => \[ 'UNIX_TIMESTAMP(?)', '2011-04-12 00:34:12' ] ); 107 my ( $stmt, @sub_bind ) = @{$$val}; 108 push @columns, $stmt; 109 push @bind_columns, @sub_bind; 110 } 111 else { 112 # normal values 113 push @columns, '?'; 114 push @bind_columns, $val; 115 } 116 } 117 } 118 119 # Insert an empty record in SQLite. 120 # ref. https://github.com/tokuhirom/SQL-Maker/issues/11 121 if ($self->driver eq 'SQLite' && @columns==0) { 122 my $sql = "$prefix $quoted_table" . $self->new_line . 'DEFAULT VALUES'; 123 return ($sql); 124 } 125 126 my $sql = "$prefix $quoted_table" . $self->new_line; 127 $sql .= '(' . join(', ', @quoted_columns) .')' . $self->new_line . 128 'VALUES (' . join(', ', @columns) . ')'; 129 130 return ($sql, @bind_columns); 131} 132 133sub _quote { 134 my ($self, $label) = @_; 135 136 SQL::Maker::Util::quote_identifier($label, $self->quote_char(), $self->name_sep()); 137} 138 139sub delete { 140 my ($self, $table, $where, $opt) = @_; 141 142 my $w = $self->_make_where_clause($where); 143 my $quoted_table = $self->_quote($table); 144 my $sql = "DELETE FROM $quoted_table"; 145 if ($opt->{using}) { 146 # $bulder->delete('foo', \%where, { using => 'bar' }); 147 # $bulder->delete('foo', \%where, { using => ['bar', 'qux'] }); 148 my $tables = ref($opt->{using}) eq 'ARRAY' ? $opt->{using} : [$opt->{using}]; 149 my $using = join(', ', map { $self->_quote($_) } @$tables); 150 $sql .= " USING " . $using; 151 } 152 $sql .= $w->[0]; 153 return ($sql, @{$w->[1]}); 154} 155 156sub update { 157 my ($self, $table, $args, $where) = @_; 158 159 my ($columns, $bind_columns) = $self->make_set_clause($args); 160 161 my $w = $self->_make_where_clause($where); 162 push @$bind_columns, @{$w->[1]}; 163 164 my $quoted_table = $self->_quote($table); 165 my $sql = "UPDATE $quoted_table SET " . join(', ', @$columns) . $w->[0]; 166 return ($sql, @$bind_columns); 167} 168 169# make "SET" clause. 170sub make_set_clause { 171 my ($self, $args) = @_; 172 173 my (@columns, @bind_columns); 174 my @args = ref $args eq 'HASH' ? %$args : @$args; 175 while (my ($col, $val) = splice @args, 0, 2) { 176 my $quoted_col = $self->_quote($col); 177 if (Scalar::Util::blessed($val)) { 178 if ($val->can('as_sql')) { 179 push @columns, "$quoted_col = " . $val->as_sql(undef, sub { $self->_quote($_[0]) }); 180 push @bind_columns, $val->bind(); 181 } else { 182 push @columns, "$quoted_col = ?"; 183 push @bind_columns, $val; 184 } 185 } else { 186 Carp::croak("cannot pass in an unblessed ref as an argument in strict mode") 187 if ref($val) && $self->strict; 188 if (ref $val eq 'SCALAR') { 189 # $builder->update(foo => { created_on => \"NOW()" }); 190 push @columns, "$quoted_col = " . $$val; 191 } 192 elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY' ) { 193 # $builder->update( foo => \[ 'VALUES(foo) + ?', 10 ] ); 194 my ( $stmt, @sub_bind ) = @{$$val}; 195 push @columns, "$quoted_col = " . $stmt; 196 push @bind_columns, @sub_bind; 197 } 198 else { 199 # normal values 200 push @columns, "$quoted_col = ?"; 201 push @bind_columns, $val; 202 } 203 } 204 } 205 return (\@columns, \@bind_columns); 206} 207 208sub where { 209 my ($self, $where) = @_; 210 my $cond = $self->_make_where_condition($where); 211 return ($cond->as_sql(undef, sub { $self->_quote($_[0]) }), $cond->bind()); 212} 213 214sub _make_where_condition { 215 my ($self, $where) = @_; 216 217 return $self->new_condition unless $where; 218 if ( Scalar::Util::blessed( $where ) and $where->can('as_sql') ) { 219 return $where; 220 } 221 222 my $w = $self->new_condition; 223 my @w = ref $where eq 'ARRAY' ? @$where : %$where; 224 while (my ($col, $val) = splice @w, 0, 2) { 225 $w->add($col => $val); 226 } 227 return $w; 228} 229 230sub _make_where_clause { 231 my ($self, $where) = @_; 232 233 return ['', []] unless $where; 234 235 my $w = $self->_make_where_condition($where); 236 my $sql = $w->as_sql(undef, sub { $self->_quote($_[0]) }); 237 return [$sql ? " WHERE $sql" : '', [$w->bind]]; 238} 239 240# my($stmt, @bind) = $sql−>select($table, \@fields, \%where, \%opt); 241sub select { 242 my $stmt = shift->select_query(@_); 243 return ($stmt->as_sql,@{$stmt->bind}); 244} 245 246sub select_query { 247 my ($self, $table, $fields, $where, $opt) = @_; 248 249 unless (ref $fields eq 'ARRAY') { 250 Carp::croak("SQL::Maker::select_query: \$fields should be ArrayRef[Str]"); 251 } 252 253 my $stmt = $self->new_select; 254 for my $field (@$fields) { 255 $stmt->add_select(ref $field eq 'ARRAY' ? @$field : $field); 256 } 257 258 if ( defined $table ) { 259 unless ( ref $table ) { 260 # $table = 'foo' 261 $stmt->add_from( $table ); 262 } 263 else { 264 # $table = [ 'foo', [ bar => 'b' ] ] 265 for ( @$table ) { 266 $stmt->add_from( ref $_ eq 'ARRAY' ? @$_ : $_ ); 267 } 268 } 269 } 270 271 $stmt->prefix($opt->{prefix}) if $opt->{prefix}; 272 273 if ( $where ) { 274 $stmt->set_where($self->_make_where_condition($where)); 275 } 276 277 if ( my $joins = $opt->{joins} ) { 278 for my $join ( @$joins ) { 279 $stmt->add_join(ref $join eq 'ARRAY' ? @$join : $join); 280 } 281 } 282 283 if (my $o = $opt->{order_by}) { 284 if (ref $o eq 'ARRAY') { 285 for my $order (@$o) { 286 if (ref $order eq 'HASH') { 287 # Skinny-ish [{foo => 'DESC'}, {bar => 'ASC'}] 288 $stmt->add_order_by(%$order); 289 } else { 290 # just ['foo DESC', 'bar ASC'] 291 $stmt->add_order_by(\$order); 292 } 293 } 294 } elsif (ref $o eq 'HASH') { 295 # Skinny-ish {foo => 'DESC'} 296 $stmt->add_order_by(%$o); 297 } else { 298 # just 'foo DESC, bar ASC' 299 $stmt->add_order_by(\$o); 300 } 301 } 302 if (my $o = $opt->{group_by}) { 303 if (ref $o eq 'ARRAY') { 304 for my $group (@$o) { 305 if (ref $group eq 'HASH') { 306 # Skinny-ish [{foo => 'DESC'}, {bar => 'ASC'}] 307 $stmt->add_group_by(%$group); 308 } else { 309 # just ['foo DESC', 'bar ASC'] 310 $stmt->add_group_by(\$group); 311 } 312 } 313 } elsif (ref $o eq 'HASH') { 314 # Skinny-ish {foo => 'DESC'} 315 $stmt->add_group_by(%$o); 316 } else { 317 # just 'foo DESC, bar ASC' 318 $stmt->add_group_by(\$o); 319 } 320 } 321 if (my $o = $opt->{index_hint}) { 322 $stmt->add_index_hint($table, $o); 323 } 324 325 $stmt->limit( $opt->{limit} ) if defined $opt->{limit}; 326 $stmt->offset( $opt->{offset} ) if $opt->{offset}; 327 328 if (my $terms = $opt->{having}) { 329 while (my ($col, $val) = each %$terms) { 330 $stmt->add_having($col => $val); 331 } 332 } 333 334 $stmt->for_update(1) if $opt->{for_update}; 335 return $stmt; 336} 337 3381; 339__END__ 340 341=encoding utf8 342 343=for test_synopsis 344my ($table, @fields, %where, %opt, %values, %set, $sql, @binds, @set); 345 346=head1 NAME 347 348SQL::Maker - Yet another SQL builder 349 350=head1 SYNOPSIS 351 352 use SQL::Maker; 353 354 my $builder = SQL::Maker->new( 355 driver => 'SQLite', # or your favorite driver 356 ); 357 358 # SELECT 359 ($sql, @binds) = $builder->select($table, \@fields, \%where, \%opt); 360 361 # INSERT 362 ($sql, @binds) = $builder->insert($table, \%values, \%opt); 363 364 # DELETE 365 ($sql, @binds) = $builder->delete($table, \%where, \%opt); 366 367 # UPDATE 368 ($sql, @binds) = $builder->update($table, \%set, \%where); 369 ($sql, @binds) = $builder->update($table, \@set, \%where); 370 371=head1 DESCRIPTION 372 373SQL::Maker is yet another SQL builder class. It is based on L<DBIx::Skinny>'s SQL generator. 374 375=head1 METHODS 376 377=over 4 378 379=item C<< my $builder = SQL::Maker->new(%args); >> 380 381Create new instance of SQL::Maker. 382 383Attributes are the following: 384 385=over 4 386 387=item driver: Str 388 389Driver name is required. The driver type is needed to create SQL string. 390 391=item quote_char: Str 392 393This is the character that a table or column name will be quoted with. 394 395Default: auto detect from $driver. 396 397=item name_sep: Str 398 399This is the character that separates a table and column name. 400 401Default: '.' 402 403=item new_line: Str 404 405This is the character that separates a part of statements. 406 407Default: '\n' 408 409=item strict: Bool 410 411Whether or not the use of unblessed references are prohibited for defining the SQL expressions. 412 413In strict mode, all the expressions must be declared by using blessed references that export C<as_sql> and C<bind> methods like L<SQL::QueryMaker>. 414See L</STRICT MODE> for detail. 415 416Default: undef 417 418=back 419 420=item C<< my $select = $builder->new_select(%args|\%args); >> 421 422Create new instance of L<SQL::Maker::Select> using the settings from B<$builder>. 423 424This method returns an instance of L<SQL::Maker::Select>. 425 426=item C<< my ($sql, @binds) = $builder->select($table|\@tables, \@fields, \%where|\@where|$where, \%opt); >> 427 428 my ($sql, @binds) = $builder->select('user', ['*'], {name => 'john'}, {order_by => 'user_id DESC'}); 429 # => 430 # SELECT * FROM `user` WHERE (`name` = ?) ORDER BY user_id DESC 431 # ['john'] 432 433This method returns the SQL string and bind variables for a SELECT statement. 434 435=over 4 436 437=item C<< $table >> 438 439=item C<< \@tables >> 440 441Table name for the B<FROM> clause as scalar or arrayref. You can specify the instance of B<SQL::Maker::Select> for a sub-query. 442 443If you are using C<< $opt->{joins} >> this should be I<< undef >> since it's passed via the first join. 444 445=item C<< \@fields >> 446 447This is a list for retrieving fields from database. 448 449Each element of the C<@fields> is normally a scalar or a scalar ref containing the column name. 450If you want to specify an alias of the field, you can use an arrayref containing a pair 451of column and alias names (e.g. C<< ['foo.id' => 'foo_id'] >>). 452 453=item C<< \%where >> 454 455=item C<< \@where >> 456 457=item C<< $where >> 458 459where clause from hashref or arrayref via L<SQL::Maker::Condition>, or L<SQL::Maker::Condition> object, or L<SQL::QueryMaker> object. 460 461=item C<< \%opt >> 462 463These are the options for the SELECT statement 464 465=over 4 466 467=item C<< $opt->{prefix} >> 468 469This is a prefix for the SELECT statement. 470 471For example, you can provide the 'SELECT SQL_CALC_FOUND_ROWS '. It's useful for MySQL. 472 473Default Value: 'SELECT ' 474 475=item C<< $opt->{limit} >> 476 477This option adds a 'LIMIT $n' clause. 478 479=item C<< $opt->{offset} >> 480 481This option adds an 'OFFSET $n' clause. 482 483=item C<< $opt->{order_by} >> 484 485This option adds an B<ORDER BY> clause 486 487You can write it in any of the following forms: 488 489 $builder->select(..., {order_by => 'foo DESC, bar ASC'}); 490 $builder->select(..., {order_by => ['foo DESC', 'bar ASC']}); 491 $builder->select(..., {order_by => {foo => 'DESC'}}); 492 $builder->select(..., {order_by => [{foo => 'DESC'}, {bar => 'ASC'}]}); 493 494=item C<< $opt->{group_by} >> 495 496This option adds a B<GROUP BY> clause 497 498You can write it in any of the following forms: 499 500 $builder->select(..., {group_by => 'foo DESC, bar ASC'}); 501 $builder->select(..., {group_by => ['foo DESC', 'bar ASC']}); 502 $builder->select(..., {group_by => {foo => 'DESC'}}); 503 $builder->select(..., {group_by => [{foo => 'DESC'}, {bar => 'ASC'}]}); 504 505=item C<< $opt->{having} >> 506 507This option adds a HAVING clause 508 509=item C<< $opt->{for_update} >> 510 511This option adds a 'FOR UPDATE" clause. 512 513=item C<< $opt->{joins} >> 514 515This option adds a 'JOIN' via L<SQL::Maker::Select>. 516 517You can write it as follows: 518 519 $builder->select(undef, ..., {joins => [[user => {table => 'group', condition => 'user.gid = group.gid'}], ...]}); 520 521=item C<< $opt->{index_hint} >> 522 523This option adds an INDEX HINT like as 'USE INDEX' clause for MySQL via L<SQL::Maker::Select>. 524 525You can write it as follows: 526 527 $builder->select(..., { index_hint => 'foo' }); 528 $builder->select(..., { index_hint => ['foo', 'bar'] }); 529 $builder->select(..., { index_hint => { list => 'foo' }); 530 $builder->select(..., { index_hint => { type => 'FORCE', list => ['foo', 'bar'] }); 531 532=back 533 534=back 535 536=item C<< my ($sql, @binds) = $builder->insert($table, \%values|\@values, \%opt); >> 537 538 my ($sql, @binds) = $builder->insert(user => {name => 'john'}); 539 # => 540 # INSERT INTO `user` (`name`) VALUES (?) 541 # ['john'] 542 543Generate an INSERT query. 544 545=over 4 546 547=item C<< $table >> 548 549Table name in scalar. 550 551=item C<< \%values >> 552 553These are the values for the INSERT statement. 554 555=item C<< \%opt >> 556 557These are the options for the INSERT statement 558 559=over 4 560 561=item C<< $opt->{prefix} >> 562 563This is a prefix for the INSERT statement. 564 565For example, you can provide 'INSERT IGNORE INTO' for MySQL. 566 567Default Value: 'INSERT INTO' 568 569=back 570 571=back 572 573=item C<< my ($sql, @binds) = $builder->delete($table, \%where|\@where|$where, \%opt); >> 574 575 my ($sql, @binds) = $builder->delete($table, \%where); 576 # => 577 # DELETE FROM `user` WHERE (`name` = ?) 578 # ['john'] 579 580Generate a DELETE query. 581 582=over 4 583 584=item C<< $table >> 585 586Table name in scalar. 587 588=item C<< \%where >> 589 590=item C<< \@where >> 591 592=item C<< $where >> 593 594where clause from hashref or arrayref via L<SQL::Maker::Condition>, or L<SQL::Maker::Condition> object, or L<SQL::QueryMaker> object. 595 596=item C<< \%opt >> 597 598These are the options for the DELETE statement 599 600=over 4 601 602=item C<< $opt->{using} >> 603 604This option adds a USING clause. It takes a scalar or an arrayref of table names as argument: 605 606 my ($sql, $binds) = $bulder->delete($table, \%where, { using => 'group' }); 607 # => 608 # DELETE FROM `user` USING `group` WHERE (`group`.`name` = ?) 609 # ['doe'] 610 $bulder->delete(..., { using => ['bar', 'qux'] }); 611 612=back 613 614=back 615 616=item C<< my ($sql, @binds) = $builder->update($table, \%set|@set, \%where|\@where|$where); >> 617 618Generate a UPDATE query. 619 620 my ($sql, @binds) = $builder->update('user', ['name' => 'john', email => 'john@example.com'], {user_id => 3}); 621 # => 622 # 'UPDATE `user` SET `name` = ?, `email` = ? WHERE (`user_id` = ?)' 623 # ['john','john@example.com',3] 624 625=over 4 626 627=item $table 628 629Table name in scalar. 630 631=item \%set 632 633Setting values. 634 635=item \%where 636 637=item \@where 638 639=item $where 640 641where clause from a hashref or arrayref via L<SQL::Maker::Condition>, or L<SQL::Maker::Condition> object, or L<SQL::QueryMaker> object. 642 643=back 644 645=item C<< $builder->new_condition() >> 646 647Create new L<SQL::Maker::Condition> object from C< $builder > settings. 648 649=item C<< my ($sql, @binds) = $builder->where(\%where) >> 650 651=item C<< my ($sql, @binds) = $builder->where(\@where) >> 652 653=item C<< my ($sql, @binds) = $builder->where(\@where) >> 654 655Where clause from a hashref or arrayref via L<SQL::Maker::Condition>, or L<SQL::Maker::Condition> object, or L<SQL::QueryMaker> object. 656 657=back 658 659=head1 PLUGINS 660 661SQL::Maker features a plugin system. Write the code as follows: 662 663 package My::SQL::Maker; 664 use parent qw/SQL::Maker/; 665 __PACKAGE__->load_plugin('InsertMulti'); 666 667=head1 STRICT MODE 668 669See L<http://blog.kazuhooku.com/2014/07/the-json-sql-injection-vulnerability.html> for why 670do we need the strict mode in the first place. 671 672In strict mode, the following parameters must be blessed references implementing C<as_sql> and C<bind> methods 673if they are NOT simple scalars (i.e. if they are references of any kind). 674 675=over 676 677=item * 678 679Values in C<$where> parameter for C<select>, C<update>, C<delete> methods. 680 681=item * 682 683Values in C<%values> and C<%set> parameter for C<insert> and C<update> methods, respectively. 684 685=back 686 687You can use L<SQL::QueryMaker> objects for those parameters. 688 689Example: 690 691 use SQL::QueryMaker qw(sql_in sql_raw); 692 693 ## NG: Use array-ref for values. 694 $maker->select("user", ['*'], { name => ["John", "Tom"] }); 695 696 ## OK: Use SQL::QueryMaker 697 $maker->select("user", ['*'], { name => sql_in(["John", "Tom"]) }); 698 699 ## Also OK: $where parameter itself is a blessed object. 700 $maker->select("user", ['*'], $maker->new_condition->add(name => sql_in(["John", "Tom"]))); 701 $maker->select("user", ['*'], sql_in(name => ["John", "Tom"])); 702 703 704 ## NG: Use scalar-ref for a raw value. 705 $maker->insert(user => [ name => "John", created_on => \"datetime(now)" ]); 706 707 ## OK: Use SQL::QueryMaker 708 $maker->insert(user => [name => "John", created_on => sql_raw("datetime(now)")]); 709 710 711=head1 FAQ 712 713=over 4 714 715=item Why don't you use SQL::Abstract? 716 717I need a more extensible one. 718 719So, this module contains L<SQL::Maker::Select>, the extensible B<SELECT> clause object. 720 721=back 722 723=head1 AUTHOR 724 725Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt> 726 727=head1 SEE ALSO 728 729L<SQL::Abstract> 730L<SQL::QueryMaker> 731 732The whole code was taken from L<DBIx::Skinny> by nekokak++. 733 734=head1 LICENSE 735 736Copyright (C) Tokuhiro Matsuno 737 738This library is free software; you can redistribute it and/or modify 739it under the same terms as Perl itself. 740 741=cut 742