########################################################################### # # mgbuildproc.pm -- # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 1999 New Zealand Digital Library Project # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### # This document processor outputs a document # for mg to process package mgppbuildproc; use classify; use doc; use docproc; use util; BEGIN { @ISA = ('docproc'); } sub new { my ($class, $collection, $source_dir, $build_dir, $verbosity) = @_; my $self = new docproc (); $self->{'collection'} = $collection; $self->{'source_dir'} = $source_dir; $self->{'build_dir'} = $build_dir; $self->{'verbosity'} = $verbosity; $self->{'classifiers'} = []; $self->{'mode'} = "text"; $self->{'assocdir'} = $build_dir; $self->{'dontgdbm'} = {}; $self->{'index'} = "text"; $self->{'indexexparr'} = []; $self->{'output_handle'} = "STDOUT"; $self->{'num_docs'} = 0; $self->{'num_sections'} = 0; $self->{'num_bytes'} = 0; $self->{'indexing_text'} = 0; return bless $self, $class; } sub reset { my $self = shift (@_); $self->{'num_docs'} = 0; $self->{'num_sections'} = 0; $self->{'num_bytes'} = 0; } sub get_num_docs { my $self = shift (@_); return $self->{'num_docs'}; } sub get_num_sections { my $self = shift (@_); return $self->{'num_sections'}; } sub get_num_bytes { my $self = shift (@_); return $self->{'num_bytes'}; } sub set_output_handle { my $self = shift (@_); my ($handle) = @_; $self->{'output_handle'} = $handle; } sub set_mode { my $self = shift (@_); my ($mode) = @_; $self->{'mode'} = $mode; } sub set_assocdir { my $self = shift (@_); my ($assocdir) = @_; $self->{'assocdir'} = $assocdir; } sub set_dontgdbm { my $self = shift (@_); my ($dontgdbm) = @_; $self->{'dontgdbm'} = $dontgdbm; } sub set_index { my $self = shift (@_); my ($index, $indexexparr) = @_; $self->{'index'} = $index; $self->{'indexexparr'} = $indexexparr if defined $indexexparr; } sub set_classifiers { my $self = shift (@_); my ($classifiers) = @_; $self->{'classifiers'} = $classifiers; } sub set_indexing_text { my $self = shift (@_); my ($indexing_text) = @_; $self->{'indexing_text'} = $indexing_text; } sub process { my $self = shift (@_); my $method = $self->{'mode'}; $self->$method(@_); } # use 'Paged' if document has no more than 2 levels # and each section at second level has a number for # Title metadata sub get_document_type { my $self = shift (@_); my ($doc_obj) = @_; my $thistype = "VList"; my $childtype = "VList"; my $title; my @tmp = (); my $section = $doc_obj->get_top_section (); my $first = 1; while (defined $section) { @tmp = split /\./, $section; if (scalar(@tmp) > 1) { return ($thistype, $childtype); } if (!$first) { $title = $doc_obj->get_metadata_element ($section, "Title"); if (!defined $title || $title !~ /^\d+$/) { return ($thistype, $childtype); } } $first = 0; $section = $doc_obj->get_next_section($section); } if ($doc_obj->get_text_length ($doc_obj->get_top_section())) { $thistype = "Paged"; } else { $thistype = "Invisible"; } $childtype = "Paged"; return ($thistype, $childtype); } sub assoc_files { my $self = shift (@_); my ($doc_obj, $archivedir) = @_; my ($afile); foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) { # if assoc file contains directory structure of # its own use it, otherwise use HASH... directory if ($assoc_file->[1] =~ /[\/\\]/) { $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]); } else { $afile = &util::filename_cat($self->{'assocdir'}, $archivedir, $assoc_file->[1]); } &util::hard_link ($assoc_file->[0], $afile); } } sub infodb { my $self = shift (@_); my ($doc_obj, $filename) = @_; my $handle = $self->{'output_handle'}; # $handle = "main::STDOUT"; my $doctype = $doc_obj->get_doc_type(); # only output this document if it is one to be indexed return if ($doctype ne "indexed_doc"); my ($archivedir) = $filename =~ /^(.*?)(?:\/|\\)[^\/\\]*$/; $archivedir = "" unless defined $archivedir; $archivedir =~ s/\\/\//g; $archivedir =~ s/^\/+//; $archivedir =~ s/\/+$//; $self->assoc_files ($doc_obj, $archivedir); # this is another document $self->{'num_docs'} += 1 unless ($doctype eq "classification"); # is this a paged or a hierarchical document my ($thistype, $childtype) = $self->get_document_type ($doc_obj); my $section = $doc_obj->get_top_section (); my $doc_OID = $doc_obj->get_OID(); my $first = 1; my $url = ""; while (defined $section) { # update a few statistics $self->{'num_bytes'} += $doc_obj->get_text_length ($section); $self->{'num_sections'} += 1 unless ($doctype eq "classification"); # output the section name if ($section eq "") { print $handle "[$doc_OID]\n"; } else { print $handle "[$doc_OID.$section]\n"; } # output the fact that this document is a document #print $handle "doc\n"; # output whether this node contains text if ($doc_obj->get_text_length($section) > 0) { print $handle "1\n"; } else { print $handle "0\n"; } # output all the section metadata my $found_doctype = 0; my $metadata = $doc_obj->get_all_metadata ($section); foreach $pair (@$metadata) { my ($field, $value) = (@$pair); $found_doctype = 1 if $field eq "doctype"; if ($field ne "Identifier" && $field !~ /^gsdl/ && defined $value && $value ne "") { # escape problematic stuff $value =~ s/\\/\\\\/g; $value =~ s/\n/\\n/g; $value =~ s/\r/\\r/g; # special case for URL metadata if ($field =~ /^URL$/i) { $url .= "[$value]\n"; if ($section eq "") {$url .= "
$doc_OID\n";} else {$url .= "
$doc_OID.$section\n";} $url .= '-' x 70 . "\n"; } if (!defined $self->{'dontgdbm'}->{$field}) { print $handle "<$field>$value\n"; } } } # output the fact that this document is a document # (unless doctype was already output as part of # metadata) if (!$found_doctype && !defined $self->{'dontgdbm'}->{'doctype'}) { print $handle "doc\n"; } # output archivedir if at top level if ($section eq $doc_obj->get_top_section()) { print $handle "$archivedir\n"; } # output document display type if ($first) { print $handle "$thistype\n"; } # output a list of children my $children = $doc_obj->get_children ($section); if (scalar(@$children) > 0) { print $handle "$childtype\n"; print $handle ""; my $firstchild = 1; foreach $child (@$children) { print $handle ";" unless $firstchild; $firstchild = 0; if ($child =~ /^.*?\.(\d+)$/) { print $handle "\".$1"; } else { print $handle "\".$child"; } # if ($child eq "") { print $handle "$doc_OID"; } # elsif ($section eq "") { print $handle "$doc_OID.$child"; } # else { print $handle "$doc_OID.$section.$child"; } } print $handle "\n"; } # output the matching document number print $handle "$self->{'num_sections'}\n"; print $handle '-' x 70, "\n"; # output a database entry for the document number print $handle "[$self->{'num_sections'}]\n"; if ($section eq "") { print $handle "
$doc_OID\n"; } else { print $handle "
$doc_OID.$section\n"; } print $handle '-' x 70, "\n"; # output entry for url if ($url ne "") { print $handle $url; } $first = 0; $section = $doc_obj->get_next_section($section); } # classify this document &classify::classify_doc ($self->{'classifiers'}, $doc_obj); } sub find_paragraphs { $_[1] =~ s/($1/gi; } sub filter_text { # $self->filter_text ($field, $new_text); # don't want to do anything for this version, however, # in a particular collection you might want to override # this method to post-process certain fields depending on # the field, or whether we are outputting it for indexing } sub text { my $self = shift (@_); my ($doc_obj) = @_; my $handle = $self->{'output_handle'}; my $indexed_doc = 1; # only output this document if it is one to be indexed return if ($doc_obj->get_doc_type() ne "indexed_doc"); # see if this document belongs to this subcollection foreach $indexexp (@{$self->{'indexexparr'}}) { $indexed_doc = 0; my ($field, $exp, $options) = split /\//, $indexexp; if (defined ($field) && defined ($exp)) { my ($bool) = $field =~ /^(.)/; $field =~ s/^.// if $bool eq '!'; if ($field =~ /^filename$/i) { $field = $doc_obj->get_source_filename(); } else { $field = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $field); } next unless defined $field; if ($bool eq '!') { if ($options =~ /^i$/i) { if ($field !~ /$exp/i) {$indexed_doc = 1; last;} } else { if ($field !~ /$exp/) {$indexed_doc = 1; last;} } } else { if ($options =~ /^i$/i) { if ($field =~ /$exp/i) {$indexed_doc = 1; last;} } else { if ($field =~ /$exp/) {$indexed_doc = 1; last;} } } } } # this is another document $self->{'num_docs'} += 1; # get the parameters for the output my ($fields) = $self->{'index'}; #print STDERR "fields are $fields\n"; $fields =~ s/\ball\b/Title,Creator,text/; # add in others here my $doc_section = 0; # just for this document my $text = "\n"; my $text_extra = ""; # get the text for this document my $section = $doc_obj->get_top_section(); while (defined $section) { # update a few statistics $doc_section++; $self->{'num_sections'} += 1; $text .= "
\n"; if ($indexed_doc) { $self->{'num_bytes'} += $doc_obj->get_text_length ($section); foreach $field (split (/,/, $fields)) { # only deal with this field if it doesn't start with top or # this is the first section my $real_field = $field; if (!($real_field =~ s/^top//) || ($doc_section == 1)) { my $new_text = ""; if ($real_field eq "text") { #print STDERR "in text bit"; $new_text = ""; $new_text .= $doc_obj->get_text ($section); $self->find_paragraphs($new_text); } else { # metadata field if ($real_field eq "metadata") { # insert all metadata #except gsdl stuff #print STDERR "in metadata bit\n"; my $metadata = $doc_obj->get_all_metadata ($section); foreach $pair (@$metadata) { my ($mfield, $mvalue) = (@$pair); #print STDERR "$mfield, $mvalue\n"; # check fields here, maybe others dont want if ($mfield ne "Identifier" && $mfield ne "classifytype" && $mfield !~ /^gsdl/ && defined $mvalue && $mvalue ne "") { $new_text .= "<$mfield>$mvalue\n"; #print STDERR "metadata=$mfield:$mvalue"; } } } else { #individual metadata specified foreach $item (@{$doc_obj->get_metadata ($section, $real_field)}) { $new_text .= "<$real_field>$item\n"; } } } # filter the text $self->filter_text ($field, $new_text); #???????????????????? if ($self->{'indexing_text'} && $new_text =~ /[\(\)\{\}]/) { } $text .= "$new_text"; } } } # if (indexed_doc) $section = $doc_obj->get_next_section($section); } #while defined section print $handle "$text"; } 1;