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-10 16:16:17.000000000 +0200 @@ -4,9 +4,78 @@ 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) = @_; + + $self->{_db_specific_attrs} = pop @rest; + + my ($sql, @bind) = $self->SUPER::select($table, $fields, $where, $order, @rest); + push @bind, @{$self->{_oracle_connect_by_binds}}; + + return wantarray ? ($sql, @bind) : $sql; + } + + sub _emulate_limit { + my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_; + + my ($cb_sql, @cb_bind) = $self->_connect_by(); + $sql .= $cb_sql; + $self->{_oracle_connect_by_binds} = \@cb_bind; + + return $self->SUPER::_emulate_limit($syntax, $sql, $order, $rows, $offset); + } + + sub _connect_by { + my ($self) = @_; + my $attrs = $self->{_db_specific_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 +84,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 + + 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 + + 'order_siblings_by' => 'firstname ASC' + =cut use Carp::Clan qw/^DBIx::Class/; @@ -29,6 +153,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-10 16:23:00.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 => 17; 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,104 @@ 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') +} + +{ + # combine a connect by with order_by + my $rs = $schema->resultset('Artist')->search({}, + { + 'start_with' => { 'name' => 'dfoo' }, + 'connect_by' => { 'prior parentid' => 'artistid'}, + 'order_by' => 'name ASC', + }); + my $ok = 1; + foreach my $node_name (qw(afoo cfoo dfoo foo)) { + $ok = 0 if $rs->next->name ne $node_name; + } + ok( $ok, 'Connect By with a order_by; result name ok'); +} + +{ + # limit a connect by + my $rs = $schema->resultset('Artist')->search({}, + { + 'start_with' => { 'name' => 'dfoo' }, + 'connect_by' => { 'prior parentid' => 'artistid'}, + 'order_by' => 'name ASC', + 'rows' => 2, + 'page' => 1, + }); + is( $rs->count(), 2, 'Connect By; LIMIT count ok' ); + my $ok = 1; + foreach my $node_name (qw(afoo cfoo)) { + $ok = 0 if $rs->next->name ne $node_name; + } + ok( $ok, 'LIMIT a Connect By query ok'); +} + # clean up our mess END { if($dbh) {