Compojure and SQLite Part 2

Continuing from the previous post, I added table inserts. In addition, I started adding some decorators to help avoid repeating code. Since there was some refactoring, many functions changed a lot.

Here's the top chunk:
(ns db-edit
(:require [clojure.contrib.sql :as sql])
(:use clojure.contrib.json.write)
(:use compojure))

; Information about the SQLite database
(def db-params {:classname "org.sqlite.JDBC"
:subprotocol "sqlite"
:subname "./database.sqlite"})

(def http-error-map
{400 {:name "Bad Request"
:long "The request could not be understood by the server due to malformed syntax."}
401 {:name "Unauthorized"
:long "The request requires user authentication."} ; Note WWW-Authenticate header should be added
404 {:name "Not Found"
:long "The server has not found anything matching the Request-URI."}})

(defn error [err]
(if-let [errMap (get http-error-map err)]
{:status err
:headers {}
:body (str "HTTP error " err ": " (get errMap :name) "\n" (get errMap :long))}
{:status err
:headers {}
:body (str "HTTP Error " err " encountered")}))

(defn sanitize-sql
"Cleans the string of nasty SQL related special chars"
[s]
(. s (replaceAll "/[\\s'\";#%]/" "")))

(defn cleanPath
"Sanitize the incoming string for '..'"
[p]
(.. p (replaceAll "/\\.+" "/") (replaceAll "/+" "/")))

(defn log [ level & rest ]
(if (== level :debug)
(. org.mortbay.log.Log info (str rest))
(if (== level :info)
(. org.mortbay.log.Log debug (str rest))
(. org.mortbay.log.Log warn (str rest)))))


None of that code change, although I did add the log function to help with debugging. It just sends messages to the Jetty log since I'm using Jetty as the servlet container.

The three functions for retrieving data were simplified a little. They no longer have sql/with-connection or json-str. The functions now have nothing specific to compojure or the web, and they don't have anything for setting up the database connection. The functions are now much more focused on exactly what they are intended to do. Here are the new definitions:
(defn get-table-meta
"Demonstrate getting table info"
[f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil)))))

(defn get-column-meta
"Given a table name, return a collection of the field names"
[t f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getColumns nil nil t nil)))))

(defn get-table
"Given a table name, return a collection of structmaps for all the data in the table"
[t]
(sql/with-query-results
res
[(str "SELECT * FROM " (sanitize-sql t))]
(into [] res)))


In order to make sure those functions have a database connection and have their output converted to JSON, I added two chunks of middleware:
(defn with-db
[handler]
(fn [request]
(sql/with-connection db-params (handler request))))

(defn with-json
[handler]
(fn [request]
(json-str (handler request))))


In Compojure, middleware is a wrapper around the request handlers. Middleware functions return a function that does something either to the request before it calls the request handler, or something to the response of the handler. In the first example above, the with-db function calls the handler as the body of the sql/with-connection function. There's no magic here. A handler function used to look like:
(defn get-table-meta
"Demonstrate getting table info"
[f]
(sql/with-connection db-params (map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil))))))


But with the decorator, calling with-connection is factored out.

In the second example decorator with-json, the result of the handler is converted to a JSON string. This has the potential for causing problems. If a handler can return an error code or a response map it won't return an error or the expected response; it'll return the json string version of the error and response map. Fortunately, decorators have to be explicitly added to handlers:

(defn tables-handler [request]
(get-table-meta table-name))
(defn columns-handler [request]
(get-column-meta (:table (:params request)) column-name))
(defn table-handler [request]
(get-table (:table (:params request))))
(defn insert-handler [request]
(insert-row (:table (:params request)) (dissoc (conj (:params request) {}) :table)))

(decorate tables-handler (with-json) (with-db))
(decorate table-handler (with-json) (with-db))
(decorate columns-handler (with-json) (with-db))
(decorate insert-handler (with-json) (with-db))

(defroutes my-routes
(POST "/insert/:table" insert-handler)
(ANY "/columns/:table" columns-handler)
(ANY "/table/:table" table-handler)
(ANY "/tables" tables-handler)
(ANY "/*" (or (serve-file "./static" (cleanPath (params :*))) :next))
(ANY "/*" (error 400)))

(run-server {:port 8080}
"/*" (servlet my-routes))


As you can see the route definitions now use simple function handler functions. While before one of the routes was (ANY "/columns/:table" (get-column-meta (params :table) column-name)) it's now (ANY "/columns/:table" columns-handler) and the columns-handler function takes care of pulling out the arguments from the request and calling the get-column-meta function. This way the decorators can be added to the handlers, and keeps logic out of the otherwise simple path specification of the defroutes.

Inserting a new record is pretty simple:
(defn insert-row [table fields]
(sql/insert-records table fields)
["Added record", fields])


That's it. The with-db decorator is added so it has a db connection to use, and the handler takes care of making sure the arguments are correct.

Here's the full code:

./db-edit.clj:
(ns db-edit
(:require [clojure.contrib.sql :as sql])
(:use clojure.contrib.json.write)
(:use compojure))

; Information about the SQLite database
(def db-params {:classname "org.sqlite.JDBC"
:subprotocol "sqlite"
:subname "./database.sqlite"})

