File Coverage

blib/lib/DBIx/MySperqlOO.pm

Criterion	Covered	Total	%
statement	18	146	12.3
branch	0	64	0.0
condition	0	6	0.0
subroutine	6	30	20.0
pod	4	15	26.6
total	28	261	10.7

package DBIx::MySperqlOO;
use Class::Std;
use Class::Std::Utils;
use strict;
use warnings;
use DBI;

use version; our $VERSION = qv('1.0.1');

{
	my %dbh_of  : ATTR();
	my %sth_of  : ATTR();
	my %dbd_of  : ATTR();
	my %db_of   : ATTR();
	my %host_of : ATTR();
	my %user_of : ATTR();
	my %pass_of : ATTR();
	my %dsn_of  : ATTR();

	sub BUILD {
		my ( $self, $ident, $arg_ref ) = @_;

		$dbd_of{$ident}  = $arg_ref->{dbd}  ? $arg_ref->{dbd}  : 'mysql';
		$db_of{$ident}   = $arg_ref->{db}   ? $arg_ref->{db}   : $arg_ref->{database};
		$host_of{$ident} = $arg_ref->{host} ? $arg_ref->{host} : 'localhost';
		$user_of{$ident} = $arg_ref->{user} ? $arg_ref->{user} : '';
		$pass_of{$ident} = $arg_ref->{pass} ? $arg_ref->{pass} : '';
		$dsn_of{$ident}  = $arg_ref->{dsn} ?  $self->_build_dsn() : '';

		$self->connect();

		return;
	}

	sub set_dbd  { my ($self, $value) = @_; $dbd_of{ident $self} = $value; $self->_build_dsn(); return $self; }
	sub set_db   { my ($self, $value) = @_; $db_of{ident $self} = $value; $self->_build_dsn(); return $self; }
	sub set_host { my ($self, $value) = @_; $host_of{ident $self} = $value; $self->_build_dsn(); return $self; }
	sub set_user { my ($self, $value) = @_; $user_of{ident $self} = $value; $self->_build_dsn(); return $self; }
	sub set_pass { my ($self, $value) = @_; $pass_of{ident $self} = $value; $self->_build_dsn(); return $self; }
	sub set_dsn  { my ($self, $value) = @_; $dsn_of{ident $self} = $value; return $self; }

	sub get_user { my ($self)  = @_; return $user_of{ident $self}; }
	sub get_pass { my ($self)  = @_; return $pass_of{ident $self}; }
	sub get_dsn  { my ($self)         = @_; my ($ident)        = ident $self; if (! $dsn_of{$ident} ) { $self->_build_dsn(); } return $dsn_of{$ident}; }

	sub _build_dsn { my ($self)       = @_; my ($ident) = ident $self; $dsn_of{$ident} = 'DBI:' . $dbd_of{$ident} . ':database=' . $db_of{$ident} . ';host=' . $host_of{$ident}; }

	sub connect {
		my ($self) = @_;
		my ($ident) = ident $self;

		# Either connect or quit with error
		$dbh_of{$ident} = DBI->connect( $self->get_dsn(), $self->get_user(), $self->get_pass() );

		# Emit error string if connect failed
		if ($DBI::err) { warn "ERROR: $DBI::err : $DBI::errstr [DBConnect failed]"; }

		return $dbh_of{$ident};
	}

	sub sqlexec {
		my ( $self, $sql, $type, $parameters ) = @_;

		$type = $type ? $type : '$sth';

		# Execute the sql with the given params
		$sth_of{ident $self} = $self->_sqlexecute( $sql, $parameters );

		# Check for type of return
		if ($type =~ m/sth/) {
			# Return the handle
			return $sth_of{ident $self};
		} else {
			# Return the data per type
			return $self->_sqlfetch( $type );
		}
	}

	sub _sqlexecute {
		my ( $self, $sql, $parameters ) = @_;
		my $ident = ident($self);

		# Check parameters and prepare
		$sth_of{$ident} = $self->_sqlparse( $sql, $parameters );

		# Execute
		$sth_of{$ident}->execute() or return "ERROR: [database.pl:_sqlexecute]$DBI::err : $DBI::errstr [_sqlexecute failed]";

		# Return statement handle
		return $sth_of{ident $self};
	}

	sub _sqlparse {
		my ( $self, $test, $parameters) = @_;
		my $ident = ident($self);

		if ($self->_is_handle($test)) {
			# Handle
			$sth_of{$ident} = $dbh_of{$ident}->prepare($test->{Statement}) or return "ERROR: Could not prepare handle [_sqlparse failed]";
		} else {
			# SQL string
			# Get database handle
			if (!($dbh_of{$ident}->{Active})) { $dbh_of{$ident} = &DBConnect; }

			# Prepare the statement
			$sth_of{$ident} = $dbh_of{$ident}->prepare($test) or return "ERROR: Could not prepare statement [_sqlparse failed]";
		}

		return $sth_of{ident $self};
	}

	sub _sqlfetch {
		my ( $self, $type ) = @_;

		if    ($type eq '\@@') { $self->_fetch_all_array_ref(); }
		elsif ($type eq '\@')  { $self->_fetch_row_array_ref(); }
		elsif ($type eq '@')   { $self->_fetch_row_array();     }
		elsif ($type eq '\%')  { $self->_fetch_row_hash_ref();  }
		else                   { return "ERROR: type($type) [_sqlfetch failed]"; }
	}

	sub _fetch_all_array_ref {
		my ( $self ) = @_;
		my ($ref)    = $sth_of{ident $self}->fetchall_arrayref;
		if ($DBI::err) { return "ERROR: Fetching Error($DBI::err) $DBI::errstr [_fetch_all_array_ref failed]"; }
		return $ref;
	}

	sub _fetch_row_array_ref {
		my ( $self ) = @_;
		my ($ref)    = $sth_of{ident $self}->fetchrow_arrayref;
		if ($DBI::err) { return "ERROR: Fetching Error($DBI::err) $DBI::errstr [_fetch_row_array_ref failed]"; }
		return $ref;
	}

	sub _fetch_row_array {
		my ( $self ) = @_;
		my (@array)  = $sth_of{ident $self}->fetchrow_array;
		if ($DBI::err) { return "ERROR: Fetching Error($DBI::err) $DBI::errstr [_fetch_row_array failed]"; }
		return @array;
	}

	sub _fetch_row_hash_ref {
		my ( $self ) = @_;
		my ($ref)    = $sth_of{ident $self}->fetchrow_hashref;
		if ($DBI::err) { return "ERROR: Fetching Error($DBI::err) $DBI::errstr [_fetch_row_hash_ref failed]"; }
		return $ref;
	}

	sub get_row_count {
		my $self = shift @_;
		my $ref = $_[0];

		# Check to see if it is a non array reference
		if (($ref =~ /SCALAR/) or ($ref =~ /HASH/)) {
			if ($ref =~ /HASH/) {
				# It is a reference to a hash
				# Return the number of keys for hash
				return keys(%$ref);
			} else {
				# It is a scalar
				# Return 1 for scalar
				return 1;
			}
		} else {
			if ($ref =~ /ARRAY/) {
				if (@{ $ref->[0] }) {
					return @$ref;
			} else {
			  return 0;
			}
			} else {
				# It is a simple array or scalar
				return 1;
			}
		}
	}

	sub get_col_count {
		my $self = shift @_;
		my $ref = $_[0];

		# Check to see if it is a non array reference
		if (($ref =~ /SCALAR/) or ($ref =~ /HASH/)) {
			if ($ref =~ /HASH/) {
				# It is a reference to a hash
				# Return the number of keys for hash
				return keys(%$ref);
			} else {
				# It is a scalar
				# Return 1 for scalar
				return 1;
			}
		} else {
			# Evaluates the length of the first row
			# Only non zero for actual array of arrays
			if (@{ $ref->[0] }) {
				# It is a reference to an array of arrays
				# Return the length of the first row
				return @{ $ref->[0] };
			} else {
				# Regular arrays, array references, and
				# scalars land here
				# An array would have at least two elements
				# A reference or scalar would have one
				if (@_ > 1) {
					# It is an array
					# Return the length of the input array
					return @_;
				} else {
					if (@$ref) {
						# It is a reference to an array
						# Return the length of the input array
						return @$ref;
					} else {
						# It is a scalar
						# Return 1 for scalar
						return 1;
					}
				}
			}
		}
	}

	sub get_field_names { my ( $self ) = @_; my $ref = $sth_of{ident $self}->{NAME}; return @$ref; }

	sub _is_handle { my $self = shift @_; return ($_[0] =~ m/^DBI/); }

}

1; # Magic true value required at end of module

__END__