Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

DBI abstraction

by Ryszard (Priest)
on May 15, 2002 at 12:32 UTC ( #166704=snippet: print w/replies, xml ) Need Help??
Description: A handy bit of code I use to manage my DBI calls. IT allows you to:
  1. cache multiple DB handles
  2. cache multiple SQL statements
  3. use any cached statement against any DB handle you may have

NB: This is hardcoded as Oracle only, however wouldnt be too hard to adapt to multiple RDBMS's ...

update: Added support for bindvars (you must parse the multiples as an array). Fixed bug under warnings when $args{hash} was not defined in private _execute method.

update: Fixed bug in DESTROY thx to eric256

package DBhandler;

$VERSION = 1.00;
use strict;
use DBI;
use Carp;
use Data::Dumper;

  #Encapsulated class data

    my %_log_attr =  #      DEFAULT  ACCESSIBILITY REQUIRED
          _cache        => [undef,   'read',        undef], 
          _handle       => [undef,   'read',        undef]

    #is a specirfied object attribute accessible in a given mode
    sub _accessible {
      my ($self, $attr, $mode) = @_;
      $_log_attr{$attr}[1] =~ /$mode/

    # Classwide default value for a specified object attributes
    sub _default_for {
      my ($self, $attr) = @_;

    sub _required {
      my ($self, $attr) = @_;

    # list of names of all specified object attributes
    sub _standard_keys
      keys %_log_attr;

    sub _get_db_handle {

        my ($self, %args) = @_;
        croak "Must supply username" unless ($args{user});
        croak "Must supply password" unless ($args{pwd});
        croak "Must supply SID"      unless ($args{sid});

        my $dsn  = "DBI:Oracle:".$args{sid};           #set the datase
+t name
        my %attr = ( RaiseError => 1, PrintError => 0 ); #set error ra
+ising and printing 

        # lets go get the handle
        my $handle = DBI->connect($dsn,$args{user},$args{pwd}, \%attr)
        croak "Unable to connect to ".$args{sid} unless ($handle);
        return $handle;

    sub _execute {
        my ($self, %args) = @_;
        my ($retval, %rethash, @retary);

        croak "Invalid statement name (".$args{statement}.") " 
              if (!defined $self->{_cache}{$args{statement}} );

        croak "Must supply a handle to execute the statement on! " 
              if (!defined $args{handle} );

        #prepare the sql for execution
        my $sth = $self->{_db_handle}{$args{handle}}->prepare($self->{

        $sth->execute(@{$args{bindvar}});                      #execut
+e the statement
        if ($self->{_cache}{$args{statement}} =~ /^SELECT/i) {
            if (defined $args{hash}) {
                while (my @row = $sth->fetchrow_array ){  #fetch the r
+ows into an array reference
                    push @{$rethash{shift(@row)}}, @row;   #push the a
+rray onto an list to return
                $retval = \%rethash;
            } else {
                while (my $row = $sth->fetchrow_arrayref ){  #fetch th
+e rows into an array reference
                    push @retary, [$row];        #push the array onto 
+an list to return
                $retval = \@retary;               #return a reference 
+to the container  

        croak "DB error when executing ".$args{statement}." (".$self->
            if (defined $self->{_db_handle}{$args{handle}}->errstr);
        return $retval;

sub new {
    my ($caller, %arg) = @_;
    my $caller_is_obj = ref($caller);
    my $class = $caller_is_obj  || $caller;
    my $self  = bless {}, $class;
    foreach my $attrname ($self->_standard_keys() )
      my ($argname) = ($attrname =~ /^_(.*)/);
      if (exists $arg{$argname})     
          { $self->{$attrname} = $arg{$argname} ;
      elsif ($caller_is_obj)
          { $self->{$attrname} = $caller->{$argname}; 
          { $self->{$attrname} = $self->_default_for($attrname) }
      croak "Must supply value for ".$argname 
         if ($self->_required($attrname) && !$self->{$attrname} ) ;
    croak "Must supply DB handle name" unless ($arg{handle} );
    $self->{_db_handle}{$arg{handle}} = $self->_get_db_handle(%arg); 

    return $self;

# This routine will accept a hash containing a statement
# handle (hash key) and statement (hash value)
sub add_sql {

    my ($self, %cache) = @_;
    croak "Must supply a statement to cache " if (!%cache);
    foreach my $ele (keys %cache){
        $self->{_cache}{$ele} = $cache{$ele}; 

sub execute {
    my ($self, %args) = @_;    
    my $statement;

    croak "SQL statement not found for ".$args{statement} 
          unless ($self->{_cache}{$args{statement}} );

    croak "DB handle not found for ".$args{handle} 
          unless ($self->{_db_handle}{$args{handle}} );

    return $self->_execute(%args);

sub fetch_handle {
    my ($self, %args) = @_;
    croak "Must supply SID"  unless ($args{sid});
    croak "Must supply name" unless ($args{handle});
    croak "Must supply user" unless ($args{user});
    croak "Must supply pwd"  unless ($args{pwd});

    $self->{_db_handle}{$args{handle}} = $self->_get_db_handle(%args);


    my $self = shift;
    foreach (keys %{$self->{_db_handle}}) {
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://166704]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2017-06-27 13:14 GMT
Find Nodes?
    Voting Booth?
    How many monitors do you use while coding?

    Results (606 votes). Check out past polls.