diff options
author | Stuart Halloway <stu@thinkrelevance.com> | 2009-08-17 19:15:35 -0400 |
---|---|---|
committer | Stuart Halloway <stu@thinkrelevance.com> | 2009-08-17 19:15:35 -0400 |
commit | 07eef46b22f27a61784c11be03ff0159fac50b38 (patch) | |
tree | 95d138ba31c757592f85e826c02fdff40a222dbd | |
parent | cb35f77f5b5bea740120bc649ae82c8015c7ca4c (diff) | |
parent | 76a841f9e4f2e184beabe693856572dff265cab7 (diff) |
Merge branch 'master' of git@github.com:richhickey/clojure-contrib
-rw-r--r-- | build.xml | 2 | ||||
-rw-r--r-- | doc/pprint/CommonLispFormat.markdown | 2 | ||||
-rw-r--r-- | src/clojure/contrib/duck_streams.clj | 58 | ||||
-rw-r--r-- | src/clojure/contrib/http/agent.clj | 300 | ||||
-rw-r--r-- | src/clojure/contrib/http/connection.clj | 14 | ||||
-rw-r--r-- | src/clojure/contrib/java_utils.clj | 20 | ||||
-rw-r--r-- | src/clojure/contrib/logging.clj | 259 | ||||
-rw-r--r-- | src/clojure/contrib/pprint.clj | 13 |
8 files changed, 411 insertions, 257 deletions
@@ -90,7 +90,7 @@ </java> </target> - <target name="compile_clojure" depends="init,check_hasclojure" + <target name="compile_clojure" depends="init,check_hasclojure,compile_classes" description="Compile Clojure sources." if="hasclojure"> <java classname="clojure.lang.Compile"> diff --git a/doc/pprint/CommonLispFormat.markdown b/doc/pprint/CommonLispFormat.markdown index 116d114e..a3a87b55 100644 --- a/doc/pprint/CommonLispFormat.markdown +++ b/doc/pprint/CommonLispFormat.markdown @@ -1,4 +1,4 @@ -# Common Lisp-compatible Format function +# A Common Lisp-compatible Format Function cl-format is an implementation of the incredibly baroque Common Lisp format function as specified in [Common Lisp, the Language, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000). diff --git a/src/clojure/contrib/duck_streams.clj b/src/clojure/contrib/duck_streams.clj index fe0cc5fc..f15e0ee4 100644 --- a/src/clojure/contrib/duck_streams.clj +++ b/src/clojure/contrib/duck_streams.clj @@ -69,7 +69,8 @@ (def #^{:doc "Name of the default encoding to use when reading & writing. - Default is UTF-8."} + Default is UTF-8." + :tag "java.lang.String"} *default-encoding* "UTF-8") (def @@ -113,7 +114,7 @@ (defmethod reader Reader [x] (BufferedReader. x)) -(defmethod reader InputStream [x] +(defmethod reader InputStream [#^InputStream x] (BufferedReader. (InputStreamReader. x *default-encoding*))) (defmethod reader File [#^File x] @@ -139,7 +140,8 @@ (def #^{:doc "If true, writer and spit will open files in append mode. - Defaults to false. Use append-writer or append-spit."} + Defaults to false. Use append-writer or append-spit." + :tag "java.lang.Boolean"} *append-to-writer* false) @@ -175,7 +177,7 @@ ;; Writer includes sub-classes such as FileWriter (PrintWriter. (BufferedWriter. x))) -(defmethod writer OutputStream [x] +(defmethod writer OutputStream [#^OutputStream x] (assert-not-appending) (PrintWriter. (BufferedWriter. @@ -234,7 +236,7 @@ (.close rdr))))] (read-line (reader f)))) -(defn slurp* +(defn #^String slurp* "Like clojure.core/slurp but opens f with reader." [f] (with-open [#^BufferedReader r (reader f)] @@ -301,7 +303,7 @@ copy (fn [input output] [(type input) (type output)])) -(defmethod copy [InputStream OutputStream] [input output] +(defmethod copy [InputStream OutputStream] [#^InputStream input #^OutputStream output] (let [buffer (make-array Byte/TYPE *buffer-size*)] (loop [] (let [size (.read input buffer)] @@ -309,21 +311,21 @@ (do (.write output buffer 0 size) (recur))))))) -(defmethod copy [InputStream Writer] [input output] - (let [buffer (make-array Byte/TYPE *buffer-size*)] +(defmethod copy [InputStream Writer] [#^InputStream input #^Writer output] + (let [#^"[B" buffer (make-array Byte/TYPE *buffer-size*)] (loop [] (let [size (.read input buffer)] (when (pos? size) - (let [chars (.toCharArray (String. buffer *default-encoding*))] + (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))] (do (.write output chars) (recur)))))))) -(defmethod copy [InputStream File] [input output] +(defmethod copy [InputStream File] [#^InputStream input #^File output] (with-open [out (FileOutputStream. output)] (copy input out))) -(defmethod copy [Reader OutputStream] [input output] - (let [buffer (make-array Character/TYPE *buffer-size*)] +(defmethod copy [Reader OutputStream] [#^Reader input #^OutputStream output] + (let [#^"[C" buffer (make-array Character/TYPE *buffer-size*)] (loop [] (let [size (.read input buffer)] (when (pos? size) @@ -331,47 +333,47 @@ (do (.write output bytes) (recur)))))))) -(defmethod copy [Reader Writer] [input output] - (let [buffer (make-array Character/TYPE *buffer-size*)] +(defmethod copy [Reader Writer] [#^Reader input #^Writer output] + (let [#^"[C" buffer (make-array Character/TYPE *buffer-size*)] (loop [] (let [size (.read input buffer)] (when (pos? size) (do (.write output buffer 0 size) (recur))))))) -(defmethod copy [Reader File] [input output] +(defmethod copy [Reader File] [#^Reader input #^File output] (with-open [out (FileOutputStream. output)] (copy input out))) -(defmethod copy [File OutputStream] [input output] +(defmethod copy [File OutputStream] [#^File input #^OutputStream output] (with-open [in (FileInputStream. input)] (copy in output))) -(defmethod copy [File Writer] [input output] +(defmethod copy [File Writer] [#^File input #^Writer output] (with-open [in (FileInputStream. input)] (copy in output))) -(defmethod copy [File File] [input output] +(defmethod copy [File File] [#^File input #^File output] (with-open [in (FileInputStream. input) out (FileOutputStream. output)] (copy in out))) -(defmethod copy [String OutputStream] [input output] +(defmethod copy [String OutputStream] [#^String input #^OutputStream output] (copy (StringReader. input) output)) -(defmethod copy [String Writer] [input output] +(defmethod copy [String Writer] [#^String input #^Writer output] (copy (StringReader. input) output)) -(defmethod copy [String File] [input output] +(defmethod copy [String File] [#^String input #^File output] (copy (StringReader. input) output)) -(defmethod copy [*byte-array-type* OutputStream] [input output] +(defmethod copy [*byte-array-type* OutputStream] [#^"[B" input #^OutputStream output] (copy (ByteArrayInputStream. input) output)) -(defmethod copy [*byte-array-type* Writer] [input output] +(defmethod copy [*byte-array-type* Writer] [#^"[B" input #^Writer output] (copy (ByteArrayInputStream. input) output)) -(defmethod copy [*byte-array-type* File] [input output] +(defmethod copy [*byte-array-type* File] [#^"[B" input #^Writer output] (copy (ByteArrayInputStream. input) output)) @@ -389,20 +391,20 @@ (defmethod to-byte-array *byte-array-type* [x] x) -(defmethod to-byte-array String [x] +(defmethod to-byte-array String [#^String x] (.getBytes x *default-encoding*)) -(defmethod to-byte-array File [x] +(defmethod to-byte-array File [#^File x] (with-open [input (FileInputStream. x) buffer (ByteArrayOutputStream.)] (copy input buffer) (.toByteArray buffer))) -(defmethod to-byte-array InputStream [x] +(defmethod to-byte-array InputStream [#^InputStream x] (let [buffer (ByteArrayOutputStream.)] (copy x buffer) (.toByteArray buffer))) -(defmethod to-byte-array Reader [x] +(defmethod to-byte-array Reader [#^Reader x] (.getBytes (slurp* x) *default-encoding*)) diff --git a/src/clojure/contrib/http/agent.clj b/src/clojure/contrib/http/agent.clj index 698ea4a8..d63cfd1e 100644 --- a/src/clojure/contrib/http/agent.clj +++ b/src/clojure/contrib/http/agent.clj @@ -1,7 +1,7 @@ ;;; http/agent.clj: agent-based asynchronous HTTP client ;; by Stuart Sierra, http://stuartsierra.com/ -;; June 8, 2009 +;; August 17, 2009 ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use ;; and distribution terms for this software are covered by the Eclipse @@ -12,32 +12,90 @@ ;; remove this notice, or any other, from this software. -(ns #^{:doc "Agent-based asynchronous HTTP client."} +(ns #^{:doc "Agent-based asynchronous HTTP client. + + This is a HTTP client library based on Java's HttpURLConnection + class and Clojure's Agent system. It allows you to make multiple + HTTP requests in parallel. + + Start an HTTP request with the 'http-agent' function, which + immediately returns a Clojure Agent. You will never deref this + agent; that is handled by the accessor functions. The agent will + execute the HTTP request on a separate thread. + + If you pass a :handler function to http-agent, that function will be + called as soon as the HTTP response body is ready. The handler + function is called with one argument, the HTTP agent itself. The + handler can read the response body by calling the 'stream' function + on the agent. + + The value returned by the handler function becomes part of the state + of the agent, and you can retrieve it with the 'result' function. + If you call 'result' before the HTTP request has finished, it will + block until the handler function returns. + + If you don't provide a handler function, the default handler will + buffer the entire response body in memory, which you can retrieve + with the 'bytes', 'string', or 'stream' functions. Like 'result', + these functions will block until the HTTP request is completed. + + If you want to check if an HTTP request is finished without + blocking, use the 'done?' function. + + A single GET request could be as simple as: + + (string (http-agent \"http://www.stuartsierra.com/\")) + + A simple POST might look like: + + (http-agent \"http...\" :method \"POST\" :body \"foo=1\") + + And you could write the response directly to a file like this: + + (require '[clojure.contrib.duck-streams :as d]) + + (http-agent \"http...\" + :handler (fn [agnt] + (with-open [w (d/writer \"/tmp/out\")] + (d/copy (stream agnt) w)))) +"} + clojure.contrib.http.agent (:require [clojure.contrib.http.connection :as c] [clojure.contrib.duck-streams :as duck]) - (:import (java.io ByteArrayOutputStream))) + (:import (java.io ByteArrayOutputStream ByteArrayInputStream))) + + +;;; PRIVATE + +(declare result stream) (defn- setup-http-connection + "Sets the instance method, redirect behavior, and request headers of + the HttpURLConnection." [conn options] (.setRequestMethod conn (:method options)) (.setInstanceFollowRedirects conn (:follow-redirects options)) (doseq [[name value] (:headers options)] (.setRequestProperty conn name value))) -(defn- connection-success? [conn] - ;; Is the response in the 2xx range? - (= 2 (unchecked-divide (.getResponseCode conn) 100))) - -(defn- start-request [state options] - (prn "start-request") +(defn- start-request + "Agent action that starts sending the HTTP request." + [state options] (let [conn (::connection state)] (setup-http-connection conn options) (c/start-http-connection conn (:body options)) (assoc state ::state ::started))) -(defn- open-response [state options] - (prn "open-response") +(defn- connection-success? [conn] + "Returns true if the HttpURLConnection response code is in the 2xx + range." + (= 2 (unchecked-divide (.getResponseCode conn) 100))) + +(defn- open-response + "Agent action that opens the response body stream on the HTTP + request; this will block until the response stream is available." + [state options] (let [conn (::connection state)] (assoc state ::response-stream (if (connection-success? conn) @@ -45,39 +103,52 @@ (.getErrorStream conn)) ::state ::receiving))) -(defn- handle-response [state success-handler failure-handler options] - (prn "handle-response") +(defn- handle-response + "Agent action that calls the provided handler function, with no + arguments, and sets the ::result key of the agent to the handler's + return value." + [state handler options] (let [conn (::connection state)] (assoc state - ::result (if (connection-success? conn) - (success-handler) - (failure-handler)) + ::result (handler) ::state ::finished))) -(defn- disconnect [state options] - (prn "disconnect") +(defn- disconnect + "Agent action that closes the response body stream and disconnects + the HttpURLConnection." + [state options] (.close (::response-stream state)) (.disconnect (::connection state)) (assoc state ::response-stream nil ::state ::disconnected)) -(defn response-body-stream - "Returns an InputStream of the HTTP response body." - [http-agnt] - (let [a @http-agnt] - (if (= (::state a) ::receiving) - (::response-stream a) - (throw (Exception. "response-body-stream may only be called from a callback function passed to http-agent"))))) +(defn- status-in-range? + "Returns true if the response status of the HTTP agent begins with + digit, an Integer." + [digit http-agnt] + (= digit (unchecked-divide (.getResponseCode (::connection @http-agnt)) + 100))) + +(defn- get-byte-buffer [http-agnt] + (let [buffer (result http-agnt)] + (if (instance? ByteArrayOutputStream buffer) + buffer + (throw (Exception. "Handler result was not a ByteArrayOutputStream"))))) + (defn buffer-bytes "The default HTTP agent result handler; it collects the response - body in a java.io.ByteArrayOutputStream." + body in a java.io.ByteArrayOutputStream, which can later be + retrieved with the 'stream', 'string', and 'bytes' functions." [http-agnt] (let [output (ByteArrayOutputStream.)] - (duck/copy (response-body-stream http-agnt) output) + (duck/copy (stream http-agnt) output) output)) + +;;; CONSTRUCTOR + (def *http-agent-defaults* {:method "GET" :headers {} @@ -85,8 +156,7 @@ :connect-timeout 0 :read-timeout 0 :follow-redirects true - :on-success buffer-bytes - :on-failure buffer-bytes}) + :handler buffer-bytes}) (defn http-agent "Creates (and immediately returns) an Agent representing an HTTP @@ -123,55 +193,62 @@ If true, HTTP 3xx redirects will be followed automatically. Default is true. - :on-success f + :handler f - Function to be called when the request succeeds with a 2xx response - code. The function will be called with the HTTP agent as its - argument, and can use the response-body-stream function to read the - response body. The return value of this function will be stored in - the state of the agent and can be retrieved with the 'result' - function. Any exceptions thrown by this function will be added to - the agent's error queue (see agent-errors). The default function - collects the response stream into a byte array. + Function to be called when the HTTP response body is ready. If you + do not provide a handler function, the default is to buffer the + entire response body in memory. - :on-failure f - - Like :on-success but this function will be called when the request - fails with a 4xx or 5xx response code. + The handler function will be called with the HTTP agent as its + argument, and can use the 'stream' function to read the response + body. The return value of this function will be stored in the state + of the agent and can be retrieved with the 'result' function. Any + exceptions thrown by this function will be added to the agent's + error queue (see agent-errors). The default function collects the + response stream in a memory buffer. " - ([url & options] + ([uri & options] (let [opts (merge *http-agent-defaults* (apply array-map options))] - (let [a (agent {::connection (c/http-connection url) + (let [a (agent {::connection (c/http-connection uri) ::state ::created - ::url url + ::uri uri ::options opts})] (send-off a start-request opts) (send-off a open-response opts) - (send-off a handle-response - (partial (:on-success opts) a) - (partial (:on-failure opts) a) - opts) + (send-off a handle-response (partial (:handler opts) a) opts) (send-off a disconnect opts))))) + +;;; RESPONSE BODY ACCESSORS + (defn result - "Returns the value returned by the :on-success or :on-failure - handler function of the HTTP agent; nil if the handler function has - not yet finished. The default handler function returns a - ByteArrayOutputStream." + "Returns the value returned by the :handler function of the HTTP + agent; blocks until the HTTP request is completed. The default + handler function returns a ByteArrayOutputStream." [http-agnt] - (when (#{::disconnected ::finished} (::state @http-agnt)) - (::result @http-agnt))) + (await http-agnt) + (::result @http-agnt)) + +(defn stream + "Returns an InputStream of the HTTP response body. When called by + the handler function passed to http-agent, this is the raw + HttpURLConnection stream. + + If the default handler function was used, this function returns a + ByteArrayInputStream on the buffered response body." + [http-agnt] + (let [a @http-agnt] + (if (= (::state a) ::receiving) + (::response-stream a) + (ByteArrayInputStream. (.toByteArray (result http-agnt)))))) -(defn response-body-bytes +(defn bytes "Returns a Java byte array of the content returned by the server; nil if the content is not yet available." [http-agnt] - (when-let [buffer (result http-agnt)] - (if (instance? ByteArrayOutputStream buffer) - (.toByteArray buffer) - (throw (Exception. "Result was not a ByteArrayOutputStream"))))) + (.toByteArray (get-byte-buffer http-agnt))) -(defn response-body-str +(defn string "Returns the HTTP response body as a string, using the given encoding. @@ -179,37 +256,71 @@ headers, or clojure.contrib.duck-streams/*default-encoding* if it is not specified." ([http-agnt] - (response-body-str http-agnt - (or (.getContentEncoding (::connection @http-agnt)) + (string http-agnt (or (.getContentEncoding (::connection @http-agnt)) duck/*default-encoding*))) ([http-agnt encoding] - (when-let [buffer (result http-agnt)] - (if (instance? ByteArrayOutputStream buffer) - (.toString buffer encoding) - (throw (Exception. "Result was not a ByteArrayOutputStream")))))) - -(defn response-status - "Returns the Integer response status code (e.g. 200, 404) for this request." - [a] - (when (= (::state @a) ::completed) - (.getResponseCode (::connection @a)))) - -(defn response-message - "Returns the HTTP response message (e.g. 'Not Found'), for this request." - [a] - (when (= (::state @a) ::completed) - (.getResponseMessage (::connection @a)))) - -(defn response-headers - "Returns a String=>String map of HTTP response headers. Header - names are converted to all lower-case. If a header appears more - than once, only the last value is returned." - [a] + (.toString (get-byte-buffer http-agnt) encoding))) + + +;;; REQUEST ACCESSORS + +(defn request-uri + "Returns the URI/URL requested by this HTTP agent, as a String." + [http-agnt] + (::uri @http-agnt)) + +(defn request-headers + "Returns the request headers specified for this HTTP agent." + [http-agnt] + (:headers (::options @http-agnt))) + +(defn method + "Returns the HTTP method name used by this HTTP agent, as a String." + [http-agnt] + (:method (::options @http-agnt))) + +(defn request-body + "Returns the HTTP request body given to this HTTP agent. + + Note: if the request body was an InputStream or a Reader, it will no + longer be usable." + [http-agnt] + (:body (::options @http-agnt))) + + +;;; RESPONSE ACCESSORS + +(defn done? + "Returns true if the HTTP request/response has completed." + [http-agnt] + (if (#{::finished ::disconnected} (::state @http-agnt)) + true false)) + +(defn status + "Returns the HTTP response status code (e.g. 200, 404) for this + request, as an Integer, or nil if the status has not yet been + received." + [http-agnt] + (when (done? http-agnt) + (.getResponseCode (::connection @http-agnt)))) + +(defn message + "Returns the HTTP response message (e.g. 'Not Found'), for this + request, or nil if the response has not yet been received." + [http-agnt] + (when (done? http-agnt) + (.getResponseMessage (::connection http-agnt)))) + +(defn headers + "Returns a map of HTTP response headers. Header names are converted + to keywords in all lower-case Header values are strings. If a + header appears more than once, only the last value is returned." + [http-agnt] (reduce (fn [m [#^String k v]] - (assoc m (when k (.toLowerCase k)) (last v))) - {} (.getHeaderFields (::connection @a)))) + (assoc m (when k (keyword (.toLowerCase k))) (last v))) + {} (.getHeaderFields (::connection @http-agnt)))) -(defn response-headers-seq +(defn headers-seq "Returns the HTTP response headers in order as a sequence of [String,String] pairs. The first 'header' name may be null for the HTTP status line." @@ -222,14 +333,13 @@ (thisfn (inc i)))))] (lazy-seq (f 0)))) -(defn- response-in-range? [digit http-agnt] - (= digit (unchecked-divide (.getResponseCode (::connection @http-agnt)) - 100))) + +;;; RESPONSE STATUS CODE ACCESSORS (defn success? "Returns true if the HTTP response code was in the 200-299 range." [http-agnt] - (response-in-range? 2 http-agnt)) + (status-in-range? 2 http-agnt)) (defn redirect? "Returns true if the HTTP response code was in the 300-399 range. @@ -238,17 +348,17 @@ redirects will be followed automatically and a the agent will never return a 3xx response code." [http-agnt] - (response-in-range? 3 http-agnt)) + (status-in-range? 3 http-agnt)) (defn client-error? "Returns true if the HTTP response code was in the 400-499 range." [http-agnt] - (response-in-range? 4 http-agnt)) + (status-in-range? 4 http-agnt)) (defn server-error? "Returns true if the HTTP response code was in the 500-599 range." [http-agnt] - (response-in-range? 5 http-agnt)) + (status-in-range? 5 http-agnt)) (defn error? "Returns true if the HTTP response code was in the 400-499 range OR diff --git a/src/clojure/contrib/http/connection.clj b/src/clojure/contrib/http/connection.clj index 0e975cd9..4eda0fa6 100644 --- a/src/clojure/contrib/http/connection.clj +++ b/src/clojure/contrib/http/connection.clj @@ -27,32 +27,32 @@ #^{:doc "Transmits a request entity body."} send-request-entity (fn [conn entity] (type entity))) -(defmethod send-request-entity duck/*byte-array-type* [conn entity] +(defmethod send-request-entity duck/*byte-array-type* [#^HttpURLConnection conn entity] (.setFixedLengthStreamingMode conn (count entity)) (.connect conn) (duck/copy entity (.getOutputStream conn))) -(defmethod send-request-entity String [conn entity] +(defmethod send-request-entity String [conn #^String entity] (send-request-entity conn (.getBytes entity duck/*default-encoding*))) -(defmethod send-request-entity File [conn entity] +(defmethod send-request-entity File [#^HttpURLConnection conn #^File entity] (.setFixedLengthStreamingMode conn (.length entity)) (.connect conn) (duck/copy entity (.getOutputStream conn))) -(defmethod send-request-entity InputStream [conn entity] +(defmethod send-request-entity InputStream [#^HttpURLConnection conn entity] (.setChunkedStreamingMode conn -1) (.connect conn) (duck/copy entity (.getOutputStream conn))) -(defmethod send-request-entity Reader [conn entity] +(defmethod send-request-entity Reader [#^HttpURLConnection conn entity] (.setChunkedStreamingMode conn -1) (.connect conn) (duck/copy entity (.getOutputStream conn))) (defn start-http-connection - ([conn] (.connect conn)) - ([conn request-entity-body] + ([#^HttpURLConnection conn] (.connect conn)) + ([#^HttpURLConnection conn request-entity-body] (if request-entity-body (do (.setDoOutput conn true) (send-request-entity conn request-entity-body)) diff --git a/src/clojure/contrib/java_utils.clj b/src/clojure/contrib/java_utils.clj index 0f030c55..6944f9ee 100644 --- a/src/clojure/contrib/java_utils.clj +++ b/src/clojure/contrib/java_utils.clj @@ -55,7 +55,7 @@ let me (Stu) and the Clojure community know via the mailing list. "} clojure.contrib.java-utils - (:import [java.io File] + (:import [java.io File FileOutputStream] [java.util Properties] [java.net URI URL])) @@ -64,28 +64,28 @@ Building block for clojure.contrib.java-utils/file." class) -(defmethod relative-path-string String [s] +(defmethod relative-path-string String [#^String s] (relative-path-string (File. s))) -(defmethod relative-path-string File [f] +(defmethod relative-path-string File [#^File f] (if (.isAbsolute f) (throw (IllegalArgumentException. (str f " is not a relative path"))) (.getPath f))) -(defmulti as-file +(defmulti #^File as-file "Interpret a String or a java.io.File as a File. Building block for clojure.contrib.java-utils/file, which you should prefer in most cases." class) -(defmethod as-file String [s] (File. s)) +(defmethod as-file String [#^String s] (File. s)) (defmethod as-file File [f] f) -(defn file +(defn #^File file "Returns a java.io.File from string or file args." ([arg] (as-file arg)) ([parent child] - (File. (as-file parent) (relative-path-string child))) + (File. #^File (as-file parent) #^String (relative-path-string child))) ([parent child & more] (reduce file (file parent child) more))) @@ -131,7 +131,7 @@ ; Not there is no corresponding props->map. Just destructure! -(defn as-properties +(defn #^Properties as-properties "Convert any seq of pairs to a java.utils.Properties instance. Uses as-str to convert both keys and values into strings." {:tag Properties} @@ -153,9 +153,9 @@ {:tag Properties} ([m file-able] (write-properties m file-able nil)) ([m file-able comments] - (with-open [f (java.io.FileOutputStream. (file file-able))] + (with-open [#^FileOutputStream f (FileOutputStream. (file file-able))] (doto (as-properties m) - (.store f comments))))) + (.store f #^String comments))))) (defmulti #^{:doc "Coerces argument (URL, URI, or String) to a java.net.URL." diff --git a/src/clojure/contrib/logging.clj b/src/clojure/contrib/logging.clj index 7c530658..372df53d 100644 --- a/src/clojure/contrib/logging.clj +++ b/src/clojure/contrib/logging.clj @@ -10,7 +10,6 @@ ;; distribution. By using this software in any fashion, you are ;; agreeing to be bound by the terms of this license. You must not ;; remove this notice, or any other, from this software. - (ns #^{:author "Alex Taggart, Timothy Pratley", :doc @@ -23,9 +22,10 @@ :trace, :debug, :info, :warn, :error, :fatal Logging occurs with the log macro, or the level-specific convenience macros, - which write either directly or via an agent. By default direct logging is - disabled, but can be enabled via the *allow-direct-logging* boolean atom. If - logging is invoked within a transaction it will always use an agent. + which write either directly or via an agent. For performance reasons, direct + logging is enabled by default, but setting the *allow-direct-logging* boolean + atom to false will disable it. If logging is invoked within a transaction it + will always use an agent. The log macros will not evaluate their 'message' unless the specific logging level is in effect. Alternately, you can use the spy macro when you have code @@ -36,10 +36,9 @@ be used as the log-ns (similar to how the java class name is usually used). Note: your log configuration should display the name that was passed to the logging implementation, and not perform stack-inspection, otherwise you'll see - something like \"clojure.contrib.logging$fn__72$write__39__auto____81 invoke\" - in your logs. + something like \"fn__72$impl_write_BANG__39__auto____81\" in your logs. - Use the enabled? function to write conditional code against the logging level + Use the enabled? macro to write conditional code against the logging level (beyond simply whether or not to call log, which is handled automatically). You can redirect all java writes of System.out and System.err to the log @@ -48,143 +47,186 @@ needs to be specified to namespace the output."} clojure.contrib.logging) - -(defstruct #^{:doc - "A struct to abstract the functionality common to all logging implementations. - The keys are as follows: - :name ; the name of the logging system used - :get-log ; fn [log-ns] to obtain a log by string namespace - :enabled? ; fn [log lvl] to check if a particular level is emabled - :write ; fn [log lvl msg ex] to a log a message"} - log-system - :name :get-log :enabled? :write) - +(declare *impl-name* impl-get-log impl-enabled? impl-write!) + +;; Macros used so that implementation-specific functions all have the same meta. + +(defmacro def-impl-name + #^{:private true} [& body] + `(def + #^{:doc "The name of the logging implementation used."} + *impl-name* + ~@body)) + +(defmacro def-impl-get-log + #^{:private true} [& body] + `(def + #^{:doc + "Returns an implementation-specific log by string namespace. End-users should + not need to call this function." + :arglist '([~'log-ns])} + impl-get-log + (memoize ~@body))) + +(defmacro def-impl-enabled? + #^{:private true} [& body] + `(def + #^{:doc + "Implementation-specific check if a particular level is enabled. End-users + should not need to call this function." + :arglist '([~'log ~'level])} + impl-enabled? + ~@body)) + +(defmacro def-impl-write! + #^{:private true} [& body] + `(def + #^{:doc + "Implementation-specific write of a log message. End-users should not need to + call this function." + :arglist '([~'log ~'level ~'message ~'throwable])} + impl-write! + ~@body)) (defmacro commons-logging - "Creates a log-system struct using the Apache commons-logging API, - if present, otherwise nil. End-users should not need to invoke this macro." + "Defines the commons-logging-based implementations of the core logging + functions. End-users should never need to call this macro." + #^{:private true} [] (try (import (org.apache.commons.logging LogFactory Log)) - `(letfn [(get-log# [log-ns#] - (LogFactory/getLog #^String log-ns#)) - (enabled?# [#^org.apache.commons.logging.Log log# level#] - (condp = level# - :trace (.isTraceEnabled log#) - :debug (.isDebugEnabled log#) - :info (.isInfoEnabled log#) - :warn (.isWarnEnabled log#) - :error (.isErrorEnabled log#) - :fatal (.isFatalEnabled log#))) - (write# [#^org.apache.commons.logging.Log 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#)) + `(do + (def-impl-name "org.apache.commons.logging") + (def-impl-get-log + (fn [log-ns#] + (org.apache.commons.logging.LogFactory/getLog #^String log-ns#))) + (def-impl-enabled? + (fn [#^org.apache.commons.logging.Log log# level#] + (condp = level# + :trace (.isTraceEnabled log#) + :debug (.isDebugEnabled log#) + :info (.isInfoEnabled log#) + :warn (.isWarnEnabled log#) + :error (.isErrorEnabled log#) + :fatal (.isFatalEnabled log#)))) + (def-impl-write! + (fn [#^org.apache.commons.logging.Log 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#)))) + true) (catch Exception e nil))) (defmacro log4j-logging - "Creates a log-system struct using the log4j API, if present, otherwise nil. - End-users should not need to invoke this macro." + "Defines the log4j-based implementations of the core logging functions. + End-users should never need to call this macro." + #^{:private true} [] (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# [log-ns#] - (org.apache.log4j.Logger/getLogger #^String log-ns#)) - (enabled?# [#^org.apache.log4j.Logger log# level#] - (.isEnabledFor log# (levels# level#))) - (write# [#^org.apache.log4j.Logger 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#))) + `(do + (def-impl-name "org.apache.log4j") + (def-impl-get-log + (fn [log-ns#] + (org.apache.log4j.Logger/getLogger #^String log-ns#))) + (let [levels# {:trace org.apache.log4j.Level/TRACE + :debug org.apache.log4j.Level/DEBUG + :info org.apache.log4j.Level/INFO + :warn org.apache.log4j.Level/WARN + :error org.apache.log4j.Level/ERROR + :fatal org.apache.log4j.Level/FATAL}] + (def-impl-enabled? + (fn [#^org.apache.log4j.Logger log# level#] + (.isEnabledFor log# (levels# level#)))) + (def-impl-write! + (fn [#^org.apache.log4j.Logger log# level# msg# e#] + (if-not e# + (.log log# (levels# level#) msg#) + (.log log# (levels# level#) msg# e#))))) + true) (catch Exception e nil))) (defmacro java-logging - "Creates a log-system struct using the java.util.logging API. End-users - should not need to invoke this macro." + "Defines the java-logging-based implementations of the core logging + functions. End-users should never need to call this macro." + #^{:private true} [] (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# [log-ns#] - (java.util.logging.Logger/getLogger log-ns#)) - (enabled?# [#^java.util.logging.Logger log# level#] - (.isLoggable log# (levels# level#))) - (write# [#^java.util.logging.Logger log# level# msg# e#] - (if-not e# - (.log log# #^java.util.logging.Level (levels# level#) - #^String (str msg#)) - (.log log# #^java.util.logging.Level (levels# level#) - #^String (str msg#) #^Throwable e#)))] - (struct log-system "java-logging" get-log# enabled?# write#))) + `(do + (def-impl-name "java.util.logging") + (def-impl-get-log + (fn [log-ns#] + (java.util.logging.Logger/getLogger log-ns#))) + (let [levels# {:trace java.util.logging.Level/FINEST + :debug java.util.logging.Level/FINE + :info java.util.logging.Level/INFO + :warn java.util.logging.Level/WARNING + :error java.util.logging.Level/SEVERE + :fatal java.util.logging.Level/SEVERE}] + (def-impl-enabled? + (fn [#^java.util.logging.Logger log# level#] + (.isLoggable log# (levels# level#)))) + (def-impl-write! + (fn [#^java.util.logging.Logger log# level# msg# e#] + (if-not e# + (.log log# #^java.util.logging.Level (levels# level#) + #^String (str msg#)) + (.log log# #^java.util.logging.Level (levels# level#) + #^String (str msg#) #^Throwable e#))))) + true) (catch Exception e nil))) -(defn do-log - "Logs the message immediately if the specific logging level is enabled. Use - the log macro in preference to this function." - [system-ref level message throwable log-ns] - (let [system @system-ref - log ((system :get-log) log-ns)] - (if ((system :enabled?) log level) - ((system :write) log level (force message) throwable)) - system-ref)) +;; Initialize implementation-specific functions +(or (commons-logging) + (log4j-logging) + (java-logging) + (throw ; this should never happen in 1.5+ + (RuntimeException. + "Valid logging implementation could not be found."))) (def #^{:doc - "An atom holding the default log-system initialized to the first - implementation found from: Apache commons-logging, log4j, java.util.logging."} - *log-system* - (atom (or (commons-logging) - (log4j-logging) - (java-logging) - (throw ; this should never happen in 1.5+ - (RuntimeException. - "Valid logging implementation could not be found."))))) + "The default agent used for performing logging durng a transaction or when + direct logging is disabled."} + *logging-agent* (agent nil)) (def #^{:doc - "The default agent referencing *log-system*."} - *log-system-agent* (agent *log-system*)) + "A boolean indicating whether direct logging (as opposed to via an agent) is + allowed when not operating from within a transaction. Defaults to true."} + *allow-direct-logging* (atom true)) -(def #^{:doc - "A boolean atom indicating whether direct logging (as opposed to via an agent) - is allowed when not operating from within a transaction. Defaults to false."} - *allow-direct-logging* (atom false)) +(defn agent-write! + "Writes the message immediately, and ignores the first argument. Used by the + logging agent. End-users should never need to call this function." + [_ log level message throwable] + (impl-write! log level message throwable)) (defmacro log - "Logs a message, either directly or via an agent. See also the level-specific + "Logs a message, either directly or via an agent. Also see the level-specific convenience macros." ([level message] `(log ~level ~message nil)) ([level message throwable] `(log ~level ~message ~throwable ~(str *ns*))) ([level message throwable log-ns] - `(if (and @*allow-direct-logging* - (not (clojure.lang.LockingTransaction/isRunning))) - (do-log *log-system* ~level (delay ~message) ~throwable ~log-ns) - (send-off *log-system-agent* - do-log ~level (delay ~message) ~throwable ~log-ns)))) + `(let [log# (impl-get-log ~log-ns)] + (if (impl-enabled? log# ~level) + (if (and @*allow-direct-logging* + (not (clojure.lang.LockingTransaction/isRunning))) + (impl-write! log# ~level ~message ~throwable) + (send-off *logging-agent* + agent-write! log# ~level ~message ~throwable)))))) (defmacro enabled? @@ -194,8 +236,7 @@ ([level] `(enabled? ~level ~(str *ns*))) ([level log-ns] - `(let [sys# @*log-system*] - ((sys# :enabled?) ((sys# :get-log) ~log-ns) ~level)))) + `(impl-enabled? (impl-get-log ~log-ns) ~level))) (defmacro spy @@ -222,7 +263,8 @@ (def #^{:doc "A ref used by log-capture! to maintain a reference to the original System.out - and System.err streams."} + and System.err streams." + :private true} *old-std-streams* (ref nil)) @@ -305,4 +347,3 @@ `(log :fatal ~message)) ([message throwable] `(log :fatal ~message ~throwable))) - diff --git a/src/clojure/contrib/pprint.clj b/src/clojure/contrib/pprint.clj index f11d0a71..2c6c34f6 100644 --- a/src/clojure/contrib/pprint.clj +++ b/src/clojure/contrib/pprint.clj @@ -14,13 +14,14 @@ (ns #^{:author "Tom Faulhaber", :doc "This module comprises two elements: -1) A pretty printer for Clojure data structures, implemented in the function \"pprint\" -2) A Common Lisp compatible format function, implemented as \"cl-format\" because - Clojure is using the name \"format\" for its own format. +1) A pretty printer for Clojure data structures, implemented in the + function \"pprint\" +2) A Common Lisp compatible format function, implemented as + \"cl-format\" because Clojure is using the name \"format\" + for its Java-based format function. -Complete documentation is available on the wiki at the contrib google code site.", - :see-also [["PrettyPrinting" "Documentation for the pretty printer"] - ["CommonLispFormat" "Documentation for Common Lisp format function"]] +See documentation for those functions for more information or complete +documentation on the the clojure-contrib web site on github.", } clojure.contrib.pprint (:use clojure.contrib.pprint.utilities) |