;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.6 2007/04/30 17:22:51 HansOesterholt Exp $
;;;
;;; $Log: log4scm-cfg.scm,v $
;;; 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)
  )
  

)