Merge 'trunk' into 'DBIx-Class-current'
Matt S Trout [Thu, 23 Mar 2006 18:05:16 +0000 (18:05 +0000)]
r9088@obrien (orig r1305):  matthewt | 2006-03-22 11:52:30 +0000
Nuked ancient and unused classdata entry
r9091@obrien (orig r1306):  jguenther | 2006-03-22 18:16:27 +0000
fixed unclear documentation regarding context in txn_do()
r9092@obrien (orig r1307):  castaway | 2006-03-22 22:41:38 +0000
Fix up is_auto_increment doc

r9093@obrien (orig r1308):  castaway | 2006-03-22 22:46:30 +0000
Fixup sequence docs

r9100@obrien (orig r1315):  wdh | 2006-03-23 18:02:43 +0000
add basic cache tests/docs to trunk

12 files changed:
TODO
lib/DBIx/Class/Positioned.pm [new file with mode: 0644]
lib/DBIx/Class/Tree/AdjacencyList.pm [new file with mode: 0644]
t/helperrels/26positioned.t [new file with mode: 0644]
t/lib/DBICTest/Schema.pm
t/lib/DBICTest/Schema/Employee/AdjacencyList.pm [new file with mode: 0644]
t/lib/DBICTest/Schema/Employee/Positioned.pm [new file with mode: 0644]
t/lib/DBICTest/Schema/Employee/PositionedAdjacencyList.pm [new file with mode: 0644]
t/lib/sqlite.sql
t/run/04db.tl
t/run/145db2.tl
t/run/26positioned.tl [new file with mode: 0644]

diff --git a/TODO b/TODO
index d0726b3..3e58f61 100644 (file)
--- a/TODO
+++ b/TODO
@@ -17,3 +17,8 @@
 2006-03-18 by bluefeet
  - Support table locking.
 
