;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.6 2007/05/09 22:36:27 HansOesterholt Exp $
;;;
;;; $Log: log4scm-reader.scm,v $
;;; Revision 1.6  2007/05/09 22:36:27  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: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
          )
         )

        )