[bug#36919] [PATCH 2/2] gnu-maintenance: KDE updater finds packages even in sub-directory.

[Hartmut Goebel]

Fixes <http://issues.guix.gnu.org/issue/30345> and
finally fixes <http://issues.guix.gnu.org/issue/25020>.

Formerly packages living in a path like
/stable/frameworks/5.60/portingAids/kross-5.60.0.tar.xz
have not been found.

* guix/gnu-maintenance.scm (uri->kde-path-pattern): New procedure.
  (latest-kde-release): Use pattern to search for file.
---
 guix/gnu-maintenance.scm | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 730e2519ee..d76ef2c5aa 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -657,14 +657,36 @@ releases are on gnu.org."
                           entries)))))
       entries)))
 
+(define (uri->kde-path-pattern uri)
+
+  (define version-regexp
+    (make-regexp
+     (string-join '("^([0-9]+\\.)+[0-9]+-?"   ;; 5.12.90, 4.2.0-preview
+                    "^[0-9]+$"                ;; 20031002
+                    ".*-([0-9]+\\.)+[0-9]+$") ;; kdepim-4.6.1
+                    "|")))
+
+  (define (version->pattern part)
+    ;; If a path element might be a version´, replace it by a catch-all part
+    (if (regexp-exec version-regexp part)
+        "[^/]+"
+        part))
+
+  (let* ((path (uri-path uri))
+         (directory-parts (string-split (dirname path) #\/)))
+    (make-regexp
+     (string-append
+      (string-join (map version->pattern directory-parts) "/")
+      "/"))))
+
 (define (latest-kde-release package)
   "Return the latest release of PACKAGE, the name of an KDE.org package."
   (let* ((uri      (string->uri (origin-uri (package-source package))))
-         (directory  (dirname (dirname (uri-path uri))))
+         (path-rx  (uri->kde-path-pattern uri))
          (name     (package-upstream-name package))
          (files    (download.kde.org-files))
          (relevant (filter (lambda (file)
-                             (and (string-prefix? directory file)
+                             (and (regexp-exec path-rx file)
                                   (release-file? name (basename file))
                                   ))
                            files)))
-- 
2.21.0