;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; log4scm
;;;
;;; Author            : Hans Oesterholt-Dijkema
;;; License           : LGPL
;;; Short Description : This module provides a logging facility for mzscheme.
;;;
;;; $Id: log4scm.scm,v 1.25 2007/04/18 18:37:21 HansOesterholt Exp $
;;;
;;; $Log: log4scm.scm,v $
;;; Revision 1.25  2007/04/18 18:37:21  HansOesterholt
;;; *** empty log message ***
;;;
;;; Revision 1.24  2006/01/12 00:50:28  HansOesterholt
;;; Small change to adjust for planet package datastructs
;;;
;;; Revision 1.23  2006/01/05 20:30:38  HansOesterholt
;;; Adaptation to planet requires
;;;
;;; Revision 1.22  2005/11/22 19:53:02  HansOesterholt
;;; no message
;;;
;;; Revision 1.21  2005/11/13 20:02:18  HansOesterholt
;;; -- Small things
;;;
;;; Revision 1.20  2005/11/13 19:44:11  HansOesterholt
;;; - Bug fixing.
;;; - Making things more consistent.
;;; - Adding the log4scm-viewer application
;;; - Making things start as a real windows application.
;;;
;;; Revision 1.19  2005/11/13 16:41:31  HansOesterholt
;;; Some minor bug fixing.
;;;
;;; Revision 1.18  2005/11/13 16:12:15  HansOesterholt
;;; Changed log4scm to use log4scm-cfg instead
;;; of it's own functions.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module log4scm mzscheme
	(require (planet "fifo.scm" ("oesterholt" "datastructs.plt" 1 0)))
	(require (lib "file.ss" "mzlib"))
	(require (lib "time.ss" "srfi" "19"))
	(require (planet "sutil.scm" ("oesterholt" "ho-utils.plt" 1 0)))
	(require (planet "scfg.scm" ("oesterholt" "ho-utils.plt" 1 0)))
	(require "log4scm-cfg.scm")
	
	(provide ;; starting/stopping the logger for a thread
	         log-start
		 log-stop
		 log-sync
		 ;; notify functions
		 log-fatal-notify
		 ;; log functions
		 log-debug
		 log-info
		 log-warn
		 log-warning
		 log-error
		 log-fatal
		 ;; configuration options
		 log-level
		 log-keep-days
		 log-mode)


