X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker%2FOracle.pm;h=7548c2a8abc41470cbaf6f72f82b85f236812506;hb=2d841fdcd476a0556da75626f56d927668208d50;hp=0a773e7ad063a65666268182e63fa157ed8e03b6;hpb=d5dedbd62928f65a9071b4d9b6d56c6b663a073b;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/SQLMaker/Oracle.pm b/lib/DBIx/Class/SQLMaker/Oracle.pm
index 0a773e7..7548c2a 100644
--- a/lib/DBIx/Class/SQLMaker/Oracle.pm
+++ b/lib/DBIx/Class/SQLMaker/Oracle.pm
@@ -5,7 +5,12 @@ use warnings;
 use strict;
 
 use base qw( DBIx::Class::SQLMaker );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+
+BEGIN {
+  use DBIx::Class::Optional::Dependencies;
+  die('The following extra modules are required for Oracle-based Storages ' . DBIx::Class::Optional::Dependencies->req_missing_for ('id_shortener') . "\n" )
+    unless DBIx::Class::Optional::Dependencies->req_ok_for ('id_shortener');
+}
 
 sub new {
   my $self = shift;
@@ -15,12 +20,12 @@ sub new {
     handler => '_where_field_PRIOR',
   };
 
-  $self->SUPER::new (\%opts);
+  $self->next::method(\%opts);
 }
 
 sub _assemble_binds {
   my $self = shift;
-  return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/from where oracle_connect_by having order/);
+  return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where oracle_connect_by group having order limit/);
 }
 
 
@@ -31,7 +36,7 @@ sub _parse_rs_attrs {
     my ($cb_sql, @cb_bind) = $self->_connect_by($rs_attrs);
     push @{$self->{oracle_connect_by_bind}}, @cb_bind;
 
-    my $sql = $self->SUPER::_parse_rs_attrs(@_);
+    my $sql = $self->next::method(@_);
 
     return "$cb_sql $sql";
 }
@@ -70,13 +75,13 @@ sub _order_siblings_by {
 
     my ( @sql, @bind );
     for my $c ( $self->_order_by_chunks($arg) ) {
-        $self->_SWITCH_refkind(
-            $c,
-            {
-                SCALAR   => sub { push @sql, $c },
-                ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
-            }
-        );
+        if (ref $c) {
+            push @sql, shift @$c;
+            push @bind, @$c;
+        }
+        else {
+            push @sql, $c;
+        }
     }
 
     my $sql =
@@ -102,6 +107,19 @@ sub _where_field_PRIOR {
   return ($sql, @bind);
 }
 
+# use this codepath to hook all identifiers and mangle them if necessary
+# this is invoked regardless of quoting being on or off
+sub _quote {
+  my ($self, $label) = @_;
+
+  return '' unless defined $label;
+  return ${$label} if ref($label) eq 'SCALAR';
+
+  $label =~ s/ ( [^\.]{31,} ) /$self->_shorten_identifier($1)/gxe;
+
+  $self->next::method($label);
+}
+
 # this takes an identifier and shortens it if necessary
 # optionally keywords can be passed as an arrayref to generate useful
 # identifiers
@@ -118,7 +136,7 @@ sub _shorten_identifier {
   return $to_shorten
     if length($to_shorten) <= $max_len;
 
-  croak 'keywords needs to be an arrayref'
+  $self->throw_exception("'keywords' needs to be an arrayref")
     if defined $keywords && ref $keywords ne 'ARRAY';
 
   # if no keywords are passed use the identifier as one
@@ -183,4 +201,57 @@ sub _unqualify_colname {
   return $self->_shorten_identifier($self->next::method($fqcn));
 }
 
+#
+# Oracle has a different INSERT...RETURNING syntax
+#
+
+sub _insert_returning {
+  my ($self, $options) = @_;
+
+  my $f = $options->{returning};
+
+  my ($f_list, @f_names) = do {
+    if (! ref $f) {
+      (
+        $self->_quote($f),
+        $f,
+      )
+    }
+    elsif (ref $f eq 'ARRAY') {
+      (
+        (join ', ', map { $self->_quote($_) } @$f),
+        @$f,
+      )
+    }
+    elsif (ref $f eq 'SCALAR') {
+      (
+        $$f,
+        $$f,
+      )
+    }
+    else {
+      $self->throw_exception("Unsupported INSERT RETURNING option $f");
+    }
+  };
+
+  my $rc_ref = $options->{returning_container}
+    or $self->throw_exception('No returning container supplied for IR values');
+
+  @$rc_ref = (undef) x @f_names;
+
+  return (
+    ( join (' ',
+      $self->_sqlcase(' returning'),
+      $f_list,
+      $self->_sqlcase('into'),
+      join (', ', ('?') x @f_names ),
+    )),
+    map {
+      $self->{bindtype} eq 'columns'
+        ? [ $f_names[$_] => \$rc_ref->[$_] ]
+        : \$rc_ref->[$_]
+    } (0 .. $#f_names),
+  );
+}
+
 1;