cvsuser 02/04/05 14:01:59
Modified: P5EEx/Blue/P5EEx/Blue/Repository DBI.pm
Log:
did some long-overdue cleanup to use updated DBI routines instead of my homegrown
ones
Revision Changes Path
1.10 +101 -156 p5ee/P5EEx/Blue/P5EEx/Blue/Repository/DBI.pm
Index: DBI.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Repository/DBI.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- DBI.pm 19 Mar 2002 22:14:51 -0000 1.9
+++ DBI.pm 5 Apr 2002 22:01:59 -0000 1.10
@@ -1,13 +1,13 @@
######################################################################
-## File: $Id: DBI.pm,v 1.9 2002/03/19 22:14:51 spadkins Exp $
+## File: $Id: DBI.pm,v 1.10 2002/04/05 22:01:59 spadkins Exp $
######################################################################
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Repository;
package P5EEx::Blue::Repository::DBI;
-$VERSION = do { my @r=(q$Revision: 1.9 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.10 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
@ISA = ( "P5EEx::Blue::Repository" );
@@ -222,121 +222,84 @@
$err ? $err : "";
}
-######################################################################
-# SQL EXECUTE METHODS (new methods not defined in P5EEx::Blue::Repository)
-######################################################################
-
-# $colvararr = $rep->exec_select_row($sql);
-sub exec_select_row {
- my ($self, $sql) = @_;
- my (@row, $dbh, $sth, $rc);
-
- if (!defined $self->{dbh}) {
- $self->{error} = "Not connected to database";
- return ()
- }
- $dbh = $self->{dbh};
- delete $self->{error};
- $self->{sql} = $sql;
-
- $sth = $dbh->prepare($sql);
- if ($DBI::err) {
- return();
- }
-
- $rc = $sth->execute;
- if ($DBI::err) {
- return();
- }
-
- @row = $sth->fetchrow;
- if ($DBI::err) {
- return();
- }
-
- $sth->finish;
- if ($DBI::err) {
- return();
- }
-
- \@row;
-}
-
-# @colvararr = $rep->exec_select($sql);
-sub exec_select {
- my ($self, $sql, $startrow, $endrow) = @_;
- my (@rows, @row, $dbh, $sth, $rc, $rownum);
-
- if (!defined $self->{dbh}) {
- $self->{error} = "Not connected to database";
- return ()
- }
- $dbh = $self->{dbh};
- delete $self->{error};
- $self->{sql} = $sql;
-
- $sth = $dbh->prepare($sql);
- if ($DBI::err) {
- return();
- }
-
- $rc = $sth->execute;
- if ($DBI::err) {
- return();
- }
+# modified from the DBD::_::db::selectall_arrayref in DBI.pm
+sub selectrange_arrayref {
+ my ($self, $stmt, $startrow, $endrow, $attr, @bind) = @_;
+ my $dbh = $self->{dbh};
+ return [] if (!$dbh);
+ my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
+ return unless $sth;
+ $sth->execute(@bind) || return;
+ my $slice = $attr->{Slice}; # typically undef, else hash or array ref
+ if (!$slice and $slice=$attr->{Columns}) {
+ if (ref $slice eq 'ARRAY') { # map col idx to perl array idx
+ $slice = [ @{$attr->{Columns}} ]; # take a copy
+ for (@$slice) { $_-- }
+ }
+ }
+ return $self->fetchrange_arrayref($sth, $startrow, $endrow, $slice);
+}
+
+# modified from the DBD::_::st::fetchall_arrayref in DBI.pm
+sub fetchrange_arrayref {
+ my ($self, $sth, $startrow, $endrow, $slice) = @_;
+ $slice = [] if (! defined $slice);
+ $startrow = 0 if (!defined $startrow);
+ $endrow = 0 if (!defined $endrow);
+ my $mode = ref $slice;
+ my @rows;
+ my $row;
+ my ($rownum);
+ if ($mode eq 'ARRAY') {
+ # we copy the array here because fetch (currently) always
+ # returns the same array ref. XXX
+ if (@$slice) {
$rownum = 0;
- while (1) {
- @row = $sth->fetchrow;
+ while ($row = $sth->fetch) {
$rownum++;
- if ($DBI::err) {
- return();
+ last if ($endrow > 0 && $rownum > $endrow);
+ push @rows, [ @{$row}[ @$slice] ] if ($rownum >= $startrow);
}
- if ($#row < 0 || ($endrow > 0 && $rownum > $endrow)) {
- $sth->finish;
- if ($DBI::err) {
- return();
+ $sth->finish if ($endrow > 0 && $rownum > $endrow);
}
- last;
+ else {
+ # return $sth->_fetchall_arrayref;
+ $rownum = 0;
+ while ($row = $sth->fetch) {
+ $rownum++;
+ last if ($endrow > 0 && $rownum > $endrow);
+ push @rows, [ @$row ] if ($rownum >= $startrow);
}
- if ($rownum >= $startrow) {
- push(@rows, [@row]);
+ $sth->finish if ($endrow > 0 && $rownum > $endrow);
}
}
- \@rows;
+ elsif ($mode eq 'HASH') {
+ if (keys %$slice) {
+ my @o_keys = keys %$slice;
+ my @i_keys = map { lc } keys %$slice;
+ $rownum = 0;
+ while ($row = $sth->fetchrow_hashref('NAME_lc')) {
+ my %hash;
+ @hash{@o_keys} = @{$row}{@i_keys};
+ $rownum++;
+ last if ($endrow > 0 && $rownum > $endrow);
+ push @rows, \%hash if ($rownum >= $startrow);
}
-
-# $ok = $rep->exec_sql($sql);
-sub exec_sql {
- my ($self, $sql) = @_;
- my (@data, @row, $dbh, $sth, $rc);
-
- if (!defined $self->{dbh}) {
- $self->{error} = "Not connected to database";
- return 0;
+ $sth->finish if ($endrow > 0 && $rownum > $endrow);
}
- $dbh = $self->{dbh};
- delete $self->{error};
- $self->{numrows} = 0;
- $self->{sql} = $sql;
-
- $sth = $dbh->prepare($sql);
- if ($DBI::err) {
- return(0);
+ else {
+ # XXX assumes new ref each fetchhash
+ while ($row = $sth->fetchrow_hashref()) {
+ $rownum++;
+ last if ($endrow > 0 && $rownum > $endrow);
+ push @rows, $row if ($rownum >= $startrow);
}
-
- $rc = $sth->execute;
- $self->{numrows} = $rc;
- if ($DBI::err) {
- return(0);
+ $sth->finish if ($endrow > 0 && $rownum > $endrow);
}
-
- $sth->finish;
- if ($DBI::err) {
- return(0);
}
-
- 1;
+ else { Carp::croak("fetchall_arrayref($mode) invalid") }
+ return \@rows;
}
######################################################################
@@ -1171,7 +1134,7 @@
# $row = $rep->select_row ($table, \@cols, \@params, \%paramvalues);
sub select_row {
my $self = shift;
- my ($table, $sql);
+ my ($dbh, $table, $sql);
$table = $_[0];
if ($self->{table}{$table}{rawaccess}) {
$sql = $self->mk_select_rows_sql(@_);
@@ -1179,7 +1142,9 @@
else {
$sql = $self->mk_select_joined_rows_sql(@_);
}
- $self->exec_select_row($sql);
+ $dbh = $self->{dbh};
+ return undef if (!$dbh);
+ return $dbh->selectrow_arrayref($sql);
}
# NOTE: everything after the first line is optional
@@ -1191,7 +1156,7 @@
# TODO: rethink $startrow/$endrow vs. $numrows/$skiprows
sub select_rows {
my $self = shift;
- my ($table, $startrow, $endrow, $sql);
+ my ($dbh, $table, $startrow, $endrow, $sql);
($table, $startrow, $endrow) = @_[(0,5,6)];
if ($self->{table}{$table}{rawaccess}) {
$sql = $self->mk_select_rows_sql(@_);
@@ -1199,14 +1164,16 @@
else {
$sql = $self->mk_select_joined_rows_sql(@_);
}
- $self->exec_select($sql, $startrow, $endrow);
+ return $self->selectrange_arrayref($sql, $startrow, $endrow);
}
# $ok = $rep->insert_row ($table, \@cols, \@row);
sub insert_row {
my ($self, $table, $cols, $row) = @_;
my $sql = $self->mk_insert_row_sql($table, $cols, $row);
- $self->exec_sql($sql);
+ my $dbh = $self->{dbh};
+ return 0 if (!defined $dbh);
+ return $dbh->do($sql);
}
# $ok = $rep->insert_rows ($table, \@cols, \@rows);
@@ -1214,11 +1181,14 @@
my ($self, $table, $cols, $rows) = @_;
my ($row, $sql, $nrows, $ok);
+ my $dbh = $self->{dbh};
+ return 0 if (!defined $dbh);
+
$ok = 1;
foreach $row (@$rows) {
$sql = $self->mk_insert_row_sql($table, $cols, $row);
$nrows += $self->{numrows};
- if (!$self->exec_sql($sql)) {
+ if (!$dbh->do($sql)) {
$self->{numrows} = $nrows;
$ok = 0;
last;
@@ -1232,61 +1202,36 @@
sub update_row {
my ($self, $table, $cols, $row, $keycolidx) = @_;
my $sql = $self->mk_update_row_sql($table, $cols, $row, $keycolidx);
- $self->exec_sql($sql);
+ my $dbh = $self->{dbh};
+ return 0 if (!defined $dbh);
+ return $dbh->do($sql);
}
# $ok = $rep->update_rows($table, \@cols, \@row, \@params, \%paramvalues);
sub update_rows {
my ($self, $table, $cols, $row, $params, $paramvalues) = @_;
my $sql = $self->mk_update_rows_sql($table, $cols, $row, $params, $paramvalues);
- $self->exec_sql($sql);
+ my $dbh = $self->{dbh};
+ return 0 if (!defined $dbh);
+ return $dbh->do($sql);
}
-# $ok = $rep->store_row ($table, \@cols, \@row, \@keycolidx, $update_first);
-#sub store_row {
-# my ($self, $table, $cols, $row, $keycolidx, $update_first) = @_;
-# my ($update_sql, $insert_sql, $success);
-#
-# #print "store_row($table,\n [",
-# # join(",",@$cols), "],\n [",
-# # join(",",@$row), "],\n [",
-# # join(",",@$keycolidx), "], $update_first);\n";
-#
-# $success = 0;
-# if ($update_first) {
-# $update_sql = $self->mk_update_row_sql($table,$cols,$row,$keycolidx);
-# $success = $self->exec_sql($update_sql);
-# $success = 0 if ($self->{numrows} == 0); # SQL succeeded but found no
rows to update
-# if (!$success) {
-# $insert_sql = $self->mk_insert_row_sql($table,$cols,$row);
-# $success = $self->exec_sql($insert_sql);
-# }
-# }
-# else {
-# $insert_sql = $self->mk_insert_row_sql($table,$cols,$row);
-# $success = $self->exec_sql($insert_sql);
-# if (!$success) {
-# $update_sql = $self->mk_update_row_sql($table,$cols,$row,$keycolidx);
-# $success = $self->exec_sql($update_sql);
-# $success = 0 if ($self->{numrows} == 0); # SQL succeeded but found
no rows to update
-# }
-# }
-#
-# $success;
-#}
-
# $ok = $rep->delete_row ($table, \@cols, \@row, \@keycolidx);
sub delete_row {
my $self = shift;
my $sql = $self->mk_delete_row_sql(@_);
- $self->exec_sql($sql);
+ my $dbh = $self->{dbh};
+ return 0 if (!defined $dbh);
+ return $dbh->do($sql);
}
# $ok = $rep->delete_rows($table, \@params, \%paramvalues);
sub delete_rows {
my $self = shift;
my $sql = $self->mk_delete_rows_sql(@_);
- $self->exec_sql($sql);
+ my $dbh = $self->{dbh};
+ return 0 if (!defined $dbh);
+ return $dbh->do($sql);
}
######################################################################
