Class::PObject::Driver::DBI - Base class for all DBI-related drivers

    package Class::PObject::YourDriver;
    use Class::PObject::Driver::DBI;
    @ISA = ('Class::PObject::Driver::DBI');

    sub save {
        my ($self, $pobject_name, \%properties, \%columns) = @_;
        ...
    }

    sub dbh {
        my ($self, $pobject_name, \%properties) = @_;
        ...
    }

    Class::PObject::Driver::DBI is a subclass of Class::PObject::Driver.
    Provides all the necessary base methods/utilities for writing
    DBI-related pobject drivers.

package Class::PObject::Driver::DBI;

# DBI.pm,v 1.13 2003/11/07 04:51:04 sherzodr Exp

use strict;
#use diagnostics;
use Carp;
use Log::Agent;
use Class::PObject::Driver;
use vars ('$VERSION', '@ISA');

@ISA = ('Class::PObject::Driver');

$VERSION = '2.02';



sub _prepare_create_table {
    my ($self, $object_name, $tablename) = @_;

    my $props = $object_name->__props();
    my @cols = ();
    for my $column ( @{ $props->{columns} } ) {
        my $type = $props->{tmap}->{$column};
        if ( $type eq "MD5" ) {
            $type = "CHAR(32)";
        } elsif ( $type eq "ENCRYPT" ) {
            $type = "CHAR(18)";
        } else {
            unless ( $type =~ m/^(CHAR|VARCHAR|INTEGER|TEXT|BLOB)(\([^\)]+\))?$/ ) {
                logtrc 3, "%s is %s", $column, $type;
                $type = "VARCHAR(255)"
            }
        }
        if ( $column eq 'id' ) {
            push @cols, "id INTEGER PRIMARY KEY NOT NULL";
        } else {
            push @cols, sprintf "%s %s NULL", $column, $type;
        }
    }
    my $sql =  sprintf "\nCREATE TABLE %s (\n\t%s\n)", $tablename, join ",\n\t", @cols;
    logtrc 4, $sql;
    return $sql
}



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

    $terms ||= {};
    unless ( ref $terms ) {
        die join ', ', caller(0)
    }
    # if no terms present, just return an empty string
    unless ( keys %$terms ) {
        return ("", ());
    }
    my ($sql, @where, @bind_params);
    while ( my ($k, $v) = each %$terms ) {
        push @where, "$k=?";
        push @bind_params, $v
    }
    $sql = "WHERE " . join (" AND ", @where);
    return ($sql, \@bind_params)
}



sub _prepare_select {
    my ($self, $table_name, $terms, $args, $cols) = @_;

    my ($sql, @where, @bind_params, $selected_cols);
    my ($where_clause, $bind_params) = $self->_prepare_where_clause($terms);
    $selected_cols = $cols ? join (", ", @$cols) : "*";
    $sql = sprintf("SELECT %s FROM %s %s", $selected_cols, $table_name, $where_clause);
    if ( defined $args ) {
        $args->{limit}      ||= 1000;
        $args->{offset}     ||= 0;
        if ( $args->{'sort'} ) {
            $args->{direction}  ||= 'asc';
            $sql .= sprintf(" ORDER BY %s %s", $args->{'sort'}, $args->{direction})
        }
        $sql .= sprintf(" LIMIT %d, %d", $args->{offset}, $args->{limit})
    }
    return ($sql, $bind_params)
}



sub _prepare_delete {
    my ($self, $table_name, $terms) = @_;

    my ($sql, @where, @bind_params);
    $sql = "DELETE FROM $table_name ";

    my ($where_clause, $bind_params) = $self->_prepare_where_clause($terms);
    $sql .= $where_clause;

    return ($sql, $bind_params)
}



sub _prepare_insert {
    my ($self, $table_name, $columns) = @_;

    my ($sql, @fields, @values, @bind_params);
    $sql = "INSERT INTO $table_name";

    while ( my ($k, $v) = each %$columns ) {
        push @fields, $k;
        push @values, '?';
        push @bind_params, $v
    }

    $sql .= sprintf(" (%s) VALUES(%s)", join(", ", @fields), join(", ", @values) );
    return ($sql, \@bind_params)
}



