File Coverage

blib/lib/DBIx/SimpleQuery.pm

Criterion	Covered	Total	%
statement	37	116	31.9
branch	10	60	16.6
condition	0	11	0.0
subroutine	10	16	62.5
pod	7	11	63.6
total	64	214	29.9

##
## File: DBIx/SimpleQuery.pm
## Author: Steve Simms
##
## Revision: $Revision$
## Date: $Date$
##
## A module designed to take away the pain of querying the database.
##

package DBIx::SimpleQuery;

use Carp;
use DBI;
use DBIx::SimpleQuery::Object;

use strict;

require Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(query qs);

our $VERSION = "0.05";

my $default_dsn;
my $default_user;
my $default_password;

my $debug = 0;

sub new {
    my ($class, %params) = @_;
    my $self = {};

    # A main goal of this module is to eliminate the need to specify
    # user and password if they can be derived.
    #
    # Try to get connection information from the following sources,
    # in decreasing order of preference:
    #
    # - Specified as arguments to query (defeats the point, but a
    #   useful override nonetheless)
    # - Given as parameters to new, which may be called explicitly by
    #   the module, instead of implicitly by query.
    if (keys %params) {
	$self->{"dsn"} = $params{"dsn"};
	$self->{"user"} = $params{"user"};
	$self->{"password"} = $params{"password"};
    }

    # - Stored as module-level variables
    elsif ($default_dsn) {
	$self->{"dsn"} = $default_dsn;
	$self->{"user"} = $default_user;
	$self->{"password"} = $default_password;
    }

    # - Stored as environment variables
    elsif ($ENV{"DBIX_SIMPLEQUERY_DSN"}) {
	$self->{"dsn"} = $ENV{"DBIX_SIMPLEQUERY_DSN"};
	$self->{"user"} = $ENV{"DBIX_SIMPLEQUERY_USER"};
	$self->{"password"} = $ENV{"DBIX_SIMPLEQUERY_PASSWORD"};
    }

    # - Read from /etc/simplequery.conf
    elsif (-r '/etc/simplequery.conf') {
	open my $config_file, '<', '/etc/simplequery.conf';
	while (<$config_file>) {
	    chomp;
	    my $line = $_;

	    # Skip Comments
	    next if $line =~ /^\#/;

	    # Skip Blank Linkes
	    next if $line eq "";
	    next if $line =~ /^\s+$/;

	    # All remaining lines should be configuration values
	    unless ($line =~ /^\s*(dsn|user|password)\s*=\s*(\S+)\s*$/) {
		croak "Bad config file format: $line";
	    }
	    else {
		$self->{$1} = $2;
	    }
	}
    }

    # - Default to the first available data source of the first
    #   available driver of Oracle, Pg, or mysql, in that order, using
    #   the current user's login name, and no password.
    else {
	my @available_drivers = DBI->available_drivers();
	@available_drivers = grep { /^(?:Oracle|Pg|mysql)$/ } @available_drivers;
	my @data_sources = DBI->data_sources(shift @available_drivers);

	$self->{"dsn"} = shift(@data_sources);
	$self->{"user"} = getpwuid($>);
	$self->{"password"} = "";
    }

    return bless $self, $class;
}

sub setDefaults  { return set_defaults(@_); }
sub set_defaults {
    my %defaults = (ref($_[0]) eq "HASH" ? %{$_[0]} : @_);
    $default_dsn = $defaults{"dsn"} if exists $defaults{"dsn"};
    $default_user = $defaults{"user"} if exists $defaults{"user"};
    $default_password = $defaults{"password"} if exists $defaults{"password"};
    return;
}

sub getDsn  { return get_dsn(@_); }
sub get_dsn {
    my $self = shift();
    $self = new DBIx::SimpleQuery unless (ref($self) eq "DBIx::SimpleQuery");
    return $self->{"dsn"};
}

