File Coverage

lib/LEOCHARRE/Database.pm

Criterion	Covered	Total	%
statement	76	101	75.2
branch	14	46	30.4
condition	3	8	37.5
subroutine	18	24	75.0
pod	13	13	100.0
total	124	192	64.5

package LEOCHARRE::Database;
use DBI;
use strict;
use warnings;
use Carp;
use LEOCHARRE::DEBUG;
use base 'LEOCHARRE::Database::Base';
use vars qw($VERSION);
$VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)/g;


sub dbh {
   my $self = shift;
   unless( $self->{DBH} ){

      $self->{AUTOCOMMIT} ||=0;

      if( ! defined $self->{DBABSPATH} ){
         debug('will open mysql connection..');
   	   my $dbname		= $self->{DBNAME} or confess('missing DBNAME argument to constructor');
		   my $user			= $self->{DBUSER} or confess('missing DBUSER argument to constructor');
		   my $password	= $self->{DBPASSWORD} or confess('missing DBPASSWORD argument to constructor');

	   	$self->{DBH} = DBI::connect_mysql($self->{DBNAME}, $self->{DBUSER}, $self->{DBPASSWORD}, $self->{DBHOST})
            or die('connect_mysql failed');
         debug("ok");
      }


      else {
         $self->{DBABSPATH} or confess('DBABSPATH argument to constructor bad');
         debug("will open sqlite connection..$$self{DBABSPATH} ");

         $self->{DBH} = DBI::connect_sqlite($self->{DBABSPATH}) or die('conect_sqlite failed');
      }
      $self->{__DBH_IS_LOCAL_} = 1;

      $self->{DBH}->{RaiseError} = 1; # freak out when things go bad
      #$self->{DBH}->{PrintError} = 1; # print error or not

      $self->{DBH}->{AutoCommit} = $self->{AUTOCOMMIT};

      if ($DEBUG){
         $LEOCHARRE::Database::Base::DEBUG=1;
      }


   }
   return $self->{DBH};
}


# did the connection happen here?
sub _dbh_is_local {
   my $self = shift;
   $self->{__DBH_IS_LOCAL_} ||=0;
   return $self->{__DBH_IS_LOCAL_};
}


sub dbh_selectcol {
   my ($self, $statement) = @_;
   return $self->dbh->selectcol($statement);
}


sub dbh_do {
   my($self, $arg) = @_;
   defined $arg or confess('missing arg');
   ref $arg eq 'HASH' or confess('arg must be hashref');
   defined $arg->{sqlite} or confess('missing sqlite key');
   defined $arg->{mysql} or confess('missing mysql key');

   my $q = $self->dbh->is_mysql ? $arg->{mysql} : $arg->{sqlite};

   $self->dbh->do($q) ; # TODO or .. ????

   return 1;
}
sub dbh_count {
   my ($self,$statement) = @_;
   return $self->dbh->rows_count($statement);
}

sub dbh_sth {
   my ($self, $statement) = @_;
   $statement or confess("missing statement argument");

   unless ($self->{_handles}->{$statement}){
      $self->{_handles} ||={};
      debug("preparing [$statement]..");

      local $self->dbh->{RaiseError};
      my $sth = $self->dbh->prepare($statement);
      defined $sth or confess("statment [$statement] failed to prepare, ". $self->dbh->errstr );
      $self->{_handles}->{$statement} = $sth;
   }

   return $self->{_handles}->{$statement};
}

sub dbh_is_sqlite {
	my $self = shift;
   return $self->dbh->is_sqlite;
}

sub dbh_is_mysql {
	my $self = shift;
   return $self->dbh->is_mysql;
}

sub dbh_driver {
	my $self = shift;
   return $self->dbh->driver;
}



sub dbh_droptable {
   my ($self,$tablename) = @_;
   return $self->dbh->drop_table($tablename);
}

sub dbh_table_exists {
   my ($self,$tablename) = @_;
   return $self->dbh->table_exists($tablename);
}

sub dbh_table_dump {
   my ($self,$tablename) = @_;
   return $self->dbh->table_dump($tablename);
}



sub dbh_lid {
   my ($self,$tablename) = @_;
   return $self->dbh->lid($tablename);
}


# for retro
sub dbh_close_active_handles {
   my $self = shift;
   defined $self->dbh or return 1;
   return $self->dbh->close_active_handles;
}



sub DESTROY {
   my $self = shift;

   defined $self->dbh or return 1;

   $self->_dbh_is_local or debug("dbh is not local\n") and return 1;
#   unless( $self->dbh->{AutoCommit} or return 1;
   debug("dbh is local..");


   $self->dbh->close_active_handles;



   unless ( $self->dbh->{AutoCommit} ){
      debug("committing..");
      local $self->dbh->{RaiseError};
      $self->dbh->commit or confess("cannot commit.. ".$self->dbh->errstr);
      debug("done.\n");
   }

   {
      # sqlite reports errors here.. a bug
      # "closing dbh with active statement handles at.."
      # this is a brute force approach to get rid of that warning
      no warnings;
      (local $SIG{'__WARN__'} = sub {} ) if $self->dbh->is_sqlite;

      $self->dbh->disconnect;
      debug("disconnected.\n");
   };

   return 1;
}






1;

__END__