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

Last change on this file since 21562 was 21562, checked in by mdewsnip, 14 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
File size: 23.8 KB
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 repository browser.