diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor index 91baae631f..935326da2d 100644 --- a/basis/logging/insomniac/insomniac.factor +++ b/basis/logging/insomniac/insomniac.factor @@ -30,7 +30,7 @@ SYMBOL: insomniac-recipients \ (email-log-report) NOTICE add-error-logging : email-log-report ( service word-names -- ) - "logging.insomniac" [ (email-log-report) ] with-logging ; + "logging.insomniac" DEBUG [ (email-log-report) ] with-logging ; : schedule-insomniac ( service word-names -- ) [ [ email-log-report ] assoc-each rotate-logs ] 2curry diff --git a/basis/logging/logging-docs.factor b/basis/logging/logging-docs.factor index 275d900f3d..64956493c6 100644 --- a/basis/logging/logging-docs.factor +++ b/basis/logging/logging-docs.factor @@ -8,6 +8,9 @@ HELP: DEBUG HELP: NOTICE { $description "Log level for ordinary messages." } ; +HELP: WARNING +{ $description "Log level for warnings." } ; + HELP: ERROR { $description "Log level for error messages." } ; @@ -18,6 +21,7 @@ ARTICLE: "logging.levels" "Log levels" "Several log levels are supported, from lowest to highest:" { $subsection DEBUG } { $subsection NOTICE } +{ $subsection WARNING } { $subsection ERROR } { $subsection CRITICAL } ; @@ -36,7 +40,7 @@ ARTICLE: "logging.files" "Log files" HELP: log-message { $values { "msg" string } { "word" word } { "level" "a log level" } } -{ $description "Sends a message to the current log. Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ; +{ $description "Sends a message to the current log if the level is more urgent than " { $link log-level } ". Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ; HELP: add-logging { $values { "level" "a log level" } { "word" word } } @@ -90,8 +94,8 @@ HELP: close-logs { $description "Closes all open log streams. Subsequent logging will re-open the streams. This should be used before moving or deleting log files." } ; HELP: with-logging -{ $values { "service" "a log service name" } { "quot" quotation } } -{ $description "Calls the quotation a new dynamic scope where all logging calls are sent to the log file for " { $snippet "service" } "." } ; +{ $values { "service" "a log service name" } { "level" "a log level" } { "quot" quotation } } +{ $description "Calls the quotation a new dynamic scope where all logging calls more urgent than " { $link log-level } " are sent to the log file for " { $snippet "service" } "." } ; ARTICLE: "logging.rotation" "Log rotation" "Log files should be rotated periodically to prevent unbounded growth." @@ -120,4 +124,3 @@ ARTICLE: "logging" "Logging framework" { $subsection "logging.server" } ; ABOUT: "logging" - diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 6769932c88..2389389074 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -4,12 +4,29 @@ USING: logging.server sequences namespaces concurrency.messaging words kernel arrays shuffle tools.annotations prettyprint.config prettyprint debugger io.streams.string splitting continuations effects generalizations parser strings -quotations fry accessors ; +quotations fry accessors math assocs math.order ; IN: logging SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ; -: log-levels { DEBUG NOTICE NOTICE WARNING ERROR CRITICAL } ; +SYMBOL: log-level + +: log-levels ( -- assoc ) + H{ + { DEBUG 0 } + { NOTICE 10 } + { WARNING 20 } + { ERROR 30 } + { CRITICAL 40 } + } ; + +ERROR: undefined-log-level ; + +: log-level<=> ( log-level log-level -- ? ) + [ log-levels at* [ undefined-log-level ] unless ] bi@ <=> ; + +: log? ( log-level -- ? ) + log-level get log-level<=> +lt+ = not ; : send-to-log-server ( array string -- ) prefix "log-server" get send ; @@ -22,7 +39,8 @@ SYMBOL: log-service : log-message ( msg word level -- ) check-log-message - log-service get dup [ + dup log? + log-service get dup and [ [ [ string-lines ] [ name>> ] [ name>> ] tri* ] dip 4array "log-message" send-to-log-server ] [ @@ -35,8 +53,10 @@ SYMBOL: log-service : close-logs ( -- ) { } "close-logs" send-to-log-server ; -: with-logging ( service quot -- ) - log-service swap with-variable ; inline +: with-logging ( service level quot -- ) + '[ + _ log-service [ _ log-level _ with-variable ] with-variable + ] call ; inline ! Aspect-oriented programming idioms diff --git a/basis/logging/parser/parser.factor b/basis/logging/parser/parser.factor index 07a84ec5c6..5406d8fcd0 100644 --- a/basis/logging/parser/parser.factor +++ b/basis/logging/parser/parser.factor @@ -3,7 +3,7 @@ USING: accessors peg peg.parsers memoize kernel sequences logging arrays words strings vectors io io.files io.encodings.utf8 namespaces make combinators logging.server -calendar calendar.format ; +calendar calendar.format assocs ; IN: logging.parser TUPLE: log-entry date level word-name message ; @@ -21,7 +21,7 @@ SYMBOL: multiline "[" "]" surrounded-by ; : 'log-level' ( -- parser ) - log-levels [ + log-levels keys [ [ name>> token ] keep [ nip ] curry action ] map choice ;