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")