Changeset 2267

Timestamp:

2001-04-03T14:33:03+12:00 (23 years ago)

Author:

davidb

Message:

GML file syntax altered to be XML compliant. This basically meant
turning attribute lists of metadata names (which in Greenstone can
appear multiple times within a tag) into tag names themselves, which
are then explicitly stated in a <metadata>...</metadata> block.

Newly built collection will use the new syntactic form, however the
GMLPlug file is backwards compatible and so will still import in
files in the older GML format.

Location:

trunk/gsdl/perllib

Files:

• doc.pm (modified) (6 diffs)
• docprint.pm (modified) (1 diff)
• docsave.pm (modified) (3 diffs)
• plugins/GMLPlug.pm (modified) (3 diffs)

trunk/gsdl/perllib/doc.pm

@@ -143 +143 @@
 
 
-sub buffer_section {
+sub buffer_section_gml {
     my $self = shift (@_);
     my ($section, $suppress_subject_info) = @_;
@@ -171 +171 @@
     # output all the subsections
     foreach $subsection (@{$section_ptr->{'subsection_order'}}) {
-    $all_text .= $self->buffer_section("$section.$subsection", $suppress_subject_info);
+    $all_text .= $self->buffer_section_gml("$section.$subsection", 
+                           $suppress_subject_info);
     }
     
@@ -180 +181 @@
 }
 
+
+sub buffer_section_xml {
+    my $self = shift (@_);
+    my ($section, $dtd_metadata, $suppress_subject_info) = @_;
+
+    $suppress_subject_info = 0 unless defined $suppress_subject_info;
+    my ($all_text, $data, $subsection);
+    
+    my $section_ptr = $self->_lookup_section ($section);
+    my ($section_num) = $section =~ /(\d+)$/;
+    
+    return "" unless defined $section_ptr;
+
+    # output the section header (including the section number
+    # and metadata)
+
+    $all_text .= "<gsdlsection";
+    $all_text .= " gsdlnum=\"$section_num\"" if defined $section_num;
+    $all_text .= ">\n";
+    
+    $all_text .= "  <metadata>\n";
+    
+    # output metadata
+    foreach $data (@{$section_ptr->{'metadata'}}) {
+    my $tag_name = $data->[0];
+    my $tag_value = &_escape_text($data->[1]);
+
+    unless ($suppress_subject_info && $tag_name eq "Subject")
+    {
+        if (defined $dtd_metadata)
+        {
+        $dtd_metadata->{$tag_name}++;
+        }
+
+        $all_text .= "    <$tag_name>$tag_value</$tag_name>\n";
+    }
+    }
+
+    $all_text .= "  </metadata>\n";
+
+    # output the text
+    $all_text .= &_escape_text($section_ptr->{'text'});
+
+    # output all the subsections
+    foreach $subsection (@{$section_ptr->{'subsection_order'}}) {
+    $all_text .= $self->buffer_section_xml("$section.$subsection", 
+                           $dtd_metadata,
+                           $suppress_subject_info);
+    }
+    
+    # output the closing tag
+    $all_text .=  "</gsdlsection>\n";
+
+    return $all_text;
+}
+
 sub output_section {
     my $self = shift (@_);
-    my ($handle, $section, $suppress_subject_info) = @_;
-
-    my $all_text = $self->buffer_section($section, $suppress_subject_info);
+    my ($handle, $section, $colname, $dtd_metadata, 
+    $suppress_subject_info) = @_;
+
+    my $all_text = $self->buffer_section_xml($section, $dtd_metadata, 
+                         $suppress_subject_info);
+
+    # xml header    
+    if (defined $collection)
+    {
+    my $xml_head
+        = '<? xml version="1.0" standalone="no" encoding="UTF-8" ?>';
+    $xml_head .= "\n<!DOCTYPE gsdl:$colname SYSTEM \"$colname.dtd\">\n";
+    $all_text = $xml_head.$all_text;
+    }
+
     print $handle $all_text;
 }
@@ -262 +331 @@
         print STDERR "doc::set_OID could not write to $filename\n";
         } else {
-        $self->output_section('OUTFILE', $self->get_top_section(), 1);
+        $self->output_section('OUTFILE', $self->get_top_section(), 
+                      undef, 1);
         close (OUTFILE);
         }
