changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: net/fetch

changeset 302: 6ea593ae4cea
parent 301: 5b5d12253b8d
child 304: e426780ce0c7
author: Richard Westhaver <ellis@rwest.io>
date: Sat, 27 Apr 2024 22:25:36 +0000
files: lisp/lib/net/fetch.lisp lisp/lib/net/net.asd
description: net/fetch
     1.1--- a/lisp/lib/net/fetch.lisp	Fri Apr 26 20:32:04 2024 -0400
     1.2+++ b/lisp/lib/net/fetch.lisp	Sat Apr 27 22:25:36 2024 +0000
     1.3@@ -7,57 +7,57 @@
     1.4   (let ((output (if output
     1.5                     output
     1.6                     (file-namestring (obj/uri:uri-path (obj/uri:uri url))))))
     1.7-      (multiple-value-bind (stream status header uri)
     1.8-          (dex:get url :want-stream t)
     1.9-        (when (= status 200) (write-stream-into-file stream (pathname output)))
    1.10-        (values (or stream uri header)
    1.11-                status))))
    1.12+    (multiple-value-bind (stream status header uri)
    1.13+        (dex:get url :want-stream t)
    1.14+      (when (= status 200) (write-stream-into-file stream (pathname output)))
    1.15+      (values (or stream uri header)
    1.16+              status))))
    1.17 
    1.18-  (defun split-file-path (path)
    1.19-    (let ((pos-last-slash (1+ (position #\/ path :from-end t))))
    1.20-      (list (subseq path 0 pos-last-slash)
    1.21-            (subseq path pos-last-slash))))
    1.22+(defun split-file-path (path)
    1.23+  (let ((pos-last-slash (1+ (position #\/ path :from-end t))))
    1.24+    (list (subseq path 0 pos-last-slash)
    1.25+          (subseq path pos-last-slash))))
    1.26 
    1.27-  (defun split-uri-string (uri-string)
    1.28-    (let ((pu (parse-uri uri-string)))
    1.29-      (cons (uri-host pu) (split-file-path (uri-path pu)))))
    1.30+(defun split-uri-string (uri-string)
    1.31+  (let ((pu (parse-uri uri-string)))
    1.32+    (cons (uri-host pu) (split-file-path (uri-path pu)))))
    1.33 
    1.34-  (defun condition-path (path)
    1.35-    "Abuse parse-uri to strip possible get args from path"
    1.36-    (let ((p (parse-uri path))) (uri-path p)))
    1.37+(defun condition-path (path)
    1.38+  "Abuse parse-uri to strip possible get args from path"
    1.39+  (let ((p (parse-uri path))) (uri-path p)))
    1.40 
    1.41-  (defun is-file (path)
    1.42-    (handler-case (probe-file path)
    1.43-      (type-error (e) #+sbcl (declare (ignore e)) (error 'invalid-path-error
    1.44-                                                         :text (format nil "Invalid path: ~A" path)))))
    1.45+(defun is-file (path)
    1.46+  (handler-case (probe-file path)
    1.47+    (type-error (e) #+sbcl (declare (ignore e)) (error 'invalid-path-error
    1.48+                                                       :text (format nil "Invalid path: ~A" path)))))
    1.49 
    1.50-  (defun %fetch (url-or-path &key (cache t)
    1.51-                               (dir "vega/")
    1.52-                               (flush nil))
    1.53-    (cond
    1.54-      ((is-file (condition-path url-or-path)) (condition-path url-or-path))
    1.55-      ((is-file (condition-path (concatenate 'string  dir url-or-path)))
    1.56-       (condition-path (concatenate 'string  dir url-or-path)))
    1.57-      ((parse-uri url-or-path)
    1.58-       (let* ((tmp-pathname (split-uri-string url-or-path))
    1.59-              (file-pathstring (format nil "~{~A~^~}" (if dir (cons dir tmp-pathname) tmp-pathname)))
    1.60-              (file-pathname (ensure-directories-exist
    1.61-                              file-pathstring)))
    1.62-         (if flush
    1.63-             (when (is-file file-pathname) (delete-file file-pathname))
    1.64-             (if (and cache (probe-file file-pathname))
    1.65-                 (values file-pathname 200 "OK")
    1.66-                 (download url-or-path file-pathname)))))
    1.67-      (t (values nil 404 "Not file of url"))))
    1.68+(defun %fetch (url-or-path &key (cache t)
    1.69+                                dir
    1.70+                                (flush nil))
    1.71+  (cond
    1.72+    ((is-file (condition-path url-or-path)) (condition-path url-or-path))
    1.73+    ((is-file (condition-path (concatenate 'string  dir url-or-path)))
    1.74+     (condition-path (concatenate 'string  dir url-or-path)))
    1.75+    ((parse-uri url-or-path)
    1.76+     (let* ((tmp-pathname (split-uri-string url-or-path))
    1.77+            (file-pathstring (format nil "~{~A~^~}" (if dir (cons dir tmp-pathname) tmp-pathname)))
    1.78+            (file-pathname (ensure-directories-exist
    1.79+                            file-pathstring)))
    1.80+       (if flush
    1.81+           (when (is-file file-pathname) (delete-file file-pathname))
    1.82+           (if (and cache (probe-file file-pathname))
    1.83+               (values file-pathname 200 "OK")
    1.84+               (download url-or-path file-pathname)))))
    1.85+    (t (values nil 404 "Not file of url"))))
    1.86 
    1.87-  (defun fetch (url-or-path
    1.88-                &key
    1.89-                  (dir)
    1.90-                  (external-format :utf-8)
    1.91-                  (cache t)
    1.92-                  (stream nil)
    1.93-                  (flush nil))
    1.94-    "Fetch file from ~url-or-location~ if not cached in ~dir~
    1.95+(defun fetch (url-or-path
    1.96+              &key
    1.97+              (dir)
    1.98+              (external-format :utf-8)
    1.99+              (cache t)
   1.100+              (stream nil)
   1.101+              (flush nil))
   1.102+  "Fetch file from ~url-or-location~ if not cached in ~dir~
   1.103 stores the file in the location specified by dir if url or file is url the file
   1.104 is stored in ~dir~/~uri-host~/~uri-path~.
   1.105 
   1.106@@ -71,9 +71,9 @@
   1.107   - dir: location to store fetched file.
   1.108   - flush: if T fetch does not download the file it deletes the existing file.
   1.109 "
   1.110-    (let ((fetched-path (%fetch url-or-path :dir dir :cache cache :flush flush)))
   1.111-      (if (not fetched-path)
   1.112-          nil
   1.113-          (if stream
   1.114-              (open fetched-path :direction :input :external-format external-format)
   1.115-              fetched-path))))
   1.116+  (let ((fetched-path (%fetch url-or-path :dir dir :cache cache :flush flush)))
   1.117+    (if (not fetched-path)
   1.118+        nil
   1.119+        (if stream
   1.120+            (open fetched-path :direction :input :external-format external-format)
   1.121+            fetched-path))))
     2.1--- a/lisp/lib/net/net.asd	Fri Apr 26 20:32:04 2024 -0400
     2.2+++ b/lisp/lib/net/net.asd	Sat Apr 27 22:25:36 2024 +0000
     2.3@@ -7,7 +7,7 @@
     2.4    :sb-bsd-sockets :cl-ppcre
     2.5    :dat :obj
     2.6    :swank :swank-client
     2.7-   :dexador :puri ;; fetch
     2.8+   :dexador ;; fetch
     2.9    :hunchentoot :std :log)
    2.10   :serial t
    2.11   :components ((:file "pkg")