Fix sourcing of filenames from escaped URIsHEADv2.9.2master

Use Perl's URI library code to properly parse and handle SlackBuild links.

2 files changed, 20 insertions, 14 deletions

diff --git a/ChangeLog.md b/ChangeLog.md
index fbe9ddc..de58b2c 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -2,7 +2,14 @@
 
 All notable changes to this project will be documented in this file.
 
-## [Unreleased]
+## [2.9.2]
+
+### Fixed
+
+  - Fix all URI escapes in distfile names. Thanks to pghvlaans for relaying the
+    report from fourtysixandtwo and lockywolf!
+
+## [2.9.1]
 
 ### Fixed
 
diff --git a/SBO-Lib/lib/SBO/Lib/Download.pm b/SBO-Lib/lib/SBO/Lib/Download.pm
index ab65765..eb8bfdc 100644
--- a/SBO-Lib/lib/SBO/Lib/Download.pm
+++ b/SBO-Lib/lib/SBO/Lib/Download.pm
@@ -11,6 +11,7 @@ use SBO::Lib::Repo qw/ $distfiles /;
 use SBO::Lib::Info qw/ get_download_info /;
 
 use Digest::MD5;
+use URI ();
 use Exporter 'import';
 
 our @EXPORT_OK = qw{
@@ -162,10 +163,14 @@ sub get_distfile {
   my $fail = {};
 
   if ($config{FALLBACK_ARCHIVE} ne 'FALSE') {
+    my $uri = URI->new($link);
+    my @segments = $uri->path_segments();
+    my $filename = $segments[-1];
+
     push(@links, sprintf(
       "%s/by-md5/%s/%s/%s/%s",
       $config{FALLBACK_ARCHIVE},
-      substr($info_md5, 0, 1), substr($info_md5, 1, 1), $info_md5, _get_fname($link),
+      substr($info_md5, 0, 1), substr($info_md5, 1, 1), $info_md5, $filename,
     ));
   }
 
@@ -223,8 +228,12 @@ C<$link>.
 
 sub get_filename_from_link {
   script_error('get_filename_from_link requires an argument') unless @_ == 1;
-  my $filename = _get_fname(shift);
-  return undef unless defined $filename;
+
+  my $uri = URI->new(shift);
+  my @segments = $uri->path_segments();
+  my $filename = $segments[-1];
+
+  return undef unless length($filename);
   return "$distfiles/$filename";
 }
 
@@ -296,14 +305,4 @@ sub verify_distfile {
   return $info_md5 eq $md5sum ? 1 : 0;
 }
 
-# given a link, grab the filename from it and prepend $distfiles
-sub _get_fname {
-  my $fn = shift;
-  my $regex = qr#/([^/]+)$#;
-  my ($filename) = $fn =~ $regex;
-  $filename =~ s/%2B/+/g if $filename;
-  return $filename;
-
-}
-
 1;