—

              
package FU::SQL 0.5;
use v5.36;
use Exporter 'import';
use Carp 'confess';
use experimental 'builtin', 'for_list';
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 :prototype($) ($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__
HideShow 315 lines of Pod
=head1 NAME
FU::SQL - Small and Safe SQL Query Builder
=head1 EXPERIMENTAL
This module is still in development and there will likely be a few breaking API
changes, see the main L<FU> module for details.
=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
=head1 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
=head1 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 are 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. Regular variables, array
elements and hash values are always writable:
  my $x = 'SELECT 1';
  SQL $x;  # BAD: $x is used as bind parameter instead
  # Better:
  my $x = SQL 'SELECT 1';
  SQL $x;
Constants created with C<use constant> are considered string literals, and
there are probably plenty of other creative ways to end up with variables that
may be considered a "string literal" by this module. L<Hash::Util>,
L<Scalar::Readonly>, other modules and tied hashes or arrays all have the
potential to create read-only strings, but I don't expect that these are
commonly applied on untrusted user input.
In most cases, this heuristic should work out well. In the few cases where it
doesn't, or when you're not entirely sure what kind of value you're dealing
with, 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'
Never 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 columns 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)
=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>