Changeset 69

Timestamp:

1998-12-11T14:45:40+13:00 (25 years ago)

Author:

sjboddie

Message:

Sub-collection indexes may now be defined within the collect.cfg file as
subcollection blah1 Title/blah/i
subcollection blah2 !Title/blah/i
indexsubcollections blah1 blah2 blah1,blah2
indexes section:text document:text
This example would create section:text and document:text indexes for:

1. the blah1 subcollection (i.e those documents whose Title field contains 'blah')
2. the blah2 subcollection (i.e. those documents whose Title field doesn't contain 'blah')
3. both subcollections (i.e. all documents)

The field to match the regular expression against (Title in this example) may be
any valid metadata tag or 'filename'.
The regular expression (blah in this example) may be any valid perl regular expression.

Location:

trunk/gsdl/perllib

Files:

• cfgread.pm (modified) (4 diffs)
• colcfg.pm (modified) (3 diffs)
• mgbuilder.pm (modified) (4 diffs)
• mgbuildproc.pm (modified) (4 diffs)

trunk/gsdl/perllib/cfgread.pm

@@ -28 +28 @@
 #   '^(this|that)$'
 sub read_cfg_file {
-    my ($filename, $stringexp, $arrayexp) = @_;
+    my ($filename, $stringexp, $arrayexp, $hashexp) = @_;
     my ($line);
     my $data = {};
@@ -41 +41 @@
         } elsif ($key =~ /$arrayexp/) {
             push (@{$data->{$key}}, @$line);
+
+        } elsif ($key =~ /$hashexp/) {
+            my $k = shift @$line;
+            my $v = shift @$line;
+            $data->{$key}->{$k} = $v;
         }
         }
@@ -56 +61 @@
 #   '^(this|that)$'
 sub write_cfg_file {
-    my ($filename, $data, $stringexp, $arrayexp) = @_;
+    my ($filename, $data, $stringexp, $arrayexp, $hashexp) = @_;
 
     if (open (COLCFG, ">$filename")) {
@@ -64 +69 @@
         } elsif ($key =~ /$arrayexp/) {
         &write_cfg_line ('COLCFG', [$key, @{$data->{$key}}]);
+        } elsif ($key =~ /$hashexp/) {
+        foreach $k (keys (%{$data->{$key}})) {
+            &write_cfg_line ('COLCFG', [$key, $k, $data->{$key}->{$k}]);
+        }
         }
     }

trunk/gsdl/perllib/colcfg.pm

@@ -13 +13 @@
 # {'beta'}->string
 # {'key'}->string
+# {'subcollection'}->hash of key-value pairs
+# {'indexsubcollections'}->array of strings
 # {'indexes'}->array of strings
 # {'defaultindex'}->string
@@ -22 +24 @@
     return &cfgread::read_cfg_file ($filename, 
             '^(creator|public|beta|key|defaultindex)$', 
-            '^(maintainer|indexes|plugins)$');
+            '^(maintainer|indexsubcollections|indexes|plugins)$',
+            '^(subcollection)$');
 }
 
@@ -30 +33 @@
     &cfgread::write_cfg_file($filename, $data,
             '^(creator|public|beta|key|defaultindex)$', 
-            '^(maintainer|indexes|plugins)$');
+            '^(maintainer|subcollection|indexsubcollections|indexes|plugins)$',
+            '^(subcollection)$');
 }
 

trunk/gsdl/perllib/mgbuilder.pm

@@ -41 +41 @@
 
 
+    # sort out subcollection indexes
+    if (defined $self->{'collect_cfg'}->{'indexsubcollections'}) {
+    my $indexes = $self->{'collect_cfg'}->{'indexes'};
+    $self->{'collect_cfg'}->{'indexes'} = [];
+    foreach $subcollection (@{$self->{'collect_cfg'}->{'indexsubcollections'}}) {
+        foreach $index (@$indexes) {
+        push (@{$self->{'collect_cfg'}->{'indexes'}}, "$index:$subcollection");
+        }
+    }
+    }
+
     # get the list of plugins for this collection
     my @plugins = (); # some good choice of plugins .... ????
