File Coverage

blib/lib/SQL/Maker/Select.pm

Criterion	Covered	Total	%
statement	192	198	96.9
branch	80	94	85.1
condition	27	43	62.7
subroutine	31	31	100.0
pod	14	22	63.6
total	344	388	88.6

package SQL::Maker::Select;
use strict;
use warnings;
use utf8;
use SQL::Maker::Condition;
use SQL::Maker::Util;
use Class::Accessor::Lite (
    new => 0,
    wo => [qw/distinct for_update/],
    rw => [qw/prefix/],
    ro => [qw/quote_char name_sep new_line strict/],
);
use Scalar::Util ();

sub offset {
    if (@_==1) {
        return $_[0]->{offset};
    } else {
        $_[0]->{offset} = $_[1];
        return $_[0];
    }
}

sub limit {
    if (@_==1) {
        $_[0]->{limit};
    } else {
        $_[0]->{limit} = $_[1];
        return $_[0];
    }
}

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    my $self = bless {
        select             => +[],
        distinct           => 0,
        select_map         => +{},
        select_map_reverse => +{},
        from               => +[],
        joins              => +[],
        index_hint         => +{},
        group_by           => +[],
        order_by           => +[],
        prefix             => 'SELECT ',
        new_line           => "\n",
        strict             => 0,
        %args
    }, $class;

    return $self;
}

sub new_condition {
    my $self = shift;

    SQL::Maker::Condition->new(
        quote_char => $self->{quote_char},
        name_sep   => $self->{name_sep},
        strict     => $self->{strict},
    );
}

sub bind {
    my $self = shift;
    my @bind;
    push @bind, @{$self->{subqueries}} if $self->{subqueries};
    push @bind, $self->{where}->bind  if $self->{where};
    push @bind, $self->{having}->bind if $self->{having};
    return wantarray ? @bind : \@bind;
}

sub add_select {
    my ($self, $term, $col) = @_;

    $col ||= $term;
    push @{ $self->{select} }, $term;
    $self->{select_map}->{$term} = $col;
    $self->{select_map_reverse}->{$col} = $term;
    return $self;
}

sub add_from {
    my ($self, $table, $alias) = @_;
    if ( Scalar::Util::blessed( $table ) and $table->can('as_sql') ) {
        push @{ $self->{subqueries} }, $table->bind;
        push @{$self->{from}}, [ \do{ '(' . $table->as_sql . ')' }, $alias ];
    }
    else {
        push @{$self->{from}}, [$table, $alias];
    }
    return $self;
}

sub add_join {
    my ($self, $table_ref, $joins) = @_;
    my ($table, $alias) = ref($table_ref) eq 'ARRAY' ? @$table_ref : ($table_ref);

    if ( Scalar::Util::blessed( $table ) and $table->can('as_sql') ) {
        push @{ $self->{subqueries} }, $table->bind;
        $table = \do{ '(' . $table->as_sql . ')' };
    }

    push @{ $self->{joins} }, {
        table => [ $table, $alias ],
        joins => $joins,
    };
    return $self;
}

sub add_index_hint {
    my ($self, $table, $hint) = @_;

    my ($type, $list);

    if (ref $hint eq 'HASH') {
        # { type => '...', list => ['foo'] }
        $type = $hint->{type} || 'USE';
        $list = ref($hint->{list}) eq 'ARRAY' ? $hint->{list} : [ $hint->{list} ];
    } else {
        # ['foo, 'bar'] or just 'foo'
        $type = 'USE';
        $list = ref($hint) eq 'ARRAY' ? $hint : [ $hint ];
    }

    $self->{index_hint}->{$table} = {
        type => $type,
        list => $list,
    };

    return $self;
}

sub _quote {
    my ($self, $label) = @_;

    return $$label if ref $label eq 'SCALAR';
    SQL::Maker::Util::quote_identifier($label, $self->{quote_char}, $self->{name_sep})
}

