Commit | Line | Data |
c0024355 |
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 | |
43426175 |
7 | # |
8 | # TODO: |
43426175 |
9 | # - Check the parameter syntax of connect_by |
2df1857d |
10 | # - Review by experienced DBIC/SQL:A developers :-) |
11 | # - Check NOCYCLE parameter |
12 | # http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/pseudocolumns001.htm#i1009434 |
43426175 |
13 | # |
14 | |
c0024355 |
15 | sub select { |
16 | my ($self, $table, $fields, $where, $order, @rest) = @_; |
17 | |
18 | $self->{_db_specific_attrs} = pop @rest; |
19 | |
20 | my ($sql, @bind) = $self->SUPER::select($table, $fields, $where, $order, @rest); |
21 | push @bind, @{$self->{_oracle_connect_by_binds}}; |
22 | |
23 | return wantarray ? ($sql, @bind) : $sql; |
24 | } |
25 | |
26 | sub _emulate_limit { |
27 | my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_; |
28 | |
29 | my ($cb_sql, @cb_bind) = $self->_connect_by(); |
30 | $sql .= $cb_sql; |
31 | $self->{_oracle_connect_by_binds} = \@cb_bind; |
32 | |
33 | return $self->SUPER::_emulate_limit($syntax, $sql, $order, $rows, $offset); |
34 | } |
35 | |
36 | sub _connect_by { |
37 | my ($self) = @_; |
38 | my $attrs = $self->{_db_specific_attrs}; |
39 | my $sql = ''; |
40 | my @bind; |
41 | |
42 | if ( ref($attrs) eq 'HASH' ) { |
43 | if ( $attrs->{'start_with'} ) { |
44 | my ($ws, @wb) = $self->_recurse_where( $attrs->{'start_with'} ); |
45 | $sql .= $self->_sqlcase(' start with ') . $ws; |
46 | push @bind, @wb; |
47 | } |
48 | if ( my $connect_by = $attrs->{'connect_by'}) { |
43426175 |
49 | my ($connect_by_sql, @connect_by_sql_bind) = $self->_recurse_where( $attrs->{'connect_by'} ); |
50 | $sql .= sprintf(" %s %s", |
51 | $self->_sqlcase('connect by'), |
52 | $connect_by_sql, |
53 | ); |
54 | push @bind, @connect_by_sql_bind; |
55 | # $sql .= $self->_sqlcase(' connect by'); |
56 | # foreach my $key ( keys %$connect_by ) { |
57 | # $sql .= " $key = " . $connect_by->{$key}; |
58 | # } |
c0024355 |
59 | } |
60 | if ( $attrs->{'order_siblings_by'} ) { |
61 | $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} ); |
62 | } |
63 | } |
64 | |
65 | return wantarray ? ($sql, @bind) : $sql; |
66 | } |
67 | |
68 | sub _order_siblings_by { |
2a770efe |
69 | my ( $self, $arg ) = @_; |
70 | |
71 | my ( @sql, @bind ); |
72 | for my $c ( $self->_order_by_chunks($arg) ) { |
73 | $self->_SWITCH_refkind( |
74 | $c, |
75 | { |
76 | SCALAR => sub { push @sql, $c }, |
77 | ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c }, |
78 | } |
79 | ); |
80 | } |
c0024355 |
81 | |
2a770efe |
82 | my $sql = |
83 | @sql |
84 | ? sprintf( '%s %s', $self->_sqlcase(' order siblings by'), join( ', ', @sql ) ) |
85 | : ''; |
c0024355 |
86 | |
2a770efe |
87 | return wantarray ? ( $sql, @bind ) : $sql; |
c0024355 |
88 | } |
89 | |
90 | 1; |
91 | |
92 | __END__ |
93 | |
94 | =pod |
95 | |
96 | =head1 NAME |
97 | |
98 | DBIx::Class::SQLAHacks::Oracle - adds hierarchical query support for Oracle to SQL::Abstract |
99 | |
100 | =head1 DESCRIPTION |
101 | |
102 | See L<DBIx::Class::Storage::DBI::Oracle::Generic> for more informations about |
103 | how to use hierarchical queries with DBIx::Class. |
104 | |
105 | =cut |