Implemented Oracle support and a minor speed improvement

META.yml

@@ -39,10 +39,8 @@ 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
   Params::Validate: 0
   Scalar::Util: 0
   Sub::Exporter: 0

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';
@@ -31,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;

lib/DBIx/ObjectMapper/Engine.pm

@@ -35,6 +35,7 @@ sub update                   { }
 sub insert                   { }
 sub create                   { }
 sub delete                   { }
+sub union                    { }
 sub iterator                 { }
 
 1;

lib/DBIx/ObjectMapper/Engine/DBI.pm

@@ -21,13 +21,15 @@ 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' ) {
         @connect_info = @$param[ 0 .. 2 ];
         $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},
@@ -47,7 +49,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;
     }
 
@@ -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} } );
+            }
         }
     };
 
@@ -175,13 +183,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}
@@ -200,10 +209,17 @@ 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;
+            $self->txn_rollback;
         }
         $dbh->disconnect;
         $self->log_connect('DISCONNECT');
@@ -466,7 +482,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 +522,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 +541,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 : +{};
@@ -565,6 +586,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 {  }
 
@@ -671,6 +702,7 @@ DBIx::ObjectMapper::Engine::DBI - the DBI engine
      on_connect_do => [],
      on_disconnect_do => [],
      db_schema => 'public',
+     connect_identifier => undef,
      namesep => '.',
      quote => '"',
      iterator => '',
@@ -692,6 +724,7 @@ DBIx::ObjectMapper::Engine::DBI - the DBI engine
         on_connect_do => [],
         on_disconnect_do => [],
         db_schema => 'public',
+        connect_identifier => undef,
         namesep => '.',
         quote => '"',
         iterator => '',

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;

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 { }
 
@@ -229,4 +230,77 @@ sub release_savepoint {}
 
 sub rollback_savepoint {}
 
+sub bind_params { my ($self, $sth, @binds) = @_; @binds }
+
+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;