sub as_sql {
    my $self = shift;
    my $sql = '';
    my $new_line = $self->new_line;

    if (@{ $self->{select} }) {
        $sql .= $self->{prefix};
        $sql .= 'DISTINCT ' if $self->{distinct};
        $sql .= join(', ',  map {
            my $alias = $self->{select_map}->{$_};
            if (!$alias) {
                $self->_quote($_)
            } elsif ($alias && $_ =~ /(?:^|\.)\Q$alias\E$/) {
                $self->_quote($_)
            } else {
                $self->_quote($_) . ' AS ' .  $self->_quote($alias)
            }
        } @{ $self->{select} }) . $new_line;
    }

    $sql .= 'FROM ';

    ## Add any explicit JOIN statements before the non-joined tables.
    if ($self->{joins} && @{ $self->{joins} }) {
        my $initial_table_written = 0;
        for my $j (@{ $self->{joins} }) {
            my ($table, $join) = map { $j->{$_} } qw( table joins );
            $table = $self->_add_index_hint(@$table); ## index hint handling
            $sql .= $table unless $initial_table_written++;
            $sql .= ' ' . uc($join->{type}) if $join->{type};
            $sql .= ' JOIN ' . $self->_quote($join->{table});
            $sql .= ' ' . $self->_quote($join->{alias}) if $join->{alias};

            if ( defined $join->{condition} ) {
                if (ref $join->{condition} && ref $join->{condition} eq 'ARRAY') {
                    $sql .= ' USING ('. join(', ', map { $self->_quote($_) } @{ $join->{condition} }) . ')';
                }
                elsif (ref $join->{condition} && ref $join->{condition} eq 'HASH') {
                    my @conds;
                    for my $key (keys %{ $join->{condition} }) {
                        push @conds, $self->_quote($key) . ' = ' . $self->_quote($join->{condition}{$key});
                    }
                    $sql .= ' ON ' . join(' AND ', @conds);
                }
                else {
                    $sql .= ' ON ' . $join->{condition};
                }
            }
        }
        $sql .= ', ' if @{ $self->{from} };
    }

    if ($self->{from} && @{ $self->{from} }) {
        $sql .= join ', ',
          map { $self->_add_index_hint($_->[0], $_->[1]) }
             @{ $self->{from} };
    }

    $sql .= $new_line;
    $sql .= $self->as_sql_where()   if $self->{where};

    $sql .= $self->as_sql_group_by  if $self->{group_by};
    $sql .= $self->as_sql_having    if $self->{having};
    $sql .= $self->as_sql_order_by  if $self->{order_by};

    $sql .= $self->as_sql_limit     if defined $self->{limit};

    $sql .= $self->as_sql_for_update;
    $sql =~ s/${new_line}+$//;

    return $sql;
}

sub as_sql_limit {
    my $self = shift;

    my $n = $self->{limit};
    return '' unless defined $n;

    die "Non-numerics in limit clause ($n)" if $n =~ /\D/;
    return sprintf "LIMIT %d%s" . $self->new_line, $n,
           ($self->{offset} ? " OFFSET " . int($self->{offset}) : "");
}

sub add_order_by {
    my ($self, $col, $type) = @_;
    push @{$self->{order_by}}, [$col, $type];
    return $self;
}

sub as_sql_order_by {
    my ($self) = @_;

    my @attrs = @{$self->{order_by}};
    return '' unless @attrs;

    return 'ORDER BY '
           . join(', ', map {
                my ($col, $type) = @$_;
                if (ref $col) {
                    $$col
                } else {
                    $type ? $self->_quote($col) . " $type" : $self->_quote($col)
                }
           } @attrs)
           . $self->new_line;
}

sub add_group_by {
    my ($self, $group, $order) = @_;
    push @{$self->{group_by}}, $order ? $self->_quote($group) . " $order" : $self->_quote($group);
    return $self;
}

sub as_sql_group_by {
    my ($self,) = @_;

    my $elems = $self->{group_by};

    return '' if @$elems == 0;

    return 'GROUP BY '
           . join(', ', @$elems)
           . $self->new_line;
}

sub set_where {
    my ($self, $where) = @_;
    $self->{where} = $where;
    return $self;
}

sub add_where {
    my ($self, $col, $val) = @_;

    $self->{where} ||= $self->new_condition();
    $self->{where}->add($col, $val);
    return $self;
}

sub add_where_raw {
    my ($self, $term, $bind) = @_;

    $self->{where} ||= $self->new_condition();
    $self->{where}->add_raw($term, $bind);
    return $self;
}

sub as_sql_where {
    my $self = shift;

    my $where = $self->{where}->as_sql();
    $where ? "WHERE $where" . $self->new_line : '';
}

sub as_sql_having {
    my $self = shift;
    if ($self->{having}) {
        'HAVING ' . $self->{having}->as_sql . $self->new_line;
    } else {
        ''
    }
}

sub add_having {
    my ($self, $col, $val) = @_;

    if (my $orig = $self->{select_map_reverse}->{$col}) {
        $col = $orig;
    }

    $self->{having} ||= $self->new_condition();
    $self->{having}->add($col, $val);
    return $self;
}

sub as_sql_for_update {
    my $self = shift;
    $self->{for_update} ? ' FOR UPDATE' : '';
}

sub _add_index_hint {
    my ($self, $tbl_name, $alias) = @_;
    my $quoted = $alias ? $self->_quote($tbl_name) . ' ' . $self->_quote($alias) : $self->_quote($tbl_name);
    my $hint = $self->{index_hint}->{$tbl_name};
    return $quoted unless $hint && ref($hint) eq 'HASH';
    if ($hint->{list} && @{ $hint->{list} }) {
        return $quoted . ' ' . uc($hint->{type} || 'USE') . ' INDEX (' .
                join (',', map { $self->_quote($_) } @{ $hint->{list} }) .
                ')';
    }
    return $quoted;
}


1;
__END__