Changeset 18337 for gsdl/trunk

Timestamp:

2009-01-08T18:32:09+13:00 (15 years ago)

Author:

ak19

Message:

1. Spaces replaced with underscore in the subroutine rename_file instead of in unicode::url_encode. 2. Now the subroutine takes an optional third parameter which is set when given only a tailname: no suffix to the given filename. This is useful for when the filename contains period marks in the middle, none of which are the one separating tailname from the suffix. The testcase with the 'ridiculous' filename (containing period marks and spaces) is successfully handled again.

File:

• gsdl/trunk/perllib/util.pm (modified) (2 diffs)

gsdl/trunk/perllib/util.pm

@@ -995 +995 @@
 }
 
-# returns the given filename converted using either URL encoding or 
-# base64 encoding, as specified by $rename_method
+# Returns the given filename converted using either URL encoding or base64
+# encoding, as specified by $rename_method. If the given filename has no suffix
+# (if it is just the tailname), then $no_suffix should be some defined value. 
 sub rename_file {
-    my ($filename, $rename_method)  = @_;
-
-    if(!$filename) { # for example, empty string
+    my ($filename, $rename_method, $no_suffix)  = @_;
+
+    if(!$filename) { # undefined or empty string
     return $filename;
     }
-  
-    my ($tailname,$dirname,$suffix) = File::Basename::fileparse($filename, "\\.[^\\.]+\$");
+
+    # Replace spaces with underscore.
+    # Do this first else it can go wrong below when getting tailname
+    $filename =~ s/ /_/g;
+
+    # Should we do this????
+    # DM safing would have replaced underscores with character entity _
+    $filename =~ s/&\#095;/_/g;
+
+    my ($tailname,$dirname,$suffix); 
+    if($no_suffix) { # given a tailname, no suffix
+    $suffix = "";
+    ($tailname,$dirname) = File::Basename::fileparse($filename);
+    } 
+    else {
+    ($tailname,$dirname,$suffix) = File::Basename::fileparse($filename, "\\.(?:[^\\.]+?)\$");
+    }
 
     if (!$rename_method) {
@@ -1010 +1026 @@
     # Debugging information
     my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
-    print STDERR "Calling method; $cfilename:$cline $cpackage->$csubr\n";
+    print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr\n";
     }