package DBIx::Handy;

use strict;
use DBI;
use Carp;

sub new {
    my $class = shift;
    
    defined $DBIx::Handy::_instance ?
    $DBIx::Handy::_instance : ($DBIx::Handy::_instance = $class->init(
+@_));
}

sub init {    
    my $class = shift;
    my %params = @_;
    
    my $self = {_CONFIG        => {}, # holds class configuration
        _DATABASES    => {}, # holds configuration for each database
        _DBH        => {}, # holds DBH of databases
        };
    
    bless ($self,$class);
    
    # Set deafult values for config
    $params{config}->{auto_connect} ||= 'lazy';
    $self->{_CONFIG} = $params{config};
    
    if((ref ($_[0]) eq 'HASH') && (not defined $params{databases})){
    push @{$params{databases}}, shift;
    }
    
    foreach( @{ $params{databases} } ){
    
    # Set default value for this database
    $_->{host} ||= 'localhost';
    $_->{auto_connect} ||= $params{config}->{auto_connect};
    $_->{driver} ||= $params{config}->{driver};
    
    # Die if there is no driver specified
    die ('No driver specified for ' . $_->{database} . ' and no defaul
+t specified in config.')
    unless(defined $_->{driver});
    
    my $db_identifier = $_->{host} . '.' . $_->{driver} . '.' . $_->{d
+atabase};
    
    die "Database $db_identifier already configured!" if
    (defined $self->{_DATABASES}->{$db_identifier});
    
    # If we didnt received default_database setting - put this first d
+atabase to be it.
    $self->{_CONFIG}->{default_database} = $db_identifier unless(defin
+ed $self->{_CONFIG}->{default_database});
        
    $self->{_DATABASES}->{$db_identifier} = $_;
    
    $self->connect($db_identifier) if ($_->{auto_connect} eq 'startup'
+);
    }
    
    return $self;    
}

sub DESTROY {
    my $self = shift;
    
    foreach(keys %{$self->{_DATABASES}}){
    if(defined $self->{_DBH}->{$_}){
        $self->disconnect($_);
    }
    }
}

sub connect {
    my $self = shift;
    my $db_identifier = shift;
    
    $db_identifier ||= $self->{_CONFIG}->{default_database};
    
    # Connection configs
    my $c = $self->{_DATABASES}->{$db_identifier};

    unless (defined $self->{_DBH}->{$db_identifier}){
    $self->{_DBH}->{$db_identifier} =
        DBI->connect('dbi:' . $c->{driver} .
        ':database=' . $c->{database} .
        ';host=' . $c->{host},
        $c->{username}, $c->{password},
        $c->{options}) or die "Could not connect to database. Error me
+ssage: $!";
    } else {
    warn "Trying to connect but already connected!";
    }
    
    return $self->{_DBH}->{$db_identifier};
}

sub disconnect {
    my $self = shift;
    my $db_identifier = shift;
    
    $db_identifier ||= $self->{_CONFIG}->{default_database};
    
    if (defined $self->{_DBH}->{$db_identifier}){
    # Finish the STH if needed.
    $self->{_STH}->finish() if defined $self->{_STH};
    
    $self->{_DBH}->{$db_identifier}->disconnect();
    delete $self->{_DBH}->{$db_identifier};
    } else {
    warn "Trying to disconnect but already disconnected! $self";
    }
    
    # If it fails, it's already disconnect ...
    return 1;
}

sub dbh {
    my $self = shift;
    my $db_identifier = shift;
    
    $db_identifier ||= $self->{_CONFIG}->{default_database};
    
    if(defined $self->{_DBH}->{$db_identifier}){
    return $self->{_DBH}->{$db_identifier};
    } else {
    warn "Trying to get DBH but not connected to database!";
    return;
    }
}

sub prepare {
    my $self = shift;
    my $sql = shift;
    
    my $db_identifier = shift;
    
    $db_identifier ||= $self->{_CONFIG}->{default_database};
    
    unless (defined $self->{_DBH}->{$db_identifier}){
    die "You need to be connected to database to prepare the queries!"
+;
    }
    
    return $self->{_DBH}->{$db_identifier}->prepare($sql);
}

sub do {
    my $self = shift;
    
    return $self->execute(sql         => shift,  # shifts SQL string
              database     => shift); # shifts databse name
}

sub execute {
    my $self = shift;
    my %params = @_;
    
    $params{database} ||= $self->{_CONFIG}->{default_database};
    
    # Check - should we connect
    unless(defined $self->{_DBH}->{$params{database}}){
    
    $self->connect($params{database})
    if $self->{_DATABASES}->{$params{database}}->{auto_connect} eq 'la
+zy';
    
    }

    # If we received sth in params - it's prepared earlier so we dont 
+do it now.
    $self->{_STH} = $params{sth} || $self->prepare($params{sql}, $para
+ms{database});
    
    $self->{_STH}->execute(@{$params{data}});

    if(defined $params{method}){
    my $method = $params{method};    
    return $self->{_STH}->$method(  @{ $params{method_params} }  );
    } else {
    return $self->{_STH};
    }
}

sub insert {
    my $self = shift;
    my %params = @_;
    
    $params{database} ||= $self->{_CONFIG}->{default_database};
    
    my @fields = $self->_GET_FIELDS($params{table},$params{database});
  
    my $data = $params{data};
  
    my $sql = 'INSERT INTO ' . $params{table} . ' (';
    
    my ($sql_part1, $sql_part2, @data);
  
    foreach (@fields){
    if(defined($data->{$_}) && (length($data->{$_}) >= 1) && ($data->{
+$_} ne '')){
        $sql_part1 .= "$_,";
        $sql_part2 .= '?,';
        push (@data,$data->{$_});
    }
    }
  
    chop($sql_part1);
    chop($sql_part2); # to remove last ,
  
    $sql_part1 .= ')'; 
    $sql_part2 .= ')'; 
    $sql .= $sql_part1 . ' VALUES (' . $sql_part2;

    return $self->execute(sql         => $sql,
              data         => \@data,
              database     => $params{database});    
}


sub update {
    my $self = shift;

    my %params = @_;

    my @fields = $self->_GET_FIELDS($params{table}, $params{database})
+;

    my $data = $params{data};

    my $sql = 'UPDATE ' . $params{table} . ' SET ';
    my @data;

    foreach (@fields){
    if(defined($data->{$_}) && (length($data->{$_}) >= 1) &&
      ($data->{$_} ne '') && ($_ ne $params{id_field})  ){
        
        $sql .= $_ . ' = ?,';
        push @data,$data->{$_};
    }
    }

    chop($sql); # to remove last ,
    $sql .= ' WHERE ' . $params{id_field} . ' = ?'; # where id_field =
+ id_value

    push @data, $data->{$params{id_field}};

    return $self->execute(sql         => $sql,
              data         => \@data,
              database     => $params{database}); 
}

sub _GET_FIELDS {
    my $self      = shift;
    
    my $results = $self->execute(sql         => 'SHOW COLUMNS FROM ' .
+ shift , # shifts table name
                 method_params    => ['Field'],
                 method     => 'fetchall_hashref',
                 database    => shift); # shifts database name
    
    my $fields = join (" ",keys %{$results});
    
    return(keys %{$results});
}

sub _GET_DB_IDENT {
    my $self     = shift;
    my $db_name = shift;
    
    my ($count, $db_identifier);

    my ($host, $driver, $database) = split(/\./, $db_name);
    unless ((defined $host) && (defined $driver) && (defined $database
+)){
    
    foreach(keys %{$self->{_DATABASES}}){
        my ($db_host, $db_driver, $database_name) = split(/./, $_);
        
        if($db_name eq $database_name){
        $count++;
        $db_identifier = $_;
        }
        
    }
    
    die "Couldnt decide which DB to use as there are more of them with
+ same name, please specify as host.driver.db_name!"
    if ($count > 1);
    
    } else {
    
    die "Couldnt find database with that name ..."
    unless (defined $self->{_DATABASES}->{$db_name});
    
    }
    
    return $db_identifier || $db_name;
}

1;
[download]

As I mostly work with CGI::Application these days, I set up the thing in main module which is inherited by all others. to be precise in cgiapp_init method which is called before anything else.

my $DB = DBIx::Handy->new({database     => 'autoreorder',
                               auto_connect => 'startup',
                               driver       => 'mysql',
                               username     => 'alex'});
[download]

Then anywhere in the application where I need it, I either call new without parameters (as it gives me original instance - Singleton) if I'm in some other package (so I wouldnt pass original reference around) or get it from CGI::App's "storage" ( $self->param('DB') ) if in some Runmode

Sample of doing an insert (similar for update - but for now you need to specify primary key field name, plan to make that also automatic if possible for that driver) :

my $r = CGI->new();
my $form_data = $r->Vars();

# Do some checking on form data - validation

$DB->insert(table  => 'customers',
            data   => $form_data);
[download]

my $res = $self->{_DB}->execute(
              sql => 'SELECT * FROM customers WHERE email = ?',
              method => 'fetchrow_hashref',
              data => [$form_data->{email}]);

# OR something like this if you know it will return more results

my $STH = $self->{_DB}->execute(
              sql => 'SELECT * FROM customers WHERE email = ?',
              data => [$form_data->{email}]);

while($row = $STH->fetchrow_hashref()){
    # ....
}
[download]