sub _prepare_update {
    my ($self, $table_name, $columns, $terms) = @_;

    my ($sql, @fields, @bind_params);
    $sql = "UPDATE $table_name SET ";

    while ( my ($k, $v) = each %$columns ) {
        push @fields, "$k=?";
        push @bind_params, $v
    }

    $sql .= join (", ", @fields);

    my ($where_clause, $where_params) = $self->_prepare_where_clause($terms);
    $sql .= " " . $where_clause;

    return ($sql, [@bind_params, @$where_params])
}



sub _tablename {
    my ($self, $object_name, $props, $dbh) = @_;

    if ( defined $props->{datasource}->{Table} ) {
        return $props->{datasource}->{Table}
    }

    my $table_name = lc $object_name;
    $table_name =~ s/\W+/_/g;

    return $table_name
}



sub load {
    my $self = shift;
    my ($object_name, $props, $id) = @_;

    my $dbh = $self->dbh($object_name, $props) or return;
    my $table = $self->_tablename($object_name, $props, $dbh) or return;
    my ($sql, $bind_params) = $self->_prepare_select($table, {id=>$id});

    my $sth = $dbh->prepare( $sql );
    unless ( $sth->execute( @$bind_params ) ) {
        $self->errstr($sth->errstr);
        return undef
    }

    return $sth->fetchrow_hashref
}



sub load_ids {
    my $self = shift;
    my ($object_name, $props, $terms, $args) = @_;

    my $dbh   = $self->dbh($object_name, $props)              or return;
    my $table = $self->_tablename($object_name, $props, $dbh) or return;
    my ($sql, $bind_params)   = $self->_prepare_select($table, $terms, $args, ['id']);


    my $sth   = $dbh->prepare( $sql );

    unless( $sth->execute(@$bind_params) ) {
        $self->errstr($sth->errstr);
        return undef
    }

    unless ( $sth->rows ) {
        return []
    }

    my @data_set = ();
    while ( my $row = $sth->fetchrow_hashref() ) {
        push @data_set, $row->{id}
    }
    return \@data_set
}



sub remove {
    my $self = shift;
    my ($object_name, $props, $id)  = @_;

    unless ( defined $id ) {
        $self->errstr("remove(): don't know what to remove. 'id' is missing");
        return undef
    }

    my $dbh                 = $self->dbh($object_name, $props)              or return;
    my $table               = $self->_tablename($object_name, $props, $dbh) or return;
    my ($sql, $bind_params) = $self->_prepare_delete($table, {id=>$id});

    my $sth                 = $dbh->prepare( $sql );
    unless ( $sth->execute($id) ) {
        $self->errstr($sth->errstr);
        return undef
    }
    return $id
}



sub remove_all {
    my $self  = shift;
    my ($object_name, $props, $terms) = @_;

    my $dbh                 = $self->dbh($object_name, $props)              or return;
    my $table               = $self->_tablename($object_name, $props, $dbh) or return;
    my ($sql, $bind_params) = $self->_prepare_delete($table, $terms);

    my $sth   = $dbh->prepare( $sql );
    unless ( $sth->execute(@$bind_params) ) {
        $self->errstr($sth->errstr);
        return undef
    }
    return 1
}



sub drop_datasource {
    my $self = shift;
    my ($object_name, $props) = @_;

    my $dbh = $self->dbh($object_name, $props) or return;
    my $table= $self->_tablename($object_name, $props, $dbh) or return;
    unless ( $dbh->do( "DROP TABLE $table" ) ) {
        $self->errstr( $dbh->errstr );
        return undef
    }

    return 1
}



sub count {
    my $self = shift;
    my ($object_name, $props, $terms) = @_;

    my $dbh                         = $self->dbh($object_name, $props)  or return;
    my $table                       = $self->_tablename($object_name, $props, $dbh) or return;
    my ($where_clause, $bind_params)= $self->_prepare_where_clause($terms);
    my $sql                         = "SELECT COUNT(*) FROM $table " . $where_clause;

    my $sth                         = $dbh->prepare( $sql );
    unless ( $sth->execute( @$bind_params ) ) {
        $self->errstr($sth->errstr);
        return undef
    }

    my $count = $sth->fetchrow_array || 0;
    return $count
}



sub _read_lock {
    my ($self, $dbh, $table) = @_;






}



sub _write_lock {
    my ($self, $dbh, $table) = @_;






}



sub _unlock {
    my ($self, $dbh, $table) = @_;






}







1;
__END__