Changeset 13172 for trunk/gsdl/perllib/plugouts/BasPlugout.pm

Timestamp:

2006-10-27T13:41:01+13:00 (18 years ago)

Author:

kjdon

Message:

Moved all printing stuff out of doc.pm.
docprint now prints a GA representation of a doc obj - use &docprint::get_section_xml instead of $doc_obj->buffer_section_xml or $doc_obj->output_section.
Most of the code has been moved into plugouts, except for the bit thats gone to docprint.pm.

File:

• trunk/gsdl/perllib/plugouts/BasPlugout.pm (modified) (5 diffs)

trunk/gsdl/perllib/plugouts/BasPlugout.pm

@@ -41 +41 @@
 
 my $arguments = [ 
-      { 'name' => "group_size", 
+       { 'name' => "group_size", 
     'desc' => "{BasPlugout.group_size}",
     'type' => "int",
@@ -73 +73 @@
     'type' => "flag",
     'reqd' => "no",  
-        'hiddengli' => "no"}                    
+        'hiddengli' => "no"},
+       { 'name' => "debug",
+     'desc' => "{BasPlugout.debug}",
+     'type' => "flag",
+     'reqd' => "no",
+     'hiddengli' => "yes"}
 ];
 
@@ -483 +488 @@
     # copy all the associated files, add this information as metadata
     # to the document
-        print STDERR "Writing associated files to $doc_dir\n";
+        print $outhandle "Writing associated files to $doc_dir\n";
     $self->process_assoc_files ($doc_obj, $doc_dir);
     }
 
     # save this document
-    $doc_obj->output_section('BasPlugout::GROUPPROCESS', $doc_obj->get_top_section());
+    my $section_text = &docprint::get_section_xml($doc_obj,$doc_obj->get_top_section());
+    print GROUPPROCESS $section_text;
 
     $self->{'gs_count'}++;
@@ -717 +723 @@
 }
 
+
 #the subclass should implement this method if is_group method could return 1.
 sub close_group_output{
@@ -727 +734 @@
 }
 
+my $dc_set = { Title => 1,       
+           Creator => 1, 
+           Subject => 1, 
+           Description => 1, 
+           Publisher => 1, 
+           Contributor => 1, 
+           Date => 1, 
+           Type => 1, 
+           Format => 1, 
+           Identifier => 1, 
+           Source => 1, 
+           Language => 1, 
+           Relation => 1, 
+           Coverage => 1, 
+           Rights => 1};
+
+
+# returns an XML representation of the dublin core metadata
+# if dc meta is not found, try ex mete
+sub get_dc_metadata {
+    my $self = shift(@_);
+    my ($doc_obj, $section, $version) = @_;
+    
+    # build up string of dublin core metadata
+    $section="" unless defined $section;
+    
+    my $section_ptr = $doc_obj->_lookup_section($section);
+    return "" unless defined $section_ptr;
+
+
+    my $explicit_dc = {};
+    my $explicit_ex = {};
+
+    my $all_text="";
+    foreach my $data (@{$section_ptr->{'metadata'}}){
+    my $escaped_value = &docprint::escape_text($data->[1]);
+    if ($data->[0]=~ m/^dc\./) {
+        $data->[0] =~ tr/[A-Z]/[a-z]/;
+
+        $data->[0] =~ m/^dc\.(.*)/;
+        my $dc_element =  $1;
+
+        if (!defined $explicit_dc->{$dc_element}) {
+        $explicit_dc->{$dc_element} = [];
+        }
+        push(@{$explicit_dc->{$dc_element}},$escaped_value);
+
+        if (defined $version && ($version eq "oai_dc")) {
+        $all_text .= "   <dc:$dc_element>$escaped_value</dc:$dc_element>\n";
+        }
+        else {
+        # qualifier???
+        $all_text .= '   <dcvalue element="'. $dc_element.'">'. $escaped_value. "</dcvalue>\n";
+        }
+
+    } 
+    elsif (($data->[0] =~ m/^ex\./) || ($data->[0] !~ m/\./)) {
+        $data->[0] =~ m/^(ex\.)?(.*)/;
+        my $ex_element =  $2;
+        my $lc_ex_element = lc($ex_element);
+
+        if (defined $dc_set->{$ex_element}) {
+        if (!defined $explicit_ex->{$lc_ex_element}) {
+            $explicit_ex->{$lc_ex_element} = [];
+        }
+        push(@{$explicit_ex->{$lc_ex_element}},$escaped_value);
+        }
+    }
+    }
+
+    # go through dc_set and for any element *not* defined in explicit_dc
+    # that do exist in explicit_ex, add it in as metadata
+    foreach my $k ( keys %$dc_set ) {
+    my $lc_k = lc($k);
+
+    if (!defined $explicit_dc->{$lc_k}) {
+        if (defined $explicit_ex->{$lc_k}) {
+
+        foreach my $v (@{$explicit_ex->{$lc_k}}) {
+            my $dc_element    = $lc_k;
+            my $escaped_value = $v;
+
+            if (defined $version && ($version eq "oai_dc")) {
+            $all_text .= "   <dc:$dc_element>$escaped_value</dc:$dc_element>\n";
+            }
+            else {
+            $all_text .= '   <dcvalue element="'. $dc_element.'">'. $escaped_value. "</dcvalue>\n";
+            }
+            
+        }
+        }
+    }
+    }
+
+    if ($all_text eq "") {
+    $all_text .= "   There is no Dublin Core metatdata in this document\n";
+    }   
+    $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
+
+    return $all_text;
+}
+
+# Build up dublin_core metadata.  Priority given to dc.* over ex.*
+# This method was apparently added by Jeffrey and committed by Shaoqun.
+# But we don't know why it was added, so not using it anymore.
+sub new_get_dc_metadata {
+    
+    my $self = shift(@_);
+    my ($doc_obj, $section, $version) = @_;
+
+    # build up string of dublin core metadata
+    $section="" unless defined $section;
+    
+    my $section_ptr=$doc_obj->_lookup_section($section);
+    return "" unless defined $section_ptr;
+
+    my $all_text = "";
+    foreach my $data (@{$section_ptr->{'metadata'}}){
+    my $escaped_value = &docprint::escape_text($data->[1]);
+    my $dc_element =  $data->[0];
+    
+    my @array = split('\.',$dc_element);
+    my ($type,$name);
+
+    if(defined $array[1])
+    {
+        $type = $array[0];
+        $name = $array[1];
+    }
+    else
+    {
+        $type = "ex";
+        $name = $array[0];
+    }
+    
+    $all_text .= '   <Metadata Type="'. $type.'" Name="'.$name.'">'. $escaped_value. "</Metadata>\n";
+    }
+    return $all_text;
+}
+
+
 1;