Adding Ben Simpson's new persistence layer.

lib/WebGUI/Persistent/Query.pm

@@ -0,0 +1,246 @@
+package WebGUI::Persistent::Query;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2003 Plain Black LLC.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+
+use strict;
+use warnings;
+use WebGUI::SQL ();
+use WebGUI::ErrorHandler;
+
+=head1 NAME
+
+Package WebGUI::Persistent::Query
+
+=head1 DESCRIPTION
+
+An abstract base class for objects that build queries, providing funtionality
+for building the where clause. See WebGUI::Persistent::Query::Select for more 
+details.
+
+=head1 SYNOPSIS
+
+ use WebGUI::Persistent::Query;
+ our @ISA = qw(WebGUI::Persistent::Query);
+
+ sub buildQuery {
+      # build the query...
+      .
+      .
+      .
+ }
+
+=head1 METHODS
+
+#-------------------------------------------------------------------
+
+=head2 buildQuery
+
+Build the query from the properties. This method must be overridden by
+subclasses
+
+=cut
+
+sub buildQuery {
+     WebGUI::ErrorHandler::fatalError("buildQuery() must be overridden");
+}
+;
+
+#-------------------------------------------------------------------
+
+=head2 buildWhere
+
+Build the where clause for this query.
+
+=cut
+
+sub buildWhere {
+     my ($self) = @_;
+     my @clauses;
+
+     if (my $where = $self->parseWhereArgs(@{$self->{_where}})) {
+          return "WHERE $where";
+     }
+
+     return undef;
+}
+
+#-------------------------------------------------------------------
+
+=head2 buildWhereElement( $name, @values )
+
+Builds an element of a where clause.
+
+=cut
+
+sub buildWhereElement {
+     my ($self,$name,@vals) = @_;
+     @vals = @{$vals[0]} if ref($vals[0]);
+     return undef unless @vals;
+     return "$name = ".$self->quote($name,@vals) if (@vals == 1);
+     return "$name IN (".join(',',map {$self->quote($name,$_)} @vals).")";
+}
+
+#-------------------------------------------------------------------
+
+=head2 new( %p )
+
+=over
+
+=item properties
+
+A hashref of field name to a hash reference of property settings. 
+
+Currently used settings are:
+
+=over
+
+=item * quote
+
+If true values for this field are automatically quoted.
+
+=back
+
+=item table
+
+The name of the table to query.
+
+=item where
+
+A hash reference or array reference of arguments to build a where clause from.
+See parseWhereArgs for details.
+
+=back
+
+=cut
+
+sub new {
+     my ($class,%p) = @_;
+     $p{where} ||= [];
+     $p{where} = [$p{where}] unless ref($p{where}) eq 'ARRAY';
+     my $self = bless {
+          _where      => $p{where},
+          _properties => $p{properties},
+          _table      => $p{table},
+     }, $class;
+     return $self;
+}
+
+#-------------------------------------------------------------------
+
+sub _parsePart {
+     my ($self,$part,$or,$no_bracket) = @_;
+
+     return $part unless ref($part);
+     if (ref($part) eq 'ARRAY') {
+          my @parts;
+          foreach my $sub_part (@$part) {
+               $sub_part = $self->_parsePart($sub_part,!$or);
+               push @parts,$sub_part if $sub_part;
+          }
+          if (@parts) {
+               my $ret_val = join(($or ? ' OR ' : ' AND '),@parts);
+               return ($no_bracket ? $ret_val : "($ret_val)");
+          }
+     } elsif (ref($part) eq 'HASH') {
+          my @parts;
+          foreach my $key (keys %$part) {
+               my $clause = $self->buildWhereElement($key,$part->{$key});
+               push @parts,$clause if $clause; 
+          }
+          return $self->_parsePart(\@parts,!$or,1);
+     }
+     return '';
+}
+
+#-------------------------------------------------------------------
+
+=head2 parseWhereArgs( @argumentList)
+
+Recursivley parses a list of where arguments joining them with "AND" or "OR". Arguments 
+may take a number of forms:
+
+=over
+
+=item * scalar
+
+("A = 1") is left unchanged.
+
+=item * array reference
+
+An array reference causes the joining argument to switch from 'AND' to 'OR' 
+(or visa-versa) for its contents:
+
+([ "A = 1","C = 2" ])
+
+becomes:
+
+"(A = 1 OR C = 2)"
+
+=item * hash reference
+
+These are a convienent way of being able to dynamically build up complex 
+queries gradually.
+
+({ A => 1 , C => 2 })
+
+becomes:
+
+"A = 1 AND C = 2"
+
+=back
+
+This routine is flexiable enough to be able to parse arguments of the form:
+
+({A => [1,2]},[{B => 3,C => 4}],{D => 5})
+
+becomes:
+
+"A in (1,2) AND (B = 3 OR C = 4) AND D = 5"
+
+=cut
+
+sub parseWhereArgs {
+     my ($self,@where_arg_list) = @_;
+     my @where_parts;
+     foreach my $where_part (@where_arg_list) {
+          my $part = $self->_parsePart($where_part,1,0);
+          push @where_parts,$part if $part;
+     }
+     return $self->_parsePart(\@where_parts,0,1);
+}
+
+#-------------------------------------------------------------------
+
+=head2 quote( $propertyName, $propertyVaule )
+
+Returns a quoted value for inclusion in a query, by refering to the properties
+supplied to new().
+
+=cut
+
+sub quote {
+     my ($self,$propertyName,$propertyValue) = @_;
+  
+     return 'NULL' unless defined($propertyValue);
+
+     if ($self->{_properties}{$propertyName}{quote}) {
+          return WebGUI::SQL::quote($propertyValue);
+     }
+
+     return $propertyValue;
+}
+
+1;