@@ -283 +353 @@
     if (!defined $OID) 
     {
-    my $hash_text = $self->buffer_section($self->get_top_section(), 1);
+    my $hash_text = $self->buffer_section_gml($self->get_top_section(),
+                          undef, 1);
     my $hash_len = length($hash_text);
 
@@ -493 +564 @@
     my $section = $mastersection;
     my $sectionref = $self;
-
-####    print STDERR "*** mastersection = $mastersection\n";
 
     while ($section ne "") {

trunk/gsdl/perllib/docprint.pm

@@ -60 +60 @@
     
     # output document
-    $doc_obj->output_section(STDOUT, $doc_obj->get_top_section());
+    $doc_obj->output_section(STDOUT, $doc_obj->get_top_section(),
+                 undef, undef, 0);
 }
 

trunk/gsdl/perllib/docsave.pm

@@ -53 +53 @@
     $self->{'groupsize'} = $groupsize;
     $self->{'gs_count'} = 0;
-    
+
+    # keep an associate array of all metavalues used by collection to
+    # help generate the XML DTD 
+    $self->{'dtd_metadata'} = {}; 
+
     $self->{'outhandle'} = STDERR;
     $self->{'outhandle'} = $outhandle if defined $outhandle;
-    
     # set a default for the archive directory
     $self->{'archive_dir'} = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "archives");
@@ -113 +116 @@
 
     # save this document
-    $doc_obj->output_section('docsave::OUTDOC', $doc_obj->get_top_section());
+    $doc_obj->output_section('docsave::OUTDOC', 
+                 $doc_obj->get_top_section(),
+                 $self->{'collection'},
+                 $self->{'dtd_metadata'},0);
+
     close OUTDOC;
 
@@ -184 +191 @@
 
     # save this document
-    $doc_obj->output_section('docsave::OUTDOC', $doc_obj->get_top_section());
+    $doc_obj->output_section('docsave::OUTDOC', 
+                 $doc_obj->get_top_section(),
+                 $self->{'collection'},
+                 $self->{'dtd_metadata'},0);
 
     $self->{'gs_count'}++;

trunk/gsdl/perllib/plugins/GMLPlug.pm

@@ -96 +96 @@
 
         my @indenting_sections = split("<gsdlsection", $gml);
-        shift(@indenting_sections); # first entry is trivially empty
+        shift(@indenting_sections); # skips over xml header if present
 
         foreach $gml (@indenting_sections) {
@@ -127 +127 @@
         }
         
-        # add the tags
+        # add the metadata
+        # could be stored as either attributes or ....
         while ((defined $tags) && ($tags =~ s/^\s*(\S+)=\"([^\"]*)\"//o)) {
             $doc_obj->add_utf8_metadata($section, $1, &GMLPlug::_unescape_text($2)) 
@@ -134 +135 @@
         }
         
+        # ... or tags (xml compliant)
+        if ($text =~ m/^\s*<metadata>/)
+        {
+            my $metadata;
+            ($metadata,$text) 
+            = ($text =~ m/\s*<metadata>\s*(<.*)\s*<\/metadata>(.*)$/s);
+            while ((defined $metadata) 
+               && ($metadata =~ s/<(.*?)>(.*?)<\/.*?>//s))
+            {
+            $doc_obj->add_utf8_metadata($section, $1, &GMLPlug::_unescape_text($2)) 
+                if (defined $1 and defined $2);
+            }
+        }
+
         # add the text
+
         $doc_obj->add_utf8_text($section, $text) 
             if ((defined $text) && ($text ne ""));