source: main/trunk/greenstone2/perllib/ClassifyTreeModel.pm@ 21308

package ClassifyTreeModel;

use ClassifyTreeNode;
use GDBMUtils;
use strict;

# /** Constructor
#  *
#  *  @param  $class       The name of the class to bless as a string
#  *  @param  $collection  The name of the collection whose GDBM database we
#  *                       will be accessing as a string
#  *  @param  $root        The oid of the root node of the classifier as a
#  *                       string
#  *  @return A reference to the ClassifyTreeModel object
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub new()
  {
    my ($class, $collection, $root) = @_;
    my $debug = 0;
    print STDERR "ClassifyTreeModel.new(\"$collection\", \"$root\")\n" unless !$debug;
    # Store the variables
    my $self = {};
    $self->{'collection'} = $collection;
    $self->{'debug'} = $debug;
    $self->{'root'} = $root;
    # Bless me father for I have sinned
    bless $self, $class;
    return $self;
  }
# /** new() **/

# /** Given a path and a document id, add this document to the classifier tree
#  *  creating any necessary tree nodes first.
#  *
#  *  @param  $value The path to store this document in
#  *  @param  $oid Unique identifier of a document
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub addDocument()
  {
    my ($self, $value, $oid) = @_;
    print STDERR "ClassifyTreeModel.addDocument(\"$value\", \"$oid\")\n" unless !$self->{'debug'};
    # Generate a treepath object from the metadata value, remembering to prefix
    # with the root nodes path
    my $root_node_obj = $self->getRootNode();
    my $path_obj = $root_node_obj->getPath();
    $path_obj->addPathComponent($value);
    # Ensure that this classifier node, and if necessary its ancestor nodes,
    # exist in our tree.
    my $node_obj = $self->getNodeByPath($path_obj);
    if (!$node_obj)
      {
        # The node doesn't exist, so we need to add it
        $node_obj = $self->addNode($path_obj);
      }
    # Add the document to the node.
    $node_obj->addDocument($oid);
    # Done.
  }
# /** addDocument() **/

# /** Add a node into the tree first ensuring all its parent nodes are inserted
#  *  to.
#  *
#  *  @param  $path_obj The path to insert the new node at
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub addNode()
  {
    my ($self, $path_obj) = @_;
    print STDERR "ClassifyTreeModel.addNode(\"" . $path_obj->toString() . "\")\n" unless !$self->{'debug'};
    # Ensure the parent exists, assuming we aren't at the root
    my $parent_path_obj = $path_obj->getParentPath();
    #rint STDERR "* parent path: " . $parent_path_obj->toString() . "\n";
    my $parent_node_obj = $self->getNodeByPath($parent_path_obj);
    #rint STDERR "* does parent node already exist? " . $parent_node_obj . "\n";
    #rint STDERR "* are we at the root node yet? " . $parent_path_obj->isRootPath() . "\n";
    if (!$parent_node_obj && !$parent_path_obj->isRootPath())
      {
        #rint STDERR "* recursive call!\n";
        $parent_node_obj = $self->addNode($parent_path_obj);
      }
    # Insert this node into it's parent.
    return $parent_node_obj->insertNode($path_obj);
  }
# /** addNode() **/

# /** Retrieve the name of the collection this model is drawing from.
#  *
#  *  @return The collection name as a string
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub getCollection()
  {
    my ($self) = @_;
    print STDERR "ClassifyTreeModel.getCollection()\n" unless !$self->{'debug'};
    return $self->{'collection'};
  }
# /** getCollection() **/

# /** Retrieve a node from this tree based upon its CLID (OID).
#  *  @param  $clid  The CLID as a string
#  *  @return The indicated ClassifyTreeNode or null
sub getNodeByCLID()
  {
    my ($self, $clid) = @_;
    print STDERR "ClassifyTreeModel.getNodeByCLID(\"$clid\")\n" unless !$self->{'debug'};
    my $result = 0;
    # Test if this clid is even in our tree
    if($clid !~ /^$self->{'root'}/)
      {
        print STDERR "Requested node $clid, which isn't part of " . $self->{'root'} . "\n";
        return 0;
      }
    # Unfortunately I have to check that there is text to retrieve before I
    # create a new node.
    if(&GDBMUtils::gdbmCachedCollectionGet($self->getCollection(), $clid) =~ /\w+/)
      {
        # Since the CLID can directly reference the correct entry in the GDBM we
        # just create the node and return it
        $result = new ClassifyTreeNode($self, $clid);
      }
    return $result;
  }

