Index: /gsdl/trunk/perllib/plugins/BasePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/BasePlugin.pm	(revision 16389)
+++ /gsdl/trunk/perllib/plugins/BasePlugin.pm	(revision 16390)
@@ -76,12 +76,12 @@
 	'deft' => "",
 	'reqd' => "no" },
+      { 'name' => "no_blocking",
+	'desc' => "{BasePlugin.no_blocking}",
+	'type' => "flag",
+	'reqd' => "no"},
       { 'name' => "block_exp",
 	'desc' => "{BasePlugin.block_exp}",
 	'type' => "regexp",
 	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "smart_block",
-	'desc' => "{BasePlugin.smart_block}",
-	'type' => "flag",
 	'reqd' => "no" },
       { 'name' => "associate_ext",
@@ -107,5 +107,11 @@
 	'deft' => "auto",
 	'list' => $encoding_plus_auto_list,
-	'reqd' => "no" }
+	'reqd' => "no" },
+      { 'name' => "smart_block",
+        'desc' => "{BasePlugin.smart_block}",
+        'type' => "flag",
+        'reqd' => "no",
+	'hiddengli' => "yes" } # deprecated, but leave in for old collections
+
       
       ];
@@ -129,4 +135,14 @@
 
     my $self = new PrintInfo($pluginlist, $inputargs, $hashArgOptLists);
+    
+    if ($self->{'info_only'}) {
+        # don't worry about any options etc
+        return bless $self, $class;
+    }
+
+    if ($self->{'smart_block'}) {
+	print STDERR "WARNING: -smart_block option has been deprecated and is no longer useful\n";
+    }
+    $self->{'smart_block'} = undef;
 
     my $plugin_name = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
@@ -161,8 +177,4 @@
     }
 
-    $self->{'shared_fileroot'} = {};
-    $self->{'file_blocks'} = {};
-
-
     return bless $self, $class;
 
@@ -181,5 +193,6 @@
     $self->{'outhandle'} = $outhandle if defined $outhandle;
     $self->{'failhandle'} = $failhandle;
-
+#    $self->SUPER::init(@_);
+    
     # set process_exp and block_exp to defaults unless they were
     # explicitly set
@@ -245,10 +258,22 @@
 }
 
-# default implementation is to do nothing. 
-sub store_block_files
-{
+# default implementation is to do nothing
+sub store_block_files {
+    
     my $self =shift (@_);
-    my ($filename) = @_;
-    return;
+    my ($filename_full_path, $block_hash) = @_;
+
+}
+
+# put files to block into hash 
+sub use_block_expressions {
+
+    my $self =shift (@_);
+    my ($filename_full_path, $block_hash) = @_;
+
+    if ($self->{'block_exp'} ne "" && $filename_full_path =~ /$self->{'block_exp'}/) {
+	$block_hash->{'file_blocks'}->{$filename_full_path} = 1;
+    }
+
 }
 
@@ -257,5 +282,5 @@
 {
     my $self =shift;
-    my $filename = shift;
+    my ($filename, $block_hash) = @_;
 
     if ($self->{'cover_image'}) {
@@ -266,5 +291,5 @@
 	} 	
 	if (-e $coverfile) {
-	    $self->{'file_blocks'}->{$coverfile} = 1;
+	    $block_hash->{'file_blocks'}->{$coverfile} = 1;
 	} 
     }
@@ -273,34 +298,24 @@
 }
 
-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 {
+
+# discover all the files that should be blocked by this plugin
+# check the args ...
+sub file_block_read {
+
     my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+    my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $gli) = @_;
     # Keep track of filenames with same root but different extensions
     # Used to support -associate_ext and the more generalised
     # -associate_tail_re
+    my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file);
 
     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);
