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 | |
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 |