lib/WebGUI/Persistent/Query/Delete.pm

@@ -0,0 +1,101 @@
+package WebGUI::Persistent::Query::Delete;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2003 Plain Black LLC.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use warnings;
+use WebGUI::Persistent::Query;
+
+our @ISA = qw(WebGUI::Persistent::Query);
+
+=head1 NAME
+
+Package WebGUI::Persistent::Query::Insert
+
+=head1 DESCRIPTION
+
+This class allows reliable dynamic building of Sql delete queries.
+
+=head1 SYNOPSIS
+
+ my $query = WebGUI::Persistent::Query::Insert->new(
+   table => 'myTable',
+   where => [A => [1,2],[{C => 'hello',B => 1}]],
+   properties => {
+     A => { },
+     B => { },
+     C => { quote => 1 },
+     D => { quote => 1 },
+   }
+ );
+
+ $query->buildQuery();
+
+Returns:
+
+  DELETE FROM myTable 
+  WHERE A IN (1,2) AND (C = 'hello' OR B = 1)
+
+=cut
+
+#-------------------------------------------------------------------
+
+=head2 buildQuery
+
+=cut
+
+sub buildQuery {
+     my ($self,%p) = @_;
+  
+     my $query = 'DELETE FROM '.$self->{_table};
+     if (my $where = $self->buildWhere()) {
+          $query .= " $where";
+     }
+  
+     return $query;
+}
+
+=head2 new( %p )
+
+=over
+
+=item properties
+
+A hashref of field name to a hash reference of property settings. 
+
+Currently used settings are:
+
+=over
+
+=item * quote
+
+If true values for this field are automatically quoted.
+
+=back
+
+=item table
+
+The name of the table to query.
+
+=item where
+
+A hash reference or array reference of arguments to build a where clause from.
+See parseWhereArgs for details.
+
+=back
+
+=cut
+
+1;

lib/WebGUI/Persistent/Query/Insert.pm

