SQL-Tiny-0.04/000755 000766 000024 00000000000 13452267674 013134 5ustar00andystaff000000 000000 SQL-Tiny-0.04/Changes000644 000766 000024 00000000433 13452267665 014427 0ustar00andystaff000000 000000 Revision history for Perl module SQL::Tiny 0.04 2019-04-06 22:32:46 CDT - Added ability to pass SQL functions. 0.02 2019-03-13 00:40:14 CST - Added 'group_by' capability to sql_select. - Added ':all' export tag. 0.01 2019-03-08 23:40:27 CST - First version. SQL-Tiny-0.04/MANIFEST000644 000766 000024 00000000472 13452267675 014271 0ustar00andystaff000000 000000 Changes lib/SQL/Tiny.pm Makefile.PL MANIFEST README.md t/00-load.t t/delete.t t/insert.t t/select.t t/update.t # No need to ship this. # t/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) SQL-Tiny-0.04/t/000755 000766 000024 00000000000 13452267674 013377 5ustar00andystaff000000 000000 SQL-Tiny-0.04/README.md000644 000766 000024 00000004661 13452267665 014422 0ustar00andystaff000000 000000 # SQL::Tiny, a Perl module for generating simple SQL statements A very simple SQL-building library. It's not for all your SQL needs, only the very simple ones. It doesn't handle JOINs. It doesn't handle subselects. It's only for simple SQL. my ($sql,$binds) = sql_select( 'users', [ 'name', 'status' ], { status => [ 'Deleted', 'Inactive' ] }, { order_by => 'name' } ); my ($sql,$binds) = sql_insert( 'users', { name => 'Dave', status => 'Active' } ); my ($sql,$binds) = sql_update( 'users', { status => 'Inactive' }, { password => undef } ); my ($sql,$binds) = sql_delete( 'users', { status => 'Inactive' } ); In my test suites, I have a lot of ad hoc SQL queries, and it drives me nuts to have so much SQL code lying around. SQL::Tiny is for generating SQL code for simple cases. I'd far rather have: my ($sql,$binds) = sql_insert( 'users', { name => 'Dave', salary => 50000, status => 'Active', dateadded => \'SYSDATE()', } ); than hand-coding: my $sql = 'INSERT INTO users (name,salary,status,dateadded) VALUES (:name,:status,:salary,SYSDATE())'; my $binds = { ':name' => 'Dave', ':salary' => 50000, ':status' => 'Active', ':dateadded' => \'SYSDATE()', }; or even the positional: my $sql = 'INSERT INTO users (name,salary,status,dateadded) VALUES (?,?,?,SYSDATE())'; my $binds = [ 'Dave', 50000, 'Active' ]; # Build status of dev branch * Travis (Linux) [![Build Status](https://travis-ci.org/petdance/sql-tiny.png?branch=dev)](https://travis-ci.org/petdance/sql-tiny) * [CPAN Testers](https://cpantesters.org/distro/S/sql-tiny.html) # Installation To install this module, run the following commands: perl Makefile.PL make make test make install # Support and Documentation After installing, you can find documentation for this module with the perldoc command. perldoc SQL::Tiny You can also look for information at: MetaCPAN https://metacpan.org/release/SQL-Tiny Project home page https://github.com/petdance/sql-tiny Project issue tracker https://github.com/petdance/sql-tiny/issues # License and Copyright Copyright (C) 2019 Andy Lester This program is free software; you can redistribute it and/or modify it under the terms of the the [Artistic License 2.0](http://www.perlfoundation.org/artistic_license_2_0). SQL-Tiny-0.04/META.yml000644 000766 000024 00000001251 13452267674 014404 0ustar00andystaff000000 000000 --- abstract: 'A very simple SQL-building library' author: - 'Andy Lester ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: SQL-Tiny no_index: directory: - t - inc requires: perl: '5.010001' resources: bugtracker: https://github.com/petdance/sql-tiny/issues license: http://www.perlfoundation.org/artistic_license_2_0 repository: git://github.com/petdance/sql-tiny.git version: '0.04' SQL-Tiny-0.04/lib/000755 000766 000024 00000000000 13452267674 013702 5ustar00andystaff000000 000000 SQL-Tiny-0.04/Makefile.PL000644 000766 000024 00000002311 13452267665 015103 0ustar00andystaff000000 000000 use 5.010001; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'SQL::Tiny', AUTHOR => q{Andy Lester }, VERSION_FROM => 'lib/SQL/Tiny.pm', ABSTRACT_FROM => 'lib/SQL/Tiny.pm', LICENSE => 'artistic_2', PL_FILES => {}, MIN_PERL_VERSION => '5.010001', CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, BUILD_REQUIRES => { 'Test::More' => '0', }, PREREQ_PM => { # None }, META_MERGE => { resources => { bugtracker => 'https://github.com/petdance/sql-tiny/issues', license => 'http://www.perlfoundation.org/artistic_license_2_0', repository => 'git://github.com/petdance/sql-tiny.git', }, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'SQL-Tiny-*' }, ); sub MY::postamble { return <<'MAKE_FRAG'; .PHONY: tags critic critic: perlcritic -1 -q -profile perlcriticrc lib/SQL/Tiny.pm t/*.t tags: ctags -f tags --recurse --totals \ --exclude=blib \ --exclude=.git \ --exclude='*~' \ --languages=Perl --langmap=Perl:+.t \ MAKE_FRAG } SQL-Tiny-0.04/META.json000644 000766 000024 00000002225 13452267674 014556 0ustar00andystaff000000 000000 { "abstract" : "A very simple SQL-building library", "author" : [ "Andy Lester " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "SQL-Tiny", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "perl" : "5.010001" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/petdance/sql-tiny/issues" }, "license" : [ "http://www.perlfoundation.org/artistic_license_2_0" ], "repository" : { "url" : "git://github.com/petdance/sql-tiny.git" } }, "version" : "0.04" } SQL-Tiny-0.04/lib/SQL/000755 000766 000024 00000000000 13452267674 014341 5ustar00andystaff000000 000000 SQL-Tiny-0.04/lib/SQL/Tiny.pm000644 000766 000024 00000022256 13452267665 015631 0ustar00andystaff000000 000000 package SQL::Tiny; use 5.010001; use strict; use warnings; =head1 NAME SQL::Tiny - A very simple SQL-building library =head1 VERSION Version 0.04 =cut our $VERSION = '0.04'; use parent 'Exporter'; our @EXPORT_OK = qw( sql_select sql_insert sql_update sql_delete ); our %EXPORT_TAGS = ( all => [@EXPORT_OK], ); =head1 SYNOPSIS my ($sql,$binds) = sql_select( 'users', [ 'name', 'status' ], { status => [ 'Deleted', 'Inactive' ] }, { order_by => 'name' } ); my ($sql,$binds) = sql_select( 'users', [ 'COUNT(*)' ], { status => [ 'Deleted', 'Inactive' ] }, { group_by => 'status' } ); my ($sql,$binds) = sql_insert( 'users', { name => 'Dave', status => 'Active' } ); my ($sql,$binds) = sql_update( 'users', { status => 'Inactive' }, { password => undef } ); my ($sql,$binds) = sql_delete( 'users', { status => 'Inactive' } ); =head1 DOCUMENTATION A very simple SQL-building library. It's not for all your SQL needs, only the very simple ones. It doesn't handle JOINs. It doesn't handle subselects. It's only for simple SQL. In my test suites, I have a lot of ad hoc SQL queries, and it drives me nuts to have so much SQL code lying around. SQL::Tiny is for generating SQL code for simple cases. I'd far rather have: my ($sql,$binds) = sql_insert( 'users', { name => 'Dave', salary => 50000, status => 'Active', dateadded => \'SYSDATE()', qty => \[ 'ROUND(?)', 14.5 ], } ); than hand-coding: my $sql = 'INSERT INTO users (name,salary,status,dateadded,qty) VALUES (:name,:status,:salary,SYSDATE(),ROUND(:qty))'; my $binds = { ':name' => 'Dave', ':salary' => 50000, ':status' => 'Active', ':dateadded' => \'SYSDATE()', ':qty' => 14.5, }; or even the positional: my $sql = 'INSERT INTO users (name,salary,status,dateadded,qty) VALUES (?,?,?,SYSDATE(),ROUND(?))'; my $binds = [ 'Dave', 50000, 'Active', 14.5 ]; The trade-off for that brevity of code is that SQL::Tiny has to make new SQL and binds from the input every time. You can't cache the SQL that comes back from SQL::Tiny because the placeholders could vary depending on what the input data is. Therefore, you don't want to use SQL::Tiny where speed is essential. The other trade-off is that SQL::Tiny handles only very simple code. It won't handle JOINs of any kind. SQL::Tiny isn't meant for all of your SQL needs, only the simple ones that you do over and over. =head1 EXPORT All subs can be exported, but none are by default. C<:all> exports all subs. =head1 SUBROUTINES/METHODS =head2 sql_select( $table, \@columns, \%where [, \%other ] ) Creates simple SELECTs and binds. The C<%other> can contain C and C. Calling: my ($sql,$binds) = sql_select( 'users', [qw( userid name )], { status => 'X' ], { order_by => 'name' }, ); returns: $sql = 'SELECT userid,name FROM users WHERE status=? ORDER BY name'; $binds = [ 'X' ]; =cut sub sql_select { my $table = shift; my $columns = shift; my $where = shift; my $other = shift // {}; my @parts = ( 'SELECT ' . join( ',', @{$columns} ), "FROM $table", ); my @binds; _build_where_section( \@parts, $where, \@binds ); _build_by_section( \@parts, 'GROUP BY', $other->{group_by} ); _build_by_section( \@parts, 'ORDER BY', $other->{order_by} ); my $sql = join( ' ', @parts ); return ( $sql, \@binds ); } =head2 sql_insert( $table, \%values ) Creates simple INSERTs and binds. Calling: my ($sql,$binds) = sql_insert( 'users', { serialno => '12345', name => 'Dave', rank => 'Sergeant', height => undef, date_added => \'SYSDATE()', } ); returns: $sql = 'INSERT INTO users (date_added,height,name,rank,serialno) VALUES (SYSDATE(),NULL,?,?,?)'; $binds = [ 'Dave', 'Sergeant', 12345 ] =cut sub sql_insert { my $table = shift; my $values = shift; my @parts = ( "INSERT INTO $table" ); my @values; my @binds; my @columns = sort keys %{$values}; for my $key ( @columns ) { my $value = $values->{$key}; if ( !defined($value) ) { push @values, 'NULL'; } elsif ( ref($value) eq 'SCALAR' ) { push @values, ${$value}; } elsif ( ref($value) eq 'REF' ) { my $deepval = ${$value}; my ($literal,$bind) = @{$deepval}; push @values, $literal; push @binds, $bind; } else { push @values, '?'; push @binds, $value; } } push @parts, '(' . join( ',', @columns ) . ')'; push @parts, 'VALUES (' . join( ',', @values ) . ')'; my $sql = join( ' ', @parts ); return ( $sql, \@binds ); } =head2 sql_update( $table, \%values, \%where ) Creates simple UPDATE calls and binds. Calling: my ($sql,$binds) = sql_update( 'users', { status => 'X', lockdate => undef, }, { orderdate => \'SYSDATE()', }, ); returns: $sql = 'UPDATE users SET lockdate=NULL, status=? WHERE orderdate=SYSDATE()' $binds = [ 'X' ] =cut sub sql_update { my $table = shift; my $values = shift; my $where = shift; my @parts = ( "UPDATE $table" ); my @columns; my @binds; for my $key ( sort keys %{$values} ) { my $value = $values->{$key}; if ( !defined($value) ) { push @columns, "$key=NULL"; } elsif ( ref($value) eq 'SCALAR' ) { push @columns, "$key=${$value}"; } elsif ( ref($value) eq 'REF' ) { my $deepval = ${$value}; my ($literal,$bind) = @{$deepval}; push @columns, "$key=$literal"; push @binds, $bind; } else { push @columns, "$key=?"; push @binds, $value; } } push @parts, 'SET ' . join( ', ', @columns ); _build_where_section( \@parts, $where, \@binds ); my $sql = join( ' ', @parts ); return ( $sql, \@binds ); } =head2 sql_delete( $table, \%where ) Creates simple DELETE calls and binds. Calling: my ($sql,$binds) = sql_delete( 'users', { serialno => 12345, height => undef, date_added => \'SYSDATE()', status => [qw( X Y Z )], }, ); returns: $sql = 'DELETE FROM users WHERE date_added = SYSDATE() AND height IS NULL AND serialno = ? AND status IN (?,?,?)' $binds = [ 12345, 'X', 'Y', 'Z' ] =cut sub sql_delete { my $table = shift; my $where = shift; my @parts = ( "DELETE FROM $table" ); my @binds; _build_where_section( \@parts, $where, \@binds ); my $sql = join( ' ', @parts ); return ( $sql, \@binds ); } sub _build_where_section { my $parts = shift; my $where = shift; my $binds = shift; my @conditions; for my $key ( sort keys %{$where} ) { my $value = $where->{$key}; if ( !defined($value) ) { push @conditions, "$key IS NULL"; } elsif ( ref($value) eq 'ARRAY' ) { push @conditions, "$key IN (" . join( ',', ('?') x @{$value} ) . ')'; push @{$binds}, @{$value}; } elsif ( ref($value) eq 'SCALAR' ) { push @conditions, "$key=${$value}"; } elsif ( ref($value) eq 'REF' ) { my $deepval = ${$value}; my ($literal,$bind) = @{$deepval}; push @conditions, "$key=$literal"; push @{$binds}, $bind; } else { push @conditions, "$key=?"; push @{$binds}, $value; } } if ( @conditions ) { push @{$parts}, 'WHERE ' . join( ' AND ', @conditions ); } return; } sub _build_by_section { my $parts = shift; my $section = shift; my $columns = shift; if ( $columns ) { if ( ref($columns) eq 'ARRAY' ) { push @{$parts}, $section . ' ' . join( ',', @{$columns} ); } else { push @{$parts}, "$section $columns"; } } return; } =head1 AUTHOR Andy Lester, C<< >> =head1 BUGS Please report any bugs or feature requests to L, or email me directly. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc SQL::Tiny You can also look for information at: =over 4 =item * MetaCPAN L =item * GitHub issue tracker L =back =head1 ACKNOWLEDGEMENTS Thanks to the following folks for their contributions: Mohammad S Anwar, Tim Heaney. =head1 LICENSE AND COPYRIGHT Copyright 2019 Andy Lester. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L =cut 1; # End of SQL::Tiny SQL-Tiny-0.04/t/delete.t000644 000766 000024 00000002374 13452267665 015034 0ustar00andystaff000000 000000 #!/usr/bin/perl use warnings; use strict; use 5.010; use Test::More tests => 3; use SQL::Tiny ':all'; test_delete( 'users', { serialno => 12345, height => undef, date_added => \'SYSDATE()', status => [qw( X Y Z )], qty => \[ 'ROUND(?)', 14.5 ], }, 'DELETE FROM users WHERE date_added=SYSDATE() AND height IS NULL AND qty=ROUND(?) AND serialno=? AND status IN (?,?,?)', [ 14.5, 12345, 'X', 'Y', 'Z' ], 'Standard mish-mash' ); test_delete( 'doomed', {}, 'DELETE FROM doomed', [], 'No WHERE conditions' ); test_delete( 'orders', { status => undef }, 'DELETE FROM orders WHERE status IS NULL', [], 'No WHEREs with values' ); done_testing(); exit 0; sub test_delete { local $Test::Builder::Level = $Test::Builder::Level + 1; my $table = shift; my $where = shift; my $expected_sql = shift; my $expected_binds = shift; my $msg = shift; return subtest "$msg: $expected_sql" => sub { plan tests => 2; my ($sql,$binds) = sql_delete( $table, $where ); is( $sql, $expected_sql, 'SQL matches' ); is_deeply( $binds, $expected_binds, 'Binds match' ); }; } SQL-Tiny-0.04/t/00-load.t000644 000766 000024 00000000321 13444276367 014714 0ustar00andystaff000000 000000 #!perl -T use 5.010001; use strict; use warnings; use Test::More; plan tests => 1; BEGIN { use_ok( 'SQL::Tiny' ) || print "Bail out!\n"; } diag( "Testing SQL::Tiny $SQL::Tiny::VERSION, Perl $], $^X" ); SQL-Tiny-0.04/t/insert.t000644 000766 000024 00000002031 13452267665 015064 0ustar00andystaff000000 000000 #!/usr/bin/perl use warnings; use strict; use 5.010; use Test::More tests => 1; use SQL::Tiny ':all'; test_insert( 'users', { serialno => '12345', name => 'Dave', rank => 'Sergeant', height => undef, date_added => \'SYSDATE()', startdate => \[ "to_date(?,'MM/DD/YYYY')", '03/02/2003' ], }, "INSERT INTO users (date_added,height,name,rank,serialno,startdate) VALUES (SYSDATE(),NULL,?,?,?,to_date(?,'MM/DD/YYYY'))", [ 'Dave', 'Sergeant', 12345, '03/02/2003' ] ); done_testing(); exit 0; sub test_insert { local $Test::Builder::Level = $Test::Builder::Level + 1; my $table = shift; my $values = shift; my $expected_sql = shift; my $expected_binds = shift; return subtest "Expecting: $expected_sql" => sub { plan tests => 2; my ($sql,$binds) = sql_insert( $table, $values ); is( $sql, $expected_sql, 'SQL matches' ); is_deeply( $binds, $expected_binds, 'Binds match' ); }; } SQL-Tiny-0.04/t/select.t000644 000766 000024 00000004403 13452267665 015044 0ustar00andystaff000000 000000 #!/usr/bin/perl use warnings; use strict; use 5.010; use Test::More tests => 7; use SQL::Tiny ':all'; test_select( [ 'users', [qw( userid name )], { status => 'X', code => [ 2112, 5150, 90125 ] }, { order_by => [qw( name state )] }, ], 'SELECT userid,name FROM users WHERE code IN (?,?,?) AND status=? ORDER BY name,state', [ 2112, 5150, 90125, 'X' ] ); test_select( [ 'users', [qw( userid name )], { startdate => \[ "to_date(?,'MM/DD/YYYY')", '03/02/2003' ], status => [ 'X', 'Y', 'Z' ] }, ], q{SELECT userid,name FROM users WHERE startdate=to_date(?,'MM/DD/YYYY') AND status IN (?,?,?)}, [ '03/02/2003', 'X', 'Y', 'Z' ], ); test_select( [ 'users', [ 'COUNT(*)' ], { status => [qw( X Y Z )] }, ], 'SELECT COUNT(*) FROM users WHERE status IN (?,?,?)', [ 'X', 'Y', 'Z' ] ); test_select( [ 'users', [ 'COUNT(*)' ], { status => [qw( X Y Z )] }, { group_by => 'status', order_by => [qw( name state )] }, ], 'SELECT COUNT(*) FROM users WHERE status IN (?,?,?) GROUP BY status ORDER BY name,state', [ 'X', 'Y', 'Z' ] ); test_select( [ 'users', [ 'COUNT(*)' ], {}, { group_by => [qw( status state )] }, ], 'SELECT COUNT(*) FROM users GROUP BY status,state', [] ); test_select( [ 'users', [qw( foo )], {} ], 'SELECT foo FROM users', [] ); test_select( [ 'users', [qw( foo )], { source => 'S', timestamp => \'SYSDATE()', width => [ 12, 47 ] }, { order_by => 'name' }, ], 'SELECT foo FROM users WHERE source=? AND timestamp=SYSDATE() AND width IN (?,?) ORDER BY name', [ 'S', 12, 47 ] ); done_testing(); exit 0; sub test_select { local $Test::Builder::Level = $Test::Builder::Level + 1; my $args = shift; my $expected_sql = shift; my $expected_binds = shift; return subtest "Expecting: $expected_sql" => sub { plan tests => 2; my ($sql,$binds) = sql_select( $args->[0], $args->[1], $args->[2], $args->[3] ); is( $sql, $expected_sql, 'SQL matches' ); is_deeply( $binds, $expected_binds, 'Binds match' ); }; } SQL-Tiny-0.04/t/update.t000644 000766 000024 00000002721 13452267665 015050 0ustar00andystaff000000 000000 #!/usr/bin/perl use warnings; use strict; use 5.010; use Test::More tests => 3; use SQL::Tiny ':all'; test_update( 'users', { lockdate => undef, qty => \[ 'TRUNC(?)', 19.85 ], status => 'X', }, { orderdate => \'SYSDATE()', qty => \[ 'ROUND(?)', 14.5 ], }, 'UPDATE users SET lockdate=NULL, qty=TRUNC(?), status=? WHERE orderdate=SYSDATE() AND qty=ROUND(?)', [ 19.85, 'X', 14.5 ], 'Standard mish-mash' ); test_update( 'wipe', { finagle => 4, }, {}, 'UPDATE wipe SET finagle=?', [ 4 ], 'No WHERE restrictions' ); test_update( 'fishy', { bingo => 'bongo', }, { status => [qw( A B C )], width => [ 5, 6 ], }, 'UPDATE fishy SET bingo=? WHERE status IN (?,?,?) AND width IN (?,?)', [ 'bongo', 'A', 'B', 'C', 5, 6 ], 'WHERE clause has INs', ); done_testing(); exit 0; sub test_update { local $Test::Builder::Level = $Test::Builder::Level + 1; my $table = shift; my $values = shift; my $where = shift; my $expected_sql = shift; my $expected_binds = shift; my $msg = shift; return subtest "$msg: $expected_sql" => sub { plan tests => 2; my ($sql,$binds) = sql_update( $table, $values, $where ); is( $sql, $expected_sql, 'SQL matches' ); is_deeply( $binds, $expected_binds, 'Binds match' ); }; }