Changeset 11122

Timestamp:

2006-01-27T00:21:47+13:00 (18 years ago)

Author:

davidb

Message:

Introduction of -associate_tail_re option to BasPlug. This is a generalisation
of the associate_ext (in fact associate_ext is now mapped into the equivalent
assoicate_tail_re expression). To work properly, plugins that use the
secondary plugin mechanism (such as PDFPlug) need to duplicate the
associate_tail_re value secondary plug ins too.

Location:

trunk/gsdl/perllib/plugins

Files:

• BasPlug.pm (modified) (12 diffs)
• PDFPlug.pm (modified) (2 diffs)
• WordPlug.pm (modified) (2 diffs)

trunk/gsdl/perllib/plugins/BasPlug.pm

@@ -105 +105 @@
     'type' => "string",
     'reqd' => "no" },
+      { 'name' => "associate_tail_re",
+    'desc' => "{BasPlug.associate_tail_re}",
+    'type' => "string",
+    'reqd' => "no" },
       { 'name' => "input_encoding",
     'desc' => "{BasPlug.input_encoding}",
@@ -413 +417 @@
     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) {
-        $associate_ext_lookup{$e} = 1;
-    }
-
-    $self->{'associate_ext_lookup'} = \%associate_ext_lookup;
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+        my $outhandle = $self->{'outhandle'};
+        print $outhandle "Warning: can only specify 'associate_ext' or 'associate_tail_re'\n";
+        print $outhandle "         defaulting to 'associate_tail_re'\n";
+    }
+    else {
+        my @exts = split(/,/,$associate_ext);
+
+        my @exts_bracketed = map { $_ = "(?:\\.$_)" } @exts;
+        my $associate_tail_re = join("|",@exts_bracketed);
+        $self->{'associate_tail_re'} = $associate_tail_re;
+    }
+
+    delete $self->{'associate_ext'};
     }
 
@@ -545 +557 @@
     return;
 }
-    
+
+sub root_ext_split
+{
+    my $self = shift (@_);
+    my ($filename,$tail_re) = @_;
+    
+    my ($file_prefix,$file_ext) = ($filename =~ m/^(.*?)($tail_re)$/);
+
+    if ((!defined $file_prefix) || (!defined $file_ext)) {
+    ($file_prefix,$file_ext) = ($filename =~ m/^(.*)(\..*?)$/);
+    }
+
+    return ($file_prefix,$file_ext);
+}
+
 sub metadata_read {
     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 -associate_ext
-
-    my $associate_ext = $self->{'associate_ext'};
-    if ((defined $associate_ext) && ($associate_ext ne "")) {
-
-    my ($file_prefix,$file_ext) = ($file =~ m/^(.*)\.(.*?)$/);
+    # Used to support -associate_ext and the more generalised
+    # -associate_tail_re
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+
+    my ($file_prefix,$file_ext) 
+        = $self->root_ext_split($file,$associate_tail_re);
+
     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' => {} };
+        my $file_prefix_rec = { 'tie_to'  => undef, 
+                        'exts'    => {} };
         $shared_fileroot->{$file_prefix} = $file_prefix_rec;
         }
@@ -568 +598 @@
         my $process_exp = $self->{'process_exp'};
 
-        if ($file =~ m/$self->{'process_exp'}/) {
+        if ($file =~ m/$process_exp/) {
         # This is the document the others should be tied to
         $file_prefix_rec->{'tie_to'} = $file_ext;
         }
         else {
-        if (defined $self->{'associate_ext_lookup'}->{$file_ext}) {
+        if ($file_ext =~ m/$associate_tail_re$/) {
             $file_prefix_rec->{'exts'}->{$file_ext} = 1;
         }
         }
-    }
-    }
-    
+
+    }
+    }
+
     # now check whether we are actually processing this
     my $filename = $file;
@@ -630 +661 @@
 
         my $has_file_ext = $exts->{$file_ext};
