adding Oracle driver

diff --git a/Changes b/Changes
index f413bd9..88088bd 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension DBIx::DBSchema.
 
+0.24 unreleased
+       - Oracle driver from Daniel Hanks <hanksdc@about-inc.com> and Peter
+          Bowen <pbowen@aboutws.com>.
+
 0.23 Mon Feb 16 17:35:54 PST 2004
        - Update Pg dependancy to 1.32
        - Update the simple load test so it skips DBIx::DBSchema::DBD::Pg if

diff --git a/DBSchema/DBD/Oracle.pm b/DBSchema/DBD/Oracle.pm
new file mode 100644 (file)
index 0000000..7ad5bc3
--- /dev/null
+++ b/DBSchema/DBD/Oracle.pm
@@ -0,0 +1,124 @@
+package DBIx::DBSchema::DBD::Oracle;
+
+use strict;
+use vars qw($VERSION @ISA %typemap);
+use DBIx::DBSchema::DBD;
+
+$VERSION = '0.01';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+  'VARCHAR'         => 'VARCHAR2',
+  'SERIAL'          => 'INTEGER',
+  'LONG VARBINARY'  => 'BLOB',
+  'TIMESTAMP'       => 'DATE',
+  'BOOL'            => 'INTEGER'
+);
+
+=head1 NAME
+
+DBIx::DBSchema::DBD::Oracle - Oracle native driver for DBIx::DBSchema
+
+=head1 SYNOPSIS
+
+use DBI;
+use DBIx::DBSchema;
+
+$dbh = DBI->connect('dbi:Oracle:tns_service_name', 'user','pass');
+$schema = new_native DBIx::DBSchema $dbh;
+
+=head1 DESCRIPTION
+
+This module implements a Oracle-native driver for DBIx::DBSchema.
+
+=head1 AUTHOR
+
+Daniel Hanks <hanksdc@about-inc.com>
+
+=cut 
+
+### Return column name, column type, nullability, column length, column default,
+### and a field reserved for driver-specific use
+sub columns {
+  my ($proto, $dbh, $table) = @_;
+  return $proto->_column_info($dbh, $table);
+}
+
+sub column {
+  my ($proto, $dbh, $table, $column) = @_;
+  return $proto->_column_info($dbh, $table, $column);
+}
+
+sub _column_info {
+  my ($proto, $dbh, $table, $column) = @_;
+  my $sql = "SELECT column_name, data_type,
+                    CASE WHEN nullable = 'Y' THEN 1
+                         WHEN nullable = 'N' THEN 0
+                         ELSE 1
+                    END AS nullable,
+                    data_length, data_default, NULL AS reserved
+               FROM user_tab_columns
+              WHERE table_name = ?";
+     $sql .= "  AND column_name = ?" if defined($column);
+  if(defined($column)) {
+    return $dbh->selectrow_arrayref($sql, undef, $table, $column);
+  } else { ### Assume columns
+    return $dbh->selectall_arrayref($sql, undef, $table);
+  }
+}
+
+### This is broken. Primary keys can be comprised of any subset of a tables
+### fields, not just one field, as this module assumes.
+sub primary_key {
+  my ($proto, $dbh, $table) = @_;
+  my $sql = "SELECT column_name
+               FROM user_constraints uc, user_cons_columns ucc
+              WHERE uc.constraint_name = ucc.constraint_name
+                AND uc.constraint_type = 'P'
+                AND uc.table_name = ?";
+  my ($key) = $dbh->selectrow_array($sql, undef, $table);
+  return $key;
+}
+
+### Wraoper around _index_info
+sub unique {
+  my ($proto, $dbh, $table) = @_;
+  return $proto->_index_info($dbh, $table, 'UNIQUE');
+}
+
+### Wrapper around _index_info
+sub index {
+  my ($proto, $dbh, $table) = @_;
+  return $proto->_index_info($dbh, $table, 'NONUNIQUE');
+}
+
+### Collect info about unique or non-unique indexes
+### $type must be 'UNIQUE' or 'NONUNIQUE'
+sub _index_info {
+  my ($proto, $dbh, $table, $type) = @_;
+
+  ### Sanity-check
+  die "\$type must be 'UNIQUE' or 'NONUNIQUE'" 
+    unless $type =~ /^(NON)?UNIQUE$/;
+
+  ### Set up the query
+  my $sql = "SELECT ui.index_name, uic.column_name
+               FROM user_indexes ui, user_ind_columns uic
+              WHERE ui.index_name = uic.index_name
+                AND ui.uniqueness = ?
+                AND table_name = ?";
+  my $sth = $dbh->prepare($sql);
+  $sth->execute($table, $type);
+
+  ### Now collect the results
+  my $results = {};
+  while(my ($idx, $col) = $sth->fetchrow_array()) {
+    if(!exists($results->{$idx})) {
+      $results->{$idx} = [];
+    }
+    push @{$results->{$idx}}, $col;
+  }
+  return $results;
+}
+
+

diff --git a/MANIFEST b/MANIFEST
index b04de25..3570adb 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -8,6 +8,8 @@ DBSchema.pm
 t/load.t
 t/load-mysql.t
 t/load-pg.t
+t/load-sybase.t
+t/load-oracle.t
 DBSchema/Table.pm
 DBSchema/ColGroup.pm
 DBSchema/ColGroup/Index.pm
@@ -17,3 +19,4 @@ DBSchema/DBD.pm
 DBSchema/DBD/mysql.pm
 DBSchema/DBD/Pg.pm
 DBSchema/DBD/Sybase.pm
+DBSchema/DBD/Oracle.pm

diff --git a/README b/README
index e020427..4e41f8b 100644 (file)
--- a/README
+++ b/README
@@ -1,6 +1,6 @@
 DBIx::DBSchema
 
-Copyright (c) 2000-2002 Ivan Kohler
+Copyright (c) 2000-2004 Ivan Kohler
 Copyright (c) 2000 Mail Abuse Prevention System LLC
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
@@ -12,7 +12,7 @@ schema from an existing database.  You can save the schema to disk and restore
 it from different process.  Most importantly, DBIx::DBSchema can write SQL
 CREATE statements for different databases from a single source.
 
-Currently supported databases are MySQL, PostgreSQL and Sybase.
+Currently supported databases are MySQL, PostgreSQL, Sybase and Oracle.
 DBIx::DBSchema will attempt to use generic SQL syntax for other databases.
 Assistance adding support for other databases is welcomed.  See the
 DBIx::DBSchema::DBD manpage, "Driver Writer's Guide and Base Class".
@@ -39,4 +39,4 @@ A mailing list is available.  Send a blank message to
 
 Homepage: <http://www.420.am/dbix-dbschema>
 
-$Id: README,v 1.9 2002-11-29 23:03:04 ivan Exp $
+$Id: README,v 1.10 2004-02-26 01:34:24 ivan Exp $

diff --git a/t/load-oracle.t b/t/load-oracle.t
new file mode 100644 (file)
index 0000000..c851812
--- /dev/null
+++ b/t/load-oracle.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema::DBD::Oracle;
+$loaded = 1;
+print "ok 1\n";

diff --git a/t/load-sybase.t b/t/load-sybase.t
new file mode 100644 (file)
index 0000000..fef6047
--- /dev/null
+++ b/t/load-sybase.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema::DBD::Sybase;
+$loaded = 1;
+print "ok 1\n";