lserver/roswell/lserver.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  (ql:quickload '(:lserver :uiop :alexandria) :silent t))


(defpackage :ros.script.lserver.3766064847
  (:use :cl))
(in-package :ros.script.lserver.3766064847)

(import 'alexandria:starts-with-subseq)
(import 'alexandria:ensure-list)

(defun help ()
  (format t "~&Usage:
    lserver --home ~~/.lserver --socket \"my\"~%"))

(defun terminate (&optional message args)
  (when message
    (format *error-output* "~&Error: ~A~%"
            (apply #'format nil (princ-to-string message) (ensure-list args))))
  (uiop:quit -1))


(defun parse-args (args)
  (flet ((keyp (string)
           (starts-with-subseq "--" string))
         (parse-value (value)
           (or (ignore-errors
                (let ((read-value (read-from-string value)))
                  (if (and (symbolp read-value)
                           (not (keywordp read-value)))
                      value
                      read-value)))
               value)))
    (let ((path (pop args)))
      (when (starts-with-subseq "--" path)
        (terminate "No path given."))
      (cons (pathname path)
            (loop for index from 0 below (length args)
                  for first = (elt args index)
                  for rest = (subseq args (incf index))
                  for key = (or (when (not (keyp first))
                                  (terminate "Invalid option: ~S" first))
                                (intern (string-upcase (subseq first 2)) :keyword))
                  for value = (if (eql key :depends-on)
                                  (loop for (item . rest) on rest
                                        collecting item
                                        until (keyp (car rest))
                                        do (incf index))
                                  (parse-value (car rest)))
                  nconc (list key (parse-value value)))))))

(defparameter options '(:home :socket :help))

(defun argv->args (argv)
  (flet ((keyp (string)
           (starts-with-subseq "--" string))
         (parse-value (value)
           (or (ignore-errors
		 (let ((read-value (read-from-string value)))
		   (if (and (symbolp read-value)
			    (not (keywordp read-value)))
		       value
		       read-value)))
               value)))
    (loop for index from 0 below (length argv)
       for first = (elt argv index)
       for key = (or (when (not (keyp first))
		       (terminate "Invalid option: ~S" first))
		     (when (string= first "--help")
		       (help)
		       (terminate))
		     (let ((key (intern (string-upcase (subseq first 2)) :keyword)))
		       (when (not (member key options))
			 (terminate "Invalid option: ~S" first))
		       key))
       for second = (or (when (eql (1+ index) (length argv)) 
			  (terminate "Invalid null option value: ~S " (list first)))
			(elt argv (incf index)))
       for value = (or (when (keyp second)
			 (terminate "Invalid option value: ~S ~S" (list first second)))
		       second)
       nconc (list key (parse-value value)))))

(defun main (&rest argv)
  (let ((args (argv->args argv)))
    (apply 'lserver:run-server args)))

;;; vim: set ft=lisp lisp: