sqlmaker side of PRIOR support
Matt S Trout [Sun, 17 Mar 2013 21:48:27 +0000 (21:48 +0000)]
lib/DBIx/Class/SQLMaker/Converter/Oracle.pm [new file with mode: 0644]
lib/DBIx/Class/SQLMaker/Oracle.pm

diff --git a/lib/DBIx/Class/SQLMaker/Converter/Oracle.pm b/lib/DBIx/Class/SQLMaker/Converter/Oracle.pm
new file mode 100644 (file)
index 0000000..e636d6d
--- /dev/null
@@ -0,0 +1,30 @@
+package DBIx::Class::SQLMaker::Converter::Oracle;
+
+use Moo;
+
+extends 'DBIx::Class::SQLMaker::Converter';
+
+around _where_hashpair_to_dq => sub {
+  my ($orig, $self) = (shift, shift);
+  my ($k, $v, $logic) = @_;
+  if (ref($v) eq 'HASH' and (keys %$v == 1) and lc((keys %$v)[0]) eq '-prior') {
+    my $rhs = $self->_expr_to_dq((values %$v)[0]);
+    return $self->_op_to_dq(
+      $self->{cmp}, $self->_ident_to_dq($k), $self->_op_to_dq(PRIOR => $rhs)
+    );
+  } else {
+    return $self->$orig(@_);
+  }
+};
+
+around _apply_to_dq => sub {
+  my ($orig, $self) = (shift, shift);
+  my ($op, $v) = @_;
+  if ($op eq 'PRIOR') {
+    return $self->_op_to_dq(PRIOR => $self->_expr_to_dq($v));
+  } else {
+    return $self->$orig(@_);
+  }
+};
+
+1;
index 7548c2a..9791dcd 100644 (file)
@@ -1,10 +1,10 @@
 package # Hide from PAUSE
   DBIx::Class::SQLMaker::Oracle;
 
-use warnings;
-use strict;
+use Module::Runtime ();
+use Moo;
 
-use base qw( DBIx::Class::SQLMaker );
+extends 'DBIx::Class::SQLMaker';
 
 BEGIN {
   use DBIx::Class::Optional::Dependencies;
@@ -12,17 +12,18 @@ BEGIN {
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('id_shortener');
 }
 
-sub new {
-  my $self = shift;
-  my %opts = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
-  push @{$opts{special_ops}}, {
-    regex => qr/^prior$/i,
-    handler => '_where_field_PRIOR',
-  };
-
-  $self->next::method(\%opts);
+sub _build_converter_class {
+  Module::Runtime::use_module('DBIx::Class::SQLMaker::Converter::Oracle');
 }
 
+around _build_renderer_roles => sub {
+  my ($orig, $self) = (shift, shift);
+  (
+    'Data::Query::Renderer::SQL::Extension::ConnectBy',
+    $self->$orig(@_),
+  );
+};
+
 sub _assemble_binds {
   my $self = shift;
   return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where oracle_connect_by group having order limit/);