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"
|
||||
:license "GPLv3"
|
||||
:author "Jaidyn Ann <jadedctrl@posteo.at>"
|
||||
: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
|
||||
(and (dexador:fetch (url-encode-uri (quri:uri url)) path)
|
||||
(pathname path))
|
||||
(file-exists ()
|
||||
(cl-user::file-exists ()
|
||||
path)
|
||||
(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