;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; log4scm-cfg
;;;
;;; Author            : Hans Oesterholt-Dijkema
;;; License           : LGPL
;;; Short Description : This module provides a configuration class in ROOS
;;;                     for configuring log files.
;;;
;;; $Id: log4scm-cfg.scm,v 1.8 2007/05/09 22:36:27 HansOesterholt Exp $
;;;
;;; $Log: log4scm-cfg.scm,v $
;;; Revision 1.8  2007/05/09 22:36:27  HansOesterholt
;;; *** empty log message ***
;;;
;;; Revision 1.7  2007/04/30 17:34:16  HansOesterholt
;;; *** empty log message ***
;;;
;;; Revision 1.6  2007/04/30 17:22:51  HansOesterholt
;;; *** empty log message ***
;;;
;;; Revision 1.5  2006/01/05 20:30:38  HansOesterholt
;;; Adaptation to planet requires
;;;
;;; Revision 1.4  2005/11/22 19:53:01  HansOesterholt
;;; no message
;;;
;;; Revision 1.3  2005/11/13 16:41:31  HansOesterholt
;;; Some minor bug fixing.
;;;
;;; Revision 1.2  2005/11/13 16:12:15  HansOesterholt
;;; Changed log4scm to use log4scm-cfg instead
;;; of it's own functions.
;;;
;;; Revision 1.1  2005/11/13 16:02:58  HansOesterholt
;;; - Add log configuration class
;;; - Add log reader class
;;; - Add mzgtk2 component for viewing and configuring log files
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module log4scm-cfg mzscheme
        (require (planet "scfg.scm" ("oesterholt" "ho-utils.plt" 1 0)))
        (require (planet "sprefs.scm" ("oesterholt" "ho-utils.plt" 1 0)))
        (require (planet "roos.scm" ("oesterholt" "roos.plt" 1 0)))
        (require (planet "sutil.scm" ("oesterholt" "ho-utils.plt" 1 0)))
        (require (planet "internat.scm" ("oesterholt" "internat.plt" 1 0)))
        (require (lib "pregexp.ss"   "mzlib"))
        (require (lib "list.ss"      "mzlib"))
        (provide log4scm-cfg
                 (all-from (planet "roos.scm" ("oesterholt" "roos.plt" 1 0))))


        (def-class
         (this (log4scm-attr _attr _help))
         (supers)
         (private
          (define __help  (_ _help))
          )
         (public
          (define (attribute) _attr)
          (define (level)     _attr)
          (define (mode)      _attr)
          (define (range)     _attr)
          (define (help)      __help)
          (define (label)     (help))
          )
         (constructor)
         )


        (def-class
         (this (log4scm-cfg config-file))
         (supers)
         (private
          (define cfg     (scfg-new config-file))

          (define (validate-attribute attribute attributes)
            (if (null? attributes)
                #f
                (if (eq? attribute (-> (car attributes) attribute))
                    #t
                    (validate-attribute attribute (cdr attributes)))))
          )
         (public
          ;;; reading/writing configurables

          (define (level . _level)
            (meta-apply scfg-cond-set!-get cfg '(log level) (-> this default-log-level) _level))

          (define (mode . _mode)
            (meta-apply scfg-cond-set!-get cfg '(log mode) (-> this default-log-mode) _mode))

          (define (keep . _keep)
            (let ((R  (inexact->exact
                       (meta-apply scfg-cond-set!-get cfg '(log keep) (-> this default-keep) _keep))))
              (if (<= R 0)
                  1
                  R)))

          (define (directory)
            (basedir config-file))

          (define (filename)
            (scfg-filename cfg))

          (define (current-log-files)
            (let ((fn  (pregexp-replace "[.].*$" (basename (-> this filename)) "[.][0-9-]+$"))
                  (dir (-> this directory)))
              (let ((files (glob (string-append dir "/" fn))))
                (quicksort files string-ci>?))))

          (define (tail-mode . _tail-mode)
            (meta-apply scfg-cond-set!-get cfg '(log reader tail-mode) #t _tail-mode))

          (define (color level . _color)
            (meta-apply sprefs-cond-set!-get (list 'log 'color level) "#000000" _color))

          ;;; Committing changes

          (define (commit . filename)
            (apply scfg-save (cons cfg filename)))

          ;;; Domain definitions

          (define (keep-range-in-days)
            (log4scm-attr (list 1 30) "Minimum and maximum number of days to keep log files"))

          (define (configurable-minimum-log-levels)
            (list (log4scm-attr 'debug "Log all possible messages")
                  (log4scm-attr 'info  "Don't log debug messages")
                  (log4scm-attr 'warn  "Don't log info and debug messages")))

          (define (configurable-log-levels)
            (list (log4scm-attr 'debug "Debug messages")
                  (log4scm-attr 'info  "Informational messages")
                  (log4scm-attr 'warn  "Warnings")
                  (log4scm-attr 'error  "Error messages (errors don't prevent the program from running)")
                  (log4scm-attr 'fatal  "Fatal messages (program will exit shortly)")
                  ))

          (define (configurable-log-modes)
            (list (log4scm-attr 'copy (string-append
                                       "Copy mode will copy all messages to the log queue.\n"
                                       "This will keep messages from changes while the program\n"
                                       "runs, but is slower"
                                       ))
                  (log4scm-attr 'reference (string-append
                                            "Reference mode will keep a reference to a message,\n"
                                            "which can then change while the program runs. This\n"
                                            "can result in obscure logs (especially when debugging\n"
                                            "is involved."
                                            ))))

          ;;; Validators

          (define (validate-log-level level)
            (validate-attribute level (-> this configurable-log-levels)))

          (define (validate-log-mode mode)
            (validate-attribute mode  (-> this configurable-log-modes)))

          (define (validate-keep keep)
            (let ((range (-> this keep-range-in-days)))
              (and (>= keep (car range)) (<= keep (cadr range)))))

          ;;; Defaults

          (define (default-log-level) 'info)
          (define (default-log-mode)  'copy)
          (define (default-keep)      7)

          ) ;public
         (constructor)
         )


        )