-        
+
         if ($has_file_ext) {
         return 1;
@@ -646 +677 @@
     my ($file, $filename, $metadata) = @_;
 
-    my $associate_ext = $self->{'associate_ext'};
-
-
-    return 0 if (!$associate_ext);
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    return 0 if (!$associate_tail_re);
 
     # If file, see if matches with "tie_to" doc or is one of the
     # associated filename extensions.
 
-    my ($file_prefix,$file_ext) = ($file =~ m/^(.*)\.(.*?)$/);
+    my ($file_prefix,$file_ext) = $self->root_ext_split($file,$associate_tail_re);
+
     if ((defined $file_prefix) && (defined $file_ext)) {
 
@@ -673 +703 @@
         my ($full_prefix) = ($filename =~ m/^(.*)\..*?$/);
         foreach my $e (keys %$exts) {       
-        my $assoc_file = "$full_prefix.$e";
+        my $assoc_file = "$full_prefix$e";
+        print STDERR "  $self->{'plugin_type'}: Associating $file_prefix$e with $file_prefix_rec->{'tie_to'} version\n";
         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
-        
+
+
+        # a form of smart block     
         return 1;
     }
@@ -724 +757 @@
     }
     }
+
     if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
     return (undef,undef); # can't recognise
@@ -812 +846 @@
     # include any metadata passed in from previous plugins 
     # note that this metadata is associated with the top level section
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
 
     $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
@@ -1156 +1192 @@
     my ($doc_obj, $cursection, $metadata) = @_;
 
+    my $associate_tail_re = $self->{'associate_tail_re'};
+
     foreach my $field (keys(%$metadata)) {
     # $metadata->{$field} may be an array reference
@@ -1173 +1211 @@
                   
         $doc_obj->associate_file($full_filename,$tail_filename,$mimetype);
-        
+
+        # work out extended tail extension (i.e. matching tail re)
+
+        my ($file_prefix,$file_extended_ext) 
+            = $self->root_ext_split($tail_filename,$associate_tail_re);
+        my ($pre_doc_ext) = ($file_extended_ext =~ m/^(.*)\..*$/);
+
         my ($doc_ext) = ($tail_filename =~ m/^.*\.(.*)$/);
         my $start_doclink = "<a href=\"_httpcollection_/index/assoc/{Or}{[parent(Top):archivedir],[archivedir]}/$tail_filename\">";
@@ -1179 +1223 @@
         my $end_doclink = "</a>";
 
-        $equiv_form .= " $start_doclink\{If\}{$srcicon,$srcicon,$doc_ext\}$end_doclink";        
+        my $assoc_form = "$start_doclink\{If\}{$srcicon,$srcicon,$doc_ext\}$end_doclink";
+
+        if (defined $pre_doc_ext) {
+            # for metadata such as [mp3._edited] [mp3._full] ...
+            $doc_obj->add_utf8_metadata ($cursection, "$doc_ext.$pre_doc_ext", $assoc_form); 
+        }
+
+        # for multiple metadata such as [mp3.assoclink]
+        $doc_obj->add_utf8_metadata ($cursection, "$doc_ext.assoclink", $assoc_form); 
+        
+        $equiv_form .= " $assoc_form";  
         }
         $doc_obj->add_utf8_metadata ($cursection, "equivlink", $equiv_form); 

trunk/gsdl/perllib/plugins/PDFPlug.pm

@@ -146 +146 @@
     my $html_options = $secondary_plugin_options->{'HTMLPlug'};
     my $text_options = $secondary_plugin_options->{'TEXTPlug'};
+    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'};
    
     if ($self->{'input_encoding'} eq "auto") {
@@ -179 +180 @@
     push(@$html_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
     push(@$text_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+    push(@$html_options, "-associate_tail_re", $associate_tail_re);
+    push(@$text_options, "-associate_tail_re", $associate_tail_re);
+    push(@$pagedimg_options, "-associate_tail_re", $associate_tail_re);
+    }
+
  
     $self = bless $self, $class;

trunk/gsdl/perllib/plugins/WordPlug.pm

@@ -152 +152 @@
     my $html_options = $secondary_plugin_options->{'HTMLPlug'};
     my $text_options = $secondary_plugin_options->{'TextPlug'};
-    
+    my $structhtml_options = $secondary_plugin_options->{'StructuredHTMLPlug'};    
     # wvWare will always produce html files encoded as utf-8, so make sure the secondary HTMLPlug knows this
     push(@$html_options,"-input_encoding", "utf8");
+
     if ($self->{'input_encoding'} eq "auto") {
     $self->{'input_encoding'} = "utf8";
@@ -167 +168 @@
     push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
     push(@$html_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+    push(@$html_options, "-associate_tail_re", $associate_tail_re);
+    push(@$text_options, "-associate_tail_re", $associate_tail_re);
+    push(@$structhtml_options, "-associate_tail_re", $associate_tail_re);
+    }
        
     $self = bless $self, $class;