lib/DBIx/Class/SQLAHacks/Oracle.pm

   1 package # Hide from PAUSE
   2   DBIx::Class::SQLAHacks::Oracle;
   3
   4 use base qw( DBIx::Class::SQLAHacks );
   5 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
   6
   7 sub select {
   8     my ($self, $table, $fields, $where, $order, @rest) = @_;
   9
  10     $self->{_db_specific_attrs} = pop @rest;
  11
  12     my ($sql, @bind) = $self->SUPER::select($table, $fields, $where, $order, @rest);
  13     push @bind, @{$self->{_oracle_connect_by_binds}};
  14
  15     return wantarray ? ($sql, @bind) : $sql;
  16 }
  17
  18 sub _emulate_limit {
  19     my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_;
  20
  21     my ($cb_sql, @cb_bind) = $self->_connect_by();
  22     $sql .= $cb_sql;
  23     $self->{_oracle_connect_by_binds} = \@cb_bind;
  24
  25     return $self->SUPER::_emulate_limit($syntax, $sql, $order, $rows, $offset);
  26 }
  27
  28 sub _connect_by {
  29     my ($self) = @_;
  30     my $attrs = $self->{_db_specific_attrs};
  31     my $sql = '';
  32     my @bind;
  33
  34     if ( ref($attrs) eq 'HASH' ) {
  35         if ( $attrs->{'start_with'} ) {
  36             my ($ws, @wb) = $self->_recurse_where( $attrs->{'start_with'} );
  37             $sql .= $self->_sqlcase(' start with ') . $ws;
  38             push @bind, @wb;
  39         }
  40         if ( my $connect_by = $attrs->{'connect_by'}) {
  41             $sql .= $self->_sqlcase(' connect by');
  42             foreach my $key ( keys %$connect_by ) {
  43                 $sql .= " $key = " . $connect_by->{$key};
  44             }
  45         }
  46         if ( $attrs->{'order_siblings_by'} ) {
  47             $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} );
  48         }
  49     }
  50
  51     return wantarray ? ($sql, @bind) : $sql;
  52 }
  53
  54 sub _order_siblings_by {
  55     my $self = shift;
  56     my $ref = ref $_[0];
  57
  58     my @vals = $ref eq 'ARRAY'  ? @{$_[0]} :
  59                $ref eq 'SCALAR' ? ${$_[0]} :
  60                $ref eq ''       ? $_[0]    :
  61                puke( "Unsupported data struct $ref for ORDER SIBILINGS BY" );
  62
  63     my $val = join ', ', map { $self->_quote($_) } @vals;
  64     return $val ? $self->_sqlcase(' order siblings by')." $val" : '';
  65 }
  66
  67 1;
  68
  69 __END__
  70
  71 =pod
  72
  73 =head1 NAME
  74
  75 DBIx::Class::SQLAHacks::Oracle - adds hierarchical query support for Oracle to SQL::Abstract
  76
  77 =head1 DESCRIPTION
  78
  79 See L<DBIx::Class::Storage::DBI::Oracle::Generic> for more informations about
  80 how to use hierarchical queries with DBIx::Class.
  81
  82 =cut