@@ -177 +188 @@
     
     foreach $index (@$indexes) {
-    my ($level, $fields) = split (":", $index);
-    my @fields = split (",", $fields);
+    my ($level, $fields, $subcollection) = split (":", $index);
+    my @fields = split (/,/, $fields);
     splice (@fields, 2); # just want first two fields
     
@@ -189 +200 @@
     map {s/^(.).*?([bcdfghjklmnpqrstvwxyz]).*$/$1$2/i;} @fields;
     $dirname .= join("", @fields);
+
+    # next comes a processed version of the subcollection if there is one.
+    # the processed version contains the first character and the next
+    # consonant if there's only one field, other wise the first character
+    # of the first two fields
+    if (defined ($subcollection) && $subcollection =~ /\w/) {
+        @fields = split /,/, $subcollection;
+        if (scalar @fields >= 2) {
+        splice (@fields, 2);
+        map {s/^(.).*$/$1/i;} @fields;
+        $dirname .= join("", @fields);
+        } else {
+        $subcollection =~ s/^(.).*?([bcdfghjklmnpqrstvwxyz]).*$/$1$2/i;
+        $dirname .= $subcollection;
+        }
+    }
 
     # convert the directory name to lowercase
@@ -238 +265 @@
     $index_level = 3 if $index =~ /^paragraph/i;
 
+    # get the index expression if this index belongs
+    # to a subcollection
+    my $indexexparr = [];
+    my ($level, $fields, $subcollection) = split (":", $index);
+    my (@subcollections) = split /,/, $subcollection;
+
+    foreach $subcollection (@subcollections) {
+    if (defined ($self->{'collect_cfg'}->{'subcollection'}->{$subcollection})) {
+        push (@$indexexparr, $self->{'collect_cfg'}->{'subcollection'}->{$subcollection});
+    } 
+    }
+    
     # set up the document processor
     $self->{'buildproc'}->set_output_handle ('mgbuilder::PIPEOUT');
     $self->{'buildproc'}->set_mode ('text');
-    $self->{'buildproc'}->set_index ($index);
+    $self->{'buildproc'}->set_index ($index, $indexexparr);
 
 

trunk/gsdl/perllib/mgbuildproc.pm

@@ -24 +24 @@
     $self->{'mode'} = "text";
     $self->{'index'} = "section:text";
+    $self->{'indexexparr'} = [];
     $self->{'output_handle'} = "STDOUT";
     $self->{'num_docs'} = 0;
@@ -74 +75 @@
 sub set_index {
     my $self = shift (@_);
-    my ($index) = @_;
+    my ($index, $indexexparr) = @_;
 
     $self->{'index'} = $index;
+    $self->{'indexexparr'} = $indexexparr if defined $indexexparr;
 }
 
@@ -391 +393 @@
     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 eq "filename") {
+        $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
@@ -412 +444 @@
     # update a few statistics
     $doc_section++;
-    $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
     $self->{'num_sections'} += 1;
-    
-    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") {
-            $new_text = $doc_obj->get_text ($section);
-            $new_text =~ s/[\cB\cC]//g;
-            $new_text =~ s/(<p\b)/\cC$1/gi;
+
+    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") {
+            $new_text = $doc_obj->get_text ($section);
+            $new_text =~ s/[\cB\cC]//g;
+            $new_text =~ s/(<p\b)/\cC$1/gi;
+            
+            } else {
+            $new_text = join ("\cC", @{$doc_obj->get_metadata ($section, $real_field)});
+            }
             
-        } else {
-            $new_text = join ("\cC", @{$doc_obj->get_metadata ($section, $real_field)});
-        }
-        
-        $text .= "$new_text\cC";
+            $text .= "$new_text\cC";
+        }
         }
     }