Changeset 139

Timestamp:

1999-02-03T14:43:31+13:00 (25 years ago)

Author:

sjboddie

Message:

Got building stuff to handle subcollections and language subcollections

Location:

trunk/gsdl/perllib

Files:

• colcfg.pm (modified) (3 diffs)
• mgbuilder.pm (modified) (5 diffs)
• mgbuildproc.pm (modified) (6 diffs)
• plugins/GMLPlug.pm (modified) (1 diff)

trunk/gsdl/perllib/colcfg.pm

@@ -13 +13 @@
 # {'beta'}->string
 # {'key'}->string
+# {'languages'}->array of strings
 # {'subcollection'}->hash of key-value pairs
 # {'indexsubcollections'}->array of strings
@@ -25 +26 @@
             '^(creator|public|beta|key|defaultindex|importdir|' .
                     'archivedir|cachedir|builddir|textindex|removeold)$',
-            '^(maintainer|indexsubcollections|indexes|plugins)$',
+            '^(maintainer|languages|indexsubcollections|indexes|plugins)$',
             '^(subcollection)$');
 }
@@ -35 +36 @@
             '^(creator|public|beta|key|defaultindex|importdir|' .
                     'archivedir|cachedir|builddir|textindex|removeold)$',
-            '^(maintainer|subcollection|indexsubcollections|indexes|plugins)$',
+            '^(maintainer|languages|indexsubcollections|indexes|plugins)$',
             '^(subcollection)$');
 }

trunk/gsdl/perllib/mgbuilder.pm

@@ -52 +52 @@
     }
 
+    # sort out language subindexes
+    if (defined $self->{'collect_cfg'}->{'languages'}) {
+    my $indexes = $self->{'collect_cfg'}->{'indexes'};
+    $self->{'collect_cfg'}->{'indexes'} = [];
+    foreach $language (@{$self->{'collect_cfg'}->{'languages'}}) {
+        foreach $index (@$indexes) {
+        push (@{$self->{'collect_cfg'}->{'indexes'}}, "$index:$language");
+        }
+    }
+    }
+
     # get the list of plugins for this collection
     my @plugins = (); # some good choice of plugins .... ????
@@ -187 +198 @@
     my %dirnames = ('text'=>'text',
             'extra'=>'extra');
-    
+    my %pnames = ('index' => '', 'subcollection' => '', 'languages' => '');
+
     foreach $index (@$indexes) {
-    my ($level, $fields, $subcollection) = split (":", $index);
-    my @fields = split (/,/, $fields);
-    splice (@fields, 2); # just want first two fields
-    
-    # the directory names starts with the first character of the index level
-    my ($dirname) = $level =~ /^(.)/;
-
-    # next comes a processed version of the first two fields in the index
-    # the processed version contains the first character and the next
-    # consonant
-    map {s/^(.).*?([bcdfghjklmnpqrstvwxyz]).*$/$1$2/i;} @fields;
-    $dirname .= join("", @fields);
+    my ($level, $gran, $subcollection, $languages) = split (":", $index);
+
+    # the directory name starts with the first character of the index level
+    my ($pindex) = $level =~ /^(.)/;
+
+    # next comes a processed version of the index
+    $pindex .= $self->process_field ($gran); 
+    $pindex = lc ($pindex);
 
     # 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, otherwise 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;
-        }
+    my $psub = $self->process_field ($subcollection);
+    $psub = lc ($psub);
+
+    # next comes a processed version of the language if there is one.
+    my $plang = $self->process_field ($languages);
+    $plang = lc ($plang);
+
+    my $dirname = $pindex . $psub . $plang;
+
+    # check to be sure all index names are unique
+    while (defined ($dirnames{$dirname})) {
+        $dirname = $self->make_unique (\%pnames, $index, \$pindex, \$psub, \$plang);
     }
 
