cvsuser 04/09/02 14:02:09
Modified: App-Repository/lib/App/Repository MySQL.pm
Log:
add primary key autodetection
Revision Changes Path
1.8 +86 -6 p5ee/App-Repository/lib/App/Repository/MySQL.pm
Index: MySQL.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Repository/lib/App/Repository/MySQL.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- MySQL.pm 17 Jul 2003 17:50:49 -0000 1.7
+++ MySQL.pm 2 Sep 2004 21:02:08 -0000 1.8
@@ -1,12 +1,12 @@
######################################################################
-## File: $Id: MySQL.pm,v 1.7 2003/07/17 17:50:49 spadkins Exp $
+## File: $Id: MySQL.pm,v 1.8 2004/09/02 21:02:08 spadkins Exp $
######################################################################
use App::Repository::DBI;
package App::Repository::MySQL;
-$VERSION = do { my @r=(q$Revision: 1.7 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.8 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
@ISA = ( "App::Repository::DBI" );
@@ -33,7 +33,7 @@
=cut
sub _dsn {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
my $dbidriver = "mysql";
@@ -59,21 +59,101 @@
$dsn .= ";port=$dbport" if ($dbport); # if $dbhost not supplied, $dbport is
path to Unix socket
$dsn .= ";mysql_client_found_rows=true";
- &App::sub_exit($dsn) if ($App::trace_subs);
+ &App::sub_exit($dsn) if ($App::trace);
return($dsn);
}
sub _mk_select_sql_suffix {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $options) = @_;
my $suffix = "";
$options = {} if (!$options);
if ($options->{endrow}) {
$suffix = "limit $options->{endrow}\n";
}
- &App::sub_exit($suffix) if ($App::trace_subs);
+ &App::sub_exit($suffix) if ($App::trace);
return($suffix);
}
+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
+ my (@primary_key, @alternate_key, @index, @key, $key_name, $non_unique);
+ if ($table_def->{phys_table} && (! defined $table_def->{primary_key} || !
defined $table_def->{alternate_key})) {
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
+ my $sth = $dbh->prepare("SHOW INDEX FROM $table");
+ my $hashes = $dbh->selectall_arrayref($sth, { Columns=>{} });
+ foreach my $hash (@$hashes) {
+ if ($key_name && $hash->{key_name} ne $key_name) {
+ if ($key_name eq 'PRIMARY') {
+ @primary_key = @key;
+ }
+ elsif ($non_unique) {
+ push(@index, [EMAIL PROTECTED]);
+ }
+ else {
+ push(@alternate_key, [EMAIL PROTECTED]);
+ }
+ @key = ();
+ }
+ $non_unique = $hash->{non_unique};
+ $key_name = $hash->{key_name};
+ push(@key, $hash->{column_name});
+ }
+ if ($key_name) {
+ if ($key_name eq 'PRIMARY') {
+ @primary_key = @key;
+ }
+ elsif ($non_unique) {
+ push(@index, [EMAIL PROTECTED]);
+ }
+ else {
+ push(@alternate_key, [EMAIL PROTECTED]);
+ }
+ }
+
+ $table_def->{primary_key} = [EMAIL PROTECTED] if
(!$table_def->{primary_key});
+ $table_def->{alternate_key} = [EMAIL PROTECTED] if
(!$table_def->{alternate_key} && $#alternate_key > -1);
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
+# The following patch purportedly adds primary_key() detection directly
+# to the DBD where it belongs. Until this is in, I may want to
+# duplicate the code in this module.
+#diff -ru DBD-mysql-2.9003/lib/DBD/mysql.pm new/lib/DBD/mysql.pm
+#--- DBD-mysql-2.9003/lib/DBD/mysql.pm Mon Oct 27 14:26:08 2003
+#+++ new/lib/DBD/mysql.pm Tue Mar 2 08:03:17 2004
+#@@ -282,7 +282,22 @@
+# return map { $_ =~ s/.*\.//; $_ } $dbh->tables();
+#}
+#-
+#+sub primary_key {
+#+ my ($dbh, $catalog, $schema, $table) = @_;
+#+ my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
+#+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
+#+ my $desc_sth = $dbh->prepare("SHOW INDEX FROM $table_id");
+#+ my $desc = $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
+#+ my %keys;
+#+ foreach my $row (@$desc) {
+#+ if ($row->{key_name} eq 'PRIMARY') {
+#+ $keys{$row->{column_name}} = $row->{seq_in_index};
+#+ }
+#+ }
+#+ my (@keys) = sort { $keys{$a} <=> $keys{$b} } keys %keys;
+#+ return (@keys);
+#+}
+#+
+#sub column_info {
+# my ($dbh, $catalog, $schema, $table, $column) = @_;
+# return $dbh->set_err(1, "column_info doesn't support table wildcard")
+
1;
