;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; log4scm-reader
;;;
;;; Author            : Hans Oesterholt-Dijkema
;;; License           : LGPL
;;; Short Description : This module provides a log file reader for log4scm.
;;;
;;; $Id: log4scm-reader.scm,v 1.5 2006/01/05 20:30:38 HansOesterholt Exp $
;;;
;;; $Log: log4scm-reader.scm,v $
;;; Revision 1.5  2006/01/05 20:30:38  HansOesterholt
;;; Adaptation to planet requires
;;;
;;; Revision 1.4  2005/11/22 19:53:02  HansOesterholt
;;; no message
;;;
;;; Revision 1.3  2005/11/13 19:44:10  HansOesterholt
;;; - Bug fixing.
;;; - Making things more consistent.
;;; - Adding the log4scm-viewer application
;;; - Making things start as a real windows application.
;;;
;;; 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-reader mzscheme
	(require (planet "roos.scm" ("oesterholt" "roos.plt" 1 0)))
	(require (planet "sutil.scm" ("oesterholt" "ho-utils.plt" 1 0)))
	(require (lib "14.ss" "srfi"))
	(require (lib "string.ss" "srfi" "13"))
	(require "log4scm.scm")
	(provide log4scm-reader
		 log4scm-line
		 (all-from (planet "roos.scm" ("oesterholt" "roos.plt" 1 0))))

(define (displ a) (display a))

(def-class
  (this (log4scm-line line))
  (supers)
  (private

   (define (process line)

     (define (f s n)
       (if (= n 0)
	   (list s)
	   (let ((i (string-index s char-set:blank)))
	     (if (eq? i #f)
		 (cons "" (f s (- n 1)))
		 (cons (substring s 0 i)
		       (f (string-trim (substring s (+ i 1))) (- n 1)))))))
     
     (apply (lambda (timestamp type message)
	      (list timestamp 
		    (let ((level (string->symbol type)))
		      (if (eq? level 'warning)
			  'warn
			  level))
		    message))
	    (f line 2)))

   )
  (public
   (define timestamp #f)
   (define level     #f)
   (define message   #f)
   (define (display)
     (displ (format "~a ~a ~a~%" timestamp level message)))
   )
  (constructor
   (apply (lambda (_timestamp _type _message)
	    (set! timestamp _timestamp)
	    (set! level     _type)
	    (set! message   _message))
	  (process line))
   
   )
  )

(def-class 
  (this (log4scm-reader log4scm-cfg output-handler))
  (supers)
  (private
   (define handle             #f)
   (define current-log-file   #f)
   (define current-file-size  0)
   (define bytes-read         0)
   )
  (public

   (define (log-file file)
     (if (not (eq? handle #f))
	 (close-input-port handle))
     (if (file-exists? file)
	 (begin
	   (set! handle           (open-input-file file))
	   (set! bytes-read       0)
	   (set! current-log-file file))
	 (begin
	   (set! handle           #f)
	   (set! bytes-read       0)
	   (set! current-log-file #f))))

   (define (close)
     (if (not (eq? handle #f))
	 (close-input-port handle)))
     
   (define (name)
     (if (eq? current-log-file #f)
	 ""
	 current-log-file))

   (define (size)
     (if (eq? current-log-file #f)
	 0
	 (if (file-exists? current-log-file)
	     (begin
	       (set! current-file-size (file-size current-log-file))
	       current-file-size)
	     0)))

   (define (position)
     (if (eq? handle #f)
	 0
	 (file-position handle)))

   (define (calculate-progress)
     (if (= current-file-size 0)
	 100
	 (inexact->exact (round (/ (* 100.0 bytes-read) current-file-size)))))

   (define (read)

     (let ((read-any #f))
     
       (define (rd)
	 (if (>= (position) current-file-size)
	     (begin
	       (-> output-handler progress 100)
	       read-any)
	     (let ((line (read-line handle 'any)))
	       (if (eof-object? line)
		   (begin
		     (-> output-handler progress 100)
		     read-any)
		   (let ((ln (string-trim-both line)))
		     (set! read-any #t)
		     (set! bytes-read (+ (string-length line) bytes-read))
		     (-> output-handler progress (calculate-progress))
		     (if (> (string-length ln) 0)
			 (-> output-handler add-line (log4scm-line line)))
		     (rd))))))

       (begin
	 (size)
	 (log-debug (format "~s ~s ~s" handle (position) current-file-size))
	 (if (eq? handle #f)
	     #f
	     (rd)))))
   )
  (constructor
   )
  )

)