path-without-extension: utility function.

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

1 files changed, 12 insertions, 1 deletions

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)