WebGUI::SQL as DBI subclass

This commit is contained in:
Graham Knop 2010-04-13 19:25:42 -05:00
parent 5b25692561
commit 0bff8a0fa4
2 changed files with 445 additions and 559 deletions

View file

@ -15,11 +15,13 @@ package WebGUI::SQL;
=cut =cut
use strict; use strict;
use DBI; use DBI ();
use Tie::IxHash; use Tie::IxHash ();
use WebGUI::SQL::ResultSet; use Text::CSV_XS ();
use WebGUI::Utility; use WebGUI::Utility ();
use Text::CSV_XS; use WebGUI::SQL::ResultSet ();
use Try::Tiny;
use namespace::clean;
=head1 NAME =head1 NAME
@ -67,6 +69,93 @@ These methods are available from this package:
=cut =cut
our @ISA = qw(DBI);
#-------------------------------------------------------------------
=head2 connect ( session, dsn, user, pass )
Constructor. Connects to the database using DBI.
=head2 session
A reference to the active WebGUI::Session object.
=head2 dsn
The Database Service Name of the database you wish to connect to. It looks like 'DBI:mysql:dbname;host=localhost'.
=head2 user
The username to use to connect to the database defined by dsn.
=head2 pass
The password to use to connect to the database defined by dsn.
=cut
sub connect {
my $class = shift;
my $session;
my $dsn;
my $user;
my $pass;
if (ref $_[0] && $_[0]->isa('WebGUI::Session')) {
$session = shift;
}
if (ref $_[0] && $_[0]->isa('WebGUI::Config')) {
my $config = shift;
$dsn = $config->get('dsn');
$user = $config->get('dbuser');
$pass = $config->get('dbpass');
}
else {
$dsn = shift;
$user = shift;
$pass = shift;
}
my $params = shift;
if (! $params) {
$params = {};
}
if (ref $params) {
$params = { %$params };
}
else {
my @params = map { split /=/, $_, 2 } split /\n/, $params;
for (@params) {
s/\s+$//;
s/^\s+//;
}
$params = { @params };
}
$params->{RaiseError} = 1;
$params->{PrintError} = 0;
$params->{AutoCommit} = 1;
$params->{ShowErrorStatement} = 1;
$params->{HandleError} = sub {
$session->errorHandler->fatal(Carp::longmess(shift));
};
if ( ($class->parse_dsn($dsn))[1] eq 'mysql' ) {
$params->{mysql_enable_utf8} = 1;
}
my $dbh = $class->SUPER::connect($dsn, $user, $pass, $params);
unless (defined $dbh) {
die "Couldn't connect to database: $dsn : $DBI::errstr";
}
if ($session) {
$dbh->session($session);
}
return $dbh;
}
package WebGUI::SQL::db;
our @ISA = qw(DBI::db);
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -77,8 +166,8 @@ Starts a transaction sequence. To be used with commit and rollback. Any writes a
=cut =cut
sub beginTransaction { sub beginTransaction {
my $self = shift; my $self = shift;
$self->dbh->begin_work; $self->begin_work;
} }
@ -104,7 +193,6 @@ sub buildArray {
return @{ $arrayRef }; return @{ $arrayRef };
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 buildArrayRef ( sql, params ) =head2 buildArrayRef ( sql, params )
@ -122,16 +210,15 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub buildArrayRef { sub buildArrayRef {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my $sth = $self->prepare($sql); my $array = $self->selectall_arrayref($sql, { Slice => [0] }, @$params);
$sth->execute($params); for (@$array) {
my @array; $_ = $_->[0];
while (my $data = $sth->arrayRef) {
push @array, $data->[0];
} }
return \@array;
return $array;
} }
@ -162,7 +249,7 @@ straight hash that is faster but does not maintain order.
=cut =cut
sub buildHash { sub buildHash {
my $self = shift; my $self = shift;
my $hashRef = $self->buildHashRef(@_); my $hashRef = $self->buildHashRef(@_);
return %{ $hashRef }; return %{ $hashRef };
} }
@ -195,24 +282,20 @@ straight hash that is faster but does not maintain order.
=cut =cut
sub buildHashRef { sub buildHashRef {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my $options = shift || {}; my $options = shift || {};
my %hash; my %hash;
unless ($options->{noOrder}) { unless ($options->{noOrder}) {
tie %hash, "Tie::IxHash"; tie %hash, 'Tie::IxHash';
}
my $dbh = $self->dbh;
my $results = $dbh->selectall_arrayref($sql, {}, @$params);
if ($dbh->err) {
$self->session->log->fatal("Couldn't execute prepared statement: $sql : With place holders: ".join(", ", @{$params}).". Root cause: ". $dbh->errstr);
} }
my $results = $self->selectall_arrayref($sql, {}, @$params);
my $width = @{$results} && @{$results->[0]}; my $width = @{$results} && @{$results->[0]};
%hash %hash
= $width == 2 ? map { @{ $_ } } @{ $results } = $width == 2 ? map { @$_ } @{ $results }
# for single column, use it for both key and value # for single column, use it for both key and value
: $width == 1 ? map { $_->[0], $_->[0] } @{ $results } : $width == 1 ? map { ($_->[0]) x 2 } @{ $results }
: $width == 0 ? () : $width == 0 ? ()
: map { : map {
# for more than 2 columns, use all but last joined with colons for key # for more than 2 columns, use all but last joined with colons for key
@ -246,13 +329,8 @@ sub buildArrayRefOfHashRefs {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my @array; my $array = $self->selectall_arrayref($sql, { Slice => {} }, @$params);
my $sth = $self->read($sql, $params); return $array;
while (my $data = $sth->hashRef) {
push @array, $data;
}
$sth->finish;
return \@array;
} }
@ -282,18 +360,21 @@ sub buildDataTableStructure {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my %hash;
my @array;
##Note, I need a valid statement handle for doing the rows method on. ##Note, I need a valid statement handle for doing the rows method on.
my $sth = $self->read($sql,$params); my $sth = $self->prepare($sql);
while (my $data = $sth->hashRef) { $sth->execute(@$params);
push(@array,$data); my $array = $sth->fetchall_arrayref( {} );
}
$hash{records} = \@array; my %hash = (
$hash{totalRecords} = $self->quickScalar('select found_rows()') + 0; ##Convert to numeric records => $array,
$hash{recordsReturned} = $sth->rows()+0; totalRecords => $self->selectrow_array('SELECT found_rows()') + 0, ##Convert to numeric
$sth->finish; recordsReturned => $sth->rows + 0,
return %hash; );
$sth->finish;
return %hash;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -319,21 +400,21 @@ Which column of the result set to use as the key when creating the hashref.
=cut =cut
sub buildHashRefOfHashRefs { sub buildHashRefOfHashRefs {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my $key = shift; my $key = shift;
my $sth = $self->read($sql, $params);
my %hash; my $sth = $self->prepare($sql);
tie %hash, "Tie::IxHash"; $sth->execute(@$params);
while (my $data = $sth->hashRef) { tie my %hash, 'Tie::IxHash';
$hash{$data->{$key}} = $data; while (my $data = $sth->fetchrow_hashref) {
} $hash{$data->{$key}} = $data;
$sth->finish; }
return \%hash; $sth->finish;
return \%hash;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 buildSearchQuery ( $sql, $placeholders, $keywords, $columns ) =head2 buildSearchQuery ( $sql, $placeholders, $keywords, $columns )
@ -364,7 +445,7 @@ An arrayref of column names that should be searched for $keywords.
sub buildSearchQuery { sub buildSearchQuery {
my ($self, $sql, $placeHolders, $keywords, $columns) = @_; my ($self, $sql, $placeHolders, $keywords, $columns) = @_;
if ($$sql =~ m/where/) { if ($$sql =~ m/where/i) {
$$sql .= ' and ('; $$sql .= ' and (';
} }
else { else {
@ -383,77 +464,6 @@ sub buildSearchQuery {
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 commit ( )
Ends a transaction sequence. To be used with beginTransaction. Applies all of the writes since beginTransaction to the database.
=cut
sub commit {
my $self = shift;
$self->dbh->commit;
}
#-------------------------------------------------------------------
=head2 connect ( session, dsn, user, pass )
Constructor. Connects to the database using DBI.
=head2 session
A reference to the active WebGUI::Session object.
=head2 dsn
The Database Service Name of the database you wish to connect to. It looks like 'DBI:mysql:dbname;host=localhost'.
=head2 user
The username to use to connect to the database defined by dsn.
=head2 pass
The password to use to connect to the database defined by dsn.
=cut
sub connect {
my $class = shift;
my $session = shift;
my $dsn = shift;
my $user = shift;
my $pass = shift;
my $params = shift;
require WebGUI::SQL::Trace;
open my $trace_handle, '>:via(WebGUI::SQL::Trace)', $session;
my (undef, $driver) = DBI->parse_dsn($dsn);
my $dbh = DBI->connect($dsn, $user, $pass, {
RaiseError => 0,
AutoCommit => 1,
$driver eq 'mysql' ? (mysql_enable_utf8 => 1) : (),
});
$dbh->trace('2|SQL', $trace_handle);
unless (defined $dbh) {
$session->errorHandler->error("Couldn't connect to database: $dsn : $DBI::errstr");
return undef;
}
##Set specific attributes for this database.
my @params = split /\s*\n\s*/, $params;
foreach my $param ( @params ) {
my ($paramName, $paramValue) = split /\s*=\s*/, $param;
$dbh->{$paramName} = $paramValue;
}
bless {_dbh=>$dbh, _session=>$session}, $class;
}
#-------------------------------------------------------------------
=head2 dbh ( ) =head2 dbh ( )
Returns a reference to the working DBI database handler for this WebGUI::SQL object. Returns a reference to the working DBI database handler for this WebGUI::SQL object.
@ -461,8 +471,8 @@ Returns a reference to the working DBI database handler for this WebGUI::SQL obj
=cut =cut
sub dbh { sub dbh {
my $self = shift; my $self = shift;
return $self->{_dbh}; return $self;
} }
@ -487,43 +497,12 @@ The value to search for in the key column.
=cut =cut
sub deleteRow { sub deleteRow {
my ($self, $table, $key, $keyValue) = @_; my ($self, $table, $key, $keyValue) = @_;
my $sth = $self->write("delete from ".$self->dbh->quote_identifier($table)." where ".$key."=?", [$keyValue]); $table = $self->quote_identifier($table);
$key = $self->quote_identifier($key);
return $self->do("DELETE FROM $table WHERE $key = ?", {}, $keyValue);
} }
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
$self->disconnect;
undef $self;
}
#-------------------------------------------------------------------
=head2 disconnect ( )
Disconnects from the database. And destroys the object.
=cut
sub disconnect {
my $self = shift;
my $dbh = delete $self->{_dbh};
if ($dbh) {
$dbh->disconnect;
}
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 errorCode ( ) =head2 errorCode ( )
@ -533,8 +512,8 @@ Returns an error code for the current handler.
=cut =cut
sub errorCode { sub errorCode {
my $self = shift; my $self = shift;
return $self->dbh->err; return $self->err;
} }
@ -547,8 +526,8 @@ Returns a text error message for the current handler.
=cut =cut
sub errorMessage { sub errorMessage {
my $self = shift; my $self = shift;
return $self->dbh->errstr; return $self->errstr;
} }
@ -556,7 +535,7 @@ sub errorMessage {
=head2 getNextId ( idName ) =head2 getNextId ( idName )
Increments an incrementer of the specified type and returns the value. Increments an incrementer of the specified type and returns the value.
=head3 idName =head3 idName
@ -565,14 +544,13 @@ Specify the name of one of the incrementers in the incrementer table.
=cut =cut
sub getNextId { sub getNextId {
my $self = shift; my $self = shift;
my $name = shift; my $name = shift;
my ($id); $self->begin_work;
$self->beginTransaction; my $id = $self->selectrow_array('SELECT nextValue FROM incrementer WHERE incrementerId = ?', {}, $name);
($id) = $self->quickArray("select nextValue from incrementer where incrementerId=?", [$name]); $self->do('UPDATE incrementer SET nextValue=nextValue+1 WHERE incrementerId=?', {}, $name);
$self->write("update incrementer set nextValue=nextValue+1 where incrementerId=?",[$name]); $self->commit;
$self->commit; return $id;
return $id;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -585,7 +563,7 @@ Returns the DBI driver used by this database link
sub getDriver { sub getDriver {
my $self = shift; my $self = shift;
return $self->{_dbh}->{Driver}->{Name}; return $self->{Driver}->{Name};
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -609,30 +587,18 @@ The value to search for in the key column.
=cut =cut
sub getRow { sub getRow {
my ($self, $table, $key, $keyValue) = @_; my ($self, $table, $key, $keyValue) = @_;
my $row = $self->quickHashRef("select * from ".$self->dbh->quote_identifier($table)." where ".$key."=?",[$keyValue]); my $row = $self->selectrow_hashref(
return $row; sprintf('SELECT * FROM %s WHERE %s = ?',
$self->quote_identifier($table),
$self->quote_identifier($key)
),
{},
$keyValue,
);
return $row;
} }
#-------------------------------------------------------------------
=head2 prepare ( sql )
This is a wrapper for WebGUI::SQL::ResultSet->prepare()
=head3 sql
An SQL statement.
=cut
sub prepare {
my $self = shift;
my $sql = shift;
return WebGUI::SQL::ResultSet->prepare($sql, $self);
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 quickArray ( sql, params ) =head2 quickArray ( sql, params )
@ -650,11 +616,10 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub quickArray { sub quickArray {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift || []; my $params = shift || [];
my $data = $self->dbh->selectrow_arrayref($sql, {}, @{ $params }) || []; return $self->selectrow_array($sql, {}, @{ $params });
return @{ $data };
} }
@ -675,26 +640,25 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub quickCSV { sub quickCSV {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my ($sth, $output, @data);
my $csv = Text::CSV_XS->new({ eol => "\n" }); my $csv = Text::CSV_XS->new({ eol => "\n" });
$sth = $self->prepare($sql); my $sth = $self->prepare($sql);
$sth->execute($params); $sth->execute(@$params);
return undef unless $csv->combine($sth->getColumnNames); return undef unless $csv->combine($sth->getColumnNames);
$output = $csv->string(); my $output = $csv->string;
while (@data = $sth->array) { while (my @data = $sth->fetchrow_array) {
return undef unless $csv->combine(@data); return undef unless $csv->combine(@data);
$output .= $csv->string(); $output .= $csv->string;
} }
$sth->finish; $sth->finish;
return $output; return $output;
} }
@ -715,19 +679,11 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub quickHash { sub quickHash {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my ($sth, $data); my $row = $self->selectrow_hashref($sql, {}, @$params);
$sth = $self->prepare($sql); return %{$row};
$sth->execute($params);
$data = $sth->hashRef;
$sth->finish;
if (defined $data) {
return %{$data};
} else {
return ();
}
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -747,18 +703,10 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub quickHashRef { sub quickHashRef {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my $sth = $self->prepare($sql); return $self->selectrow_hashref($sql, {}, @$params);
$sth->execute($params);
my $data = $sth->hashRef;
$sth->finish;
if (defined $data) {
return $data;
} else {
return {};
}
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -778,15 +726,11 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub quickScalar { sub quickScalar {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my ($sth, @data); my ($data) = $self->selectrow_array($sql, {}, @$params);
$sth = $self->prepare($sql); return $data;
$sth->execute($params);
@data = $sth->array;
$sth->finish;
return $data[0];
} }
@ -807,39 +751,18 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub quickTab { sub quickTab {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my ($sth, $output, @data); my $sth = $self->prepare($sql);
$sth = $self->prepare($sql); $sth->execute(@{$params});
$sth->execute($params); my $output = join("\t", $sth->getColumnNames) . "\n";
$output = join("\t",$sth->getColumnNames)."\n"; while (my @data = $sth->fetchrow_array) {
while (@data = $sth->array) { WebGUI::Utility::makeArrayTabSafe(\@data);
makeArrayTabSafe(\@data); $output .= join("\t", @data) . "\n";
$output .= join("\t",@data)."\n"; }
} $sth->finish;
$sth->finish; return $output;
return $output;
}
#-------------------------------------------------------------------
=head2 quote ( string )
Returns a string quoted and ready for insert into the database.
B<NOTE:> You should use this sparingly. It is much faster and safer to use prepare/execute style queries and passing in place holder parameters. Even the convenience methods like quickArray() support the use of place holder parameters.
=head3 string
Any scalar variable that needs to be escaped to be inserted into the database.
=cut
sub quote {
my $self = shift;
my $value = shift;
return $self->dbh->quote($value);
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -855,16 +778,29 @@ An array reference containing strings to be quoted.
=cut =cut
sub quoteAndJoin { sub quoteAndJoin {
my $self = shift; my $self = shift;
my $arrayRef = shift; my $arrayRef = shift;
my @newArray; return join ',', map { $self->quote($_) } @$arrayRef;
foreach my $value (@$arrayRef) {
push(@newArray,$self->quote($value));
}
return join(",",@newArray);
} }
#-------------------------------------------------------------------
=head2 quoteIdentifier ( string )
Returns a string quoted as an identifier to be used as a table name, column name, etc.
=head3 string
Any scalar variable that needs to be escaped to be inserted into the database.
=cut
sub quoteIdentifier {
my $self = shift;
return $self->quote_identifier(@_);
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 quoteIdentifier ( string ) =head2 quoteIdentifier ( string )
@ -901,31 +837,14 @@ An array reference containing a list of values to be used in the placeholders de
=cut =cut
sub read { sub read {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $placeholders = shift; my $placeholders = shift;
return WebGUI::SQL::ResultSet->read($sql, $self, $placeholders); my $sth = $self->prepare($sql);
$sth->execute(@$placeholders);
return $sth;
} }
#-------------------------------------------------------------------
=head2 rollback ( )
Ends a transaction sequence. To be used with beginTransaction. Cancels all of the writes since beginTransaction.
=head3 dbh
A database handler. Defaults to the WebGUI default database handler.
=cut
sub rollback {
my $self = shift;
$self->dbh->rollback;
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 session ( ) =head2 session ( )
@ -935,8 +854,14 @@ Returns a reference to the current session.
=cut =cut
sub session { sub session {
my $self = shift; my $self = shift;
return $self->{_session}; if (@_) {
my $session = $self->{private_webgui_session} = shift;
require WebGUI::SQL::Trace;
open my $trace_handle, '>:via(WebGUI::SQL::Trace)', $session;
$self->trace('2|SQL', $trace_handle);
}
return $self->{private_webgui_session};
} }
@ -965,22 +890,29 @@ Use this ID to create a new row. Same as setting the key value to "new" except t
=cut =cut
sub setRow { sub setRow {
my ($self, $table, $keyColumn, $data, $id) = @_; my ($self, $table, $keyColumn, $data, $id) = @_;
$data->{$keyColumn} ||= $id; $table = $self->quote_identifier($table);
if ($data->{$keyColumn} eq "new") { my $key = $self->quote_identifier($keyColumn);
$data->{$keyColumn} = $self->session->id->generate();
} if ($data->{$keyColumn} eq 'new' || $id) {
my $dbh = $self->dbh; $id ||= $self->session->id->generate;
my @fields = (); $data->{$keyColumn} = $id;
my @data = (); $self->do("REPLACE INTO $table ($key) VALUES (?)", {}, $id);
my @placeholders = (); }
foreach my $key (keys %{$data}) {
push(@fields, $dbh->quote_identifier($key)); my @fields = map { $self->quote_identifier($_) . '=?' } keys %$data;
push(@placeholders, '?'); my @data = values %$data;
push(@data,$data->{$key});
} if (@fields) {
$self->write("replace into $table (" . join(",",@fields) . ") values (".join(",",@placeholders).")",\@data); $self->do(
return $data->{$keyColumn}; "UPDATE $table SET " . join(", ", @fields)
. " WHERE $key = ?",
{},
@data,
$id,
);
}
return $id;
} }
@ -1001,10 +933,11 @@ An array reference containing a list of values to be used in the placeholders de
=cut =cut
sub unconditionalRead { sub unconditionalRead {
my $self = shift; my $self = shift;
my $sql = shift; local $self->{RaiseError} = 0;
my $placeholders = shift; local $self->{HandleError} = undef;
return WebGUI::SQL::ResultSet->unconditionalRead($sql, $self, $placeholders); my $sth = $self->read(@_);
return $sth;
} }
@ -1026,11 +959,10 @@ An array reference containing values for any placeholder params used in the SQL
=cut =cut
sub write { sub write {
my $self = shift; my $self = shift;
my $sql = shift; my $sql = shift;
my $params = shift; my $params = shift;
my $sth = $self->prepare($sql); return $self->do($sql, {}, @$params);
$sth->execute($params);
} }

View file

@ -26,8 +26,6 @@ This class provides methods for working with SQL result sets. If you're used to
=head1 SYNOPSIS =head1 SYNOPSIS
use WebGUI::SQL::ResultSet;
my $result = WebGUI::SQL::ResultSet->prepare($query, $db); my $result = WebGUI::SQL::ResultSet->prepare($query, $db);
$result->execute([ @values ]); $result->execute([ @values ]);
@ -44,160 +42,6 @@ This class provides methods for working with SQL result sets. If you're used to
These methods are available from this package: These methods are available from this package:
=cut =cut
#-------------------------------------------------------------------
=head2 array ( )
Returns the next row of data as an array.
=cut
sub array {
my $self = shift;
return $self->sth->fetchrow_array() or $self->db->session->errorHandler->fatal("Couldn't fetch array. ".$self->errorMessage);
}
#-------------------------------------------------------------------
=head2 arrayRef ( )
Returns the next row of data as an array reference. Note that this is 12% faster than array().
=cut
sub arrayRef {
my $self = shift;
return $self->sth->fetchrow_arrayref() or $self->db->session->errorHandler->fatal("Couldn't fetch array. ".$self->errorMessage);
}
#-------------------------------------------------------------------
=head2 db ( )
A reference to the current WebGUI::SQL object.
=cut
sub db {
my $self = shift;
return $self->{_db};
}
#-------------------------------------------------------------------
=head2 errorCode {
Returns an error code for the current handler.
=cut
sub errorCode {
my $self = shift;
return $self->sth->err;
}
#-------------------------------------------------------------------
=head2 errorMessage {
Returns a text error message for the current handler.
=cut
sub errorMessage {
my $self = shift;
return $self->sth->errstr;
}
#-------------------------------------------------------------------
=head2 execute ( [ placeholders ] )
Executes a prepared SQL statement. For SELECT queries, returns a true value on success. For
other queries, returns the number of rows effected. Return value will always evaluate as true
even if zero rows were effected.
=head3 placeholders
An array reference containing a list of values to be used in the placeholders defined in the SQL statement.
=cut
sub execute {
my $self = shift;
my $placeholders = shift || [];
my $sql = $self->{_sql};
$self->sth->execute(@{ $placeholders }) or $self->session->errorHandler->fatal("Couldn't execute prepared statement: $sql : With place holders: ".join(", ", @{$placeholders}).". Root cause: ". $self->errorMessage);
}
#-------------------------------------------------------------------
=head2 finish ( )
Releases the result set. Should be called to complete any statement handler.
=cut
sub finish {
my $self = shift;
return $self->sth->finish;
}
#-------------------------------------------------------------------
=head2 getColumnNames
Returns an array of column names. Use with a "read" method.
=cut
sub getColumnNames {
my $self = shift;
return @{$self->sth->{NAME}} if (ref $self->sth->{NAME} eq 'ARRAY');
}
#-------------------------------------------------------------------
=head2 hash ( )
Returns the next row of data in the form of a hash.
=cut
sub hash {
my $self = shift;
my ($hashRef);
$hashRef = $self->sth->fetchrow_hashref();
if (defined $hashRef) {
return %{$hashRef};
} else {
return ();
}
}
#-------------------------------------------------------------------
=head2 hashRef ( )
Returns the next row of data in the form of a hash reference.
=cut
sub hashRef {
my $self = shift;
return $self->sth->fetchrow_hashref();
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 prepare ( sql, db ) =head2 prepare ( sql, db )
@ -215,14 +59,12 @@ A WebGUI::SQL database handler.
=cut =cut
sub prepare { sub prepare {
my $class = shift; my $class = shift;
my $sql = shift; my $sql = shift;
my $db = shift; my $db = shift;
my $sth = $db->dbh->prepare($sql) or $db->session->errorHandler->fatal("Couldn't prepare statement: ".$sql." : ". $db->dbh->errstr); return $db->prepare($sql);
bless {_sth => $sth, _sql => $sql, _db=>$db}, $class;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 read ( sql, db, placeholders ) =head2 read ( sql, db, placeholders )
@ -245,43 +87,13 @@ An array reference containing a list of values to be used in the placeholders de
=cut =cut
sub read { sub read {
my $class = shift; my $class = shift;
my $sql = shift; my $sql = shift;
my $db = shift; my $db = shift;
my $placeholders = shift; my $placeholders = shift;
my $self = $db->prepare($sql, $db); return $db->read($sql, $placeholders);
$self->execute($placeholders);
return $self;
} }
#-------------------------------------------------------------------
=head2 rows ( )
Returns the number of rows in the result set.
=cut
sub rows {
my $self = shift;
return $self->sth->rows;
}
#-------------------------------------------------------------------
=head2 sth ( )
Returns the working DBI statement handler for this result set.
=cut
sub sth {
my $self = shift;
return $self->{_sth};
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 unconditionalRead ( sql, db, placeholders ) =head2 unconditionalRead ( sql, db, placeholders )
@ -303,19 +115,161 @@ An array reference containing a list of values to be used in the placeholders de
=cut =cut
sub unconditionalRead { sub unconditionalRead {
my $class = shift; my $class = shift;
my $sql = shift; my $sql = shift;
my $db = shift; my $db = shift;
my $placeholders = shift; my $placeholders = shift;
my $errorHandler = $db->session->errorHandler; return $db->unconditionalRead($sql, $placeholders);
$errorHandler->query($sql,$placeholders); }
my $sth = $db->dbh->prepare($sql) or $errorHandler->warn("Unconditional read failed: ".$sql." : ".$db->dbh->errstr);
if ($sth) { package WebGUI::SQL::st;
$sth->execute(@$placeholders) or $errorHandler->warn("Unconditional read failed: ".$sql." : ".$sth->errstr);
bless {_sql=>$sql, _db=>$db, _sth=>$sth}, $class; our @ISA = qw(DBI::st);
} else {
return undef; #-------------------------------------------------------------------
}
=head2 array ( )
Returns the next row of data as an array.
=cut
sub array {
my $self = shift;
return $self->fetchrow_array;
}
#-------------------------------------------------------------------
=head2 arrayRef ( )
Returns the next row of data as an array reference. Note that this is 12% faster than array().
=cut
sub arrayRef {
my $self = shift;
return $self->fetchrow_arrayref;
}
#-------------------------------------------------------------------
=head2 db ( )
A reference to the current WebGUI::SQL object.
=cut
sub db {
my $self = shift;
return $self->{Database};
}
#-------------------------------------------------------------------
=head2 errorCode {
Returns an error code for the current handler.
=cut
sub errorCode {
my $self = shift;
return $self->err;
}
#-------------------------------------------------------------------
=head2 errorMessage {
Returns a text error message for the current handler.
=cut
sub errorMessage {
my $self = shift;
return $self->errstr;
}
#-------------------------------------------------------------------
=head2 execute ( [ placeholders ] )
Executes a prepared SQL statement. For SELECT queries, returns a true value on success. For
other queries, returns the number of rows effected. Return value will always evaluate as true
even if zero rows were effected.
=head3 placeholders
An array reference containing a list of values to be used in the placeholders defined in the SQL statement.
=cut
sub execute {
my $self = shift;
my $placeholders =
( @_ == 1 && ref $_[0] eq 'ARRAY' ) ? $_[0]
: \@_;
return $self->SUPER::execute(@$placeholders);
}
#-------------------------------------------------------------------
=head2 getColumnNames
Returns an array of column names. Use with a "read" method.
=cut
sub getColumnNames {
my $self = shift;
return @{ $self->{NAME} }
if (ref $self->{NAME} eq 'ARRAY');
return;
}
#-------------------------------------------------------------------
=head2 hash ( )
Returns the next row of data in the form of a hash.
=cut
sub hash {
my $self = shift;
my $hashRef = $self->fetchrow_hashref || {};
return %$hashRef;
}
#-------------------------------------------------------------------
=head2 hashRef ( )
Returns the next row of data in the form of a hash reference.
=cut
sub hashRef {
my $self = shift;
return $self->fetchrow_hashref;
}
#-------------------------------------------------------------------
=head2 sth ( )
Returns the working DBI statement handler for this result set.
=cut
sub sth {
my $self = shift;
return $self;
} }
1; 1;