-
+	    = &util::get_prefix_and_tail_by_regex($filename_full_path,$associate_tail_re);
+	
 	if ((defined $file_prefix) && (defined $file_ext)) {
-
-	    my $shared_fileroot = $self->{'shared_fileroot'};
+	    my $shared_fileroot = $block_hash->{'shared_fileroot'};
 	    if (!defined $shared_fileroot->{$file_prefix}) {
 		my $file_prefix_rec = { 'tie_to'  => undef, 
@@ -311,7 +326,5 @@
 	    my $file_prefix_rec = $shared_fileroot->{$file_prefix};
 
-	    my $process_exp = $self->{'process_exp'};
-
-	    if ($file =~ m/$process_exp/) {
+	    if ($self->can_process_this_file($filename_full_path)) {
 		# This is the document the others should be tied to
 		$file_prefix_rec->{'tie_to'} = $file_ext;
@@ -319,4 +332,5 @@
 	    else {
 		if ($file_ext =~ m/$associate_tail_re$/) {
+		    # this file should be associated to the main one
 		    $file_prefix_rec->{'exts'}->{$file_ext} = 1;
 		}
@@ -326,18 +340,17 @@
     }
 
+    # check block expressions
+    $self->use_block_expressions($filename_full_path, $block_hash) unless $self->{'no_blocking'};
+
     # now check whether we are actually processing this
-    my $filename = $file;
-    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-    if ($self->{'process_exp'} eq "" || $filename !~ /$self->{'process_exp'}/ || !-f $filename) {
+    if (!-f $filename_full_path || !$self->can_process_this_file($filename_full_path)) {
 	return undef; # can't recognise
     }
-
-    # do smart blocking if appropriate
-    if ($self->{'smart_block'}) {
-	$self->store_block_files($filename);
-    }
+   
+    $self->store_block_files($filename_full_path, $block_hash) unless $self->{'no_blocking'};
+
     # block the cover image if there is one
     if ($self->{'cover_image'}) {
-	$self->block_cover_image($filename);
+	$self->block_cover_image($filename_full_path, $block_hash) unless $self->{'no_blocking'};
     }
        
@@ -345,161 +358,21 @@
 }
 
-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;
-	    }
-	}
-    }
-
+# plugins that rely on more than process_exp (eg XML plugins) can override this method
+sub can_process_this_file {
+    my $self = shift(@_);
+    my ($filename) = @_;
+
+    if ($self->{'process_exp'} ne "" && $filename =~ /$self->{'process_exp'}/) {
+	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_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) = $self->root_ext_split($file,$associate_tail_re);
-
-    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";
-		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	    
-	    return 1;
-	}
-    }
-
-    return 0;
-}
-
-sub get_full_filenames {
-    my $self = shift (@_);
-    my ($base_dir, $file) = @_;
-
-    my $filename_full_path = $file;
-    # add on directory if present
-    $filename_full_path = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-    my $filename_no_path = $file;
-    # remove directory if present
-    $filename_no_path =~ s/^.*[\/\\]//;
-    return ($filename_full_path, $filename_no_path);
-}
-
-sub read_block {
-    my $self = shift (@_);  
-  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-
-    my ($filename_full_path, $filename_no_path) = $self->get_full_filenames($base_dir, $file);
-
-    if ($self->associate_with($file,$filename_full_path,$metadata)) {
-	# a form of smart block
-	$self->{'num_blocked'} ++;
-	return (0,undef); # blocked
-    }
-
-    my $smart_block = $self->{'smart_block'};
-    my $smart_block_BN = $self->{'smart_block_BN'};
-   
-    if ($smart_block || $smart_block_BN) {
-	if (defined $self->{'file_blocks'}->{$filename_full_path} && $self->{'file_blocks'}->{$filename_full_path} == 1){
-	    $self->{'num_blocked'} ++;
-	    return (0,undef); # blocked
-	}
-    } else {
-	if ($self->{'block_exp'} ne "" && $filename_full_path =~ /$self->{'block_exp'}/) {
-	    $self->{'num_blocked'} ++;
-	    return (0,undef); # blocked
-	}
-	if ($self->{'cover_image'}) {
-	    if (defined $self->{'file_blocks'}->{$filename_full_path} && $self->{'file_blocks'}->{$filename_full_path} == 1){
-		$self->{'num_blocked'} ++;
-		return (0,undef); # blocked
-	    }
-	}
-    }
-
-    if ($filename_full_path !~ /$self->{'process_exp'}/ || !-f $filename_full_path) {
-	return (undef,undef); # can't recognise
-    }
-    
-    ##why are we returning the full filename - do we need this??
-    return (1,$filename_full_path);
-}
-
-
-#filename_encoding set by user
-sub filename_to_utf8_metadata
-{
+    
+}
+
+# just converts path as is to utf8.
+sub filepath_to_utf8 {
     my $self = shift (@_);  
     my ($file, $file_encoding) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    my ($filemeta) = $file =~ /([^\\\/]+)$/; # getting the tail of the filepath (skips all string parts containing slashes upto the end)
+    my $filemeta = $file;
 
     my $filename_encoding = $self->{'filename_encoding'};
@@ -529,4 +402,20 @@
 	);
     }
