File Coverage

blib/lib/BW/DB.pm

Criterion	Covered	Total	%
statement	15	137	10.9
branch	0	100	0.0
condition	0	23	0.0
subroutine	5	26	19.2
pod	8	20	40.0
total	28	306	9.1

# BW::DB.pm
# Normalized database routines
#   with support for MySQL and SQLite
#
# by Bill Weinman - http://bw.org/
# Copyright (c) 1995-2010 The BearHeart Group, LLC
#
# See HISTORY file.
#

package BW::DB;
use strict;
use warnings;

use base qw( BW::Base );
use BW::Constants;
use DBI;

our $VERSION = "1.1.1";

sub _init
{
    my $self = shift;
    $self->SUPER::_init(@_);

    if ( $self->{connect} or $self->{dsn} or $self->{database} or $self->{dbengine} ) {
        $self->init_db;
    }

    return SUCCESS;
}

# _setter_getter entry points
sub connect  { BW::Base::_setter_getter(@_); }
sub database { BW::Base::_setter_getter(@_); }
sub dbname   { BW::Base::_setter_getter(@_); }
sub host     { BW::Base::_setter_getter(@_); }
sub port     { BW::Base::_setter_getter(@_); }
sub socket   { BW::Base::_setter_getter(@_); }
sub user     { BW::Base::_setter_getter(@_); }
sub password { BW::Base::_setter_getter(@_); }
sub dsn      { BW::Base::_setter_getter(@_); }
sub dbh      { BW::Base::_setter_getter(@_); }
sub dbengine { BW::Base::_setter_getter(@_); }  # may be 'mysql' or 'SQLite'

# setup the database connection
sub init_db
{
    my $sn   = 'init_db';
    my $self = shift;

    my ( $dsn, $dbengine, $dbname, $database, $host, $port, $socket, $user, $password );
    $dbengine = $self->{dbengine} || 'mysql';   # default to mysql for backward compatibility

    if ( $self->connect ) {
        my @dsnarray = split( /:/, $self->{connect} );
        if( scalar @dsnarray == 2 ) {
            ( $dbengine, $dbname ) = @dsnarray;
        } else {
            ( $database, $host, $port, $user, $password ) = split( /:/, $self->{connect} );
        }
    } elsif ( $self->{dsn} ) {
        $dsn = $self->{dsn};
    } elsif ( $self->{dbname} ) {
        $dbengine = 'SQLite';
        $dbname = $self->{dbname};
    } elsif ( $self->{database} ) {
        $database = $self->{database};
        $host     = $self->{host};
        $port     = $self->{port};
        $socket   = $self->{socket};
    }

    if(lc $dbengine eq 'sqlite') { $dbengine = 'SQLite' }; # correct any miscapitalization

    $self->dbengine($dbengine) if $dbengine;    # use the setters
    $self->dbname($dbname) if $dbname;

    $user     = $self->{user}     if $self->{user};
    $password = $self->{password} if $self->{password};
    $dsn = "DBI:${dbengine}"        unless $dsn;
    $dsn .= ":database=$database"   if $database;
    $dsn .= ":dbname=$dbname"       if $dbname;
    $dsn .= ";host=$host"           if $host;
    $dsn .= ";port=$port"           if $port;
    $dsn .= ";mysql_socket=$socket" if $socket;

    $self->{dbh} = DBI->connect( $dsn, $user, $password, { PrintError => 0 } );
    return $self->_error("$sn: DBI connect error: $DBI::errstr") if $DBI::errstr;
    return $self->_error("$sn: database not connected") unless $self->{dbh};
}

# sql_do ( $query, @bind_values )
# returns number of rows affected
# use for non-SELECT ad-hoc queries
sub sql_do
{
    my $sn          = 'sql_do';
    my $self        = shift;
    my $query       = shift or return VOID;
    my @bind_values = @_;

    $self->init_db()                                unless $self->{dbh};
    return $self->_error("Database not connected.") unless $self->{dbh};

    my $rc = $self->{dbh}->do( $query, undef, @bind_values );
    if ($DBI::err) {
        return $self->_error("$sn: DBI: $DBI::errstr");
    } else {
        return $rc;
    }
}

