download-file: Get download filename from url if not given

.gitignore

@@ -25,3 +25,4 @@ example
 venv
 foreign
 tmp
+*.json

Makefile

@@ -66,7 +66,8 @@ test-docker: testfiles
 		DOCKER_TAG=${DOCKER_TAG} \
 		COMPILE_R7RS=${SCHEME} \
 		CSC_OPTIONS="${CSC_OPTIONS}" \
-		SNOW_PACKAGES="foreign.c srfi.64 srfi.170 retropikzel.system retropikzel.named-pipes ${PKG}" \
+		SNOW_PACKAGES="srfi.64 ${PKG}" \
+		AKKU_PACKAGES="akku-r7rs" \
 		APT_PACKAGES="${APT_PACKAGES}" \
 		PASS_ENV_VARS="CSC_OPTIONS" \
 		test-r7rs -o test-program test.${SFX}

retropikzel/download-file.scm

@@ -30,6 +30,15 @@
 ;(define-c-procedure curl-easy-getinfo libcurl 'curl_easy_getinfo 'int '(pointer int pointer))
 ;(define-c-procedure curl-easy-nextheader libcurl 'curl_easy_nextheader 'pointer '(pointer int int pointer))
 
+(define (get-right-char-until str chars)
+  (let ((result '())
+        (until? #f))
+    (for-each
+      (lambda (c)
+        (when (member c chars) (set! until? #t))
+        (when (not until?) (set! result (cons c result))))
+      (reverse (string->list str)))
+    (list->string result)))
 
 (define (download-file url . download-path)
   (when (not (string? url))
@@ -39,16 +48,21 @@
     (error "download-file error: download-path must be string"
            (car download-path)))
   (let* ((handle (curl-easy-init))
-         (to-path (if (null? download-path) "." (car download-path)))
+         (to-path (if (null? download-path)
+                    (get-right-char-until url '(#\/ #\\))
+                    (car download-path)))
          (to-path-cbv (string->c-bytevector to-path))
          (file-mode-cbv (string->c-bytevector "w"))
          (to-file-cbv (c-fopen to-path-cbv file-mode-cbv))
          (url-cbv (string->c-bytevector url)))
+    (display "HERE: to-path ")
+    (write to-path)
+    (newline)
     (when (c-bytevector-null? to-file-cbv)
       (let* ((error-message "download-file error")
              (error-pointer (string->c-bytevector error-message)))
         (c-perror error-pointer)
-        (c-bytevector-free file-mode-cbv to-path-cbv o-file-cbv url-cbv error-pointer)
+        (c-bytevector-free file-mode-cbv to-path-cbv to-file-cbv url-cbv error-pointer)
         (error error-message)))
     (curl-easy-setopt-pointer handle CURLOPT-WRITEDATA to-file-cbv)
     (curl-easy-setopt-pointer handle CURLOPT-URL url-cbv)

retropikzel/download-file/test.scm

@@ -6,5 +6,8 @@
                tmpfile)
 (test-assert (file-exists? tmpfile))
 
+(download-file "https://microsoftedge.github.io/Demos/json-dummy-data/64KB.json")
+(test-assert (file-exists? "64KB.json"))
+
 (test-end "download-file")
 

retropikzel/system.scm

@@ -2,7 +2,7 @@
 (define-c-procedure c-system libc 'system 'int '(pointer))
 
 (define (system command)
-  (let* ((command-pointer (string->c-bytevector command))
+  (let* ((command-cbv (string->c-bytevector command))
          (result (c-system command-pointer)))
-    (c-bytevector-free command-pointer)
+    (c-bytevector-free command-cbv)
     result))