File Coverage

blib/lib/SQL/QueryMaker.pm

Criterion	Covered	Total	%
statement	119	119	100.0
branch	33	50	66.0
condition	14	20	70.0
subroutine	25	25	100.0
pod	4	6	66.6
total	195	220	88.6

package SQL::QueryMaker;
use 5.008_001;
use strict;
use warnings;
use utf8;
use Carp ();
use Exporter qw(import);
use Scalar::Util qw(blessed);

our $VERSION = '0.03';

our @EXPORT = qw(sql_op sql_raw);

{
    no strict "refs";

    for (qw(and or)) {
        my $fn = "sql_$_";
        my $op = uc $_;

        *{__PACKAGE__ . "::$fn"} = sub {
            # fetch args
            my $args = pop;
            my $column = shift;
            if (ref $args eq 'HASH') {
                Carp::croak("cannot specify the column name as another argument when the conditions are listed using hashref")
                    if defined $column;
                my @conds;
                for my $column (keys %$args) {
                    my $value = $args->{$column};
                    if (blessed($value) && $value->can('bind_column')) {
                        $value->bind_column($column);
                    } else {
                        $value = sql_eq($column, $value);
                    }
                    push @conds, $value;
                }
                $args = \@conds;
            } else {
                Carp::croak("arguments to `$op` must be contained in an arrayref or a hashref")
                    if ref $args ne 'ARRAY';
            }
            # build and return the compiler
            return SQL::QueryMaker->_new($column, sub {
                my ($column, $quote_cb) = @_;
                return $op eq 'AND' ? '0=1' : '1=1'
                    if @$args == 0;
                my @term;
                for my $arg (@$args) {
                    if (blessed($arg) && $arg->can('as_sql')) {
                        my ($term, $bind) = $arg->as_sql($column, $quote_cb);
                        push @term, "($term)";
                    } else {
                        Carp::croak("no column binding for $fn")
                            unless defined $column;
                        push @term, '(' . $quote_cb->($column) . ' = ?)';
                    }
                }
                my $term = join " $op ", @term;
                return $term;
            }, do {
                my @bind;
                for my $arg (@$args) {
                    if (blessed($arg) && $arg->can('as_sql')) {
                        push @bind, $arg->bind();
                    } else {
                        push @bind, $arg;
                    }
                }
                \@bind;
            });
        };

        push @EXPORT, $fn;
    }

    for (qw(in not_in)) {
        my $fn = "sql_$_";
        my $op = uc $_;
        $op =~ s/_/ /g;

        *{__PACKAGE__ . "::$fn"} = sub {
            # fetch args
            my $args = pop;
            Carp::croak("arguments to `$op` must be contained in an arrayref")
                if ref $args ne 'ARRAY';
            my $column = shift;
            # build and return the compiler
            return SQL::QueryMaker->_new($column, sub {
                my ($column, $quote_cb) = @_;
                Carp::croak("no column binding for $fn")
                    unless defined $column;
                return $op eq 'IN' ? '0=1' : '1=1'
                    if @$args == 0;
                my @term;
                for my $arg (@$args) {
                    if (blessed($arg) && $arg->can('as_sql')) {
                        my $term = $arg->as_sql(undef, $quote_cb);
                        push @term, $term eq '?' ? $term : "($term)"; # emit parens only when necessary
                    } else {
                        push @term, '?';
                    }
                }
                my $term = $quote_cb->($column) . " $op (" . join(',', @term) . ')';
                return $term;
            }, do {
                my @bind;
                for my $arg (@$args) {
                    if (blessed($arg) && $arg->can('as_sql')) {
                        push @bind, $arg->bind();
                    } else {
                        push @bind, $arg;
                    }
                }
                \@bind;
            });
        };

        push @EXPORT, $fn;
    }

    my %FNOP = (
        'is_null' => 'IS NULL',
        'is_not_null' => 'IS NOT NULL',
        'eq' => '= ?',
        'ne' => '!= ?',
        'lt' => '< ?',
        'gt' => '> ?',
        'le' => '<= ?',
        'ge' => '>= ?',
        'like' => 'LIKE ?',
        'between' => 'BETWEEN ? AND ?',
        'not_between' => 'NOT BETWEEN ? AND ?',
        'not' => 'NOT @',
    );
    for (keys %FNOP) {
        my $fn = "sql_$_";
        my ($num_args, $builder) = _compile_builder($FNOP{$_});

        *{__PACKAGE__ . "::$fn"} = sub {
            # fetch args
            my $column = @_ > $num_args ? shift : undef;
            Carp::croak("the operator expects $num_args parameters, but got " . scalar(@_))
                if $num_args != @_;
            return _sql_op($fn, $builder, $column, [ @_ ]);
        };

        push @EXPORT, $fn;
    }
}

sub sql_op {
    my $args = pop;
    my $expr = pop;
    my ($num_args, $builder) = _compile_builder($expr);
    Carp::croak("the operator expects $num_args but got " . scalar(@$args))
        if $num_args != @$args;
    return _sql_op("sql_op", $builder, shift, $args);
}

sub _sql_op {
    my ($fn, $builder, $column, $args) = @_;
    return SQL::QueryMaker->_new($column, sub {
        my ($column, $quote_cb) = @_;
        Carp::croak("no column binding for $fn(args...)")
            unless defined $column;
        my $term = $builder->($quote_cb->($column));
        return $term;
    }, $args);
}

sub sql_raw {
    my ($sql, @bind) = @_;
    return SQL::QueryMaker->_new(undef, sub {
        return $sql;
    }, \@bind);
}

sub _compile_builder {
    my $expr = shift;
    # substitute the column character
    $expr = "\@ $expr"
        if $expr !~ /\@/;

    my $num_args = @{[ $expr =~ /\?/g ]};
    my @expr = split /\@/, $expr, -1;
    my $builder = sub {
        return join $_[0], @expr;
    };
    return ($num_args, $builder);
}

sub _new {
    my ($class, $column, $as_sql, $bind) = @_;
    for my $b (@$bind) {
        Carp::croak("cannot bind an arrayref or an hashref")
            if ref $b && ! blessed($b);
    }
    return bless {
        column => $column,
        as_sql => $as_sql,
        bind   => $bind,
    }, $class;
}

sub bind_column {
    my ($self, $column) = @_;
    if (defined $column) {
        Carp::croak('cannot rebind column for \`' . $self->{column} . "` to: `$column`")
            if defined $self->{column};
    }
    $self->{column} = $column;
}

sub as_sql {
    my ($self, $supplied_colname, $quote_cb) = @_;
    $self->bind_column($supplied_colname)
        if defined $supplied_colname;
    $quote_cb ||= \"e_identifier;
    return $self->{as_sql}->($self->{column}, $quote_cb);
}

sub bind {
    my $self = shift;
    return @{$self->{bind}};
}

sub quote_identifier {
    my $label = shift;
    return join '.', map { "`$_`" } split /\./, $label;
}

1;
__END__