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

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

small changes based on the fact that we need to store ids for updated and deleted documents so the reconstructed documents don't get processed later

  • 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
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
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 "add") || ($edit_mode eq "update")) {
419 #add this document to the browse structure
420 push(@{$self->{'doclist'}},$doc_obj->get_OID())
421 unless ($doctype eq "classification");
422 if ($edit_mode eq "update") {
423 $self->{'dont_reconstruct'}->{$doc_obj->get_OID()} = 1;
424 }
425 &classify::classify_doc ($self->{'classifiers'}, $doc_obj);
426 $self->{'num_docs'} += 1 unless ($doctype eq "classification");
427 }
428 elsif ($edit_mode eq "delete") {
429 # record this doc so we don't process the reconstructed doc later
430 my $del_doc_oid = $doc_obj->get_OID();
431 $self->{'dont_reconstruct'}->{$del_doc_oid} = 1;
432 # do we need this??? where did num_docs come from, from reconstruction??
433 $self->{'num_docs'} -= 1 unless ($doctype eq "classification");
434 }
435
436 # is this a paged or a hierarchical document
437 my ($thistype, $childtype) = $self->get_document_type ($doc_obj);
438
439 my $section = $doc_obj->get_top_section ();
440 my $doc_OID = $doc_obj->get_OID();
441 my $first = 1;
442 my $infodb_handle = $self->{'output_handle'};
443
444 $self->{'doc_mdprefix_fields'} = {};
445
446 while (defined $section)
447 {
448 my $section_OID = $doc_OID;
449 if ($section ne "")
450 {
451 $section_OID = $doc_OID . "." . $section;
452 }
453 my %section_infodb = ();
454
455 # update a few statistics - how do we do update????
456 if (($edit_mode eq "add")) {# || ($edit_mode eq "update")) {
457
458 $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
459 $self->{'num_sections'} += 1 unless ($doctype eq "classification");
460 }
461 elsif ($edit_mode eq "delete") {
462 # delete
463 $self->{'num_bytes'} -= $doc_obj->get_text_length ($section);
464 $self->{'num_sections'} -= 1 unless ($doctype eq "classification");
465 }
466
467 # output the fact that this document is a document (unless doctype
468 # has been set to something else from within a plugin
469 my $dtype = $doc_obj->get_metadata_element ($section, "doctype");
470 if (!defined $dtype || $dtype !~ /\w/) {
471 $section_infodb{"doctype"} = [ "doc" ];
472 }
473
474 # Output whether this node contains text
475 #
476 # If doc_obj reconstructed from database file then no need to
477 # explicitly add <hastxt> as this is preserved as metadata when
478 # the database file is loaded in
479 if (defined $filename)
480 {
481 # doc_obj derived directly from file
482 if ($doc_obj->get_text_length($section) > 0) {
483 $section_infodb{"hastxt"} = [ "1" ];
484 } else {
485 $section_infodb{"hastxt"} = [ "0" ];
486 }
487 }
488
489 # output all the section metadata
490 my $metadata = $doc_obj->get_all_metadata ($section);
491 foreach my $pair (@$metadata) {
492 my ($field, $value) = (@$pair);
493
494 if ($field ne "Identifier" && $field !~ /^gsdl/ &&
495 defined $value && $value ne "") {
496
497 # escape problematic stuff
498 $value =~ s/([^\\])\\([^\\])/$1\\\\$2/g;
499 $value =~ s/\n/\\n/g;
500 $value =~ s/\r/\\r/g;
501 # remove ex. if there
502 $field =~ s/^ex\.//;
503
504 # special case for URL metadata
505 if ($field =~ /^URL$/i) {
506 if (($edit_mode eq "add") || ($edit_mode eq "update")) {
507
508 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $value, { 'section' => [ $section_OID ] });
509 }
510 else {
511 # delete
512 &dbutil::delete_infodb_entry($self->{'infodbtype'}, $infodb_handle, $value);
513 }
514
515
516 }
517
518 if (!defined $self->{'dontdb'}->{$field}) {
519 push(@{$section_infodb{$field}}, $value);
520
521 if ($section eq "" && $self->{'store_metadata_coverage'} =~ /^true$/i)
522 {
523 $self->infodb_metadata_stats($field,$edit_mode);
524 }
525 }
526 }
527 }
528
529 if ($section eq "")
530 {
531 my $doc_mdprefix_fields = $self->{'doc_mdprefix_fields'};
532
533 foreach my $prefix (keys %$doc_mdprefix_fields)
534 {
535 push(@{$section_infodb{"metadataset"}}, $prefix);
536
537 foreach my $field (keys %{$doc_mdprefix_fields->{$prefix}})
538 {
539 push(@{$section_infodb{"metadatalist-$prefix"}}, $field);
540
541 my $val = $doc_mdprefix_fields->{$prefix}->{$field};
542 push(@{$section_infodb{"metadatafreq-$prefix-$field"}}, $val);
543 }
544 }
545 }
546
547 # If doc_obj reconstructed from database file then no need to
548 # explicitly add <archivedir> as this is preserved as metadata when
549 # the database file is loaded in
550 if (defined $filename)
551 {
552 # output archivedir if at top level
553 if ($section eq $doc_obj->get_top_section()) {
554 $section_infodb{"archivedir"} = [ $archivedir ];
555 }
556 }
557
558 # output document display type
559 if ($first) {
560 $section_infodb{"thistype"} = [ $thistype ];
561 }
562
563 if ($self->{'db_level'} eq "document") {
564 # doc num is num_docs not num_sections
565 # output the matching document number
566 $section_infodb{"docnum"} = [ $self->{'num_docs'} ];
567 }
568 else {
569 # output a list of children
570 my $children = $doc_obj->get_children ($section);
571 if (scalar(@$children) > 0) {
572 $section_infodb{"childtype"} = [ $childtype ];
573 my $contains = "";
574 foreach my $child (@$children)
575 {
576 $contains .= ";" unless ($contains eq "");
577 if ($child =~ /^.*?\.(\d+)$/)
578 {
579 $contains .= "\".$1";
580 }
581 else
582 {
583 $contains .= "\".$child";
584 }
585 }
586 $section_infodb{"contains"} = [ $contains ];
587 }
588 # output the matching doc number
589 $section_infodb{"docnum"} = [ $self->{'num_sections'} ];
590 }
591
592 if (($edit_mode eq "add") || ($edit_mode eq "update")) {
593 # in case of update, this will overwrite old entry??
594 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $section_OID, \%section_infodb);
595 }
596 else {
597 # delete
598 &dbutil::delete_infodb_entry($self->{'infodbtype'}, $infodb_handle, $section_OID);
599 }
600
601
602 # output a database entry for the document number, except for Lucene (which no longer needs this information)
603 unless (ref($self) eq "lucenebuildproc")
604 {
605 if (($edit_mode eq "add") || ($edit_mode eq "update")) {
606
607 if ($self->{'db_level'} eq "document") {
608 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $self->{'num_docs'}, { 'section' => [ $doc_OID ] });
609 }
610 else {
611 &dbutil::write_infodb_entry($self->{'infodbtype'}, $infodb_handle, $self->{'num_sections'}, { 'section' => [ $section_OID ] });
612 }
613 }
614 else {
615
616 if ($self->{'db_level'} eq "document") {
617 &dbutil::delete_infodb_entry($self->{'infodbtype'}, $infodb_handle, $self->{'num_docs'});
618 }
619 else {
620 &dbutil::delete_infodb_entry($self->{'infodbtype'}, $infodb_handle, $self->{'num_sections'});
621 }
622
623 }
624 }
625
626 $first = 0;
627 $section = $doc_obj->get_next_section($section);
628 last if ($self->{'db_level'} eq "document"); # if no sections wanted, only add the docs
629 }
630}
631
632
633
634
635sub infodb {
636 my $self = shift (@_);
637 my ($doc_obj, $filename) = @_;
638
639 $self->infodbedit($doc_obj,$filename,"add");
640}
641
642sub infodbreindex {
643 my $self = shift (@_);
644 my ($doc_obj, $filename) = @_;
645
646 $self->infodbedit($doc_obj,$filename,"update");
647}
648
649sub infodbdelete {
650 my $self = shift (@_);
651 my ($doc_obj, $filename) = @_;
652
653 $self->infodbedit($doc_obj,$filename,"delete");
654}
655
656
657sub text {
658 my $self = shift (@_);
659 my ($doc_obj) = @_;
660
661 my $handle = $self->{'outhandle'};
662 print $handle "basebuildproc::text function must be implemented in sub classes\n";
663 die "\n";
664}
665
666sub textreindex
667{
668 my $self = shift @_;
669
670 my $outhandle = $self->{'outhandle'};
671 print $outhandle "basebuildproc::textreindex function must be implemented in sub classes\n";
672 if (!$self->is_incremental_capable()) {
673
674 print $outhandle " This operation is only possible with indexing tools with that support\n";
675 print $outhandle " incremental building\n";
676 }
677 die "\n";
678}
679
680sub textdelete
681{
682 my $self = shift @_;
683
684 my $outhandle = $self->{'outhandle'};
685 print $outhandle "basebuildproc::textdelete function must be implemented in sub classes\n";
686 if (!$self->is_incremental_capable()) {
687
688 print $outhandle " This operation is only possible with indexing tools with that support\n";
689 print $outhandle " incremental building\n";
690 }
691 die "\n";
692}
693
694
695# should the document be indexed - according to the subcollection and language
696# specification.
697sub is_subcollection_doc {
698 my $self = shift (@_);
699 my ($doc_obj) = @_;
700
701 my $indexed_doc = 1;
702 foreach my $indexexp (@{$self->{'indexexparr'}}) {
703 $indexed_doc = 0;
704 my ($field, $exp, $options) = split /\//, $indexexp;
705 if (defined ($field) && defined ($exp)) {
706 my ($bool) = $field =~ /^(.)/;
707 $field =~ s/^.// if $bool eq '!';
708 my @metadata_values;
709 if ($field =~ /^filename$/i) {
710 push(@metadata_values, $doc_obj->get_source_filename());
711 }
712 else {
713 $field =~ s/^ex\.//; #strip ex. if present
714 @metadata_values = @{$doc_obj->get_metadata($doc_obj->get_top_section(), $field)};
715 }
716 next unless @metadata_values;
717 foreach my $metadata_value (@metadata_values) {
718 if ($bool eq '!') {
719 if ($options =~ /^i$/i) {
720 if ($metadata_value !~ /$exp/i) {$indexed_doc = 1; last;}
721 } else {
722 if ($metadata_value !~ /$exp/) {$indexed_doc = 1; last;}
723 }
724 } else {
725 if ($options =~ /^i$/i) {
726 if ($metadata_value =~ /$exp/i) {$indexed_doc = 1; last;}
727 } else {
728 if ($metadata_value =~ /$exp/) {$indexed_doc = 1; last;}
729 }
730 }
731 }
732
733 last if ($indexed_doc == 1);
734 }
735 }
736
737 # if this doc is so far in the sub collection, and we have lang info,
738 # now we check the languages to see if it matches
739 if($indexed_doc && defined $self->{'lang_meta'}) {
740 $indexed_doc = 0;
741 my $field = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'lang_meta'});
742 if (defined $field) {
743 foreach my $lang (@{$self->{'langarr'}}) {
744 my ($bool) = $lang =~ /^(.)/;
745 if ($bool eq '!') {
746 $lang =~ s/^.//;
747 if ($field !~ /$lang/) {
748 $indexed_doc = 1; last;
749 }
750 } else {
751 if ($field =~ /$lang/) {
752 $indexed_doc = 1; last;
753 }
754 }
755 }
756 }
757 }
758 return $indexed_doc;
759
760}
761
762# use 'Paged' if document has no more than 2 levels
763# and each section at second level has a number for
764# Title metadata
765# also use Paged if gsdlthistype metadata is set to Paged
766sub get_document_type {
767 my $self = shift (@_);
768 my ($doc_obj) = @_;
769
770 my $thistype = "VList";
771 my $childtype = "VList";
772 my $title;
773 my @tmp = ();
774
775 my $section = $doc_obj->get_top_section ();
776
777 my $gsdlthistype = $doc_obj->get_metadata_element ($section, "gsdlthistype");
778 if (defined $gsdlthistype) {
779 if ($gsdlthistype eq "Paged") {
780 $childtype = "Paged";
781 if ($doc_obj->get_text_length ($doc_obj->get_top_section())) {
782 $thistype = "Paged";
783 } else {
784 $thistype = "Invisible";
785 }
786
787 return ($thistype, $childtype);
788 } elsif ($gsdlthistype eq "Hierarchy") {
789 return ($thistype, $childtype); # use VList, VList
790 }
791 }
792 my $first = 1;
793 while (defined $section) {
794 @tmp = split /\./, $section;
795 if (scalar(@tmp) > 1) {
796 return ($thistype, $childtype);
797 }
798 if (!$first) {
799 $title = $doc_obj->get_metadata_element ($section, "Title");
800 if (!defined $title || $title !~ /^\d+$/) {
801 return ($thistype, $childtype);
802 }
803 }
804 $first = 0;
805 $section = $doc_obj->get_next_section($section);
806 }
807 if ($doc_obj->get_text_length ($doc_obj->get_top_section())) {
808 $thistype = "Paged";
809 } else {
810 $thistype = "Invisible";
811 }
812 $childtype = "Paged";
813 return ($thistype, $childtype);
814}
815
816sub assoc_files
817{
818 my $self = shift (@_);
819 my ($doc_obj, $archivedir) = @_;
820 my ($afile);
821
822 foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) {
823 #rint STDERR "Processing associated file - copy " . $assoc_file->[0] . " to " . $assoc_file->[1] . "\n";
824 # if assoc file starts with a slash, we put it relative to the assoc
825 # dir, otherwise it is relative to the HASH... directory
826 if ($assoc_file->[1] =~ m@^[/\\]@) {
827 $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]);
828 } else {
829 $afile = &util::filename_cat($self->{'assocdir'}, $archivedir, $assoc_file->[1]);
830 }
831 &util::hard_link ($assoc_file->[0], $afile, $self->{'verbosity'});
832 }
833}
834
Note: See TracBrowser for help on using the repository browser.