;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; log4scm
;;;
;;; Author            : Hans Oesterholt-Dijkema
;;; License           : LGPL
;;; Short Description : This module provides a logging facility for mzscheme.
;;;
;;; $Id: log4scm.scm,v 1.26 2007/05/09 22:36:27 HansOesterholt Exp $
;;;
;;; $Log: log4scm.scm,v $
;;; Revision 1.26  2007/05/09 22:36:27  HansOesterholt
;;; *** empty log message ***
;;;
;;; 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))
        
        
        (define MAX-LOG-LINE-LENGTH 120)
;;;=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 (make-msg msgs)
              (if (null? msgs)
                  ""
                  (string-append (format "~a" (car msgs))
                                 (make-msg (cdr msgs)))))
            
            (define (log dt level msg-lines count)
              (if (null? msg-lines)
                  (flush-output (thrcell-ref log-fh))
                  (begin
                    (display (format "~a ~a ~a~a~%"
                                     dt level (if (= count 0)
                                                  "" 
                                                  "+ ")
                                     (substr (car msg-lines) 0 MAX-LOG-LINE-LENGTH)) (thrcell-ref log-fh))
                    (log dt level (cdr msg-lines) (+ count 1)))))
                                                  
            (begin
              ;; TODO: seek to the end of the file (concurrent access, and flush)
              (let ((M (make-msg msgs)))
                (let ((lines (splitstr M #\newline)))
                  (log dt level lines 0)))))

          (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-max-line-length . len) : integer>
;;;
;;;This function will report and/or set the current log line length.
;;;THIS IS A GLOBAL SETTING, NOT IN A CONFIG FILE. Defaults to 120.
;;;
;;;=verbatim scm,8
        (define (log-max-line-length . arg)
          (if (not (null? arg))
              (set! MAX-LOG-LINE-LENGTH (car arg)))
          MAX-LOG-LINE-LENGTH)
;;;=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.26 2007/05/09 22:36:27 HansOesterholt Exp $
;;;
;;;=cut
        )