# sql_select ( $query, @bind_values )
# returns arrayref of hashrefs or FAILURE
# hash keys are equiv of column (or query) names
sub sql_select
{
    my $sn          = 'sql_select';
    my $self        = shift;
    my $query       = shift or return VOID;
    my @bind_values = @_;

    $self->init_db()                                     unless $self->{dbh};
    return $self->_error("$sn: Database not connected.") unless $self->{dbh};

    my $rc = $self->{dbh}->selectall_arrayref( $query, { Slice => {} }, @bind_values );
    if ($DBI::err) {
        return $self->_error("$sn: DBI: $DBI::errstr");
    } elsif ( $rc && ref($rc) eq 'ARRAY' ) {
        return $rc;
    } else {
        return FAILURE;
    }
}

# sql_select_column ( $query, @bind_values )
# returns arrayref of values (scalars) or FAILURE
sub sql_select_column
{
    my $sn          = 'sql_select_column';
    my $self        = shift;
    my $query       = shift or return VOID;
    my @bind_values = @_;

    $self->init_db()                                     unless $self->{dbh};
    return $self->_error("$sn: Database not connected.") unless $self->{dbh};

    my $rc = $self->{dbh}->selectcol_arrayref( $query, undef, @bind_values );
    if ($DBI::err) {
        return $self->_error("$sn: DBI: $DBI::errstr");
    } elsif ( $rc && ref($rc) eq 'ARRAY' ) {
        return $rc;
    } else {
        return FAILURE;
    }
}

# sql_select_value ( $query, @bind_values )
# returns scalar value or FAILURE
sub sql_select_value
{
    my $sn          = 'sql_select_value';
    my $self        = shift;
    my $query       = shift or return VOID;
    my @bind_values = @_;

    $self->init_db()                                     unless $self->{dbh};
    return $self->_error("$sn: Database not connected.") unless $self->{dbh};

    my $rc = $self->{dbh}->selectcol_arrayref( $query, { MaxRows => 1 }, @bind_values );
    if ($DBI::err) {
        return $self->_error("$sn: DBI: $DBI::errstr");
    } elsif ( $rc && ref($rc) eq 'ARRAY' ) {
        return $rc->[0];
    } else {
        return FAILURE;
    }
}

# insert( table, { name => value, ... } )
# returns SUCCESS or FAILURE
sub insert
{
    my $sn      = 'insert';
    my $self    = shift or return undef;
    my $table   = shift or return undef;
    my $nvpairs = shift or return undef;
    my @cols;
    my @vals;

    $self->init_db()                                     unless $self->{dbh};
    return $self->_error("$sn: Database not connected.") unless $self->{dbh};

    foreach my $k ( keys %{$nvpairs} ) {
        push @cols, $k;
        push @vals, $nvpairs->{$k};
    }
    return FAILURE unless ( @cols and @vals );

    my $query =
        "INSERT INTO $table (" .
        join( ', ', @cols ) .
        ") VALUES (" .
        join( ', ', ('?') x @vals ) .
        ")";

    $self->{dbh}->do( $query, undef, @vals ) or return $self->_error("$sn: $DBI::errstr");
    return SUCCESS;
}

# insert_id
# returns the insert id from the last insert operation
sub insert_id
{
    my $self = shift;
    return $self->{dbh}->last_insert_id( '', '', '', '' );      # use the DBI function
}

sub table_exists
{
    my $sn         = 'table_exists';
    my $self       = shift;
    my $table_name = shift or return $self->_error("no table name");

    if($self->{dbengine} eq 'SQLite') {
        my $rc = $self->sql_select( "pragma table_info($table_name)" );
        return scalar @$rc;     # pragma returns no rows if table doesn't exist
    } elsif($self->{dbengine} eq 'mysql') {
        my $rc = $self->sql_select("describe $table_name");
        if ( $self->error ) {
            return FALSE;
        } else {
            return TRUE;
        }
    }
}

# create an sql date from a unix epoch date
sub sql_date
{
    my ( $self, $t ) = @_;
    $t = time unless defined $t;

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) = gmtime($t);
    my $tstr = sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec );
    return $tstr;
}

1;

__END__