@@ -0,0 +1,115 @@
+package WebGUI::Persistent::Query::Insert;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2003 Plain Black LLC.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+
+use strict;
+use warnings;
+use WebGUI::Persistent::Query::Insert;
+
+our @ISA = qw(WebGUI::Persistent::Query);
+
+=head1 NAME
+
+Package WebGUI::Persistent::Query::Insert
+
+=head1 DESCRIPTION
+
+This class allows reliable dynamic building of Sql insert queries.
+
+=head1 SYNOPSIS
+
+ my $query = WebGUI::Persistent::Query::Insert->new(
+   table => 'myTable',
+   data => {
+     A => 1,
+     B => 2,
+     C => 'hello',
+     D => 'world'
+   },
+   properties => {
+     A => { },
+     B => { },
+     C => { quote => 1 },
+     D => { quote => 1 },
+   }
+ );
+
+ $query->buildQuery();
+
+Returns:
+
+  INSERT INTO myTable (A,B,C,D) VALUES (1,2,'hello','world');
+
+=cut
+
+#-------------------------------------------------------------------
+
+sub buildFieldValues {
+     my ($self) = @_;
+
+     my @fields = keys %{$self->{_data}};
+     my @values = map { $self->quote($_,$self->{_data}{$_})} @fields;
+
+     return "(".join(', ',@fields).") VALUES (".join(', ',@values).")";
+}
+
+#-------------------------------------------------------------------
+
+=head2 buildQuery
+
+=cut
+
+sub buildQuery {
+     my ($self) = @_;
+     return join(' ','INSERT INTO',$self->{_table},$self->buildFieldValues());
+}
+
+#-------------------------------------------------------------------
+
+=head2 new( %p )
+
+=over
+
+=item data
+
+A hash reference of field name to value.
+
+=item properties
+
+=over
+
+=item * quote
+
+If true values for this field are automatically quoted.
+
+=back
+
+=item table
+
+The name of the table to query.
+
+=back
+
+=cut
+
+sub new {
+     my ($class,%p) = @_;
+     my $self = $class->SUPER::new(%p);
+     $self->{_data} = $p{data} || {};
+     return $self;
+}
+
+1;

lib/WebGUI/Persistent/Query/Select.pm

@@ -0,0 +1,171 @@
+package WebGUI::Persistent::Query::Select;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2003 Plain Black LLC.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+
+use strict;
+use warnings;
+use WebGUI::Persistent::Query;
+
+=head1 NAME
+
+Package WebGUI::Persistent::Query::Select
+
+=head1 DESCRIPTION
+
+This class allows reliable dynamic building of Sql select queries.
+
+=head1 SYNOPSIS
+
+ my $query = WebGUI::Persistent::Query::Select->new(
+   where => [A => [1,2],[{C => 'hello',B => 1}]],
+   table => 'myTable',
+   limit => 1,
+   groupBy => 'D',
+   properties => {
+     A => { },
+     B => { },
+     C => { quote => 1 },
+     D => { quote => 1 },
+   }
+ );
+
+ $query->buildQuery();
+
+Returns:
+
+  SELECT A,B,C,D 
+  FROM myTable 
+  WHERE A IN (1,2) AND (C = 'hello' OR B = 1) LIMIT 1 GROUP BY D
+
+=cut
+
+our @ISA = qw(WebGUI::Persistent::Query);
+
+#-------------------------------------------------------------------
+
+sub buildFrom { "FROM ".$_[0]->{_table} }
+
+#-------------------------------------------------------------------
+
+sub buildGroupBy { 
+     my ($self) = @_;
+     return '' unless $self->{_groupBy} && @{$self->{_groupBy}};
+     return 'GROUP BY '.join(',',@{$self->{_groupBy}});
+}
+
+#-------------------------------------------------------------------
+
+sub buildLimit { $_[0]->{_limit} ? "LIMIT ".$_[0]->{_limit} : '' }
+
+#-------------------------------------------------------------------
+
+sub buildOrderBy { 
+     my ($self) = @_;
+     return '' unless $self->{_orderBy} && @{$self->{_orderBy}};
+     return 'ORDER BY '.join(',',@{$self->{_orderBy}});
+}
+
+#-------------------------------------------------------------------
+
+=head2 buildQuery
+
+=cut
+
+sub buildQuery {
+     my ($self) = @_;
+
+     my @clauses = ('SELECT',
+                    $self->buildSelectFields(),
+                    $self->buildFrom());
+
+     if (my $where = $self->buildWhere()) {
+          push @clauses,$where;
+     }
+     if (my $group_by = $self->buildGroupBy()) {
+          push @clauses,$group_by;
+     }
+     if (my $order_by = $self->buildOrderBy()) {
+          push @clauses,$order_by;
+     }
+     if (my $limit = $self->buildLimit()) {
+          push @clauses,$limit;
+     }
+     return join(' ',@clauses);
+}
+
+#-------------------------------------------------------------------
+
+sub buildSelectFields {
+     my ($self) = @_;
+     return join(', ',@{$self->{_fields}}) if @{$self->{_fields}};
+     return join(', ',keys %{$self->{_properties}}) if %{$self->{_properties}};
+     return '*';
+}
+
+#-------------------------------------------------------------------
+
+=head2 new( %p )
+
+=over
+
+=item fields
+
+An array reference of field names (optional).
+
+=item groupBy
+
+An array reference of fields to group results by
+
+=item limit
+
+A scalar limit.
+
+=item orderBy
+
+An array reference of fields to order results by
+
+=item properties
+
+=over
+
+=item * quote
+
+If true values for this field are automatically quoted.
+
+=back
+
+=item table
+
+The name of the table to query.
+
+=item where
+
+A hash reference or array reference of arguments to build a where clause from.
+See WebGUI::Persistent::Query::parseWhereArgs for details.
+
+=cut
+
+sub new {
+     my ($class,%p) = @_;
+     my $self = $class->SUPER::new(%p);
+     $self->{_fields} = $p{fields} || [];
+     $self->{_limit} = $p{limit};
+     $self->{_group_by} = $p{groupBy};
+     $self->{_order_by} = $p{orderBy};
+     return $self;
+}
+
+1;

