Class::DBI::Oracle - Extensions to Class::DBI for Oracle

  package Music::DBI;
  use base 'Class::DBI::Oracle';
  Music::DBI->set_db('Main', 'dbi:Oracle:tnsname', 'username', 'password');

  package Artist;
  use base 'Music::DBI';
  __PACKAGE__->set_up_table('Artist');

  # ... see the Class::DBI documentation for details on Class::DBI usage

	* A sequence fix for Oracle databases.

	* Automatic column name discovery.

	* Automatic primary key detection.

	* Sequence name guessing.

	* Proper aliasing of reserved words.

package Class::DBI::Oracle;

use strict;
use base 'Class::DBI';

use vars qw($VERSION);
$VERSION = '0.51';

# Setup an alias if the tablename is an Oracle reserved word - 
# for example if the class name is: user
# make the table_alias q["user"]
#
# Note: actually not all oracle reserved words (v$reserved_words) seem
# to be a problem, but these have been identified

my @problemWords = qw{
	ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT BETWEEN BY CHAR CHECK CLUSTER 
	COLUMN COMMENT COMPRESS CONNECT CREATE CROSS CURRENT CURRENT_DATE 
	CURRENT_TIMESTAMP CURSOR_SPECIFIC_SEGMENT DATE DBTIMEZONE DECIMAL 
	DEFAULT DELETE DESC DISTINCT DROP ELSE ESCAPE EXCLUSIVE EXISTS FALSE 
	FILE FLOAT FOR FROM GRANT GROUP HAVING IDENTIFIED IMMEDIATE IN INCREMENT
	INDEX INITIAL INSERT INTEGER INTERSECT INTO IS JOIN LDAP_REG_SYNC_INTERVAL
	LEVEL LIKE LOCALTIMESTAMP LOCK LOGICAL_READS_PER_SESSION LONG MAXEXTENTS
	MINUS MLSLABEL MODE MODIFY NLS_SORT NOAUDIT NOCOMPRESS NOT NOWAIT NULL 
	NUMBER OF OFFLINE ON ONLINE OPTION OR ORDER PASSWORD_VERIFY_FUNCTION 
	PRIOR PRIVILEGES PUBLIC RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
	SELECT SESSION SESSIONTIMEZONE SET SHARE SIZE SMALLINT START SUCCESSFUL
	SYNONYM SYSDATE SYSTIMESTAMP SYS_OP_BITVEC SYS_OP_ENFORCE_NOT_NULL$ TABLE
	THEN TO TRIGGER UID UNION UNIQUE UPDATE USER VALIDATE VALUES VARCHAR 
	VARCHAR2 VIEW WHENEVER WHERE WITH
};

sub _die { require Carp; Carp::croak(@_); } 

sub set_up_table {
	my($class, $table) = @_;
	my $dbh = $class->db_Main();

	$class->table($table);

	$table = uc $table;

	# alias the table if needed.
	(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 $sth = $dbh->prepare($sql);
	$sth->execute($table,$table);
	
	my $col = $sth->fetchall_arrayref;
	
	$sth->finish();

	# 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];
	}

	_die('The "',$class->table,qq{" table $msg}) if $msg;

	$class->columns(All => map {$_->[0]} @$col);
	$class->columns(Primary => @primary);

	# attempt to guess the sequence from the table name.
	# this won't work if there is inconsistent naming.
	#
	# This is potentially very dangerous code, there could be many
	# sequences with the same table name embedded, probably should 
	# only use the sequence if it's the only one that is found with the
	# same tablename

	# Go and get all the sequences where the table name is within the
	# name of the sequence
	$sql = qq[
				select	sequence_name
				from	user_sequences
				where	sequence_name like (?)
		];
	
	$sth = $dbh->prepare($sql);
	$sth->execute("\%$table\%");
	my @sequence = map {$_->[0]} @{$sth->fetchall_arrayref};
	$sth->finish();

	$class->sequence($sequence[0]) unless $#sequence;

}

     __PACKAGE__->set_sql('Nextval', <<'');
SELECT %s.NEXTVAL from DUAL

1;