sub getUser  { return get_user(@_); }
sub get_user {
    my $self = shift();
    $self = new DBIx::SimpleQuery unless (ref($self) eq "DBIx::SimpleQuery");
    return $self->{"user"};
}

sub getPassword  { return get_password(@_); }
sub get_password {
    my $self = shift();
    $self = new DBIx::SimpleQuery unless (ref($self) eq "DBIx::SimpleQuery");
    return $self->{"password"};
}

# This can be called either as a class method or a function
sub query {
    my $self = shift();
    my $query;

    if (ref($self) eq "DBIx::SimpleQuery") {
	$query = shift();
    }
    else {
	$query = $self;
	$self = new DBIx::SimpleQuery(@_);
    }

    # Establish the connection
    my $dbh;
    if ($self->{"dsn"} =~ /^DBI:Pg/) {
        $dbh = DBI->connect_cached($self->{"dsn"}, $self->{"user"}, $self->{"password"}, {
            pg_server_prepare => 0,
        });
    }
    else {
        $dbh = DBI->connect_cached($self->{"dsn"}, $self->{"user"}, $self->{"password"});
    }
    croak "Unable to establish a database connection: $DBI::errstr" unless $dbh;

    # Debug
    print STDERR "SimpleQuery: $query\n" if $debug;

    # Prepare and execute the query
    my $sth = $dbh->prepare($query);
    my $rv  = $sth->execute();

    # Was the query successful?
    croak "Query error: " . $sth->errstr unless $rv;

    # Store the results
    my $object = new DBIx::SimpleQuery::Object {
	"count" => ($rv eq "0E0" ? 0 : $rv),
	"results" => ($sth->{"Active"} ? $sth->fetchall_arrayref({}) : []),
	"iter" => 0,
	"field_count" => $sth->{"NUM_OF_FIELDS"}
	};

    # Account for DBDs that don't set $rv to be the number of rows
    # returned.
    if (not $object->{"count"} and scalar @{$object->{"results"}}) {
	$object->{"count"} = scalar @{$object->{"results"}};
    }

    # Set the implicit variable
    $_ = $object;

    # List context returns different results depending on the type of
    # query
    if (wantarray) {
	my $first_row = $object->{"results"}->[0];

	# If only one field was retrieved, return an array of the values
	if ($object->{"field_count"} == 1) {
	    my @keys = keys %{$first_row};
	    my $key = shift(@keys);
	    return map { $_->{$key} } @{$object->{"results"}};
	}

	# Otherwise return an array of hashes containing the rows
	return @{$object->{"results"}};
    }

    # If there's only one row, and one field in that row, return the
    # value instead of a SimpleQuery object.
    if ($object->{"count"}       and $object->{"count"}       == 1 and
	$object->{"field_count"} and $object->{"field_count"} == 1) {
	my ($value) = values %{$object->{"results"}->[0]};
	return $value;
    }

    # In scalar or void context, return the object itself for further
    # interaction
    return $object;
}

# This can be called either as a class method or a function
sub qs {
    my $text;
    my $self;

    # It's possible to call this function without any arguments, in
    # which case it uses $_.
    if (scalar @_ == 0) {
	$self = new DBIx::SimpleQuery;
	$text = $_;
    }
    else {
	$self = shift();
	if (ref($self) eq "DBIx::SimpleQuery") {
	    $text = shift();
	}
	else {
	    $text = $self;
	    $self = new DBIx::SimpleQuery;
	}
    }

    return "NULL" unless defined $text;

    # Establish the connection
    my $dbh = DBI->connect_cached($self->{"dsn"}, $self->{"user"}, $self->{"password"});

    # If connection successfully established, use the driver's quote
    # method for best results.
    if ($dbh) {
	return $dbh->quote($text);
    }

    # Replace quotes with double-quotes
    $text =~ s/\'/\'\'/g;

    # Returned the escaped text within quotes
    return "'$text'";
}

1;

__END__