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

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

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