Changeset 215

Timestamp:

1999-03-30T17:08:18+12:00 (25 years ago)

Author:

rjmcnab

Message:

Added code to build a new gdbm format.

Location:

trunk/gsdl

Files:

• bin/script/buildcol.pl (modified) (3 diffs)
• perllib/doc.pm (modified) (3 diffs)
• perllib/mgbuilder.pm (modified) (7 diffs)
• perllib/mgbuildproc.pm (modified) (4 diffs)

trunk/gsdl/bin/script/buildcol.pl

@@ -29 +29 @@
 {
     if (!parsargv::parse(\@ARGV, 
+             'newgdbm', \$newgdbm,
              'verbosity/\d+/2', \$verbosity,
              'archivedir/.*/', \$archivedir,
@@ -36 +37 @@
     die "\n";
     }
+
+    $newgdbm = 0 unless $newgdbm;
 
     # get and check the collection
@@ -109 +112 @@
 
     eval("\$builder = new $buildertype(\$collection, " .
-     "\$realarchivedir, \$realbuilddir, \$verbosity)");
+     "\$realarchivedir, \$realbuilddir, \$verbosity, \$newgdbm)");
     die "$@" if $@;
 

trunk/gsdl/perllib/doc.pm

@@ -116 +116 @@
     my $sectionref = $self;
 
-    while ($section ne "") {
+    while (defined $section && $section ne "") {
     ($num, $section) = $section =~ /^\.?(\d+)(.*)$/;
     $num =~ s/^0+(\d)/$1/; # remove leading 0s
@@ -260 +260 @@
 
 # returns a reference to a list of children
-
 sub get_children {
     my $self = shift (@_);
@@ -516 +515 @@
 
     foreach $data (@{$section_ptr->{'metadata'}}) {
-    return $data->[1] if ($data->[0] eq $field);
+    return $data->[1] if (scalar(@$data) >= 2 && $data->[0] eq $field);
     }
     

trunk/gsdl/perllib/mgbuilder.pm

@@ -4 +4 @@
 package mgbuilder;
 
+use classify;
 use cfgread;
 use colcfg;
@@ -24 +25 @@
 
 sub new {
-    my ($class, $collection, $source_dir, $build_dir, $verbosity) = @_;
+    my ($class, $collection, $source_dir, $build_dir, $verbosity, $newgdbm) = @_;
 
     # create an mgbuilder object
@@ -30 +31 @@
               'source_dir'=>$source_dir,
               'build_dir'=>$build_dir,
-              'verbosity'=>$verbosity}, $class;
+              'verbosity'=>$verbosity,
+              'newgdbm'=>$newgdbm}, $class;
 
 
     # read in the collection configuration file
-    if (!-e "$ENV{'GSDLCOLLECTDIR'}/etc/collect.cfg") {
+    my $colcfgname = "$ENV{'GSDLCOLLECTDIR'}/etc/collect.cfg";
+    if (!-e $colcfgname) {
     die "mgbuilder::new - couldn't find collect.cfg for collection $collection\n";
     }
-    $self->{'collect_cfg'} = &colcfg::read_collect_cfg ("$ENV{'GSDLHOME'}/collect/" .
-                            "$collection/etc/collect.cfg");
-
+    $self->{'collect_cfg'} = &colcfg::read_collect_cfg ($colcfgname);
 
     # sort out subcollection indexes
@@ -76 +77 @@
     die "\n";
     }
-    
+
+    # load all the classifiers
+    if ($self->{'newgdbm'}) {
+    $self->{'classifiers'} = [];
+    if (open (COLCFG, $colcfgname)) {
+        while (defined ($line = &cfgread::read_cfg_line('mgbuilder::COLCFG'))) {
+        if (scalar(@$line) >= 2) {
+            my $key = shift (@$line);
+            if ($key eq "classify") {
+            my $classinfo = &classify::load_classifier($line);
+            push (@{$self->{'classifiers'}}, $classinfo) 
+                if defined $classinfo;
+            }
+        }
+        }
+        close (COLCFG);
+    } else {
+        print STDERR "mgbuilder::new couldn't read the cfg file $colcfgname\n";
+        print STDERR "               no classifiers were loaded\n";
+    }
+    }
 
     # load up the document processor for building
@@ -92 +113 @@
 
     eval("\$self->{'buildproc'} = new $buildproctype(\$collection, " .
-     "\$source_dir, \$build_dir, \$verbosity)");
+     "\$source_dir, \$build_dir, \$verbosity, \$newgdbm)");
     die "$@" if $@;
 
@@ -436 +457 @@
     print STDERR "\n*** creating the info database\n" if ($self->{'verbosity'} >= 1);
 
+    # init all the classifiers
+    if ($self->{'newgdbm'}) {
+    &classify::init_classifiers ($self->{'classifiers'});
+    }
+
     # set up the document processor
     $self->{'buildproc'}->set_output_handle ('mgbuilder::PIPEOUT');
-    $self->{'buildproc'}->set_mode ('infodb');
-    
-    # collect the statistics for the text
-    # -b $maxdocsize sets the maximum document size to be 12 meg
+    if ($self->{'newgdbm'}) {
+    $self->{'buildproc'}->set_mode ('newinfodb');
+    $self->{'buildproc'}->set_classifiers ($self->{'classifiers'});
+    } else {
+    $self->{'buildproc'}->set_mode ('infodb');
+    }
+    
+    # create the infodatabase
     if (!-e "$exedir/txt2db$exe" || !open (PIPEOUT, 
             "| $exedir/txt2db$exe $fulldbname")) {
@@ -449 +479 @@
     &plugin::read ($self->{'pluginfo'}, $self->{'source_dir'}, 
            "", {}, $self->{'buildproc'});
+
+    # output classification information
+    if ($self->{'newgdbm'}) {
+    &classify::output_classify_info ($self->{'classifiers'}, 'mgbuilder::PIPEOUT');
+    }
+
     close (PIPEOUT);
 }

trunk/gsdl/perllib/mgbuildproc.pm

@@ -5 +5 @@
 package mgbuildproc;
 
+use classify;
+use doc;
 use docproc;
 use util;
@@ -22 +24 @@
     $self->{'build_dir'} = $build_dir;
     $self->{'verbosity'} = $verbosity;
+    $self->{'classifiers'} = [];
     $self->{'mode'} = "text";
     $self->{'index'} = "section:text";
@@ -81 +84 @@
 }
 
+sub set_classifiers {
+    my $self = shift (@_);
+    my ($classifiers) = @_;
+
+    $self->{'classifiers'} = $classifiers;
+}
+
 sub process {
     my $self = shift (@_);
@@ -87 +97 @@
     $self->$method(@_);
 }
+
+sub newinfodb {
+    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();
+
+    # only output this document if it is one to be indexed
+    return if ($doctype ne "indexed_doc");
+
+    # this is another document
+    $self->{'num_docs'} += 1 unless ($doctype eq "classification");
+
+    my $section = $doc_obj->get_top_section ();
+    my $doc_OID = $doc_obj->get_OID();
+    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 "<doctype>doc\n";
+
+    # output whether this node contains text
+    if ($doc_obj->get_text_length($section) > 0) {
+        print $handle "<hastxt>1\n";
+    } else {
+        print $handle "<hastxt>0\n";
+    }
+
+    # output all the section metadata
+    my $metadata = $doc_obj->get_all_metadata ($section);
+    foreach $pair (@$metadata) {
+        my ($field, $value) = (@$pair);
+
+        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;
+        
+        print $handle "<$field>$value\n";
+        }
+    }
+
+    # output a list of children
+    my $children = $doc_obj->get_children ();
+    if (scalar(@$children) > 0) {
+        print $handle "<contains>";
+        my $firstchild = 1;
+        foreach $child (@$children) {
+        print $handle ";" unless $firstchild;
+        $firstchild = 0;
+        if ($child eq "") { print $handle "$doc_OID"; }
+        else { print $handle "$doc_OID.$child"; }
+        }
+        print $handle "\n";
+    }
+
+    # output the matching document number
+    print $handle "<docnum>$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 "<section>$doc_OID\n"; }
+    else { print $handle "<section>$doc_OID.$section\n"; }
+    print $handle '-' x 70, "\n";
+
+
+    $section = $doc_obj->get_next_section($section);
+    }
+
+    # classify this document
+    &classify::classify_doc ($self->{'classifiers'}, $doc_obj);
+
+}
+
+
 
 sub infodb {