diff --git a/mirror-img.asd b/mirror-img.asd index 5261ddd..3fe8ce2 100644 --- a/mirror-img.asd +++ b/mirror-img.asd @@ -1,6 +1,20 @@ -(defsystem "mirror-img" +(require "asdf") + +(asdf:defsystem "mirror-img" :version "0.1" :license "GPLv3" :author "Jaidyn Ann " :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 " + :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"))) diff --git a/src/mirror-img.lisp b/src/mirror-img.lisp index 751f5f3..dafc2f8 100644 --- a/src/mirror-img.lisp +++ b/src/mirror-img.lisp @@ -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))) diff --git a/src/unix.lisp b/src/unix.lisp new file mode 100644 index 0000000..cd9a4de --- /dev/null +++ b/src/unix.lisp @@ -0,0 +1,72 @@ +;;;; mirror-img/unix: UNIX-style cli program frontend to mirror-img. + +;; Copyright © 2024 Jaidyn Ann +;; +;; 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 . + +(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))