From f6ec3665ae2c99dc0b09da065313a9e57d22b414 Mon Sep 17 00:00:00 2001 From: djcb Date: Tue, 18 Sep 2012 21:24:45 +0300 Subject: [PATCH] * some improvements for mu-sexp-convert (output should now pass xmllint, json_verify) --- contrib/mu-sexp-convert | 115 +++++++++++++++++++++++++++------------- 1 file changed, 79 insertions(+), 36 deletions(-) diff --git a/contrib/mu-sexp-convert b/contrib/mu-sexp-convert index 2e5333d0..f633b1b3 100755 --- a/contrib/mu-sexp-convert +++ b/contrib/mu-sexp-convert @@ -19,7 +19,14 @@ exec guile -e main -s $0 $@ ;; along with this program; if not, write to the Free Software Foundation, ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -(use-modules (ice-9 getopt-long) (ice-9 format)) +;; +;; a little hack to convert the output of +;; mu find --format=sexp +;; and +;; mu view --format=sexp +;; into XML or JSON + +(use-modules (ice-9 getopt-long) (ice-9 format) (ice-9 regex)) (use-modules (sxml simple)) (define (mapconcat func lst sepa) @@ -57,14 +64,35 @@ into a list of pairs (define (string->xml str) "XML-encode STR." + ;; sneakily re-using sxml->xml (call-with-output-string (lambda (port) (sxml->xml str port)))) +(define (string->json str) + "Convert string into a JSON-encoded string." + (letrec ((convert + (lambda (lst) + (if (null? lst) + "" + (string-append + (cond + ((equal? (car lst) #\") "\\\"") + ((equal? (car lst) #\\) "\\\\") + ((equal? (car lst) #\/) "\\/") + ((equal? (car lst) #\bs) "\\b") + ((equal? (car lst) #\ff) "\\f") + ((equal? (car lst) #\lf) "\\n") + ((equal? (car lst) #\cr) "\\r") + ((equal? (car lst) #\ht) "\\t") + (#t (string (car lst)))) + (convert (cdr lst))))))) + (convert (string->list str)))) + (define (etime->time_t t) "Convert elisp time object T into a time_t value." (logior (ash (car t) 16) (car t))) -(define (output-xml) - "Convert string INPUT to XML and print on stdout." +(define (sexp->xml) + "Convert string INPUT to XML, return the XML (string)." (letrec ((convert-xml (lambda* (expr #:optional parent) (cond @@ -78,37 +106,43 @@ into a list of pairs (cond ((member parent '("from" "to" "cc" "bcc")) (mapconcat (lambda (addr) - (format #f "
~a~a" + (format #f "
~a~a
" (if (string? (car addr)) - (format #f "~a" (string->xml (car addr))) "") + (format #f "~a" + (string->xml (car addr))) "") (if (string? (cdr addr)) - (format #f "~a" (string->xml (cdr addr))) ""))) + (format #f "~a" + (string->xml (cdr addr))) ""))) expr " ")) ((string= parent "parts") "") ;; for now, ignore ;; convert the crazy emacs time thingy to time_t... ((string= parent "date") (format #f "~a" (etime->time_t expr))) - ((string= parent "flags") - (mapconcat (lambda (flag) (format #f "~a" flag)) expr "")))) - ((or (string? expr) (symbol? expr)) (string->xml expr)) + (#t + (mapconcat + (lambda (elm) (format #f "~a" (convert-xml elm))) expr "")))) + ((string? expr) (string->xml expr)) + ((symbol? expr) (format #f "~a" expr)) ((number? expr) (number->string expr)) - (#t "."))))) - (let ((expr (read))) - (if (not (eof-object? expr)) - (begin - (format #t "\n~a\n" (convert-xml expr)) - (output-xml)))))) + (#t ".")))) + (msg->xml + (lambda () + (let ((expr (read))) + (if (not (eof-object? expr)) + (string-append (format #f "\n~a\n" (convert-xml expr)) (msg->xml)) + ""))))) + (format #f "\n\n~a" (msg->xml)))) -(define (output-json) - "Convert string INPUT to JSON and print on stdout." +(define (sexp->json) + "Convert string INPUT to JSON, return the JSON (string)." (letrec ((convert-json (lambda* (expr #:optional parent) (cond ((property-list? expr) (mapconcat (lambda (pair) - (format #f "\n\t\"~a\":~a" - (car pair) (convert-json (cdr pair) (car pair)))) + (format #f "\n\t\"~a\": ~a" + (car pair) (convert-json (cdr pair) (car pair)))) (plist->pairs expr) ", ")) ((list? expr) (cond @@ -117,27 +151,36 @@ into a list of pairs (mapconcat (lambda (addr) (format #f "{~a~a}" (if (string? (car addr)) - (format #f "\"name\":\"~a\"," (string->xml (car addr))) "") + (format #f "\"name\": \"~a\"," + (string->json (car addr))) "") (if (string? (cdr addr)) - (format #f "\"email\":\"~a\"" (string->xml (cdr addr))) ""))) + (format #f "\"email\": \"~a\"" + (string->json (cdr addr))) ""))) expr " ") "]")) - ((string= parent "parts") "[]") ;; for now, ignore + ((string= parent "parts") "[]") ;; todo ;; convert the crazy emacs time thingy to time_t... - ((string= parent "date") (format #f "~a" (format #f "~a" (etime->time_t expr)))) - ((string= parent "flags") + ((string= parent "date") + (format #f "~a" (format #f "~a" (etime->time_t expr)))) + (#t (string-append "[" - (mapconcat (lambda (flag) (format #f "\"flag\":\"~a\"" flag)) expr ", ") - "]")))) - ((or (string? expr) (symbol? expr)) (format #f "\"~a\"" (string->xml expr))) + (mapconcat (lambda (elm) (format #f "~a" (convert-json elm))) expr ",") "]")))) + ((string? expr) + (format #f "\"~a\"" (string->json expr))) + ((symbol? expr) + (format #f "\"~a\"" expr)) ((number? expr) (number->string expr)) - (#t "."))))) - (let ((expr (read))) - (if (not (eof-object? expr)) - (begin - (format #t "{~a\n},\n" (convert-json expr)) - (output-json)))))) - + (#t ".")))) + (msg->json + (lambda (first) + (let ((expr (read))) + (if (not (eof-object? expr)) + (string-append (format #f "~a{~a\n}" + (if first "" ",\n") + (convert-json expr)) (msg->json #f)) + ""))))) + (format #f "[\n~a\n]" (msg->json #t)))) + (define (main args) (let* ((optionspec '((format (value #t)))) (options (getopt-long args optionspec)) @@ -149,9 +192,9 @@ into a list of pairs (begin (display msg) (exit 1))))) (cond ((string= outformat "xml") - (output-xml)) + (format #t "~a\n" (sexp->xml))) ((string= outformat "json") - (output-json)) + (format #t "~a\n" (sexp->json))) (#t (begin (display msg) (exit 1))))))