view release on metacpan or  search on metacpan

lib/DBIx/MoCo/DataBase.pm  view on Meta::CPAN

package DBIx::MoCo::DataBase;
use strict;
use warnings;
use Carp;
use base qw (Class::Data::Inheritable);
use DBI;
use SQL::Abstract;

__PACKAGE__->mk_classdata($_) for qw(username password
                                     cache_connection last_insert_id);
__PACKAGE__->cache_connection(1);

our $DEBUG = 0;
our $SQL_COUNT = 0;

# $Carp::CarpLevel = 2;
my $sqla = SQL::Abstract->new;

sub insert {
    my $class = shift;
    my ($table, $args) = @_;
    my ($sql, @binds) = $sqla->insert($table,$args);
    $class->execute($sql,undef,\@binds);
}

sub delete {
    my $class = shift;
    my ($table, $where) = @_;
    $where or croak "where is not specified to delete from $table";
    (ref $where eq 'HASH' && %$where) or croak "where is not specified to delete from $table";
    my ($sql, @binds) = $sqla->delete($table,$where);
    $sql =~ /WHERE/io or croak "where is not specified to delete from $table";
    $class->execute($sql,undef,\@binds);
}

sub update {
    my $class = shift;
    my ($table, $args, $where) = @_;
    $where or croak "where is not specified to update $table";
    (ref $where eq 'HASH' && %$where) or croak "where is not specified to update $table";
    my ($sql, @binds) = $sqla->update($table,$args,$where);
    $sql =~ /WHERE/io or croak "where is not specified to update $table";
    $class->execute($sql,undef,\@binds);
}

sub select {
    my $class = shift;
    my ($table, $args, $where, $order, $limit) = @_;
    my ($sql, @binds) = $sqla->select($table,$args,$where,$order);
    $sql .= $class->_parse_limit($limit) if $limit;
    my $data;
    $class->execute($sql,\$data,\@binds) or return;
    return $data;
}

sub search {
    my $class = shift;
    my %args = @_;
    my ($sql, @binds) = $class->_search_sql(\%args);
    my $data;
    $class->execute($sql,\$data,\@binds) or return;
    return $data;
}

sub _search_sql {
    my $class = shift;
    my $args = shift;
    my $field = $args->{field} || "*";
    my $sql = "SELECT $field FROM " . $args->{table};
    $sql .= " USE INDEX ($args->{use_index})" if $args->{use_index};
    my ($where,@binds) = $class->_parse_where($args->{where});
    $sql .= $where if $where;
    $sql .= " GROUP BY $args->{group}" if $args->{group};
    $sql .= " ORDER BY $args->{order}" if $args->{order};
    $sql .= $class->_parse_limit($args);
    return ($sql,@binds);
}

sub _parse_where {
    my ($class, $where) = @_;
    my $binds = [];
    if (ref $where eq 'ARRAY') {
        my $sql = shift @$where;
        if ($sql =~ m!\s*:[A-Za-z_][A-Za-z0-9_]+\s*!o) {
            @$where % 2 and croak "You gave me an odd number of parameters to 'where'!";
            my %named_values = @$where;
            my @values;
            $sql =~ s{:([A-Za-z_][A-Za-z0-9_]*)}{
                croak "$1 is not exists in hash" if !exists $named_values{$1};
                my $value = $named_values{$1};
                if (ref $value eq 'ARRAY') {
                    push @values, $_ for @$value;
                    join ',', map('?', 1..@$value);
                } else {
                    push @values, $value;
                    '?'