+
+    return $filemeta;
+}
+
+# gets the filename with no path, converts to utf8, and then dm safes it.
+#filename_encoding set by user
+sub filename_to_utf8_metadata
+{
+    my $self = shift (@_);  
+    my ($file, $file_encoding) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    my ($filemeta) = $file =~ /([^\\\/]+)$/; # getting the tail of the filepath (skips all string parts containing slashes upto the end)
+    $filemeta = $self->filepath_to_utf8($filemeta, $file_encoding);
+
     my $dmsafe_filemeta = &ghtml::dmsafe($filemeta);
 
@@ -649,5 +538,5 @@
 sub read_into_doc_obj {
     my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
 
     my $outhandle = $self->{'outhandle'};
@@ -658,5 +547,5 @@
 	    if $self->{'verbosity'} > 1;
 
-    my ($filename_full_path, $filename_no_path) = $self->get_full_filenames($base_dir, $file);
+    my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file);
     # create a new document
     my $doc_obj = new doc ($filename_full_path, "indexed_doc");
@@ -724,4 +613,17 @@
 }
 
+# implement this if you are extracting metadata for other documents
+sub metadata_read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+    
+    # can we process this file??
+    my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file);
+    return undef unless $self->can_process_this_file($filename_full_path);
+
+    return 1; # we recognise the file, but don't actually do anything with it
+}
+
+
 # The BasePlugin read() function. This function calls read_into_doc_obj()
 # to ensure all the right things to make general options work for a
@@ -741,10 +643,10 @@
 sub read {
     my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    # check that we are not blocked
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
+    my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    # can we process this file??
+    my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file);
+    return undef unless $self->can_process_this_file($filename_full_path);
+    
     my ($process_status,$doc_obj) = $self->read_into_doc_obj(@_);
    
@@ -771,5 +673,4 @@
 
     gsprintf(STDERR, "BasePlugin::process {common.must_be_implemented}\n") && die "\n";
-    # die "BasePlugin::process function must be implemented in sub-class\n";
 
     return undef; # never gets here
@@ -781,4 +682,5 @@
 
 }
+
 # write_file -- used by ConvertToPlug, for example in post processing
 #
@@ -848,5 +750,4 @@
 	    # need to be associated with a document, but the document hasn't
 	    # been formed yet.
-	    
 	    my $equiv_form = "";
 	    foreach my $gaf (@{$metadata->{$field}}) {
@@ -854,5 +755,4 @@
 		my ($tail_filename) = ($full_filename =~ /^.*[\/\\](.+?)$/);
 		my $filename = $full_filename;
-			      
 		$doc_obj->associate_file($full_filename,$tail_filename,$mimetype);
 
@@ -860,5 +760,5 @@
 
 		my ($file_prefix,$file_extended_ext) 
-		    = $self->root_ext_split($tail_filename,$associate_tail_re);
+		    = &util::get_prefix_and_tail_by_regex($tail_filename,$associate_tail_re);
 		my ($pre_doc_ext) = ($file_extended_ext =~ m/^(.*)\..*$/);
 
@@ -943,3 +843,4 @@
 
 
+
 1;
