root/main/trunk/greenstone2/perllib/ClassifyTreeNode.pm @ 21562

Revision 21562, 23.8 KB (checked in by mdewsnip, 10 years ago)

Changed calls to GDBMUtils::gdbmCachedCollectionSet() to dbutil::write_infodb_entry(). Part of removing GDBMUtils.pm and making the code less GDBM-specific.

  • Property svn:keywords set to Author Date Id Revision
Line 
1package ClassifyTreeNode;
2
3use ClassifyTreeNode;
4use ClassifyTreePath;
5use GDBMUtils;
6use strict;
7
8# /** Constructor
9#  *
10#  *
11#  *  @author John Thompson, DL Consulting Ltd.
12#  */
13sub new()
14  {
15    my ($class, $model, $clid, $force_new) = @_;
16    my $debug = 0;
17    $force_new = 0 unless defined($force_new);
18    print STDERR "ClassifyTreeNode.new(model, \"$clid\", $force_new)\n" unless !$debug;
19    $force_new = 0 unless defined($force_new);
20    # Test the parameters
21    die("Can't create a tree node that doesn't belong to a tree model!") unless $model;
22    die("Can't create a tree node that doesn't have a unique id (OID)!") unless $clid;
23    # Store the variables
24    my $self = {};
25    $self->{'debug'} = $debug;
26    $self->{'model'} = $model;
27    $self->{'clid'} = $clid;
28
29    my $collection = $model->getCollection();
30
31    my $index_text_directory_path = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection, "index", "text");
32    $self->{'infodb_file_path'} = &dbutil::get_infodb_file_path("gdbm", $collection, $index_text_directory_path);
33
34    # Check if this node already exists in the database, and if not insert it
35    # now
36    my $text = &dbutil::read_infodb_entry("gdbm", $self->{'infodb_file_path'}, $clid);
37    if($text !~ /\w+/ && $force_new)
38      {
39    my $infodb_file_handle = &dbutil::open_infodb_write_handle("gdbm", $self->{'infodb_file_path'}, "append");
40    &dbutil::write_infodb_entry("gdbm", $infodb_file_handle, $clid, &dbutil::convert_infodb_string_to_hash("<doctype>classify\n<hastxt>0\n<childtype>VList\n<Title>\n<numleafdocs>0\n<contains>\n"));
41    &dbutil::close_infodb_write_handle("gdbm", $infodb_file_handle);
42      }
43    # Bless me father for I have sinned
44    bless $self, $class;
45    return $self;
46  }
47# /** new() **/
48
49# /** Add a document to this tree node.
50#  *
51#  *  @param  $oid The unique identifier of the document to add
52#  *
53#  *  @author John Thompson, DL Consulting Ltd
54#  */
55sub addDocument()
56  {
57    my ($self, $oid) = @_;
58    print STDERR "ClassifyTreeNode.addDocument(\"$oid\")\n" unless !$self->{'debug'};
59    # Get the current contains list
60    my $contains = $self->getContains();
61    # See whether this document already exists in the contains
62    if ($contains !~ /(^$oid$|^$oid;$|;$oid;|;$oid$)/)
63      {
64        # If not, append to the contains list
65        if ($contains ne "")
66          {
67            $contains .= ";$oid";
68          }
69        else
70          {
71            $contains = $oid;
72          }
73        # Store the changed contains
74        $self->setContains($contains);
75        # We now have to update the numleafdocs count for this node and its
76        # ancestor nodes
77        my $cur_node_obj = $self;
78        while ($cur_node_obj)
79          {
80            my $numleafdocs = $cur_node_obj->getNumLeafDocs();
81            if ($numleafdocs =~ /^\d+$/)
82              {
83                $numleafdocs ++;
84              }
85            else
86              {
87                $numleafdocs = 1;
88              }
89            $cur_node_obj->setNumLeafDocs($numleafdocs);
90            $cur_node_obj = $cur_node_obj->getParentNode();
91          }
92      }
93    else
94      {
95        print STDERR "Document already exists!\n" unless !$self->{'debug'};
96      }
97  }
98# /** addDocument() **/
99
100# /** Changes the CLID of a particular node. Note that this is significantly
101#  *  tricky step, as we have to remove the old node from the database, and
102#  *  then readd with the corrected CLID.
103#  *
104#  *  @param  $clid The new CLID as an integer
105#  *
106#  *  @author John Thompson, DL Consulting Ltd.
107#  */
108sub changeCLID()
109  {
110    my($self, $new_clid) = @_;
111    print STDERR "ClassifyTreeNode.changeCLID(\"$new_clid\")\n" unless !$self->{'debug'};
112    # Store the current clid for later use
113    my $old_clid = $self->{'clid'};
114    # And record the children now, as they'll change after we shift the parent
115    # CLID
116    my @child_nodes = $self->getChildren();
117
118    # Retrieve the current document
119    my $text = $self->toString();
120
121    my $collection = $self->{'model'}->getCollection();
122
123    # Create a new document with the correct CLID
124    my $infodb_file_handle = &dbutil::open_infodb_write_handle("gdbm", $self->{'infodb_file_path'}, "append");
125    &dbutil::write_infodb_entry("gdbm", $infodb_file_handle, $new_clid, &dbutil::convert_infodb_string_to_hash($text));
126    # Remove the old document
127    &dbutil::delete_infodb_entry("gdbm", $infodb_file_handle, $self->{'clid'});
128    &dbutil::close_infodb_write_handle("gdbm", $infodb_file_handle);
129
130    # Finally, change the clid stored in this document
131    $self->{'clid'} = $new_clid;
132
133    # Now go through this nodes children, and shift them too
134    foreach my $child_node (@child_nodes)
135      {
136        # We determine the new clid by retrieving the childs current clid,
137        # and then replacing any occurance to the parents old clid with the
138        # parents new clid
139        my $old_child_clid = $child_node->getCLID();
140        #rint STDERR "* considering: " . $old_child_clid . "\n";
141        if($old_child_clid =~ /^CL/)
142          {
143            my $new_child_clid = $new_clid . substr($old_child_clid, length($old_clid));
144            #rint STDERR "* shifting child $old_child_clid to $new_child_clid\n";
145            $child_node->changeCLID($new_child_clid);
146          }
147      }
148  }
149# /** changeCLID() **/
150
151
152# /** Retrieve the unique id for this classifier.
153#  *
154#  *  @return The CLID as a string
155#  *
156#  *  @author John Thompson, DL Consulting Ltd.
157#  */
158sub getCLID()
159  {
160    my ($self) = @_;
161    print STDERR "ClassifyTreeNode.getCLID()\n" unless !$self->{'debug'};
162    return $self->{'clid'};
163  }
164
165# /** Return the child objects of this node an as array.
166#  *
167#  *  @return An array of node objects
168#  *
169#  *  @author John Thompson, DL Consulting Ltd.
170#  */
171sub getChildren()
172  {
173    my ($self) = @_;
174    print STDERR "ClassifyTreeNode.getChildren()\n" unless !$self->{'debug'};
175    my $text = $self->toString();
176    my @children = ();
177    # Retrieve the contains metadata item
178    if($text =~ /<contains>(.*?)\r?\n/)
179      {
180        #rint STDERR "* children formed from contains: $1\n";
181        my $contains_raw = $1;
182        my @contains = split(/;/, $contains_raw);
183        foreach my $child_clid (@contains)
184          {
185            # Replace the " with the parent clid
186            $child_clid =~ s/\"/$self->{'clid'}/;
187            # Create the node obj
188            my $child_node_obj = new ClassifyTreeNode($self->{'model'}, $child_clid);
189            # And insert into ever growing array of child nodes
190            push(@children, $child_node_obj);
191          }
192      }
193    return @children;
194  }
195# /** getChildren() **/
196
197# /** Retrieve the contains metadata which is used to determine this nodes
198#  *  children.
199#  *
200#  *  @return The contains metadata as a string
201#  *
202#  *  @author John Thompson, DL Consulting Ltd.
203#  */
204sub getContains()
205  {
206    my ($self) = @_;
207    print STDERR "ClassifyTreeNode.getContains()\n" unless !$self->{'debug'};
208    my $result = 0;
209    my $text = $self->toString();
210    if($text =~ /<contains>(.*?)\r?\n/)
211      {
212        $result = $1;
213        # Replace " with this nodes CLID
214        $result =~ s/\"/$self->{'clid'}/g;
215      }
216    return $result;
217  }
218# /** getContains() **/
219
220# /** Retrieve this nodes next sibling.
221#  *
222#  *  @return The next sibling node object or 0 if no such node
223#  *
224#  *  @author John Thompson, DL Consulting Ltd.
225#  */
226sub getNextSibling()
227  {
228    my ($self) = @_;
229    print STDERR "ClassifyTreeNode.getNextSibling()\n" unless !$self->{'debug'};
230    my $sibling_node = 0;
231    # The next sibling would be the node identified by the CLID with its
232    # suffix number one greater than this nodes CLID.
233    my @clid_parts = split(/\./, $self->{'clid'});
234    my $suffix = pop(@clid_parts);
235    $suffix++;
236    push(@clid_parts, $suffix);
237    my $next_clid = join(".", @clid_parts);
238
239    my $collection = $self->{'model'}->getCollection();
240
241    # Now determine if this node exists.
242    if (&dbutil::read_infodb_entry("gdbm", $self->{'infodb_file_path'}, $next_clid) =~ /\w+/)
243      {
244        # And if so, create it.
245        $sibling_node = new ClassifyTreeNode($self->{'model'}, $next_clid);
246      }
247    # Done
248    return $sibling_node;
249  }
250# /** getNextSibling() **/
251
252# /** Retrieve the numleafdocs metadata which if affected by any changes to
253#  *  child nodes.
254#  *
255#  *  @return The numleafdocs as an integer
256#  *
257#  *  @author John Thompson, DL Consulting Ltd.
258#  */
259sub getNumLeafDocs()
260  {
261    my ($self) = @_;
262    print STDERR "ClassifyTreeNode.getNumLeafDocs()\n" unless !$self->{'debug'};
263    my $result = 0;
264    my $text = $self->toString();
265    if($text =~ /<numleafdocs>(\d*?)\r?\n/)
266      {
267        $result = $1;
268      }
269    return $result;
270  }
271# /** getNumLeafDocs() **/
272
273# /** Retrieve the parent node of the given node.
274#  *
275#  *  @param  $child_node The node whose parent we want to retrieve
276#  *  @return The parent node, or 0 if this is the root
277#  *
278#  *  @author John Thompson, DL Consulting Ltd.
279#  */
280sub getParentNode()
281  {
282    my ($self) = @_;
283    print STDERR "ClassifyTreeNode.getParentNode()\n" unless !$self->{'debug'};
284    my $parent_node = 0;
285    my $child_clid = $self->getCLID();
286    my @clid_parts = split(/\./, $child_clid);
287    if(scalar(@clid_parts) > 1)
288      {
289        pop(@clid_parts);
290        my $parent_clid = join(".", @clid_parts);
291        $parent_node = $self->{'model'}->getNodeByCLID($parent_clid);
292      }
293    # Otherwise we are already at the root node
294    return $parent_node;
295  }
296# /** getParentNode() **/
297
298# /** Retrieve the path to this node.
299#  *
300#  *  @return The path obj which represents the path to this node or 0 if no
301#  *          path information exists
302#  *
303#  *  @author John Thompson, DL Consulting Ltd.
304#  */
305sub getPath()
306  {
307    my ($self) = @_;
308    print STDERR "ClassifyTreeNode.getPath()\n" unless !$self->{'debug'};
309    my $result = 0;
310    my $text = $self->toString();
311    if($text =~ /<Title>(.*?)\r?\n/ )
312      {
313        my $this_component = $1;
314        # If this node has a parent, then retrieve its path
315        my $parent_node = $self->getParentNode();
316        if ($parent_node)
317          {
318            # Get the path...
319            $result = $parent_node->getPath();
320            # ... and add our component
321            $result->addPathComponent($this_component);
322          }
323        else
324          {
325            $result = new ClassifyTreePath($this_component);
326          }
327      }
328    return $result;
329  }
330# /** getPath() **/
331
332# /** Retrieve the title of this node. This returns essentially the same
333#  *  information as getPath, but without the encapsulating object.
334#  *
335#  *  @return The title as a string
336#  *
337#  *  @author John Thompson, DL Consulting Ltd.
338#  */
339sub getTitle()
340  {
341    my ($self) = @_;
342    print STDERR "ClassifyTreeNode.getTitle()\n" unless !$self->{'debug'};
343    my $result = 0;
344    my $text = $self->toString();
345    if($text =~ /<Title>(.*?)\r?\n/)
346      {
347        $result = $1;
348      }
349    return $result;
350  }
351# /** getTitle() **/
352
353# /** Using the given value locate the correct position to insert a new node,
354#  *  create it, and then establish it in the database.
355#  *
356#  *  @param  $path The path used to determine where to insert node as a string
357#  *  @return The newly inserted node object
358#  *
359#  *  @author John Thompson, DL Consulting Ltd.
360#  */
361sub insertNode()
362  {
363    my ($self, $path) = @_;
364    print STDERR "ClassifyTreeNode.insertNode(\"$path\")\n" unless !$self->{'debug'};
365    my $child_clid = "";
366    my $child_node = 0;
367    my $new_contains = "";
368    # Get the children of this node
369    my @children = $self->getChildren();
370    # If there are no current children, then this will be the first
371    if (scalar(@children) == 0)
372      {
373        #rint STDERR "ClassifyTreeNode.insertNode: first child!\n";
374        $child_clid = $self->{'clid'} . ".1"; # First child
375        # Contains needs to have this new clid added
376        $new_contains = $child_clid;
377      }
378    # Otherwise search through the current children, looking at their values
379    # to locate where to insert this node.
380    else
381      {
382        #rint STDERR "ClassifyTreeNode.insertNode: searching for position...\n";
383        my $found = 0;
384        my $offset = 1;
385        foreach my $sibling_node (@children)
386          {
387            my $sibling_path = $sibling_node->getPath();
388            # If we are still searching for the insertion point
389            if(!$found)
390              {
391                if($sibling_path->toString() eq $path->toString())
392                  {
393                    # What?!? This node already exists! why are we adding it again!
394                    print STDERR "ClassifyTreeNode.insertNode: what?!? node already exists... how did we get here?\n";
395                    return $sibling_node;
396                  }
397                elsif($sibling_path->toString() gt $path->toString())
398                  {
399                    # Found our location!
400                    $found = 1;
401                    $child_clid = $self->{'clid'} . "." . $offset;
402                    # You may notice we haven't added this node to contains.
403                    # This is because the parent node already contains this
404                    # clid - instead we need to record the new highest clid
405                    # created when we move the sibling nodes for here onwards
406                    # up one space.
407                    #rint STDERR "ClassifyTreeNode.insertNode: found our location: $child_clid \n";
408                    last;
409                  }
410              }
411            $offset++;
412          }
413        # If we haven't found the node, we insert at the end.
414        if(!$found)
415          {
416            #rint STDERR "ClassifyTreeNode.insertNode not found... insert at end \n";
417            $child_clid = $self->{'clid'} . "." . $offset;
418            # Contains needs to have this new clid added
419            $new_contains = $child_clid;
420          }
421        # If we did find the node, we now have to go through the sibling nodes
422        # shifting them up one CLID to ensure there's space.
423        else
424          {
425            # We need another copy of children, but this time with the last
426            # children first!
427            @children = reverse $self->getChildren();
428            my $offset2 = scalar(@children) + 1;
429            foreach my $sibling_node (@children)
430              {
431                $sibling_node->changeCLID($self->{'clid'} . "." . $offset2);
432                # If this if the highest sibling node we are going to rename,
433                # then use it to set the contains metadata.
434                if($new_contains !~ /\w+/)
435                  {
436                    $new_contains = $self->{'clid'} . "." . $offset2;
437                  }
438                # Once we've processed the node exactly in the space the new
439                # node will occupy, we're done.
440                $offset2--;
441                if($offset2 == $offset)
442                  {
443                    last;
444                  }
445              }
446          }
447      }
448    $child_node = new ClassifyTreeNode($self->{'model'}, $child_clid, 1);
449    # Set the value, as this is the only piece of metadata we know and care
450    # about at this stage
451    $child_node->setTitle($path->getLastPathComponent());
452    # Update the contains metadata for this node
453    my $contains = $self->getContains();
454    if($contains =~ /\w/)
455      {
456        $contains .= ";" . $new_contains;
457      }
458    else
459      {
460        $contains = $new_contains;
461      }
462    $self->setContains($contains);
463    # And return the node
464    return $child_node;
465  }
466# /** insertNode() **/
467
468# /** Remove all the children of this node and return the number of document
469#  *  references (leaf nodes) removed by this process.
470#  *
471#  *  @return The count of document references removed as an integer
472#  *
473#  *  @author John Thompson, DL Consulting Ltd
474#  */
475sub removeAllNodes()
476  {
477    my ($self) = @_;
478    print STDERR "ClassifyTreeNode.removeAllNodes()\n" unless !$self->{'debug'};
479    my $num_leaf_docs = 0;
480    # Recursively remove this nodes children
481    my @children = $self->getChildren();
482    foreach my $child_node (@children)
483      {
484        $child_node->removeAllNodes();
485      }
486    # Retrieve the document count (leaf docs)
487    my $text = $self->toString();
488    if ($text =~ /<numleafdocs>(\d+)/)
489      {
490        $num_leaf_docs += $1;
491      }
492    # Now remove the node from the database
493    my $infodb_file_handle = &dbutil::open_infodb_write_handle("gdbm", $self->{'infodb_file_path'}, "append");
494    &dbutil::delete_infodb_entry("gdbm", $infodb_file_handle, $self->{'clid'});
495    &dbutil::close_infodb_write_handle("gdbm", $infodb_file_handle);
496
497    # Return the leaf count (so we can adjust the numleafdocs at the root node
498    # of this deletion.
499    return $num_leaf_docs;
500  }
501# /** removeAllNodes() **/
502
503# /** Remove the given document this node, and then update the numleafdocs
504#  *  metadata for all the ancestor nodes.
505#  *
506#  *  @param  $oid The unique identifier of a greenstone document
507#  *
508#  *  @author John Thompson, DL Consulting Ltd.
509#  */
510sub removeDocument()
511  {
512    my ($self, $oid) = @_;
513    print STDERR "ClassifyTreeNode::removeDocument(\"$oid\")\n" unless !$self->{'debug'};
514    # Retrieve the contains metadata
515    my $contains = $self->getContains();
516    # Remove this oid
517    my @contains_parts = split(/;/, $contains);
518    my @new_contains_parts = ();
519    foreach my $oid_or_clid (@contains_parts)
520      {
521        if ($oid ne $oid_or_clid && $oid_or_clid =~ /[\w\d]+/)
522          {
523            push(@new_contains_parts, $oid_or_clid);
524          }
525      }
526    $contains = join(";", @new_contains_parts);
527    $self->setContains($contains);
528    # We now have to update the numleafdocs count for this node and its
529    # ancestor nodes
530    my $cur_node_obj = $self;
531    while ($cur_node_obj)
532      {
533        my $numleafdocs = $cur_node_obj->getNumLeafDocs();
534        if ($numleafdocs =~ /^\d+$/)
535          {
536            $numleafdocs--;
537          }
538        else
539          {
540            $numleafdocs = 0;
541          }
542        $cur_node_obj->setNumLeafDocs($numleafdocs);
543        $cur_node_obj = $cur_node_obj->getParentNode();
544      }
545    # Done
546  }
547# /** removeDocument() **/
548
549# /** Remove the node denoted by the path.
550#  *
551#  *  @param  $child_node The node to be removed
552#  *
553#  *  @author John Thompson, DL Consulting Ltd
554#  */
555sub removeNode()
556  {
557    my ($self, $child_node) = @_;
558    # Not as easy as it first sounds as we have to do a recursive remove,
559    # keeping track of any documents removed so we can update document count.
560    # We then remove this node, adjusting the sibling's clid's as necessary
561    # before altering the contains.
562    print STDERR "ClassifyTreeNode::removeNode(child_node)\n" unless !$self->{'debug'};
563    my $remove_clid = $child_node->getCLID();
564    my $sibling_node = $child_node->getNextSibling();
565    # Recursively remove this nodes and its children, taking note of decrease
566    # in document count.
567    my $removed_numleafdocs = $child_node->removeAllNodes();
568    # Determine if removing this node requires other nodes to be moved, and if
569    # so, do so. We do this in a repeating loop until there are no further
570    # siblings, overwriting the $remove_clid variable with the clid of the node
571    # just changed (you'll see why in a moment).
572    while ($sibling_node != 0)
573      {
574        my $current_node = $sibling_node;
575        # Get this nodes sibling
576        $sibling_node = $current_node->getNextSibling();
577        # Record the CLID to change to
578        my $new_clid = $remove_clid;
579        # Record the old clid
580        $remove_clid = $current_node->getCLID();
581        # Modify the clid of the current node
582        $current_node->changeCLID($new_clid);
583        # Continue until there are no further sibling nodes
584      }
585    # By now the $remove_clid will contain the CLID that has to be removed from
586    # the contains metadata for this node
587    my $contains = $self->getContains();
588    my @contains_parts = split(/;/, $contains);
589    my @new_contains_parts = ();
590    foreach my $oid_or_clid (@contains_parts)
591      {
592        if ($remove_clid ne $oid_or_clid && $oid_or_clid =~ /[\w\d]+/)
593          {
594            push(@new_contains_parts, $oid_or_clid);
595          }
596      }
597    $contains = join(";", @new_contains_parts);
598    $self->setContains($contains);
599    # We also alter the numleafdocs metadata to reflect the removal of these
600    # nodes.
601    my $numleafdocs = $self->getNumLeafDocs();
602    if ($numleafdocs =~ /^\d+$/)
603      {
604        $numleafdocs -= $removed_numleafdocs;
605      }
606    else
607      {
608        $numleafdocs = 0;
609      }
610    $self->setNumLeafDocs($numleafdocs);
611    # Done
612  }
613# /** removeNode() **/
614
615# /** Set the contains metadata in the database.
616#  *
617#  *  @param  $contains The new contains string
618#  *
619#  *  @author John Thompson, DL Consulting Ltd.
620#  */
621sub setContains()
622  {
623    my ($self, $contains) = @_;
624    print STDERR "ClassifyTreeNode::setContains(\"$contains\")\n" unless !$self->{'debug'};
625    # Replace any occurance of this nodes CLID with "
626    $contains =~ s/$self->{'clid'}/\"/g;
627
628    my $collection = $self->{'model'}->getCollection();
629    my $clid = $self->{'clid'};
630
631    # Load the text of this node
632    my $text = &dbutil::read_infodb_entry("gdbm", $self->{'infodb_file_path'}, $clid);
633
634    # Replace the contains
635    #rint STDERR "Before: $text\n";
636    $text =~ s/<contains>.*?\n+/<contains>$contains\n/;
637    #rint STDERR "After:  $text\n";
638    # Store the changed text
639    my $infodb_file_handle = &dbutil::open_infodb_write_handle("gdbm", $self->{'infodb_file_path'}, "append");
640    &dbutil::write_infodb_entry("gdbm", $infodb_file_handle, $clid, &dbutil::convert_infodb_string_to_hash($text));
641    &dbutil::close_infodb_write_handle("gdbm", $infodb_file_handle);
642  }
643# /** setContains() **/
644
645# /** Set the numleafdocs metadata in the database.
646#  *
647#  *  @param  $numleafdocs The new count of leaf documents
648#  *
649#  *  @author John Thompson, DL Consulting Ltd.
650#  */
651sub setNumLeafDocs()
652  {
653    my ($self, $numleafdocs) = @_;
654    print STDERR "ClassifyTreeNode::setNumLeafDocs(numleafdocs)\n" unless !$self->{'debug'};
655
656    my $collection = $self->{'model'}->getCollection();
657    my $clid = $self->{'clid'};
658
659    # Load the text of this node
660    my $text = &dbutil::read_infodb_entry("gdbm", $self->{'infodb_file_path'}, $clid);
661    # Replace the numleafdocs
662    $text =~ s/<numleafdocs>\d*?\n+/<numleafdocs>$numleafdocs\n/;
663    # Store the changed text
664    my $infodb_file_handle = &dbutil::open_infodb_write_handle("gdbm", $self->{'infodb_file_path'}, "append");
665    &dbutil::write_infodb_entry("gdbm", $infodb_file_handle, $clid, &dbutil::convert_infodb_string_to_hash($text));
666    &dbutil::close_infodb_write_handle("gdbm", $infodb_file_handle);
667  }
668# /** setNumLeafDocs() **/
669
670# /** Set the title metadata in the database.
671#  *  Note: Previously this was value and we extracted the title, but the new
672#  *        autohierarchies don't set values.
673#  *
674#  *  @param  $title The new title string
675#  *
676#  *  @author John Thompson, DL Consulting Ltd.
677#  */
678sub setTitle()
679  {
680    my ($self, $title) = @_;
681    print STDERR "ClassifyTreeNode::setTitle(\"$title\")\n" unless !$self->{'debug'};
682
683    my $collection = $self->{'model'}->getCollection();
684    my $clid = $self->{'clid'};
685
686    # Load the text of this node
687    my $text = &dbutil::read_infodb_entry("gdbm", $self->{'infodb_file_path'}, $clid);
688    # Replace the title
689    $text =~ s/<Title>.*?\n+/<Title>$title\n/;
690    # Store the changed text
691    my $infodb_file_handle = &dbutil::open_infodb_write_handle("gdbm", $self->{'infodb_file_path'}, "append");
692    &dbutil::write_infodb_entry("gdbm", $infodb_file_handle, $clid, &dbutil::convert_infodb_string_to_hash($text));
693    &dbutil::close_infodb_write_handle("gdbm", $infodb_file_handle);
694  }
695# /** setValue() **/
696
697# /** Represent this node as a string.
698#  *
699#  * @return The string representation of this node
700#  *
701#  * @author John Thompson, DL Consulting Ltd.
702#  */
703sub toString()
704  {
705    my ($self) = @_;
706    print STDERR "ClassifyTreeNode::toString()\n" unless !$self->{'debug'};
707    my $collection = $self->{'model'}->getCollection();
708    my $clid = $self->{'clid'};
709
710    my $text = &dbutil::read_infodb_entry("gdbm", $self->{'infodb_file_path'}, $clid);
711    return $text;
712  }
713# /** toString() **/
714
7151;
Note: See TracBrowser for help on using the browser.