From 4eb69bf0d33810886ee118f38989cef696e4c868 Mon Sep 17 00:00:00 2001
From: Hartmut Goebel <h.goebel@crazy-compilers.com>
Date: Sun, 4 Aug 2019 11:32:39 +0200
Subject: import: KDE updater finds packages even in sub-directory.

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/import/kde.scm (uri->kde-path-pattern): New procedure.
  (latest-kde-release): Use pattern to search for file.
---
 guix/import/kde.scm | 36 ++++++++++++++++++++++++++++++++++--
 1 file changed, 34 insertions(+), 2 deletions(-)

diff --git a/guix/import/kde.scm b/guix/import/kde.scm
index 927ecc8263..6873418d62 100644
--- a/guix/import/kde.scm
+++ b/guix/import/kde.scm
@@ -117,15 +117,47 @@ CACHE."
     (close-port port)
     files))
 
+(define (uri->kde-path-pattern uri)
+  "Build a regexp from the package's URI suitable for matching the package
+path version-agnostic.
+
+Example:
+Input:
+   mirror://kde//stable/frameworks/5.55/portingAids/kross-5.55.0.zip
+Output:
+   //stable/frameworks/[^/]+/portingAids/
+"
+
+  (define version-regexp
+    ;; regexp for matching versions as used in the ld-lR file
+    (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, a KDE package, or #f if it could
 not be determined."
   (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)))
     (match (sort relevant (lambda (file1 file2)
-- 
cgit v1.2.3