Add FU::SQL
Somewhat experimental, need to test this approach on a real site. Looking pretty promising so far, though.
This commit is contained in:
Yorhel
parent
48d3fb86a5
commit
145d086bea
5 changed files with 504 additions and 0 deletions
18
FU/Pg.pm
18
FU/Pg.pm
|
|
@ -6,8 +6,17 @@ _load_libpq();
|
|||
|
||||
package FU::Pg::conn {
|
||||
sub lib_version { FU::Pg::lib_version() }
|
||||
|
||||
sub Q {
|
||||
require FU::SQL;
|
||||
my $s = shift;
|
||||
my($sql, $params) = FU::SQL::SQL(@_)->compile(placeholder_style => 'pg', in_style => 'pg');
|
||||
$s->q($sql, @$params);
|
||||
}
|
||||
};
|
||||
|
||||
*FU::Pg::txn::Q = \*FU::Pg::conn::Q;
|
||||
|
||||
package FU::Pg::error {
|
||||
use overload '""' => sub($e, @) { $e->{full_message} };
|
||||
}
|
||||
|
|
@ -21,6 +30,8 @@ FU::Pg - The Ultimate (synchronous) Interface to PostgreSQL
|
|||
|
||||
=head1 SYNOPSYS
|
||||
|
||||
use FU::Pg;
|
||||
|
||||
my $conn = FU::Pg->connect("dbname=test user=test password=nottest");
|
||||
|
||||
$conn->exec('CREATE TABLE books (id SERIAL, title text, read bool)');
|
||||
|
|
@ -147,6 +158,11 @@ Note that this method just creates a statement object, the given query is not
|
|||
prepared or executed until the appropriate statement methods (see below) are
|
||||
used.
|
||||
|
||||
=item $conn->Q(@args)
|
||||
|
||||
Same as C<< $conn->q() >> but uses L<FU::SQL> to construct the SQL query and
|
||||
bind parameters.
|
||||
|
||||
=back
|
||||
|
||||
Statement objects returned by C<< $conn->q() >> support the following
|
||||
|
|
@ -359,6 +375,8 @@ Transaction methods:
|
|||
|
||||
=item $txn->q(..)
|
||||
|
||||
=item $txn->Q(..)
|
||||
|
||||
Run a query inside the transaction. These work the same as the respective
|
||||
methods on the parent C<$conn> object.
|
||||
|
||||
|
|
|
|||
404
FU/SQL.pm
Normal file
404
FU/SQL.pm
Normal file
|
|
@ -0,0 +1,404 @@
|
|||
package FU::SQL 0.1;
|
||||
use v5.36;
|
||||
use Exporter 'import';
|
||||
use Carp 'confess';
|
||||
use experimental 'builtin';
|
||||
|
||||
our @EXPORT = qw/
|
||||
P RAW SQL
|
||||
PARENS INTERSPERSE COMMA
|
||||
AND OR WHERE
|
||||
SET VALUES IN
|
||||
/;
|
||||
|
||||
|
||||
sub _obj { bless [@_], 'FU::SQL::val' }
|
||||
|
||||
sub P :prototype($) ($p) { bless \(my $x = $p), 'FU::SQL::p' }
|
||||
sub RAW :prototype($) ($s) { _obj "$s" }
|
||||
|
||||
# These operate on $_ and must be called with &func syntax.
|
||||
# The readonly check can be finicky.
|
||||
sub _israw { builtin::created_as_string($_) && Internals::SvREADONLY($_) }
|
||||
sub _tosql { &_israw ? "$_" : ref($_) =~ /^FU::SQL::/ ? $_ : P $_ }
|
||||
|
||||
sub SQL { _obj map &_tosql, @_ }
|
||||
sub PARENS { SQL '(', @_, ')' }
|
||||
sub INTERSPERSE { my @a = map &_tosql, @_; _obj map $_ > 1 ? ($a[0],$a[$_]) : $a[$_], 1..$#a }
|
||||
sub COMMA { INTERSPERSE ',', @_ }
|
||||
|
||||
sub _conditions {
|
||||
@_ == 1 && ref $_[0] eq 'HASH'
|
||||
? map PARENS(RAW $_,
|
||||
!defined $_[0]{$_} ? ('IS NULL') :
|
||||
ref($_[0]{$_}) eq 'FU::SQL::in' ? ($_[0]{$_})
|
||||
: ('=', $_[0]{$_})
|
||||
), sort keys $_[0]->%*
|
||||
: map PARENS($_), @_
|
||||
}
|
||||
|
||||
sub AND { !@_ || (@_ == 1 && ref $_[0] eq 'HASH' && keys $_[0]->%* == 0) ? RAW '1=1' : INTERSPERSE 'AND', _conditions @_ }
|
||||
sub OR { !@_ || (@_ == 1 && ref $_[0] eq 'HASH' && keys $_[0]->%* == 0) ? RAW '1=0' : INTERSPERSE 'OR', _conditions @_ }
|
||||
sub WHERE { SQL 'WHERE', AND @_ }
|
||||
|
||||
sub SET($h) { SQL 'SET', COMMA map SQL(RAW $_, '=', $h->{$_}), sort keys %$h }
|
||||
|
||||
sub VALUES {
|
||||
@_ == 1 && ref $_[0] eq 'HASH'
|
||||
? SQL '(', COMMA(map RAW $_, sort keys $_[0]->%*), ') VALUES (', COMMA(map $_[0]{$_}, sort keys $_[0]->%*), ')'
|
||||
: @_ == 1 && ref $_[0] eq 'ARRAY'
|
||||
? SQL 'VALUES (', COMMA($_[0]->@*), ')'
|
||||
: SQL 'VALUES (', COMMA(@_), ')';
|
||||
}
|
||||
|
||||
sub IN($a) {
|
||||
confess "Expected arrayref" if ref $a ne 'ARRAY';
|
||||
bless \$a, 'FU::SQL::in'
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub FU::SQL::val::_compile($self, $opt, $sql, $params) {
|
||||
for (@$self) {
|
||||
$$sql .= ' ' if length $$sql && $$sql !~ /\s$/;
|
||||
if (ref $_) { $_->_compile($opt, $sql, $params); }
|
||||
else { $$sql .= $_; }
|
||||
}
|
||||
}
|
||||
|
||||
sub FU::SQL::p::_compile($self, $opt, $sql, $params) {
|
||||
push @$params, $$self;
|
||||
$$sql .= $opt->{placeholder_style} eq 'pg' ? '$'.@$params : '?';
|
||||
}
|
||||
|
||||
sub FU::SQL::in::_compile($self, $opt, $sql, $params) {
|
||||
if ($opt->{in_style} eq 'pg') {
|
||||
$$sql .= '= ANY(';
|
||||
FU::SQL::p::_compile($self, $opt, $sql, $params);
|
||||
$$sql .= ')';
|
||||
} else {
|
||||
$$sql .= 'IN(';
|
||||
for my($i,$v) (builtin::indexed @$$self) {
|
||||
$$sql .= ',' if $i;
|
||||
FU::SQL::p::_compile(\$v, $opt, $sql, $params);
|
||||
}
|
||||
$$sql .= ')';
|
||||
}
|
||||
}
|
||||
|
||||
sub FU::SQL::val::compile($self, %opt) {
|
||||
$opt{placeholder_style} ||= 'dbi';
|
||||
$opt{in_style} ||= 'dbi';
|
||||
my($sql, @params) = ('');
|
||||
$self->_compile(\%opt, \$sql, \@params);
|
||||
($sql, \@params)
|
||||
}
|
||||
|
||||
*FU::SQL::p::compile = *FU::SQL::in::compile = \*FU::SQL::val::compile;
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
FU::SQL - Small and Safe SQL Query Builder
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use FU::SQL;
|
||||
|
||||
my $data = { name => 'John', last_updated => RAW 'NOW()' };
|
||||
|
||||
my $upd = SQL 'UPDATE table', SET $data;
|
||||
|
||||
my $ins = SQL 'INSERT INTO table', VALUES $data;
|
||||
|
||||
my $sel = SQL 'SELECT id, name FROM table', WHERE { id => IN([1,2,3]) };
|
||||
|
||||
my($sql, @params) = $sel->compile;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Compiling SQL
|
||||
|
||||
All functions listed under L</"Constructing SQL"> return an object that can be
|
||||
passed to other construction functions or compiled into SQL and bind
|
||||
parameters. These objects support one method call:
|
||||
|
||||
=over
|
||||
|
||||
=item ($sql, $params) = $obj->compile(%options)
|
||||
|
||||
Compile an object into a SQL string and a (possibly empty) arrayref of bind
|
||||
parameters. The following options are supported:
|
||||
|
||||
=over
|
||||
|
||||
=item placeholder_style => 'dbi' or 'pg'
|
||||
|
||||
Set the style to use for placeholders in the SQL string. When set to C<'dbi'>
|
||||
(default), placeholders are indicated with a single question mark. When set to
|
||||
C<'pg'>, placeholders use PostgreSQL-style numbered variables instead. For
|
||||
example:
|
||||
|
||||
my $obj = SQL 'SELECT', 1, ',', 2;
|
||||
my ($sql) = $obj->compile(placeholder_style => 'dbi');
|
||||
# $sql = 'SELECT ?, ?'
|
||||
|
||||
($sql) = $obj->compile(placeholder_style => 'pg');
|
||||
# $sql = 'SELECT $1, $2'
|
||||
|
||||
All L<DBI> drivers support the C<'dbi'> method just fine, but you need to use
|
||||
C<'pg'> when your SQL is going to L<FU::Pg> or L<Pg::PQ>.
|
||||
|
||||
=item in_style => 'dbi' or 'pg'
|
||||
|
||||
Set the style to use for C<IN> expressions, refer to the C<IN()> function below
|
||||
for details.
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
=head2 Constructing SQL
|
||||
|
||||
All of the functions below return an object with a C<compile()> method. All
|
||||
functions are exported by default.
|
||||
|
||||
=over
|
||||
|
||||
=item SQL(@args)
|
||||
|
||||
Construct an SQL object by concatenating the given arguments. There are three
|
||||
types of supported arguments:
|
||||
|
||||
=over
|
||||
|
||||
=item 1.
|
||||
|
||||
B<String literals> are interpreted as raw SQL fragments.
|
||||
|
||||
=item 2.
|
||||
|
||||
Objects returned by other functions listed below can be included as
|
||||
SQL fragments.
|
||||
|
||||
=item 3.
|
||||
|
||||
B<Everything else> is considered a bind parameter.
|
||||
|
||||
=back
|
||||
|
||||
These rules allow for flexible SQL construction:
|
||||
|
||||
SQL 'SELECT 1'; # Raw SQL statement
|
||||
SQL 'WHERE id =', 1; # SQL with a bind parameter
|
||||
|
||||
my $fifteen = SQL('5 + ', 10);
|
||||
SQL 'WHERE number =', $fifteen; # Composing SQL objects
|
||||
|
||||
There is some magic going on in order to differentiate between a I<string
|
||||
literal> and other arguments. The rule is that anything that is
|
||||
C<builtin::created_as_string()> and read-only (as per
|
||||
C<Internals::SvREADONLY()>) is considered raw SQL. Variables are by definition
|
||||
writable:
|
||||
|
||||
my $x = 'SELECT 1';
|
||||
SQL $x; # BAD: $x is used as bind parameter instead
|
||||
|
||||
# Better:
|
||||
my $x = SQL 'SELECT 1';
|
||||
SQL $x;
|
||||
|
||||
In most cases, though, this is the behavior you want. In the few cases where it
|
||||
isn't, you can always use C<P()> or C<RAW()> to force an argument as bind
|
||||
parameter or SQL string.
|
||||
|
||||
=item P($val)
|
||||
|
||||
Return an object where C<$val> is forced into a bind parameter, for example:
|
||||
|
||||
SQL 'WHERE name =', 'John'; # BAD, 'John' is a string literal
|
||||
|
||||
SQL 'WHERE name =', P 'John'; # Good, 'John' is now a parameter
|
||||
|
||||
=item RAW($sql)
|
||||
|
||||
Force the given C<$sql> string to be included as SQL. For example:
|
||||
|
||||
# BAD:
|
||||
my $tables = ['a', 'b', 'c'];
|
||||
SQL 'SELECT * FROM', $tables[1];
|
||||
# 'SELECT * FROM ?', that's a syntax error.
|
||||
|
||||
# Better:
|
||||
SQL 'WHERE * FROM', RAW $tables[1];
|
||||
# 'SELECT * FROM b'
|
||||
|
||||
Absolutely do not use this function with untrusted input.
|
||||
|
||||
=item PARENS(@args)
|
||||
|
||||
Like C<SQL()> but surrounds the expression by parens:
|
||||
|
||||
SQL 'WHERE x AND', PARENS('y', 'OR', 'z');
|
||||
# 'WHERE x AND ( y OR z )'
|
||||
|
||||
=item INTERSPERSE($value, @args)
|
||||
|
||||
Concatenate C<@args> with C<$value> as separator. Same way as C<join()> works
|
||||
for strings, but I had to come up with a different name because "join" tends to
|
||||
have a completely different meaning in the SQL world.
|
||||
|
||||
INTERSPERSE 'OR', 'true', 'false';
|
||||
# 'true OR false'
|
||||
|
||||
=item COMMA(@args)
|
||||
|
||||
Short-hand for C<INTERSPERSE(',', @args)>.
|
||||
|
||||
=item AND(@conditions)
|
||||
|
||||
Construct an SQL expression to test that all given conditions are true. Returns
|
||||
C<'1=1'> (i.e. true) if C<@conditions> is an empty list.
|
||||
|
||||
AND 'x IS NOT NULL',
|
||||
SQL('id <>', $not_this_id);
|
||||
# '( x IS NOT NULL ) AND ( id <> ? )'
|
||||
|
||||
AND;
|
||||
# '1=1'
|
||||
|
||||
=item AND($hashref)
|
||||
|
||||
A special form of C<AND()> that tests the given column for equality instead.
|
||||
The keys of the hashref are interpreted as raw SQL and the values as bind
|
||||
parameters.
|
||||
|
||||
AND { id => 1, number => RAW 'random()', x => undef }
|
||||
# '( id = ? ) AND ( number = random() ) AND ( x IS NULL )'
|
||||
|
||||
=item OR(@conditions)
|
||||
|
||||
=item OR($hashref)
|
||||
|
||||
Like C<AND()> except OR. These return C<'1=0'> (i.e. false) on an empty list.
|
||||
|
||||
=item WHERE(@conditions)
|
||||
|
||||
=item WHERE($hashref)
|
||||
|
||||
Like C<AND()> but prefixed with C<'WHERE'>.
|
||||
|
||||
=item SET($hashref)
|
||||
|
||||
Construct a SET clause:
|
||||
|
||||
SQL 'UPDATE table', SET {
|
||||
name => 'John',
|
||||
last_updated => RAW('NOW()'),
|
||||
};
|
||||
# 'UPDATE table SET name = ? , last_updated = NOW()'
|
||||
|
||||
=item VALUES(@args)
|
||||
|
||||
Construct a VALUES clause, C<@args> is interpreted as in C<SQL()>:
|
||||
|
||||
SQL 'INSERT INTO table (name, last_updated)', VALUES(P('John'), 'NOW()');
|
||||
# 'INSERT INTO table (name, last_updated) VALUES ( ? , NOW() )'
|
||||
|
||||
=item VALUES($arrayref)
|
||||
|
||||
Same as C<VALUES(@args)> but arguments are interpreted as bind parameters:
|
||||
|
||||
SQL 'INSERT INTO table (name, last_updated)', VALUES(['John', RAW 'NOW()']);
|
||||
# 'INSERT INTO table (name, last_updated) VALUES ( ? , NOW() )'
|
||||
|
||||
=item VALUES($hashref)
|
||||
|
||||
Like C<VALUES($arrayref)> but also constructs a list of column names from the
|
||||
hash keys:
|
||||
|
||||
SQL 'INSERT INTO table', VALUES {
|
||||
name => 'John',
|
||||
last_updated => RAW('NOW()'),
|
||||
};
|
||||
# Same as above examples
|
||||
|
||||
Note how this allows for re-using the same hashref with C<SET()>, allowing for
|
||||
convenient insert-or-update:
|
||||
|
||||
my $data = {
|
||||
name => 'John',
|
||||
last_updated => RAW('NOW()'),
|
||||
};
|
||||
SQL 'INSERT INTO table', VALUES($data),
|
||||
'ON CONFLICT (name) DO UPDATE', SET($data);
|
||||
|
||||
(The bind parameters are duplicated though, there's no duplicate detection yet.
|
||||
Not sure if that's even worth it)
|
||||
|
||||
=item IN($arrayref)
|
||||
|
||||
Construct an C<IN()> clause for matching an SQL expression against multiple
|
||||
values. This function results in different SQL depending on the C<in_style>
|
||||
option given to C<compile()>. The default C<'dbi'> style passes each value as a
|
||||
bind parameter:
|
||||
|
||||
SQL 'WHERE id', IN([1, 2, 3, 4]);
|
||||
# 'WHERE id IN(?, ?, ?, ?)', parameters: 1, 2, 3, 4
|
||||
|
||||
The C<'pg'> style passes the entire array as a single bind parameter instead:
|
||||
|
||||
SQL 'WHERE id', IN([1, 2, 3, 4]);
|
||||
# 'WHERE id = ANY(?)', parameter: [1, 2, 3, 4]
|
||||
|
||||
The C<'pg'> style allows for more efficient re-use of cached prepared
|
||||
statements, since the generated query does not depend on the number of values.
|
||||
Unfortunately, the only Postgres module that supports arrays as bind parameters
|
||||
that I am aware of is L<FU::Pg>. This approach does not, as of writing, work
|
||||
with L<DBD::Pg> or L<Pg::PQ>.
|
||||
|
||||
Can be used in the C<$hashref> versions of C<AND>, C<OR> and C<WHERE> as well:
|
||||
|
||||
WHERE { id => IN([1, 2]) }
|
||||
# 'WHERE id IN(?, ?)'
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<SQL::Interp> and the many other related modules on CPAN. This module was
|
||||
heavily inspired by SQL::Interp, but differs in a few key areas:
|
||||
|
||||
=over
|
||||
|
||||
=item * SQL::Interp expects bind parameters to be passed as a scalar reference
|
||||
(e.g. C<\$x>), but this is easy to forget and the result of forgetting to do so
|
||||
is an SQL injection vulnerability - the worst possible outcome.
|
||||
C<sql_interp_strict()> was introduced in an attempt to provide a safer
|
||||
alternative, but that limits the flexibility of the query builder. This module
|
||||
instead attempts to identify string literals through some trickery and
|
||||
considers everything else a bind parameter, which is much less prone to
|
||||
accidental SQL injection.
|
||||
|
||||
=item * SQL::Interp parses your input query in an attempt to guess the context
|
||||
for interpolation. While this has (to my surprise) always worked out well for
|
||||
anything I've written, it does feel a tad too magical for my taste. This module
|
||||
instead requires you to more explicitly state your intentions, while hopefully
|
||||
remaining as concise and readable.
|
||||
|
||||
=item * SQL::Interp assigns various semantics to hashrefs and arrayrefs, which
|
||||
means those can't easily be used as bind parameters. Not at all a problem if
|
||||
you're using DBI - which doesn't support that anyway, but it can cause trouble
|
||||
with L<FU::Pg>.
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
MIT.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Yorhel <projects@yorhel.nl>
|
||||
Loading…
Add table
Add a link
Reference in a new issue