source: main/trunk/greenstone2/perllib/basebuildproc.pm@ 23133

Last change on this file since 23133 was 23133, checked in by kjdon, 10 years ago

still workign on incremental infodb updating. cleaning up code now that reconstructed docs are added after processing new/changed ones. so don't need to do deletion from the infodb.

  • Property svn:keywords set to Author Date Id Revision
File size: 22.0 KB
Line 
1##########################################################################
2#
3# basebuildproc.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26# This document processor outputs a document for indexing (should be
27# implemented by subclass) and storing in the database
28
29package basebuildproc;
30
31eval {require bytes};
32
33use classify;
34use dbutil;
35use doc;
36use docproc;
37use strict;
38no strict 'subs';
39no strict 'refs';
40use util;
41
42BEGIN {
43 @basebuildproc::ISA = ('docproc');
44}
45
46sub new()
47 {
48 my ($class, $collection, $source_dir, $build_dir, $keepold, $verbosity, $outhandle) = @_;
49 my $self = new docproc ();
50
51 # outhandle is where all the debugging info goes
52 # output_handle is where the output of the plugins is piped
53 # to (i.e. mg, database etc.)
54 $outhandle = STDERR unless defined $outhandle;
55
56 $self->{'collection'} = $collection;
57 $self->{'source_dir'} = $source_dir;
58 $self->{'build_dir'} = $build_dir;
59 $self->{'keepold'} = $keepold;
60 $self->{'verbosity'} = $verbosity;
61 $self->{'outhandle'} = $outhandle;
62
63 $self->{'classifiers'} = [];
64 $self->{'mode'} = "text";
65 $self->{'assocdir'} = $build_dir;
66 $self->{'dontdb'} = {};
67 $self->{'store_metadata_coverage'} = "false";
68
69 $self->{'index'} = "section:text";
70 $self->{'indexexparr'} = [];
71
72 $self->{'separate_cjk'} = 0;
73
74 my $found_num_data = 0;
75 my $buildconfigfile = undef;
76
77 if ($keepold) {
78 # For incremental building need to seed num_docs etc from values
79 # stored in build.cfg (if present)
80 $buildconfigfile = &util::filename_cat($build_dir, "build.cfg");
81 if (-e $buildconfigfile) {
82 $found_num_data = 1;
83 }
84 else {
85 # try the index dir
86 $buildconfigfile = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},
87 "index", "build.cfg");
88 if (-e $buildconfigfile) {
89 $found_num_data = 1;
90 }
91 }
92
93 }
94
95 if ($found_num_data)
96 {
97 #print STDERR "Found_Num_Data!\n";
98 my $buildcfg = &colcfg::read_build_cfg($buildconfigfile);
99 $self->{'starting_num_docs'} = $buildcfg->{'numdocs'};
100 #print STDERR "- num_docs: $self->{'starting_num_docs'}\n";
101 $self->{'starting_num_sections'} = $buildcfg->{'numsections'};
102 #print STDERR "- num_sections: $self->{'starting_num_sections'}\n";
103 $self->{'starting_num_bytes'} = $buildcfg->{'numbytes'};
104 #print STDERR "- num_bytes: $self->{'starting_num_bytes'}\n";
105 }
106 else
107 {
108 #print STDERR "NOT Found_Num_Data!\n";
109 $self->{'starting_num_docs'} = 0;
110 $self->{'starting_num_sections'} = 0;
111 $self->{'starting_num_bytes'} = 0;
112 }
113
114 $self->{'output_handle'} = "STDOUT";
115 $self->{'num_docs'} = $self->{'starting_num_docs'};
116 $self->{'num_sections'} = $self->{'starting_num_sections'};
117 $self->{'num_bytes'} = $self->{'starting_num_bytes'};
118
119 $self->{'num_processed_bytes'} = 0;
120 $self->{'store_text'} = 1;
121
122 # what level (section/document) the database - indexer intersection is
123 $self->{'db_level'} = "section";
124 #used by browse interface
125 $self->{'doclist'} = [];
126
127 $self->{'indexing_text'} = 0;
128
129 return bless $self, $class;
130
131}
132
133sub reset {
134 my $self = shift (@_);
135
136 $self->{'num_docs'} = $self->{'starting_num_docs'};
137 $self->{'num_sections'} = $self->{'starting_num_sections'};
138 $self->{'num_bytes'} = $self->{'starting_num_bytes'};
139
140 $self->{'num_processed_bytes'} = 0;
141}
142
143sub zero_reset {
144 my $self = shift (@_);
145
146 $self->{'num_docs'} = 0;
147 $self->{'num_sections'} = 0;
148 # reconstructed docs have no text, just metadata, so we need to
149 # remember how many bytes we had initially
150 #$self->{'num_bytes'} = $self->{'starting_num_bytes'};
151 $self->{'num_bytes'} = 0; # we'll store num bytes in db for reconstructed docs.
152 $self->{'num_processed_bytes'} = 0;
153}
154
155sub is_incremental_capable
156{
157 # By default we return 'no' as the answer
158 # Safer to assume non-incremental to start with, and then override in
159 # inherited classes that are.
160
161 return 0;
162}
163
164sub get_num_docs {
165 my $self = shift (@_);
166
167 return $self->{'num_docs'};
168}
169
170sub get_num_sections {
171 my $self = shift (@_);
172
173 return $self->{'num_sections'};
174}
175
176# num_bytes is the actual number of bytes in the collection
177# this is normally the same as what's processed during text compression
178sub get_num_bytes {
179 my $self = shift (@_);
180
181 return $self->{'num_bytes'};
182}
183
184# num_processed_bytes is the number of bytes actually passed
185# to mg for the current index
186sub get_num_processed_bytes {
187 my $self = shift (@_);
188
189 return $self->{'num_processed_bytes'};
190}
191
192sub set_output_handle {
193 my $self = shift (@_);
194 my ($handle) = @_;
195
196 $self->{'output_handle'} = $handle;
197 binmode($handle,":utf8");
198}
199
200
201sub set_mode {
202 my $self = shift (@_);
203 my ($mode) = @_;
204
205 $self->{'mode'} = $mode;
206}
207
208sub get_mode {
209 my $self = shift (@_);
210
211 return $self->{'mode'};
212}
213
214sub set_assocdir {
215 my $self = shift (@_);
216 my ($assocdir) = @_;
217
218 $self->{'assocdir'} = $assocdir;
219}
220
221sub set_dontdb {
222 my $self = shift (@_);
223 my ($dontdb) = @_;
224
225 $self->{'dontdb'} = $dontdb;
226}
227
228sub set_infodbtype
229{
230 my $self = shift(@_);
231 my $infodbtype = shift(@_);
232 $self->{'infodbtype'} = $infodbtype;
233}
234
235sub set_index {
236 my $self = shift (@_);
237 my ($index, $indexexparr) = @_;
238
239 $self->{'index'} = $index;
240 $self->{'indexexparr'} = $indexexparr if defined $indexexparr;
241}
242
243sub set_index_languages {
244 my $self = shift (@_);
245 my ($lang_meta, $langarr) = @_;
246 $lang_meta =~ s/^ex\.//; # strip ex. if there
247 $self->{'lang_meta'} = $lang_meta;
248 $self->{'langarr'} = $langarr;
249}
250
251sub get_index {
252 my $self = shift (@_);
253
254 return $self->{'index'};
255}
256
257sub set_classifiers {
258 my $self = shift (@_);
259 my ($classifiers) = @_;
260
261 $self->{'classifiers'} = $classifiers;
262}
263
264sub set_indexing_text {
265 my $self = shift (@_);
266 my ($indexing_text) = @_;
267
268 $self->{'indexing_text'} = $indexing_text;
269}
270
271sub get_indexing_text {
272 my $self = shift (@_);
273
274 return $self->{'indexing_text'};
275}
276
277sub set_store_text {
278 my $self = shift (@_);
279 my ($store_text) = @_;
280
281 $self->{'store_text'} = $store_text;
282}
283
284sub set_store_metadata_coverage {
285 my $self = shift (@_);
286 my ($store_metadata_coverage) = @_;
287
288 $self->{'store_metadata_coverage'} = $store_metadata_coverage || "";
289}
290
291sub get_doc_list {
292 my $self = shift(@_);
293
294 return @{$self->{'doclist'}};
295}
296
297# the standard database level is section, but you may want to change it to document
298sub set_db_level {
299 my $self= shift (@_);
300 my ($db_level) = @_;
301
302 $self->{'db_level'} = $db_level;
303}
304
305sub set_sections_index_document_metadata {
306 my $self= shift (@_);
307 my ($index_type) = @_;
308
309 $self->{'sections_index_document_metadata'} = $index_type;
310}
311
312sub set_separate_cjk {
313 my $self = shift (@_);
314 my ($sep_cjk) = @_;
315
316 $self->{'separate_cjk'} = $sep_cjk;
317}
318
319sub process {
320 my $self = shift (@_);
321 my $method = $self->{'mode'};
322
323 $self->$method(@_);
324}
325
326# post process text depending on field. Currently don't do anything here
327# except cjk separation, and only for indexing
328# should only do this for indexed text (if $self->{'indexing_text'}),
329# but currently search term highlighting doesn't work if you do that.
330# once thats fixed up, then fix this.
331sub filter_text {
332 my $self = shift (@_);
333 my ($field, $text) = @_;
334
335 # lets do cjk seg here
336 my $new_text =$text;
337 if ($self->{'separate_cjk'}) {
338 $new_text = &cnseg::segment($text);
339 }
340 return $new_text;
341}
342
343
344sub infodb_metadata_stats
345{
346 my $self = shift (@_);
347 my ($field,$edit_mode) = @_;
348
349 # Keep some statistics relating to metadata sets used and
350 # frequency of particular metadata fields within each set
351
352 # Union of metadata prefixes and frequency of fields
353 # (both scoped for this document alone, and across whole collection)
354
355 if ($field =~ m/^(.+)\.(.*)$/) {
356 my $prefix = $1;
357 my $core_field = $2;
358
359 if (($edit_mode eq "add") || ($edit_mode eq "update")) {
360 $self->{'doc_mdprefix_fields'}->{$prefix}->{$core_field}++;
361 $self->{'mdprefix_fields'}->{$prefix}->{$core_field}++;
362 }
363 else {
364 # delete
365 $self->{'doc_mdprefix_fields'}->{$prefix}->{$core_field}--;
366 $self->{'mdprefix_fields'}->{$prefix}->{$core_field}--;
367 }
368
369 }
370 elsif ($field =~ m/^[[:upper:]]/) {
371 # implicit 'ex' metadata set
372
373 if (($edit_mode eq "add") || ($edit_mode eq "update")) {
374
375 $self->{'doc_mdprefix_fields'}->{'ex'}->{$field}++;
376 $self->{'mdprefix_fields'}->{'ex'}->{$field}++;
377 }
378 else {
379 # delete
380 $self->{'doc_mdprefix_fields'}->{'ex'}->{$field}--;
381 $self->{'mdprefix_fields'}->{'ex'}->{$field}--;
382 }
383 }
384
385}
386
387
388sub infodbedit {
389 my $self = shift (@_);
390 my ($doc_obj, $filename, $edit_mode) = @_;
391
392 # only output this document if it is a "indexed_doc" or "info_doc" (database only) document
393 my $doctype = $doc_obj->get_doc_type();
394 return if ($doctype ne "indexed_doc" && $doctype ne "info_doc");
395 print STDERR "infodbedit, mode=$edit_mode, ".$doc_obj->get_OID()."\n";
396 my $archivedir = "";
397 if (defined $filename)
398 {
399 # doc_obj derived directly from file
400 my ($dir) = $filename =~ /^(.*?)(?:\/|\\)[^\/\\]*$/;
401 $dir = "" unless defined $dir;
402 $dir =~ s/\\/\//g;
403 $dir =~ s/^\/+//;
404 $dir =~ s/\/+$//;
405
406 $archivedir = $dir;
407
408 # resolve the final filenames of the files associated with this document
409 $self->assoc_files ($doc_obj, $archivedir);
410 }
411 else
412 {
413 # doc_obj reconstructed from database (has metadata, doc structure but no text)
414 my $top_section = $doc_obj->get_top_section();
415 $archivedir = $doc_obj->get_metadata_element($top_section,"archivedir");
416 }
417
418 if ($edit_mode eq "delete") {
419 # record this doc so we don't process the reconstructed doc later
420 $self->{'dont_reconstruct'}->{$doc_obj->get_OID()} = 1;
421 # we don't need to do anything else for the info database for a deleted document. The infodb starts from scratch each time, so no deletion is necessary
422 # do we need this??? where did num_docs come from, from reconstruction??
423 #$self->{'num_docs'} -= 1 unless ($doctype eq "classification");
424 return;
425 }
426
427 if ($edit_mode eq "update") {
428 # we don't want to process the reconstructed doc later, but we will process this version now.
429 $self->{'dont_reconstruct'}->{$doc_obj->get_OID()} = 1;
430 }
431
432 # rest of code used for add and update. In both cases, we add to the classifiers and to the info database.
433
434 #add this document to the browse structure
435 push(@{$self->{'doclist'}},$doc_obj->get_OID())
436 unless ($doctype eq "classification");
437 $self->{'num_docs'} += 1 unless ($doctype eq "classification");
438
439 if (!defined $filename) {
440 # a reconstructed doc
441 $self->{'num_bytes'} += $doc_obj->get_metadata_element ($doc_obj->get_top_section (), "total_numbytes");
442 print STDERR "new numbytes = $self->{'num_bytes'}\n";
443 }
444 # classify the document
445 &classify::classify_doc ($self->{'classifiers'}, $doc_obj);
446
447 # now add all the section to the infodb.
448
449 # is this a paged or a hierarchical document
450 my ($thistype, $childtype) = $self->get_document_type ($doc_obj);
451
452 my $section = $doc_obj->get_top_section ();
453 my $doc_OID = $doc_obj->get_OID();
454 my $first = 1;
455 my $infodb_handle = $self->{'output_handle'};
456
457 $self->{'doc_mdprefix_fields'} = {};
458
459 while (defined $section)
460 {
461 my $section_OID = $doc_OID;
462 if ($section ne "")
463 {
464 $section_OID = $doc_OID . "." . $section;
465 }
466 my %section_infodb = ();
467
468 # update a few statistics
469 $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
470 $self->{'num_sections'} += 1 unless ($doctype eq "classification");
471
472 # output the fact that this document is a document (unless doctype
473 # has been set to something else from within a plugin
474 my $dtype = $doc_obj->get_metadata_element ($section, "doctype");
475 if (!defined $dtype || $dtype !~ /\w/) {
476 $section_infodb{"doctype"} = [ "doc" ];
477 }
478
479 if ($first && defined $filename) {
480 # if we are at the top level of the document, and we are not a reconstructed document, set the total_text_length - used to count bytes when we reconstruct later
481 my $length = $doc_obj->get_total_text_length();
482 $section_infodb{"total_numbytes"} = [ $length ];
483 }
484 # Output whether this node contains text
485 #
486 # If doc_obj reconstructed from database file then no need to
487 # explicitly add <hastxt> as this is preserved as metadata when
488 # the database file is loaded in
489 if (defined $filename)
490 {
491 # doc_obj derived directly from file
492 if ($doc_obj->get_text_length($section) > 0) {
493 $section_infodb{"hastxt"} = [ "1" ];
494 } else {
495 $section_infodb{"hastxt"} = [ "0" ];
496 }
497 }
498
499 # output all the section metadata
500 my $metadata = $doc_obj->get_all_metadata ($section);
501 foreach my $pair (@$metadata) {
502 my ($field, $value) = (@$pair);
503
504 if ($field ne "Identifier" && $field !~ /^gsdl/ &&
505 defined $value && $value ne "") {
506
507 # escape problematic stuff
508 $value =~ s/([^\\])\\([^\\])/$1\\\\$2/g;
509 $value =~ s/\n/\\n/g;
510 $value =~ s/\r/\\r/g;
511 # remove ex. if there
512 $field =~ s/^ex\.//;
513
514 # special case for URL metadata
515 if ($field =~ /^URL$/i) {
516 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $value, { 'section' => [ $section_OID ] });
517 }
518
519 if (!defined $self->{'dontdb'}->{$field}) {
520 push(@{$section_infodb{$field}}, $value);
521
522 if ($section eq "" && $self->{'store_metadata_coverage'} =~ /^true$/i)
523 {
524 $self->infodb_metadata_stats($field,$edit_mode);
525 }
526 }
527 }
528 }
529
530 if ($section eq "")
531 {
532 my $doc_mdprefix_fields = $self->{'doc_mdprefix_fields'};
533
534 foreach my $prefix (keys %$doc_mdprefix_fields)
535 {
536 push(@{$section_infodb{"metadataset"}}, $prefix);
537
538 foreach my $field (keys %{$doc_mdprefix_fields->{$prefix}})
539 {
540 push(@{$section_infodb{"metadatalist-$prefix"}}, $field);
541
542 my $val = $doc_mdprefix_fields->{$prefix}->{$field};
543 push(@{$section_infodb{"metadatafreq-$prefix-$field"}}, $val);
544 }
545 }
546 }
547
548 # If doc_obj reconstructed from database file then no need to
549 # explicitly add <archivedir> as this is preserved as metadata when
550 # the database file is loaded in
551 if (defined $filename)
552 {
553 # output archivedir if at top level
554 if ($section eq $doc_obj->get_top_section()) {
555 $section_infodb{"archivedir"} = [ $archivedir ];
556 }
557 }
558
559 # output document display type
560 if ($first) {
561 $section_infodb{"thistype"} = [ $thistype ];
562 }
563
564 if ($self->{'db_level'} eq "document") {
565 # doc num is num_docs not num_sections
566 # output the matching document number
567 $section_infodb{"docnum"} = [ $self->{'num_docs'} ];
568 }
569 else {
570 # output a list of children
571 my $children = $doc_obj->get_children ($section);
572 if (scalar(@$children) > 0) {
573 $section_infodb{"childtype"} = [ $childtype ];
574 my $contains = "";
575 foreach my $child (@$children)
576 {
577 $contains .= ";" unless ($contains eq "");
578 if ($child =~ /^.*?\.(\d+)$/)
579 {
580 $contains .= "\".$1";
581 }
582 else
583 {
584 $contains .= "\".$child";
585 }
586 }
587 $section_infodb{"contains"} = [ $contains ];
588 }
589 # output the matching doc number
590 $section_infodb{"docnum"} = [ $self->{'num_sections'} ];
591 }
592
593 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $section_OID, \%section_infodb);
594
595 # output a database entry for the document number, unless we are incremental
596 unless ($self->is_incremental_capable())
597 {
598 print STDERR "outputting db entry for doc number\n";
599 if ($self->{'db_level'} eq "document") {
600 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $self->{'num_docs'}, { 'section' => [ $doc_OID ] });
601 }
602 else {
603 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $self->{'num_sections'}, { 'section' => [ $section_OID ] });
604 }
605 }
606
607 $first = 0;
608 $section = $doc_obj->get_next_section($section);
609 last if ($self->{'db_level'} eq "document"); # if no sections wanted, only add the docs
610 } # while defined section
611
612 print STDERR "end of infodb edit\n";
613}
614
615
616
617
618sub infodb {
619 my $self = shift (@_);
620 my ($doc_obj, $filename) = @_;
621
622 $self->infodbedit($doc_obj,$filename,"add");
623}
624
625sub infodbreindex {
626 my $self = shift (@_);
627 my ($doc_obj, $filename) = @_;
628
629 $self->infodbedit($doc_obj,$filename,"update");
630}
631
632sub infodbdelete {
633 my $self = shift (@_);
634 my ($doc_obj, $filename) = @_;
635
636 $self->infodbedit($doc_obj,$filename,"delete");
637}
638
639
640sub text {
641 my $self = shift (@_);
642 my ($doc_obj) = @_;
643
644 my $handle = $self->{'outhandle'};
645 print $handle "basebuildproc::text function must be implemented in sub classes\n";
646 die "\n";
647}
648
649sub textreindex
650{
651 my $self = shift @_;
652
653 my $outhandle = $self->{'outhandle'};
654 print $outhandle "basebuildproc::textreindex function must be implemented in sub classes\n";
655 if (!$self->is_incremental_capable()) {
656
657 print $outhandle " This operation is only possible with indexing tools with that support\n";
658 print $outhandle " incremental building\n";
659 }
660 die "\n";
661}
662
663sub textdelete
664{
665 my $self = shift @_;
666
667 my $outhandle = $self->{'outhandle'};
668 print $outhandle "basebuildproc::textdelete function must be implemented in sub classes\n";
669 if (!$self->is_incremental_capable()) {
670
671 print $outhandle " This operation is only possible with indexing tools with that support\n";
672 print $outhandle " incremental building\n";
673 }
674 die "\n";
675}
676
677
678# should the document be indexed - according to the subcollection and language
679# specification.
680sub is_subcollection_doc {
681 my $self = shift (@_);
682 my ($doc_obj) = @_;
683
684 my $indexed_doc = 1;
685 foreach my $indexexp (@{$self->{'indexexparr'}}) {
686 $indexed_doc = 0;
687 my ($field, $exp, $options) = split /\//, $indexexp;
688 if (defined ($field) && defined ($exp)) {
689 my ($bool) = $field =~ /^(.)/;
690 $field =~ s/^.// if $bool eq '!';
691 my @metadata_values;
692 if ($field =~ /^filename$/i) {
693 push(@metadata_values, $doc_obj->get_source_filename());
694 }
695 else {
696 $field =~ s/^ex\.//; #strip ex. if present
697 @metadata_values = @{$doc_obj->get_metadata($doc_obj->get_top_section(), $field)};
698 }
699 next unless @metadata_values;
700 foreach my $metadata_value (@metadata_values) {
701 if ($bool eq '!') {
702 if ($options =~ /^i$/i) {
703 if ($metadata_value !~ /$exp/i) {$indexed_doc = 1; last;}
704 } else {
705 if ($metadata_value !~ /$exp/) {$indexed_doc = 1; last;}
706 }
707 } else {
708 if ($options =~ /^i$/i) {
709 if ($metadata_value =~ /$exp/i) {$indexed_doc = 1; last;}
710 } else {
711 if ($metadata_value =~ /$exp/) {$indexed_doc = 1; last;}
712 }
713 }
714 }
715
716 last if ($indexed_doc == 1);
717 }
718 }
719
720 # if this doc is so far in the sub collection, and we have lang info,
721 # now we check the languages to see if it matches
722 if($indexed_doc && defined $self->{'lang_meta'}) {
723 $indexed_doc = 0;
724 my $field = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'lang_meta'});
725 if (defined $field) {
726 foreach my $lang (@{$self->{'langarr'}}) {
727 my ($bool) = $lang =~ /^(.)/;
728 if ($bool eq '!') {
729 $lang =~ s/^.//;
730 if ($field !~ /$lang/) {
731 $indexed_doc = 1; last;
732 }
733 } else {
734 if ($field =~ /$lang/) {
735 $indexed_doc = 1; last;
736 }
737 }
738 }
739 }
740 }
741 return $indexed_doc;
742
743}
744
745# use 'Paged' if document has no more than 2 levels
746# and each section at second level has a number for
747# Title metadata
748# also use Paged if gsdlthistype metadata is set to Paged
749sub get_document_type {
750 my $self = shift (@_);
751 my ($doc_obj) = @_;
752
753 my $thistype = "VList";
754 my $childtype = "VList";
755 my $title;
756 my @tmp = ();
757
758 my $section = $doc_obj->get_top_section ();
759
760 my $gsdlthistype = $doc_obj->get_metadata_element ($section, "gsdlthistype");
761 if (defined $gsdlthistype) {
762 if ($gsdlthistype eq "Paged") {
763 $childtype = "Paged";
764 if ($doc_obj->get_text_length ($doc_obj->get_top_section())) {
765 $thistype = "Paged";
766 } else {
767 $thistype = "Invisible";
768 }
769
770 return ($thistype, $childtype);
771 } elsif ($gsdlthistype eq "Hierarchy") {
772 return ($thistype, $childtype); # use VList, VList
773 }
774 }
775 my $first = 1;
776 while (defined $section) {
777 @tmp = split /\./, $section;
778 if (scalar(@tmp) > 1) {
779 return ($thistype, $childtype);
780 }
781 if (!$first) {
782 $title = $doc_obj->get_metadata_element ($section, "Title");
783 if (!defined $title || $title !~ /^\d+$/) {
784 return ($thistype, $childtype);
785 }
786 }
787 $first = 0;
788 $section = $doc_obj->get_next_section($section);
789 }
790 if ($doc_obj->get_text_length ($doc_obj->get_top_section())) {
791 $thistype = "Paged";
792 } else {
793 $thistype = "Invisible";
794 }
795 $childtype = "Paged";
796 return ($thistype, $childtype);
797}
798
799sub assoc_files
800{
801 my $self = shift (@_);
802 my ($doc_obj, $archivedir) = @_;
803 my ($afile);
804
805 foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) {
806 #rint STDERR "Processing associated file - copy " . $assoc_file->[0] . " to " . $assoc_file->[1] . "\n";
807 # if assoc file starts with a slash, we put it relative to the assoc
808 # dir, otherwise it is relative to the HASH... directory
809 if ($assoc_file->[1] =~ m@^[/\\]@) {
810 $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]);
811 } else {
812 $afile = &util::filename_cat($self->{'assocdir'}, $archivedir, $assoc_file->[1]);
813 }
814 &util::hard_link ($assoc_file->[0], $afile, $self->{'verbosity'});
815 }
816}
817
Note: See TracBrowser for help on using the repository browser.