+2006-03-21 by bluefeet
+ - When subclassing a dbic class make it so you don't have to do 
+   __PACKAGE__->table(__PACKAGE__->table()); for the result set to 
+   return the correct object type.
+
diff --git a/lib/DBIx/Class/Positioned.pm b/lib/DBIx/Class/Positioned.pm
new file mode 100644 (file)
index 0000000..d3b7cf7
--- /dev/null
@@ -0,0 +1,376 @@
+# vim: ts=8:sw=4:sts=4:et
+package DBIx::Class::Positioned;
+use strict;
+use warnings;
+use base qw( DBIx::Class );
+
+=head1 NAME
+
+DBIx::Class::Positioned - Modify the position of objects in an ordered list.
+
+=head1 SYNOPSIS
+
+Create a table for your positionable data.
+
+  CREATE TABLE employees (
+    employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
+    name TEXT NOT NULL,
+    position INTEGER NOT NULL
+  );
+
+In your Schema or DB class add Positioned to the top 
+of the component list.
+
+  __PACKAGE__->load_components(qw( Positioned ... ));
+
+Specify the column that stores the position number for 
+each row.
+
+  package My::Employee;
+  __PACKAGE__->position_column('position');
+
+Thats it, now you can change the position of your objects.
+
+  #!/use/bin/perl
+  use My::Employee;
+  
+  my $employee = My::Employee->create({ name=>'Matt S. Trout' });
+  
+  my $rs = $employee->siblings();
+  my @siblings = $employee->siblings();
+  
+  my $sibling;
+  $sibling = $employee->first_sibling();
+  $sibling = $employee->last_sibling();
+  $sibling = $employee->previous_sibling();
+  $sibling = $employee->next_sibling();
+  
+  $employee->move_previous();
+  $employee->move_next();
+  $employee->move_first();
+  $employee->move_last();
+  $employee->move_to( $position );
+
+=head1 DESCRIPTION
+
+This module provides a simple interface for modifying the position 
+of DBIx::Class objects.
+
+=head1 AUTO UPDATE
+
+All of the move_* methods automatically update the rows involved in 
+the query.  This is not configurable and is due to the fact that if you 
+move a record it always causes other records in the list to be updated.
+
+=head1 METHODS
+
+=head2 position_column
+
+  __PACKAGE__->position_column('position');
+
+Sets and retrieves the name of the column that stores the 
+positional value of each record.  Default to "position".
+
+=cut
+
+__PACKAGE__->mk_classdata( 'position_column' => 'position' );
+
+=head2 collection_column
+
+  __PACKAGE__->collection_column('thing_id');
+
+This method specified a column to limit all queries in 
+this module by.  This effectively allows you to have multiple 
+positioned lists within the same table.
+
+=cut
+
+__PACKAGE__->mk_classdata( 'collection_column' );
+
+=head2 siblings
+
+  my $rs = $employee->siblings();
+  my @siblings = $employee->siblings();
+
+Returns either a result set or an array of all other objects 
+excluding the one you called it on.
+
+=cut
+
+sub siblings {
+    my( $self ) = @_;
+    my $position_column = $self->position_column;
+    my $rs = $self->result_source->resultset->search(
+        {
+            $position_column => { '!=' => $self->get_column($position_column) },
+            $self->_collection_clause(),
+        },
+        { order_by => $self->position_column },
+    );
+    return $rs->all() if (wantarray());
+    return $rs;
+}
+
+=head2 first_sibling
+
+  my $sibling = $employee->first_sibling();
+
+Returns the first sibling object.
+
+=cut
+
+sub first_sibling {
+    my( $self ) = @_;
+    return ($self->result_source->resultset->search(
+        {
+            $self->position_column => 1,
+            $self->_collection_clause(),
+        },
+    )->all())[0];
+}
+
+=head2 last_sibling
+
+  my $sibling = $employee->last_sibling();
+
+Return the last sibling.
+
+=cut
+
+sub last_sibling {
+    my( $self ) = @_;
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return ($self->result_source->resultset->search(
+        {
+            $self->position_column => $count,
+            $self->_collection_clause(),
+        },
+    )->all())[0];
+}
+
+=head2 previous_sibling
+
+  my $sibling = $employee->previous_sibling();
+
+Returns the sibling that resides one position higher.  Undef 
+is returned if the current object is the first one.
+
+=cut
+
+sub previous_sibling {
+    my( $self ) = @_;
+    my $position_column = $self->position_column;
+    my $position = $self->get_column( $position_column );
+    return 0 if ($position==1);
+    return ($self->result_source->resultset->search(
+        {
+            $position_column => $position - 1,
+            $self->_collection_clause(),
+        }
+    )->all())[0];
+}
+
+=head2 next_sibling
+
+  my $sibling = $employee->next_sibling();
+
+Returns the sibling that resides one position lower.  Undef 
+is returned if the current object is the last one.
+
+=cut
+
+sub next_sibling {
+    my( $self ) = @_;
+    my $position_column = $self->position_column;
+    my $position = $self->get_column( $position_column );
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return 0 if ($position==$count);
+    return ($self->result_source->resultset->search(
+        {
+            $position_column => $position + 1,
+            $self->_collection_clause(),
+        },
+    )->all())[0];
+}
+
+=head2 move_previous
+
+  $employee->move_previous();
+
+Swaps position with the sibling on position previous in the list.  
+1 is returned on success, and 0 is returned if the objects is already 
+the first one.
+
+=cut
+
+sub move_previous {
+    my( $self ) = @_;
+    my $position = $self->get_column( $self->position_column() );
+    return $self->move_to( $position - 1 );
+}
+
+=head2 move_next
+
+  $employee->move_next();
+
+Swaps position with the sibling in the next position.  1 is returned on 
+success, and 0 is returned if the object is already the last in the list.
+
+=cut
+
+sub move_next {
+    my( $self ) = @_;
+    my $position = $self->get_column( $self->position_column() );
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return 0 if ($position==$count);
+    return $self->move_to( $position + 1 );
+}
+
+=head2 move_first
+
+  $employee->move_first();
+
+Moves the object to the first position.  1 is returned on 
+success, and 0 is returned if the object is already the first.
+
+=cut
+
+sub move_first {
+    my( $self ) = @_;
+    return $self->move_to( 1 );
+}
+
+=head2 move_last
+
+  $employee->move_last();
+
+Moves the object to the very last position.  1 is returned on 
+success, and 0 is returned if the object is already the last one.
+
+=cut
+
+sub move_last {
+    my( $self ) = @_;
+    my $count = $self->result_source->resultset->search({$self->_collection_clause()})->count();
+    return $self->move_to( $count );
+}
+
+=head2 move_to
+
+  $employee->move_to( $position );
+
+Moves the object to the specified position.  1 is returned on 
+success, and 0 is returned if the object is already at the 
+specified position.
+
+=cut
+
+sub move_to {
+    my( $self, $to_position ) = @_;
+    my $position_column = $self->position_column;
+    my $from_position = $self->get_column( $position_column );
+    return 0 if ( $to_position < 1 );
+    return 0 if ( $from_position==$to_position );
+    my $rs = $self->result_source->resultset->search({
+        -and => [
+            $position_column => { ($from_position>$to_position?'<':'>') => $from_position },
+            $position_column => { ($from_position>$to_position?'>=':'<=') => $to_position },
+        ],
+        $self->_collection_clause(),
+    });
+    my $op = ($from_position>$to_position) ? '+' : '-';
+    $rs->update({
+        $position_column => \"$position_column $op 1",
+    });
+    $self->set_column( $position_column => $to_position );
+    $self->update();
+    return 1;
+}
+
+=head2 insert
+
+Overrides the DBIC insert() method by providing a default 
+position number.  The default will be the number of rows in 
+the table +1, thus positioning the new record at the last position.
+
+=cut
+
+sub insert {
+    my $self = shift;
+    my $position_column = $self->position_column;
+    $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_collection_clause()} )->count()+1 ) 
+        if (!$self->get_column($position_column));
+    $self->next::method( @_ );
+}
+
+=head2 delete
+
+Overrides the DBIC delete() method by first moving the object 
+to the last position, then deleting it, thus ensuring the 
+integrity of the positions.
+
+=cut
+
+sub delete {
+    my $self = shift;
+    $self->move_last;
+    $self->next::method( @_ );
+}
+
+=head1 PRIVATE METHODS
+
+These methods are used internally.  You should never have the 
+need to use them.
+
+=head2 _collection_clause
+
+This method returns a name=>value pare for limiting a search 
+by the collection column.  If the collection column is not 
+defined then this will return an empty list.
+
+=cut
+
+sub _collection_clause {
+    my $self = shift;
+    if ($self->collection_column()) {
+        return ( $self->collection_column() => $self->get_column($self->collection_column()) );
+    }
+    return ();
+}
+
+1;
+__END__
+
+=head1 BUGS
+
+=head2 Race Condition on Insert
+
+If a position is not specified for an insert than a position 
+will be chosen based on COUNT(*)+1.  But, it first selects the 
+count then inserts the record.  The space of time between select 
+and insert introduces a race condition.  To fix this we need the 
+ability to lock tables in DBIC.  I've added an entry in the TODO 
+about this.
+
+=head2 Multiple Moves
+
+Be careful when issueing move_* methods to multiple objects.  If 
+you've pre-loaded the objects then when you move one of the objects 
+the position of the other object will not reflect their new value 
+until you reload them from the database.
+
+The are times when you will want to move objects as groups, such 
+as changeing the parent of several objects at once - this directly 
+conflicts with this problem.  One solution is for us to write a 
+ResultSet class that supports a parent() method, for example.  Another 
+solution is to somehow automagically modify the objects that exist 
+in the current object's result set to have the new position value.
+
+=head1 AUTHOR
+
+Aran Deltac <bluefeet@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
diff --git a/lib/DBIx/Class/Tree/AdjacencyList.pm b/lib/DBIx/Class/Tree/AdjacencyList.pm
new file mode 100644 (file)
index 0000000..381b039
--- /dev/null
@@ -0,0 +1,182 @@
+# vim: ts=8:sw=4:sts=4:et
+package DBIx::Class::Tree::AdjacencyList;
+use strict;
+use warnings;
+use base qw( DBIx::Class );
+
+=head1 NAME
+
+DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model.
+
+=head1 SYNOPSIS
+
+Create a table for your tree data.
+
+  CREATE TABLE employees (
+    employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
+    parent_id INTEGER NOT NULL,
+    name TEXT NOT NULL
+  );
+
+In your Schema or DB class add Tree::AdjacencyList to the top 
+of the component list.
+
+  __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));
+  # If you want positionable data make sure this 
+  # module comes first, as in:
+  __PACKAGE__->load_components(qw( Tree::AdjacencyList Positioned ... ));
+
+Specify the column that contains the parent ID each row.
+
+  package My::Employee;
+  __PACKAGE__->parent_column('parent_id');
+
+Thats it, now you can modify and analyze the tree.
+
+  #!/use/bin/perl
+  use My::Employee;
+  
+  my $employee = My::Employee->create({ name=>'Matt S. Trout' });
+  
+  my $rs = $employee->children();
+  my @siblings = $employee->children();
+  
+  my $parent = $employee->parent();
+  $employee->parent( 7 );
+
+=head1 DESCRIPTION
+
+This module provides methods for working with adjacency lists.  The 
+adjacency list model is a very common way of representing a tree structure.  
+In this model each row in a table has a prent ID column that references the 
+primary key of another row in the same table.  Because of this the primary 
+key must only be one column and is usually some sort of integer.  The row 
+with a parent ID of 0 is the root row and is usually the parent of all 
+other rows.
+
+=head1 METHODS
+
+=head2 parent_column
+
+  __PACKAGE__->parent_column('parent_id');
+
+Declares the name of the column that contains the self-referential 
+ID which defines the parent row.  Defaults to "parent_id".
+
+=cut
+
+__PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
+
+=head2 parent
+
+  my $parent = $employee->parent();
+  $employee->parent( $parent_obj );
+  $employee->parent( $parent_id );
+
+Retrieves the object's parent ID, or sets the object's 
+parent ID.  If setting the parent ID then 0 will be returned 
+if the object already has the specified parent, and 1 on 
+success.
+
+If you are using the Positioned component this 
+module will first move the object to the last position of 
+the list, change the parent ID, then move the object to the 
+last position of the new list.  This ensures the intergrity 
+of the positions.
+
+=cut
+
+sub parent {
+    my( $self, $new_parent ) = @_;
+    my $parent_column = $self->parent_column();
+    if ($new_parent) {
+        if (ref($new_parent)) {
+            $new_parent = $new_parent->id() || 0;
+        }
+        return 0 if ($new_parent == ($self->get_column($parent_column)||0));
+        my $positioned = $self->can('position_column');
+        $self->move_last if ($positioned);
+        $self->set_column( $parent_column => $new_parent );
+        if ($positioned) {
+            $self->set_column(
+                $self->position_column() => $self->search( {$self->_parent_clause()} )->count() + 1
+            );
+        }
+        $self->update();
+        return 1;
+    }
+    else {
+        return $self->find( $self->get_column( $parent_column ) );
+    }
+}
+
+=head2 children
+
+  my $children_rs = $employee->children();
+  my @children = $employee->children();
+
+Returns a list or record set, depending on context, of all 
+the objects one level below the current one.
+
+If you are using the Positioned component then this method 
+will return the children sorted by the position column.
+
+=cut
+
+sub children {
+    my( $self ) = @_;
+    my $rs = $self->search(
+        { $self->parent_column()=>$self->id() },
+        ( $self->can('position_column') ? {order_by=>$self->position_column()} : () )
+    );
+    return $rs->all() if (wantarray());
+    return $rs;
+}
+
+=head2 descendents
+
+Same as children.  Declared so that this module is 
+compatible with the Tree::NestedSet module.
+
+=cut
+
+#*descendants = \&children;
+
+=head1 PRIVATE METHODS
+
+These methods are used internally.  You should never have the 
+need to use them.
+
+=head2 _parent_clause
+
+This method is provided as an override of the method in 
+DBIC::Positioned.  This way Positioned and Tree::AdjacencyList 
+may be used together without conflict.  Make sure that in 
+you component list that you load Tree::AdjacencyList before you 
+load Positioned.
+
+This method assumes a parent ID of 0 if none is defined.  This 
+usually comes in to play if you are just createing the object 
+and it has not yet been assigned a parent.
+
+=cut
+
+sub _parent_clause {
+    my( $self ) = @_;
+    return (
+        $self->parent_column() =>
+        $self->get_column($self->parent_column())
+    );
+}
+
+1;
+__END__
+
+=head1 AUTHOR
+
+Aran Deltac <bluefeet@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
diff --git a/t/helperrels/26positioned.t b/t/helperrels/26positioned.t
new file mode 100644 (file)
index 0000000..8e42bbd
--- /dev/null
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/26positioned.tl";
+run_tests(DBICTest->schema);
index f2ee2d7..c0ef724 100644 (file)
@@ -7,6 +7,9 @@ no warnings qw/qw/;
 
 __PACKAGE__->load_classes(qw/
   Artist
+  Employee::Positioned
+  Employee::AdjacencyList
+  Employee::PositionedAdjacencyList
   CD
   #dummy
   Track
diff --git a/t/lib/DBICTest/Schema/Employee/AdjacencyList.pm b/t/lib/DBICTest/Schema/Employee/AdjacencyList.pm
new file mode 100644 (file)
index 0000000..c0e4407
--- /dev/null
@@ -0,0 +1,39 @@
+package # hide from PAUSE 
+    DBICTest::Schema::Employee::AdjacencyList;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components(qw(
+    Tree::AdjacencyList
+    PK::Auto
+    Core
+));
+
+__PACKAGE__->table('employees_adjacencylist');
+
+__PACKAGE__->add_columns(
+    employee_id => {
+        data_type => 'integer',
+        is_auto_increment => 1
+    },
+    parent_id => {
+        data_type => 'integer',
+        is_nullable => 1,
+    },
+    name => {
+        data_type => 'varchar',
+        size      => 100,
+        is_nullable => 1,
+    },
+);
+
+__PACKAGE__->set_primary_key('employee_id');
+__PACKAGE__->parent_column('parent_id');
+
+__PACKAGE__->mk_classdata('field_name_for', {
+    employee_id => 'primary key',
+    parent_id   => 'parent id',
+    name        => 'employee name',
+});
+
+1;
diff --git a/t/lib/DBICTest/Schema/Employee/Positioned.pm b/t/lib/DBICTest/Schema/Employee/Positioned.pm
new file mode 100644 (file)
index 0000000..da7444e
--- /dev/null
@@ -0,0 +1,34 @@
+package # hide from PAUSE 
+    DBICTest::Schema::Employee::Positioned;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components(qw( Positioned PK::Auto Core ));
+
+__PACKAGE__->table('employees_positioned');
+
+__PACKAGE__->add_columns(
+    employee_id => {
+        data_type => 'integer',
+        is_auto_increment => 1
+    },
+    position => {
+        data_type => 'integer',
+    },
+    name => {
+        data_type => 'varchar',
+        size      => 100,
+        is_nullable => 1,
+    },
+);
+
+__PACKAGE__->set_primary_key('employee_id');
+__PACKAGE__->position_column('position');
+
+__PACKAGE__->mk_classdata('field_name_for', {
+    employee_id => 'primary key',
+    position    => 'list position',
+    name        => 'employee name',
+});
+
+1;
diff --git a/t/lib/DBICTest/Schema/Employee/PositionedAdjacencyList.pm b/t/lib/DBICTest/Schema/Employee/PositionedAdjacencyList.pm
new file mode 100644 (file)
index 0000000..86a2e58
--- /dev/null
@@ -0,0 +1,45 @@
+package # hide from PAUSE 
+    DBICTest::Schema::Employee::PositionedAdjacencyList;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components(qw(
+    Tree::AdjacencyList
+    Positioned
+    PK::Auto
+    Core
+));
+
+__PACKAGE__->table('employees_positioned_adjacencylist');
+
+__PACKAGE__->add_columns(
+    employee_id => {
+        data_type => 'integer',
+        is_auto_increment => 1
+    },
+    parent_id => {
+        data_type => 'integer',
+        is_nullable => 1,
+    },
+    position => {
+        data_type => 'integer',
+    },
+    name => {
+        data_type => 'varchar',
+        size      => 100,
+        is_nullable => 1,
+    },
+);
+
+__PACKAGE__->set_primary_key('employee_id');
+__PACKAGE__->position_column('position');
+__PACKAGE__->parent_column('parent_id');
+
+__PACKAGE__->mk_classdata('field_name_for', {
+    employee_id => 'primary key',
+    parent_id   => 'parent id',
+    position    => 'list position',
+    name        => 'employee name',
+});
+
+1;
index f59aca8..6cd3abe 100644 (file)
@@ -1,10 +1,19 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Sun Mar 19 19:16:50 2006
+-- Created on Tue Mar 21 12:11:03 2006
 -- 
 BEGIN TRANSACTION;
 
 --
+-- Table: employees_positioned
+--
+CREATE TABLE employees_positioned (
+  employee_id INTEGER PRIMARY KEY NOT NULL,
+  position integer NOT NULL,
+  name varchar(100)
+);
+
+--
 -- Table: serialized
 --
 CREATE TABLE serialized (
@@ -13,12 +22,12 @@ CREATE TABLE serialized (
 );
 
 --
--- Table: twokeys
+-- Table: cd_to_producer
 --
-CREATE TABLE twokeys (
-  artist integer NOT NULL,
+CREATE TABLE cd_to_producer (
   cd integer NOT NULL,
-  PRIMARY KEY (artist, cd)
+  producer integer NOT NULL,
+  PRIMARY KEY (cd, producer)
 );
 
 --
@@ -30,12 +39,12 @@ CREATE TABLE liner_notes (
 );
 
 --
--- Table: cd_to_producer
+-- Table: employees_adjacencylist
 --
-CREATE TABLE cd_to_producer (
-  cd integer NOT NULL,
-  producer integer NOT NULL,
-  PRIMARY KEY (cd, producer)
+CREATE TABLE employees_adjacencylist (
+  employee_id INTEGER PRIMARY KEY NOT NULL,
+  parent_id integer,
+  name varchar(100)
 );
 
 --
@@ -47,6 +56,16 @@ CREATE TABLE artist (
 );
 
 --
+-- Table: employees_positioned_adjacencylist
+--
+CREATE TABLE employees_positioned_adjacencylist (
+  employee_id INTEGER PRIMARY KEY NOT NULL,
+  parent_id integer,
+  position integer NOT NULL,
+  name varchar(100)
+);
+
+--
 -- Table: self_ref_alias
 --
 CREATE TABLE self_ref_alias (
@@ -56,17 +75,6 @@ CREATE TABLE self_ref_alias (
 );
 
 --
--- Table: fourkeys
---
-CREATE TABLE fourkeys (
-  foo integer NOT NULL,
-  bar integer NOT NULL,
-  hello integer NOT NULL,
-  goodbye integer NOT NULL,
-  PRIMARY KEY (foo, bar, hello, goodbye)
-);
-
---
 -- Table: cd
 --
 CREATE TABLE cd (
@@ -77,24 +85,6 @@ CREATE TABLE cd (
 );
 
 --
--- Table: artist_undirected_map
---
-CREATE TABLE artist_undirected_map (
-  id1 integer NOT NULL,
-  id2 integer NOT NULL,
-  PRIMARY KEY (id1, id2)
-);
-
---
--- Table: onekey
---
-CREATE TABLE onekey (
-  id INTEGER PRIMARY KEY NOT NULL,
-  artist integer NOT NULL,
-  cd integer NOT NULL
-);
-
---
 -- Table: track
 --
 CREATE TABLE track (
@@ -105,10 +95,11 @@ CREATE TABLE track (
 );
 
 --
--- Table: producer
+-- Table: treelike
 --
-CREATE TABLE producer (
-  producerid INTEGER PRIMARY KEY NOT NULL,
+CREATE TABLE treelike (
+  id INTEGER PRIMARY KEY NOT NULL,
+  parent integer NOT NULL,
   name varchar(100) NOT NULL
 );
 
@@ -130,11 +121,48 @@ CREATE TABLE self_ref (
 );
 
 --
--- Table: treelike
+-- Table: twokeys
 --
-CREATE TABLE treelike (
+CREATE TABLE twokeys (
+  artist integer NOT NULL,
+  cd integer NOT NULL,
+  PRIMARY KEY (artist, cd)
+);
+
+--
+-- Table: fourkeys
+--
+CREATE TABLE fourkeys (
+  foo integer NOT NULL,
+  bar integer NOT NULL,
+  hello integer NOT NULL,
+  goodbye integer NOT NULL,
+  PRIMARY KEY (foo, bar, hello, goodbye)
+);
+
+--
+-- Table: artist_undirected_map
+--
+CREATE TABLE artist_undirected_map (
+  id1 integer NOT NULL,
+  id2 integer NOT NULL,
+  PRIMARY KEY (id1, id2)
+);
+
+--
+-- Table: onekey
+--
+CREATE TABLE onekey (
   id INTEGER PRIMARY KEY NOT NULL,
-  parent integer NOT NULL,
+  artist integer NOT NULL,
+  cd integer NOT NULL
+);
+
+--
+-- Table: producer
+--
+CREATE TABLE producer (
+  producerid INTEGER PRIMARY KEY NOT NULL,
   name varchar(100) NOT NULL
 );
 
index daea4fe..4865d96 100644 (file)
@@ -44,7 +44,7 @@ my $test_type_info = {
     'name' => {
         'data_type' => 'varchar',
         'is_nullable' => 0,
-    }
+    },
 };
 is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
 
index aa721b1..31e3461 100644 (file)
@@ -14,10 +14,7 @@ DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
 
 my $dbh = DB2Test->schema->storage->dbh;
 
-{
-    local $SIG{__WARN__} = sub {};
-    $dbh->do("DROP TABLE artist;");
-}
+$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 });
 
 $dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10));");
 
diff --git a/t/run/26positioned.tl b/t/run/26positioned.tl
new file mode 100644 (file)
index 0000000..c73e257
--- /dev/null
@@ -0,0 +1,73 @@
+# vim: filetype=perl
+
+sub run_tests {
+
+    plan tests => 56;
+    my $schema = shift;
+
+    my $employees = $schema->resultset('Employee::Positioned');
+    $employees->delete();
+
+    foreach (1..5) {
+        $employees->create({ name=>'temp' });
+    }
+    $employees = $employees->search(undef,{order_by=>'position'});
+    ok( check_positions($employees), "$class: intial positions" );
+
+    my $employee;
+
+    foreach my $position (1..$employees->count()) {
+
+        $employee = $employees->find({ position=>$position });
+        $employee->move_previous();
+        ok( check_positions($employees), "$class: move_previous( $position )" );
+
+        $employee = $employees->find({ position=>$position });
+        $employee->move_next();
+        ok( check_positions($employees), "$class: move_next( $position )" );
+
+        $employee = $employees->find({ position=>$position });
+        $employee->move_first();
+        ok( check_positions($employees), "$class: move_first( $position )" );
+
+        $employee = $employees->find({ position=>$position });
+        $employee->move_last();
+        ok( check_positions($employees), "$class: move_last( $position )" );
+
+        foreach my $to_position (1..$employees->count()) {
+            $employee = $employees->find({ position=>$position });
+            $employee->move_to($to_position);
+            ok( check_positions($employees), "$class: move_to( $position => $to_position )" );
+        }
+
+        $employee = $employees->find({ position=>$position });
+        if ($position==1) {
+            ok( !$employee->previous_sibling(), 'no previous sibling' );
+            ok( $employee->next_sibling(), 'next sibling' );
+        }
+        elsif ($position==$employees->count()) {
+            ok( $employee->previous_sibling(), 'previous sibling' );
+            ok( !$employee->next_sibling(), 'no next sibling' );
+        }
+        else {
+            ok( $employee->previous_sibling(), 'previous sibling' );
+            ok( $employee->next_sibling(), 'next sibling' );
+        }
+
+    }
+}
+
+sub check_positions {
+    my( $employees ) = @_;
+    $employees->reset();
+    my $expected_position = 0;
+    while (my $employee = $employees->next()) {
+        $expected_position ++;
+        if ($employee->position()!=$expected_position) {
+            return 0;
+        }
+    }
+    return 1;
+}
+
+1;