lib/WebGUI/Persistent/Query/Update.pm

@@ -0,0 +1,118 @@
+package WebGUI::Persistent::Query::Update;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2003 Plain Black LLC.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+
+use strict;
+use warnings;
+use WebGUI::Persistent::Query;
+
+our @ISA = qw(WebGUI::Persistent::Query);
+
+=head1 NAME
+
+Package WebGUI::Persistent::Query::Insert
+
+=head1 DESCRIPTION
+
+This class allows reliable dynamic building of Sql insert queries.
+
+=head1 SYNOPSIS
+
+ my $query = WebGUI::Persistent::Query::Insert->new(
+   table => 'myTable',
+   where => [A => [1,2],[{C => 'hello',B => 1}]],
+   data => {
+     A => 1,
+     B => 2,
+     C => 'hello',
+     D => 'world'
+   },
+   properties => {
+     A => { },
+     B => { },
+     C => { quote => 1 },
+     D => { quote => 1 },
+   }
+ );
+
+ $query->buildQuery();
+
+Returns:
+
+  UPDATE myTable SET A = 1, B = 2, C = 'hello' C = 'world'
+  WHERE A IN (1,2) AND (C = 'hello' OR B = 1)
+
+=cut
+
+=head2 buildQuery
+
+=cut
+
+sub buildQuery {
+     my ($self) = @_;
+
+     my @clauses = ('UPDATE',$self->{_table},$self->buildSet());
+     if (my $where = $self->buildWhere()) {
+          push @clauses,$where;
+     }
+
+     return join(' ',@clauses);
+}
+
+sub buildSet {
+     my ($self) = @_;
+     'SET '.join(', ',map {
+          "$_ = ". $self->quote($_,$self->{_data}{$_})
+     } keys %{$self->{_data}});
+}
+
+=head2 new( %p )
+
+=over
+
+=item data
+
+A hash reference of field name to value.
+
+=item properties
+
+=over
+
+=item * quote
+
+If true values for this field are automatically quoted.
+
+=back
+
+=item table
+
+=item where
+
+A hash reference or array reference of arguments to build a where clause from.
+See WebGUI::Persistent::Query::parseWhereArgs for details.
+
+=back
+
+=cut
+
+sub new {
+     my ($class,%p) = @_;
+     my $self = $class->SUPER::new(%p);
+     $self->{_data} = $p{data} || {};
+     return $self;
+}
+
+1;

lib/WebGUI/Persistent/Tree.pm

