Changeset 315 for trunk/gsdl/perllib/mgbuildproc.pm

Timestamp:

1999-06-30T15:35:07+12:00 (25 years ago)

Author:

sjboddie

Message:

• removed old infodb stuff
• changed the way classifiers work
• added maxdocs and allclassifications options
• no longer get doctype from collect.cfg but instead set it directly in plugins that don't use the default

File:

• trunk/gsdl/perllib/mgbuildproc.pm (modified) (3 diffs)

trunk/gsdl/perllib/mgbuildproc.pm

@@ -107 +107 @@
 }
 
-sub newinfodb {
+sub infodb {
     my $self = shift (@_);
     my ($doc_obj, $filename) = @_;
     my $handle = $self->{'output_handle'};
 #    $handle = "main::STDOUT";
-
-    # this was used in the old version
-    return if ($doc_obj eq 'classifications');
 
     my $doctype = $doc_obj->get_doc_type();
@@ -209 +206 @@
     &classify::classify_doc ($self->{'classifiers'}, $doc_obj);
 
-}
-
-
-
-sub infodb {
-    my $self = shift (@_);
-    my ($doc_obj, $filename) = @_;
-    my $handle = $self->{'output_handle'};
-
-    if ($doc_obj eq 'classifications') {
-    # output classifications if all books have been processed
-    foreach $key (keys %$saved_classifications) {
-        $saved_classifications->{$key}->{'contains'} = undef if 
-        $saved_classifications->{$key}->{'contains'} eq "";
-        $saved_classifications->{$key}->{'parent'} = undef if 
-        (!defined $saved_classifications->{$key}->{'parent'}) || 
-            ($saved_classifications->{$key}->{'parent'} eq "");
-        $self->write_to_gdbm ($handle, $key, $saved_classifications->{$key}->{'title'}, 
-                  undef, undef, undef, undef, 
-                  $saved_classifications->{$key}->{'contains'}, undef, 
-                  $saved_classifications->{$key}->{'parent'}, undef, undef);
-    }
-    return;
-    }
-
-    my $doctype = $doc_obj->get_doc_type();
-
-    # only output this document if it is one to be indexed
-    return if ($doctype ne "indexed_doc" && 
-           $doctype ne "classification");
-
-    # found classification document
-    $saved_classifications = {} if ($doctype eq "classification");
-    $sectionmap = {};
-
-    # this is another document
-    $self->{'num_docs'} += 1 unless ($doctype eq "classification");
-
-    my $section = $doc_obj->get_top_section();
-    while (defined $section) {
-    # update a few statistics
-    $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
-    $self->{'num_sections'} += 1 unless ($doctype eq "classification");
-
-    my $title = $doc_obj->get_metadata_element($section, "Title");
-    my $source = $doc_obj->get_metadata_element($section, "Source"); 
-    my $date = $doc_obj->get_metadata_element($section, "Date"); 
-    my $jobnumber = $doc_obj->get_source_filename();
-
-    my $mapped_section = $self->map_section($doctype, $section);
-    if ($doctype eq "classification") {
-        $mapped_section = $self->char_classification($mapped_section);
-    } else {
-        $mapped_section = "B.$self->{'num_docs'}.$mapped_section";
-    }
-    $mapped_section =~ s/\.+$//;
-
-    my ($parent, $classification, $creator);
-    
-    $classification = $self->get_classifications($doc_obj, $section, $mapped_section)
-        unless $doctype eq "classification";
-
-    if ($section ne $doc_obj->get_top_section()) {
-        $parent = $self->map_section($doctype, $doc_obj->get_parent_section($section));
-        if ($doctype eq "classification") {
-        $parent = $self->char_classification($parent);
-        } else {
-        $parent = "B.$self->{'num_docs'}.$parent";
-        }
-        $parent =~ s/\.+$//;
-    } else {
-        $creator = $doc_obj->get_metadata_element($section, "Creator");
-
-        # need filename so we know what directory to look in for associated files
-        $filename =~ s/^\/?(.*?\.dir).*$/$1/ if (defined $filename);
-    }
-
-    if ($doc_obj->is_leaf_section($section)) {
-        if ($doctype eq "classification") {
-        if (defined $saved_classifications->{$mapped_section}) {
-            print STDERR "mgbuildproc:warning: classification $mapped_section " .
-            "declared multiple times\n";
-        } else {
-            $saved_classifications->{$mapped_section}  = {'title' => $title, 'contains' => "",
-                                  'parent' => $parent};
-        }
-        } else {
-        $self->write_to_gdbm($handle, $mapped_section, $title, $creator, $source, $date, $jobnumber, undef,
-                     $self->{'num_sections'}, $parent, $classification, $filename);
-        }
-    } else {
-
-        # add the introductory section if it exists
-        my $contains = "";
-        if ($doc_obj->get_text_length($section) > 0) {
-        $contains .= "B.$self->{'num_docs'}." . $self->map_section ($doctype, "$section.0");
-        }
-
-        # add the rest of the children
-        my @children = @{$doc_obj->get_children($section)};
-        if ($doctype eq "classification") {
-        map {$_ = $self->char_classification($_);} @children;
-        if (defined $saved_classifications->{$mapped_section}) {
-            print STDERR "mgbuildproc:warning: classification $mapped_section " .
-            "declared multiple times\n";
-        } else {
-            $saved_classifications->{$mapped_section}  = {'title' => $title, 'contains' => ""};
-            $saved_classifications->{$mapped_section}->{'contains'} = join ":", @children;
-            $saved_classifications->{$mapped_section}->{'parent'} = $parent;
-        }
-        } else {
-        map {$_ = "B.$self->{'num_docs'}." . $self->map_section($doctype, $_);} @children;
-        $contains .= ":" if $contains ne "";
-        $contains .= join ":", @children;
-        $self->write_to_gdbm ($handle, $mapped_section, $title, $creator, $source,
-                      $date, $jobnumber, $contains, $self->{'num_sections'},
-                      $parent, $classification, $filename);
-
-        if ($doc_obj->get_text_length($section) > 0) {
-            my $intromapsection = "B.$self->{'num_docs'}." . 
-            $self->map_section($doctype, "$section.0");
-            $self->write_to_gdbm ($handle, $intromapsection, "<i>(introductory text)</i>", $creator,
-                      $source, $date, $jobnumber, undef, $self->{'num_sections'},
-                      $mapped_section, $classification, $filename);
-        }
-        }
-    }
-    $section = $doc_obj->get_next_section($section);
-    }
-    
-    # update classification list with those books that 
-    # were processed before classification list
-    if ($doctype eq "classification" && defined $temp_classifications) {
-    foreach $key (keys(%$temp_classifications)) {
-        if (!defined $saved_classifications->{$key}) {
-        print STDERR "mgbuildproc:$temp_classifications->{$key} belong to " .
-            "undefined classification $key\n";
-        } 
-        $saved_classifications->{$key}->{'contains'} = $temp_classifications->{$key}->{'contains'};
-    }
-    $temp_classifications = undef;
-    }
-}
-
-
-sub write_to_gdbm {
-    my $self = shift (@_);
-    my ($handle, $section, $title, $creator, $source, $date, 
-    $jobnumber, $contains, $docnum, $parent, $classification, $OID) = @_;
-
-    print $handle "[$section]\n";
-    print $handle "<t>$title\n" if (defined $title && $title ne "");
-    print $handle "<a>$creator\n" if (defined $creator && $creator ne "");
-    print $handle "<s>$source\n" if (defined $source && $source ne "");
-    print $handle "<i>$date\n" if (defined $date && $date ne "");
-    print $handle "<j>$jobnumber\n" if (defined $jobnumber && $jobnumber ne "");
-    print $handle "<c>$contains\n" if (defined $contains && $contains ne "");
-    print $handle "<d>$docnum\n" if (defined $docnum && $docnum ne "");
-    print $handle "<p>$parent\n" if (defined $parent && $parent ne "");
-    print $handle "<x>$classification\n" if (defined $classification && $classification ne "");
-    print $handle "<o>$OID\n" if defined $OID;
-    print $handle '-' x 70, "\n";
-    
-    if (defined $docnum) {
-    print $handle "[$docnum]\n";
-    print $handle "<x>$section\n";
-    print $handle '-' x 70, "\n";
-    }
-}
-
-sub get_classifications {
-    my $self = shift (@_);
-    my ($doc_obj, $section, $mapped_section) = @_;
-
-    my ($classificationsref);
-    if (defined $saved_classifications) {
-    # classification list has been processed
-    $classificationsref = $saved_classifications;
-    } else {
-    # classification list has yet to be processed, save
-    # books in temp_classifications until list is processed
-    # and they can be moved into saved_classifications
-    $temp_classifications = {} unless defined $temp_classifications;
-    $classificationsref = $temp_classifications;
-    }
-
-    my $classifications = $doc_obj->get_metadata($section, "Subject");
-
-    # need to save which books belong in each classification
-    # to output later
-    foreach $classification (@$classifications) {
-
-    if (!defined $classificationsref->{$classification}) {
-        $classificationsref->{$classification}->{'parent'} = $doc_obj->get_parent_section($section);
-        $classificationsref->{$classification}->{'contains'} = "";
-    }
-    $classificationsref->{$classification}->{'contains'} .= ":" unless
-        $classificationsref->{$classification}->{'contains'} eq "";
-    $classificationsref->{$classification}->{'contains'} .= $mapped_section;
-    }
-
-    return (join ":", @$classifications);
-}
-
-sub map_section {
-    my $self = shift (@_);
-    my ($doctype, $section) = @_;
-
-    # classifications should never need to be mapped
-    return $section if $doctype eq "classification";
-
-    return "" unless (defined $section) && ($section ne "");
-
-    $sectionmap = {} unless defined $sectionmap;
-
-
-
-    # get the section into a standard format
-    $section =~ s/^\.+|\.+$//g;
-
-    # return the mapped section if it has been seen before
-    if (defined $sectionmap->{$section}) {
-    return $sectionmap->{$section};
-    }
-
-    # find out the parent section
-    my ($parentsection, $num);
-    if ($section =~ /^(.+)\.(\d+)$/) {
-    $parentsection = $1;
-    $num = $2;
-    } elsif ($section =~ /^(\d+)$/) {
-    $parentsection = "";
-    $num = $1;
-    } else {
-    print STDERR "mgbuildproc:map_section - misformed section $section\n";
-    }
-    $parentsection = "" unless defined $parentsection;
-
-    if ($parentsection eq "") {
-    $num ++ if $num == 1 and defined $sectionmap->{'0'};
-    } else {
-    $num ++ if $num == 1 and defined $sectionmap->{"$parentsection.0"};
-    }
-
-    # find out the mapped parent section
-    my $mappedparentsection = $self->map_section ($doctype, $parentsection);
-
-    # find the next unused child section
-    my $previousnum = $num - 1;
-    my $previoussection = "";
-    if ($parentsection eq "") {
-    $previoussection = $previousnum;
-    $previoussection = 0 if ($section == 1) && (defined $sectionmap->{'0'});
-    } else{
-    $previoussection = "$parentsection.$previousnum";
-    $previoussection = "$parentsection.0" if ($section =~ /\.1$/) && (defined $sectionmap->{"$parentsection.0"});
-    }
-    while (($previousnum > 0) && (!defined $sectionmap->{$previoussection})) {
-    $previousnum--;
-    $previoussection = "$parentsection.$previousnum";
-    $previoussection = $previousnum if $parentsection eq "";
-    }
-
-    # there has been no children under this parent, this section will be number 1
-    if ($previousnum <= 0) {
-    if ($mappedparentsection eq "") {
-        $sectionmap->{$section} = "1";
-    } else {
-        $sectionmap->{$section} = "$mappedparentsection.1";
-    }
-
-    } else {
-    # get the previous mapped number
-    my $previousmapnum = 0;
-    if ($sectionmap->{$previoussection} =~ /(^|\.)?(\d+)$/) {
-        $previousmapnum = $2;
-    }
-    
-    # increment it to get this mapped child
-    my $mappednum = $previousmapnum+1;
-
-    if ($mappedparentsection eq "") {
-        $sectionmap->{$section} = $mappednum;
-    } else {
-        $sectionmap->{$section} = "$mappedparentsection.$mappednum";
-    }
-    }
-
-    return $sectionmap->{$section};
 }
 
@@ -591 +299 @@
             if ($self->{'indexing_text'} && 
             $new_text =~ /[\(\)\{\}]/) {
-            print "arrgh: $new_text\n";
             }