File Coverage

blib/lib/CGI/Lazy/DB.pm

Criterion	Covered	Total	%
statement	24	133	18.0
branch	3	36	8.3
condition			n/a
subroutine	7	17	41.1
pod	11	11	100.0
total	45	197	22.8

package CGI::Lazy::DB;

use strict;

use DBI;
use CGI::Lazy::Globals;
use Carp;

#---------------------------------------------------------------------------------------
sub config {
	my $self = shift;

	return $self->q->config;
}

#---------------------------------------------------------------------------------------
sub dbh {
	my $self = shift;

	return $self->{_dbh};
}

#---------------------------------------------------------------------------------------
sub do { #run query with no return value
	my $self = shift;
	my $query = shift;
	my @bindvars = @_;

	my $dbh = $self->dbh;
	my $sth;

	eval {
		$sth = $dbh->prepare($query);
		$sth->execute(@bindvars) or carp $!;
	};

	if ($@) {
		$self->q->errorHandler->dbError;
		return;
	} else {
		return 1;
	}
}

#---------------------------------------------------------------------------------------
sub get { #run query returning single value
	my $self = shift;
	my $query = shift;
	my @bindvars = @_;

	if (ref $bindvars[0]) {
		if (ref $bindvars[0] eq 'ARRAY') {
			@bindvars = @{$bindvars[0]};
		} else {
			$self->q->errorHandler->getWithOtherThanArray;
		}
	}

	my $dbh = $self->dbh;
	my $sth;

	eval {
		$sth = $dbh->prepare($query);
		$sth->execute(@bindvars);
	};

	if ($@) {
		$self->q->errorHandler->dbError;
		return;
	}

	my @results = $sth->fetchrow_array;

	return $results[0];
}

#---------------------------------------------------------------------------------------
sub getarray { #run query with return value
	my $self = shift;
	my $query = shift;
	my @bindvars = @_;

	if (ref $bindvars[0]) {
		if (ref $bindvars[0] eq 'ARRAY') {
			@bindvars = @{$bindvars[0]};
		} else {
			$self->q->errorHandler->getWithOtherThanArray;
		}
	}

	my $dbh = $self->dbh;
	my $sth;

	eval {
		$sth = $dbh->prepare($query);
		$sth->execute(@bindvars);
	};

	if ($@) {
		$self->q->errorHandler->dbError;
		return;
	}

	return $sth->fetchall_arrayref;

}

#---------------------------------------------------------------------------------------
sub gethash { #run query with return value
	my $self = shift;
	my $query = shift;
	my $key = shift;
	my @bindvars = @_;

	my $dbh = $self->dbh;
	my $sth;

	eval {
		$sth = $dbh->prepare($query);
		$sth->execute(@bindvars);
	};

	if ($@) {
		$self->q->errorHandler->dbError;
		return;
	}

	return $sth->fetchall_hashref($key);
}

#---------------------------------------------------------------------------------------
sub gethashlist { #run query with return value
	my $self = shift;
	my $query = shift;
	my @bindvars = @_;

	if (ref $bindvars[0]) {
		if (ref $bindvars[0] eq 'ARRAY') {
			@bindvars = @{$bindvars[0]};
		} else {
			$self->q->errorHandler->getWithOtherThanArray;
		}
	}

	my $dbh = $self->dbh;
	my $sth;

	eval {
		$sth = $dbh->prepare($query);
		$sth->execute(@bindvars);
	};

	if ($@) {
		$self->q->errorHandler->dbError;
		return;
	}

	my $results = [];
	while (my $row = $sth->fetchrow_hashref) {
		push @$results, $row;
	}

	return $results;
}

#---------------------------------------------------------------------------------------
sub new {
	my $class = shift;
	my $q = shift;

	my $self = bless {_q => $q}, $class;

	if ($q->plugin->dbh) {
		my @list = split ':', $self->config->plugins->{dbh}->{dbDatasource};
		my $type = $list[1];
		$self->{_type} = $type;

		eval {
			$self->{_dbh} = DBI->connect(
					$self->config->plugins->{dbh}->{dbDatasource},
					$self->config->plugins->{dbh}->{dbUser},
					$self->config->plugins->{dbh}->{dbPasswd},
					$self->config->plugins->{dbh}->{dbArgs}
					) or die $!;
		};

		if ($@) {
			$q->errorHandler->dbConnectFailed;
			exit;
		}
	} else { #using dbh from somewhere else
		if ($q->vars->{dbh} ) { #if a dbh is specified on cgi creation use that one
			$self->{_dbh} = $q->vars->{dbh};
		} elsif ($q->config->dbhVar){
			{
				no strict 'vars';
				no strict 'refs';

				if ($self->config->plugins->{mod_perl}) {
					my $handler = $self->config->plugins->{mod_perl}->{PerlHandler};
					require Apache2::RequestUtil;
					my $r = Apache2::RequestUtil->request();
					my $mp = "$handler"->new($r);

					$self->{_dbh} = ${$mp->make_namespace."::".$self->config->dbhVar};

				} else {
					$self->{_dbh} = $main::{$self->config->dbhVar};

				}
			}
		} else {

		}
	}

	return $self;
}

#---------------------------------------------------------------------------------------
sub q {
	my $self = shift;

	return $self->{_q};
}

#---------------------------------------------------------------------------------------
sub recordset {
	my $self = shift;
	my $args = shift;

	return CGI::Lazy::DB::RecordSet->new($self, $args);

}

#---------------------------------------------------------------------------------------
sub type {
	my $self = shift;

	return $self->{_dbh}->{Driver}->{Name};
}
1

__END__