cvsuser 04/09/02 14:04:08
Modified: App-Repository/lib/App/Repository DBI.pm
Log:
primary keys, @{} expressions, contains _ bug, tracing
Revision Changes Path
1.18 +196 -120 p5ee/App-Repository/lib/App/Repository/DBI.pm
Index: DBI.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Repository/lib/App/Repository/DBI.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- DBI.pm 18 Feb 2004 13:17:40 -0000 1.17
+++ DBI.pm 2 Sep 2004 21:04:07 -0000 1.18
@@ -1,13 +1,13 @@
######################################################################
-## File: $Id: DBI.pm,v 1.17 2004/02/18 13:17:40 spadkins Exp $
+## File: $Id: DBI.pm,v 1.18 2004/09/02 21:04:07 spadkins Exp $
######################################################################
use App;
use App::Repository;
package App::Repository::DBI;
-$VERSION = do { my @r=(q$Revision: 1.17 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.18 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
@ISA = ( "App::Repository" );
@@ -171,7 +171,7 @@
=cut
sub _connect {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
if (!defined $self->{dbh}) {
@@ -180,13 +180,13 @@
$self->{dbh} = DBI->connect($dsn, $self->{dbuser}, $self->{dbpass}, $attr);
}
- &App::sub_exit(defined $self->{dbh}) if ($App::trace_subs);
+ &App::sub_exit(defined $self->{dbh}) if ($App::trace);
return(defined $self->{dbh});
}
# likely overridden at the subclass level
sub _dsn {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
my ($dbidriver, $dbname, $dbuser, $dbpass, $dbschema);
@@ -201,27 +201,27 @@
my $dsn = "dbi:${dbidriver}:database=${dbname}";
- &App::sub_exit($dsn) if ($App::trace_subs);
+ &App::sub_exit($dsn) if ($App::trace);
return($dsn);
}
# likely overridden at the subclass level
sub _attr {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $attr = {
PrintError => 0,
AutoCommit => 1,
RaiseError => 1,
#ShowErrorStatement => 1, # this doesn't seem to include the right SQL
statement. very confusing.
};
- &App::sub_exit($attr) if ($App::trace_subs);
+ &App::sub_exit($attr) if ($App::trace);
return($attr);
}
sub _dbh {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
- &App::sub_exit($self->{dbh}) if ($App::trace_subs);
+ &App::sub_exit($self->{dbh}) if ($App::trace);
return($self->{dbh});
}
@@ -254,33 +254,33 @@
=cut
sub _disconnect {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
if (defined $self->{dbh} && !($self->{preconnected})) {
my $dbh = $self->{dbh};
$dbh->disconnect;
delete $self->{dbh};
}
- &App::sub_exit(1) if ($App::trace_subs);
+ &App::sub_exit(1) if ($App::trace);
1;
}
sub _disconnect_client_only {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
if ($self->{dbh}) {
$self->{dbh}{InactiveDestroy} = 1;
delete $self->{dbh};
}
- &App::sub_exit(1) if ($App::trace_subs);
+ &App::sub_exit(1) if ($App::trace);
1;
}
sub _is_connected {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
my $retval = ((defined $self->{dbh}) ? 1 : 0);
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return ($retval);
}
@@ -297,7 +297,7 @@
######################################################################
sub _init2 {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
my ($name);
@@ -316,11 +316,11 @@
}
}
}
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
sub _get_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
# we only need the first row
@@ -355,12 +355,12 @@
print "\n";
}
- &App::sub_exit($row) if ($App::trace_subs);
+ &App::sub_exit($row) if ($App::trace);
return($row);
}
sub _get_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
my ($sql, $dbh, $rows, $startrow, $endrow);
@@ -395,13 +395,13 @@
print "\n";
}
- &App::sub_exit($rows) if ($App::trace_subs);
+ &App::sub_exit($rows) if ($App::trace);
return($rows);
}
# modified from the DBD::_::db::selectall_arrayref in DBI.pm
sub _selectrange_arrayref {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $stmt, $startrow, $endrow, $attr, @bind) = @_;
my $dbh = $self->{dbh};
return [] if (!$dbh);
@@ -417,18 +417,18 @@
}
}
my $retval = $self->_fetchrange_arrayref($sth, $startrow, $endrow, $slice);
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
else {
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
return();
}
}
# modified from the DBD::_::st::fetchall_arrayref in DBI.pm
sub _fetchrange_arrayref {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $sth, $startrow, $endrow, $slice) = @_;
$slice = [] if (! defined $slice);
$startrow = 0 if (!defined $startrow);
@@ -485,7 +485,7 @@
}
}
else { Carp::croak("fetchall_arrayref($mode) invalid") }
- &App::sub_exit([EMAIL PROTECTED]) if ($App::trace_subs);
+ &App::sub_exit([EMAIL PROTECTED]) if ($App::trace);
return [EMAIL PROTECTED];
}
@@ -494,7 +494,7 @@
######################################################################
sub _mk_where_clause {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $options) = @_;
my ($where, $column, $param, $value, $colnum, $repop, $sqlop, $column_def,
$quoted);
my ($tabledef, $tabcols, %sqlop, $alias, $dbexpr);
@@ -567,7 +567,14 @@
else {
$value = $params->{$param};
- if ($value =~ s/^!expr!//) {
+ if (ref($value) eq "ARRAY") {
+ $value = join(",", @$value);
+ }
+
+ if ($value =~ s/[EMAIL PROTECTED](.*)\}$/$1/) { # new @{}
expressions replace !expr!
+ $quoted = 0;
+ }
+ elsif ($value =~ s/^!expr!//) { # deprecated (ugh!)
$quoted = 0;
}
elsif ($value =~ /,/ && !
$tabledef->{param}{$param}{no_auto_in_param}) {
@@ -582,8 +589,10 @@
$value = "'%$value%'";
}
elsif ($repop eq "matches") {
- $value =~ s/\*/%/g;
+ $value =~ s/_/\\_/g;
$value =~ s/'/\\'/g;
+ $value =~ s/\*/%/g;
+ $value =~ s/\?/_/g;
$value = "'$value'";
}
elsif ($sqlop eq "in" || $sqlop eq "=") {
@@ -622,12 +631,12 @@
}
}
}
- &App::sub_exit($where) if ($App::trace_subs);
+ &App::sub_exit($where) if ($App::trace);
$where;
}
sub _mk_select_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
@@ -646,6 +655,15 @@
if (defined $order_by && $#$order_by > -1) {
for ($colnum = 0; $colnum <= $#$order_by; $colnum++) {
$col = $order_by->[$colnum];
+ if ($col =~ /^(.+)\.asc$/) {
+ $col = $1;
+ $dir = " asc";
+ }
+ elsif ($col =~ /^(.+)\.desc$/) {
+ $col = $1;
+ $dir = " desc";
+ }
+ else {
$dir = "";
if ($direction && ref($direction) eq "HASH" && defined
$direction->{$col}) {
if ($direction->{$col} =~ /^asc$/i) {
@@ -655,6 +673,7 @@
$dir = " desc";
}
}
+ }
$sql .= ($colnum == 0) ? "order by\n $col$dir" : ",\n $col$dir";
}
$sql .= "\n";
@@ -662,12 +681,12 @@
my $suffix = $self->_mk_select_sql_suffix($table, $options);
$sql .= $suffix if ($suffix);
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
return($sql);
}
sub _mk_select_joined_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
@@ -888,9 +907,19 @@
############################################################
my (@order_by_dbexpr, $order_by_dbexpr);
if (defined $order_by && ref($order_by) eq "ARRAY") {
+ my ($dir);
for ($idx = 0; $idx <= $#$order_by; $idx++) {
$column = $order_by->[$idx];
+ $dir = "";
+ if ($column =~ /^(.+)\.asc$/) {
+ $column = $1;
+ $dir = " asc";
+ }
+ elsif ($column =~ /^(.+)\.desc$/) {
+ $column = $1;
+ $dir = " desc";
+ }
$column_def = $table_def->{column}{$column};
next if (!defined $column_def);
@@ -907,6 +936,10 @@
}
if ($order_by_dbexpr) {
+ if ($dir) {
+ $order_by_dbexpr .= $dir;
+ }
+ else {
if ($direction && ref($direction) eq "HASH" && defined
$direction->{$column}) {
if ($direction->{$column} =~ /^asc$/i) {
$order_by_dbexpr .= " asc";
@@ -915,6 +948,7 @@
$order_by_dbexpr .= " desc";
}
}
+ }
push(@order_by_dbexpr, $order_by_dbexpr);
}
}
@@ -1004,9 +1038,19 @@
next if (defined $table_def->{param}{$param}{all_value} &&
$paramvalue eq $table_def->{param}{$param}{all_value});
- if ($paramvalue =~ s/^!expr!//) {
+ if (ref($paramvalue) eq "ARRAY") {
+ $paramvalue = join(",", @$paramvalue);
+ }
+
+ if ($paramvalue =~ s/[EMAIL PROTECTED](.*)\}$/$1/) { # new @{}
expressions replace !expr!
+ $quoted = 0;
+ }
+ elsif ($paramvalue =~ s/^!expr!//) { # deprecated (ugh!)
$quoted = 0;
}
+ elsif ($paramvalue =~ /,/ && !
$table_def->{param}{$param}{no_auto_in_param}) {
+ $quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted})
: ($paramvalue !~ /^-?[0-9.,]+$/);
+ }
else {
$quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted})
: ($paramvalue !~ /^-?[0-9.]+$/);
}
@@ -1016,8 +1060,10 @@
$paramvalue = "'%$paramvalue%'";
}
elsif ($repop eq "matches") {
- $paramvalue =~ s/\*/%/g;
+ $paramvalue =~ s/_/\\_/g;
$paramvalue =~ s/'/\\'/g;
+ $paramvalue =~ s/\*/%/g;
+ $paramvalue =~ s/\?/_/g;
$paramvalue = "'$paramvalue'";
}
elsif ($sqlop eq "in" || $sqlop eq "=") {
@@ -1201,19 +1247,19 @@
############################################################
# return the SQL statement
############################################################
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
return($sql);
}
sub _mk_select_sql_suffix {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $options) = @_;
- &App::sub_exit("") if ($App::trace_subs);
+ &App::sub_exit("") if ($App::trace);
return("");
}
sub _require_tables {
- &App::sub_entry if ($App::trace_subs >= 3);
+ &App::sub_entry if ($App::trace >= 3);
my ($self, $dbexpr, $reqd_tables, $tablealiashref, $require_type) = @_;
#print "_require_tables($dbexpr,...,...,$require_type)\n";
my ($tablealias, $tablealias2, @tablealias, %tableseen, $dependencies);
@@ -1236,12 +1282,12 @@
}
}
}
- &App::sub_exit() if ($App::trace_subs >= 3);
+ &App::sub_exit() if ($App::trace >= 3);
}
# $insert_sql = $rep->_mk_insert_row_sql ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
sub _mk_insert_row_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
my ($sql, $values, $col, $value, $colnum, $quoted);
@@ -1282,13 +1328,13 @@
$sql .= ")\n";
$values .= ")\n";
$sql .= $values;
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
$sql;
}
# $insert_sql = $rep->_mk_insert_sql ($table, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
sub _mk_insert_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row, $options) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
@@ -1329,7 +1375,7 @@
}
}
my $sql = "insert into $table\n (" . join(",\n ",@$cols) . ")\nvalues\n ("
. join(@values) . ")\n";
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
$sql;
}
@@ -1339,7 +1385,7 @@
# $update_sql = $rep->_mk_update_sql($table, $key, [EMAIL PROTECTED], [EMAIL
PROTECTED], \%options);
# $update_sql = $rep->_mk_update_sql($table, undef, [EMAIL PROTECTED], [EMAIL
PROTECTED], \%options);
sub _mk_update_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
die "Database->_mk_update_sql(): no columns specified" if (!$cols || $#$cols ==
-1);
@@ -1458,7 +1504,7 @@
}
my $sql = "update $table set\n " . join(",\n ",@set) . "\n" . $where;
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
$sql;
}
@@ -1470,7 +1516,7 @@
# $delete_sql = $rep->_mk_delete_sql($table, $key, undef, undef, \%options);
# $delete_sql = $rep->_mk_delete_sql($table, undef, [EMAIL PROTECTED], [EMAIL
PROTECTED], \%options);
sub _mk_delete_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
@@ -1562,13 +1608,13 @@
}
my $sql = "delete from $table\n$where";
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
$sql;
}
# $delete_sql = $rep->_mk_delete_row_sql ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED], [EMAIL PROTECTED]);
sub _mk_delete_row_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row, $keycolidx) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
my ($sql, $where, @colused, $col, $value, $colnum, $i, $nonkeycolnum, $quoted);
@@ -1609,20 +1655,20 @@
}
$sql .= $where;
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
$sql;
}
# $delete_sql = $rep->_mk_delete_rows_sql($table, [EMAIL PROTECTED], \%paramvalues);
sub _mk_delete_rows_sql {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $paramvalues) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
my ($sql, $col, $colnum);
$sql = "delete from $table\n";
$sql .= $self->_mk_where_clause($table, $params);
- &App::sub_exit($sql) if ($App::trace_subs);
+ &App::sub_exit($sql) if ($App::trace);
$sql;
}
@@ -1636,7 +1682,7 @@
# unfortunately, it doesn't work yet
sub _select_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $params, $paramvalues) = @_;
my ($dbh, $sql, $param, @params, %paramvalues, @paramvalues);
@@ -1662,10 +1708,10 @@
my $rows = $self->_selectrange_arrayref($sql, 1, 1, undef, @paramvalues);
if (!$rows || $#$rows == -1) {
- &App::sub_exit([]) if ($App::trace_subs);
+ &App::sub_exit([]) if ($App::trace);
return [];
}
- &App::sub_exit($rows->[0]) if ($App::trace_subs);
+ &App::sub_exit($rows->[0]) if ($App::trace);
return ($rows->[0]);
}
@@ -1681,7 +1727,7 @@
# unfortunately, it doesn't work yet
sub _select_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $params, $paramvalues, $order_by, $startrow, $endrow,
$sortdircol, $keycolidx, $writeable, $columntype, $summarykeys) = @_;
my ($sql, $param, @params, %paramvalues, @paramvalues);
@@ -1708,13 +1754,13 @@
}
$self->{sql} = $sql;
my $retval = $self->_selectrange_arrayref($sql, $startrow, $endrow, undef,
@paramvalues);
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
$retval;
}
# $ok = $rep->_insert_row ($table, [EMAIL PROTECTED], [EMAIL PROTECTED]);
sub _insert_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row) = @_;
$self->{error} = "";
my $sql = $self->_mk_insert_row_sql($table, $cols);
@@ -1724,7 +1770,7 @@
my $debug_sql = $self->{context}{options}{debug_sql};
if ($debug_sql) {
- print "DEBUG_SQL: _insert_row()\n";
+ print "DEBUG_SQL: insert()\n";
print "DEBUG_SQL: bind vars [", join("|",map { defined $_ ? $_ : "undef" }
@$row), "]\n";
print $sql;
}
@@ -1734,13 +1780,13 @@
print "\n";
}
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
$retval;
}
# $ok = $rep->_insert_rows ($table, [EMAIL PROTECTED], [EMAIL PROTECTED]);
sub _insert_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $cols, $rows) = @_;
$self->{error} = "";
my ($row, $sql, $nrows, $ok, $retval);
@@ -1773,12 +1819,12 @@
}
$self->{sql} = $sql;
$self->{numrows} = $nrows;
- &App::sub_exit($ok) if ($App::trace_subs);
+ &App::sub_exit($ok) if ($App::trace);
return($ok);
}
sub _delete {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->{error} = "";
my $sql = $self->_mk_delete_sql($table, $params, $cols, $row, $options);
@@ -1795,7 +1841,7 @@
print "\n";
}
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
@@ -1805,7 +1851,7 @@
# $nrows = $rep->_update($table, $key, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
# $nrows = $rep->_update($table, undef, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
sub _update {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->{error} = "";
my $sql = $self->_mk_update_sql($table, $params, $cols, $row, $options);
@@ -1822,13 +1868,13 @@
print "\n";
}
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
# $ok = $rep->_delete_row ($table, [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL
PROTECTED]);
sub _delete_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
$self->{error} = "";
my $sql = $self->_mk_delete_row_sql(@_);
@@ -1847,13 +1893,13 @@
print "\n";
}
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
$retval;
}
# $ok = $rep->_delete_rows($table, [EMAIL PROTECTED], \%paramvalues);
sub _delete_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
$self->{error} = "";
my $sql = $self->_mk_delete_rows_sql(@_);
@@ -1872,7 +1918,7 @@
print "\n";
}
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
$retval;
}
@@ -1883,7 +1929,7 @@
use DBIx::Compat;
sub _load_rep_metadata_from_source {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
my ($dbidriver, $dbh);
@@ -2072,11 +2118,11 @@
$self->{native}{need_null_in_create} = DBIx::Compat::GetItem($dbidriver,
"NeedNullInCreate");
$self->{native}{empty_is_null} = DBIx::Compat::GetItem($dbidriver,
"EmptyIsNull");
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
sub _load_table_metadata_from_source {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table) = @_;
return if (! $table);
@@ -2113,11 +2159,14 @@
# COLUMN DATA
#########################################################
my ($colnum, $data_types, $columns, $column_def, $phys_columns);
- my ($native_type_num, $native_type_def);
+ my ($native_type_num, $native_type_def, $phys_table);
$func = DBIx::Compat::GetItem($dbidriver, "ListFields");
+ eval {
$sth = &{$func}($dbh, $table);
-
+ };
+ if (!$@) {
+ $table_def->{phys_table} = $table;
$phys_columns = $sth->{NAME}; # array of fieldnames
$data_types = $sth->{TYPE}; # array of fieldtypes
@@ -2156,6 +2205,15 @@
if (!defined $column_def->{dbexpr});
}
}
+ }
+
+ ######################################################################
+ # primary key
+ ######################################################################
+
+ if (!$self->{primary_key} || !$self->{alternate_key}) {
+ $self->_load_table_key_metadata($table);
+ }
######################################################################
# tables that are related via tablealiases can be "import"-ed
@@ -2212,7 +2270,25 @@
# $d->Indent(1);
# print $d->Dump();
#}
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
+}
+
+sub _load_table_key_metadata {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table) = @_;
+
+ return if (! $table);
+ my $table_def = $self->{table}{$table};
+ return if (! $table_def);
+ my $dbh = $self->{dbh};
+
+ # if not defined at all, try to get it from the database
+ if (! defined $table_def->{primary_key}) {
+ eval {
+ $table_def->{primary_key} = [ $dbh->primary_key($self->{dbcatalog},
$self->{dbschema}, $table) ];
+ };
+ }
+ &App::sub_exit() if ($App::trace);
}
1;
