mirror-img/t/mirror-img.lisp
Jaidyn Ann 19e01c762d Add --source & :HTML-URL to resolve relative URLs
Now, relative URLs in the input file can be
mirrored in relation to a given URL.
2024-05-31 22:29:47 -05:00

153 lines
5.7 KiB
Common Lisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; mirror-img/tests: Tests for the mirror-img package.
;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(defpackage :mirror-img/tests
(:use :cl :lisp-unit2)
(:export :run))
(in-package :mirror-img/tests)
(defparameter *mirror-img-result* nil)
(defun relative-pathname (path)
"Return an absolute path adding the relative PATH to the :mirror-img
systems path."
(asdf:system-relative-pathname :mirror-img/tests path))
(defun run ()
"Run all tests for the mirror-img package."
(let* ((doc-root (relative-pathname "t/testing-website/"))
(acceptor (make-instance 'hunchentoot:easy-acceptor
:port 4242
:document-root doc-root))
(server (hunchentoot:start acceptor)))
(lisp-unit2:with-summary ()
(handler-case
(progn
(run-tests :package :mirror-img/tests)
(hunchentoot:stop server))
(error (c)
(hunchentoot:stop server)
c)))))
(define-test mirror-img (:tags '(mirror-img))
(assert-eq
'T
(stringp
(setq *mirror-img-result*
(let* ((html-path (relative-pathname "t/testing-website/index.html"))
(download-dir (relative-pathname "t/tmp/"))
(html-url "http://localhost:4242")
(url-dir (pathname-utils:relative-pathname
(relative-pathname "t/")
download-dir)))
(mirror-img:mirror-img html-path download-dir
:url-dir url-dir
:html-url html-url))))))
(define-test mirror-img.files-mirrored (:tags '(mirror-img))
(assert-equal
'("café" "classy_fireplace" "fireplace" "merry christmas!!! ^_^" "more_calming" "style" "welcoming you")
(sort (mapcar #'pathname-name
(uiop:directory-files (relative-pathname "t/tmp/localhost/")))
#'string-lessp)))
(define-test mirror-img.correct-urls (:tags '(mirror-img))
(assert-equal
'("tmp/localhost/café.jpg"
"tmp/localhost/classy_fireplace.jpg"
"tmp/localhost/fireplace.jpg"
"tmp/localhost/merry christmas!!! ^_^.jpg"
"tmp/localhost/more_calming.jpg"
"tmp/localhost/style.css"
"tmp/localhost/welcoming you.jpg")
(sort (mirror-img::linked-urls
(lquery:$ (lquery:initialize *mirror-img-result*)))
#'string-lessp)))
(define-test mirrored-pathname (:tags '(base))
(assert-equal
#p"base/invalid.tld/bird apple.txt"
(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
'("/res/welcoming you.jpg"
"http://localhost:4242/res/img/b/fireplace.jpg"
"http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/more_calming.jpg"
"http://localhost:4242/res/img/b/Im 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")
(sort (mirror-img::linked-urls
(lquery:$ (lquery:initialize
(relative-pathname "t/testing-website/index.html"))))
#'string-lessp)))
(define-test url-encode-uri.space (:tags '(util))
(assert-equal
"https://invalid.tld/dad%20alive.jpg"
(mirror-img::url-encode-uri "https://invalid.tld/dad alive.jpg")))
(define-test url-encode-path.space+exclamation (:tags '(util))
(assert-equal
"/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
(mirror-img::uri-explicit-port (quri:uri "http://xwx.moe/bird.png"))))
(define-test uri-explicit-port.http443 (:tags '(util))
(assert-eq
443
(mirror-img::uri-explicit-port (quri:uri "http://xwx.moe:443/bird.png"))))
(define-test uri-explicit-port.https27 (:tags '(util))
(assert-eq
27
(mirror-img::uri-explicit-port (quri:uri "http://xwx.moe:27/bird.png"))))
(define-test uri-explicit-port.https443 (:tags '(util))
(assert-eq
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")))