/usr/local/CPAN/RDBAL/RDBAL/Layer/DBI.pm

• package RDBAL::Layer::DBI
  • Version
  • import
  • new
  • Sql
  • RowCount
  • UseDatabase
  • NextRow
  • Regular_Row
  • More_Results
  • ColumnNames
  • ColumnTypes
  • ColumnLengths
  • PrintTable
  • PrintTables
  • Query
• __END__
• EOF

package RDBAL::Layer::DBI;

require 5.000;

$VERSION = "1.00";
sub Version { $VERSION; }

use strict;
use vars qw(@ISA @EXPORT $VERSION $DefaultClass $AutoloadClass);
use Exporter;

@ISA = qw();

@EXPORT = ();

sub import {
    my $pkg = shift;
    my $callpkg = caller;
    Exporter::export 'RDBAL::Layer::DBI', $callpkg, @_;
}

# Default class for the SQL object to use when all else fails.
$DefaultClass = 'RDBAL::Layer::DBI' unless defined $RDBAL::Layer::DBI::DefaultClass;
# This is where to look for autoloaded routines.
$AutoloadClass = $DefaultClass unless defined $RDBAL::Layer::DBI::AutoloadClass;


sub new {
    my($class) = shift;
    my($username) = shift;
    my($password) = shift;
    my($server) = shift;
    my($driver) = shift;
    my($database) = shift;
    my($self) = {};
    my($data_source);

    bless $self,ref $class || $class || $DefaultClass;
    if ($driver eq 'Sybase') {
	$data_source = "dbi:$driver" . ':server=' . $server;
    } else {
	if (defined($database)) {
	    $data_source = "dbi:$driver:$database";
	} else {
	    $data_source = "dbi:$driver:";
	}
    }
    $self->{'connection'} =
	DBI->connect($data_source, $username, $password, { PrintError => 0 });
    $self->{'driver'} = $driver;
    return $self;
}

#
# Execute SQL command
#
sub Sql {
    my($self) = shift;
    my($connection) = $self->{'connection'};
    my($command) = shift;
    my($sth);
 
    if (defined($self->{'sth'})) {
	$self->{'sth'}->finish;
    }
    $sth = $connection->prepare($command) or return undef;
    $self->{'sth'} = $sth;
    $self->{'sth'}->execute or return undef;
    $self->{'empty_fetch'} = 0;
    return 1;
}

sub RowCount {
    my($self) = shift;

    return $self->{'sth'}->rows;
}

sub UseDatabase {
    my($self) = shift;
    my($connection) = $self->{'connection'};
    my($database) = shift;
    my($retval);

    if ($self->{'driver'} eq 'Sybase' ) {
	$self->Sql("use $database") or return undef;
	while($self->More_Results) {};
    }
    return 1;
}

#
#   @row = NextRow($connection);
#

sub NextRow {
    my($self) = shift;
    my(@row) = $self->{'sth'}->fetchrow_array;
    $self->{'empty_fetch'} = 0;
    return @row;
}

#
# $bool_regular_row = Regular_Row($connection);
#

sub Regular_Row {
    my($self) = shift;

    if ($self->{'sth'}->{NAME}->[0] ne 'COL(1)') {
	return 1;
    } else {
	return 0;
    }
}

#
# $bool_no_more_result_sets = More_Results($connection);
#
sub More_Results {
    my($self) = shift;
    my($retval) = 0;
    my(@row);

    if ($self->{'empty_fetch'}) {
	while($self->{'sth'}->fetchrow_array) {}
    }
    $self->{'empty_fetch'} = 1;
    if (defined($self->{'sth'}->{syb_more_results}) &&
	$self->{'sth'}->{syb_more_results}) {
	$retval = 1;
    }
    return $retval;
}

#
# Get column names
#
 
sub ColumnNames {
    my($self) = shift;
 
    return @{$self->{'sth'}->{NAME}};
}
 
#
# Get column types
#
 
sub ColumnTypes {
    my($self) = shift;
    return undef;
}
 
#
# Get column field lengths
#
 
sub ColumnLengths {
    my($self) = shift;
    return undef;
}

#
# Output one result table as text
#
sub PrintTable {
    my($self) = shift;
    my(@columnname);
    my(@row);
 
    @columnname = $self->ColumnNames();
    print join("\t", @columnname)."\n";

    while(@row = $self->NextRow()) {
    	print join("\t", @row)."\n";
    }
    return 1;
}

#
# Output one or more result tables as text
#
sub PrintTables {
    my($self) = shift;
    my($connection) = $self->{'connection'};
    my(@columnname);
    my(@row);
 
    do {
	PrintTable($self);
    } while ($self->More_Results());
    return 1;
}

#
# Execute an SQL query and return the results in an array
#
# If the query produces a single value per row, just return
# an array of the data.
#
# If the query produces multiple values per row, return an
# array of references to arrays.
#
sub Query {
    my($self) = shift;
    my($command) = shift;
    my(@out,@row,$ptr,$ret);

    $ret = $self->Sql($command);
    if (!$ret) {
	print "Error on query $command\n";
	return undef;
    }

    do { 
    	while(@row = $self->NextRow()) {
	    if (@row<=1) { 
		push(@out,$row[0]); 
	    } else { 
		$ptr = [];
		push(@{$ptr},@row);
		push(@out,$ptr);
	    }
	}
    } while ($self->More_Results());
    return(@out); 
}



1;

__END__