http://qs1969.pair.com?node_id=101631
Category: Miscellaneous
Author/Contact Info rob_au
Description: A while ago, I asked the collective wisdom of the Monastery regarding Metadata and DBI Abstraction in the context of utilising a simplier DBI interface for a medium-to-large web site I was working on. From this node, I received a number of very useful suggestions and recommendations via both follow-up nodes and the chatterbox, one of which almost led me to distraction with Tangram. After this experience I set about re-inventing the wheel to a certain extent, implementing a very basic abstraction class (which I later found had many similarities, in a basic form, to BingoX::Carbon to which princepawn directed me).
 
To this end, I present this very simple DBI abstraction class which may help others, who like myself, have need for a simple DBI abstraction class with a minimal learning curve (although if I had the time, I think I would have gone down the path of BingoX::Carbon). This module has been written to interface a PostgreSQL database and introduces new, connect, disconnect, param, select_array and select_hash abstraction methods which should be very easy to use for anyone familiar with the DBI interface. At this stage, the commit method has not been implemented, this abstraction class representing a read-only interface at this point in time.
 
In practical terms, this abstraction class allowed me to build a catalogue and shopping interface to a PostgreSQL database comprised of more than 5,000 products in under a fortnight of development time.
 
package Simple::Abstraction;

use Carp;
use DBI;
use strict;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();

our $VERSION = '0.33';

sub commit {
    my ($parent, $args) = @_;
    my ($self) = {};
    bless ($self);
    return undef unless (defined($parent->{dbh}));
    print STDERR "Simple::Abstraction->commit - Not implemented at thi
+s time\n" if ($parent->{debug});
    return;
};

sub connect {
    my ($param) = shift;
    my ($class) = ref($param) || $param;
    my ($parent) = {};
    bless ($parent, $class);
    my (%args) = @_;
    $parent->{debug} = ($args{'debug'} =~ /^\d+$/) ? $args{'debug'} : 
+0;
    $parent->{driver} = (length($args{'driver'})) ? $args{'driver'} : 
+"Pg";
    $parent->{username} = (length($args{'username'})) ? $args{'usernam
+e'} : undef;
    $parent->{password} = (length($args{'password'})) ? $args{'passwor
+d'} : undef;
    $parent->{database} = (length($args{'database'})) ? $args{'databas
+e'} : "test";
    $parent->{hostname} = (length($args{'hostname'})) ? $args{'hostnam
+e'} : "localhost";
    $parent->{dsn} = "DBI:" . $parent->{driver} . ":dbname=" . $parent
+->{database} . ";host=" . $parent->{hostname};

    print STDERR "Simple::Abstraction->connect - Creating connection t
+o DSN '", $parent->{dsn}, "'\n" if ($parent->{debug});

    unless ($parent->{dbh} = DBI->connect($parent->{dsn}, $parent->{us
+ername}, $parent->{password})) {
        croak "Cannot connect to '", $parent->{dsn}, "' - ", $DBI::err
+str, "\n";
    };
    return ($parent);
};

sub disconnect {
    my ($parent, $args) = @_;
    unless ($parent->{dbh}->disconnect) {
        croak "Cannot disconnect from '", $parent->{dsn}, "' - ", $DBI
+::errstr, "\n";
    };
    undef $parent;
    return 1;
};

sub new {
    my ($parent, $type, $args) = @_;
    my ($self) = {};
    bless ($self);
    return undef unless (defined($parent->{dbh}));

    $self->{type} = $type;
    $self->{parent} = \$parent;

    print STDERR "Simple::Abstraction->new - Creating new object of ty
+pe '", $self->{type}, "'\n" if (${$self->{parent}}->{debug});

    if (ref($args) eq 'HASH') {
        foreach my $param (keys(%{$args})) {
            $$args{$param} =~ s/\"/\\\"/g;
            eval qq/
                \$self->{data}->{$param} = "$$args{$param}";
            /;
            print STDERR "Simple::Abstraction->new - Setting parameter
+ '", $param, "' for object of type '", $self->{type}, "'\n" if (${$se
+lf->{parent}}->{debug});
        };
    };

    return ($self);
};

sub param {
    my ($self) = shift;
    my ($args) = @_;
    return undef unless (defined($self->{type}));

    if (ref($args) eq 'HASH') {
        foreach my $param (keys(%{$args})) {
            $$args{$param} =~ s/\"/\\\"/g;
            eval qq/
                \$self->{data}->{$param} = "$$args{$param}";
            /;
            print STDERR "Simple::Abstraction->param - Setting paramet
+er '", $param, "' for object of type '", $self->{type}, "'\n" if (${$
+self->{parent}}->{debug});
        };
    } elsif (defined($args)) {
        my ($param) = $args;
        if (defined($self->{data}->{$args})) {
            print STDERR "Simple::Abstraction->param - Returning param
+eter '", $args, "' for object of type '", $self->{type}, "'\n" if (${
+$self->{parent}}->{debug});
            return ($self->{data}->{$args});
        };
    } else {
        return (keys (%{$self->{data}}));
    };

    return;
};

sub select_array {
    my ($parent, $type, $args, $order) = @_;
    my ($self) = {};
    bless ($self);
    return undef unless (defined($parent->{dbh}));
    $self->{type} = $type;

    my (@results);

    print STDERR "Simple::Abstraction->select_array - Creating new arr
+ay for select results from table '", $self->{type}, "'\n" if ($parent
+->{debug});

    my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}")
+;
    $sth->execute;

    my (@fields, @search);
    for (my $index = 0; $index < $sth->{NUM_OF_FIELDS}; $index++) {
        if (defined($$args{$sth->{NAME}->[$index]})) {
            push (@search, $sth->{NAME}->[$index]." ~~ '".$$args{$sth-
+>{NAME}->[$index]}."'");
        };
        push (@fields, $sth->{NAME}->[$index]);
    };
    my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}" 
+.
        (($#search >= 0) ? " where ".join(" and ", @search) : undef) .
+ 
        ((ref($order) eq 'ARRAY') ? " order by ".join(", ", @{$order})
+ : undef)
    );
    $sth->execute;
    while (my (@row) = $sth->fetchrow_array) {
        my (%row);
        foreach my $field (@fields) {
            $row{$field} = shift(@row);
        };
        push (@results, $parent->new($self->{type}, \%row));
    };

    return (@results);
};


sub select_hash {
    my ($parent, $type, $args) = @_;
    my ($self) = {};
    bless ($self);
    return undef unless (defined($parent->{dbh}));
    $self->{type} = $type;

    my (%results);

    print STDERR "Simple::Abstraction->select_hash - Creating new hash
+ for select results from table '", $self->{type}, "'\n" if ($parent->
+{debug});

    my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}")
+;
    $sth->execute;

    my (@fields, @search);
    for (my $index = 0; $index < $sth->{NUM_OF_FIELDS}; $index++) {
        if (defined($$args{$sth->{NAME}->[$index]})) {
            push (@search, $sth->{NAME}->[$index]." ~~ '".$$args{$sth-
+>{NAME}->[$index]}."'");
        };
        push (@fields, $sth->{NAME}->[$index]);
    };
    my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}".
+(($#search >= 0) ? " where ".join(" and ", @search) : undef));
    $sth->execute;
    while (my (@row) = $sth->fetchrow_array) {
        my (%row);
        foreach my $field (@fields) {
            $row{$field} = shift(@row);
        };
        my ($result) = $parent->new($self->{type}, \%row);
        $results{$result->param($fields[0])} = $result;
    };

    return (%results);
};

1;

__END__