File Coverage

blib/lib/SQL/Maker.pm

Criterion	Covered	Total	%
statement	162	198	81.8
branch	77	98	78.5
condition	11	20	55.0
subroutine	25	28	89.2
pod	8	11	72.7
total	283	355	79.7

package SQL::Maker;
use strict;
use warnings;
use 5.008001;
our $VERSION = '1.20';
use Class::Accessor::Lite 0.05 (
    ro => [qw/quote_char name_sep new_line strict driver select_class/],
);

use Carp ();
use SQL::Maker::Select;
use SQL::Maker::Select::Oracle;
use SQL::Maker::Condition;
use SQL::Maker::Util;
use Module::Load ();
use Scalar::Util ();

sub load_plugin {
    my ($class, $role) = @_;
    $role = $role =~ s/^\+// ? $role : "SQL::Maker::Plugin::$role";
    Module::Load::load($role);

    no strict 'refs';
    for (@{"${role}::EXPORT"}) {
        *{"${class}::$_"} = *{"${role}::$_"};
    }
}

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    unless ($args{driver}) {
        Carp::croak("'driver' is required for creating new instance of $class");
    }
    my $driver = $args{driver};
    unless ( defined $args{quote_char} ) {
    $args{quote_char} = do{
        if ($driver eq  'mysql') {
        q{`}
        } else {
        q{"}
        }
    };
    }
    $args{select_class} = $driver eq 'Oracle' ? 'SQL::Maker::Select::Oracle' : 'SQL::Maker::Select';

    return bless {
        name_sep => '.',
        new_line => "\n",
        strict   => 0,
        %args
    }, $class;
}

sub new_condition {
    my $self = shift;

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

sub new_select {
    my $self = shift;
    my %args = @_==1 ? %{$_[0]} : @_;

    return $self->select_class->new(
        name_sep   => $self->name_sep,
        quote_char => $self->quote_char,
        new_line   => $self->new_line,
        strict     => $self->strict,
        %args,
    );
}

# $builder->insert($table, \%values, \%opt);
# $builder->insert($table, \@values, \%opt);
sub insert {
    my ($self, $table, $values, $opt) = @_;
    my $prefix = $opt->{prefix} || 'INSERT INTO';

    my $quoted_table = $self->_quote($table);

    my (@columns, @bind_columns, @quoted_columns, @values);
    @values = ref $values eq 'HASH' ? %$values : @$values;
    while (my ($col, $val) = splice(@values, 0, 2)) {
        push @quoted_columns, $self->_quote($col);
        if (Scalar::Util::blessed($val)) {
            if ($val->can('as_sql')) {
                push @columns, $val->as_sql(undef, sub { $self->_quote($_[0]) });
                push @bind_columns, $val->bind();
            } else {
                push @columns, '?';
                push @bind_columns, $val;
            }
        } else {
            Carp::croak("cannot pass in an unblessed ref as an argument in strict mode")
                if ref($val) && $self->strict;
            if (ref($val) eq 'SCALAR') {
                # $builder->insert(foo => { created_on => \"NOW()" });
                push @columns, $$val;
            }
            elsif (ref($val) eq 'REF' && ref($$val) eq 'ARRAY') {
                # $builder->insert( foo => \[ 'UNIX_TIMESTAMP(?)', '2011-04-12 00:34:12' ] );
                my ( $stmt, @sub_bind ) = @{$$val};
                push @columns, $stmt;
                push @bind_columns, @sub_bind;
            }
            else {
                # normal values
                push @columns, '?';
                push @bind_columns, $val;
            }
        }
    }

    # Insert an empty record in SQLite.
    # ref. https://github.com/tokuhirom/SQL-Maker/issues/11
    if ($self->driver eq 'SQLite' && @columns==0) {
        my $sql  = "$prefix $quoted_table" . $self->new_line . 'DEFAULT VALUES';
        return ($sql);
    }

    my $sql  = "$prefix $quoted_table" . $self->new_line;
       $sql .= '(' . join(', ', @quoted_columns) .')' . $self->new_line .
               'VALUES (' . join(', ', @columns) . ')';

    return ($sql, @bind_columns);
}

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

    SQL::Maker::Util::quote_identifier($label, $self->quote_char(), $self->name_sep());
}

sub delete {
    my ($self, $table, $where, $opt) = @_;

    my $w = $self->_make_where_clause($where);
    my $quoted_table = $self->_quote($table);
    my $sql = "DELETE FROM $quoted_table";
    if ($opt->{using}) {
        # $bulder->delete('foo', \%where, { using => 'bar' });
        # $bulder->delete('foo', \%where, { using => ['bar', 'qux'] });
        my $tables = ref($opt->{using}) eq 'ARRAY' ? $opt->{using} : [$opt->{using}];
        my $using = join(', ', map { $self->_quote($_) } @$tables);
        $sql .= " USING " . $using;
    }
    $sql .= $w->[0];
    return ($sql, @{$w->[1]});
}

sub update {
    my ($self, $table, $args, $where) = @_;

    my ($columns, $bind_columns) = $self->make_set_clause($args);

    my $w = $self->_make_where_clause($where);
    push @$bind_columns, @{$w->[1]};

    my $quoted_table = $self->_quote($table);
    my $sql = "UPDATE $quoted_table SET " . join(', ', @$columns) . $w->[0];
    return ($sql, @$bind_columns);
}

# make "SET" clause.
sub make_set_clause {
    my ($self, $args) = @_;

    my (@columns, @bind_columns);
    my @args = ref $args eq 'HASH' ? %$args : @$args;
    while (my ($col, $val) = splice @args, 0, 2) {
        my $quoted_col = $self->_quote($col);
        if (Scalar::Util::blessed($val)) {
            if ($val->can('as_sql')) {
                push @columns, "$quoted_col = " . $val->as_sql(undef, sub { $self->_quote($_[0]) });
                push @bind_columns, $val->bind();
            } else {
                push @columns, "$quoted_col = ?";
                push @bind_columns, $val;
            }
        } else {
            Carp::croak("cannot pass in an unblessed ref as an argument in strict mode")
                if ref($val) && $self->strict;
            if (ref $val eq 'SCALAR') {
                # $builder->update(foo => { created_on => \"NOW()" });
                push @columns, "$quoted_col = " . $$val;
            }
            elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY' ) {
                # $builder->update( foo => \[ 'VALUES(foo) + ?', 10 ] );
                my ( $stmt, @sub_bind ) = @{$$val};
                push @columns, "$quoted_col = " . $stmt;
                push @bind_columns, @sub_bind;
            }
            else {
                # normal values
                push @columns, "$quoted_col = ?";
                push @bind_columns, $val;
            }
        }
    }
    return (\@columns, \@bind_columns);
}

sub where {
    my ($self, $where) = @_;
    my $cond = $self->_make_where_condition($where);
    return ($cond->as_sql(), $cond->bind());
}

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

    return $self->new_condition unless $where;
    if ( Scalar::Util::blessed( $where ) and $where->can('as_sql') ) {
        return $where;
    }

    my $w = $self->new_condition;
    my @w = ref $where eq 'ARRAY' ? @$where : %$where;
    while (my ($col, $val) = splice @w, 0, 2) {
        $w->add($col => $val);
    }
    return $w;
}

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

    return ['', []] unless $where;

    my $w = $self->_make_where_condition($where);
    my $sql = $w->as_sql();
    return [$sql ? " WHERE $sql" : '', [$w->bind]];
}

# my($stmt, @bind) = $sql−>select($table, \@fields, \%where, \%opt);
sub select {
    my $stmt = shift->select_query(@_);
    return ($stmt->as_sql,@{$stmt->bind});
}

sub select_query {
    my ($self, $table, $fields, $where, $opt) = @_;

    unless (ref $fields eq 'ARRAY') {
        Carp::croak("SQL::Maker::select_query: \$fields should be ArrayRef[Str]");
    }

    my $stmt = $self->new_select;
    for my $field (@$fields) {
        $stmt->add_select(ref $field eq 'ARRAY' ? @$field : $field);
    }

    if ( defined $table ) {
        unless ( ref $table ) {
            # $table = 'foo'
            $stmt->add_from( $table );
        }
        else {
            # $table = [ 'foo', [ bar => 'b' ] ]
            for ( @$table ) {
                $stmt->add_from( ref $_ eq 'ARRAY' ? @$_ : $_ );
            }
        }
    }

    $stmt->prefix($opt->{prefix}) if $opt->{prefix};

    if ( $where ) {
        $stmt->set_where($self->_make_where_condition($where));
    }

    if ( my $joins = $opt->{joins} ) {
        for my $join ( @$joins ) {
            $stmt->add_join(ref $join eq 'ARRAY' ? @$join : $join);
        }
    }

    if (my $o = $opt->{order_by}) {
        if (ref $o eq 'ARRAY') {
            for my $order (@$o) {
                if (ref $order eq 'HASH') {
                    # Skinny-ish [{foo => 'DESC'}, {bar => 'ASC'}]
                    $stmt->add_order_by(%$order);
                } else {
                    # just ['foo DESC', 'bar ASC']
                    $stmt->add_order_by(\$order);
                }
            }
        } elsif (ref $o eq 'HASH') {
            # Skinny-ish {foo => 'DESC'}
            $stmt->add_order_by(%$o);
        } else {
            # just 'foo DESC, bar ASC'
            $stmt->add_order_by(\$o);
        }
    }
    if (my $o = $opt->{group_by}) {
        if (ref $o eq 'ARRAY') {
            for my $group (@$o) {
                if (ref $group eq 'HASH') {
                    # Skinny-ish [{foo => 'DESC'}, {bar => 'ASC'}]
                    $stmt->add_group_by(%$group);
                } else {
                    # just ['foo DESC', 'bar ASC']
                    $stmt->add_group_by(\$group);
                }
            }
        } elsif (ref $o eq 'HASH') {
            # Skinny-ish {foo => 'DESC'}
            $stmt->add_group_by(%$o);
        } else {
            # just 'foo DESC, bar ASC'
            $stmt->add_group_by(\$o);
        }
    }
    if (my $o = $opt->{index_hint}) {
        $stmt->add_index_hint($table, $o);
    }

    $stmt->limit( $opt->{limit} )    if defined $opt->{limit};
    $stmt->offset( $opt->{offset} )  if $opt->{offset};

    if (my $terms = $opt->{having}) {
        while (my ($col, $val) = each %$terms) {
            $stmt->add_having($col => $val);
        }
    }

    $stmt->for_update(1) if $opt->{for_update};
    return $stmt;
}

1;
__END__