lib/DBIx/Class/SQLAHacks/Oracle.pm

   1 package # Hide from PAUSE
   2   DBIx::Class::SQLAHacks::Oracle;
   3
   4 use warnings;
   5 use strict;
   6
   7 use base qw( DBIx::Class::SQLAHacks );
   8 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
   9
  10 #
  11 #  TODO:
  12 #   - Review by experienced DBIC/SQL:A developers :-)
  13 #   - Problem with count and connect_by look the TODO in t/73oracle.t
  14 #
  15
  16 sub new {
  17   my $self = shift;
  18   my %opts = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
  19   push @{$opts{special_ops}}, {
  20     regex => qr/^prior$/i,
  21     handler => '_where_field_PRIOR',
  22   };
  23
  24   $self->SUPER::new (\%opts);
  25 }
  26
  27 sub select {
  28     my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
  29
  30     my $sql = $self->SUPER::select($table, $fields, $where, $rs_attrs, @rest);
  31
  32     return wantarray ? ($sql, @{$self->{from_bind}}, @{$self->{where_bind}}, @{$self->{_oracle_connect_by_binds}}, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql;
  33 }
  34
  35 sub _emulate_limit {
  36     my ( $self, $syntax, $sql, $rs_attrs, $rows, $offset ) = @_;
  37
  38     my ($cb_sql, @cb_bind) = $self->_connect_by($rs_attrs);
  39     $sql .= $cb_sql;
  40     $self->{_oracle_connect_by_binds} = \@cb_bind;
  41
  42     return $self->SUPER::_emulate_limit($syntax, $sql, $rs_attrs, $rows, $offset);
  43 }
  44
  45 sub _connect_by {
  46     my ($self, $attrs) = @_;
  47
  48     my $sql = '';
  49     my @bind;
  50
  51     if ( ref($attrs) eq 'HASH' ) {
  52         if ( $attrs->{'start_with'} ) {
  53             my ($ws, @wb) = $self->_recurse_where( $attrs->{'start_with'} );
  54             $sql .= $self->_sqlcase(' start with ') . $ws;
  55             push @bind, @wb;
  56         }
  57         if ( my $connect_by = $attrs->{'connect_by'} || $attrs->{'connect_by_nocycle'} ) {
  58             my ($connect_by_sql, @connect_by_sql_bind) = $self->_recurse_where( $connect_by );
  59             $sql .= sprintf(" %s %s",
  60                 ( $attrs->{'connect_by_nocycle'} ) ? $self->_sqlcase('connect by nocycle')
  61                     : $self->_sqlcase('connect by'),
  62                 $connect_by_sql,
  63             );
  64             push @bind, @connect_by_sql_bind;
  65         }
  66         if ( $attrs->{'order_siblings_by'} ) {
  67             $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} );
  68         }
  69     }
  70
  71     return wantarray ? ($sql, @bind) : $sql;
  72 }
  73
  74 sub _order_siblings_by {
  75     my ( $self, $arg ) = @_;
  76
  77     my ( @sql, @bind );
  78     for my $c ( $self->_order_by_chunks($arg) ) {
  79         $self->_SWITCH_refkind(
  80             $c,
  81             {
  82                 SCALAR   => sub { push @sql, $c },
  83                 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
  84             }
  85         );
  86     }
  87
  88     my $sql =
  89       @sql
  90       ? sprintf( '%s %s', $self->_sqlcase(' order siblings by'), join( ', ', @sql ) )
  91       : '';
  92
  93     return wantarray ? ( $sql, @bind ) : $sql;
  94 }
  95
  96 # we need to add a '=' only when PRIOR is used against a column diretly
  97 # i.e. when it is invoked by a special_op callback
  98 sub _where_field_PRIOR {
  99   my ($self, $lhs, $op, $rhs) = @_;
 100   my ($sql, @bind) = $self->_recurse_where ($rhs);
 101
 102   $sql = sprintf ('%s = %s %s ',
 103     $self->_convert($self->_quote($lhs)),
 104     $self->_sqlcase ($op),
 105     $sql
 106   );
 107
 108   return ($sql, @bind);
 109 }
 110
 111 1;
 112
 113 __END__
 114
 115 =pod
 116
 117 =head1 NAME
 118
 119 DBIx::Class::SQLAHacks::Oracle - adds hierarchical query support for Oracle to SQL::Abstract
 120
 121 =head1 DESCRIPTION
 122
 123 See L<DBIx::Class::Storage::DBI::Oracle::Generic> for more informations about
 124 how to use hierarchical queries with DBIx::Class.
 125
 126 =cut