File Coverage

blib/lib/DBIx/SQL/Abstract.pm

Criterion	Covered	Total	%
statement	21	53	39.6
branch	0	14	0.0
condition			n/a
subroutine	7	9	77.7
pod	1	1	100.0
total	29	77	37.6

# $DBIx::SQL::Abstract.pm,v 1.1 2005/09/06  14:15:53 alex Exp $
#
# Copyright (c) 2004 Alejandro Juarez
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

# PURPOSE: This module was created to serve several functions inhereted
#          from the DBIx and SQL::Abstract modules ...
#
# USAGE: To read the HOW TO USE instructions you need to run perldoc:
#        perldoc DBIx::SQL::Abstract


package DBIx::SQL::Abstract;
use strict;
use warnings;
use Carp;
use base 'DBIx';
use SQL::Abstract;
use DBI;
use vars qw(@ISA);
require Exporter;
@ISA = qw(DBI DBI::db DBI::st SQL::Abstract);

our $VERSION = '0.07';

sub new {
    my $class = shift;
    my %params = @_;

    # Setting the DBIx and database default parameters
    my $db = { driver => 'Pg',
	       dbname => 'db',
	       host => undef,
	       port => undef,
	       user => 'user',
	       passwd => undef,
	       attr => undef, # Used for DBI attributes
	   };

    # Setting the DBIx and database default attributes
    my $dbiattr = { PrintError => 1,
		    RaiseError => 0,
		    AutoCommit => 0,
		    ChopBlanks => 1
		    };
    my $knownargs = join ('|', keys %$db);

    # Checking for 2 explicit options in the arguments
    if ( $#_ >= 3 ) {
	# Checking if here we had unknown arguments
	my @unknownargs = grep { $_ !~ /^($knownargs)$/ } keys %params;

	if ( ! @unknownargs ) {

	    # Checking for the existence of explicit args: dbname && user
	    my @minargs = map { $_ =~ /^(dbname|user)$/ } keys %params;
	    if ( $#minargs == 1) {

		# Setting the arguments for the database connection
		map { $db->{$_} = $params{$_} } keys %params;
		my ($dbLine, @dbargs);
		$dbLine = "dbi:$db->{driver}:dbname='$db->{dbname}'";
		push @dbargs, $dbLine, $db->{user}, $db->{passwd};

		# Setting the DBI Attributes
		if  ( $db->{attr} ) {
		    my $attr = $db->{attr}; #used only for a better style
		    map { $dbiattr->{$_} = $attr->{$_} } keys %$attr;
		}

		# Here, All is Right, we'll open the database connection
		my $dbh = DBI->connect(@dbargs, \%$dbiattr) or
		    die ("Failed to open database connection:\n",
			 $DBI::errstr);

		return bless $dbh, $class;

	    } else {
		die 'You need the DSN options: [dbname | user]';
	    }

	} else {
	    die 'Unknown argument(s) received: ', join(', ', @unknownargs);
	}

    } else {
	die 'You need the DSN options: dbname => DBNAME, user => USER';
    }
}


sub DESTROY {
    # If we are not in autocommit mode, roll back any transactions left
    # pending. Cleanly disconnect from the database before disappearing.
    my $self = shift;

    if (ref $self ) {
  	if ($self->{AutoCommit} == 1 ) {
  	    $self->commit;
  	} else {
  	    $self->rollback;
  	}
    }

    return 1;
}


1;
__END__