Begin UNIX cli front-end
This commit is contained in:
parent
0316d7ca9e
commit
3a26997f2d
|
@ -1,6 +1,20 @@
|
||||||
(defsystem "mirror-img"
|
(require "asdf")
|
||||||
|
|
||||||
|
(asdf:defsystem "mirror-img"
|
||||||
:version "0.1"
|
:version "0.1"
|
||||||
:license "GPLv3"
|
:license "GPLv3"
|
||||||
:author "Jaidyn Ann <jadedctrl@posteo.at>"
|
:author "Jaidyn Ann <jadedctrl@posteo.at>"
|
||||||
:depends-on (:dexador :lquery :split-sequence)
|
:depends-on (:dexador :lquery :split-sequence)
|
||||||
:components ((:file "src/mirror-img")))
|
:components ((:file "src/mirror-img"))
|
||||||
|
:in-order-to ((build-op (build-op "mirror-img/unix"))))
|
||||||
|
|
||||||
|
(asdf:defsystem "mirror-img/unix"
|
||||||
|
:version "0.1"
|
||||||
|
:license "GPLv3"
|
||||||
|
:author "Jaidyn Ann <jadedctrl@posteo.at>"
|
||||||
|
:class asdf:program-system
|
||||||
|
:build-operation "program-op"
|
||||||
|
:build-pathname "mirror-img"
|
||||||
|
:entry-point "mirror-img/unix:main"
|
||||||
|
:depends-on (:mirror-img :unix-opts :cl-strings)
|
||||||
|
:components ((:file "src/unix")))
|
||||||
|
|
|
@ -140,7 +140,7 @@ already set)."
|
||||||
(handler-case
|
(handler-case
|
||||||
(and (dexador:fetch (url-encode-uri (quri:uri url)) path)
|
(and (dexador:fetch (url-encode-uri (quri:uri url)) path)
|
||||||
(pathname path))
|
(pathname path))
|
||||||
(file-exists ()
|
(cl-user::file-exists ()
|
||||||
path)
|
path)
|
||||||
(error nil)))
|
(error nil)))
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,72 @@
|
||||||
|
;;;; mirror-img/unix: UNIX-style cli program frontend to mirror-img.
|
||||||
|
|
||||||
|
;; 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/unix
|
||||||
|
(:use :cl)
|
||||||
|
(:export :main))
|
||||||
|
|
||||||
|
(in-package :mirror-img/unix)
|
||||||
|
|
||||||
|
|
||||||
|
;;; Macros
|
||||||
|
;;; ————————————————————————————————————————
|
||||||
|
;; list symbol form
|
||||||
|
(defmacro when-opt (opts option body)
|
||||||
|
`(when (getf ,opts ,option)
|
||||||
|
,body))
|
||||||
|
|
||||||
|
;; list symbol form form
|
||||||
|
(defmacro if-opt (opts option if-form &optional else-form)
|
||||||
|
`(if (getf ,opts ,option)
|
||||||
|
,if-form ,else-form))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; Mirror-img (UNIX)
|
||||||
|
;;; ————————————————————————————————————————
|
||||||
|
;; NIL → NIL
|
||||||
|
(defun main ()
|
||||||
|
"Actual invocation of the program. This is what you should set as :toplevel."
|
||||||
|
(multiple-value-bind (opts free) (opts:get-opts)
|
||||||
|
(when-opt opts :help (help))
|
||||||
|
(let* ((input-stream (pathname (car free))))
|
||||||
|
(when (not input-stream)
|
||||||
|
(format *error-output* "No file provided.~%")
|
||||||
|
(help 2))
|
||||||
|
|
||||||
|
(format
|
||||||
|
't
|
||||||
|
(mirror-img:mirror-img
|
||||||
|
input-stream
|
||||||
|
#p"mirror/")))))
|
||||||
|
|
||||||
|
(opts:define-opts
|
||||||
|
(:name :help
|
||||||
|
:description "print this help text."
|
||||||
|
:short #\h :long "help")
|
||||||
|
(:name :base
|
||||||
|
:description "directory for all mirrored files"
|
||||||
|
:short #\b :long "base"
|
||||||
|
:arg-parser (lambda (dir)
|
||||||
|
(car (directory dir)))))
|
||||||
|
|
||||||
|
;; number stream → nil
|
||||||
|
(defun help (&optional (exit-code 0) (stream *standard-output*))
|
||||||
|
"Prints help message and dies."
|
||||||
|
(unix-opts:describe :prefix "usage: mirror-img [-h] [-b DIR] HTML_FILE"
|
||||||
|
:stream stream)
|
||||||
|
(unix-opts:exit exit-code))
|
Ŝarĝante…
Reference in New Issue