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

Last change on this file since 32594 was 23485, checked in by davidb, 13 years ago

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