(def http-error-map
{400 {:name "Bad Request"
:long "The request could not be understood by the server due to malformed syntax."}
401 {:name "Unauthorized"
:long "The request requires user authentication."} ; Note WWW-Authenticate header should be added
404 {:name "Not Found"
:long "The server has not found anything matching the Request-URI."}})

(defn error [err]
(if-let [errMap (get http-error-map err)]
{:status err
:headers {}
:body (str "HTTP error " err ": " (get errMap :name) "\n" (get errMap :long))}
{:status err
:headers {}
:body (str "HTTP Error " err " encountered")}))

(defn sanitize-sql
"Cleans the string of nasty SQL related special chars"
[s]
(. s (replaceAll "/[\\s'\";#%]/" "")))

(defn cleanPath
"Sanitize the incoming string for '..'"
[p]
(.. p (replaceAll "/\\.+" "/") (replaceAll "/+" "/")))

(defn log [ level & rest ]
(if (== level :debug)
(. org.mortbay.log.Log info (str rest))
(if (== level :info)
(. org.mortbay.log.Log debug (str rest))
(. org.mortbay.log.Log warn (str rest)))))

(defn with-db
[handler]
(fn [request]
(sql/with-connection db-params (handler request))))

(defn with-json
[handler]
(fn [request]
(json-str (handler request))))

(defn get-table-meta
"Demonstrate getting table info"
[f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getTables nil nil nil nil)))))

(defn get-column-meta
"Given a table name, return a collection of the field names"
[t f]
(map f
(resultset-seq
(-> (sql/connection)
(.getMetaData)
(.getColumns nil nil t nil)))))

(defn get-table
"Given a table name, return a collection of structmaps for all the data in the table"
[t]
(sql/with-query-results
res
[(str "SELECT * FROM " (sanitize-sql t))]
(into [] res)))

(defn table-name
"Given a mapstruct from the get-table-meta function, give back a string"
[t]
(:table_name t))

(defn column-name
"Given a mapstruct from the table-col-names, give back the column name"
[c]
(:column_name c))

(defn insert-row [table fields]
(sql/insert-records table fields)
["Added record", fields])

(defn tables-handler [request]
(get-table-meta table-name))
(defn columns-handler [request]
(get-column-meta (:table (:params request)) column-name))
(defn table-handler [request]
(get-table (:table (:params request))))
(defn insert-handler [request]
(insert-row (:table (:params request)) (dissoc (conj (:params request) {}) :table)))

(decorate tables-handler (with-json) (with-db))
(decorate table-handler (with-json) (with-db))
(decorate columns-handler (with-json) (with-db))
(decorate insert-handler (with-json) (with-db))

(defroutes my-routes
(POST "/insert/:table" insert-handler)
(ANY "/columns/:table" columns-handler)
(ANY "/table/:table" table-handler)
(ANY "/tables" tables-handler)
(ANY "/*" (or (serve-file "./static" (cleanPath (params :*))) :next))
(ANY "/*" (error 400)))

(run-server {:port 8080}
"/*" (servlet my-routes))


static/index.html:
<script type="text/javascript">
// You may specify partial version numbers, such as "1" or "1.3",
// with the same result. Doing so will automatically load the
// latest version matching that partial revision pattern
// (i.e. both 1 and 1.3 would load 1.3.2 today).
google.load("jquery", "1.3.2");
google.load("jqueryui", "1.7.1");
google.setOnLoadCallback(function() {
loadTableNames();
});
</script>
<script type="text/javascript"
src="db-edit.js"></script>
</head>
<body>
<h1>DB Edit</h1>
<div id="content"></div>
</body>
</html>


static/db-edit.js
function tableNamesJSON(json) {
var str="<ul>\n";
$.each(json, function(i, t) {
str+=" <li><a href='#' onClick='loadTable(\""+t+"\")'>"+t+"</a></li>\n";
});
str+="</ul>\n";
return str;
}

function loadTableNames() {
$.getJSON("/tables", function(data, textStatus) {
$("#content").html(tableNamesJSON(data));
});
}

function tableDataJSON(json, columns) {
var str="";
$.each(json, function(i, r) {
str+=" <tr>\n"
$.each(r, function(j, c) {
str+=" <td>"+c+"</td>\n";
});
str+=" </tr>\n"
});
return str;
}

function columnsJSON(json) {
var str="";
$.each(json, function(i, c) {
str+=" <td>"+c+"</td>\n";
});
return str;
}

function loadTable(t) {
$("#content").html("<table id='t' border='1'><tr id='t_head'></tr></table>");
$.getJSON("/columns/"+t, function(data, status) {
$("#t_head").html(columnsJSON(data));
loadTableData(t, data);
});
$("#content").append(createInsertForm(t));
}

function loadTableData(t, columns) {
$.getJSON("/table/"+t, function(data, textStatus) {
$("#t").append(tableDataJSON(data, columns));
});
}

function createInsertForm(t) {
$.getJSON("/columns/"+t, function(data, status) {
var str="<form method='POST' action='/insert/"+t+"'>\n";
$.each(data, function(i, c) {
str+=" "+c+": <input type='text' name='"+c+"'>\n";
numCol=i;
});
str+=" <input type='submit'>\n";
str+="</form>";
$("#content").append(str);
});
}


Update: Escape JS and HTML. Thanks to a handy dandy page.