Hello Monks - I've (actualy still am) written an module that's for now called DBIx::Handy. At some point (after adding some documentation, tests ...etc) I planed to release it on CPAN.

Reasons for writing it :
Simple solution. There are other DB abstraction modules, but they are much bigger and more complicated. I ussualy need very simple SQL (insert/update) but I hate writing it :)

What it does:
Based on data that you send it as hash (I ussualy get it from CGI.pm and pass it througth Data::FormValidator) and fields in specified table it generates insert and update SQL strings, prepares them and obviosly executes them.

Of course there are few more things like (dis)connecting databases, preparing statements and executing them. I've also implemented it as Singleton since I've realised that it's stupid to pass around your DBH or in this case DBIx::Handy instance. Then I realised that I will need to connect to more than one DB at same time (get data from one, put it in second) in the project I'm curently working on so I added that too :)

I'm looking for ideas what could/should be implemented in it - and comments on what and how it looks like to you.

At this point it's basicly MySQL specific - but I dont intend to leave it on that. I was thinking of moving all things that are specific to some RDBMS into a separate modules such as DBIx::Handy::mysql ... DBIx::Handy::XXyyZZ. Not quite shure how to implement that at this point. Any sugestions?

I also posted an older version of it about two weeks ago on this 487823 node - also for comments.

Code and ussage samples:

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]
Sample of executing you'r own SQL : 
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]
Obvisoly still need some touches on supporting connections to multiple databases.

In reply to RFC DBIx::Handy by techcode

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.