| Subject: | [patch] hierarchical queries - oracle specific |
Oracle supports a Oracle specific syntax to run hierarchical queries:
http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/queries003.htm
This patch enables the Oracle storage modul to handle the
resultset-attributes 'connect_by', 'start_with', and
'order_siblings_by'. This makes it possible to run hierarchical queries
through DBIx::Class.
| Subject: | oracle-hierarchical-queries.patch |
diff -Nurb DBIx-Class-0.08010-orig/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm DBIx-Class-0.08010/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
--- DBIx-Class-0.08010-orig/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2007-09-04 20:33:11.000000000 +0200
+++ DBIx-Class-0.08010/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2008-09-09 16:47:57.000000000 +0200
@@ -4,9 +4,69 @@
use strict;
use warnings;
+__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract::Oracle');
+
+BEGIN {
+ package DBIC::SQL::Abstract::Oracle;
+
+ use base qw( DBIC::SQL::Abstract );
+
+ sub select {
+ my ($self, $table, $fields, $where, $order, @rest) = @_;
+
+ my $db_specific_attrs = pop @rest;
+
+ my ($sql, @bind) = $self->SUPER::select($table, $fields, $where, $order, @rest);
+ my ($cb_sql, @cb_bind) = $self->_connect_by($db_specific_attrs);
+ $sql .= $cb_sql;
+ push @bind, @cb_bind;
+
+ return wantarray ? ($sql, @bind) : $sql;
+ }
+
+ sub _connect_by {
+ my ($self, $attrs) = @_;
+ my $sql = '';
+ my @bind;
+
+ if ( ref($attrs) eq 'HASH' ) {
+ if ( $attrs->{'start_with'} ) {
+ my ($ws, @wb) = $self->_recurse_where( $attrs->{'start_with'} );
+ $sql .= $self->_sqlcase(' start with ') . $ws;
+ push @bind, @wb;
+ }
+ if ( my $connect_by = $attrs->{'connect_by'}) {
+ $sql .= $self->_sqlcase(' connect by');
+ foreach my $key ( keys %$connect_by ) {
+ $sql .= " $key = " . $connect_by->{$key};
+ }
+ }
+ if ( $attrs->{'order_siblings_by'} ) {
+ $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} );
+ }
+ }
+
+ return wantarray ? ($sql, @bind) : $sql;
+ }
+
+ sub _order_siblings_by {
+ my $self = shift;
+ my $ref = ref $_[0];
+
+ my @vals = $ref eq 'ARRAY' ? @{$_[0]} :
+ $ref eq 'SCALAR' ? ${$_[0]} :
+ $ref eq '' ? $_[0] :
+ puke( "Unsupported data struct $ref for ORDER SIBILINGS BY" );
+
+ my $val = join ', ', map { $self->_quote($_) } @vals;
+ return $val ? $self->_sqlcase(' order siblings by')." $val" : '';
+ }
+
+} # end of BEGIN - package DBIC::SQL::Abstract::Oracle
+
=head1 NAME
-DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
+DBIx::Class::Storage::DBI::Oracle - Automatic primary key class and "Connect By" support for Oracle
=head1 SYNOPSIS
@@ -15,12 +75,67 @@
__PACKAGE__->set_primary_key('id');
__PACKAGE__->sequence('mysequence');
+ # with a resultset using a hierarchical relationship
+ my $rs = $schema->resultset('Person')->search({},
+ {
+ 'start_with' => { 'firstname' => 'Foo', 'lastname' => 'Bar' },
+ 'connect_by' => { 'parentid' => 'prior persionid'},
+ 'order_siblings_by' => 'firstname ASC',
+ };
+ );
+
=head1 DESCRIPTION
-This class implements autoincrements for Oracle.
+This class implements autoincrements for Oracle and adds support for Oracle
+specific hierarchical queries.
=head1 METHODS
+=head1 ATTRIBUTES
+
+Following additional attributes can be used in resultsets.
+
+=head2 connect_by
+
+=over 4
+
+=item Value: \%connect_by
+
+=back
+
+A hashref of conditions used to specify the relationship between parent rows
+and child rows of the hierarchy.
+
+ connect_by => { parentid => 'prior personid' }
+
+=head2 start_with
+
+=over 4
+
+=item Value: \%condition
+
+=back
+
+A hashref of conditions which specify the root row(s) of the hierarchy.
+
+It uses the same syntax as L<DBIx::Class::ResultSet/search>
+
+ start_with => { firstname => 'Foo', lastname => 'Bar' }
+
+=head2 order_siblings_by
+
+=over 4
+
+=item Value: ($order_siblings_by | \@order_siblings_by)
+
+=back
+
+Which column(s) to order the siblings by.
+
+It uses the same syntax as L<DBIx::Class::ResultSet/order_by>
+
+ 'order_siblings_by' => 'firstname ASC'
+
=cut
use Carp::Clan qw/^DBIx::Class/;
@@ -29,6 +144,21 @@
# __PACKAGE__->load_components(qw/PK::Auto/);
+sub _db_specific_attrs {
+ my ($self, $attrs) = @_;
+
+ my $rv = {};
+ if ( $attrs->{connect_by} || $attrs->{start_with} || $attrs->{order_siblings_by} ) {
+ $rv = {
+ connect_by => $attrs->{connect_by},
+ start_with => $attrs->{start_with},
+ order_siblings_by => $attrs->{order_siblings_by},
+ }
+ }
+
+ return $rv;
+}
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
diff -Nurb DBIx-Class-0.08010-orig/lib/DBIx/Class/Storage/DBI.pm DBIx-Class-0.08010/lib/DBIx/Class/Storage/DBI.pm
--- DBIx-Class-0.08010-orig/lib/DBIx/Class/Storage/DBI.pm 2008-02-27 14:49:09.000000000 +0100
+++ DBIx-Class-0.08010/lib/DBIx/Class/Storage/DBI.pm 2008-09-09 14:31:17.000000000 +0200
@@ -1125,9 +1125,18 @@
push @args, $attrs->{rows}, $attrs->{offset};
}
+ # give DB specific DBI subclasses the chance to pass DB specific attributes to
+ # the spl_maker, without overriding the whole _select method
+ if (my $db_specific_attrs = $self->_db_specific_attrs($attrs) ) {
+ push @args, $db_specific_attrs;
+ }
+
return $self->_execute(@args);
}
+# override this method to add DB specific attributes
+sub _db_specific_attrs { undef; }
+
sub source_bind_attributes {
my ($self, $source) = @_;
diff -Nurb DBIx-Class-0.08010-orig/t/73oracle.t DBIx-Class-0.08010/t/73oracle.t
--- DBIx-Class-0.08010-orig/t/73oracle.t 2007-08-11 23:07:59.000000000 +0200
+++ DBIx-Class-0.08010/t/73oracle.t 2008-09-09 16:52:47.000000000 +0200
@@ -11,7 +11,7 @@
'Warning: This test drops and creates tables called \'artist\', \'cd\' and \'track\''
unless ($dsn && $user && $pass);
-plan tests => 7;
+plan tests => 14;
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -24,10 +24,12 @@
$dbh->do("DROP TABLE track");
};
$dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
-$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255))");
+$dbh->do("CREATE TABLE artist (artistid NUMBER(12), parentid NUMBER(12), name VARCHAR(255))");
$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))");
$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE)");
+$schema->class('Artist')->add_columns('parentid');
+
$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
$dbh->do(qq{
CREATE OR REPLACE TRIGGER artist_insert_trg
@@ -95,6 +97,71 @@
is( scalar @results, 1, "Group by with limit OK" );
}
+# create a tree of artists
+my $afoo_id = $schema->resultset('Artist')->create({ name => 'afoo', parentid => 1 })->id;
+$schema->resultset('Artist')->create({ name => 'bfoo', parentid => 1 });
+my $cfoo_id = $schema->resultset('Artist')->create({ name => 'cfoo', parentid => $afoo_id })->id;
+$schema->resultset('Artist')->create({ name => 'dfoo', parentid => $cfoo_id });
+my $xfoo_id = $schema->resultset('Artist')->create({ name => 'xfoo' })->id;
+
+# create some cds and tracks
+$schema->resultset('CD')->create({ cdid => 2, artist => $cfoo_id, title => "cfoo's cd", year => '2008' });
+$schema->resultset('Track')->create({ trackid => 2, cd => 2, position => 1, title => 'Track1 cfoo' });
+$schema->resultset('CD')->create({ cdid => 3, artist => $xfoo_id, title => "xfoo's cd", year => '2008' });
+$schema->resultset('Track')->create({ trackid => 3, cd => 3, position => 1, title => 'Track1 xfoo' });
+
+{
+ my $rs = $schema->resultset('Artist')->search({}, # get the whole tree
+ {
+ 'start_with' => { 'name' => 'foo' },
+ 'connect_by' => { 'parentid' => 'prior artistid'},
+ });
+ is( $rs->count, 5, 'Connect By count ok' );
+ my $ok = 1;
+ foreach my $node_name (qw(foo afoo cfoo dfoo bfoo)) {
+ $ok = 0 if $rs->next->name ne $node_name;
+ }
+ ok( $ok, 'got artist tree');
+}
+
+{
+ # use order siblings by statement
+ my $rs = $schema->resultset('Artist')->search({},
+ {
+ 'start_with' => { 'name' => 'foo' },
+ 'connect_by' => { 'parentid' => 'prior artistid'},
+ 'order_siblings_by' => 'name DESC',
+ });
+ my $ok = 1;
+ foreach my $node_name (qw(foo bfoo afoo cfoo dfoo)) {
+ $ok = 0 if $rs->next->name ne $node_name;
+ }
+ ok( $ok, 'Order Siblings By ok');
+}
+
+{
+ # get the root node
+ my $rs = $schema->resultset('Artist')->search({ parentid => undef },
+ {
+ 'start_with' => { 'name' => 'dfoo' },
+ 'connect_by' => { 'prior parentid' => 'artistid'},
+ });
+ is( $rs->count, 1, 'root node count ok' );
+ ok( $rs->next->name eq 'foo', 'found root node');
+}
+
+{
+ # combine a connect by with a join
+ my $rs = $schema->resultset('Artist')->search({'cds.title' => { 'like' => '%cd'}},
+ {
+ 'join' => 'cds',
+ 'start_with' => { 'name' => 'foo' },
+ 'connect_by' => { 'parentid' => 'prior artistid'},
+ });
+ is( $rs->count, 1, 'Connect By with a join; count ok' );
+ ok( $rs->next->name eq 'cfoo', 'Connect By with a join; result name ok')
+}
+
# clean up our mess
END {
if($dbh) {