-    # convert the directory name to lowercase
-    $dirname = lc ($dirname);
-
-    # add a number to make this directory name unique
-    if (defined $dirnames{$dirname}) {
-        my $num = 1;
-        while (defined $dirnames{"$dirname$num"}) {
-        $num++;
-        }
-        $dirname .= $num;
-    }
-    
+    $mapping{'indexmap'}{"$level:$gran"} = $pindex;
+    $mapping{'subcollectionmap'}{$subcollection} = $psub if $psub =~ /\w/;
+    $mapping{'languagemap'}{$languages} = $plang if $plang =~ /\w/;
     $mapping{$index} = $dirname;
     $dirnames{$dirname} = $index;
+    $pnames{'index'}{$pindex} = "$level:$gran";
+    $pnames{'subcollection'}{$psub} = $subcollection;
+    $pnames{'languages'}{$plang} = $languages;
     }
 
@@ -237 +238 @@
 }
 
+# returns a processed version of a field.
+# if the field has only one component the processed
+# version will contain the first character and next consonant
+# of that componant - otherwise it will contain the first 
+# character of the first two components 
+sub process_field {
+    my $self = shift (@_);
+    my ($field) = @_;
+ 
+    return "" unless (defined ($field) && $field =~ /\w/);
+
+    my @components = split /,/, $field;
+    if (scalar @components >= 2) {
+    splice (@components, 2);
+    map {s/^(.).*$/$1/;} @components;
+    return join("", @components);
+    } else {
+    my ($a, $b) = $field =~ /^(.).*?([bcdfghjklmnpqrstvwxyz])/i;
+    ($a, $b) = $field =~ /^(.)(.)/ unless defined $a && defined $b;
+    return "$a$b";
+    }
+}
+
+sub make_unique {
+    my $self = shift (@_);
+    my ($namehash, $index, $indexref, $subref, $langref) = @_;
+    my ($level, $gran, $subcollection, $languages) = split (":", $index);
+
+    if ($namehash->{'index'}->{$$indexref} ne "$level:$gran") {
+    $self->get_next_version ($indexref);
+    } elsif ($namehash->{'subcollection'}->{$$subref} ne $subcollection) {
+    $self->get_next_version ($subref);
+    } elsif ($namehash->{'languages'}->{$$langref} ne $languages) {
+    $self->get_next_version ($langref);
+    }
+    return "$$indexref$$subref$$langref";
+}   
+
+sub get_next_version {
+    my $self = shift (@_);
+    my ($nameref) = @_;
+
+    if ($$nameref =~ /(\d\d)$/) {
+    my $num = $1; $num ++;
+    $$nameref =~ s/\d\d$/$num/;
+    } elsif ($$nameref =~ /(\d)$/) {
+    my $num = $1;
+    if ($num == 9) {$$nameref =~ s/\d\d$/10/;}
+    else {$num ++; $$nameref =~ s/\d$/$num/;}
+    } else {
+    $$nameref =~ s/.$/0/;
+    }
+}
 
 sub build_index {
@@ -277 +331 @@
         push (@$indexexparr, $self->{'collect_cfg'}->{'subcollection'}->{$subcollection});
     } 
+    }
+    
+    # add expressions for languages if this index belongs to
+    # a language subcollection
+    foreach $language (@{$self->{'collect_cfg'}->{'languages'}}) {
+    if ($language =~ s/^\!//) {
+        push (@$indexexparr, "!Language/$language/");
+    } else {
+        push (@$indexexparr, "Language/$language/");
+    }
     }
     
@@ -407 +471 @@
     # store the mapping between the index names and the directory names
     my @indexmap = ();
