Added logging functions

1 files changed, 227 insertions, 0 deletions

diff --git a/src/clojure/contrib/logging.clj b/src/clojure/contrib/logging.clj
new file mode 100644
index 00000000..adc6e0ab
--- /dev/null
+++ b/src/clojure/contrib/logging.clj
@@ -0,0 +1,227 @@
+(ns 
+  #^{:author "Alex Taggart, Timothy Pratley",
+     :doc "Logging macros which delegate to a specific logging implementation. 
+  At runtime a specific implementation is selected from, in order, Apache 
+  commons-logging, log4j, and finally java.util.logging.
+  
+  Logging levels are specified by clojure keywords corresponding to the 
+  values used in log4j/commons-logging:
+    :trace, :debug, :info, :warn, :error, :fatal  
+  
+  Unless otherwise specified, the current namespace will be used as the log-name
+  (similar to how the java class name is usually used).
+  
+  Logging occurs with the log macro which writes either directly or via an 
+  agent.  By default direct logging is disabled, but can be enabled via the 
+  *allow-direct-logging* boolean ref.  If log is invoked within a transaction it
+  will always use an agent.
+  
+  The logging macros will not evaluate their 'message' unless the specific 
+  logging level is in effect.
+  
+  Use the enabled? function to write conditional code against the logging level 
+  (beyond simply whether or not to call log/send-log).
+  
+  You can redirect all java writes of System.out and System.err to the log 
+  system by calling log-capture!.  To rebind *out* and *err* to the log system 
+  invoke with-logs."
+  }
+  clojure.contrib.logging)
+
+
+(defstruct log-system
+  :name     ; the name of the logging system used
+  :get-log  ; fn [name] to obtain a log by string name
+  :enabled? ; fn [log lvl] to check if a particular level is emabled
+  :write)   ; fn [log lvl msg ex] to a log a message
+
+
+(defmacro commons-logging
+  "Creates a log-system struct using the Apache commons-logging API, 
+  if present; otherwise nil."
+  []
+  (try
+    (import (org.apache.commons.logging LogFactory Log))
+    `(letfn [(get-log# [name#]
+               (LogFactory/getLog name#))
+             (enabled?# [log# level#]
+               (condp = level#
+                 :trace (.isTraceEnabled log#)
+                 :debug (.isDebugEnabled log#)
+                 :info  (.isInfoEnabled  log#)
+                 :warn  (.isWarnEnabled  log#)
+                 :error (.isErrorEnabled log#)
+                 :fatal (.isFatalEnabled log#)))
+             (write# [log# level# msg# e#]
+               (condp = level#
+                 :trace (.trace log# msg# e#)
+                 :debug (.debug log# msg# e#)
+                 :info  (.info  log# msg# e#)
+                 :warn  (.warn  log# msg# e#)
+                 :error (.error log# msg# e#)
+                 :fatal (.fatal log# msg# e#)))]
+      (struct log-system "commons-logging" get-log# enabled?# write#))
+    (catch Exception e nil)))
+
+
+(defmacro log4j-logging
+  "Creates a log-system struct using the log4j API, if present; otherwise nil."
+  []
+  (try
+    (import (org.apache.log4j Logger Level))
+    `(let [levels# {:trace Level/TRACE
+                    :debug Level/DEBUG
+                    :info  Level/INFO
+                    :warn  Level/WARN
+                    :error Level/ERROR
+                    :fatal Level/FATAL}]
+      (letfn [(get-log# [name#] 
+                (Logger/getLogger name#))
+              (enabled?# [log# level#] 
+                (.isEnabledFor log# (levels# level#)))
+              (write# [log# level# msg# e#]
+                (if-not e#
+                  (.log log# (levels# level#) msg#)
+                  (.log log# (levels# level#) msg# e#)))]
+        (struct log-system "log4j-logging" get-log# enabled?# write#)))
+    (catch Exception e nil)))
+
+
+(defmacro java-logging
+  "Creates a log-system struct using the java.util.logging API."
+  []
+  (try
+    (import (java.util.logging Logger Level))
+    `(let [levels# {:trace Level/FINEST
+                    :debug Level/FINE
+                    :info  Level/INFO
+                    :warn  Level/WARNING
+                    :error Level/SEVERE
+                    :fatal Level/SEVERE}]
+      (letfn [(get-log# [name#] 
+                (Logger/getLogger name#))
+              (enabled?# [log# level#] 
+                (.isLoggable log# (levels# level#)))
+              (write# [log# level# msg# e#]
+                (if-not e#
+                  (.log log# (levels# level#) (str msg#))
+                  (.log log# (levels# level#) (str msg#) e#)))]
+        (struct log-system "java-logging" get-log# enabled?# write#)))
+    (catch Exception e nil)))
+
+
+(defmacro direct-log
+  "Logs the message immediately if the specific logging level is enabled. Use 
+  the log macro in prefernce to this."
+  [level message throwable log-name system]
+  `(let [log# ((~system :get-log) ~log-name)]
+    (if ((~system :enabled?) log# ~level)
+      ((~system :write) log# ~level ~message ~throwable))))
+
+
+(defmacro send-log
+  "Sends the message to a logging agent. Use the log macro in preference to 
+  this."
+  [level message throwable log-name system-agent]
+  (defn agent-log [sys# lvl# msg# th# ln#]
+    (let [log# ((sys# :get-log) ln#)]
+      (if ((sys# :enabled?) log# lvl#)
+        ((sys# :write) log# lvl# (force msg#) th#))
+      sys#))
+  `(send-off ~system-agent 
+      agent-log ~level (delay ~message) ~throwable ~log-name))
+
+
+(def *log-system*
+  (ref (some eval ['(commons-logging)
+                   '(log4j-logging)
+                   '(java-logging)])))
+               
+(def *log-system-agent* (agent *log-system*))
+
+(def *allow-direct-logging* (ref false))
+
+
+(defmacro log
+  "Logs a message, either directly or via an agent."
+  ([level message]
+    `(log ~level ~message nil))
+  ([level message throwable]
+    `(log ~level ~message ~throwable (str *ns*)))
+  ([level message throwable log-name]
+    `(if (and @*allow-direct-logging*
+                (not (clojure.lang.LockingTransaction/isRunning)))
+        (direct-log ~level ~message ~throwable ~log-name @*log-system*)
+        (send-log ~level ~message ~throwable ~log-name *log-system-agent*))))
+
+
+(defn enabled?
+  "Returns true if the specific logging level is enabled."
+  ([level]
+    (enabled? level (str *ns*)))
+  ([level log-name]
+    (let [sys @*log-system*]
+      ((sys :enabled?) ((sys :get-log) log-name) level))))
+
+
+(defmacro spy
+  "Evaluates expr and outputs the form and its result to the debug log; returns 
+  the result of expr."
+  [expr]
+  `(let [a# ~expr] (log :debug (str '~expr " => " a#)) a#))
+
+
+(defn log-stream
+  "Creates a logging output stream that will output to the log."
+  [level log-name]
+  (java.io.PrintStream.
+    (proxy [java.io.ByteArrayOutputStream] []
+      (flush []
+        (proxy-super flush)
+        (let [s (.trim (.toString this))]
+          (proxy-super reset)
+          (if (> (.length s) 0)
+            (log level s nil log-name)))))
+    true))
+
+
+(def *old-std-streams* (ref nil))
+
+
+(defn log-capture!
+  "Captures System/out and System/err, redirecting all writes of those streams 
+  to :info and :error logging, respectively. The specified log-name value will 
+  be used for all redirected logging. NOTE: this will not redirect output of 
+  *out* or *err*; for that use with-logs" 
+  [log-name]
+  (dosync
+    (let [new-out (log-stream :info log-name)
+          new-err (log-stream :error log-name)]
+      ; don't overwrite if something is already there
+      (if (nil? @*old-std-streams*)
+        (ref-set *old-std-streams* {:out System/out :err System/err})) 
+      (System/setOut new-out)
+      (System/setErr new-err))))
+
+
+(defn log-uncapture!
+  "Restores System/out and System/err to their original values."
+  []
+  (dosync
+    (when-let [{old-out :out old-err :err} @*old-std-streams*]
+      (ref-set *old-std-streams* nil)
+      (System/setOut old-out)
+      (System/setErr old-err))))
+
+
+(defmacro with-logs
+  "Evaluates exprs in a context in which *out* and *err* are bound to :info and 
+  :error logging, respectively."
+  [log-name & body]
+  `(let [new-out# (java.io.PrintWriter. 
+                    (log-stream :info ~log-name) true)
+         new-err# (java.io.PrintWriter. 
+                    (log-stream :error ~log-name) true)]
+    (binding [*out* new-out# 
+              *err* new-err#]
+      ~@body)))