Changeset 18194 in project


Ignore:
Timestamp:
05/24/10 17:43:15 (9 years ago)
Author:
azul
Message:

Made it possible to disable logging setting LOG_DIR to empty string. Made it possible to only keep the last N logs of a given kind setting LOG_COLLECT to N.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/simple-logging/trunk/simple-logging.scm

    r18193 r18194  
    1313(define *logging-data* #f)
    1414
     15(define *logs-to-keep*
     16  (string->number (or (getenv "LOG_COLLECT") "2")))
     17
    1518(define-record logging-data program-name directory files-list)
    1619(define-record logging-file file version byte-count)
     
    2629
    2730(define (logging severity fmt . args)
    28   (let ((str (format "~A: ~A: ~A: ~A"
    29                      severity
    30                      (seconds->string (current-seconds))
    31                      (current-process-id)
    32                      (apply format fmt args))))
    33     ; We want to log this for the requested severity and all lesser:
    34     (for-each
    35       (lambda (s) (logging-with-severity s str))
    36       (member severity *severities*))))
    37 
    38 (define (logging-proc severity proc fmt . args)
    39   (let ((str (format #f fmt args)))
    40     (lambda args
    41       (call-with-logging severity (lambda () (apply proc args)) "~A" str))))
     31  (when *logging-data*
     32    (let ((str (format "~A: ~A: ~A: ~A"
     33                       severity
     34                       (seconds->string (current-seconds))
     35                       (current-process-id)
     36                       (apply format fmt args))))
     37      ; We want to log this for the requested severity and all lesser:
     38      (for-each
     39        (lambda (s) (logging-with-severity s str))
     40        (member severity *severities*)))))
    4241
    4342(define (call-with-logging severity proc fmt . args)
    44   (let ((id (gensym)) (str (apply format #f fmt args)))
    45     (logging severity "> ~A: ~A" id str)
    46     (let ((result (proc)))
    47       (logging severity "< ~A: ~A" id str)
    48       result)))
     43  (if *logging-data*
     44    (let ((id (gensym)) (str (apply format #f fmt args)))
     45      (logging severity "> ~A: ~A" id str)
     46      (let ((result (proc)))
     47        (logging severity "< ~A: ~A" id str)
     48        result))
     49    (proc)))
    4950
    5051(define *log-size*
     
    6364              (directory? (logging-data-directory *logging-data*)))
    6465    (create-directory (logging-data-directory *logging-data*)))
     66  (when (logging-file-file file)
     67    (close-output-port (logging-file-file file)))
     68  (when (and (positive? *logs-to-keep*)
     69             (>= (logging-file-version file) *logs-to-keep*))
     70    (let ((path (get-log-path severity (- (logging-file-version file) *logs-to-keep*))))
     71      (when (file-exists? path)
     72        (delete-file path))))
    6573  (logging-file-file-set! file
    6674    (open-output-file (get-log-path severity (logging-file-version file))))
     
    8694
    8795(define (with-logging program-name thunk)
    88   (set! *logging-data*
    89     (make-logging-data
    90       program-name
    91       (format #f "~A/log-~A-~A-~A"
    92               (or (getenv "TMPDIR")
    93                   (getenv "TEMP")
    94                   (getenv "TMP")
    95                   "/tmp")
    96               program-name
    97               (current-seconds)
    98               (current-process-id))
    99       '()))
     96  (unless (and (getenv "LOG_DIR") (string=? (getenv "LOG_DIR") ""))
     97    (set! *logging-data*
     98      (make-logging-data
     99        program-name
     100        (format #f "~A/log-~A-~A-~A"
     101                (or (getenv "LOG_DIR")
     102                    (getenv "TMPDIR")
     103                    (getenv "TEMP")
     104                    (getenv "TMP")
     105                    "/tmp")
     106                program-name
     107                (current-seconds)
     108                (current-process-id))
     109        '())))
    100110  (thunk)
    101   (for-each
    102     (lambda (logging-file)
    103       (when (logging-file-file (cadr logging-file))
    104         (close-output-port (logging-file-file (cadr logging-file)))))
    105     (logging-data-files-list *logging-data*)))
     111  (when *logging-data*
     112    (for-each
     113      (lambda (logging-file)
     114        (when (logging-file-file (cadr logging-file))
     115          (close-output-port (logging-file-file (cadr logging-file)))))
     116      (logging-data-files-list *logging-data*))))
Note: See TracChangeset for help on using the changeset viewer.