WebGUI::SQL as DBI subclass
This commit is contained in:
Graham Knop
parent
5b25692561
commit
0bff8a0fa4
2 changed files with 445 additions and 559 deletions
|
|
@ -15,11 +15,13 @@ package WebGUI::SQL;
|
|||
=cut
|
||||
|
||||
use strict;
|
||||
use DBI;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::SQL::ResultSet;
|
||||
use WebGUI::Utility;
|
||||
use Text::CSV_XS;
|
||||
use DBI ();
|
||||
use Tie::IxHash ();
|
||||
use Text::CSV_XS ();
|
||||
use WebGUI::Utility ();
|
||||
use WebGUI::SQL::ResultSet ();
|
||||
use Try::Tiny;
|
||||
use namespace::clean;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
|
@ -67,6 +69,93 @@ These methods are available from this package:
|
|||
|
||||
=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
|
||||
|
||||
sub beginTransaction {
|
||||
my $self = shift;
|
||||
$self->dbh->begin_work;
|
||||
my $self = shift;
|
||||
$self->begin_work;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -104,7 +193,6 @@ sub buildArray {
|
|||
return @{ $arrayRef };
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 buildArrayRef ( sql, params )
|
||||
|
|
@ -122,16 +210,15 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub buildArrayRef {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
my @array;
|
||||
while (my $data = $sth->arrayRef) {
|
||||
push @array, $data->[0];
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $array = $self->selectall_arrayref($sql, { Slice => [0] }, @$params);
|
||||
for (@$array) {
|
||||
$_ = $_->[0];
|
||||
}
|
||||
return \@array;
|
||||
|
||||
return $array;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -162,7 +249,7 @@ straight hash that is faster but does not maintain order.
|
|||
=cut
|
||||
|
||||
sub buildHash {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $hashRef = $self->buildHashRef(@_);
|
||||
return %{ $hashRef };
|
||||
}
|
||||
|
|
@ -195,24 +282,20 @@ straight hash that is faster but does not maintain order.
|
|||
=cut
|
||||
|
||||
sub buildHashRef {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $options = shift || {};
|
||||
my %hash;
|
||||
unless ($options->{noOrder}) {
|
||||
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);
|
||||
tie %hash, 'Tie::IxHash';
|
||||
}
|
||||
my $results = $self->selectall_arrayref($sql, {}, @$params);
|
||||
my $width = @{$results} && @{$results->[0]};
|
||||
%hash
|
||||
= $width == 2 ? map { @{ $_ } } @{ $results }
|
||||
= $width == 2 ? map { @$_ } @{ $results }
|
||||
# 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 ? ()
|
||||
: map {
|
||||
# for more than 2 columns, use all but last joined with colons for key
|
||||
|
|
@ -246,13 +329,8 @@ sub buildArrayRefOfHashRefs {
|
|||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my @array;
|
||||
my $sth = $self->read($sql, $params);
|
||||
while (my $data = $sth->hashRef) {
|
||||
push @array, $data;
|
||||
}
|
||||
$sth->finish;
|
||||
return \@array;
|
||||
my $array = $self->selectall_arrayref($sql, { Slice => {} }, @$params);
|
||||
return $array;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -282,18 +360,21 @@ sub buildDataTableStructure {
|
|||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my %hash;
|
||||
my @array;
|
||||
|
||||
##Note, I need a valid statement handle for doing the rows method on.
|
||||
my $sth = $self->read($sql,$params);
|
||||
while (my $data = $sth->hashRef) {
|
||||
push(@array,$data);
|
||||
}
|
||||
$hash{records} = \@array;
|
||||
$hash{totalRecords} = $self->quickScalar('select found_rows()') + 0; ##Convert to numeric
|
||||
$hash{recordsReturned} = $sth->rows()+0;
|
||||
$sth->finish;
|
||||
return %hash;
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute(@$params);
|
||||
my $array = $sth->fetchall_arrayref( {} );
|
||||
|
||||
my %hash = (
|
||||
records => $array,
|
||||
totalRecords => $self->selectrow_array('SELECT found_rows()') + 0, ##Convert to numeric
|
||||
recordsReturned => $sth->rows + 0,
|
||||
);
|
||||
|
||||
$sth->finish;
|
||||
|
||||
return %hash;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -319,21 +400,21 @@ Which column of the result set to use as the key when creating the hashref.
|
|||
=cut
|
||||
|
||||
sub buildHashRefOfHashRefs {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $key = shift;
|
||||
my $sth = $self->read($sql, $params);
|
||||
my %hash;
|
||||
tie %hash, "Tie::IxHash";
|
||||
while (my $data = $sth->hashRef) {
|
||||
$hash{$data->{$key}} = $data;
|
||||
}
|
||||
$sth->finish;
|
||||
return \%hash;
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $key = shift;
|
||||
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute(@$params);
|
||||
tie my %hash, 'Tie::IxHash';
|
||||
while (my $data = $sth->fetchrow_hashref) {
|
||||
$hash{$data->{$key}} = $data;
|
||||
}
|
||||
$sth->finish;
|
||||
return \%hash;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 buildSearchQuery ( $sql, $placeholders, $keywords, $columns )
|
||||
|
|
@ -364,7 +445,7 @@ An arrayref of column names that should be searched for $keywords.
|
|||
|
||||
sub buildSearchQuery {
|
||||
my ($self, $sql, $placeHolders, $keywords, $columns) = @_;
|
||||
if ($$sql =~ m/where/) {
|
||||
if ($$sql =~ m/where/i) {
|
||||
$$sql .= ' and (';
|
||||
}
|
||||
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 ( )
|
||||
|
||||
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
|
||||
|
||||
sub dbh {
|
||||
my $self = shift;
|
||||
return $self->{_dbh};
|
||||
my $self = shift;
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -487,43 +497,12 @@ The value to search for in the key column.
|
|||
=cut
|
||||
|
||||
sub deleteRow {
|
||||
my ($self, $table, $key, $keyValue) = @_;
|
||||
my $sth = $self->write("delete from ".$self->dbh->quote_identifier($table)." where ".$key."=?", [$keyValue]);
|
||||
my ($self, $table, $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 ( )
|
||||
|
|
@ -533,8 +512,8 @@ Returns an error code for the current handler.
|
|||
=cut
|
||||
|
||||
sub errorCode {
|
||||
my $self = shift;
|
||||
return $self->dbh->err;
|
||||
my $self = shift;
|
||||
return $self->err;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -547,8 +526,8 @@ Returns a text error message for the current handler.
|
|||
=cut
|
||||
|
||||
sub errorMessage {
|
||||
my $self = shift;
|
||||
return $self->dbh->errstr;
|
||||
my $self = shift;
|
||||
return $self->errstr;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -556,7 +535,7 @@ sub errorMessage {
|
|||
|
||||
=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
|
||||
|
||||
|
|
@ -565,14 +544,13 @@ Specify the name of one of the incrementers in the incrementer table.
|
|||
=cut
|
||||
|
||||
sub getNextId {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my ($id);
|
||||
$self->beginTransaction;
|
||||
($id) = $self->quickArray("select nextValue from incrementer where incrementerId=?", [$name]);
|
||||
$self->write("update incrementer set nextValue=nextValue+1 where incrementerId=?",[$name]);
|
||||
$self->commit;
|
||||
return $id;
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
$self->begin_work;
|
||||
my $id = $self->selectrow_array('SELECT nextValue FROM incrementer WHERE incrementerId = ?', {}, $name);
|
||||
$self->do('UPDATE incrementer SET nextValue=nextValue+1 WHERE incrementerId=?', {}, $name);
|
||||
$self->commit;
|
||||
return $id;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -585,7 +563,7 @@ Returns the DBI driver used by this database link
|
|||
|
||||
sub getDriver {
|
||||
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
|
||||
|
||||
sub getRow {
|
||||
my ($self, $table, $key, $keyValue) = @_;
|
||||
my $row = $self->quickHashRef("select * from ".$self->dbh->quote_identifier($table)." where ".$key."=?",[$keyValue]);
|
||||
return $row;
|
||||
my ($self, $table, $key, $keyValue) = @_;
|
||||
my $row = $self->selectrow_hashref(
|
||||
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 )
|
||||
|
|
@ -650,11 +616,10 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub quickArray {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift || [];
|
||||
my $data = $self->dbh->selectrow_arrayref($sql, {}, @{ $params }) || [];
|
||||
return @{ $data };
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift || [];
|
||||
return $self->selectrow_array($sql, {}, @{ $params });
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -675,26 +640,25 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub quickCSV {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my ($sth, $output, @data);
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
|
||||
my $csv = Text::CSV_XS->new({ eol => "\n" });
|
||||
my $csv = Text::CSV_XS->new({ eol => "\n" });
|
||||
|
||||
$sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute(@$params);
|
||||
|
||||
return undef unless $csv->combine($sth->getColumnNames);
|
||||
$output = $csv->string();
|
||||
return undef unless $csv->combine($sth->getColumnNames);
|
||||
my $output = $csv->string;
|
||||
|
||||
while (@data = $sth->array) {
|
||||
return undef unless $csv->combine(@data);
|
||||
$output .= $csv->string();
|
||||
}
|
||||
while (my @data = $sth->fetchrow_array) {
|
||||
return undef unless $csv->combine(@data);
|
||||
$output .= $csv->string;
|
||||
}
|
||||
|
||||
$sth->finish;
|
||||
return $output;
|
||||
$sth->finish;
|
||||
return $output;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -715,19 +679,11 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub quickHash {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my ($sth, $data);
|
||||
$sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
$data = $sth->hashRef;
|
||||
$sth->finish;
|
||||
if (defined $data) {
|
||||
return %{$data};
|
||||
} else {
|
||||
return ();
|
||||
}
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $row = $self->selectrow_hashref($sql, {}, @$params);
|
||||
return %{$row};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -747,18 +703,10 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub quickHashRef {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
my $data = $sth->hashRef;
|
||||
$sth->finish;
|
||||
if (defined $data) {
|
||||
return $data;
|
||||
} else {
|
||||
return {};
|
||||
}
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
return $self->selectrow_hashref($sql, {}, @$params);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -778,15 +726,11 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub quickScalar {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my ($sth, @data);
|
||||
$sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
@data = $sth->array;
|
||||
$sth->finish;
|
||||
return $data[0];
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my ($data) = $self->selectrow_array($sql, {}, @$params);
|
||||
return $data;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -807,39 +751,18 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub quickTab {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my ($sth, $output, @data);
|
||||
$sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
$output = join("\t",$sth->getColumnNames)."\n";
|
||||
while (@data = $sth->array) {
|
||||
makeArrayTabSafe(\@data);
|
||||
$output .= join("\t",@data)."\n";
|
||||
}
|
||||
$sth->finish;
|
||||
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);
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute(@{$params});
|
||||
my $output = join("\t", $sth->getColumnNames) . "\n";
|
||||
while (my @data = $sth->fetchrow_array) {
|
||||
WebGUI::Utility::makeArrayTabSafe(\@data);
|
||||
$output .= join("\t", @data) . "\n";
|
||||
}
|
||||
$sth->finish;
|
||||
return $output;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -855,16 +778,29 @@ An array reference containing strings to be quoted.
|
|||
=cut
|
||||
|
||||
sub quoteAndJoin {
|
||||
my $self = shift;
|
||||
my $arrayRef = shift;
|
||||
my @newArray;
|
||||
foreach my $value (@$arrayRef) {
|
||||
push(@newArray,$self->quote($value));
|
||||
}
|
||||
return join(",",@newArray);
|
||||
my $self = shift;
|
||||
my $arrayRef = shift;
|
||||
return join ',', map { $self->quote($_) } @$arrayRef;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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 )
|
||||
|
|
@ -901,31 +837,14 @@ An array reference containing a list of values to be used in the placeholders de
|
|||
=cut
|
||||
|
||||
sub read {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $placeholders = shift;
|
||||
return WebGUI::SQL::ResultSet->read($sql, $self, $placeholders);
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $placeholders = shift;
|
||||
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 ( )
|
||||
|
|
@ -935,8 +854,14 @@ Returns a reference to the current session.
|
|||
=cut
|
||||
|
||||
sub session {
|
||||
my $self = shift;
|
||||
return $self->{_session};
|
||||
my $self = shift;
|
||||
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
|
||||
|
||||
sub setRow {
|
||||
my ($self, $table, $keyColumn, $data, $id) = @_;
|
||||
$data->{$keyColumn} ||= $id;
|
||||
if ($data->{$keyColumn} eq "new") {
|
||||
$data->{$keyColumn} = $self->session->id->generate();
|
||||
}
|
||||
my $dbh = $self->dbh;
|
||||
my @fields = ();
|
||||
my @data = ();
|
||||
my @placeholders = ();
|
||||
foreach my $key (keys %{$data}) {
|
||||
push(@fields, $dbh->quote_identifier($key));
|
||||
push(@placeholders, '?');
|
||||
push(@data,$data->{$key});
|
||||
}
|
||||
$self->write("replace into $table (" . join(",",@fields) . ") values (".join(",",@placeholders).")",\@data);
|
||||
return $data->{$keyColumn};
|
||||
my ($self, $table, $keyColumn, $data, $id) = @_;
|
||||
$table = $self->quote_identifier($table);
|
||||
my $key = $self->quote_identifier($keyColumn);
|
||||
|
||||
if ($data->{$keyColumn} eq 'new' || $id) {
|
||||
$id ||= $self->session->id->generate;
|
||||
$data->{$keyColumn} = $id;
|
||||
$self->do("REPLACE INTO $table ($key) VALUES (?)", {}, $id);
|
||||
}
|
||||
|
||||
my @fields = map { $self->quote_identifier($_) . '=?' } keys %$data;
|
||||
my @data = values %$data;
|
||||
|
||||
if (@fields) {
|
||||
$self->do(
|
||||
"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
|
||||
|
||||
sub unconditionalRead {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $placeholders = shift;
|
||||
return WebGUI::SQL::ResultSet->unconditionalRead($sql, $self, $placeholders);
|
||||
my $self = shift;
|
||||
local $self->{RaiseError} = 0;
|
||||
local $self->{HandleError} = undef;
|
||||
my $sth = $self->read(@_);
|
||||
return $sth;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1026,11 +959,10 @@ An array reference containing values for any placeholder params used in the SQL
|
|||
=cut
|
||||
|
||||
sub write {
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
my $sth = $self->prepare($sql);
|
||||
$sth->execute($params);
|
||||
my $self = shift;
|
||||
my $sql = shift;
|
||||
my $params = shift;
|
||||
return $self->do($sql, {}, @$params);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -26,8 +26,6 @@ This class provides methods for working with SQL result sets. If you're used to
|
|||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::SQL::ResultSet;
|
||||
|
||||
my $result = WebGUI::SQL::ResultSet->prepare($query, $db);
|
||||
|
||||
$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:
|
||||
|
||||
=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 )
|
||||
|
|
@ -215,14 +59,12 @@ A WebGUI::SQL database handler.
|
|||
=cut
|
||||
|
||||
sub prepare {
|
||||
my $class = shift;
|
||||
my $sql = shift;
|
||||
my $db = shift;
|
||||
my $sth = $db->dbh->prepare($sql) or $db->session->errorHandler->fatal("Couldn't prepare statement: ".$sql." : ". $db->dbh->errstr);
|
||||
bless {_sth => $sth, _sql => $sql, _db=>$db}, $class;
|
||||
my $class = shift;
|
||||
my $sql = shift;
|
||||
my $db = shift;
|
||||
return $db->prepare($sql);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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
|
||||
|
||||
sub read {
|
||||
my $class = shift;
|
||||
my $sql = shift;
|
||||
my $db = shift;
|
||||
my $placeholders = shift;
|
||||
my $self = $db->prepare($sql, $db);
|
||||
$self->execute($placeholders);
|
||||
return $self;
|
||||
my $class = shift;
|
||||
my $sql = shift;
|
||||
my $db = shift;
|
||||
my $placeholders = shift;
|
||||
return $db->read($sql, $placeholders);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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 )
|
||||
|
|
@ -303,19 +115,161 @@ An array reference containing a list of values to be used in the placeholders de
|
|||
=cut
|
||||
|
||||
sub unconditionalRead {
|
||||
my $class = shift;
|
||||
my $sql = shift;
|
||||
my $db = shift;
|
||||
my $placeholders = shift;
|
||||
my $errorHandler = $db->session->errorHandler;
|
||||
$errorHandler->query($sql,$placeholders);
|
||||
my $sth = $db->dbh->prepare($sql) or $errorHandler->warn("Unconditional read failed: ".$sql." : ".$db->dbh->errstr);
|
||||
if ($sth) {
|
||||
$sth->execute(@$placeholders) or $errorHandler->warn("Unconditional read failed: ".$sql." : ".$sth->errstr);
|
||||
bless {_sql=>$sql, _db=>$db, _sth=>$sth}, $class;
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
my $class = shift;
|
||||
my $sql = shift;
|
||||
my $db = shift;
|
||||
my $placeholders = shift;
|
||||
return $db->unconditionalRead($sql, $placeholders);
|
||||
}
|
||||
|
||||
package WebGUI::SQL::st;
|
||||
|
||||
our @ISA = qw(DBI::st);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue