Compare commits
5 Enmetoj
28f40c5f6e
...
7807afece2
Author | SHA1 | Date | |
---|---|---|---|
Jaidyn Ann | 7807afece2 | ||
Jaidyn Ann | 43cc123057 | ||
Jaidyn Ann | 93022814fd | ||
Jaidyn Ann | 55362c7075 | ||
Jaidyn Ann | d9bead00b4 |
|
@ -64,7 +64,7 @@ For example:
|
|||
(linked-urls dom :tags tags))))
|
||||
|
||||
;; lquery-dom alist list → nil
|
||||
(defun substitute-urls (dom substitution-alist &key (tags '("img")))
|
||||
(defun substitute-urls (dom substitution-alist &key (tags *default-tags*))
|
||||
"Replace SRC or HREF attributes of certain tags in an LQuery DOM, based on a
|
||||
substitution associative list. The substitution alist is made up of cons-cells
|
||||
mapping replacee URLs to substition URLs.
|
||||
|
@ -89,13 +89,12 @@ among the given tags."
|
|||
"Given a URL, return the corresponding path we would download it to, were we
|
||||
to mirror it."
|
||||
(let* ((url (quri:uri url))
|
||||
(path (quri:uri-path url)))
|
||||
(path (uri-path+query url)))
|
||||
(pathname
|
||||
(format nil "~@[~A/~]~A/~A~@[.~A~]"
|
||||
(format nil "~@[~A/~]~A/~A"
|
||||
base-dir
|
||||
(quri:uri-host url)
|
||||
(pathname-name path)
|
||||
(pathname-type path)))))
|
||||
(pathname-leaf path)))))
|
||||
|
||||
|
||||
|
||||
|
@ -126,10 +125,11 @@ HREF and SRC attributes."
|
|||
"Set the SRC or HREF attribute of an LQuery node (based on which attribute is
|
||||
already set)."
|
||||
(and node
|
||||
(if (lquery-funcs:attr node "src")
|
||||
(lquery-funcs:attr node "src" url))
|
||||
(if (lquery-funcs:attr node "href")
|
||||
(lquery-funcs:attr node "href" url))))
|
||||
(cond ((lquery-funcs:attr node "src")
|
||||
(lquery-funcs:attr node "src" url))
|
||||
((lquery-funcs:attr node "href")
|
||||
(lquery-funcs:attr node "href" url))
|
||||
('T node))))
|
||||
|
||||
|
||||
|
||||
|
@ -139,7 +139,7 @@ already set)."
|
|||
(defun http-fetch (url path)
|
||||
"Download a URL to a path; if successful, returns the pathname. Otherwise, NIL."
|
||||
(handler-case
|
||||
(and (dexador:fetch (url-encode-uri (quri:uri url)) path)
|
||||
(and (dexador:fetch (url-encode-uri url) path)
|
||||
(pathname path))
|
||||
(cl-user::file-exists ()
|
||||
path)
|
||||
|
@ -154,7 +154,7 @@ already set)."
|
|||
(quri:uri-scheme uri)
|
||||
(quri:uri-host uri)
|
||||
(uri-explicit-port uri)
|
||||
(url-encode-path (quri:uri-path uri)))))
|
||||
(url-encode-path (uri-path+query uri)))))
|
||||
|
||||
;; string → string
|
||||
(defun url-encode-path (path)
|
||||
|
@ -178,3 +178,14 @@ That is, 443 is implied by HTTPS, so nil is returned; but 998 wouldn’t be impl
|
|||
(and (equal scheme "http")
|
||||
(eq port 80)))
|
||||
port)))
|
||||
|
||||
;; quri-uri → string
|
||||
(defun uri-path+query (uri)
|
||||
"Return everything in a URI after the TLD — that is, both the path _and_ the query."
|
||||
(format nil "~A~@[?~A~]" (quri:uri-path uri) (quri:uri-query uri)))
|
||||
|
||||
;; pathname → string
|
||||
(defun pathname-leaf (pathname)
|
||||
"Given a pathname, return the entirety of the file leaf.
|
||||
That is, everything following the last directory name."
|
||||
(car (last (split-sequence:split-sequence #\/ (namestring pathname)))))
|
||||
|
|
|
@ -70,11 +70,17 @@
|
|||
(mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt"
|
||||
:base-dir #p"base/")))
|
||||
|
||||
(define-test mirrored-pathname.esperanto-question (:tags '(base))
|
||||
(assert-equal
|
||||
#p"base/invalid.tld/?!?! ĉu ne?!?!.png"
|
||||
(mirror-img::mirrored-pathname "https://invalid.tld/dir/s/d/ askldjas/ asldkja/?!?! ĉu ne?!?!.png"
|
||||
:base-dir #p"base/")))
|
||||
|
||||
(define-test linked-urls (:tags '(dom))
|
||||
(assert-equal
|
||||
'("http://localhost:4242/res/img/b/fireplace.jpg"
|
||||
"http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/more_calming.jpg"
|
||||
"http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas%3F!/classy_fireplace.jpg"
|
||||
"http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas?!/classy_fireplace.jpg"
|
||||
"http://localhost:4242/res/img/level-2/café.jpg"
|
||||
"http://localhost:4242/res/img/merry christmas!!! ^_^.jpg"
|
||||
"http://localhost:4242/res/style.css"
|
||||
|
@ -94,6 +100,11 @@
|
|||
"/images%21/dad%20alive.jpg"
|
||||
(mirror-img::url-encode-path "/images!/dad alive.jpg")))
|
||||
|
||||
(define-test url-encode-path.question (:tags '(util))
|
||||
(assert-equal
|
||||
"/images%21/%3F%C4%89u_ne%20tio%20sufi%C4%89e%3F%21.jpg"
|
||||
(mirror-img::url-encode-path "/images!/?ĉu_ne tio sufiĉe?!.jpg")))
|
||||
|
||||
(define-test uri-explicit-port.http80 (:tags '(util))
|
||||
(assert-eq
|
||||
nil
|
||||
|
@ -114,3 +125,12 @@
|
|||
nil
|
||||
(mirror-img::uri-explicit-port (quri:uri "https://xwx.moe:443/bird.png"))))
|
||||
|
||||
(define-test pathname-leaf.simple (:tags '(util))
|
||||
(assert-equal
|
||||
"apple_berries.png"
|
||||
(mirror-img::pathname-leaf #p"/mom/dad/apple/laksdjal/apple_berries.png")))
|
||||
|
||||
(define-test pathname-leaf.very-weird (:tags '(util))
|
||||
(assert-equal
|
||||
" lak -!?ĉ_berries.png"
|
||||
(mirror-img::pathname-leaf #p"/mom/dad?!?Ljla asdasd'' aslkdjĉ/apple/laksdjal/ lak -!?ĉ_berries.png")))
|
||||
|
|
|
@ -62,7 +62,7 @@
|
|||
<p>Three…</p>
|
||||
|
||||
<figure>
|
||||
<img src="http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas%3F!/classy_fireplace.jpg">
|
||||
<img src="http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas?!/classy_fireplace.jpg">
|
||||
<figcaption><em>You’re surrounded by your superiors.</em>
|
||||
<a href="https://www.pixiv.net/artworks/115188449">
|
||||
🔗
|
||||
|
|
Ŝarĝante…
Reference in New Issue