[Bast-commits] r5659 - in DBIx-Class/0.08/branches: .
hierarchical-queries hierarchical-queries/lib/DBIx/Class/Storage
hierarchical-queries/lib/DBIx/Class/Storage/DBI/Oracle
hierarchical-queries/t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Fri Feb 27 00:39:25 GMT 2009
Author: caelum
Date: 2009-02-27 00:39:25 +0000 (Fri, 27 Feb 2009)
New Revision: 5659
Added:
DBIx-Class/0.08/branches/hierarchical-queries/
Modified:
DBIx-Class/0.08/branches/hierarchical-queries/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/hierarchical-queries/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/branches/hierarchical-queries/t/73oracle.t
Log:
Integrating patch from rt#39121 -- passes tests, but needs work
Copied: DBIx-Class/0.08/branches/hierarchical-queries (from rev 5652, DBIx-Class/0.08/trunk)
Property changes on: DBIx-Class/0.08/branches/hierarchical-queries
___________________________________________________________________
Name: svn:ignore
+ _build
blib
pm_to_blib
Build
Build.bat
Makefile
Makefile.old
inc
README
META.yml
MANIFEST
Name: svn:mergeinfo
+
Name: svk:merge
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/resultsetcolumn_custom_columns:5160
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/sqla_1.50_compat:5414
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/trunk:5635
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:10954
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
Modified: DBIx-Class/0.08/branches/hierarchical-queries/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-02-26 23:44:40 UTC (rev 5652)
+++ DBIx-Class/0.08/branches/hierarchical-queries/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-02-27 00:39:25 UTC (rev 5659)
@@ -6,7 +6,8 @@
=head1 NAME
-DBIx::Class::Storage::DBI::Oracle::Generic - Automatic primary key class for Oracle
+DBIx::Class::Storage::DBI::Oracle::Generic - Automatic primary key class and
+connect_by support for Oracle
=head1 SYNOPSIS
@@ -16,12 +17,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/;
@@ -30,6 +86,90 @@
# __PACKAGE__->load_components(qw/PK::Auto/);
+{
+ 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" : '';
+ }
+}
+
+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;
+} # end of DBIC::SQL::Abstract::Oracle
+
+__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract::Oracle');
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, @columns) = @_;
my @ids = ();
Modified: DBIx-Class/0.08/branches/hierarchical-queries/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-02-26 23:44:40 UTC (rev 5652)
+++ DBIx-Class/0.08/branches/hierarchical-queries/lib/DBIx/Class/Storage/DBI.pm 2009-02-27 00:39:25 UTC (rev 5659)
@@ -1416,9 +1416,18 @@
$attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
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 @args;
}
+sub _db_specific_attrs { undef }
+
sub source_bind_attributes {
my ($self, $source) = @_;
Modified: DBIx-Class/0.08/branches/hierarchical-queries/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/trunk/t/73oracle.t 2009-02-26 23:44:40 UTC (rev 5652)
+++ DBIx-Class/0.08/branches/hierarchical-queries/t/73oracle.t 2009-02-27 00:39:25 UTC (rev 5659)
@@ -39,7 +39,7 @@
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 24;
+plan tests => 34;
DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -60,7 +60,10 @@
$dbh->do("CREATE SEQUENCE pkid1_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0");
-$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))");
+
+$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), parentid NUMBER(12), rank NUMBER(38), charfield VARCHAR2(10))");
+$schema->class('Artist')->add_columns('parentid');
+
$dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid 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)");
@@ -147,6 +150,104 @@
my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
+# 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($schema && ($dbh = $schema->storage->dbh)) {
More information about the Bast-commits
mailing list