Changeset 900

Timestamp:

2000-02-03T10:06:40+13:00 (24 years ago)

Author:

sjboddie

Message:

tweaked the way associated files are handled at build time - some
individual plugins may still need catching up.

Location:

trunk/gsdl/perllib

Files:

• mgbuildproc.pm (modified) (8 diffs)
• plugins/GMLPlug.pm (modified) (1 diff)
• plugins/HBPlug.pm (modified) (1 diff)
• plugins/HTMLPlug.pm (modified) (3 diffs)

trunk/gsdl/perllib/mgbuildproc.pm

@@ -34 +34 @@
 use docproc;
 use util;
-
 
 BEGIN {
@@ -187 +186 @@
 sub assoc_files {
     my $self = shift (@_);
-    my ($doc_obj) = @_;
+    my ($doc_obj, $archivedir) = @_;
+    my ($afile);
     
-    foreach $assoc_file (@{$doc_obj->get_assoc_files()}) {
-    $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]);
+    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);
     }
@@ -201 +207 @@
 #    $handle = "main::STDOUT";
 
-    $self->assoc_files ($doc_obj);
-
     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
@@ -239 +251 @@
     # output all the section metadata
     my $metadata = $doc_obj->get_all_metadata ($section);
-    foreach $pair (@$metadata) {
+    foreach my $pair (@$metadata) {
         my ($field, $value) = (@$pair);
 
@@ -266 +278 @@
     # output archivedir if at top level
     if ($section eq $doc_obj->get_top_section()) {
-        my ($archivedir) = $filename =~ /^(.*?)(?:\/|\\)[^\/\\]*$/;
-        $archivedir = "" unless defined $archivedir;
-        $archivedir =~ s/\\/\//g;
-        $archivedir =~ s/^\/+//;
-        $archivedir =~ s/\/+$//;
         print $handle "<archivedir>$archivedir\n";
     }
@@ -285 +292 @@
         print $handle "<contains>";
         my $firstchild = 1;
-        foreach $child (@$children) {
+        foreach my $child (@$children) {
         print $handle ";" unless $firstchild;
         $firstchild = 0;
@@ -348 +355 @@
 
     # see if this document belongs to this subcollection
-    foreach $indexexp (@{$self->{'indexexparr'}}) {
+    foreach my $indexexp (@{$self->{'indexexparr'}}) {
     $indexed_doc = 0;
     my ($field, $exp, $options) = split /\//, $indexexp;
@@ -397 +404 @@
     if ($indexed_doc) {
         $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
-        foreach $field (split (/,/, $fields)) {
+        foreach my $field (split (/,/, $fields)) {
         # only deal with this field if it doesn't start with top or
         # this is the first section

trunk/gsdl/perllib/plugins/GMLPlug.pm

@@ -171 +171 @@
     # add the associated files
     $assoc_files = $doc_obj->get_metadata($doc_obj->get_top_section(), "gsdlassocfile");
-    my ($assoc_file_info);
+    my ($assoc_file_info, $afile);
     foreach $assoc_file_info (@$assoc_files) {
         my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info);
-        $dir = "" unless defined $dir;
+        if (defined $dir && $dir =~ /\w/) {
+        $afile = &util::filename_cat($dir, $assoc_file);
+        } else {
+        $afile = $assoc_file;
+        }
         $doc_obj->associate_file(&util::filename_cat($parent_dir, $assoc_file),
-                     &util::filename_cat($dir, $assoc_file), $mime_type);
+                     $afile, $mime_type);
     }
     $doc_obj->delete_metadata($doc_obj->get_top_section(), "gsdlassocfile");

trunk/gsdl/perllib/plugins/HBPlug.pm

@@ -141 +141 @@
     # fix up the image links
     $section =~ s/<img[^>]*?src=\"?([^\">]+)\"?[^>]*>/
-    <center><img src=\"_httpcollection_\/archives\/_thisOID_\/$1\"><\/center><br>/ig;
+    <center><img src=\"_httpcollimg_\/_thisOID_\/$1\"><\/center><br>/ig;
     $section =~ s/&lt;&lt;I&gt;&gt;\s*([^\.]+\.(png|jpg|gif))/
-    <center><img src=\"_httpcollection_\/archives\/_thisOID_\/$1\"><\/center><br>/ig;
+    <center><img src=\"_httpcollimg_\/_thisOID_\/$1\"><\/center><br>/ig;
 
     return $section;

trunk/gsdl/perllib/plugins/HTMLPlug.pm

@@ -71 +71 @@
     print STDERR "   -w3mir                 Set if w3mir was used to generate input file structure.\n";
     print STDERR "                          w3mir \n";
+    print STDERR "   -rename_assoc_files    Renames files associated with documents (e.g. images). Also\n";
+    print STDERR "                          creates much shallower directory structure (useful when creating\n";
+    print STDERR "                          collections to go on cd-rom).\n\n";
 }
 
@@ -84 +87 @@
              q^no_metadata^, \$self->{'no_metadata'},
              q^metadata_fields/.*/Title^, \$self->{'metadata_fields'},
-             q^w3mir^, \$self->{'w3mir'})) {
+             q^w3mir^, \$self->{'w3mir'},
+             q^rename_assoc_files^, \$self->{'rename_assoc_files'})) {
     &print_usage();
     die "\n";
@@ -243 +247 @@
     $filename = &util::filename_cat ($base_dir, $filename);
     my ($ext) = $filename =~ /(\.[^\.]*)$/;
-    if (defined $self->{'aux_files'}->{$href}) {
-    $newname = $self->{'aux_files'}->{$href}->{'dir_num'} . "/" .
-        $self->{'aux_files'}->{$href}->{'file_num'} . $ext;
+    if ($self->{'rename_assoc_files'}) {
+    if (defined $self->{'aux_files'}->{$href}) {
+        $newname = $self->{'aux_files'}->{$href}->{'dir_num'} . "/" .
+        $self->{'aux_files'}->{$href}->{'file_num'} . $ext;
+    } else {
+        $newname = $self->{'dir_num'} . "/" . $self->{'file_num'} . $ext;
+        $self->inc_filecount ();
+    }
+    $doc_obj->associate_file($filename, $newname, undef, $section);
+    return "_httpcollimg_/$newname";
+
     } else {
-    $newname = $self->{'dir_num'} . "/" . $self->{'file_num'} . $ext;
-    $self->inc_filecount ();
-    }
-    $doc_obj->associate_file($filename, $newname, undef, $section);
-    return "_httpcollimg_/$newname";
+    ($newname) = $filename =~ /([^\/\\]*)$/;
+    $doc_obj->associate_file($filename, $newname, undef, $section);
+    return "_httpcollimg_/_thisOID_/$newname";
+    }
 }