source: main/trunk/greenstone2/perllib/ClassifyTreeNode.pm@ 21563

Last change on this file since 21563 was 21563, checked in by mdewsnip, 14 years ago

Deleted GDBMUtils.pm. What was the point of me spending all that time creating dbutil if people are just going to ignore it and continue writing GDBM-only code?!? Not impressed...
  • Property svn:keywords set to Author Date Id Revision
File size: 23.8 KB
Line 
1package ClassifyTreeNode;
2
3use ClassifyTreeNode;
4use ClassifyTreePath;
5use strict;
6
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 repository browser.