1 package # Hide from PAUSE
2 DBIx::Class::SQLAHacks::Oracle;
4 use base qw( DBIx::Class::SQLAHacks );
5 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
9 # - Problems with such statements: parentid != PRIOR artistid
10 # - Check the parameter syntax of connect_by
11 # - Review review by experienced DBIC/SQL:A developers :-)
15 my $self = shift->SUPER::new(@_);
17 push @{ $self->{unary_ops} },{
19 handler => '_prior_as_unary_op',
22 push @{ $self->{special_ops} },{
24 handler => '_prior_as_special_op',
32 my ($self, $table, $fields, $where, $order, @rest) = @_;
34 $self->{_db_specific_attrs} = pop @rest;
36 my ($sql, @bind) = $self->SUPER::select($table, $fields, $where, $order, @rest);
37 push @bind, @{$self->{_oracle_connect_by_binds}};
39 return wantarray ? ($sql, @bind) : $sql;
43 my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_;
45 my ($cb_sql, @cb_bind) = $self->_connect_by();
47 $self->{_oracle_connect_by_binds} = \@cb_bind;
49 return $self->SUPER::_emulate_limit($syntax, $sql, $order, $rows, $offset);
54 my $attrs = $self->{_db_specific_attrs};
58 if ( ref($attrs) eq 'HASH' ) {
59 if ( $attrs->{'start_with'} ) {
60 my ($ws, @wb) = $self->_recurse_where( $attrs->{'start_with'} );
61 $sql .= $self->_sqlcase(' start with ') . $ws;
64 if ( my $connect_by = $attrs->{'connect_by'}) {
65 my ($connect_by_sql, @connect_by_sql_bind) = $self->_recurse_where( $attrs->{'connect_by'} );
66 $sql .= sprintf(" %s %s",
67 $self->_sqlcase('connect by'),
70 push @bind, @connect_by_sql_bind;
71 # $sql .= $self->_sqlcase(' connect by');
72 # foreach my $key ( keys %$connect_by ) {
73 # $sql .= " $key = " . $connect_by->{$key};
76 if ( $attrs->{'order_siblings_by'} ) {
77 $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} );
81 return wantarray ? ($sql, @bind) : $sql;
84 sub _order_siblings_by {
88 my @vals = $ref eq 'ARRAY' ? @{$_[0]} :
89 $ref eq 'SCALAR' ? ${$_[0]} :
91 puke( "Unsupported data struct $ref for ORDER SIBILINGS BY" );
93 my $val = join ', ', map { $self->_quote($_) } @vals;
94 return $val ? $self->_sqlcase(' order siblings by')." $val" : '';
97 sub _prior_as_special_op {
98 my ( $self, $field, $op, $arg ) = @_;
100 my ( $label, $and, $placeholder );
101 $label = $self->_convert( $self->_quote($field) );
102 $and = ' ' . $self->_sqlcase('and') . ' ';
103 $placeholder = $self->_convert('?');
105 # TODO: $op is prior, and not the operator
106 $op = $self->_sqlcase('=');
108 my ( $sql, @bind ) = $self->_SWITCH_refkind(
112 my $sql = sprintf( "%s %s PRIOR %s", $label, $op, $$arg );
116 my $sql = sprintf( "%s %s PRIOR %s", $label, $op, $placeholder );
117 return ( $sql, $arg );
119 HASHREF => sub { # case { '-prior' => { '=<' => 'nwiger'} }
120 # no _convert and _quote from SCALARREF
121 my ( $sql, @bind ) = $self->_where_hashpair_HASHREF( $field, $arg, $op );
122 $sql = sprintf( " PRIOR %s", $sql );
123 return ( $sql, @bind );
127 $self->puke(" wrong way... :/");
131 return ( $sql, @bind );
134 sub _prior_as_unary_op {
135 my ( $self, $op, $arg ) = @_;
137 my $placeholder = $self->_convert('?');
138 my $and = ' ' . $self->_sqlcase('and') . ' ';
140 my ( $sql, @bind ) = $self->_SWITCH_refkind(
144 $self->puke("special op 'prior' accepts an arrayref with exactly two values")
147 my ( @all_sql, @all_bind );
149 foreach my $val ( @{$arg} ) {
150 my ( $sql, @bind ) = $self->_SWITCH_refkind($val,
153 return ( $placeholder, ($val) );
156 return ( $$val, () );
161 push @all_bind, @bind;
163 my $sql = sprintf("PRIOR %s ",join $self->_sqlcase('='), @all_sql);
164 return ($sql,@all_bind);
169 $self->puke(" wrong way... :/ ");
173 return ( $sql, @bind );
184 DBIx::Class::SQLAHacks::Oracle - adds hierarchical query support for Oracle to SQL::Abstract
188 See L<DBIx::Class::Storage::DBI::Oracle::Generic> for more informations about
189 how to use hierarchical queries with DBIx::Class.