File Coverage

blib/lib/FU/SQL.pm

Criterion	Covered	Total	%
statement	96	96	100.0
branch	35	36	97.2
condition	22	25	88.0
subroutine	26	26	100.0
pod	13	13	100.0
total	192	196	97.9

package FU::SQL 1.4;
use v5.36;
use Exporter 'import';
use Carp 'confess';
use experimental 'builtin', 'for_list';

our @EXPORT = qw/
    P RAW IDENT 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" }
sub IDENT :prototype($) ($s) { bless \(my $x = "$s"), 'FU::SQL::i' }

# 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(IDENT $_,
        !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(IDENT $_, '=', $h->{$_}), sort keys %$h }

sub VALUES {
    @_ == 1 && ref $_[0] eq 'HASH'
    ? SQL '(', COMMA(map IDENT $_, 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::i::_compile($self, $opt, $sql, $params) {
    $$sql .= $opt->{quote_identifier} ? $opt->{quote_identifier}->($$self) : $$self;
}

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) {
    !/^(placeholder_style|in_style|quote_identifier)$/ && confess "Unknown flag: $_" for keys %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::i::compile = *FU::SQL::in::compile = \*FU::SQL::val::compile;

1;
__END__