# /** Retrieve a node from this tree based upon a path
#  *
#  *  @param  $path  The path to the node as a ClassifyTreePath
#  *  @return The indicated ClassifyTreeNode or null
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub getNodeByPath()
  {
    my ($self, $path_obj) = @_;
    print STDERR "ClassifyTreeModel.getNodeByPath(\"" . $path_obj->toString() . "\")\n" unless !$self->{'debug'};
    # Starting at the ROOT of the tree, and with the first path component,
    # recursively descend through the tree looking for the node - we can assume
    # that we've found the root node (otherwise we won't be in a tree)
    my $cur_node_obj = $self->getRootNode();
    my $cur_path_obj = $cur_node_obj->getPath();
    my $depth = 1;
    # Continue till we either find the node we want, or run out a nodes
    while(!$cur_node_obj->getPath()->equals($path_obj))
      {
        # Append the path component at this depth to the current path we
        # are searching for
        $cur_path_obj->addPathComponent($path_obj->getPathComponent($depth));
        $depth++;
        #rint STDERR "Searching " . $cur_node_obj->getPath()->toString() . "'s children for: " . $cur_path_obj->toString() . "\n";
        # Search through the current nodes children, looking for one that
        # matches the current path
        my $found = 0;
        foreach my $child_node_obj ($cur_node_obj->getChildren())
          {
            #rint STDERR "* testing " . $child_node_obj->getPath()->toString() . "\n";
            if($child_node_obj->getPath()->equals($cur_path_obj))
              {
                $cur_node_obj = $child_node_obj;
                $found = 1;
                last;
              }
          }
        # Couldn't find any node with this path
        if(!$found)
          {
            #rint STDERR "* no such node exists!\n";
            return 0;
          }
      }
    return $cur_node_obj;
  }
# /** getChild() **/

# /** Retrieve the parent node of the given node.
#  *
#  *  @param  $child_node The node whose parent we want to retrieve
#  *  @return The parent node, or 0 if this is the root
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub getParentNode()
  {
    my ($self, $child_node) = @_;
    print STDERR "ClassifyTreeModel.getParentNode()\n" unless !$self->{'debug'};
    return $child_node->getParentNode();
  }
# /** getParentNode() **/

sub getRootNode()
{
  my ($self) = @_;
  print STDERR "ClassifyTreeModel.getRootNode()\n" unless !$self->{'debug'};
  return new ClassifyTreeNode($self, $self->{'root'});
}

# /** Remove the given document from the classifier tree, and then remove any
#  *  empty nodes if required.
#  *
#  *  @param  $value The value which contains the path of the node to remove
#  *                 the document from
#  *  @param  $oid The unique identifier of the document to remove
#  *  @param  $remove_empty Sets whether empty nodes are removed
#  *
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub removeDocument()
  {
    my ($self, $path, $oid, $remove_empty) = @_;
    print STDERR "ClassifyTreeModel.removeDocument(\"$path\",\"$oid\",$remove_empty)\n" unless !$self->{'debug'};
    # Append to root path
    my $root_node_obj = $self->getRootNode();
    my $path_obj = $root_node_obj->getPath();
    $path_obj->addPathComponent($path);
    # Retrieve the node in question
    my $node_obj = $self->getNodeByPath($path_obj);
    # Check we retrieved a node
    if ($node_obj)
      {
        # Remove the document
        $node_obj->removeDocument($oid);
        # If we have been asked to remove empty nodes, do so now.
        if ($remove_empty)
          {
            my $cur_node_obj = $node_obj;
            my $empty_node_obj = 0;
            while ($cur_node_obj->getNumLeafDocs() == 0)
              {
                $empty_node_obj = $cur_node_obj;
                $cur_node_obj = $cur_node_obj->getParentNode();
              }
            if ($empty_node_obj)
              {
                # Try to retrieve the parent of this node
                my $parent_node_obj = $empty_node_obj->getParentNode();
                # As long as we have a parent (i.e. we aren't the root node) go
                # ahead and delete this subtree starting at empty node
                if ($parent_node_obj)
                  {
                    $parent_node_obj->removeNode($empty_node_obj);
                  }
              }
          }
      }
    # If the node doesn't exist in this tree, then we can't very well remove
    # anything from it!
  }
# /** removeDocument() **/

1;