@@ -0,0 +1,601 @@
+package WebGUI::Persistent::Tree;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2003 Plain Black LLC.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+
+use strict;
+use warnings;
+
+use Tree::DAG_Node;
+use WebGUI::Persistent;
+use WebGUI::SQL ();
+use WebGUI::Persistent::Query::Update;
+
+our @ISA = qw(WebGUI::Persistent Tree::DAG_Node);
+
+=head1 NAME
+
+Package WebGUI::Persistent
+
+=head1 DESCRIPTION
+
+An abstract base class for objects stored in the database, that represent tree
+structures.
+
+This class inherits from both WebGUI::Persistent (to provide get() and set() 
+methods), and from Tree::DAG_Node (to provide tree manipulation methods).
+
+=head1 SYNOPSIS
+
+ package MyTreeClass;
+
+ use WebGUI::Persistent::Tree;
+ our @ISA = qw(WebGUI::Persistent::Tree);
+
+ sub table { 'myTreeTable' }
+
+
+ sub classSettings { 
+      {
+           properties => {
+                A => { key => 1 },
+                B => { defaultValue => 5},
+                C => { quote => 1 , defaultValue => "hello world"},
+                parentId       => { defaultValue => 0 },
+                sequenceNumber => { defaultValue => 1 }
+           }
+      }
+ }
+
+ 1;
+
+ .
+ .
+ .
+
+ use MyTreeClass;
+
+ my $nodes = $class->getTree({-minmumFields});
+ print join("\n",@{$nodes->{0}->draw_ascii_tree()});
+
+=head1 METHODS
+
+#-------------------------------------------------------------------
+
+=head2 buildTree( \@objs, [ \%nodes ] )
+
+Given an array reference of objects this method will attempt to build them
+into a tree.
+
+=cut
+
+sub buildTree {
+     my ($class,$objs,$nodes) = @_;
+
+     $nodes ||= {};
+     my %parentToChild = ();
+     my $keyColumn = $class->keyColumn();
+     foreach my $obj (grep {$_} @$objs) {
+          $nodes->{$obj->get($keyColumn)} = $obj;
+          $obj->{daughters} ||= [];
+          next if ($obj->get('parentId') == $obj->get($keyColumn));
+          push @{ $parentToChild{$obj->get('parentId')} }, $obj; 
+     }
+
+     foreach my $parentId (keys %parentToChild) {
+          if (my $parent = $nodes->{$parentId}) {
+               $parent->add_daughters($class->sortSiblings($parentToChild{$parentId}));
+          }
+     }
+
+     return $nodes;
+}
+
+#-------------------------------------------------------------------
+
+=head2 canDown
+
+Returns tree if this object can be moved down within the current tree.
+
+=cut
+
+sub canDown   { $_[0]->right_sister }
+
+#-------------------------------------------------------------------
+
+=head2 canLeft
+
+Returns tree if this object can be moved left within the current tree.
+
+=cut
+
+sub canLeft   { $_[0]->mother ? 1 : 0 }
+
+#-------------------------------------------------------------------
+
+=head2 canRight
+
+Returns tree if this object can be moved right within the current tree.
+
+=cut
+
+sub canRight  { $_[0]->left_sister  }
+
+#-------------------------------------------------------------------
+
+=head2 canUp
+
+Returns tree if this object can be moved up within the current tree.
+
+=cut
+
+sub canUp     { $_[0]->left_sister  }
+
+#-------------------------------------------------------------------
+
+=head2 classSettings
+
+This class method must be overridden to return a hash reference with one or
+more of the following keys.
+
+=over
+
+=item useDummyRoot
+
+This should be set to true for classes that don't store their root node in
+the database.
+
+=item properties
+
+This should be a hash reference keyed by the field names of the table that 
+this class refers to (and should be able to be manipulated with this classes
+get() and set() methods). The values of the hash reference should be hash
+references containing settings for each field.
+
+=over
+
+=item * defaultValue 
+
+The default value for this field (optional).
+
+=item * key
+
+Should be true for the primary key column (one field must be set in this way).
+
+=item * quote
+
+Should be true for fields that need to be quoted in database queries.
+
+=back
+
+=back
+
+=cut
+
+#-------------------------------------------------------------------
+
+=head2 dummyRoot
+
+This creates a dummy root object for classes that do not store their root in
+the database.
+
+=cut
+
+sub dummyRoot {
+     $_[0]->new(
+          -properties => { pageId => 0 },
+          -noSet => 1
+     );
+}
+
+#-------------------------------------------------------------------
+
+=head2 getTree ( [ \%p, $maxDepth, \%nodes ] )
+
+This method has varying behaviour depending on the context from which it is 
+called.
+
+In instance context rows from the table will be recursivley selected using the 
+current object as the root, and then the tree will be built:
+
+  $self->getTree();
+
+In class context, the all rows are selected from the table, and then the tree
+is built.
+
+  $class->getTree();
+
+In all cases a hashref is returned.
+
+ { keyColumnValue => WebGUI::Persistent::Tree object }
+
+If defined $maxDepth maybe used to limit the depth of the recursion.
+
+If %p is defined, the arguments are passed directly to the new or multiNew
+methods, this allows multiple trees to be easily stored in one table:
+
+ $class->getTree({treeId => 4});
+
+$nodes can be a hash reference to objects that have already been obtained from
+the database.
+
+=cut
+
+sub getTree {
+     my ($self,$p,$maxDepth,$nodes) = @_;
+     my $class = ref($self) || $self;
+     $nodes ||= {};
+     $p ||={};
+
+     unless (ref($self)) {
+          if ($class->useDummyRoot()) {
+               $self = $class->dummyRoot(); 
+          }
+
+          if (!defined($maxDepth)) {
+               return $class->buildTree([$class->multiNew(%$p)],$nodes);
+          } elsif (!ref($self)) {
+               $self = $class->new(%$p,$class->keyColumn() => 0); 
+          }
+     }
+     $nodes->{$self->get($class->keyColumn())} ||= $self;
+
+     return $nodes if (defined($maxDepth) && ($maxDepth-- > 0));
+
+     my @objs = $class->multiNew(
+          parentId => $self->get($class->keyColumn()),%$p
+     );
+     if (@objs) {
+          $self->buildTree(\@objs,$nodes);
+          return $nodes if (defined($maxDepth) && !$maxDepth) ;
+          $_->getTree($p,$maxDepth,$nodes) foreach @objs;
+     }
+  
+     return $nodes;
+}
+
+#-------------------------------------------------------------------
+
+=head2 grandmotherChildrenAndSelf( $keyColumnId )
+
+Using the given $keyColumnId this method fetches the grandmother, children,
+and the object refered to by the $keyColumnId.
+
+Returns a list of objects.
+
+=cut
+
+sub grandmotherChildrenAndSelf {
+     my ($class,$keyColumnId) = @_;
+     return undef unless defined($keyColumnId);
+     my $self = $class->new(-minimumFields=>1,$class->keyColumn() => $keyColumnId);
+     return undef unless $self;
+     return ($self,$class->motherSelfAndSisters($self->get('parentId')));
+}
+
+#-------------------------------------------------------------------
+
+=head2 minimumFields
+
+The minimumFields for Trees must also include the parentId, and the 
+sequenceNumber.
+
+See WebGUI::Persistent.
+
+=cut
+
+sub minimumFields {
+     my ($class) = @_;
+     unless ($class->classData->{minimumFields}) {
+          my $fields = $class->SUPER::minimumFields();
+          push @$fields, 'parentId';
+          push @$fields, 'sequenceNumber' if ($class->properties->{sequenceNumber});
+     }
+     return $class->classData->{minimumFields};
+}
+
+#-------------------------------------------------------------------
+
+=head2 motherSelfAndSisters( $keyColumnId )
+
+Given the $keyColumnId, this method fetches the related mother and sisters.
+
+Returns a list of objects.
+
+=cut
+
+sub motherSelfAndSisters {
+     my ($class,$keyColumnId) = @_;
+     return undef unless defined($keyColumnId);
+     my $self = $class->new(-minimumFields=>1,$class->keyColumn() => $keyColumnId);
+     return undef unless $self;
+  
+     my $parentId = $self->get('parentId');
+     my @objs = $class->multiNew(
+          -minimumFields => 1,
+          -where => [
+               [{
+                    parentId => $parentId,
+                    $class->keyColumn() => $parentId,
+               }],
+               $class->keyColumn()." != $keyColumnId",
+          ]
+     );
+     if ($class->useDummyRoot() && $parentId == 0) {
+          push @objs, $class->dummyRoot();
+     }
+     return ($self,@objs);
+}
+
+#-------------------------------------------------------------------
+
+=head2 moveDown( [ $keyColumnId ] )
+
+In class context:
+
+ $class->moveDown($keyColumnId);
+
+The required parent, sister and child objects are fetched from the database,
+and the tree is built and manipulated.This class' inheritance from 
+WebGUI::Persistent takes care of any database work.
+
+In instance context:
+
+ $self->moveDown();
+
+The current object is assumed to be in a pre-built tree, and so the tree is 
+simply manipulated. This class' inheritance from WebGUI::Persistent takes care
+of any database work.
+
+=cut
+
+sub moveDown {
+     my ($self,$keyColumnId) = @_;
+     my $class = ref($self) || $self;
+     return unless $class->properties->{sequenceNumber};
+  
+     unless (ref($self)) {
+          my $nodes = $class->buildTree([$class->motherSelfAndSisters($keyColumnId)]);
+          $self = $nodes->{$keyColumnId};
+     }
+
+     return unless ($self && $self->canDown());
+
+     my $right = $self->right_sister;
+     $self->swapSisters($right);
+}
+
+#-------------------------------------------------------------------
+
+=head2 moveLeft( [ $keyColumnId ] )
+
+In class context:
+
+ $class->moveLeft($keyColumnId);
+
+The required parent, sister and child objects are fetched from the database,
+and the tree is built and manipulated.This class' inheritance from 
+WebGUI::Persistent takes care of any database work.
+
+In instance context:
+
+ $self->moveLeft();
+
+The current object is assumed to be in a pre-built tree, and so the tree is 
+simply manipulated. This class' inheritance from WebGUI::Persistent takes care
+of any database work.
+
+=cut
+
+sub moveLeft {
+     my ($self,$keyColumnId) = @_;
+     my $class = ref($self) || $self;
+
+     unless (ref($self)) {
+          my $nodes = $class->buildTree([$class->grandmotherChildrenAndSelf($keyColumnId)]);
+          $self = $nodes->{$keyColumnId};
+     }
+
+     return unless ($self && $self->canLeft());
+
+     my $sister = $self->mother;
+
+     # Close up hole left by imminent move
+     map {
+          $_->set({sequenceNumber => $_->get('sequenceNumber') - 1 })
+     } $self->right_sisters();
+
+     $self->unlink_from_mother;
+     $sister->add_right_sister($self);
+
+     my $newSequenceNumber = $sister->get('sequenceNumber') + 1;
+
+     map {
+          $_->set({sequenceNumber => $_->get('sequenceNumber') + 1 })
+     } $self->right_sisters();
+
+     $self->set({
+          parentId => $sister->get('parentId'), 
+          sequenceNumber => $newSequenceNumber
+     });
+}
+
+#-------------------------------------------------------------------
+
+=head2 moveRight( [ $keyColumnId ] )
+
+In class context:
+
+ $class->moveRight($keyColumnId);
+
+The required parent, sister and child objects are fetched from the database,
+and the tree is built and manipulated.This class' inheritance from 
+WebGUI::Persistent takes care of any database work.
+
+In instance context:
+
+ $self->moveRight();
+
+The current object is assumed to be in a pre-built tree, and so the tree is 
+simply manipulated. This class' inheritance from WebGUI::Persistent takes care
+of any database work.
+
+=cut
+
+sub moveRight {
+     my ($self,$keyColumnId) = @_;
+     my $class = ref($self) || $self;
+  
+     unless (ref($self)) {
+          my @objs = $class->motherSelfAndSisters($keyColumnId);
+          my $nodes = $class->buildTree(\@objs);
+          $self = $nodes->{$keyColumnId};
+     }
+
+     return unless ($self && $self->canRight());
+
+     my $keyColumn = $class->keyColumn();
+     my $mother = $self->left_sister;
+     $mother->getTree({-minimumFields => 1},1);
+
+     # Close up hole left by imminent move
+     map {
+          $_->set({sequenceNumber => $_->get('sequenceNumber') -1 })
+     } $self->right_sisters();
+
+     # Add as right-most daughter of current left-sister
+     $self->unlink_from_mother;
+     $mother->add_daughter($self);
+
+     my $newSequenceNumber = 1;
+     if (my $sister = $self->left_sister()) {
+          $newSequenceNumber = $sister->get('sequenceNumber') + 1;
+     }
+
+     $self->set({
+          parentId => $mother ? $mother->get($keyColumn) : 0, 
+          sequenceNumber => $newSequenceNumber
+     });
+}
+
+#-------------------------------------------------------------------
+
+=head2 moveUp( [ $keyColumnId ] )
+
+In class context:
+
+ $class->moveUp($keyColumnId);
+
+The required parent, sister and child objects are fetched from the database,
+and the tree is built and manipulated.This class' inheritance from 
+WebGUI::Persistent takes care of any database work.
+
+In instance context:
+
+ $self->moveUp();
+
+The current object is assumed to be in a pre-built tree, and so the tree is 
+simply manipulated. This class' inheritance from WebGUI::Persistent takes care
+of any database work.
+
+=cut
+
+sub moveUp {
+     my ($self,$keyColumnId) = @_;
+     my $class = ref($self) || $self;
+     return unless $class->properties->{sequenceNumber};
+
+     unless (ref($self)) {
+          my $nodes = $class->buildTree([$class->motherSelfAndSisters($keyColumnId)]);
+          $self = $nodes->{$keyColumnId};
+     }
+
+     return unless ($self && $self->canUp());
+
+     my $left = $self->left_sister;
+     $self->swapSisters($left);
+}
+
+#-------------------------------------------------------------------
+
+=head2 recursiveDelete
+
+Deletes this element, and all subsequent elements in the tree. The C<getTree> 
+method must have been called to build the tree.
+
+=cut
+
+sub recursiveDelete {
+     my ($self) = @_;
+     my @ids;
+     $self->walk_down({callback => sub {push @ids, $_[0]->get($_[0]->keyColumn())}});
+     $self->multiDelete(collateralFolderId => \@ids) if @ids;
+     return @ids;
+}
+
+#-------------------------------------------------------------------
+
+=head2 sortSiblings( \@siblings )
+
+Sorts an array of objects according to sequenceNumber
+
+=cut
+
+sub sortSiblings {
+     my ($class,$siblings) = @_;
+     return @$siblings unless $class->properties->{sequenceNumber};
+     return sort { 
+          ($a->get('sequenceNumber') <=> $b->get('sequenceNumber')) 
+     } @$siblings;
+}
+
+#-------------------------------------------------------------------
+
+=head2 swapSisters( $sister )
+
+Swaps two sisters over (they must be in a built tree), and updates their
+sequenc numbers.
+
+=cut
+
+sub swapSisters {
+     my $self = shift;
+     my ($other) = @_;
+     my @daughters = $self->self_and_sisters;
+     my $a = $self ->my_daughter_index;
+     my $b = $other->my_daughter_index;
+     @daughters[$a, $b] = ($other, $self);
+     $self->mother->set_daughters(@daughters);
+
+     my $tmp = $self->get('sequenceNumber');
+     $self->set({sequenceNumber => $other->get('sequenceNumber')});
+     $other->set({sequenceNumber => $tmp});
+}
+
+=head2 useDummyRoot
+
+Returns true if useDummyRoot is set in classSettings().
+
+=cut 
+
+sub useDummyRoot {
+     my ($class) = @_;
+     unless ($class->classData->{useDummyRoot}) {
+          $class->classData->{useDummyRoot} = $class->classSettings->{useDummyRoot};
+     }
+     return $class->classData->{useDummyRoot}
+}
+
+1;