(define (unlink f)
  (with-handlers ((exn:fail:filesystem? (lambda (exn) 
					  (log-warning "log4scm: cannot remove log file " f)
					  'try-next-time)))
		 (delete-directory/files f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;=head1 Log4SCM
;;;
;;;With Log4SCM scheme programs can log messages to log files.
;;;
;;;=head2 Background
;;;
;;;This implementation of logging is a derivative of a C log server
;;;that has been written to provide high speed logging possibilities
;;;in a production messaging environment.
;;;
;;;=head3 A description of the log server
;;;
;;;A number of (different) programs can
;;;log to a central log server, using SYSV IPC message queuing.
;;;Each program can log to a logical log name, for which the log
;;;server has a configuration.
;;;
;;;The log server processes all messages from the IPC queue and
;;;multiplexes them to various log files. By making the log process
;;;asynchronous, queueing up messages, the logging process by clients
;;;performs very well, while the log server may be processing messages
;;;at a lower rate.
;;;
;;;Not only does the log server provide an asynchronous logging facility,
;;;it also provides logging by day and purging of expired log files.
;;;Log files are created for each day. Each log file having an extension
;;;in the form of C<CCYYMMDD>. On a per logical log id basis, the number
;;;of days that logs need to be preserved can be set.
;;;
;;;The log server in this production environment knows of 5 levels
;;;of messages:
;;;
;;;=over 1
;;;
;;;=item debug
;;;
;;;Log level 'debug' is used for programm debugging purposes. Logging
;;;for this level  can be turned on and off. Client programs read a
;;;flag about this, from shared memory. If the 'debug' level is
;;;turned off, clients won't log the message.
;;;
;;;=item info
;;;
;;;Log level 'info' is used for information about steps that a program
;;;takes to do a specific task. Logging for this level can also be turned
;;;on and off.
;;;
;;;=item warn
;;;
;;;Log level 'warn' is used for warnings about the processing that a
;;;program does. A warning may eventually turn into an error if the
;;;warning persists, or even result in a fatal situation. Logging
;;;for this level can also be turned on and off.
;;;
;;;=item error
;;;
;;;Log level 'error' is used for errors that occur during program
;;;execution. Errors are severe for a  program or module itself,
;;;but not for an entire system, application or service. They do not threaten
;;;the execution of the whole.
;;;
;;;=item fatal
;;;
;;;Log level 'fatal' is used for fatal errors. Fatal errors are errors
;;;that prevent the working of an entire system, application or service.
;;;
;;;=back
;;;
;;;Usually monitoring tools monitor log files for messages marked 'fatal'.
;;;When a 'fatal' message occures, a signal is given to enterprise wide
;;;monitoring tools like HP Openview or Tivoli.
;;;
;;;=head2 Log 4 Scheme features
;;;
;;;Log4SCM is in a way a simplified implementation of the previously mentioned
;;;log server. It doesn't do IPC and doesn't provide log functionality
;;;for multiple running programs, multiplexing to multiple log files.
;;;
;;;What it does provide is an asynchronous logging functionality that
;;;can be used in scheme programs. This log facility runs in a separate
;;;thread. Communication between the main thread and the log facility
;;;is done using a fifo.
;;;
;;;The levels of logging are the same as mentioned in the previous section;
;;;debug, info, warn, error and fatal are provided.
;;;
;;;In this implementation,
;;;a callback function can be attached to the log server for fatal messages.
;;;This enables the program to do e.g. some cleanup, displaying a messagebox,
;;;handling bug exchange information, checking  for program version updates,
;;;etc. on a fatal error. Handling of fatal messages is therefore synchronous.
;;;
;;;Instead of using IPC shared memory to communicate a flag that
;;;indicates if to log 'debug', 'info' and 'warn'
;;;levels to the 'logging client threads' an other implementation is made:
;;;When setting the log level for a
;;;thread, the log functions associated with the levels for which no logging 
;;;is necessary, will be replaced by noop functions.
;;;
;;;A noop function will return C<'not-logged>. A normal log function returns C<'logged>.
;;;
;;;There are two logging modes. The C<'reference> mode is faster, but if the logged
;;;message contains mutable data, like e.g. the elements of a list that can be
;;;changed using set-car! or set-cdr!, there's a good change (especially when using
;;;log-debug), that the contents of message have changed before they have been written
;;;to the log file. Especially when debugging, it's probably best to change the log
;;;mode to C<'copy>, which makes the log function copy the contents of the message
;;;to a string before handing them to the logging fifo. The log mode defaults to C<'reference>.
;;;
;;;Configuration is done on a per log file basis, not for all log files
;;;together. XML is used for log file behaviour configuration. API Functions
;;;are provided to update the configuration.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;=head2 Implementation
;;;
;;;=head3 Prerequisites
;;;
;;;This module requires C<L<SXML, SSAX|http://ssax.sf.net>>,
;;;C<L<datastructs|http://www.elemental-programming.org/epwiki/scheme%20datastructures>>,
;;;C<file.ss> from C<mzlib> and C<srfi 19>, both provided with mzscheme.
;;;
;;;=head3 Variables
;;;
;;;=verbatim scm,8
(define-syntax thrcell-ref 
  (syntax-rules ()
    ((_ a)
     a)))

(define-syntax thrcell-set!
  (syntax-rules ()
    ((_ a b)
     (set! a b))))

(define-syntax make-thrcell
  (syntax-rules ()
    ((_ a b)
     a)))
					;Log datastructures are thread specific
					;Using thrcells, we can get "child"
					;threads to share the same datastructures
(define log-fh      (make-thrcell #f #t))
(define log-name    (make-thrcell #f #t))
(define log-cfg     (make-thrcell #f #t))
(define log-lvl     (make-thrcell 'warn #t))
(define log-keep    (make-thrcell 7 #t))
(define log-mymode  (make-thrcell 'reference #t))
(define log-fifo    (make-thrcell #f #t))
(define log-dt      (make-thrcell #f #t))
(define log-thread  (make-thrcell #f #t))
(define  cfg-refresh-thread (make-thrcell #f #t))
(define log-notify  (make-thrcell (lambda args #f) #t))

					;Proxy functions
(define (log-none . msg) 'not-logged)
(define log-internal-debug (make-thrcell log-none #t))
(define log-internal-info  (make-thrcell log-none #t))
(define log-internal-warn  (make-thrcell log-none #t))
(define log-internal-error (make-thrcell log-none #t))
(define log-internal-fatal (make-thrcell log-none #t))
;;;=verbatim
;;;
;;;=verbatim
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;=head3 Reading in (and writing out) the configuration
;;;
;;;=verbatim scm,8
					;Internal functions for the configuration file
(define (read-log-config filename-prefix)
  (let* ((filename (string-append filename-prefix ".scfg")))
    (let ((cfg (log4scm-cfg filename)))
      (thrcell-set! log-keep   (-> cfg keep))
      (thrcell-set! log-lvl    (-> cfg level))
      (thrcell-set! log-mymode (-> cfg mode))
      (thrcell-set! log-cfg    cfg))))
  
(define (write-log-config filename-prefix)
  (let* ((filename (string-append filename-prefix ".scfg"))
	 (cfg      (thrcell-ref log-cfg)))
    (if cfg
	(begin
	  (-> cfg keep (thrcell-ref log-keep))
	  (-> cfg level (thrcell-ref log-lvl))
	  (-> cfg mode (thrcell-ref log-mymode))
	  (-> cfg commit filename)))))
;;;=verbatim
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;=head3 Opening and rotating a log file
;;;
;;;The functions here are used to open, close and rotate (cq. expire) log files.
;;;These functions are used when starting a log thread and when the date of log
;;;messages change. C<basedir> and <basename> are used to get the directory or
;;;file component of a full path.
;;;
;;;=verbatim scm,8

					;Rotating and opening a log file
(define (open-new-or-existing-log-and-rotate-logs filename-prefix)
  (let* ((fn-prefix (basename filename-prefix))
	 (fn-len    (string-length fn-prefix))
	 (dt (current-time))
	 (ext (string-append filename-prefix 
			     "." 
			     (date->string (time-utc->date dt) "~Y-~m-~d"))))

					;First open log for appending
    (let ((fh (open-output-file ext 'append)))
      (thrcell-set! log-fh fh))
					;And set the current date
    (thrcell-set! log-dt (time-utc->date dt))

					;Next expire logs
    (let* ((odt (subtract-duration dt (make-time 'time-duration 0 
						 (* (thrcell-ref log-keep) 24 3600))))
	   (oext (string-append filename-prefix 
				"." 
				(date->string (time-utc->date odt) "~Y-~m-~d"))))

      (for-each (lambda (filename)
		  (unlink filename)
		  )

		(let ((files (filter 
			      (lambda (filename)
				(string<? (basename filename) oext))
			      (glob (string-append filename-prefix ".*")))))
		  (if (eq? files #f)
		      (list)
		      files))))
    ))

					;Closing a log file
(define (close-log)
  (close-output-port (thrcell-ref log-fh)))

;;;=verbatim
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;=head3 log functions
;;;
;;;These functions provide the actual log functions, that
;;;the 'internal' log function thrcells point to.
;;;
;;;Note that these functions pass the given C<msg> message
;;;through to the C<log-fifo>, without copying internal
;;;references etc. This can result in unexpected behaviour,
;;;because the logger thread works asynchronously, and normally
;;;slower, because it writes to a file,  from the logging
;;;thread. Modifying the data given to <msg>, will probably
;;;change the messages waiting to be logged.
;;;
;;;E.g.:
;;;
;;; (define a (list 2 3))
;;; (log-info a)
;;; (set-car! a 8)
;;;
;;;May result in "(8 3)" being written to the log file.
;;;
;;;=verbatim scm,8

;(define (displayp . args)
;  (display args)(newline))

(define (copy-args arglist)
  (let ((s (open-output-string)))
    (for-each (lambda (arg) 
		(display arg s))
	      arglist)
    (let ((str (get-output-string s)))
      (close-output-port s)
      str)))
					;log functions
(define-syntax def-logger
  (syntax-rules ()
    ((_ name level)
     (define (name . msg)
;       (displayp level " - " msg)
       (fifo+ (thrcell-ref log-fifo)
	      (cons level (cons (current-date) 
				 (if (eq? (thrcell-ref log-mymode) 'copy)
				     (list (list (copy-args (car msg))))
				     msg))))
       'logged))))

(def-logger my-debug 'debug)
(def-logger my-info  'info)
(def-logger my-warn  'warning)
(def-logger my-error 'error)

(define (my-fatal sem . msg)
  (fifo+ (thrcell-ref log-fifo)
	 (cons 'fatal (cons (current-date) (cons sem msg))))
  'logged)

;;;=verbatim
;;;
;;;Using the C<set-log-functions> function, the thread cells
;;;for the log functions are modified. For log level 'error and
;;;above, 'log-internal-[debug,info,warn]' are set to 'log-none'.
;;;
;;;=verbatim scm,8
					;setting used log-functions
(define (set-log-functions level)

  (define (ord level)
    (cond
     ((eq? level 'debug) 0)
     ((eq? level 'info)  1)
     ((eq? level 'warn)  2)
     ((eq? level 'error) 3)
     (else 4)))

  (let ((lvl (ord level)))
    (if (<= lvl 0)
	(thrcell-set! log-internal-debug my-debug) 
	(thrcell-set! log-internal-debug log-none))
    (if (<= lvl 1)
	(thrcell-set! log-internal-info my-info)
	(thrcell-set! log-internal-info log-none))
    (if (<= lvl 2)
	(thrcell-set! log-internal-warn my-warn)
	(thrcell-set! log-internal-warn log-none))
    (thrcell-set! log-internal-error my-error)
    (thrcell-set! log-internal-fatal my-fatal)))
;;;=verbatim
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;=head3 The logger
;;;
;;;The logger function is the worker function of the log thread.
;;;This function puts all provided messages on the current log-file.
;;;It reads log requests or commands from a fifo. The C<'stop-logging>
;;;command is used to stop the logger. The C<'log-fatal-notify> command
;;;is used to change the notify function (callback function) for this
;;;log facility. It is communicated over the fifo to the logger, because
;;;setting it directly would pose problems as can be seen from the image
;;;below.
;;;
;;;=image Threads and callbacks,/images/logger.png,/images/logger.png,png,center
;;;
;;;Suppose in this image, child thread 2 wants to update the callback function
;;;for the fatal level notifyer. If it updates it's own callback function**
;;;variable, the logger thread won't notice, because variables are local
;;;to threads. If the notifyer function variable would be made shared for
;;;all threads, only one callback function could be installed for all threads.
;;;
;;;So it is made sure, that the new callback function is (asynchronously)
;;;communicated over the fifo to the logger thread. The logger thread stores
;;;the function in it's local notifyer variable.
;;;
;;;If a message with a fatal level is read from the fifo, the callback function
;;;is called. A call to the C<log-fatal> function is I<synchronous>. If a lot
;;;of messages have been logged, it can take a while for the callback function
;;;to be called and for the log-fatal function to end.
;;;
;;;=verbatim scm,8
					;logger
(define (logger)

  (define (log-entry dt level msgs)
    (define (log msgs)
      (if (null? msgs)
	  (begin
	    (newline (thrcell-ref log-fh))
	    (flush-output (thrcell-ref log-fh)))
	  (begin
	    (display (car msgs) (thrcell-ref log-fh))
	    (log (cdr msgs)))))

    (begin
      ;; TODO: seek to the end of the file (concurrent access, and flush)
      (log (cons dt (cons " " (cons level  msgs))))))

  (define (fillout lvl len)
    (let ((l (symbol->string lvl)))
      (string-append l (make-string (- len (string-length l)) #\space))))

  (define (log-fatal-notify? obj)
    (if (list? obj)
	(if (null? obj)
	    #f
	    (eq? (car obj) 'log-fatal-notify))
	#f))

  (define (do-log)
    (let ((entry (fifo- (thrcell-ref log-fifo))))
      (if (eq? entry 'stop-logging)
	  #t
	  (if (eq? entry 'refresh-configuration)
	      (begin
		(read-log-config (thrcell-ref log-name))
		(set-log-functions (thrcell-ref log-lvl))
		(do-log))
	      (begin
		(if (log-fatal-notify? entry)
		    (let ((proc (cadr entry)))
		      (log-info 'log-fatal-notify " request, proc: " proc)
		      (thrcell-set! log-notify proc))
		    (begin
		      (let* ((lvl (car entry))
			     (dt (cadr entry))
			     (sem (if (eq? lvl 'fatal) 
				      (caddr entry)
				      #f))
			     (msgs (if (eq? lvl 'fatal)
				       (cadddr entry)
				       (caddr entry)))
			     (mdt (thrcell-ref log-dt)))
			(if (not (and (= (srfi:date-day dt) (srfi:date-day mdt))
				      (= (srfi:date-month dt) (srfi:date-month mdt))
				      (= (srfi:date-year dt) (srfi:date-year mdt))))
			    (begin
			      (close-log)
			      (open-new-or-existing-log-and-rotate-logs (thrcell-ref log-name))))
			(log-entry (date->string dt "~Y-~m-~dT~H:~M:~S~z") (fillout lvl 8) msgs)
			(if (eq? lvl 'fatal)
			    (begin
			      ((thrcell-ref log-notify) dt msgs)
			      (sem))))))
					;tail recursive call...
		(do-log))))))
    
    (do-log))

(define (config-file-refresh)
  (sleep 2)
  (fifo+ (thrcell-ref log-fifo) 'refresh-configuration)
  (config-file-refresh))

;;;=verbatim
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;=head2 The Log4SCM API
;;;
;;;=head3 Synopsys
;;;
;;;The following sample code is illustrative for using log4scm
;;;with multiple threads.
;;;
;;; (require "log4scm.scm")
;;;
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; (define (next-level level)
;;;   (cond
;;;    ((eq? level 'debug) 'info)
;;;    ((eq? level 'info) 'warn)
;;;    ((eq? level 'warn) 'error)
;;;    ((eq? level 'error) 'fatal)
;;;    ((eq? level 'fatal) 'debug)))
;;;
;;; (define (do-log level . msg)
;;;   (cond
;;;    ((eq? level 'debug) (log-debug msg))
;;;    ((eq? level 'info) (log-info msg))
;;;    ((eq? level 'warn) (log-warn msg))
;;;    ((eq? level 'error) (log-error msg))
;;;    ((eq? level 'fatal) (log-fatal msg))))
;;;
;;;
;;; (define-syntax counter
;;;   (syntax-rules ()
;;;     ((_ inc-op get-op name)
;;;      (begin
;;;        (define name (let ((cnt 0))
;;; 		      (lambda (op)
;;; 			(cond
;;; 			 ((eq? op 'inc)
;;; 			  (begin
;;; 			    (set! cnt (+ cnt 1))))
;;; 			 ((eq? op 'get)
;;; 			  (begin
;;; 			    (let ((v cnt))
;;; 			      cnt)))))))
;;;        (define (inc-op) (name 'inc))
;;;        (define (get-op) (name 'get))))))
;;;
;;; (counter inc-tt1 get-tt1 TT1)
;;; (counter inc-tt2 get-tt2 TT2)
;;;
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; (define (test2 n level)
;;;
;;;   (define (t2 n level)
;;;     (if (> n 0)
;;; 	(begin
;;; 	  (do-log level "T2" n " fatal: " (get-tt2))
;;; 	  (t2 (- n 1) (next-level level)))
;;; 	#t))
;;;
;;;   (log-start "test2")
;;;   (log-level (next-level level))
;;;   (log-fatal-notify (lambda (dt msgs) (inc-tt2)))
;;;   (t2 n level)
;;;   (log-stop))
;;;  
;;;    
;;; (define (test1 n level)
;;;
;;;   (define (t1 n level)
;;;     (if (> n 0)
;;; 	(begin
;;; 	  (do-log level "T1" n " fatal: " (get-tt1))
;;; 	  (t1 (- n 1) (next-level level)))
;;; 	#t))
;;;
;;;   (log-start "test1")
;;;   (log-level (next-level level))
;;;   (log-fatal-notify (lambda (dt msgs) (inc-tt1)))
;;;   (thread (lambda () (test2 (* n 2) (next-level level))))
;;;   (t1 n level)
;;;   (log-stop))
;;;
;;;
;;; (test1 20 'debug)
;;;
;;;
;;;=head3 C<(log-start filename-prefix : string) : boolean>
;;;
;;;C<Filename-prefix> is the prefix of a filename. [filename-prefix]B<.scfg> is
;;;used for the logfile configuration. [filename-prefix]B<.CCYYMMDD> is used
;;;for log files. Log files are created per day. Each new day, expired log
;;;files will be cleaned.
;;;
;;;A call to C<log-start> will start the logging for the current thread and
;;;its child threads. New C<log-start> calls can be issued in child threads.
;;;
;;;C<log-start> must not be called more than ones in a thread. C<log-start>
;;;and C<log-stop> can be called alternating.
;;;
;;;=verbatim scm,8
					;Starting a log system for current threading environment
(define (log-start filename-prefix)
  (thrcell-set! log-name filename-prefix)
  (read-log-config (thrcell-ref log-name))
  (open-new-or-existing-log-and-rotate-logs filename-prefix)
  (thrcell-set! log-fifo (fifo))
  (set-log-functions (thrcell-ref log-lvl))
  (thrcell-set! log-thread (thread logger))
  (thrcell-set! cfg-refresh-thread (thread config-file-refresh))
  #t)
;;;=verbatim
;;;
;;;=head3 C<(log-stop)>
;;;
;;;C<log-stop> will put a 'stop-logging command on the log-fifo and
;;;wait until the logger thread stops.
;;;
;;;=verbatim scm,8
(define (log-stop)
  (kill-thread (thrcell-ref cfg-refresh-thread))
  (fifo+ (thrcell-ref log-fifo) 'stop-logging)
  (thread-wait (thrcell-ref log-thread))
  (close-output-port (thrcell-ref log-fh)))
;;;=verbatim
;;;
;;;=head3 C<(log-sync)>
;;;
;;;C<log-sync> will sync logging, make fifo empty.
;;;Wait until the logger thread stops, and restart it.
;;;
;;;=verbatim scm,8
(define (log-sync)
  (log-stop)
  (log-start (thrcell-ref log-name)))
;;;=verbatim
;;;
;;;=head3 C<(log-debug . msgs) : '[not-]logged>
;;;
;;;This function will log debug messages. If the debug level is turned
;;;on, it will return 'logged. 'not-logged will be returned
;;;otherwise.
;;;
;;;=verbatim scm,8
(define (log-debug . msgs)
  ((thrcell-ref log-internal-debug) msgs))
;;;=verbatim
;;;
;;;=head3 C<(log-info . msgs) : '[not-]logged>
;;;
;;;This function will log info messages. If the info level is turned
;;;on, it will return 'logged. 'not-logged will be returned
;;;otherwise.
;;;
;;;=verbatim scm,8
(define (log-info . msgs)
  ((thrcell-ref log-internal-info) msgs))
;;;=verbatim
;;;
;;;=head3 C<(log-warn . msgs) : '[not-]logged>
;;;
;;;This function will log warning messages. If the warn level is turned
;;;on, it will return 'logged. 'not-logged will be returned
;;;otherwise. Alias for C<log-warn>, is C<log-warning>.
;;;
;;;=verbatim scm,8
(define (log-warn . msgs)
  ((thrcell-ref log-internal-warn) msgs))

(define (log-warning . msgs)
  ((thrcell-ref log-internal-warn) msgs))
;;;=verbatim
;;;
;;;=head3 C<(log-error . msgs) : 'logged>
;;;
;;;This function will log error messages. These messages
;;;cannot be turned off.
;;;
;;;=verbatim scm,8
(define (log-error . msgs)
  ((thrcell-ref log-internal-error) msgs))
;;;=verbatim
;;;
;;;=head3 C<(log-fatal . msgs) : 'logged>
;;;
;;;This function will log fatal messages. These messages
;;;cannot be turned off. If a log-fatal-notifyer is registered,
;;;this function will be called. log-fatal will result in a synchronous
;;;log call. Normally log-fatal will also result in terminating
;;;a program.
;;;
;;;=verbatim scm,8
(define (log-fatal . msgs)
  (let ((sem (make-semaphore 0)))
    ((thrcell-ref log-internal-fatal) (lambda () (semaphore-post sem))  msgs)
    (semaphore-wait sem)))
;;;=verbatim
;;;
;;;=head3 C<(log-level . level) : current-level>
;;;
;;;This function will report and/or set the current log level.
;;;If 'level' is given as an argument, the current log level will
;;;be set to its value. If no arguments are given, only the
;;;current log level is returned.
;;;
;;;=verbatim scm,8
(define (log-level . arg)
  (if (not (null? arg))
      (begin
	(thrcell-set! log-lvl (car arg))
	(set-log-functions (car arg))
	(write-log-config (thrcell-ref log-name))))
  (thrcell-ref log-lvl))
;;;=verbatim
;;;
;;;=head3 C<(log-keep-days . days) : days>
;;;
;;;This function will report and/or set the current number of days
;;;after which log files will expire and be cleaned by the logger thread.
;;;If 'days' is given, the number of days until log files expire is
;;;set to 'days'. Otherwise, only the current number of days is returned.
;;;
;;;Precondition (not checked): daysE<gt>=1.
;;;
;;;=verbatim scm,8
(define (log-keep-days . arg)
  (if (not (null? arg))
      (begin
	(thrcell-set! log-keep (car arg))
	(write-log-config (thrcell-ref log-name))))
  (thrcell-ref log-keep))
;;;=verbatim
;;;
;;;=head3 C<(log-mode . mode) : mode>
;;;
;;;This function will report and/or set the current log mode. Possible
;;;modes are 'copy and 'reference. 'copy mode is slower, because the
;;;log functions will copy all arguments to a string instead of referencing
;;;them. But it can be very usefull when logging volatile data.
;;;
;;;=verbatim scm,8
(define (log-mode . arg)
  (if (not (null? arg))
      (begin
	(thrcell-set! log-mymode (car arg))
	(write-log-config (thrcell-ref log-name))))
  (thrcell-ref log-mymode))
;;;=verbatim
;;;
;;;=head3 C<(log-fatal-notify procedure) : #t>
;;;
;;;C<log-fatal-notify> will set a callback function that will
;;;be called on a log messages of level fatal. Programs can
;;;use this function to cleanup code, report fatal errors in
;;;a popup messagebox, or whatever.
;;;
;;;Nothing is done with the result of 'proc'. 'proc' is called
;;;with two arguments. First, a date (string? date --> #t);
;;;and second any data.
;;;
;;;=verbatim scm,8
(define (log-fatal-notify proc)
  (fifo+ (thrcell-ref log-fifo) (list 'log-fatal-notify proc))
  #t)
;;;=verbatim
;;;
;;;=head1 Downloading
;;;
;;;Log4SCM can be downloaded at L<sourceforge|http://sourceforge.net/project/showfiles.php?group_id=89865&package_id=120236>
;;;
;;;=head1 Info
;;;
;;;S<C<Author(s):>> Hans Oesterholt (hansatelementalprogrammingdotorgextension).E<lb>
;;;S<C<Copyright:>> (c) 2005.E<lb>
;;;S<C<License  :>> L<Elemental Programming Artistic License|http://www.elemental-programming.org/epwiki/ep_license.html>.E<lb>
;;;S<C<File     :>> log4scm.scm $Id: log4scm.scm,v 1.25 2007/04/18 18:37:21 HansOesterholt Exp $
;;;
;;;=cut
)