Changeset 1279 for branches/New_Config_Format-branch/gsdl/perllib/plugins/GMLPlug.pm

Timestamp:

2000-07-13T10:21:53+12:00 (24 years ago)

Author:

sjboddie

Message:

merged changes to trunk into New_Config_Format branch

File:

• branches/New_Config_Format-branch/gsdl/perllib/plugins/GMLPlug.pm (modified) (7 diffs)

branches/New_Config_Format-branch/gsdl/perllib/plugins/GMLPlug.pm

@@ -37 +37 @@
 }
 
+use strict;
+
 sub new {
     my ($class) = @_;
-    $self = new BasPlug ();
+    my $self = new BasPlug ("GMLPlug", @_);
 
     return bless $self, $class;
 }
 
-
-sub is_recursive {
+sub get_default_process_exp {
     my $self = shift (@_);
 
-    return 0; # this is not a recursive plugin
-}
-
-sub _unescape_text {
-    my ($text) = @_;
-
-    # special characters in the gml encoding
-    $text =~ s/&lt;/</g;
-    $text =~ s/&gt;/>/g;
-    $text =~ s/&quot;/\"/g;
-    $text =~ s/&amp;/&/g; # this has to be last...
-
-    return $text;
+    return q^(?i)\.gml?$^;
 }
 
@@ -69 +58 @@
     my $self = shift (@_);
     my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
-    my $fullname = &util::filename_cat ($base_dir, $file);
 
-    # see if this is a gml book
-    return undef unless (-f $fullname && $fullname =~ /\.gml(\.gz)?$/io);
-
-    my ($parent_dir, $gz) = $fullname =~ /^(.*?)[\/\\][^\/\\]+.gml(\.gz)?$/io;
-
-    if (defined $gz && $gz =~ /\.gz/io) {
-    $gz = 1;
-    } else {
-    $gz = 0;
+    my $filename = &util::filename_cat($base_dir, $file);
+    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
+    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
+    return undef;
     }
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
 
     print STDERR "GMLPlug: processing $file\n";
 
-    # read in the document
-    if ($gz) {
-    if (!open (INFILE, "zcat $fullname |")) {
-        print STDERR "GMLPlug::read - zcat couldn't read $fullname\n";
-        return undef;
-    }
-    } else {
-    if (!open (INFILE, $fullname)) {
-        print STDERR "GMLPlug::read - couldn't read $fullname\n";
-        return undef;
-    }
+    my $parent_dir = $file;
+    $parent_dir =~ s/[^\\\/]*$//;
+    $parent_dir = &util::filename_cat ($base_dir, $parent_dir);
+
+    if (!open (INFILE, $filename)) {
+    print STDERR "GMLPlug::read - couldn't read $filename\n";
+    return 0;
     }
 
@@ -106 +86 @@
 
     my $no_docs = 0;
-#    my $src_filename = ""; #### don't appear to use this anymore - not sure if that's right
 
     while (1) {
@@ -128 +107 @@
 
         } else {
-            print STDERR "GMLPlug::read - error in file $fullname\n";
+            print STDERR "GMLPlug::read - error in file $filename\n";
             print STDERR "text: \"$gml\"\n";
             last;
@@ -166 +145 @@
         last if $section eq ""; # back to top level again (more than one document in gml file)
         $section = $doc_obj->get_parent_section ($section);
-    } #while (1) section level
+    } # while (1) section level
 
     # add the associated files
-    $assoc_files = $doc_obj->get_metadata($doc_obj->get_top_section(), "gsdlassocfile");
+    my $assoc_files = $doc_obj->get_metadata($doc_obj->get_top_section(), "gsdlassocfile");
     my ($assoc_file_info, $afile);
     foreach $assoc_file_info (@$assoc_files) {
@@ -186 +165 @@
     $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
     
-    # assume the document has an OID
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # assume the document has an OID already
     
     # process the document
@@ -194 +176 @@
     last if ($maxdocs > -1 && $no_docs >= $maxdocs);
     last unless defined $gml && $gml =~ /\w/;
-    } #while(1) document level
+    } # while(1) document level
 
     return $no_docs; # no of docs processed
 }
 
+sub _unescape_text {
+    my ($text) = @_;
+
+    # special characters in the gml encoding
+    $text =~ s/&lt;/</g;
+    $text =~ s/&gt;/>/g;
+    $text =~ s/&quot;/\"/g;
+    $text =~ s/&amp;/&/g; # this has to be last...
+
+    return $text;
+}
 
 1;