possible Class::DBI::Oracle [patch]

[prev] [thread] [next] [Date index for 2005/04/19]

This is a multi-part message in MIME format.
--------------010803040801020002010403
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit

Hi all,

The attached patch would allow you to specify an Oracle schema along with 
your table.  So this module currently lets you do:

__PACKAGE__->set_up_table('TABLE_NAME');


With this patch you can also do:

__PACKAGE__->set_up_table('SCHEMA.TABLE_NAME');

  -or-

__PACKAGE__->set_up_table('TABLE_NAME', 'SCHEMA');


The implementation is changed to use the DBI Catalog methods.  If a schema 
is not specified (the common case) then it is taken from $dbh->{Username}. 
I'm not sure that this is 100% backward compatible, but I think it is.

Anyway, I'm not sure if this is useful to anyone else, or if it would even 
work for anyone else.  This would make it usable in my environment though.

I'd supply another patch with updated pod if it might actually get applied.

-thepler

--------------010803040801020002010403
Content-Type: text/plain;
 name="Oracle.pm.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="Oracle.pm.patch"

--- Oracle.pm.orig	2003-07-15 19:56:23.000000000 -0500
+++ Oracle.pm	2005-04-19 16:45:20.000000000 -0500
@@ -88,9 +88,14 @@
 sub _die { require Carp; Carp::croak(@_); } 
 
 sub set_up_table {
-	my($class, $table) = @_;
+	my($class, $table, $schema) = @_;
 	my $dbh = $class->db_Main();
 
+        ($schema, $table) = split(/\./, $table)
+            if ($table =~ /\./ and not $schema);
+
+        $schema ||= uc $dbh->{Username};
+
 	$class->table($table);
 
 	$table = uc $table;
@@ -99,49 +104,33 @@
 	(my $alias = $class) =~ s/.*:://g;
 	$class->table_alias(qq["$alias"]) if grep /$alias/i, @problemWords;
 
-	# find the primary key and column names.
-	my $sql = qq[
-		select 	lower(a.column_name), b.position
-		from 	user_tab_columns a,
-				(
-				select 	column_name, position
-				from   	user_constraints a, user_cons_columns b
-				where 	a.constraint_name = b.constraint_name
-				and	a.constraint_type = 'P'
-				and	a.table_name = ?
-				) b
-		where 	a.column_name = b.column_name (+)
-		and	a.table_name = ?
-		order by position, a.column_name];
+        my $row;
+        my $sth;
+        my @all;
+        my @primary;
+
+        $sth = $dbh->column_info('', $schema, $table, '%');
+        while ($row = $sth->fetch) {
+            push @all, lc $row->[3];
 
-	my $sth = $dbh->prepare($sql);
-	$sth->execute($table,$table);
+        }
 	
-	my $col = $sth->fetchall_arrayref;
+        $sth = $dbh->primary_key_info('', $schema, $table);
+        while ($row = $sth->fetch) {
+            push @primary, lc $row->[3];
+        }
 	
-	$sth->finish();
+	my $msg = qq{has no primary key} unless @primary;
 
 	# deal with old revisions
-	my $msg;
-	my @primary = ();
-
-	$msg = qq{has no primary key} unless $col->[0][1];
-
 	# Class::DBI >= 0.93 can use multiple-primary-column keys.
-	if ($Class::DBI::VERSION >= 0.93) {
-
-		map { push @primary, $_->[0] if $_->[1] } @$col;
-
-	} else {
-
-		$msg = qq{has a composite primary key} if $col->[1][1];
-
-		push @primary, $col->[0][0];
+	if ($Class::DBI::VERSION < 0.93) {
+		$msg = qq{has a composite primary key} if @primary > 1;
 	}
 
 	_die('The "',$class->table,qq{" table $msg}) if $msg;
 
-	$class->columns(All => map {$_->[0]} @$col);
+	$class->columns(All => @all);
 	$class->columns(Primary => @primary);
 
 	# attempt to guess the sequence from the table name.
@@ -154,7 +143,7 @@
 
 	# Go and get all the sequences where the table name is within the
 	# name of the sequence
-	$sql = qq[
+	my $sql = qq[
 		select	sequence_name
 		from	user_sequences
 		where	sequence_name like (?)

--------------010803040801020002010403--