From 128ddab7653fbeee295058a5aa87e9b44db00c7d Mon Sep 17 00:00:00 2001 From: Christopher Hall Date: Wed, 22 Aug 2012 16:07:37 +0800 Subject: [PATCH] [scripts] use cl-json Signed-off-by: Christopher Hall --- scripts/GenerateIndex | 139 +++++++++++++----------------------------- 1 file changed, 42 insertions(+), 97 deletions(-) diff --git a/scripts/GenerateIndex b/scripts/GenerateIndex index 7c5294ac2..c462f3cc3 100755 --- a/scripts/GenerateIndex +++ b/scripts/GenerateIndex @@ -23,9 +23,14 @@ exec sbcl --script "$0" "$0" "$@" ;;; You should have received a copy of the GNU General Public License ;;; along with this program. If not, see . +(load (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname))) + (require 'asdf) (require 'getopt) (require 'md5) +(require 'cl-json) + (defvar *program* (second sb-ext:*posix-argv*) "name of this script file") (defvar *debug* nil "set true for debug output") @@ -200,109 +205,52 @@ exec sbcl --script "$0" "$0" "$@" collect (append (identify k) (list v))))) -(defvar *xml-indent* 0 "for indenting the XML output") -(defvar *xml-stack* nil "for xml-close to match the tags") -(defvar *xml-stream* t "current xml output stream") - -(defun xml-set-stream (out-stream) - "set the xml output stream" - (if out-stream - (setq *xml-stream* out-stream) - (setq *xml-stream* t))) ;; sets output to stdout - -(defun xml-current-indent () - "a number of spaces corresponding to *xml-indent*" - (make-string *xml-indent* :initial-element #\Space)) - - -(defun xml-string-of (item) - "return string of item, but downcase symbols" - (if (symbolp item) - (string-downcase item) - (format nil "~a" item))) - - -(defun xml-attribute-string (attributes) - "convert: ((key value)...) to string form: key=''value''..." - (loop for attr in attributes - append (list (format nil " ~a=\"~a\"" - (xml-string-of (first attr)) - (xml-string-of (second attr)))) - into attr-list - finally - (return (apply #'concatenate 'string attr-list)))) - - -(defun xml-entry (tag data &rest attributes) - "display a single line XML entry" - (format *xml-stream* "~a<~a~a>~a~%" (xml-current-indent) - (xml-string-of tag) - (xml-attribute-string attributes) - data - (xml-string-of tag))) - - -(defun xml-open (tag &rest attributes) - "start the XML tag" - (format *xml-stream* "~a<~a~a>~%" (xml-current-indent) (xml-string-of tag) (xml-attribute-string attributes)) - (setq *xml-indent* (+ *xml-indent* 2)) - (push (xml-string-of tag) *xml-stack*)) - - -(defun xml-close () - "close the most recently opened tag" - (when *xml-stack* - (setq *xml-indent* (- *xml-indent* 2)) - (format *xml-stream* "~a~%" (xml-current-indent) (pop *xml-stack*)))) - - -(defun output-archive (file-list uncompressed-size) - "output xml for a single archive ((file size MD5)...)" - (xml-open 'archives (list 'count (length file-list)) (list 'size uncompressed-size)) - (loop - for count = 1 then (1+ count) - for item in file-list - do - (xml-entry 'file (concatenate 'string (first item)"?torrent") - (list 'id count) (list 'size (second item)) (list 'md5 (third item)))) - (xml-close)) - - (defun output-volumes (structure &key base) "output the volume list" (loop for item in structure - with count = 0 when (eq base (string= (first item) ".")) - do - (incf count) - (xml-open 'volume (list 'id count)) + collect (let* ((lang (third item)) (id (first lang)) (english (second lang)) - (native (third lang))) - (xml-entry 'language native (list 'id id) (list 'name english))) - (xml-entry 'name (second (fourth item))) - (xml-entry 'date (second item)) - (xml-entry 'folder (first item)) - (let* ((a (fifth item)) + (native (third lang)) + (name (second (fourth item))) + (date (second item)) + (folder (first item)) + (a (fifth item)) (uncompressed-size (first a)) (archives (rest a))) - (output-archive archives uncompressed-size)) - (xml-close))) - - -(defun output-structure (dir-name structure) - "output the XML structure" - (xml-open 'release) - (xml-entry 'version (file-namestring dir-name)) - (xml-open 'compatibility '(select single)) - (output-volumes structure :base t) - (xml-close) - (xml-open 'documents '(select multiple)) - (output-volumes structure) - (xml-close) - (xml-close)) + (list + (cons 'id id) + (cons 'english english) + (cons 'native native) + (cons 'name name) + (cons 'date date) + (cons 'folder folder) + (cons 'size uncompressed-size) + (cons 'files (map 'list #'make-file-item archives)))))) + + +(defun make-file-item (file) + "create a file object" + (let* ((name (first file)) + (size (second file)) + (md5 (third file))) + (list + (cons 'name name) + (cons 'size size) + (cons 'md5 md5)))) + + +(defun output-structure (stream dir-name structure) + "output the JSON structure" + (let ((bases (output-volumes structure :base t)) + (volumes (output-volumes structure)) + (table (make-hash-table :test #'equal))) + (setf (gethash 'bases table) bases) + (setf (gethash 'volumes table) volumes) + (json:encode-json table stream))) (defun main (args) @@ -337,14 +285,11 @@ exec sbcl --script "$0" "$0" "$@" (load-languages languages) (with-open-file (out-stream index :direction :output :if-exists :supersede :if-does-not-exist :create) - (xml-set-stream out-stream) - ;;(xml-set-stream t) (loop for dir in (sort directories #'string<) do (when *verbose* (format t "Directory: ~a~%" dir)) - (output-structure dir (partition-files dir (list-of-files dir)))) - (xml-set-stream nil))))) + (output-structure out-stream dir (partition-files dir (list-of-files dir)))))))) ;;; run the main program