From: Aran Deltac <bluefeet@cpan.org>
Date: Fri, 24 Mar 2006 23:47:59 +0000 (+0000)
Subject: Remove Tree and TokenGroup modules in favor of the new DBIx::Class::Tree distribution.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4e298a8054346b4685adfd3a5455730fac38435c;p=dbsrgits%2FDBIx-Class-Historic.git

Remove Tree and TokenGroup modules in favor of the new DBIx::Class::Tree distribution.
---

diff --git a/lib/DBIx/Class/TokenGroup.pm b/lib/DBIx/Class/TokenGroup.pm
deleted file mode 100644
index 8f59413..0000000
--- a/lib/DBIx/Class/TokenGroup.pm
+++ /dev/null
@@ -1,213 +0,0 @@
-package DBIx::Class::TokenGroup;
-use strict;
-use warnings;
-
-use base qw( DBIx::Class );
-
-=head1 NAME
-
-DBIx::Class::TokenGroup - Search for tokens in a tree of groups. (EXPERIMENTAL)
-
-=head1 SYNOPSIS
-
-Define your user tokens class.
-
-  package Schema::User::Token;
-  use base qw( DBIx::Class::Core );
-  __PACKAGE__->table('user_tokens');
-  __PACKAGE__->add_columns(qw( name user_id value ));
-  __PACKAGE__->set_primary_key(qw( name user_id ));
-  1;
-
-Define your group tokens class.
-
-  package Schema::Group::Token;
-  use base qw( DBIx::Class::Core );
-  __PACKAGE__->table('group_tokens');
-  __PACKAGE__->add_columns(qw( name group_id value ));
-  __PACKAGE__->set_primary_key(qw( name group_id ));
-  1;
-
-Define your group class.
-
-  package Schema::Group;
-  use base qw( DBIx::Class::Core );
-  __PACKAGE__->load_components(qw(
-    Tree::AdjacencyList
-  ));
-  __PACKAGE__->table('groups');
-  __PACKAGE__->add_columns(qw( group_id parent_id ));
-  __PACKAGE__->set_primary_key('group_id');
-  __PACKAGE__->parent_column('parent_id');
-  __PACKAGE__->has_many( 'tokens' => 'Group::Token' => 'group_id' );
-  1;
-
-Define your user class.
-
-  package Schema::User;
-  use base qw( DBIx::Class::Core );
-  __PACKAGE__->table('users');
-  __PACKAGE__->add_columns(qw( user_id group_id ));
-  __PACKAGE__->set_primary_key('user_id');
-  __PACKAGE__->token_name_column('name');
-  __PACKAGE__->token_value_column('value');
-  __PACKAGE__->has_many( 'tokens' => 'User::Token' => 'user_id' );
-  __PACKAGE__->belongs_to( 'group' => 'Group', { 'foreign.group_id' => 'self.group_id' } );
-  1;
-
-=head1 DESCRIPTION
-
-This L<DBIx::Class> component provides several utilities for 
-retrieving tokens for a tree of groups.  A token is, at a minimum, 
-a name and a value.  Groups are associated using either 
-L<DBIx::Class::Tree::AdjacencyList> or L<DBIx::Class::Tree::NestedSet>.
-
-This component itself is fairly simple, but it requires that you 
-structure your classes in a certain way.
-
-=head1 REQUIREMENTS
-
-The sample shown in the SYNOPSIS is just that, an example.  
-As long your clases respond the way that this component 
-expects it doesn't care how things are structure.  So, here 
-are the requirements for the class that uses this component.
-
-=over 4
-
-=item *
-
-A tokens() method that returns a DBIx::Class::ResultSet object.  The 
-objects (tokens) that the result set returns must have the name and 
-value columns that you specified with the...
-
-=item *
-
-TODO
-
-=back
-
-=head1 METHODS
-
-=head2 token_name_column
-
-  __PACKAGE__->token_name_column('name');
-
-Sets the name of the column that can be queried to 
-retrieve a token's name.
-
-=cut
-
-__PACKAGE__->mk_classdata( 'token_name_column' => 'name' );
-
-=head2 token_value_column
-
-  __PACKAGE__->token_value_column('value');
-
-Sets the name of the column that can be queried to 
-retrieve a token's value.  This settings is optional 
-as long as you do not use the token_true() and 
-token_false() methods.
-
-=cut
-
-__PACKAGE__->mk_classdata( 'token_value_column' => 'value' );
-
-=head2 token
-
-  $object->token('name');
-
-Returns the token object, or 0 if none was found.
-
-=cut
-
-sub token {
-    my( $self, $name ) = @_;
-    my $name_col = $self->token_name_column();
-    my $token = $self->tokens->search({
-        $name_col => $name
-    })->all();
-    return $token if ($token);
-    $token = $self->group->tokens->search({
-        $name_col => $name
-    })->all();
-    return $token if ($token);
-    my $descendant = $self->group->descendant_by_depth();
-    while (my $group = $descendant->next()) {
-        $token = $group->tokens->search({
-            $name_col => $name
-        })->all();
-        return $token if ($token);
-    }
-    return 0;
-}
-
-=head2 token_exists
-
-  if ($object->token_exists('name')){ ... }
-
-Tests whether there is a token defined of the 
-specified name.
-
-=cut
-
-sub token_exists {
-    my( $self, $name ) = @_;
-    my $name_col = $self->token_name_column();
-    return 1 if( $self->tokens->search({
-        $name_col => $name
-    })->count() );
-    return 1 if( $self->group->tokens->search({
-        $name_col => $name
-    })->count() );
-    my $ancestors = $self->group->ancestors_by_depth();
-    while (my $group = $ancestors->next()) {
-        return 1 if( $group->tokens->search({
-            $name_col => $name
-        })->count() );
-    }
-    return 0;
-}
-
-=head2 token_true
-
-  if ($object->token_true('name')) {
-
-Returns 1 if the token exists and its value is a 
-true value.  Returns 0 otherwise.
-
-=cut
-
-sub token_true {
-    my( $self, $name ) = @_;
-    my $token = $self->token( $name );
-    return 0 if(!$token);
-    return ( $token->get_column($self->token_value_column()) ? 1 : 0 );
-}
-
-=head2 token_false
-
-  if ($object->token_false('name')) {
-
-Returns 1 if the token exists and its value is a 
-false value.  Returns 0 otherwise.
-
-=cut
-
-sub token_false {
-    my( $self, $name ) = @_;
-    my $token = $self->token( $name );
-    return 0 if(!$token);
-    return ( $token->get_column($self->token_value_column()) ? 0 : 1 );
-}
-
-1;
-__END__
-
-=head1 AUTHOR
-
-Aran Clary 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
deleted file mode 100644
index 5802905..0000000
--- a/lib/DBIx/Class/Tree/AdjacencyList.pm
+++ /dev/null
@@ -1,282 +0,0 @@
-# vim: ts=8:sw=4:sts=4:et
-package DBIx::Class::Tree::AdjacencyList;
-use strict;
-use warnings;
-use base qw( DBIx::Class );
-use Carp qw( croak );
-
-=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 Positional ... ));
-
-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".
-
-If you are useing the L<DBIx::Class::Positional> component then this 
-parent_column will automatically be used as the collection_column.
-
-=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 L<DBIx::Class::Positional> 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));
-        $self->move_last() if ($self->positional());
-        $self->set_column( $parent_column => $new_parent );
-        if ($self->positional()) {
-            $self->set_column(
-                $self->position_column() => $self->search( {$self->_collection_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 L<DBIx::Class::Positional> 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->isa('DBIx::Class::Position') ? {order_by=>$self->position_column()} : () )
-    );
-    return $rs->all() if (wantarray());
-    return $rs;
-}
-
-=head2 attach_child
-
-  $parent->attach_child( $child );
-
-Sets (or moves) the child to the new parent.
-
-=cut
-
-sub attach_child {
-    my( $self, $child ) = @_;
-    $child->parent( $self );
-}
-
-=head2 attach_sibling
-
-  $this->attach_sibling( $that );
-
-Sets the passed in object to have the same parent 
-as the calling object.
-
-=cut
-
-sub attach_sibling {
-    my( $self, $child ) = @_;
-    $child->parent( $self->parent() );
-}
-
-=head1 POSITIONAL METHODS
-
-If you are useing the L<DBIx::Class::Postional> component 
-in conjunction with this module then you will also have 
-these methods available to you.
-
-=head2 append_child
-
-  $parent->append_child( $child );
-
-Sets the child to have the specified parent and moves the 
-child to the last position.
-
-=cut
-
-sub append_child {
-    my( $self, $child ) = @_;
-    croak('This method may only be used with the Positional component') if (!$self->positional());
-    $child->parent( $self );
-}
-
-=head2 prepend_child
-
-  $parent->prepend_child( $child );
-
-Sets the child to have the specified parent and moves the 
-child to the first position.
-
-=cut
-
-sub prepend_child {
-    my( $self, $child ) = @_;
-    croak('This method may only be used with the Positional component') if (!$self->positional());
-    $child->parent( $self );
-    $child->move_first();
-}
-
-=head2 attach_before
-
-  $this->attach_before( $that );
-
-Attaches the object at the position just before the 
-calling object's position.
-
-=cut
-
-sub attach_before {
-    my( $self, $sibling ) = @_;
-    croak('This method may only be used with the Positional component') if (!$self->positional());
-    $sibling->parent( $self->parent() );
-    $sibling->move_to( $self->get_column($self->position_column()) );
-}
-
-=head2 attach_after
-
-  $this->attach_after( $that );
-
-Attaches the object at the position just after the 
-calling object's position.
-
-=cut
-
-sub attach_after {
-    my( $self, $sibling ) = @_;
-    croak('This method may only be used with the Positional component') if (!$self->positional());
-    $sibling->parent( $self->parent() );
-    $sibling->move_to( $self->get_column($self->position_column()) + 1 );
-}
-
-=head2 positional
-
-  if ($object->positional()) { ... }
-
-Returns true if the object is a DBIx::Class::Positional 
-object.
-
-=cut
-
-sub positional {
-    my( $self ) = @_;
-    return $self->isa('DBIx::Class::Positional');
-}
-
-=head1 PRIVATE METHODS
-
-These methods are used internally.  You should never have the 
-need to use them.
-
-=head2 _collection_clause
-
-This method is provided as an override of the method in 
-L<DBIx::Class::Positional>.  This way Positional and Tree::AdjacencyList 
-may be used together without conflict.  Make sure that in 
-your component list that you load Tree::AdjacencyList before you 
-load Positional.
-
-=cut
-
-sub _collection_clause {
-    my( $self ) = @_;
-    return (
-        $self->parent_column() =>
-        $self->get_column($self->parent_column())
-    );
-}
-
-1;
-__END__
-
-=head1 AUTHOR
-
-Aran Clary Deltac <bluefeet@cpan.org>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
diff --git a/t/helperrels/27adjacency_list.t b/t/helperrels/27adjacency_list.t
deleted file mode 100644
index dbc5992..0000000
--- a/t/helperrels/27adjacency_list.t
+++ /dev/null
@@ -1,7 +0,0 @@
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-use DBICTest::HelperRels;
-
-require "t/run/27adjacency_list.tl";
-run_tests(DBICTest->schema);
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index 90308ab..d6dd957 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -7,8 +7,7 @@ no warnings qw/qw/;
 
 __PACKAGE__->load_classes(qw/
   Artist
-  Employee::Positional
-  Employee::AdjacencyList
+  Employee
   CD
   #dummy
   Track
diff --git a/t/lib/DBICTest/Schema/Employee/Positional.pm b/t/lib/DBICTest/Schema/Employee.pm
similarity index 89%
rename from t/lib/DBICTest/Schema/Employee/Positional.pm
rename to t/lib/DBICTest/Schema/Employee.pm
index 6234132..5eec03e 100644
--- a/t/lib/DBICTest/Schema/Employee/Positional.pm
+++ b/t/lib/DBICTest/Schema/Employee.pm
@@ -1,11 +1,11 @@
 package # hide from PAUSE 
-    DBICTest::Schema::Employee::Positional;
+    DBICTest::Schema::Employee;
 
 use base 'DBIx::Class';
 
 __PACKAGE__->load_components(qw( Positional PK::Auto Core ));
 
-__PACKAGE__->table('employees_positional');
+__PACKAGE__->table('employees');
 
 __PACKAGE__->add_columns(
     employee_id => {
diff --git a/t/lib/DBICTest/Schema/Employee/AdjacencyList.pm b/t/lib/DBICTest/Schema/Employee/AdjacencyList.pm
deleted file mode 100644
index 50f7abd..0000000
--- a/t/lib/DBICTest/Schema/Employee/AdjacencyList.pm
+++ /dev/null
@@ -1,45 +0,0 @@
-package # hide from PAUSE 
-    DBICTest::Schema::Employee::AdjacencyList;
-
-use base 'DBIx::Class';
-
-__PACKAGE__->load_components(qw(
-    Tree::AdjacencyList
-    Positional
-    PK::Auto
-    Core
-));
-
-__PACKAGE__->table('employees_adjacencylist');
-
-__PACKAGE__->add_columns(
-    employee_id => {
-        data_type => 'integer',
-        is_auto_increment => 1
-    },
-    parent_id => {
-        data_type => 'integer',
-    },
-    position => {
-        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__->position_column('position');
-
-__PACKAGE__->mk_classdata('field_name_for', {
-    employee_id => 'primary key',
-    parent_id   => 'parent id',
-    position    => 'list order',
-    name        => 'employee name',
-});
-
-1;
diff --git a/t/lib/sqlite.sql b/t/lib/sqlite.sql
index 81d56ae..ae029c5 100644
--- a/t/lib/sqlite.sql
+++ b/t/lib/sqlite.sql
@@ -1,10 +1,20 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Fri Mar 24 07:13:26 2006
+-- Created on Fri Mar 24 15:47:00 2006
 -- 
 BEGIN TRANSACTION;
 
 --
+-- Table: employees
+--
+CREATE TABLE employees (
+  employee_id INTEGER PRIMARY KEY NOT NULL,
+  position integer NOT NULL,
+  group_id integer,
+  name varchar(100)
+);
+
+--
 -- Table: serialized
 --
 CREATE TABLE serialized (
@@ -13,13 +23,12 @@ CREATE TABLE serialized (
 );
 
 --
--- Table: employees_adjacencylist
+-- Table: cd_to_producer
 --
-CREATE TABLE employees_adjacencylist (
-  employee_id INTEGER PRIMARY KEY NOT NULL,
-  parent_id integer NOT NULL,
-  position integer,
-  name varchar(100)
+CREATE TABLE cd_to_producer (
+  cd integer NOT NULL,
+  producer integer NOT NULL,
+  PRIMARY KEY (cd, producer)
 );
 
 --
@@ -31,15 +40,6 @@ CREATE TABLE liner_notes (
 );
 
 --
--- Table: cd_to_producer
---
-CREATE TABLE cd_to_producer (
-  cd integer NOT NULL,
-  producer integer NOT NULL,
-  PRIMARY KEY (cd, producer)
-);
-
---
 -- Table: artist
 --
 CREATE TABLE artist (
@@ -85,15 +85,6 @@ CREATE TABLE self_ref (
 );
 
 --
--- Table: tags
---
-CREATE TABLE tags (
-  tagid INTEGER PRIMARY KEY NOT NULL,
-  cd integer NOT NULL,
-  tag varchar(100) NOT NULL
-);
-
---
 -- Table: treelike
 --
 CREATE TABLE treelike (
@@ -103,22 +94,21 @@ CREATE TABLE treelike (
 );
 
 --
--- Table: twokeys
+-- Table: tags
 --
-CREATE TABLE twokeys (
-  artist integer NOT NULL,
+CREATE TABLE tags (
+  tagid INTEGER PRIMARY KEY NOT NULL,
   cd integer NOT NULL,
-  PRIMARY KEY (artist, cd)
+  tag varchar(100) NOT NULL
 );
 
 --
--- Table: employees_positional
+-- Table: twokeys
 --
-CREATE TABLE employees_positional (
-  employee_id INTEGER PRIMARY KEY NOT NULL,
-  position integer NOT NULL,
-  group_id integer,
-  name varchar(100)
+CREATE TABLE twokeys (
+  artist integer NOT NULL,
+  cd integer NOT NULL,
+  PRIMARY KEY (artist, cd)
 );
 
 --
diff --git a/t/run/27adjacency_list.tl b/t/run/27adjacency_list.tl
deleted file mode 100644
index 6c2f46a..0000000
--- a/t/run/27adjacency_list.tl
+++ /dev/null
@@ -1,52 +0,0 @@
-# vim: filetype=perl
-
-sub run_tests {
-
-    plan tests => 5;
-    my $schema = shift;
-
-    my $employees = $schema->resultset('Employee::AdjacencyList');
-    $employees->delete();
-
-    my $grandma = $employees->create({ name=>'grandma', parent_id=>0 });
-    foreach (1..15) {
-        $employees->create({ name=>'temp', parent_id=>$grandma->id() });
-    }
-    ok( ($grandma->children->count()==15), 'grandma children' );
-
-    my $mom = ($grandma->children->search(undef,{rows=>1})->all())[0];
-    foreach (1..5) {
-        ($grandma->children->search(undef,{rows=>1})->all())[0]->parent( $mom );
-    }
-    ok( ($mom->children->count()==5), 'mom children' );
-    ok( ($grandma->children->count()==10), 'grandma children' );
-
-    $mom = ($grandma->children->search(undef,{rows=>2})->all())[0];
-    foreach (1..4) {
-        ($grandma->children->search(undef,{rows=>1})->all())[0]->parent( $mom );
-    }
-    ok( ($mom->children->count()==4), 'mom children' );
-    ok( ($grandma->children->count()==6), 'grandma children' );
-
-    ok( check_rs( scalar $grandma->children() ), 'correct positions' );
-}
-
-sub check_rs {
-    my( $rs ) = @_;
-    $rs->reset();
-    my $position_column = $rs->result_class->position_column();
-    my $expected_position = 0;
-    while (my $row = $rs->next()) {
-        $expected_position ++;
-        if ($row->get_column($position_column)!=$expected_position) {
-            return 0;
-        }
-        my $children = $row->children();
-        while (my $child = $children->next()) {
-            return 0 if (!check_rs( scalar $child->children() ));
-        }
-    }
-    return 1;
-}
-
-1;