;;; -*-lisp-*-
(cl:defpackage #:ansible-inventory
- (:use #:common-lisp)
- (:import-from #:cl-launch #:*arguments*))
+ (:use #:common-lisp))
(in-package #:ansible-inventory)
+(declaim (optimize debug))
+
;;;--------------------------------------------------------------------------
;;; General utilities.
(print-json-itemstart)
(pprint-logical-block (*standard-output* nil)
(let ((*print-json-comma* nil))
- (print-json-simple label))
+ (print-json-simple (if (not (keywordp label))
+ label
+ (with-output-to-string (out)
+ (let ((labname (symbol-name label)))
+ (dotimes (i (length labname))
+ (let ((ch (char labname i)))
+ (write-char (if (char= ch #\-) #\_
+ (char-downcase ch))
+ out))))))))
(princ ": ")
(pprint-newline :miser)
(let ((*print-json-comma* nil))
(defun print-json-simple (value)
(typecase value
- (list (print-json-list (dolist (i value) (print-json-simple i))))
- (hash-table (print-json-map (maphash (lambda (k v)
- (print-json-mapping k
- (print-json-simple v)))
- value)))
+ ((and vector (not string))
+ (print-json-list
+ (dotimes (i (length value)) (print-json-simple (aref value i)))))
+ (null
+ (princ "null"))
+ (list
+ (print-json-map
+ (dolist (i value)
+ (print-json-mapping (car i)
+ (print-json-simple (cdr i))))))
+ (hash-table
+ (print-json-map
+ (maphash (lambda (k v)
+ (print-json-mapping k
+ (print-json-simple v)))
+ value)))
(t
(print-json-itemstart)
(etypecase value
(defvar *progname*
#.(or *compile-file-pathname* *load-pathname*))
-(let ((pkg (make-package "ANSIBLE-INVENTORY-USER"
- :use '("CL" "ANSIBLE-INVENTORY")))
- (args *arguments*))
+(defvar *user-package*
+ (make-package "ANSIBLE-INVENTORY-USER"
+ :use '("CL" "ANSIBLE-INVENTORY")))
+
+(defun load-input (file)
+ (let ((*package* *user-package*))
+ (load file :verbose nil)))
+
+(defun parse-command-line (args)
(loop (let* ((arg (pop args))
(len (length arg)))
(cond ((string= arg "--") (return))
(args
(pop args))
(t
- (error "missing argument"))))))
- (case (char arg i)
- (#\h (format t "usage: ~A FILE ...~%"
- (pathname-name *progname*)))
- (t (error "unknown option `-~A'" (char arg i))))))
+ (error "missing argument")))))
+ (case (char arg i)
+ (#\h (format t "usage: ~A FILE ...~%"
+ (pathname-name *progname*)))
+ (t (error "unknown option `-~A'" (char arg i)))))))
(t (push arg args) (return)))))
- (format t ";; remaining args = ~S~%" args)
- (dolist (arg args)
- (let ((*package* pkg))
- (load arg :verbose nil))))
+ (mapc #'load-input args))
;;;--------------------------------------------------------------------------
;;; Run the hooks.
-(setf *hostproc-hooks* (sort *hostproc-hooks* #'< :key #'hook-entry-prio))
-(mapc (compose #'hook-entry-func #'funcall) *hostproc-hooks*)
+(defun run-hooks ()
+ (setf *hostproc-hooks* (sort *hostproc-hooks* #'< :key #'hook-entry-prio))
+ (mapc (compose #'hook-entry-func #'funcall) *hostproc-hooks*))
;;;--------------------------------------------------------------------------
;;; Output the definitions.
-(setf *print-right-margin* 77)
-(print-json
- (print-json-map
- (print-json-mapping "all"
- (print-json-list (maphosts #'print-json-simple)))
- (dolist (assoc *groups*)
- (print-json-mapping (car assoc)
- (print-json-list
- (mapc #'print-json-simple (cdr assoc)))))
- (print-json-mapping "_meta"
+(defun output ()
+ (let ((*print-right-margin* 77))
+ (print-json
(print-json-map
- (print-json-mapping "hostvars"
+ (print-json-mapping "all"
+ (print-json-list (maphosts #'print-json-simple)))
+ (dolist (assoc *groups*)
+ (print-json-mapping (car assoc)
+ (print-json-list
+ (mapc #'print-json-simple (cdr assoc)))))
+ (print-json-mapping "_meta"
(print-json-map
- (maphash (lambda (host plist)
- (print-json-mapping host
- (print-json-map
- (do ((plist plist (cddr plist)))
- ((endp plist))
- (print-json-mapping (car plist)
- (print-json-simple (cadr plist)))))))
- *hosts*)))))))
+ (print-json-mapping "hostvars"
+ (print-json-map
+ (maphash (lambda (host plist)
+ (print-json-mapping host
+ (print-json-map
+ (do ((plist plist (cddr plist)))
+ ((endp plist))
+ (print-json-mapping (car plist)
+ (print-json-simple (cadr plist)))))))
+ *hosts*)))))))))
+
+;;;--------------------------------------------------------------------------
+;;; Main program.
+
+#+cl-launch
+(progn
+ (parse-command-line cl-launch:*arguments*)
+ (run-hooks)
+ (output))
;;;----- That's all, folks --------------------------------------------------