-    foreach $index (@{$self->{'collect_cfg'}->{'indexes'}}) {
-    push (@indexmap, "$index\-\>$self->{'index_mapping'}->{$index}");
+    foreach $index (keys (%{$self->{'index_mapping'}->{'indexmap'}})) {
+    push (@indexmap, "$index\-\>$self->{'index_mapping'}->{'indexmap'}->{$index}");
     }
     $build_cfg->{'indexmap'} = \@indexmap;
+
+    my @subcollectionmap = ();
+    foreach $subcollection (keys (%{$self->{'index_mapping'}->{'subcollectionmap'}})) {
+    push (@subcollectionmap, "$subcollection\-\>$self->{'index_mapping'}->{'subcollectionmap'}->{$subcollection}");
+    }
+    $build_cfg->{'subcollectionmap'} = \@subcollectionmap if scalar (@subcollectionmap);
+
+    my @languagemap = ();
+    foreach $language (keys (%{$self->{'index_mapping'}->{'languagemap'}})) {
+    push (@languagemap, "$language\-\>$self->{'index_mapping'}->{'languagemap'}->{$language}");
+    }
+    $build_cfg->{'languagemap'} = \@languagemap if scalar (@languagemap);
 
     # write out the build information
     &cfgread::write_cfg_file("$self->{'build_dir'}/build.cfg", $build_cfg,
-                 '^(builddate|numdocs|numbytes)$', '^(indexmap)$');
+                 '^(builddate|numdocs|numbytes)$', '^(indexmap|subcollectionmap|languagemap)$');
 
 }

trunk/gsdl/perllib/mgbuildproc.pm

@@ -83 +83 @@
 sub process {
     my $self = shift (@_);
-    my ($doc_obj) = @_;
     my $method = $self->{'mode'};
 
-    $self->$method($doc_obj);
+    $self->$method(@_);
 }
 
 sub infodb {
     my $self = shift (@_);
-    my ($doc_obj) = @_;
+    my ($doc_obj, $filename) = @_;
     my $handle = $self->{'output_handle'};
 
@@ -142 +141 @@
     $mapped_section =~ s/\.+$//;
 
-    my ($parent, $classification, $creator, $OID);
+    my ($parent, $classification, $creator);
     
     $classification = $self->get_classifications($doc_obj, $section, $mapped_section)
@@ -157 +156 @@
     } else {
         $creator = $doc_obj->get_metadata_element($section, "Creator");
-        $OID = $doc_obj->get_OID();
-        # this is a hack at getting OID to look like the directory path - I'm sure there's 
-        # a better way to do it but it's late... Stefan
-        my @OIDchars = split //, $OID;
-        $OID = "";
-        my $count = 0;
-        foreach $i (@OIDchars) {
-        if ($count == 7) {
-            $OID .= "$i/";
-            $count = 0;
-        } else {
-            $OID .= $i;
-            $count ++;
-        }
-        }
-        $OID =~ s/\/$//;
-        $OID .= ".dir";
+
+        # need filename so we know what directory to look in for associated files
+        $filename =~ s/^\/?(.*?\.dir).*$/$1/ if (defined $filename);
     }
 
@@ -187 +172 @@
         } else {
         $self->write_to_gdbm($handle, $mapped_section, $title, $creator, $source, $date, $jobnumber, undef,
-                     $self->{'num_sections'}, $parent, $classification, $OID);
+                     $self->{'num_sections'}, $parent, $classification, $filename);
         }
     } else {
@@ -215 +200 @@
         $self->write_to_gdbm ($handle, $mapped_section, $title, $creator, $source,
                       $date, $jobnumber, $contains, $self->{'num_sections'},
-                      $parent, $classification, $OID);
+                      $parent, $classification, $filename);
 
         if ($doc_obj->get_text_length($section) > 0) {
@@ -222 +207 @@
             $self->write_to_gdbm ($handle, $intromapsection, "<i>(introductory text)</i>", $creator,
                       $source, $date, $jobnumber, undef, $self->{'num_sections'},
-                      $mapped_section, $classification, $OID);
+                      $mapped_section, $classification, $filename);
         }
         }

trunk/gsdl/perllib/plugins/GMLPlug.pm

@@ -124 +124 @@
 
     # process the document
-    $processor->process($doc_obj);
+    $processor->process($doc_obj, $file);
         
     return 1; # processed the file