Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

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) = @_;
      $_log_attr{$attr}[0];
    }

    sub _required {
      my ($self, $attr) = @_;
      $_log_attr{$attr}[2];
    }

    # 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->{
+_cache}{$args{statement}});

        $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->
+{_cache}{$args{statement}}.")"
            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}; 
          }
      else
          { $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);
+ 


}

sub DESTROY {
    my $self = shift;
    foreach (keys %{$self->{_db_handle}}) {
        $self->{_db_handle}{$_}->disconnect;
    }
}
1
Comment on DBI abstraction
Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://166704]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (6)
As of 2015-07-30 00:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (269 votes), past polls