Changeset 8892

Timestamp:

2005-01-12T13:45:04+13:00 (19 years ago)

Author:

davidb

Message:

Addition of new minus option to BasPlug: -associate_ext.

This new option allows a collectoin designer to cause files
with the same file root but different extension to be handled
as one document. A comma separated list is given of filename
extensions that should be associated with the primary version
(i.e. the file that is being processed by the Plugin that carries
this option).

File:

• trunk/gsdl/perllib/plugins/BasPlug.pm (modified) (7 diffs)

trunk/gsdl/perllib/plugins/BasPlug.pm

@@ -32 +32 @@
 $SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
 
+use File::Basename;
+
 use Kea;
 use parsargv;
@@ -67 +69 @@
     'type' => "regexp",
     'deft' => "",
+    'reqd' => "no" },
+      { 'name' => "associate_ext",
+    'desc' => "{BasPlug.associate_ext}",
+    'type' => "string",
     'reqd' => "no" },
       { 'name' => "input_encoding",
@@ -315 +321 @@
              q^process_exp/.*/^, \$self->{'process_exp'},
              q^block_exp/.*/^, \$self->{'block_exp'},
+             q^associate_ext/.*/^, \$self->{'associate_ext'},
              q^extract_language^, \$self->{'extract_language'},
              q^extract_acronyms^, \$self->{'extract_acronyms'}, 
@@ -338 +345 @@
     die "\n";
     }
+
+    my $associate_ext = $self->{'associate_ext'};
+    if ((defined $associate_ext) && ($associate_ext ne "")) {
+    my @exts = split(/,/,$associate_ext);
+    
+    my %associate_ext_lookup = ();
+    foreach my $e (@exts) {
+        $assoicate_ext_lookup{$e} = 1;
+    }
+
+    $self->{'associate_ext_lookup'} = \%associate_ext_lookup;
+    }
+
+    $self->{'shared_fileroot'} = {};
     $self->{'file_blocks'} = {};
 
@@ -409 +430 @@
     my $self = shift (@_);  
     my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+
+    # Keep track of filenames with same root but different extensions
+    # Used to support -assoicate_ext
+
+    my $associate_ext = $self->{'associate_ext'};
+    if ((defined $associate_ext) && ($associate_ext ne "")) {
+
+    my ($file_prefix,$file_ext) = ($file =~ m/^(.*)\.(.*?)$/);
+    if ((defined $file_prefix) && (defined $file_ext)) {
+        
+        my $shared_fileroot = $self->{'shared_fileroot'};
+        if (!defined $shared_fileroot->{$file_prefix}) {
+        my $file_prefix_rec = { 'tie_to' => undef, 'exts' => {} };
+        $shared_fileroot->{$file_prefix} = $file_prefix_rec;
+        }
+        
+        my $file_prefix_rec = $shared_fileroot->{$file_prefix};
+
+        my $process_exp = $self->{'process_exp'};
+
+        if ($file =~ m/$self->{'process_exp'}/) {
+        # This is the document the others should be tied to
+        $file_prefix_rec->{'tie_to'} = $file_ext;
+        }
+        else {
+        $file_prefix_rec->{'exts'}->{$file_ext} = 1;
+        }
+    }
+    }
+
     return undef;
 }
+
+sub tie_to_filename
+{
+    my $self = shift (@_);  
+  
+    my ($file_ext,$file_prefix_rec) = @_;
+
+    if (defined $file_prefix_rec) {
+    my $tie_to = $file_prefix_rec->{'tie_to'};
+    if (defined $tie_to) {
+        if ($tie_to eq $file_ext) {
+        return 1;
+        }
+    }
+    }
+
+    return 0;
+}
+
+sub tie_to_assoc_file
+{
+    my $self = shift (@_);    
+    my ($file_ext,$file_prefix_rec) = @_;
+
+    if (defined $file_prefix_rec) {
+    my $tie_to = $file_prefix_rec->{'tie_to'};
+    if (defined $tie_to) {
+
+        my $exts = $file_prefix_rec->{'exts'};
+
+        my $has_file_ext = $exts->{$file_ext};
+        
+        if ($has_file_ext) {
+        return 1;
+        }
+    }
+    }
+
+    return 0;
+}
+
+
+sub associate_with
+{
+    my $self = shift (@_);    
+    my ($file, $filename, $metadata) = @_;
+
+    my $associate_ext = $self->{'associate_ext'};
+
+    return 0 if (!$associate_ext);
+
+    # If file, see if matches with "tie_to" doc or is one of the
+    # associated filename extensions.
+
+    my ($file_prefix,$file_ext) = ($file =~ m/^(.*)\.(.*?)$/);
+    if ((defined $file_prefix) && (defined $file_ext)) {
+
+    my $file_prefix_rec = $self->{'shared_fileroot'}->{$file_prefix};
+
+    if ($self->tie_to_filename($file_ext,$file_prefix_rec)) {
+
+        # Set up gsdlassocfile_tobe
+
+        my $exts = $file_prefix_rec->{'exts'};
+        
+        if (!defined $metadata->{'gsdlassocfile_tobe'}) {
+        $metadata->{'gsdlassocfile_tobe'} = [];
+        }
+
+        my $assoc_tobe = $metadata->{'gsdlassocfile_tobe'};
+            
+        my ($full_prefix) = ($filename =~ m/^(.*)\..*?$/);
+        foreach my $e (keys %$exts) {       
+        my $assoc_file = "$full_prefix.$e";
+        my $mime_type = ""; # let system auto detect this
+        push(@$assoc_tobe,"$assoc_file:$mime_type:"); 
+        }
+    }
+    elsif ($self->tie_to_assoc_file($file_ext,$file_prefix_rec)) {
+        # a form of smart block
+        
+        return 1;
+    }
+    }
+
+    return 0;
+}
+
 
 # The BasPlug read() function. This function does all the right things
@@ -442 +581 @@
     $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
 
-
-    if ($smart_block){
+    if ($self->associate_with($file,$filename,$metadata)) {
+    # a form of smart block
+    $self->{'num_blocked'} ++;
+    return 0; # blocked
+    }
+
+    if ($smart_block) {
     if (defined $self->{'file_blocks'}->{$filename} && $self->{'file_blocks'}->{$filename} == 1){
+        $self->{'num_blocked'} ++;
         return 0; # blocked
     }
@@ -769 +914 @@
         my $equiv_form = "";
         foreach my $gaf (@{$metadata->{$field}}) {
-        #print STDERR "**** gsdlassocfile_tobe = $gaf\n";
         my ($full_filename,$mimetype) = ($gaf =~ m/^(.*):(.*):$/);
         my ($tail_filename) = ($full_filename =~ /^.*[\/\\](.+?)$/);