implement logging in the views
Sun Jun 22 11:25:32 PDT 2008 Ryszard Szopa <ryszard.szopa@gmail.com>
* implement logging in the views
diff -rN -u old-cl-couch/view-server/functions.lisp new-cl-couch/view-server/functions.lisp
--- old-cl-couch/view-server/functions.lisp 2014-07-28 17:35:25.000000000 -0700
+++ new-cl-couch/view-server/functions.lisp 2014-07-28 17:35:25.000000000 -0700
@@ -1,9 +1,13 @@
(in-package :cl-couchdb-view-server)
-(export '(emit is))
+(export '(emit is logit))
(defvar *map-doc-results* nil)
+
(defvar *in-couch-server* nil)
+
+(defvar *log-stream* nil)
+
;;; Functions to be used in views
(defun emit (key value)
@@ -17,6 +21,20 @@
lisp->json->lisp translation confusions."
(string= (symbol-name type) (@ doc :type)))
+(defun logit (format-string &rest args)
+ "Format `args' using `format-string' to CouchDB's log file. In the
+JS view-server this function's name is `log'. If called outside a
+view, print what would be sent to CouchDB to `*standard-output*'"
+ (let ((stream (or *log-stream* t))
+ (log-body (handler-case (apply #'format nil format-string args)
+ (error (err)
+ (format nil "~s" err)))))
+ (json-stream (list (cons :log log-body)) stream)
+ (terpri stream)
+ (force-output stream)))
+
+
+
;; Copyright (C) 2008
;; Ryszard Szopa <ryszard.szopa@gmail.com>
diff -rN -u old-cl-couch/view-server/server.lisp new-cl-couch/view-server/server.lisp
--- old-cl-couch/view-server/server.lisp 2014-07-28 17:35:25.000000000 -0700
+++ new-cl-couch/view-server/server.lisp 2014-07-28 17:35:25.000000000 -0700
@@ -107,16 +107,17 @@
(format-log "CouchDB says: ~s" line)
(when (string= line "")
(return))
- (destructuring-bind (head &rest rest) (dejson line)
- (json-stream (cond
- ((string= head "reset") (reset))
- ((string= head "add_fun") (apply #'add-fun rest))
- ((string= head "map_doc") (apply #'map-doc rest))
- ((string= head "reduce") (apply #'reduce* rest))
- ((string= head "rereduce") (apply #'rereduce rest))
- (t (error "Unrecognized message: ~s ~s" head rest))) stream)
- (terpri stream)
- (force-output stream))))
+ (let ((*log-stream* stream))
+ (destructuring-bind (head &rest rest) (dejson line)
+ (json-stream (cond
+ ((string= head "reset") (reset))
+ ((string= head "add_fun") (apply #'add-fun rest))
+ ((string= head "map_doc") (apply #'map-doc rest))
+ ((string= head "reduce") (apply #'reduce* rest))
+ ((string= head "rereduce") (apply #'rereduce rest))
+ (t (error "Unrecognized message: ~s ~s" head rest))) stream)
+ (terpri stream)
+ (force-output stream)))))
(end-of-file ()
nil)))))