From f7101d420f3b84f8ac0905e36d63c9d489119e89 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 16:18:54 -0500
Subject: [PATCH 01/35] Some databases support a timestamp with a number of
 digits.

This removes the ()s so that we can treat the type name separately from its
size.
---
 lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Datetime.pm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Datetime.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Datetime.pm
index 4c52051..c3140a7 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Datetime.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Datetime.pm
@@ -26,6 +26,7 @@ sub datetime_type {
     my $self = shift;
     my $real_type = $self->{realtype} || $self->default_type;
     $real_type =~ s/ /_/g;
+    $real_type =~ s/\(.*$//;
     return $real_type;
 }
 

From fe0f6feff973eced00603e71b1b8dc7dedf59d29 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 16:31:47 -0500
Subject: [PATCH 02/35] Pushed the type list down to the driver layer.

Different databases support different sets of types and sometimes need to be
treated differently.  For example, Oracle has some requirements on how to pass
blob data into an insert, whereas other databases can accept it as a hexed
value.
---
 lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm    | 71 ++++++++++++++++
 lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm |  7 ++
 lib/DBIx/ObjectMapper/Metadata/Table.pm       |  7 +-
 .../Metadata/Table/Column/Type/ByteA.pm       |  6 ++
 .../Metadata/Table/Column/TypeMap.pm          | 82 ++-----------------
 5 files changed, 95 insertions(+), 78 deletions(-)
 create mode 100644 lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
index 3b26aa3..7902e0b 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
@@ -229,4 +229,75 @@ sub release_savepoint {}
 
 sub rollback_savepoint {}
 
+sub _type_map_data {{
+    # String
+    'varchar'           => 'String',
+    'character varying' => 'String',
+    'char'              => 'String',
+    'character'         => 'String',
+
+    # Int
+    'int'       => 'Int',
+    'integer'   => 'Int',
+    'mediumint' => 'Int',
+
+    # SmallInt
+    'tinyint'  => 'SmallInt',
+    'smallint' => 'SmallInt',
+
+    # BigInt
+    'bigint' => 'BigInt',
+
+    # Boolean
+    'boolean' => 'Boolean',
+    'bool'    => 'Boolean',
+
+    # Text
+    'text' => 'Text',
+
+    # Date
+    'date' => 'Date',
+
+    # DateTime
+    'datetime'                    => 'Datetime',
+    'timestamp'                   => 'Datetime',
+    'timestamp without time zone' => 'Datetime',
+    'timestamp with time zone'    => 'Datetime',
+
+    # Time
+    'time'                   => 'Time',
+    'time without time zone' => 'Time',
+    'time with time zone'    => 'Time',
+
+    # Interval
+    'interval' => 'Interval',
+
+    # float
+    'float'            => 'Float',
+    'real'             => 'Float',
+    'double precision' => 'Float',
+    'double'           => 'Float',
+
+    # Numeric
+    'numeric'          => 'Numeric',
+    'decimal'          => 'Numeric',
+    'dec'              => 'Numeric',
+    'money'            => 'Numeric',
+
+    # Blob
+    'blob'     => 'Binary',
+    'bytea'    => 'Binary',
+    'longblob' => 'Binary',
+
+    # Bit
+    'bit'         => 'Bit',
+    'bit varying' => 'Bit',
+}}
+
+sub type_map {
+    my $class = shift;
+    my $type  = shift;
+    return $class->_type_map_data->{$type};
+}
+
 1;
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm
index e4eeaae..f4ada3a 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm
@@ -127,4 +127,11 @@ sub rollback_savepoint {
     $dbh->pg_rollback_to($name);
 }
 
+sub _type_map_data {
+    my $class = shift;
+    my $map = $class->SUPER::_type_map_data(@_);
+    $map->{bytea} = 'ByteA';
+    return $map;
+}
+
 1;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table.pm b/lib/DBIx/ObjectMapper/Metadata/Table.pm
index 427c8d9..773bf8e 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table.pm
@@ -378,9 +378,10 @@ sub autoload {
     $self->foreign_key($foreign_key);
 
     for my $conf ( @{$engine->get_column_info( $self->table_name )} ) {
-        my $type_class
-            = DBIx::ObjectMapper::Metadata::Table::Column::TypeMap->get(
-            $conf->{type} );
+        my $type_class = DBIx::ObjectMapper::Metadata::Table::Column::TypeMap->get(
+            $conf->{type},
+            $self->engine->driver,
+        );
         my $realtype = $conf->{type};
         $conf->{type} = $type_class->new();
         $conf->{type}->size($conf->{size});
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm
new file mode 100644
index 0000000..7229b11
--- /dev/null
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm
@@ -0,0 +1,6 @@
+package DBIx::ObjectMapper::Metadata::Table::Column::Type::ByteA;
+use strict;
+use warnings;
+use base qw(DBIx::ObjectMapper::Metadata::Table::Column::Type);
+
+1;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/TypeMap.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/TypeMap.pm
index 048424c..3fa05c3 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/TypeMap.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/TypeMap.pm
@@ -3,84 +3,16 @@ use strict;
 use warnings;
 use DBIx::ObjectMapper::Utils;
 
-our $map = {
-
-    # String
-    'varchar'           => 'String',
-    'character varying' => 'String',
-    'char'              => 'String',
-    'character'         => 'String',
-
-    # Int
-    'int'       => 'Int',
-    'integer'   => 'Int',
-    'mediumint' => 'Int',
-
-    # SmallInt
-    'tinyint'  => 'SmallInt',
-    'smallint' => 'SmallInt',
-
-    # BigInt
-    'bigint' => 'BigInt',
-
-    # Boolean
-    'boolean' => 'Boolean',
-    'bool'    => 'Boolean',
-
-    # Text
-    'text' => 'Text',
-
-    # Date
-    'date' => 'Date',
-
-    # DateTime
-    'datetime'                    => 'Datetime',
-    'timestamp'                   => 'Datetime',
-    'timestamp without time zone' => 'Datetime',
-    'timestamp with time zone'    => 'Datetime',
-
-    # Time
-    'time'                   => 'Time',
-    'time without time zone' => 'Time',
-    'time with time zone'    => 'Time',
-
-    # Interval
-    'interval' => 'Interval',
-
-    # float
-    'float'            => 'Float',
-    'real'             => 'Float',
-    'double precision' => 'Float',
-    'double'           => 'Float',
-
-    # Numeric
-    'numeric'          => 'Numeric',
-    'decimal'          => 'Numeric',
-    'dec'              => 'Numeric',
-    'money'            => 'Numeric',
-
-    # Blob
-    'blob'     => 'Binary',
-    'bytea'    => 'Binary',
-    'longblob' => 'Binary',
-
-    # Bit
-    'bit'         => 'Bit',
-    'bit varying' => 'Bit',
-};
-
-# Array
-our $is_array = qr/^.+\[\]$/;
-
 sub get {
-    my $class = shift;
-    my $type = shift;
-
-    my $prefix = 'DBIx::ObjectMapper::Metadata::Table::Column::Type::';
+    my $class    = shift;
+    my $type     = shift;
+    my $driver   = shift;
+    my $prefix   = 'DBIx::ObjectMapper::Metadata::Table::Column::Type::';
+    my $is_array = qr/^.+\[\]$/;
 
     my $type_class;
-    if( $map->{$type} ) {
-        $type_class = $prefix . $map->{$type};
+    if( $driver->type_map($type) ) {
+        $type_class = $prefix . $driver->type_map($type);
     }
     elsif( $type =~ /$is_array/ ) {
         $type_class = $prefix . 'Array';

From 047ec71e1b1659c61efd2f0d9751cd9a37b7b742 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 16:35:12 -0500
Subject: [PATCH 03/35] Many more values are now passed in execute() instead of
 as raw strings to prepare().

This helps with security concerns and sets the stage for Oracle blob support.
I ensured Postgres's blobs are bound correctly.
---
 lib/DBIx/ObjectMapper/Engine/DBI.pm           | 11 +++++--
 .../ObjectMapper/Engine/DBI/BoundParam.pm     | 23 +++++++++++++++
 lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm    |  2 ++
 lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm | 29 +++++++++++++++++++
 lib/DBIx/ObjectMapper/Engine/DBI/Iterator.pm  |  5 ++--
 .../Metadata/Table/Column/Base.pm             |  2 +-
 .../Metadata/Table/Column/Type/Binary.pm      | 14 ---------
 .../Metadata/Table/Column/Type/Blob.pm        | 17 +++++++++++
 .../Metadata/Table/Column/Type/ByteA.pm       | 11 +++++++
 9 files changed, 94 insertions(+), 20 deletions(-)
 create mode 100644 lib/DBIx/ObjectMapper/Engine/DBI/BoundParam.pm
 create mode 100644 lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Blob.pm

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI.pm b/lib/DBIx/ObjectMapper/Engine/DBI.pm
index 979bf3e..ea37ba3 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI.pm
@@ -466,7 +466,8 @@ sub select_single {
     else {
         #$result = $self->dbh->selectrow_arrayref($sql, +{}, @bind);
         my $sth = $self->_prepare($sql);
-        $sth->execute(@bind) || confess $sth->errstr;
+        my @raw_bind = $self->driver->bind_params($sth, @bind);
+        $sth->execute(@raw_bind) || confess $sth->errstr;
         $result = $sth->fetchrow_arrayref;
         $sth->finish;
         $self->{sql_cnt}++;
@@ -505,7 +506,9 @@ sub update {
 
     my ( $sql, @bind ) = $query->as_sql;
     $self->log_sql($sql, @bind);
-    my $ret = $self->dbh->do($sql, {}, @bind);
+    my $sth = $self->dbh->prepare($sql);
+    my @raw_bind = $self->driver->bind_params($sth, @bind);
+    my $ret = $sth->execute(@raw_bind);
     $self->{sql_cnt}++;
     return $ret;
 }
@@ -522,7 +525,9 @@ sub insert {
 
     my ( $sql, @bind ) = $query->as_sql;
     $self->log_sql($sql, @bind);
-    $self->dbh->do( $sql, {}, @bind );
+    my $sth = $self->dbh->prepare($sql);
+    my @raw_bind = $self->driver->bind_params($sth, @bind);
+    $sth->execute(@raw_bind);
     $self->{sql_cnt}++;
 
     my $ret_id = ref($query->values) eq 'HASH' ? $query->values : +{};
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/BoundParam.pm b/lib/DBIx/ObjectMapper/Engine/DBI/BoundParam.pm
new file mode 100644
index 0000000..7748c69
--- /dev/null
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/BoundParam.pm
@@ -0,0 +1,23 @@
+package DBIx::ObjectMapper::Engine::DBI::BoundParam;
+use strict;
+use warnings;
+use Carp::Clan qw/^DBIx::ObjectMapper/;
+use Params::Validate qw(:all);
+
+my $ATTRIBUTES = {
+    value  => { type => SCALAR },
+    type   => { type => SCALAR },
+    column => { type => SCALAR },
+};
+
+sub new {
+    my $class = shift;
+    my %attr = validate( @_, $ATTRIBUTES );
+    return bless \%attr, $class;
+}
+
+sub value  { $_[0]->{value}  }
+sub type   { $_[0]->{type}   }
+sub column { $_[0]->{column} }
+
+1;
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
index 7902e0b..4a3bd5e 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
@@ -229,6 +229,8 @@ sub release_savepoint {}
 
 sub rollback_savepoint {}
 
+sub bind_params { my ($self, $sth, @binds) = @_; @binds }
+
 sub _type_map_data {{
     # String
     'varchar'           => 'String',
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm
index f4ada3a..2fd6c4b 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Pg.pm
@@ -4,6 +4,8 @@ use warnings;
 use Carp::Clan qw/^DBIx::ObjectMapper/;
 use Try::Tiny;
 use base qw(DBIx::ObjectMapper::Engine::DBI::Driver);
+use Scalar::Util qw(blessed);
+use DBD::Pg qw(:pg_types);
 
 sub init {
     my $self = shift;
@@ -127,6 +129,33 @@ sub rollback_savepoint {
     $dbh->pg_rollback_to($name);
 }
 
+sub bind_params {
+    my ($self, $sth, @binds) = @_;
+    my $bind_position = 0;
+
+    return map {
+        my $bind = $_;
+        $bind_position++;
+
+        if (ref $bind && blessed($bind) && $bind->isa('DBIx::ObjectMapper::Engine::DBI::BoundParam')) {
+            if ($bind->type eq 'binary') {
+                $sth->bind_param(
+                    $bind_position,
+                    undef,
+                    { pg_type => DBD::Pg::PG_BYTEA }
+                );
+            }
+            else {
+                confess 'Unknown type for a bound param: ' . $bind->type;
+            }
+            $bind->value;
+        }
+        else {
+            $bind;
+        }
+    } @binds;
+}
+
 sub _type_map_data {
     my $class = shift;
     my $map = $class->SUPER::_type_map_data(@_);
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Iterator.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Iterator.pm
index 9d7d8b2..7447a9b 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Iterator.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Iterator.pm
@@ -37,9 +37,10 @@ sub sth {
     {
         my ( $sql, @bind ) = $self->query->as_sql;
         my $sth = $self->engine->_prepare($sql);
-        $sth->execute(@bind) or confess $sth->errstr;
+        my @raw_bind = $self->engine->driver->bind_params($sth, @bind);
+        $sth->execute(@raw_bind) or confess $sth->errstr;
         $self->engine->{sql_cnt}++;
-        $self->engine->log_sql($sql, @bind);
+        $self->engine->log_sql($sql, @raw_bind);
         my $size = $sth->rows;
 
 #        unless( $size ) {
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
index 2462103..3ab84ed 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
@@ -179,7 +179,7 @@ sub _to_storage {
     if( defined $val and my $to_storage = $self->{to_storage} ) {
         $val = $to_storage->($val);
     }
-    return $self->type->to_storage($val);
+    return $self->type->to_storage($val, $self->name);
 }
 
 sub to_storage_on_update {
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Binary.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Binary.pm
index 8577dd1..1c15c4d 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Binary.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Binary.pm
@@ -2,19 +2,5 @@ package DBIx::ObjectMapper::Metadata::Table::Column::Type::Binary;
 use strict;
 use warnings;
 use base qw(DBIx::ObjectMapper::Metadata::Table::Column::Type);
-use DBI qw(:sql_types);
-
-sub set_engine_option {
-    my ( $self, $engine ) = @_;
-    $self->{escape_func} = $engine->driver->escape_binary_func($engine->dbh);
-}
-
-sub escape_func { $_[0]->{escape_func} }
-
-sub to_storage {
-    my ( $self, $val ) = @_;
-    return $val unless defined $val;
-    return $self->escape_func->($val);
-}
 
 1;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Blob.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Blob.pm
new file mode 100644
index 0000000..7266e23
--- /dev/null
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/Blob.pm
@@ -0,0 +1,17 @@
+package DBIx::ObjectMapper::Metadata::Table::Column::Type::Blob;
+use strict;
+use warnings;
+use base qw(DBIx::ObjectMapper::Metadata::Table::Column::Type);
+use DBIx::ObjectMapper::Engine::DBI::BoundParam;
+
+sub to_storage {
+    my ( $self, $val, $column_name ) = @_;
+    return $val unless defined $val;
+    DBIx::ObjectMapper::Engine::DBI::BoundParam->new(
+        value  => $val,
+        type   => 'binary',
+        column => $column_name,
+    );
+}
+
+1;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm
index 7229b11..de132de 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Type/ByteA.pm
@@ -2,5 +2,16 @@ package DBIx::ObjectMapper::Metadata::Table::Column::Type::ByteA;
 use strict;
 use warnings;
 use base qw(DBIx::ObjectMapper::Metadata::Table::Column::Type);
+use DBIx::ObjectMapper::Engine::DBI::BoundParam;
+
+sub to_storage {
+    my ( $self, $val, $column_name ) = @_;
+    return $val unless defined $val;
+    DBIx::ObjectMapper::Engine::DBI::BoundParam->new(
+        value  => $val,
+        type   => 'binary',
+        column => $column_name,
+    );
+}
 
 1;

From 77adef1ba608c7b33980acaf3cae79152cdd8725 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 16:39:54 -0500
Subject: [PATCH 04/35] First serious pass at Oracle support: Oracle supports
 rownum, not limit.

This requires changes to how "where" SQL is generated.  We still support the
limit interface in the abstract API, but in Oracle's case, the raw SQL
generation will translate to the correct sections.

Oracle tests are coming in the next commit.
---
 lib/DBIx/ObjectMapper/SQL/Base.pm   | 26 +++++++++++++++++++++++++-
 lib/DBIx/ObjectMapper/SQL/Select.pm |  6 +++---
 2 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index 3449c5b..59c18af 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -72,12 +72,16 @@ sub _add_accessor {
 }
 
 sub _as_sql_accessor {
-    my ( $self, $field, $func ) = @_;
+    my ( $self, $field, $func, $is_oracle ) = @_;
     my @param
         = ref $self->{$field} eq 'ARRAY'
         ? @{ $self->{$field} }
         : ( $self->{$field} );
 
+    if ($is_oracle && $func eq 'build_where') {
+        return $self->build_where(@param, $self->oracle_limit);
+    }
+
     return $self->$func(@param);
 }
 
@@ -232,6 +236,26 @@ sub convert_join_to_sql {
     return ( $stm, @bind );
 }
 
+sub oracle_limit {
+    my $self = shift;
+    return () if ($self->{driver} ne 'Oracle');
+
+    my $limit = $self->limit_as_sql;
+    my $offset = $self->offset_as_sql || 0;
+
+    my @conditions = ();
+
+    if ($offset) {
+        push @conditions, ['ROWNUM', '>', $offset];
+    }
+
+    if ($limit) {
+        push @conditions, ['ROWNUM', '<=', $limit + $offset];
+    }
+
+    return @conditions;
+}
+
 sub build_where {
     my ( $class, @where ) = @_;
     return $class->convert_conditions_to_sql('and', @where);
diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index 13b7c0d..bb6f4fc 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -13,7 +13,7 @@ __PACKAGE__->initdata({
     limit    => 0,
     offset   => 0,
     having   => [],
-    driver   => undef, # Pg, mysql, SQLite ...
+    driver   => '', # Pg, mysql, SQLite ...
 });
 
 __PACKAGE__->accessors({
@@ -37,7 +37,7 @@ sub as_sql {
     $stm .= ' ' . $join_stm if $join_stm;
     push @bind, @join_bind if @join_bind;
 
-    my ($where_stm, @where_bind) = $self->where_as_sql;
+    my ($where_stm, @where_bind) = $self->where_as_sql($self->{driver} eq 'Oracle');
     $stm .= ' WHERE ' . $where_stm if $where_stm;
     push @bind, @where_bind if @where_bind;
 
@@ -53,7 +53,7 @@ sub as_sql {
         $stm .= ' ORDER BY ' . $order_by;
     }
 
-    if( $self->limit || $self->offset ) {
+    if( ($self->limit || $self->offset) && ($self->{driver} ne 'Oracle') ) {
         my $method = $self->limit_syntax->{ lc( $self->{driver} ) };
         $method = $self->limit_syntax->{default}
             unless $method and $self->can($method);

From 6f24d4d128af74d920ee92415d646e10bd4434ae Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 16:42:34 -0500
Subject: [PATCH 05/35] Added Oracle support.

I copied tests from Pg and reduced them as necessary.  I am not testing all
possible types at this time, and they should eventually be added, both to the
tests and to the type/storage system.
---
 .../ObjectMapper/Engine/DBI/Driver/Oracle.pm  | 187 ++++++++++++++++++
 t/20_misc/100_oracle.t                        | 181 +++++++++++++++++
 2 files changed, 368 insertions(+)
 create mode 100644 lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
 create mode 100644 t/20_misc/100_oracle.t

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
new file mode 100644
index 0000000..f50a351
--- /dev/null
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
@@ -0,0 +1,187 @@
+package DBIx::ObjectMapper::Engine::DBI::Driver::Oracle;
+use strict;
+use warnings;
+use Try::Tiny;
+use Carp::Clan qw/^DBIx::ObjectMapper/;
+use base qw(DBIx::ObjectMapper::Engine::DBI::Driver);
+use DBIx::ObjectMapper::Engine::DBI::BoundParam;
+use DBD::Oracle qw(:ora_types);
+use Scalar::Util qw(blessed);
+
+sub init {
+    my $self = shift;
+    my $dbh  = shift;
+
+    try {
+        require DateTime::Format::Oracle;
+        DateTime::Format::Oracle->import;
+        $self->{datetime_parser} ||= 'DateTime::Format::Oracle';
+    } catch {
+        confess "Couldn't load DateTime::Format::Oracle: $_";
+    };
+
+    $self->{db_schema} ||= do {
+        my $system_context_row_ref = $dbh->selectall_arrayref("select sys_context( 'userenv', 'current_schema' ) from dual");
+        $system_context_row_ref->[0][0];
+    };
+
+    $self->{_cache}->{_oracle} = {
+        primary_keys => {},
+        foreign_keys => {},
+        unique_info  => {},
+    };
+    $self->{namesep} = q{.};
+    $self->{quote}   = q{'};
+}
+
+sub last_insert_id {}
+
+sub get_primary_key {
+    my ($self, $dbh, $table) = @_;
+    if (!$self->{_cache}->{_oracle}->{primary_keys}->{$table}) {
+         $self->{_cache}->{_oracle}->{primary_keys}->{$table} =
+            +[keys %{$dbh->primary_key_info('', $self->db_schema, $table)->fetchall_hashref('COLUMN_NAME')}];
+    }
+    return @{$self->{_cache}->{_oracle}->{primary_keys}->{$table}};
+}
+
+sub get_table_uniq_info {
+    my ($self, $dbh, $table) = @_;
+    if (!$self->{_cache}->{_oracle}->{unique_info}->{$table}) {
+        my $sth = $dbh->prepare(q{
+            select ai.index_name, aic.column_name
+            from all_indexes ai
+            join all_ind_columns aic
+            on aic.index_name = ai.index_name
+            and aic.index_owner = ai.owner
+            where ai.uniqueness = 'UNIQUE'
+            and aic.table_name = ?
+            and aic.index_owner = ?
+        });
+        $sth->execute($table, $self->db_schema);
+
+        my $unique_rows = $sth->fetchall_arrayref();
+        my %unique_constraints = map {
+            $_->[0] => []
+        } @$unique_rows;
+        for my $row (@$unique_rows) {
+            push @{$unique_constraints{$row->[0]}}, $row->[1];
+        }
+
+        $self->{_cache}->{_oracle}->{unique_info}->{$table} = [
+            map {
+                [$_ => $unique_constraints{$_}]
+            } keys %unique_constraints
+        ];
+    }
+
+    return $self->{_cache}->{_oracle}->{unique_info}->{$table};
+}
+
+sub get_table_fk_info {
+    my ($self, $dbh, $table) = @_;
+
+    if (!$self->{_cache}->{_oracle}->{foreign_keys}->{$table}) {
+        my $sth = $dbh->foreign_key_info(undef, undef, undef, '', $self->db_schema, $table);
+        my %constraints = ();
+
+        while (my $row = $sth->fetchrow_hashref) {
+            my $constraint_name = $row->{FK_NAME};
+            if (!$constraints{$constraint_name}) {
+                $constraints{$constraint_name} = {
+                    keys  => [],
+                    refs  => [],
+                    table => $row->{UK_TABLE_NAME},
+                };
+            }
+
+            my $constraint_info = $constraints{$constraint_name};
+            push @{$constraint_info->{keys}}, $row->{FK_COLUMN_NAME};
+            push @{$constraint_info->{refs}}, $row->{UK_COLUMN_NAME};
+        }
+
+        $self->{_cache}->{_oracle}->{foreign_keys}->{$table} = [values %constraints];
+    }
+
+    return $self->{_cache}->{_oracle}->{foreign_keys}->{$table};
+}
+
+sub get_tables {
+    my ( $self, $dbh ) = @_;
+    return $self->_truncate_quote_and_sep(
+        sort {$a cmp $b}
+        map {$_ =~ s/"//g; $_}
+        (
+            $dbh->tables(undef, $self->db_schema, undef, 'TABLE'),
+            $dbh->tables(undef, $self->db_schema, undef, 'VIEW')
+        )
+    );
+}
+
+sub set_time_zone_query {
+    my ( $self, $dbh ) = @_;
+    my $tz = $self->time_zone || return;
+    return "ALTER SESSION SET time_zone = " . $dbh->quote($tz);
+}
+
+sub set_savepoint {
+    my ($self, $dbh, $name) = @_;
+    my $quoted_name = $dbh->quote($name);
+    $dbh->do("SAVEPOINT $quoted_name");
+}
+
+sub release_savepoint {}
+
+sub rollback_savepoint {
+    my ($self, $dbh, $name) = @_;
+    my $quoted_name = $dbh->quote($name);
+    $dbh->do("ROLLBACK TO $quoted_name");
+}
+
+sub bind_params {
+    my ($self, $sth, @binds) = @_;
+    my $bind_position = 0;
+
+    return map {
+        my $bind = $_;
+        $bind_position++;
+
+        if (ref $bind && blessed($bind) && $bind->isa('DBIx::ObjectMapper::Engine::DBI::BoundParam')) {
+            if ($bind->type eq 'binary') {
+                $sth->bind_param(
+                    $bind_position,
+                    undef,
+                    {
+                        ora_type  => SQLT_BIN,
+                        ora_field => $bind->column
+                    }
+                );
+            }
+            else {
+                confess 'Unknown type for a bound param: ' . $bind->type;
+            }
+            $bind->value;
+        }
+        else {
+            $bind;
+        }
+    } @binds;
+}
+
+sub _type_map_data {
+    my $class = shift;
+    my $map = $class->SUPER::_type_map_data(@_);
+    $map->{number} = 'Numeric';
+    $map->{blob}   = 'Blob';
+    $map->{long}   = 'Binary';
+    return $map;
+}
+
+sub type_map {
+    my $class = shift;
+    my $type  = shift;
+    $type =~ s/\(.*$//;
+    return $class->_type_map_data->{$type};
+}
+
+1;
diff --git a/t/20_misc/100_oracle.t b/t/20_misc/100_oracle.t
new file mode 100644
index 0000000..083f956
--- /dev/null
+++ b/t/20_misc/100_oracle.t
@@ -0,0 +1,181 @@
+use strict;
+use warnings;
+use Test::More;
+use DateTime;
+use DateTime::Duration;
+use DateTime::Format::Oracle;
+use DBIx::ObjectMapper::Engine::DBI;
+use DBIx::ObjectMapper;
+
+my ($dsn, $user, $pass, $schema) = @ENV{map { "MAPPER_TEST_ORACLE_${_}" } qw/DSN USER PASS SCHEMA/};
+plan skip_all => 'Set $ENV{MAPPER_TEST_ORACLE_DSN}, _USER, _PASS, and _SCHEMA to run this test.' unless ($dsn && $user);
+
+my $engine = DBIx::ObjectMapper::Engine::DBI->new({
+    dsn           => $dsn,
+    username      => $user,
+    password      => $pass,
+    db_schema     => $schema,
+    on_connect_do => [
+
+        # Ensure date format for DATE fields is consistent before we start inserting rows
+        "alter session set nls_date_format = '" .
+        DateTime::Format::Oracle->nls_date_format .
+        "'",
+
+        # ...and the timestamp format for TIMESTAMP fields
+        "alter session set nls_timestamp_format = '" .
+        DateTime::Format::Oracle->nls_date_format .
+        "'",
+
+        # Create test table
+        q{
+CREATE TABLE test_types (
+  id INTEGER PRIMARY KEY,
+  i    INT,
+  num  NUMERIC(10,2),
+  f    NUMBER(5,4),
+  deci DECIMAL(10,2),
+  photo BLOB,
+  lblob LONG,
+  created TIMESTAMP(0) DEFAULT SYSDATE,
+  modified TIMESTAMP,
+  dt DATE
+)
+
+}
+    ],
+    on_disconnect_do => q{DROP TABLE test_types},
+    time_zone => 'Asia/Tokyo',
+});
+
+my $mapper = DBIx::ObjectMapper->new( engine => $engine );
+$mapper->metadata->autoload_all_tables;
+my $table = $mapper->metadata->t( 'TEST_TYPES' );
+my $GIF = 'R0lGODlhAQABAJEAAAAAAP///////wAAACH5BAUUAAIALAAAAAABAAEAAAICVAEAOw==
+';
+my $now = DateTime->now( time_zone => 'UTC' );
+
+
+is $table->c('ID')->type->type, 'numeric';
+is $table->c('I')->type->type, 'numeric';
+is $table->c('NUM')->type->type, 'numeric';
+is $table->c('F')->type->type, 'numeric';
+is $table->c('DECI')->type->type, 'numeric';
+is $table->c('PHOTO')->type->type, 'blob';
+is $table->c('LBLOB')->type->type, 'binary';
+is $table->c('CREATED')->type->type, 'datetime';
+is $table->c('MODIFIED')->type->type, 'datetime';
+is $table->c('DT')->type->type, 'date';
+
+
+{
+    my $r = $table->insert(
+        ID   => 1,
+        I    => 2,
+        NUM  => 0.202927272,
+        F    => 0.202927272,
+        DECI => 20,
+        PHOTO => $GIF,
+        LBLOB => $GIF,
+        DT => $now,
+    )->execute;
+
+    # check last_insert_id
+    is $r->{ID}, 1;
+};
+
+
+{ # find
+    ok my $d = $table->find(1);
+
+    is $d->{PHOTO}, $GIF;
+    is $d->{LBLOB}, $GIF;
+
+    is ref($d->{CREATED}), 'DateTime';
+    is $d->{CREATED}->time_zone->name, 'Asia/Tokyo';
+    ok !$d->{CREATED}->time_zone->is_utc;
+    is $d->{CREATED}->time_zone->offset_for_datetime($now), 9*60*60;
+
+    ok !$d->{MODIFIEd};
+    is $d->{DT}->ymd('-'), $now->ymd('-');
+
+    ok $d->{I} == 2;
+
+    ok $d->{NUM} == 0.20;
+    ok $d->{F} == 0.2029;
+    ok $d->{DECI} == 20.00;
+
+};
+
+{ # search by date
+    ok my $d = $table->select->where(
+        $table->c('DT') == $now,
+    )->first;
+    is $d->{ID}, 1;
+};
+
+{ # update
+    ok $table->update->set( MODIFIED => $now )->where( $table->c('ID') == 1 )->execute;
+    my $d = $table->find(1);
+    is $d->{MODIFIED}, $now;
+};
+
+{ # limit, offset
+    ok my $r = $table->select->limit(1)->offset(0)->execute;
+    is $r->first->{ID}, 1;
+};
+
+$mapper->maps(
+    $table => 'My::MyOracleTest',
+    accessors => { auto => 1 },
+    constructor => { auto => 1 },
+);
+
+{ # transaction rollback
+    my $session = $mapper->begin_session( autocommit => 0 );
+    $session->add( My::MyOracleTest->new( ID => 4, I => 10 ) );
+    $session->rollback;
+};
+
+{ # check
+    my $session = $mapper->begin_session( autocommit => 0 );
+    my $attr = $mapper->attribute('My::MyOracleTest');
+    is $session->search('My::MyOracleTest')->filter( $attr->p('I') == 10 )->count, 0;
+};
+
+{ # transaction commit
+    my $session = $mapper->begin_session( autocommit => 0 );
+    $session->add( My::MyOracleTest->new( ID => 5, I => 10 ) );
+    $session->commit;
+};
+
+{ # check
+    my $session = $mapper->begin_session( autocommit => 0 );
+    my $attr = $mapper->attribute('My::MyOracleTest');
+    is $session->search('My::MyOracleTest')->filter( $attr->p('I') == 10 )->count, 1;
+};
+
+
+{ # savepoint
+    my $session = $mapper->begin_session( autocommit => 0 );
+    $session->add( My::MyOracleTest->new( ID => 6, I => 11 ) );
+    eval {
+        $session->txn(
+            sub {
+                $session->add( My::MyOracleTest->new( ID => 1, I => 11 ) );
+                $session->commit;
+            }
+        );
+    };
+    ok $@;
+    $session->add( My::MyOracleTest->new( ID => 7, I => 11 ) );
+    $session->commit;
+};
+
+{
+    my $session = $mapper->begin_session( autocommit => 0 );
+    my $attr = $mapper->attribute('My::MyOracleTest');
+    is $session->search('My::MyOracleTest')->filter( $attr->p('I') == 11 )->count, 2;
+};
+
+done_testing;

From 72cd674693ad97d5cb32724ae44e9342ebae7f3f Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 15:47:27 -0500
Subject: [PATCH 06/35] Added support for connect identifiers.

Example for Oracle: MYSCHEMA.USER@DB2
Format: ${db_schema}.${table_name}@${connect_identifier}
---
 lib/DBIx/ObjectMapper/Engine/DBI.pm        | 19 +++++++++++--------
 lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm |  1 +
 lib/DBIx/ObjectMapper/Metadata/Table.pm    |  4 ++++
 3 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI.pm b/lib/DBIx/ObjectMapper/Engine/DBI.pm
index ea37ba3..e6e925e 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI.pm
@@ -47,7 +47,7 @@ sub _init {
         = ref $disconnect_do eq 'ARRAY' ? $disconnect_do : [$disconnect_do];
 
     for my $name ( qw(db_schema namesep quote datetime_parser iterator
-                      time_zone disable_prepare_caching cache) ) {
+                      time_zone disable_prepare_caching cache connect_identifier) ) {
         $self->{$name} = delete $option->{$name} || undef;
     }
 
@@ -175,13 +175,14 @@ sub _connect {
     $self->{driver} = DBIx::ObjectMapper::Engine::DBI::Driver->new(
         $driver_type,
         $dbh,
-        db_schema       => $self->{db_schema}       || undef,
-        namesep         => $self->{namesep}         || undef,
-        quote           => $self->{quote}           || undef,
-        query           => $self->query,
-        log             => $self->log,
-        datetime_parser => $self->{datetime_parser} || undef,
-        time_zone       => $self->{time_zone},
+        db_schema          => $self->{db_schema}          || undef,
+        connect_identifier => $self->{connect_identifier} || undef,
+        namesep            => $self->{namesep}            || undef,
+        quote              => $self->{quote}              || undef,
+        query              => $self->query,
+        log                => $self->log,
+        datetime_parser    => $self->{datetime_parser}    || undef,
+        time_zone          => $self->{time_zone},
     );
 
     if ( $self->{time_zone}
@@ -676,6 +677,7 @@ DBIx::ObjectMapper::Engine::DBI - the DBI engine
      on_connect_do => [],
      on_disconnect_do => [],
      db_schema => 'public',
+     connect_identifier => undef,
      namesep => '.',
      quote => '"',
      iterator => '',
@@ -697,6 +699,7 @@ DBIx::ObjectMapper::Engine::DBI - the DBI engine
         on_connect_do => [],
         on_disconnect_do => [],
         db_schema => 'public',
+        connect_identifier => undef,
         namesep => '.',
         quote => '"',
         iterator => '',
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
index 4a3bd5e..56dc052 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver.pm
@@ -36,6 +36,7 @@ sub log       { $_[0]->{log} }
 sub namesep   { $_[0]->{namesep} }
 sub quote     { $_[0]->{quote} }
 sub time_zone { $_[0]->{time_zone} }
+sub connect_identifier { $_[0]->{connect_identifier} }
 
 sub init { }
 
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table.pm b/lib/DBIx/ObjectMapper/Metadata/Table.pm
index 773bf8e..cfa4a8b 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table.pm
@@ -6,6 +6,10 @@ use overload
     '""' => sub {
         my $self = shift;
         my $table_name = $self->table_name;
+        my ($connect_identifier) = map {$_->driver->connect_identifier} grep {$_} $self->engine;
+        if ($connect_identifier) {
+            $table_name .= '@' . $connect_identifier;
+        }
         $table_name .= ' AS ' . $self->alias_name if $self->is_clone;
         return $table_name;
     },

From 46bfee7a2db4299cf7047574a49bbe9f0861d143 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 18 May 2011 14:55:36 -0500
Subject: [PATCH 07/35] String comparisons are slow.  This new caching greatly
 improved map loop speed.

In my environment, this dropped us from around 4 minutes for all() 140K rows
in session queries to closer to 3 minutes.  The same query took about 12
seconds when constructed directly from the lower level metadata API.

I saw room for more improvements like this with regard to functions performed
in the critical loop (the map { callback } @$results in the iterator).  This
is a critical loop.  On the other hand, if someone is fetching 140K rows as
mapped objects, they might be approaching the task incorrectly.

Another thought is to extend the API a little:

  $query->execute->all_arrayref  # make all() thin by calling this and then map
  $query->execute->all_hashref   # derive column names, make hashes, no bless

Experiments revealed that this kind of to-the-metal query only takes 3 seconds.
---
 lib/DBIx/ObjectMapper/Mapper/Attribute/Property.pm | 11 +++++++----
 lib/DBIx/ObjectMapper/Mapper/Instance.pm           |  6 +++---
 2 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Mapper/Attribute/Property.pm b/lib/DBIx/ObjectMapper/Mapper/Attribute/Property.pm
index 9c4fe9f..181ddcd 100644
--- a/lib/DBIx/ObjectMapper/Mapper/Attribute/Property.pm
+++ b/lib/DBIx/ObjectMapper/Mapper/Attribute/Property.pm
@@ -27,12 +27,15 @@ sub new {
         }
     );
 
-    bless \%prop, $class;
+    my $self = bless \%prop, $class;
+    $self->{is_column} = $self->type eq 'column';
+    return $self;
 }
 
-sub lazy   { $_[0]->{lazy} }
-sub getter { $_[0]->{getter} }
-sub setter { $_[0]->{setter} }
+sub lazy      {$_[0]->{lazy}}
+sub getter    {$_[0]->{getter}}
+sub setter    {$_[0]->{setter}}
+sub is_column {$_[0]->{is_column}}
 
 ## proxy
 
diff --git a/lib/DBIx/ObjectMapper/Mapper/Instance.pm b/lib/DBIx/ObjectMapper/Mapper/Instance.pm
index 0045587..c1df979 100644
--- a/lib/DBIx/ObjectMapper/Mapper/Instance.pm
+++ b/lib/DBIx/ObjectMapper/Mapper/Instance.pm
@@ -222,7 +222,7 @@ sub reducing {
     my %primary_key = map { $_ => 1 } @{$class_mapper->table->primary_key};
     for my $prop_name ( $class_mapper->attributes->property_names ) {
         my $prop = $class_mapper->attributes->property_info($prop_name);
-        next unless $prop->type eq 'column';
+        next unless $prop->is_column;
         my $col_name = $prop->name;
         my $val = $self->get_val($prop_name);
         next if $primary_key{$col_name} and !defined $val;
@@ -286,7 +286,7 @@ sub _modify {
         my $col = $prop->name
             || $prop_name;
         if( exists $rdata->{$col} ) {
-            if( defined $rdata->{$col} and $prop->type eq 'column' ) {
+            if( defined $rdata->{$col} and $prop->is_column ) {
                 $rdata->{$col} = $prop->{isa}->from_storage( $rdata->{$col} );
             }
             $self->set_val($prop_name => $rdata->{$col});
@@ -451,7 +451,7 @@ sub is_modified   {
         my $prop = $class_mapper->attributes->property_info($prop_name);
         my $col = $prop->name || $prop_name;
         my $val = $self->get_val($prop_name);
-        next unless $prop->type eq 'column' and ref $val;
+        next unless $prop->is_column and ref $val;
         if( $self->unit_of_work->change_checker->is_changed( $val ) ) {
             $modified_data->{$prop_name} = $val;
             $is_modified = 1;

From f47b3347cb2b22d973e614dc2ea5da9bef43b122 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Mon, 23 May 2011 11:14:35 -0500
Subject: [PATCH 08/35] Oracle supports VARCHAR2.

---
 lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
index f50a351..c41f842 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
@@ -171,9 +171,10 @@ sub bind_params {
 sub _type_map_data {
     my $class = shift;
     my $map = $class->SUPER::_type_map_data(@_);
-    $map->{number} = 'Numeric';
-    $map->{blob}   = 'Blob';
-    $map->{long}   = 'Binary';
+    $map->{number}   = 'Numeric';
+    $map->{blob}     = 'Blob';
+    $map->{long}     = 'Binary';
+    $map->{varchar2} = 'Text';
     return $map;
 }
 

From 07824f4cd40dd6e36371cbec052af664081428c2 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Mon, 23 May 2011 16:22:48 -0500
Subject: [PATCH 09/35] Added a few functions that are useful for schema
 dumping and loading.

Example load code:

  $mapper->metadata->table($table_name => {
       driver => $mapper->engine->driver,
       column_info => [
           {
               'name'        => 'FOO_ID',
               'default'     => undef,
               'type'        => 'number',
               'is_nullable' => 0,
               'size'        => '15'
           },
           {
               'name'        => 'BAR_ID',
               'default'     => undef,
               'type'        => 'number',
               'is_nullable' => 0,
               'size'        => '15'
           },
           {
               'name'        => 'BAZ_ID',
               'default'     => undef,
               'type'        => 'number',
               'is_nullable' => 0,
               'size'        => '10'
           }
       ],
       primary_key => ['BAR_ID', 'BAZ_ID', 'FOO_ID'],
       foreign_key => [
           {
               'keys'  => ['BAR_ID'],
               'refs'  => ['BAR_ID'],
               'table' => 'BAR'
           },
           {
               'keys'  => ['FOO_ID'],
               'refs'  => ['FOO_ID'],
               'table' => 'FOO'
           },
           {
               'keys'  => ['BAZ_ID'],
               'refs'  => ['BAZ_ID'],
               'table' => 'BAZ'
           }
       ],
       unique_key => [['BAZR_I' => ['BAR_ID', 'BAZ_ID', 'FOO_ID']]],
  });
---
 lib/DBIx/ObjectMapper/Metadata.pm       |  5 ++
 lib/DBIx/ObjectMapper/Metadata/Table.pm | 91 ++++++++++++++++++-------
 2 files changed, 72 insertions(+), 24 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Metadata.pm b/lib/DBIx/ObjectMapper/Metadata.pm
index e25dbf3..db1353a 100644
--- a/lib/DBIx/ObjectMapper/Metadata.pm
+++ b/lib/DBIx/ObjectMapper/Metadata.pm
@@ -54,6 +54,11 @@ sub table {
 
 *t = \&table;
 
+sub all_known_tables {
+    my $self = shift;
+    return values %{$self->{tables}};
+}
+
 sub autoload_all_tables {
     my $self   = shift;
     my $engine = $self->engine;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table.pm b/lib/DBIx/ObjectMapper/Metadata/Table.pm
index cfa4a8b..811d745 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table.pm
@@ -35,7 +35,7 @@ sub new {
     my ( $table_name, $column, $param ) = validate_pos(
         @_,
         { type => SCALAR|ARRAYREF },
-        { type => ARRAYREF|SCALAR },
+        { type => ARRAYREF|HASHREF|SCALAR },
         { type => HASHREF, optional => 1 },
     );
 
@@ -83,6 +83,14 @@ sub new {
         $self->autoload();
         $column = [];
     }
+    elsif ($column and ref($column) and ref($column) eq 'HASH') {
+        $self->{autoload} = 1;
+        $self->autoload_data(
+            $self->engine ? (driver => $self->engine->driver) : (),
+            %$column
+        );
+        $column = [];
+    }
 
     $self->column( $column );
 
@@ -358,6 +366,57 @@ sub validation {
     $class->__hash_accessor('validation', @_);
 }
 
+sub autoloaded_data {
+    sub column_to_autoload_data {
+        my $column = shift;
+        return {
+            name        => $column->name,
+            type        => $column->type->realtype,
+            size        => $column->type->size,
+            is_nullable => $column->is_nullable,
+            default     => $column->server_default,
+        };
+    }
+
+    my $self = shift;
+    return {
+        primary_key => $self->primary_key,
+        unique_key  => $self->unique_key,
+        foreign_key => $self->foreign_key,
+        column_info => [ map {column_to_autoload_data($_)} @{$self->columns} ],
+    };
+}
+
+sub autoload_data {
+    my $self = shift;
+    my %data = @_;
+
+    my $primary_key = $data{primary_key} || [];
+    my $unique_key  = $data{unique_key}  || [];
+    my $foreign_key = $data{foreign_key} || [];
+    my $column_info = $data{column_info} || [];
+    my $driver      = $data{driver};
+
+    confess "autoload_data needs driver." unless $driver;
+
+    $self->{column_map} ||= +{};
+    $self->primary_key($primary_key);
+    $self->unique_key($unique_key);
+    $self->foreign_key($foreign_key);
+
+    for my $conf ( @$column_info ) {
+        my $translated_conf = {%$conf};
+        my $type_class = DBIx::ObjectMapper::Metadata::Table::Column::TypeMap->get(
+            $translated_conf->{type},
+            $driver,
+        );
+        $translated_conf->{type} = $type_class->new();
+        $translated_conf->{type}->size($conf->{size});
+        $translated_conf->{type}->realtype($conf->{type});
+        $translated_conf->{server_default} = delete $translated_conf->{default};
+        $self->column( $translated_conf );
+    }
+}
 
 
 =head2 autoload
@@ -369,30 +428,14 @@ sub autoload {
 
     confess "autoload needs engine."    unless $self->engine;
     confess "autoload needs table_name" unless $self->table_name;
-    my $engine = $self->engine;
-    $self->{column_map} ||= +{};
-
-    my @primary_key = $self->engine->get_primary_key( $self->table_name );
-    $self->primary_key(\@primary_key);
 
-    my $uniq_key = $self->engine->get_unique_key( $self->table_name );
-    $self->unique_key($uniq_key);
-
-    my $foreign_key = $self->engine->get_foreign_key( $self->table_name );
-    $self->foreign_key($foreign_key);
-
-    for my $conf ( @{$engine->get_column_info( $self->table_name )} ) {
-        my $type_class = DBIx::ObjectMapper::Metadata::Table::Column::TypeMap->get(
-            $conf->{type},
-            $self->engine->driver,
-        );
-        my $realtype = $conf->{type};
-        $conf->{type} = $type_class->new();
-        $conf->{type}->size($conf->{size});
-        $conf->{type}->realtype($realtype);
-        $conf->{server_default} = delete $conf->{default};
-        $self->column( $conf );
-    }
+    $self->autoload_data(
+        primary_key => [$self->engine->get_primary_key( $self->table_name )],
+        unique_key  => $self->engine->get_unique_key( $self->table_name ),
+        foreign_key => $self->engine->get_foreign_key( $self->table_name ),
+        column_info => $self->engine->get_column_info( $self->table_name ),
+        driver      => $self->engine->driver,
+    );
 }
 
 sub column {

From 79b603c10c597cbb2c95c00e9bbcf42e0058a4fb Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Tue, 24 May 2011 14:25:10 -0500
Subject: [PATCH 10/35] Implemented Oracle support for table aliasing.

---
 lib/DBIx/ObjectMapper/Metadata/Table.pm | 9 ++++++++-
 lib/DBIx/ObjectMapper/SQL/Base.pm       | 7 +++++--
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Metadata/Table.pm b/lib/DBIx/ObjectMapper/Metadata/Table.pm
index 811d745..780d54f 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table.pm
@@ -6,11 +6,18 @@ use overload
     '""' => sub {
         my $self = shift;
         my $table_name = $self->table_name;
+
         my ($connect_identifier) = map {$_->driver->connect_identifier} grep {$_} $self->engine;
         if ($connect_identifier) {
             $table_name .= '@' . $connect_identifier;
         }
-        $table_name .= ' AS ' . $self->alias_name if $self->is_clone;
+
+        my $as_to_sql = ' AS ';
+        if ($self->engine && $self->engine->driver_type eq 'Oracle') {
+            $as_to_sql = ' ';
+        }
+
+        $table_name .= $as_to_sql . $self->alias_name if $self->is_clone;
         return $table_name;
     },
     fallback => 1
diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index 59c18af..03e044e 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -147,6 +147,8 @@ sub convert_func_to_sql {
       . ')';
 }
 
+sub as_to_sql { $_[0]->{driver} eq 'Oracle' ? ' ' : ' AS ' }
+
 sub convert_column_alias_to_sql {
     my ($class, $param) = @_;
     return $param unless $param;
@@ -156,8 +158,9 @@ sub convert_column_alias_to_sql {
 
     my $col = $class->convert_func_to_sql( $param->[0] );
     my $alias = $param->[1];
+    my $as = $class->as_to_sql;
     if( $col and $alias ) {
-        return $col . ' AS ' . $alias;
+        return "$col$as$alias";
     }
     else {
         return $col;
@@ -184,7 +187,7 @@ sub convert_table_to_sql {
     my ($stm, @bind);
     if( ref $table eq 'ARRAY' ) {
         my ($t_stm, @t_bind) = $class->convert_table_to_sql( $table->[0] );
-        $stm = $t_stm . ' AS ' . $table->[1];
+        $stm = $t_stm . $class->as_to_sql . $table->[1];
 
         push @bind, @t_bind if @t_bind;
     }

From 626e50658fd8703fbed39330946cdb10c0e1336b Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 25 May 2011 10:56:02 -0500
Subject: [PATCH 11/35] Fixed bug in multiple tables in the from clause.

The bug was passing @_ to convert_table instead of $t.
---
 lib/DBIx/ObjectMapper/SQL/Base.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index 03e044e..76800ff 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -173,7 +173,7 @@ sub convert_tables_to_sql {
     my @bind;
 
     for my $t ( @_ ) {
-        my ($table_stm, @table_bind) = $class->convert_table_to_sql(@_);
+        my ($table_stm, @table_bind) = $class->convert_table_to_sql($t);
         push @stm, $table_stm;
         push @bind, @table_bind if @table_bind;
     }

From 6dec7a23b6ba9d63b1b36dc15ac8d5cdd61f1eda Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 25 May 2011 13:09:37 -0500
Subject: [PATCH 12/35] Added more information about the original table per
 column.

Although I may alias my tables, I still want to know the original table of
each of the columns.  This is useful for relation-based typing, wherein I need
to get the header ($query->builder->column) to further interpret the results.

Side note: It is inconsistent that a different storage strategy is used for
column aliases vs table aliases.
---
 lib/DBIx/ObjectMapper/Metadata/Table.pm         |  4 ++--
 .../ObjectMapper/Metadata/Table/Column/Base.pm  | 17 +++++++++++++++--
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Metadata/Table.pm b/lib/DBIx/ObjectMapper/Metadata/Table.pm
index 780d54f..d7e1f4c 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table.pm
@@ -579,7 +579,7 @@ sub _set_column {
 
     my $column_obj = $self->column_metaclass->new(
         name           => $name,
-        table          => $self->table_name,
+        table          => $self->{table_name},
         sep            => $self->namesep,
         type           => $c->{type} || undef,
         is_nullable    => $c->{is_nullable},
@@ -916,7 +916,7 @@ sub clone {
         my @columns;
         for my $c ( @{$obj->columns} ) {
             my $new_col = $c->clone;
-            $new_col->{table} = $alias;
+            $new_col->{table} = [ $obj->table_name, $alias ];
             push @columns, $new_col;
         }
         $obj->{columns} = \@columns;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
index 3ab84ed..85147bf 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
@@ -37,7 +37,7 @@ sub connc   {
 
 my $ATTRIBUTES = {
     name  => { type => SCALAR },
-    table => { type => SCALAR },
+    table => { type => SCALAR|ARRAYREF },
     sep   => { type => SCALAR },
     type  => {
         type => OBJECT,
@@ -57,7 +57,20 @@ my $ATTRIBUTES = {
 };
 
 sub name           { $_[0]->{name} }
-sub table          { $_[0]->{table} }
+sub table          {
+    my $self = shift;
+    ref $self->{table} ?
+        $self->{table}->[1] || $self->{table}->[0] :
+        $self->{table}
+}
+sub table_name {
+    my $self = shift;
+    ref $self->{table} ? $self->{table}->[0] : $self->{table}
+}
+sub alias_name {
+    my $self = shift;
+    ref $self->{table} ? $self->{table}->[1] : undef;
+}
 sub sep            { $_[0]->{sep} }
 sub type           { $_[0]->{type} }
 sub is_nullable    { $_[0]->{is_nullable} }

From 4989c81dc6f07801be2e4d596cc910bff58cc50d Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 May 2011 17:13:23 -0500
Subject: [PATCH 13/35] Implemented support for subqueries in columns.

---
 lib/DBIx/ObjectMapper/SQL/Base.pm   | 16 ++++++++++------
 lib/DBIx/ObjectMapper/SQL/Select.pm |  5 ++++-
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index 76800ff..45ab334 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -124,10 +124,13 @@ sub convert_columns_to_sql {
     my $class = shift;
     return unless @_;
 
-    return join ', ', map {
+    my @converted_columns = map {[
         $class->convert_column_alias_to_sql(
-            $class->convert_func_to_sql($_) );
-    } grep { defined $_ } @_;
+            $class->convert_func_to_sql($_) )
+    ]} grep { defined $_ } @_;
+
+    return (join ', ', map {$_->[0]} @converted_columns),
+           map {@$_[1..$#$_]} @converted_columns;
 }
 
 sub convert_func_to_sql {
@@ -135,6 +138,7 @@ sub convert_func_to_sql {
     return unless $func;
     return $func unless ref $func;
     return $$func if ref $func eq 'SCALAR';
+    return $func->as_sql('parts') if (blessed($func) && $func->can('as_sql'));
     return $func unless ref $func eq 'HASH';
 
     my $key   = ( keys %$func )[0];
@@ -156,14 +160,14 @@ sub convert_column_alias_to_sql {
     return $$param if ref $param eq 'SCALAR';
     return $param unless ref $param eq 'ARRAY';
 
-    my $col = $class->convert_func_to_sql( $param->[0] );
+    my ($col, @binds) = $class->convert_func_to_sql( $param->[0] );
     my $alias = $param->[1];
     my $as = $class->as_to_sql;
     if( $col and $alias ) {
-        return "$col$as$alias";
+        return ("$col$as$alias", @binds);
     }
     else {
-        return $col;
+        return ($col, @binds);
     }
 }
 
diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index bb6f4fc..600d5de 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -30,7 +30,10 @@ sub as_sql {
 
     my @bind;
     my ($from, @from_bind) = $self->from_as_sql;
-    my $stm = 'SELECT ' . ($self->column_as_sql || '*') . ' FROM ' . $from;
+    my ($col, @col_bind) = $self->column_as_sql;
+
+    my $stm = 'SELECT ' . ($col || '*') . ' FROM ' . $from;
+    push @bind, @col_bind if @col_bind;
     push @bind, @from_bind if @from_bind;
 
     my ($join_stm, @join_bind) = $self->join_as_sql;

From 44d727a9e04506ce6708839a5c673691c186da47 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Tue, 31 May 2011 11:07:38 -0500
Subject: [PATCH 14/35] Fixed bug introduced by allowing binds in columns.

A code pattern emerges.
---
 lib/DBIx/ObjectMapper/SQL/Select.pm | 12 ++++++------
 lib/DBIx/ObjectMapper/SQL/Set.pm    | 12 ++++++------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index 600d5de..20b7f1e 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -44,17 +44,17 @@ sub as_sql {
     $stm .= ' WHERE ' . $where_stm if $where_stm;
     push @bind, @where_bind if @where_bind;
 
-    if( my $group_by = $self->group_by_as_sql ) {
-        $stm .= ' GROUP BY ' . $group_by;
-    }
+    my ($group_by, @group_binds) = $self->group_by_as_sql;
+    $stm .= ' GROUP BY ' . $group_by if $group_by;
+    push @bind, @group_binds if @group_binds;
 
     my ($having_stm, @having_bind) = $self->having_as_sql;
     $stm .= ' HAVING ' . $having_stm if $having_stm;
     push @bind, @having_bind if @having_bind;
 
-    if( my $order_by = $self->order_by_as_sql ) {
-        $stm .= ' ORDER BY ' . $order_by;
-    }
+    my ($order_by, @order_binds) = $self->order_by_as_sql;
+    $stm .= ' ORDER BY ' . $order_by if $order_by;
+    push @bind, @order_binds if @order_binds;
 
     if( ($self->limit || $self->offset) && ($self->{driver} ne 'Oracle') ) {
         my $method = $self->limit_syntax->{ lc( $self->{driver} ) };
diff --git a/lib/DBIx/ObjectMapper/SQL/Set.pm b/lib/DBIx/ObjectMapper/SQL/Set.pm
index a15c6d6..104b08a 100644
--- a/lib/DBIx/ObjectMapper/SQL/Set.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Set.pm
@@ -53,17 +53,17 @@ sub as_sql {
         map { '( ' . $_ . ' )' } @list_stm
     );
 
-    if( my $group_by = $self->group_by_as_sql ) {
-        $stm .= ' GROUP BY ' . $group_by;
-    }
+    my ($group_by, @group_binds) = $self->group_by_as_sql;
+    $stm .= ' GROUP BY ' . $group_by if $group_by;
+    push @bind, @group_binds if @group_binds;
 
     my ( $having_stm, @having_bind ) = $self->having_as_sql;
     $stm .= ' HAVING ' . $having_stm if $having_stm;
     push @bind, @having_bind if @having_bind;
 
-    if( my $order_by = $self->order_by_as_sql ) {
-        $stm .= ' ORDER BY ' . $order_by;
-    }
+    my ($order_by, @order_binds) = $self->order_by_as_sql;
+    $stm .= ' ORDER BY ' . $order_by if $order_by;
+    push @bind, @order_binds if @order_binds;
 
     if( $self->limit || $self->offset ) {
         my $method = $self->limit_syntax->{ lc( $self->{driver} ) };

From 6623a01dd6c7d92aa7d16fad90830b1d3d7347cc Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 27 Jul 2011 23:24:38 -0500
Subject: [PATCH 15/35] Implemented query cloning.

By default, OM supports mutable query building.  clone() allows us to extend
queries without affecting the original queries.  See 09_query/000_basic.t for
a specific example of how this works.
---
 lib/DBIx/ObjectMapper/Query/Base.pm | 53 ++++++++++++++++++++++++++++-
 t/09_query/000_basic.t              | 16 +++++++++
 2 files changed, 68 insertions(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/Query/Base.pm b/lib/DBIx/ObjectMapper/Query/Base.pm
index 6f4f90e..94deb08 100644
--- a/lib/DBIx/ObjectMapper/Query/Base.pm
+++ b/lib/DBIx/ObjectMapper/Query/Base.pm
@@ -1,7 +1,7 @@
 package DBIx::ObjectMapper::Query::Base;
 use strict;
 use warnings;
-use Scalar::Util qw(weaken);
+use Scalar::Util qw(weaken blessed);
 use Carp::Clan qw/^DBIx::ObjectMapper/;
 
 sub new {
@@ -37,6 +37,57 @@ sub as_sql {
     return $self->builder->as_sql(@_);
 }
 
+# By default, OM supports mutable query building.  clone() allows us to extend
+# queries without affecting the original queries.
+sub clone {
+    my $self = shift;
+    my ($clone_hash, $clone_array, $clone_element);
+
+    $clone_hash = sub {
+        my $hash = shift;
+        return {
+            map {
+                $_ => $clone_element->($hash->{$_})
+            } keys %$hash
+        };
+    };
+
+    $clone_array = sub {
+        my $array = shift;
+        return [
+            map {
+                $clone_element->($_)
+            } @$array
+        ];
+    };
+
+    $clone_element = sub {
+        my $element = shift;
+
+        if (!ref $element || ref $element eq 'CODE') {
+            return $element;
+        }
+        elsif (blessed $element && $element->can('clone')) {
+            return $element->clone;
+        }
+        elsif (blessed $element) {
+            return $element;
+        }
+        elsif (ref $element eq 'HASH') {
+            return $clone_hash->($element);
+        }
+        elsif (ref $element eq 'ARRAY') {
+            return $clone_array->($element);
+        }
+        else {
+            use Data::Dumper;
+            die "I do not know how to clone: " . Dumper($element);
+        }
+    };
+
+    return bless($clone_hash->($self), blessed $self);
+}
+
 sub DESTROY {
     my $self = shift;
     warn "DESTROY $self" if $ENV{MAPPER_DEBUG};
diff --git a/t/09_query/000_basic.t b/t/09_query/000_basic.t
index d4596d1..2069a7f 100644
--- a/t/09_query/000_basic.t
+++ b/t/09_query/000_basic.t
@@ -54,6 +54,22 @@ is ref($query->insert), 'DBIx::ObjectMapper::Query::Insert';
     };
 };
 
+{ # select with clone
+    my $regular_query1 = $query->select->from('artist');
+    my $regular_query2 = $regular_query1->order_by('id');
+    my $clone_query1   = $query->select->from('artist');
+    my $clone_query2   = $clone_query1->clone->order_by('id');
+
+    is($regular_query1->as_sql, $regular_query2->as_sql, 'Without clone, they are the same');
+    is($regular_query2->as_sql, $clone_query2->as_sql, 'Same final effects');
+    isnt($clone_query1->as_sql, $clone_query2->as_sql, 'Truly different queries');
+
+    my $sql = $clone_query1->as_sql;
+    $sql =~ s/\W/./g;
+
+    like($clone_query2->as_sql, qr($sql), 'But derivative');
+};
+
 { # select with callback
     my $it = $query->select(
         sub { { id => $_[0]->[0], name => $_[0]->[1] } }

From 79af139623d4666ac5034ad1a0c20d332a9d6571 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Fri, 29 Jul 2011 07:53:52 -0500
Subject: [PATCH 16/35] Select queries now support add_inner_join() and
 add_left_join().

The two new functions serve a few purposes.

First, they follow the principle of least surprise.  The join() and add_join()
functions default to "LEFT OUTER" joins, as opposed to SQL default of "INNER".
Since their names are explicit, a user knows exactly what will be added to the
join clauses.

Second, since the join type is in the function name, the parameters may be
less awkward.  Compare:

  $query->add_join(
      [$his_table => [$id == 1], 'INNER'],
      [$her_table => [$id == 2], 'INNER'],
  )

to:

  $query->add_inner_join(
      $his_table => [$id == 1],
      $her_table => [$id == 2],
  )

Third, there are really only two semantically distinct kinds of joins in SQL:
inner and left.  There is also "right", but it is rarely used and a simple
transform of the parameters.  Thus, the two functions serve the purpose of
narrowing down the options.  A user may fall back to using "add_join" instead
if other joins are important.  Also, "left" always implies "outer", so there
is no need to include the keyword.

Fourth, there is a distinct lack of inner_join() and left_join() functions.  I
noticed when people play with the query-building API, they expect fresh
instances of the method calls to ADD to the clause slots, not replace them.
So, while respecting the original API's behavior, I have intentionally
neglected the slot-replacement, especially since adds work on empty slots.  My
general recommendation to my clients will be to always use "add_", which I
believe should be a default behavior with "replace_" being the less-used but
still available behavior.
---
 lib/DBIx/ObjectMapper/Query/Select.pm |  1 +
 lib/DBIx/ObjectMapper/SQL/Select.pm   | 23 +++++++++
 t/01_sql.t                            | 70 +++++++++++++++++++++++++++
 3 files changed, 94 insertions(+)

diff --git a/lib/DBIx/ObjectMapper/Query/Select.pm b/lib/DBIx/ObjectMapper/Query/Select.pm
index 427f2d3..37cfb81 100644
--- a/lib/DBIx/ObjectMapper/Query/Select.pm
+++ b/lib/DBIx/ObjectMapper/Query/Select.pm
@@ -18,6 +18,7 @@ sub new {
     for my $meth ( qw( column from where join order_by
                        group_by limit offset having
                        add_column add_where add_join
+                       add_inner_join add_left_join
                        add_order_by add_group_by add_having ) ) {
         *{"$pkg\::$meth"} = sub {
             my $self = shift;
diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index 20b7f1e..9d1f925 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -72,6 +72,29 @@ sub as_sql {
     return wantarray ? ($stm, @bind) : $stm;
 }
 
+sub _add_joins_with_param {
+    my $self = shift;
+    my $param = shift;
+    my @join_params = @_;
+    my @real_join_expressions = ();
+    while (@join_params) {
+        my $table = shift @join_params;
+        my $conditions = shift @join_params;
+        push @real_join_expressions, [$table, $conditions, $param];
+    }
+    return $self->add_join(@real_join_expressions);
+}
+
+sub add_inner_join {
+    my $self = shift;
+    $self->_add_joins_with_param('INNER', @_);
+}
+
+sub add_left_join {
+    my $self = shift;
+    $self->_add_joins_with_param('LEFT', @_);
+}
+
 1;
 
 __END__
diff --git a/t/01_sql.t b/t/01_sql.t
index b987244..40bbf36 100644
--- a/t/01_sql.t
+++ b/t/01_sql.t
@@ -469,3 +469,73 @@ DBIx::ObjectMapper::SQL->select->from('hoge')->join( ['fuga', undef, 'natural']
 
 --- expected
 SELECT * FROM hoge NATURAL JOIN fuga <= 
+
+=== left outer join default
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->join( ['fuga', undef] );
+
+--- expected
+SELECT * FROM hoge LEFT OUTER JOIN fuga <= 
+
+=== left join explicit function
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->add_left_join( 'fuga' );
+
+--- expected
+SELECT * FROM hoge LEFT JOIN fuga <= 
+
+=== inner join explicit function
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->add_inner_join( 'fuga' );
+
+--- expected
+SELECT * FROM hoge INNER JOIN fuga <= 
+
+=== inner join with condition
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->join( ['fuga', [\'id=1'], 'INNER'] );
+
+--- expected
+SELECT * FROM hoge INNER JOIN fuga ON ( id=1 ) <= 
+
+=== inner join explicit function with condition
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->add_inner_join( 'fuga' => [\'id=1'] );
+
+--- expected
+SELECT * FROM hoge INNER JOIN fuga ON ( id=1 ) <= 
+
+=== additive inner join with condition
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->join( ['moo', undef, 'INNER'] )->add_join( ['fuga', [\'id=1'], 'INNER'] );
+
+--- expected
+SELECT * FROM hoge INNER JOIN moo INNER JOIN fuga ON ( id=1 ) <= 
+
+=== additive inner join explicit function with condition
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->join( ['moo', undef, 'INNER'] )->add_inner_join( 'fuga' => [\'id=1'] );
+
+--- expected
+SELECT * FROM hoge INNER JOIN moo INNER JOIN fuga ON ( id=1 ) <= 
+
+=== additive left join explicit function with condition
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->join( ['moo', undef, 'INNER'] )->add_left_join( 'fuga' => [\'id=1'] );
+
+--- expected
+SELECT * FROM hoge INNER JOIN moo LEFT JOIN fuga ON ( id=1 ) <= 
+
+=== two inner joins explicit function with one condition
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->add_inner_join( 'fuga' => [\'id=1'], 'moo' );
+
+--- expected
+SELECT * FROM hoge INNER JOIN fuga ON ( id=1 ) INNER JOIN moo <= 
+
+=== two inner joins explicit function with two conditions
+--- input
+DBIx::ObjectMapper::SQL->select->from('hoge')->add_inner_join( 'fuga' => [\'id=1'], 'moo' => [\'moo_id=3'] );
+
+--- expected
+SELECT * FROM hoge INNER JOIN fuga ON ( id=1 ) INNER JOIN moo ON ( moo_id=3 ) <= 

From 3902aaa7c1034698b670c4a050f9a4d78a6c3afd Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Fri, 28 Oct 2011 14:31:11 -0500
Subject: [PATCH 17/35] Implemented support for escaping LIKE clauses.

Example:

  $column->like("Foo\\_Thing")->escape("\\")
---
 lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm | 6 +++++-
 lib/DBIx/ObjectMapper/SQL/Base.pm                   | 4 ++++
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
index 85147bf..2aa4212 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table/Column/Base.pm
@@ -122,7 +122,11 @@ sub not_in {
     $self->op( 'NOT IN', \@values );
 }
 
-sub like { $_[0]->op( 'LIKE', $_[1]) }
+sub like {
+    my ($self, $value, $escape_character) = @_;
+    return defined($escape_character) ? $self->op( 'LIKE', [$value, $escape_character] ) :
+                                        $self->op( 'LIKE', $value );
+}
 
 sub not_like { $_[0]->op( 'NOT LIKE', $_[1]) }
 
diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index 45ab334..b16c8ca 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -340,6 +340,10 @@ sub convert_condition_to_sql {
                 $stm .= ' BETWEEN ? AND ?';
                 push @bind, @{ $w->[2] };
             }
+            elsif( uc($w->[1]) eq 'LIKE' and @{$w->[2]} == 2 ) {
+                $stm .= ' LIKE ? ESCAPE ?';
+                push @bind, @{ $w->[2] };
+            }
             else {
                 confess 'Invalid Parameters in WHERE clause.('
                     . join( ',', @$w ) . ')';

From c1ea2f4c3ac0ac7ad3ea56dbdca8dd83c01e8966 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Mon, 5 Mar 2012 09:43:15 -0600
Subject: [PATCH 18/35] DBIx::ObjectMapper can now operate on an
 externally-provided DBI handle.

We found this necessary for migration from our in-house system to OM in that we
needed to share handles and transactions.
---
 lib/DBIx/ObjectMapper/Engine/DBI.pm | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI.pm b/lib/DBIx/ObjectMapper/Engine/DBI.pm
index e6e925e..8ef628f 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI.pm
@@ -21,6 +21,7 @@ sub _init {
     my $param = shift || confess 'invalid parameter.';
     $param = [ $param, @_ ] unless ref $param;
 
+    my $external_dbh;
     my @connect_info;
     my $option;
     if ( ref $param eq 'ARRAY' ) {
@@ -28,6 +29,7 @@ sub _init {
         $option = $param->[3] if $param->[3];
     }
     elsif ( ref $param eq 'HASH' ) {
+        $external_dbh = delete $param->{external_dbh};
         @connect_info = (
             delete $param->{dsn},
             delete $param->{username},
@@ -60,6 +62,7 @@ sub _init {
         %{ $option || {} }
     };
 
+    $self->{external_dbh}       = $external_dbh;
     $self->{connect_info}       = \@connect_info;
     $self->{driver_type}        = undef;
     $self->{driver}             = undef;
@@ -156,11 +159,16 @@ sub _connect {
     my $self = shift;
 
     my $dbh = do {
-        if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
-            local $DBI::connect_via = 'connect'; # Disable Apache::DBI.
-            DBI->connect( @{ $self->{connect_info} } );
-        } else {
-            DBI->connect( @{ $self->{connect_info} } );
+        if ($self->{external_dbh}) {
+            $self->{external_dbh};
+        }
+        else {
+            if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
+                local $DBI::connect_via = 'connect'; # Disable Apache::DBI.
+                DBI->connect( @{ $self->{connect_info} } );
+            } else {
+                DBI->connect( @{ $self->{connect_info} } );
+            }
         }
     };
 

From 48fd8e1d8ee9cabc22739b345b341a7a7919b3b0 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 31 May 2012 16:47:21 -0500
Subject: [PATCH 19/35] One can now call union from a metadata.

---
 lib/DBIx/ObjectMapper/Engine.pm      |  1 +
 lib/DBIx/ObjectMapper/Engine/DBI.pm  | 10 +++++
 lib/DBIx/ObjectMapper/Metadata.pm    |  1 +
 lib/DBIx/ObjectMapper/Query.pm       |  1 +
 lib/DBIx/ObjectMapper/Query/Union.pm | 58 ++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+)
 create mode 100644 lib/DBIx/ObjectMapper/Query/Union.pm

diff --git a/lib/DBIx/ObjectMapper/Engine.pm b/lib/DBIx/ObjectMapper/Engine.pm
index 243b016..906de75 100644
--- a/lib/DBIx/ObjectMapper/Engine.pm
+++ b/lib/DBIx/ObjectMapper/Engine.pm
@@ -35,6 +35,7 @@ sub update                   { }
 sub insert                   { }
 sub create                   { }
 sub delete                   { }
+sub union                    { }
 sub iterator                 { }
 
 1;
diff --git a/lib/DBIx/ObjectMapper/Engine/DBI.pm b/lib/DBIx/ObjectMapper/Engine/DBI.pm
index 8ef628f..71c852d 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI.pm
@@ -579,6 +579,16 @@ sub delete {
     return $ret;
 }
 
+sub union {
+    my ( $self, $query, $callback ) = @_;
+    my $query_class = ref( $self->query ) . '::Union';
+    unless ( ref $query eq $query_class ) {
+        $query = $self->_as_query_object( 'union', $query );
+    }
+    return $self->iterator->new( $query, $self, $callback );
+}
+
+
 # XXXX TODO CREATE TABLE
 # sub create {  }
 
diff --git a/lib/DBIx/ObjectMapper/Metadata.pm b/lib/DBIx/ObjectMapper/Metadata.pm
index db1353a..be7bef5 100644
--- a/lib/DBIx/ObjectMapper/Metadata.pm
+++ b/lib/DBIx/ObjectMapper/Metadata.pm
@@ -88,6 +88,7 @@ sub select { $_[0]->query_object->select }
 sub insert { $_[0]->query_object->insert }
 sub delete { $_[0]->query_object->delete }
 sub update { $_[0]->query_object->update }
+sub union  { $_[0]->query_object->union  }
 
 1;
 
diff --git a/lib/DBIx/ObjectMapper/Query.pm b/lib/DBIx/ObjectMapper/Query.pm
index 941b987..61c1a24 100644
--- a/lib/DBIx/ObjectMapper/Query.pm
+++ b/lib/DBIx/ObjectMapper/Query.pm
@@ -14,5 +14,6 @@ sub insert { DBIx::ObjectMapper::Query::Insert->new( shift->metadata, @_ ) }
 sub update { DBIx::ObjectMapper::Query::Update->new( shift->metadata, @_ ) }
 sub delete { DBIx::ObjectMapper::Query::Delete->new( shift->metadata, @_ ) }
 sub count  { DBIx::ObjectMapper::Query::Count->new( shift->metadata, @_ ) }
+sub union  { DBIx::ObjectMapper::Query::Union->new( shift->metadata, @_ ) }
 
 1;
diff --git a/lib/DBIx/ObjectMapper/Query/Union.pm b/lib/DBIx/ObjectMapper/Query/Union.pm
new file mode 100644
index 0000000..113f5a9
--- /dev/null
+++ b/lib/DBIx/ObjectMapper/Query/Union.pm
@@ -0,0 +1,58 @@
+package DBIx::ObjectMapper::Query::Union;
+use strict;
+use warnings;
+use Carp::Clan qw/^DBIx::ObjectMapper/;
+use Data::Page;
+use base qw(DBIx::ObjectMapper::Query::Base);
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    $self->builder( $self->engine->query->union );
+    return $self;
+}
+
+{
+    no strict 'refs';
+    my $pkg = __PACKAGE__;
+    for my $meth ( qw( order_by group_by
+                       having
+                       limit offset
+                       add_order_by add_group_by
+                       add_having
+                       sets add_sets ) ) {
+        *{"$pkg\::$meth"} = sub {
+            my $self = shift;
+            $self->builder->$meth(@_);
+            return $self;
+        };
+    }
+};
+
+
+sub pager {
+    my $self = shift;
+    my $page = shift || 1;
+    confess 'page must be integer.' unless $page =~ /^\d+$/ and $page > 0;
+
+    my $limit = $self->builder->limit->[0] || confess "limit is not set.";
+    $self->offset( ( $page - 1 ) * $limit );
+
+    my $pager = Data::Page->new();
+    $pager->total_entries( $self->count );
+    $pager->entries_per_page( $self->builder->{limit}->[0] || 0 );
+    $pager->current_page( $page );
+    return $pager;
+}
+
+sub execute {
+    my $self = shift;
+    return $self->engine->union( $self->builder, $self->callback, @_ );
+}
+
+sub as_sql {
+    my $self = shift;
+    return $self->builder->as_sql(@_);
+}
+
+1;

From fd688f36fbbbebfaf487faf398d361f88c6ca779 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 2 Aug 2012 15:09:28 -0500
Subject: [PATCH 20/35] Someone had a typo; this _function does not exist
 anywhere.

---
 lib/DBIx/ObjectMapper/Engine/DBI.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI.pm b/lib/DBIx/ObjectMapper/Engine/DBI.pm
index 71c852d..c8f1e47 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI.pm
@@ -212,7 +212,7 @@ sub disconnect {
     if( my $dbh = $self->{_dbh} ) {
         $self->dbh_do( $self->{disconnect_do}, $dbh );
         while( $self->{txn_depth} > 0 ) {
-            $self->_txn_rollback;
+            $self->txn_rollback;
         }
         $dbh->disconnect;
         $self->log_connect('DISCONNECT');

From f8c9bf8f64685959fd3dcbde5040ab23f8497354 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Sat, 4 Aug 2012 08:09:22 -0500
Subject: [PATCH 21/35] Be nice to externally provided DBHs.

---
 lib/DBIx/ObjectMapper/Engine/DBI.pm | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI.pm b/lib/DBIx/ObjectMapper/Engine/DBI.pm
index c8f1e47..a3d721c 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI.pm
@@ -209,7 +209,14 @@ sub _connect {
 
 sub disconnect {
     my ($self) = @_;
-    if( my $dbh = $self->{_dbh} ) {
+    my $dbh = $self->{_dbh};
+    if (
+        $dbh &&
+        (
+            !defined($self->{external_dbh}) ||
+            $self->{external_dbh} != $dbh
+        )
+    ) {
         $self->dbh_do( $self->{disconnect_do}, $dbh );
         while( $self->{txn_depth} > 0 ) {
             $self->txn_rollback;

From 42c2920ef699c02709ffef3f3746315ad42a4ca3 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Wed, 23 Jan 2013 12:38:08 -0600
Subject: [PATCH 22/35] Oracle has a concept of a recycle bin for dropped
 tables.  Ignoring it.

---
 lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
index c41f842..7ff0c86 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
@@ -110,6 +110,7 @@ sub get_tables {
     my ( $self, $dbh ) = @_;
     return $self->_truncate_quote_and_sep(
         sort {$a cmp $b}
+        grep { $_ !~ /\.BIN\$0/ }
         map {$_ =~ s/"//g; $_}
         (
             $dbh->tables(undef, $self->db_schema, undef, 'TABLE'),

From 4900956f5657ce4c73133c28e719a6e2def2bd00 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Mon, 11 Mar 2013 12:05:54 -0500
Subject: [PATCH 23/35] Looks like "0" was a bad assumption.

---
 lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
index 7ff0c86..2589014 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
@@ -110,7 +110,7 @@ sub get_tables {
     my ( $self, $dbh ) = @_;
     return $self->_truncate_quote_and_sep(
         sort {$a cmp $b}
-        grep { $_ !~ /\.BIN\$0/ }
+        grep { $_ !~ /\.BIN\$/ }
         map {$_ =~ s/"//g; $_}
         (
             $dbh->tables(undef, $self->db_schema, undef, 'TABLE'),

From c86208f9bef465dc863c9f398861908008f8fca2 Mon Sep 17 00:00:00 2001
From: Shin Leong <sleong@watson.wustl.edu>
Date: Tue, 26 Mar 2013 09:39:07 -0500
Subject: [PATCH 24/35] if it is union, put parenthesis around it.

---
 lib/DBIx/ObjectMapper/SQL/Base.pm | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index b16c8ca..ea0cf7c 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -197,6 +197,9 @@ sub convert_table_to_sql {
     }
     elsif( blessed $table and $table->can('as_sql') ) {
         ( $stm, @bind ) = $table->as_sql('parts');
+        if($table->isa('DBIx::ObjectMapper::Query::Union')) {
+            $stm = '( ' . $stm . ' )';
+        }
     }
     elsif( ref $table eq 'SCALAR' ) {
         $stm = $$table;

From cbf55658b9557c194201314aa01c67267f1f41d6 Mon Sep 17 00:00:00 2001
From: Shawn Leonard <sleonard@genome.wustl.edu>
Date: Tue, 28 Jan 2014 12:46:48 -0600
Subject: [PATCH 25/35] DBD::Oracle overrides to remove deprecated RULE* hint
 until we can upgrade to DBD::Oracle 1.68

---
 .../ObjectMapper/Engine/DBI/Driver/Oracle.pm  | 101 +++++++++++++++++-
 1 file changed, 99 insertions(+), 2 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
index 2589014..a43d792 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
@@ -40,7 +40,8 @@ sub get_primary_key {
     my ($self, $dbh, $table) = @_;
     if (!$self->{_cache}->{_oracle}->{primary_keys}->{$table}) {
          $self->{_cache}->{_oracle}->{primary_keys}->{$table} =
-            +[keys %{$dbh->primary_key_info('', $self->db_schema, $table)->fetchall_hashref('COLUMN_NAME')}];
+            #+[keys %{$dbh->primary_key_info('', $self->db_schema, $table)->fetchall_hashref('COLUMN_NAME')}];
+            +[keys %{$self->_primary_key_info($dbh, '', $self->db_schema, $table)->fetchall_hashref('COLUMN_NAME')}];
     }
     return @{$self->{_cache}->{_oracle}->{primary_keys}->{$table}};
 }
@@ -82,7 +83,8 @@ sub get_table_fk_info {
     my ($self, $dbh, $table) = @_;
 
     if (!$self->{_cache}->{_oracle}->{foreign_keys}->{$table}) {
-        my $sth = $dbh->foreign_key_info(undef, undef, undef, '', $self->db_schema, $table);
+        #my $sth = $dbh->foreign_key_info(undef, undef, undef, '', $self->db_schema, $table);
+        my $sth = $self->_foreign_key_info($dbh,undef, undef, undef, '', $self->db_schema, $table);
         my %constraints = ();
 
         while (my $row = $sth->fetchrow_hashref) {
@@ -186,4 +188,99 @@ sub type_map {
     return $class->_type_map_data->{$type};
 }
 
+###### horrid DBD::Oracle override below 
+###### REMOVE WHEN PERL IS UPGRADED!!!!!
+###### code base from DBD::Oracle v1.68
+
+sub _primary_key_info {
+    my($self, $dbh, $catalog, $schema, $table) = @_;
+    if (ref $catalog eq 'HASH') {
+        ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'};
+        $catalog = undef;
+    }
+    my $SQL = <<'SQL';
+SELECT *
+  FROM
+(
+  SELECT /*+ CHOOSE */
+         NULL              TABLE_CAT
+       , c.OWNER           TABLE_SCHEM
+       , c.TABLE_NAME      TABLE_NAME
+       , c.COLUMN_NAME     COLUMN_NAME
+       , c.POSITION        KEY_SEQ
+       , c.CONSTRAINT_NAME PK_NAME
+    FROM ALL_CONSTRAINTS   p
+       , ALL_CONS_COLUMNS  c
+   WHERE p.OWNER           = c.OWNER
+     AND p.TABLE_NAME      = c.TABLE_NAME
+     AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME
+     AND p.CONSTRAINT_TYPE = 'P'
+)
+ WHERE TABLE_SCHEM = ?
+   AND TABLE_NAME  = ?
+ ORDER BY TABLE_SCHEM, TABLE_NAME, KEY_SEQ
+SQL
+#warn "@_\n$Sql ($schema, $table)";
+    my $sth = $dbh->prepare($SQL) or return undef;
+    $sth->execute($schema, $table) or return undef;
+    $sth;
+}
+
+sub _foreign_key_info {
+    my $self = shift;
+    my $dbh  = shift;
+    my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
+        'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2]
+            ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] };
+    my $SQL = <<'SQL';  # XXX: DEFERABILITY
+SELECT *
+  FROM
+(
+  SELECT /*+ CHOOSE */
+         to_char( NULL )    UK_TABLE_CAT
+       , uk.OWNER           UK_TABLE_SCHEM
+       , uk.TABLE_NAME      UK_TABLE_NAME
+       , uc.COLUMN_NAME     UK_COLUMN_NAME
+       , to_char( NULL )    FK_TABLE_CAT
+       , fk.OWNER           FK_TABLE_SCHEM
+       , fk.TABLE_NAME      FK_TABLE_NAME
+       , fc.COLUMN_NAME     FK_COLUMN_NAME
+       , uc.POSITION        ORDINAL_POSITION
+       , 3                  UPDATE_RULE
+       , decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 )
+                            DELETE_RULE
+       , fk.CONSTRAINT_NAME FK_NAME
+       , uk.CONSTRAINT_NAME UK_NAME
+       , to_char( NULL )    DEFERABILITY
+       , decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE')
+                            UNIQUE_OR_PRIMARY
+    FROM ALL_CONSTRAINTS    uk
+       , ALL_CONS_COLUMNS   uc
+       , ALL_CONSTRAINTS    fk
+       , ALL_CONS_COLUMNS   fc
+   WHERE uk.OWNER            = uc.OWNER
+     AND uk.CONSTRAINT_NAME  = uc.CONSTRAINT_NAME
+     AND fk.OWNER            = fc.OWNER
+     AND fk.CONSTRAINT_NAME  = fc.CONSTRAINT_NAME
+     AND uk.CONSTRAINT_TYPE IN ('P','U')
+     AND fk.CONSTRAINT_TYPE  = 'R'
+     AND uk.CONSTRAINT_NAME  = fk.R_CONSTRAINT_NAME
+     AND uk.OWNER            = fk.R_OWNER
+     AND uc.POSITION         = fc.POSITION
+)
+ WHERE 1              = 1
+SQL
+    my @BindVals = ();
+    while ( my ( $k, $v ) = each %$attr ) {
+        if ( $v ) {
+            $SQL .= "   AND $k = ?\n";
+            push @BindVals, $v;
+        }
+    }
+    $SQL .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n";
+    my $sth = $dbh->prepare( $SQL ) or return undef;
+    $sth->execute( @BindVals ) or return undef;
+    $sth;
+}
+
 1;

From 5e7ea49b4b8dd06f623eeb3d6a550acc33bfbe14 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 Jun 2014 08:56:36 -0500
Subject: [PATCH 26/35] Removed use of Hash::Merge.

This package was not what the use cases actually called for.  We needed some
specialized object-specific merging that preserved the original blessed
references.  Fixed the Column manipulations in the Metadata::Table to use the
more specific merge strategy and removed a package dependency (yay!).
---
 META.yml                                |  1 -
 Makefile.PL                             |  1 -
 lib/DBIx/ObjectMapper/Metadata/Table.pm | 12 ++++++++++++
 lib/DBIx/ObjectMapper/Utils.pm          | 10 ++++++----
 4 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/META.yml b/META.yml
index 96a0f72..2d65d8c 100644
--- a/META.yml
+++ b/META.yml
@@ -39,7 +39,6 @@ requires:
   DateTime::Format::SQLite: 0
   Digest::MD5: 0
   Filter::Util::Call: 0
-  Hash::Merge: 0.12
   List::MoreUtils: 0
   Log::Any: 0
   Module::Find: 0
diff --git a/Makefile.PL b/Makefile.PL
index fbacf33..ad5902c 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -21,7 +21,6 @@ requires 'Class::MOP';
 requires 'Class::Inspector';
 requires 'Class::Data::Inheritable';
 requires 'Data::Page' => 2.00;
-requires 'Hash::Merge' => 0.12;
 requires 'Params::Validate';
 requires 'Log::Any';
 requires 'Digest::MD5';
diff --git a/lib/DBIx/ObjectMapper/Metadata/Table.pm b/lib/DBIx/ObjectMapper/Metadata/Table.pm
index d7e1f4c..c867c44 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Table.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Table.pm
@@ -492,7 +492,19 @@ sub _set_column {
     my $override_column = $self->column_map->{ $c->{name} };
     if ( defined $override_column ) {
         my $org = $self->column( $c->{name} );
+        my $overriding_type = $c->{type};
         $c = DBIx::ObjectMapper::Utils::merge_hashref( { %$org }, $c );
+
+        # But we don't actually want a basic merge_hashref when it comes to
+        # the type object.  We actually want to merge specified/overriden
+        # values, such as utf8.  This is something even the old Hash::Merge
+        # package can't do exactly how we want.  Therefore, we now carefully
+        # merge those:
+        for my $attribute (keys %$overriding_type) {
+            $c->{type}->{$attribute} = defined($overriding_type->{$attribute}) ?
+                                            $overriding_type->{$attribute} :
+                                            $org->{type}->{$attribute};
+        }
     }
 
     my $name = delete $c->{name} || confess 'column name not found.';
diff --git a/lib/DBIx/ObjectMapper/Utils.pm b/lib/DBIx/ObjectMapper/Utils.pm
index 35dcddd..8cdb5ff 100644
--- a/lib/DBIx/ObjectMapper/Utils.pm
+++ b/lib/DBIx/ObjectMapper/Utils.pm
@@ -5,7 +5,6 @@ use Carp::Clan qw/^DBIx::ObjectMapper/;
 use Try::Tiny;
 use Class::MOP;
 use Scalar::Util;
-use Hash::Merge;
 use Class::Inspector;
 
 sub installed { Class::Inspector->installed($_[0]) }
@@ -79,12 +78,15 @@ sub is_deeply {
     }
 }
 
+# This function is intended to merge the values behind the toplevel keys in
+# two hashrefs, such that the second/new hashref overrides values in the
+# first/old hashref or supplies them if they are missing.
 sub merge_hashref {
     my ( $old, $new ) = @_;
-    croak "Invlid Parameter. usage: merge_hashref(HashRef,HashRef)"
+    croak "Invalid Parameter. usage: merge_hashref(HashRef,HashRef)"
         unless ref $old eq 'HASH' and ref $new eq 'HASH';
-    Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );
-    return Hash::Merge::merge($old,$new);
+
+    return {%$old, %$new};
 }
 
 sub camelize {

From 224f21f75157dcd43480d018f13661f1bef67011 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 Jun 2014 08:58:55 -0500
Subject: [PATCH 27/35] Removed Module::Find dependency.

Using Module::Find makes the system run slower with additional I/O, and it is
simply magic.  Considering that OM::Metadata::Sugar dynamically creates
functions based on the types, we are running the risk of a type with the same
name as a Perl built-in.  This entire dynamic method-building plus
module-finding tends to be a design smell.  This change is the first step
towards a safer system.

I initially ran into problems with this because I had a global version of OM
installed in addition to linking to my local repo lib, so Sugar actually found
two classes for each type and spit out warnings about function redefinition.
My first inclination was to use List::MoreUtils::uniq, but that fixed the
symptom, not the problem.
---
 META.yml                                |  1 -
 Makefile.PL                             |  1 -
 lib/DBIx/ObjectMapper/Metadata/Sugar.pm | 29 +++++++++++++++++++++----
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/META.yml b/META.yml
index 2d65d8c..83d9ad0 100644
--- a/META.yml
+++ b/META.yml
@@ -41,7 +41,6 @@ requires:
   Filter::Util::Call: 0
   List::MoreUtils: 0
   Log::Any: 0
-  Module::Find: 0
   Params::Validate: 0
   Scalar::Util: 0
   Sub::Exporter: 0
diff --git a/Makefile.PL b/Makefile.PL
index ad5902c..69a3a31 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -30,7 +30,6 @@ requires 'DateTime';
 requires 'Sub::Exporter';
 requires 'Capture::Tiny';
 requires 'Data::Dump';
-requires 'Module::Find';
 requires 'Cache::LRU';
 
 build_requires 'Test::More'     => 0.88;
diff --git a/lib/DBIx/ObjectMapper/Metadata/Sugar.pm b/lib/DBIx/ObjectMapper/Metadata/Sugar.pm
index cc37b15..08689b7 100644
--- a/lib/DBIx/ObjectMapper/Metadata/Sugar.pm
+++ b/lib/DBIx/ObjectMapper/Metadata/Sugar.pm
@@ -2,7 +2,6 @@ package DBIx::ObjectMapper::Metadata::Sugar;
 use strict;
 use warnings;
 use Sub::Exporter;
-use Module::Find;
 use DBIx::ObjectMapper::Utils;
 
 our @ATTRS = qw(Col PrimaryKey NotNull OnUpdate Default ToStorage Unique
@@ -37,10 +36,33 @@ sub ServerDefault  { server_default => $_[0] }
 sub ForeignKey     { foreign_key    => [ $_[0] => $_[1] ] }
 sub ServerCheck    { server_check   => $_[0] }
 
-our @TYPES;
+our @TYPES = qw(
+    Array
+    BigInt
+    Binary
+    Bit
+    Blob
+    Boolean
+    ByteA
+    Date
+    Datetime
+    Float
+    Int
+    Interval
+    Mush
+    Numeric
+    SmallInt
+    String
+    Text
+    Time
+    Undef
+    Uri
+    Yaml
+);
+
 {
     my $namespace = 'DBIx::ObjectMapper::Metadata::Table::Column::Type';
-    my @type_classes = Module::Find::findallmod($namespace);
+    my @type_classes = map { "${namespace}::$_" } @TYPES;
 
     my $pkg = __PACKAGE__;
     for my $type_class ( @type_classes ) {
@@ -49,7 +71,6 @@ our @TYPES;
         $name =~ s/^$namespace\:://;
         no strict 'refs';
         *{"$pkg\::$name"} = sub { type => $type_class->new(@_) };
-        push @TYPES, $name;
     }
 };
 

From c123f6f4c5a115e606a96bbee97f3a949adc9cdc Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 Jun 2014 09:03:12 -0500
Subject: [PATCH 28/35] Incorrect use of parameters to Col fixed.

Looks like this entire .t file never passed.  It should now.
---
 t/10_meta/002_table.t | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/t/10_meta/002_table.t b/t/10_meta/002_table.t
index c267f8e..cb35cf4 100644
--- a/t/10_meta/002_table.t
+++ b/t/10_meta/002_table.t
@@ -117,8 +117,8 @@ use DBIx::ObjectMapper::Metadata::Sugar qw(:all);
     ok my $meta = DBIx::ObjectMapper::Metadata::Table->new(
         testmetadata => [
             Col( name => Text(undef, utf8 => 1) ),
-            Col( created => Default { time() } ),
-            Col( updated => OnUpdate { time() }),
+            Col( created => Time(), Default { time() } ),
+            Col( updated => Time(), OnUpdate { time() } ),
         ],
         {
             engine => $engine,

From b61abadc337dfcb9968e7e45e332016164b462e8 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 Jun 2014 09:04:07 -0500
Subject: [PATCH 29/35] polymorphic_identity is not a number.  Use string
 comparison.

---
 lib/DBIx/ObjectMapper/Mapper.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/Mapper.pm b/lib/DBIx/ObjectMapper/Mapper.pm
index 60ae10e..4da06eb 100644
--- a/lib/DBIx/ObjectMapper/Mapper.pm
+++ b/lib/DBIx/ObjectMapper/Mapper.pm
@@ -165,7 +165,7 @@ sub new {
         elsif( $option->{polymorphic_on} and $option->{polymorphic_identity} ) {
             $option->{default_condition} = [
                 $option->{table}->c( $option->{polymorphic_on} )
-                    == $option->{polymorphic_identity} ];
+                    eq $option->{polymorphic_identity} ];
 
             $option->{default_value}->{$option->{polymorphic_on}}
                 = $option->{polymorphic_identity};

From 5c986f18daec36b8bb1abada39ab02383a48968b Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 Jun 2014 09:04:31 -0500
Subject: [PATCH 30/35] Dependency on Devel::Cycle is not explicitly declared;
 earlier versions broke this test.

---
 t/10_meta/009_trigger.t | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/t/10_meta/009_trigger.t b/t/10_meta/009_trigger.t
index 5b1c204..2502c2a 100644
--- a/t/10_meta/009_trigger.t
+++ b/t/10_meta/009_trigger.t
@@ -92,10 +92,23 @@ $artist->delete->execute;
 is $trigger_cnt{before_delete}, 1;
 is $trigger_cnt{after_delete}, 1;
 
-eval "require Test::Memory::Cycle";
-unless( $@ ) {
+SKIP: {
+    eval "require Test::Memory::Cycle";
+    if ($@) {
+        skip("Error requiring Test::Memory::Cycle: $@", 2);
+    }
+
+    # Versions of Devel::Cycle less than 1.09 had a bug when looking at
+    # closed-over variables in coderefs: Devel::Cycle attempted to dereference
+    # all such variables as scalar references.  This dies when, for example,
+    # the variable is a hashref.  Skip these tests if Devel::Cycle is an
+    # earlier version.
+    if (Devel::Cycle->VERSION lt '1.09') {
+        skip("Skipped memory cycle test because your version (" . Devel::Cycle->VERSION. ") of Devel::Cycle is ancient and buggy", 2);
+    }
+
     Test::Memory::Cycle::memory_cycle_ok( $artist );
     Test::Memory::Cycle::memory_cycle_ok( $meta );
-}
+};
 
 done_testing;

From 5ad69e9b3ad89fd2c3da8fe3848a6b8a4302143e Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Thu, 26 Jun 2014 09:05:25 -0500
Subject: [PATCH 31/35] Fixed table inheritance assumptions.

We were missing the method to map or the column we were mapping.
---
 t/12_session/030_inherit_polymorphic_tree.t          | 12 +++++++++---
 .../032_class_table_inheritance_with_relation.t      |  8 +++++++-
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/t/12_session/030_inherit_polymorphic_tree.t b/t/12_session/030_inherit_polymorphic_tree.t
index f89e3f6..8776f94 100644
--- a/t/12_session/030_inherit_polymorphic_tree.t
+++ b/t/12_session/030_inherit_polymorphic_tree.t
@@ -14,8 +14,8 @@ my $mapper = DBIx::ObjectMapper->new(
             q{CREATE TABLE employee(id integer primary key, type text, name text, memo text)},
             q{CREATE TABLE engineer(id integer primary key, language text, FOREIGN KEY(id) REFERENCES person(id))},
             q{CREATE TABLE manager(id integer primary key, type text, golf_swing text, FOREIGN KEY(id) REFERENCES employee(id))},
-            q{CREATE TABLE geek_manager (id integer primary key, language TEXT, memo text, FOREIGN KEY (id) REFERENCES employee(id))},
-            q{CREATE TABLE deadshit_manager (id integer primary key, iq integer, memo text, FOREIGN KEY (id) REFERENCES employee(id))},
+            q{CREATE TABLE geek_manager (id integer primary key, type text, language TEXT, memo text, FOREIGN KEY (id) REFERENCES employee(id))},
+            q{CREATE TABLE deadshit_manager (id integer primary key, type text, iq integer, memo text, FOREIGN KEY (id) REFERENCES employee(id))},
         ],
     }),
 );
@@ -184,7 +184,8 @@ $mapper->maps(
         properties => {
             old_language => {
                 isa => $mapper->metadata->t('geek_manager')->c('language'),
-            }
+            },
+            t => { isa => $mapper->metadata->t('geek_manager')->c('type') },
         }
     }
 );
@@ -194,6 +195,11 @@ $mapper->maps(
     inherits => 'My::Manager',
     polymorphic_on => 'type',
     polymorphic_identity => 'deadshit_manager',
+    attributes => {
+        properties => {
+            t => { isa => $mapper->metadata->t('deadshit_manager')->c('type') },
+        }
+    }
 );
 
 my @languages = (
diff --git a/t/12_session/032_class_table_inheritance_with_relation.t b/t/12_session/032_class_table_inheritance_with_relation.t
index 6aca0c5..70822ac 100644
--- a/t/12_session/032_class_table_inheritance_with_relation.t
+++ b/t/12_session/032_class_table_inheritance_with_relation.t
@@ -13,7 +13,7 @@ my $mapper = DBIx::ObjectMapper->new(
         on_connect_do => [
             q{CREATE TABLE language (id integer primary key, name text)},
             q{CREATE TABLE employee(id integer primary key, type text)},
-            q{CREATE TABLE engineer(id integer primary key, language_id integer REFERENCES language(id), FOREIGN KEY(id) REFERENCES person(id))},
+            q{CREATE TABLE engineer(id integer primary key, type text, language_id integer REFERENCES language(id), FOREIGN KEY(id) REFERENCES person(id))},
             q{CREATE TABLE project (id integer primary key, engineer_id integer REFERENCES engineer(id) )},
         ],
     }),
@@ -39,6 +39,12 @@ my $project = $mapper->metadata->t( 'project' => 'autoload' );
         return $self->{id};
     }
 
+    sub type {
+        my $self = shift;
+        $self->{type} = shift if @_;
+        return $self->{type};
+    }
+
     1;
 };
 

From d0722d91ad83fc3f120924d1548618139d9d8b66 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Mon, 7 Jul 2014 15:26:13 -0500
Subject: [PATCH 32/35] Revert "First serious pass at Oracle support: Oracle
 supports rownum, not limit."

This reverts commit 77adef1ba608c7b33980acaf3cae79152cdd8725.
---
 lib/DBIx/ObjectMapper/SQL/Base.pm   | 26 +-------------------------
 lib/DBIx/ObjectMapper/SQL/Select.pm |  6 +++---
 2 files changed, 4 insertions(+), 28 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/SQL/Base.pm b/lib/DBIx/ObjectMapper/SQL/Base.pm
index ea0cf7c..12304ab 100644
--- a/lib/DBIx/ObjectMapper/SQL/Base.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Base.pm
@@ -72,16 +72,12 @@ sub _add_accessor {
 }
 
 sub _as_sql_accessor {
-    my ( $self, $field, $func, $is_oracle ) = @_;
+    my ( $self, $field, $func ) = @_;
     my @param
         = ref $self->{$field} eq 'ARRAY'
         ? @{ $self->{$field} }
         : ( $self->{$field} );
 
-    if ($is_oracle && $func eq 'build_where') {
-        return $self->build_where(@param, $self->oracle_limit);
-    }
-
     return $self->$func(@param);
 }
 
@@ -246,26 +242,6 @@ sub convert_join_to_sql {
     return ( $stm, @bind );
 }
 
-sub oracle_limit {
-    my $self = shift;
-    return () if ($self->{driver} ne 'Oracle');
-
-    my $limit = $self->limit_as_sql;
-    my $offset = $self->offset_as_sql || 0;
-
-    my @conditions = ();
-
-    if ($offset) {
-        push @conditions, ['ROWNUM', '>', $offset];
-    }
-
-    if ($limit) {
-        push @conditions, ['ROWNUM', '<=', $limit + $offset];
-    }
-
-    return @conditions;
-}
-
 sub build_where {
     my ( $class, @where ) = @_;
     return $class->convert_conditions_to_sql('and', @where);
diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index 9d1f925..3a2bf59 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -13,7 +13,7 @@ __PACKAGE__->initdata({
     limit    => 0,
     offset   => 0,
     having   => [],
-    driver   => '', # Pg, mysql, SQLite ...
+    driver   => undef, # Pg, mysql, SQLite ...
 });
 
 __PACKAGE__->accessors({
@@ -40,7 +40,7 @@ sub as_sql {
     $stm .= ' ' . $join_stm if $join_stm;
     push @bind, @join_bind if @join_bind;
 
-    my ($where_stm, @where_bind) = $self->where_as_sql($self->{driver} eq 'Oracle');
+    my ($where_stm, @where_bind) = $self->where_as_sql;
     $stm .= ' WHERE ' . $where_stm if $where_stm;
     push @bind, @where_bind if @where_bind;
 
@@ -56,7 +56,7 @@ sub as_sql {
     $stm .= ' ORDER BY ' . $order_by if $order_by;
     push @bind, @order_binds if @order_binds;
 
-    if( ($self->limit || $self->offset) && ($self->{driver} ne 'Oracle') ) {
+    if( $self->limit || $self->offset ) {
         my $method = $self->limit_syntax->{ lc( $self->{driver} ) };
         $method = $self->limit_syntax->{default}
             unless $method and $self->can($method);

From 043871189b9082a5ce5a863d12dc7bcb39a73902 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Mon, 7 Jul 2014 15:27:03 -0500
Subject: [PATCH 33/35] Easier to do straight eq comparisons if we are always a
 string.

---
 lib/DBIx/ObjectMapper/SQL/Select.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index 3a2bf59..cb48a4e 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -13,7 +13,7 @@ __PACKAGE__->initdata({
     limit    => 0,
     offset   => 0,
     having   => [],
-    driver   => undef, # Pg, mysql, SQLite ...
+    driver   => '', # Pg, mysql, SQLite ...
 });
 
 __PACKAGE__->accessors({

From 3da2e3d201f88064366768dd5047b1f23b2e03f6 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Tue, 8 Jul 2014 08:02:53 -0500
Subject: [PATCH 34/35] Implemented proper Oracle three-nested-select strategy
 for rownum.

You may find two-nested-select online; ignore them.  We have to support
arbitrarily-constructed aggregate queries, after all.  Better to preserve that
than to attempt to modify it with our additional WHERE conditions.
---
 lib/DBIx/ObjectMapper/SQL/Select.pm | 64 +++++++++++++++++++++++++----
 t/14_oracle/paging.t                | 60 +++++++++++++++++++++++++++
 2 files changed, 116 insertions(+), 8 deletions(-)
 create mode 100644 t/14_oracle/paging.t

diff --git a/lib/DBIx/ObjectMapper/SQL/Select.pm b/lib/DBIx/ObjectMapper/SQL/Select.pm
index cb48a4e..88effd2 100644
--- a/lib/DBIx/ObjectMapper/SQL/Select.pm
+++ b/lib/DBIx/ObjectMapper/SQL/Select.pm
@@ -24,9 +24,8 @@ __PACKAGE__->accessors({
     num_check              => [qw(limit offset)],
 });
 
-sub as_sql {
+sub _generate_subquery {
     my $self = shift;
-    my $mode = shift;
 
     my @bind;
     my ($from, @from_bind) = $self->from_as_sql;
@@ -56,13 +55,62 @@ sub as_sql {
     $stm .= ' ORDER BY ' . $order_by if $order_by;
     push @bind, @order_binds if @order_binds;
 
+    return ($stm, @bind);
+}
+
+sub _final_column_name {
+    my ($class, $raw_column) = @_;
+
+    if (!ref $raw_column || ref $raw_column eq 'HASH') {
+        return $class->convert_func_to_sql( $raw_column );
+    }
+
+    if (defined($raw_column->[1])) {
+        return $raw_column->[1];
+    }
+
+    my ($column) = $class->convert_func_to_sql( $raw_column->[0] );
+    return $column;
+}
+
+sub _apply_oracle_limits {
+    my ($self, $original_stm, @bind) = @_;
+
+    my $lower_limit = $self->offset ? $self->offset_as_sql : 1;
+    return ($original_stm, @bind) if !$lower_limit;
+    my $upper_limit = $self->limit  ? $self->limit_as_sql + $lower_limit - 1 : undef;
+
+    my $final_column_list = join(', ', map {$self->_final_column_name($_)} @{$self->column});
+    my $stm = "SELECT $final_column_list FROM ( " .
+                   "SELECT /*+ first_row */ rownum AS oracle_rownum_XYZZY, $final_column_list FROM ( $original_stm ) " .
+              ") WHERE oracle_rownum_XYZZY >= $lower_limit" .
+                    (defined($upper_limit) ? " AND oracle_rownum_XYZZY <= $upper_limit" : "");
+
+    return ($stm, @bind);
+}
+
+sub _apply_limit_syntax {
+    my ($self, $stm, @bind) = @_;
+
+    my $method = $self->limit_syntax->{ lc( $self->{driver} ) };
+    $method = $self->limit_syntax->{default}
+        unless $method and $self->can($method);
+    if( my $add_stm = $self->${method}() ) {
+        $stm .= $add_stm;
+    }
+
+    return ($stm, @bind);
+}
+
+sub as_sql {
+    my $self = shift;
+    my $mode = shift;
+
+    my ($stm, @bind) = $self->_generate_subquery();
+
     if( $self->limit || $self->offset ) {
-        my $method = $self->limit_syntax->{ lc( $self->{driver} ) };
-        $method = $self->limit_syntax->{default}
-            unless $method and $self->can($method);
-        if( my $add_stm = $self->${method}() ) {
-            $stm .= $add_stm;
-        }
+        ($stm, @bind) = $self->{driver} eq 'Oracle' ? $self->_apply_oracle_limits($stm, @bind) :
+                                                      $self->_apply_limit_syntax($stm, @bind);
     }
 
     if( $mode and $mode eq 'parts' ) {
diff --git a/t/14_oracle/paging.t b/t/14_oracle/paging.t
new file mode 100644
index 0000000..11d0410
--- /dev/null
+++ b/t/14_oracle/paging.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+use DBIx::ObjectMapper::SQL;
+
+#-- Regular query
+my $query = DBIx::ObjectMapper::SQL->select
+                ->column(['g', 'h'], 'i')
+                ->from(['foo', 'f'])
+                ->where(['x', '=', 'something'])
+                ->limit(10)
+                ->offset(4);
+
+is_deeply(
+    [$query->as_sql],
+    ["SELECT g AS h, i FROM foo AS f WHERE ( x = ? ) LIMIT 4, 10", 'something'],
+    'Default select statement format'
+);
+
+
+#-- Now we give it the Oracle flavor
+$query->{driver} = 'Oracle';
+
+is_deeply(
+    [$query->as_sql],
+    ["SELECT h, i FROM ( " .
+         "SELECT /*+ first_row */ rownum AS oracle_rownum_XYZZY, h, i FROM ( " .
+             "SELECT g h, i FROM foo f WHERE ( x = ? ) " .
+         ") " .
+     ") WHERE oracle_rownum_XYZZY >= 4 AND oracle_rownum_XYZZY <= 13",
+     'something'],
+    'Oracle select statement format'
+);
+
+
+#-- No limits regular
+$query = DBIx::ObjectMapper::SQL->select
+                ->column(['g', 'h'], ['i'])
+                ->from(['foo', 'f'])
+                ->where(['x', '=', 'something']);
+
+is_deeply(
+    [$query->as_sql],
+    ["SELECT g AS h, i FROM foo AS f WHERE ( x = ? )", 'something'],
+    'Default no limits select statement format'
+);
+
+
+#-- No limits Oracle
+$query->{driver} = 'Oracle';
+
+is_deeply(
+    [$query->as_sql],
+    ["SELECT g h, i FROM foo f WHERE ( x = ? )", 'something'],
+    'Oracle no limits select statement format'
+);
+
+
+done_testing;
+

From 8602f415e6a4e2072cebf8bb965a0f4697b815d5 Mon Sep 17 00:00:00 2001
From: William Schroeder <wschroed@genome.wustl.edu>
Date: Tue, 26 Aug 2014 11:48:14 -0500
Subject: [PATCH 35/35] Performed cartesian join of column info in Perl instead
 of Oracle.

Oracle's ALL_CONSTRAINTS and ALL_CONS_COLUMNS tables are not indexed or
optimized for query.  DBD::Oracle's foreign_key_info can take anywhere between
4 to 18 seconds to get information for a single table, which is dreadfully
unacceptable when one has a database with almost 1000 tables.  This new
algorithm sacrifices some client memory in exchange for an 11x speedup.
---
 .../ObjectMapper/Engine/DBI/Driver/Oracle.pm  | 180 +++++++++++-------
 1 file changed, 107 insertions(+), 73 deletions(-)

diff --git a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
index a43d792..aecc9cd 100644
--- a/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
+++ b/lib/DBIx/ObjectMapper/Engine/DBI/Driver/Oracle.pm
@@ -83,26 +83,7 @@ sub get_table_fk_info {
     my ($self, $dbh, $table) = @_;
 
     if (!$self->{_cache}->{_oracle}->{foreign_keys}->{$table}) {
-        #my $sth = $dbh->foreign_key_info(undef, undef, undef, '', $self->db_schema, $table);
-        my $sth = $self->_foreign_key_info($dbh,undef, undef, undef, '', $self->db_schema, $table);
-        my %constraints = ();
-
-        while (my $row = $sth->fetchrow_hashref) {
-            my $constraint_name = $row->{FK_NAME};
-            if (!$constraints{$constraint_name}) {
-                $constraints{$constraint_name} = {
-                    keys  => [],
-                    refs  => [],
-                    table => $row->{UK_TABLE_NAME},
-                };
-            }
-
-            my $constraint_info = $constraints{$constraint_name};
-            push @{$constraint_info->{keys}}, $row->{FK_COLUMN_NAME};
-            push @{$constraint_info->{refs}}, $row->{UK_COLUMN_NAME};
-        }
-
-        $self->{_cache}->{_oracle}->{foreign_keys}->{$table} = [values %constraints];
+        $self->{_cache}->{_oracle}->{foreign_keys}->{$table} = $self->_foreign_key_info($dbh,undef, undef, undef, '', $self->db_schema, $table);
     }
 
     return $self->{_cache}->{_oracle}->{foreign_keys}->{$table};
@@ -188,10 +169,7 @@ sub type_map {
     return $class->_type_map_data->{$type};
 }
 
-###### horrid DBD::Oracle override below 
-###### REMOVE WHEN PERL IS UPGRADED!!!!!
-###### code base from DBD::Oracle v1.68
-
+###### DBD::Oracle override below because DBD::Oracle is inefficient for large schemas
 sub _primary_key_info {
     my($self, $dbh, $catalog, $schema, $table) = @_;
     if (ref $catalog eq 'HASH') {
@@ -226,61 +204,117 @@ SQL
     $sth;
 }
 
+sub build_constraint_cache {
+    my ($self, $dbh, $attr) = @_;
+    my $cache = {};
+    my $sth;
+
+    $sth = $dbh->prepare(q{
+        select OWNER, R_OWNER, TABLE_NAME, CONSTRAINT_NAME, R_CONSTRAINT_NAME, CONSTRAINT_TYPE
+          from ALL_CONSTRAINTS
+          where CONSTRAINT_TYPE in ('P','U', 'R')
+    }) or return undef;
+    $sth->execute() or return undef;
+    $cache->{constraints} = [map {
+                                +{
+                                    OWNER             => $_->[0],
+                                    R_OWNER           => $_->[1],
+                                    TABLE_NAME        => $_->[2],
+                                    CONSTRAINT_NAME   => $_->[3],
+                                    R_CONSTRAINT_NAME => $_->[4],
+                                    CONSTRAINT_TYPE   => $_->[5],
+                                }
+                            }
+                            @{$sth->fetchall_arrayref}];
+
+    $sth = $dbh->prepare(q{
+        select OWNER, CONSTRAINT_NAME, COLUMN_NAME, POSITION
+          from ALL_CONS_COLUMNS
+         order by POSITION
+    }) or return undef;
+    $sth->execute() or return undef;
+    $cache->{columns} = [map {
+                                +{
+                                    OWNER           => $_->[0],
+                                    CONSTRAINT_NAME => $_->[1],
+                                    COLUMN_NAME     => $_->[2],
+                                    POSITION        => $_->[3],
+                                }
+                            }
+                        @{$sth->fetchall_arrayref}];
+
+    $self->{_constraint_cache} = $cache;
+    return 1;
+}
+
 sub _foreign_key_info {
     my $self = shift;
     my $dbh  = shift;
     my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
-        'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2]
-            ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] };
-    my $SQL = <<'SQL';  # XXX: DEFERABILITY
-SELECT *
-  FROM
-(
-  SELECT /*+ CHOOSE */
-         to_char( NULL )    UK_TABLE_CAT
-       , uk.OWNER           UK_TABLE_SCHEM
-       , uk.TABLE_NAME      UK_TABLE_NAME
-       , uc.COLUMN_NAME     UK_COLUMN_NAME
-       , to_char( NULL )    FK_TABLE_CAT
-       , fk.OWNER           FK_TABLE_SCHEM
-       , fk.TABLE_NAME      FK_TABLE_NAME
-       , fc.COLUMN_NAME     FK_COLUMN_NAME
-       , uc.POSITION        ORDINAL_POSITION
-       , 3                  UPDATE_RULE
-       , decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 )
-                            DELETE_RULE
-       , fk.CONSTRAINT_NAME FK_NAME
-       , uk.CONSTRAINT_NAME UK_NAME
-       , to_char( NULL )    DEFERABILITY
-       , decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE')
-                            UNIQUE_OR_PRIMARY
-    FROM ALL_CONSTRAINTS    uk
-       , ALL_CONS_COLUMNS   uc
-       , ALL_CONSTRAINTS    fk
-       , ALL_CONS_COLUMNS   fc
-   WHERE uk.OWNER            = uc.OWNER
-     AND uk.CONSTRAINT_NAME  = uc.CONSTRAINT_NAME
-     AND fk.OWNER            = fc.OWNER
-     AND fk.CONSTRAINT_NAME  = fc.CONSTRAINT_NAME
-     AND uk.CONSTRAINT_TYPE IN ('P','U')
-     AND fk.CONSTRAINT_TYPE  = 'R'
-     AND uk.CONSTRAINT_NAME  = fk.R_CONSTRAINT_NAME
-     AND uk.OWNER            = fk.R_OWNER
-     AND uc.POSITION         = fc.POSITION
-)
- WHERE 1              = 1
-SQL
-    my @BindVals = ();
-    while ( my ( $k, $v ) = each %$attr ) {
-        if ( $v ) {
-            $SQL .= "   AND $k = ?\n";
-            push @BindVals, $v;
+        'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME' => $_[2]
+            ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME' => $_[5] };
+
+    if (!$self->{_constraint_cache}) {
+        return unless $self->build_constraint_cache($dbh, $attr);
+    }
+
+    my @constraints = grep {
+                          ($_->{CONSTRAINT_TYPE} eq 'R') &&
+                          ($_->{R_CONSTRAINT_NAME}) &&
+                          ($_->{OWNER} eq $attr->{FK_TABLE_SCHEM}) &&
+                          ($_->{TABLE_NAME} eq $attr->{FK_TABLE_NAME})
+                      }
+                      @{$self->{_constraint_cache}->{constraints}};
+
+    for my $constraint (@constraints) {
+        next if $constraint->{columns};
+
+        my ($foreign_table) = map { $_->{TABLE_NAME} }
+                              grep {
+                                  ($_->{CONSTRAINT_TYPE} eq 'P' || $_->{CONSTRAINT_TYPE} eq 'U') &&
+                                  $_->{OWNER} eq $constraint->{R_OWNER} &&
+                                  $_->{CONSTRAINT_NAME} eq $constraint->{R_CONSTRAINT_NAME} &&
+                                  ($attr->{UK_TABLE_NAME} ? ($_->{TABLE_NAME} eq $attr->{UK_TABLE_NAME}) : 1)
+                              } @{$self->{_constraint_cache}->{constraints}};
+
+        my @fk_columns = sort {$a->{POSITION} <=> $b->{POSITION}}
+                         map {
+                             +{
+                                 foreign_table => $foreign_table,
+                                 %$_
+                             }
+                         }
+                         grep {
+                             $_->{OWNER} eq $attr->{FK_TABLE_SCHEM} &&
+                             $_->{CONSTRAINT_NAME} eq $constraint->{CONSTRAINT_NAME}
+                         }
+                         @{$self->{_constraint_cache}->{columns}};
+
+        for my $fk_column (@fk_columns) {
+            next if $fk_column->{foreign_column};
+            ($fk_column->{foreign_column}) = map { $_->{COLUMN_NAME} }
+                                             grep {
+                                                 $_->{OWNER} eq $constraint->{R_OWNER} &&
+                                                 $_->{CONSTRAINT_NAME} eq $constraint->{R_CONSTRAINT_NAME} &&
+                                                 $_->{POSITION} eq $fk_column->{POSITION}
+                                             }
+                                             @{$self->{_constraint_cache}->{columns}};
         }
+
+        $constraint->{columns} = \@fk_columns;
     }
-    $SQL .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n";
-    my $sth = $dbh->prepare( $SQL ) or return undef;
-    $sth->execute( @BindVals ) or return undef;
-    $sth;
+
+    my @final_constraints = map {
+                                my $constraint = $_;
+                                +{
+                                    table => $constraint->{columns}[0]->{foreign_table},
+                                    keys  => [map {$_->{COLUMN_NAME}} @{$constraint->{columns}}],
+                                    refs  => [map {$_->{foreign_column}} @{$constraint->{columns}}],
+                                }
+                            }
+                            @constraints;
+
+    return \@final_constraints;
 }
 
 1;