path-without-extension: utility function. HEAD master

Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>

2 files changed, 14 insertions, 2 deletions

diff --git a/transform/special-forms.scm b/transform/special-forms.scm
index d8abf2c..0c07a0a 100644
--- a/transform/special-forms.scm
+++ b/transform/special-forms.scm
@@ -622,7 +622,8 @@ The above query results to triples that have the form:
                      (out-file
                       (if (= chunks 1)
                           rdf-path
-                          (string-append rdf-path "." (number->string (+ i 1)) ".ttl"))))
+                          (string-append (path-without-extension rdf-path)
+                                         "." (number->string (+ i 1)) ".ttl"))))
                 (with-output-to-file
                     out-file
                   (lambda ()
diff --git a/transform/strings.scm b/transform/strings.scm
index 7b62349..8b4ee45 100644
--- a/transform/strings.scm
+++ b/transform/strings.scm
@@ -2,6 +2,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:use-module (ice-9 string-fun)
   #:use-module (ice-9 textual-ports)
   #:export (string-blank?
@@ -18,11 +19,21 @@
             normalize-string-field
             fix-email-id
             blank-p
-            investigator-attributes->id))
+            investigator-attributes->id
+            path-without-extension))
 
 (define (blank-p str)
   (if (string-blank? str) #f str))
 
+(define (path-without-extension path)
+  (let* ((dir (dirname path))                ; directory part
+	 (base (basename path))              ; filename part
+	 (dot-pos (string-rindex base #\.))) ; last dot position
+    (string-append dir "/"		     ; reconstruct path
+		   (if dot-pos
+		       (substring base 0 dot-pos) ; strip extension
+		       base))))
+
 (define (lower-case-and-replace-spaces str)
   (string-map
    (lambda (c)