Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Tree: 7d241fc1e2
Fetching contributors…

Cannot retrieve contributors at this time

357 lines (322 sloc) 14.396 kB
(ns cd-analyzer.database
(:use [cd-analyzer.util]
[clojure.pprint :only (pprint)]
[clojure.contrib.string :only (as-str)])
(:require [ :as jdbc]
[clojure.string :as str])
(:import [ File]))
;; From autodoc
(defn remove-leading-whitespace
"Find out what the minimum leading whitespace is for a doc block and remove it.
We do this because lots of people indent their doc blocks to the indentation of the
string, which looks nasty when you display it."
(when s
(let [lines (.split s "\\n")
prefix-lens (map #(count (re-find #"^ *" %))
(filter #(not (= 0 (count %)))
(next lines)))
min-prefix (when (seq prefix-lens) (apply min prefix-lens))
regex (when min-prefix (apply str "^" (repeat min-prefix " ")))]
(if regex
(apply str (interpose "\n" (map #(.replaceAll % regex "") lines)))
;; TODO: where'd I get this?!
;;==== Internal functions ======================================================
(defn- join
"Joins the items in the given collection into a single string separated
with the string separator."
[separator col]
(apply str (interpose separator col)))
(defn- sql-for-insert
"Converts a table identifier (keyword or string) and a hash identifying
a record into an sql insert statement compatible with prepareStatement
Returns [sql values-to-insert]"
[table record]
(let [table-name (as-str table)
columns (map as-str (keys record))
values (vals record)
n (count columns)
template (join "," (replicate n "?"))
column-names (join "," columns)
sql (format "insert into %s (%s) values (%s)"
table-name column-names template)]
[sql values]))
;;==== Functions/macros for use by macros ======================================
(defn run-chained
"Runs the given database insert functions on the given
database spec within a transaction. Each function is passed a hash
identifying the keys of the previous inserts."
[db insert-fns]
(jdbc/with-connection db
(loop [id {}
todo insert-fns]
(if (empty? todo)
(let [[table insert-fn] (first todo)
inserted-id (insert-fn id)]
(recur (assoc id table inserted-id)
(rest todo))))))))
(defmacro build-insert-fns
"Converts a vector of [:table { record }] into a vector of database
insert functions."
(for [[table record] (partition 2 table-records)]
`[~table (fn [~'id]
(insert-record ~table ~record))])))
;;==== Functions/macros for external use =======================================
(defmacro insert-with-id
"Insert records within a single transaction into the database described by
the given db spec. The record format is :table { record-hash }.
The record hashes can optionally access a hashmap 'id' which holds the
autogenerated ids of previous inserts keyed by the table name. e.g.
(insert-with-id db-spec
:department {:name \"xfiles\"
:location \"secret\"}
:employee {:department (id :department)
:name \"Mr X\"})"
[db & table-records]
`(let [insert-fns# (build-insert-fns ~table-records)]
(run-chained ~db insert-fns#)))
(def ^{:dynamic true} *db* {:classname "com.mysql.jdbc.Driver"
:subprotocol "mysql"
:subname "//localhost:3306/clojuredocs_development?user=root&password="
:create true
:username "root"
:password ""})
(defn query-lib-stats [libdef]
(jdbc/with-connection *db*
(let [lib-stats (jdbc/with-query-results rs ["select * from libraries where name = ?" (:name libdef)]
(first rs))]
(when lib-stats (assoc lib-stats
:var-count -1))))))
(defn insert-or-update
[test-fn update-fn insert-fn]
(jdbc/with-connection *db*
(let [existing (test-fn)]
(if existing (update-fn existing) (insert-fn))))))
(defn sql-now [] (java.sql.Timestamp. (System/currentTimeMillis)))
(defn url-friendly [s]
(-> s
(str/replace #"\s" "_")))
(defn store-lib [libdef]
(let [name (:name libdef)
version (:version libdef)
description (:description libdef)
site-url (:site-url libdef)
source-base-url (:web-src-dir libdef)
copyright (:copyright libdef)
license (:license libdef)
test (fn []
(jdbc/with-query-results rs ["select * from libraries where name = ? and version=? limit 1" name version]
(first (doall rs))))
update (fn [existing]
(jdbc/update-values :libraries
["id = ?" (:id existing)]
{:description description
:site_url site-url
:source_base_url source-base-url
:copyright copyright
:license license
:version version
:updated_at (sql-now)
:url_friendly_name (url-friendly name)}))
insert (fn []
(jdbc/insert-values :libraries
(url-friendly name)
(insert-or-update test update insert)))
(defn query-var [namespace-id name version]
(jdbc/with-connection *db*
["select * from functions where namespace_id=? and name=? and version=?" namespace-id name version]
(first rs)))))
(defn query-ns [ns version]
(jdbc/with-connection *db*
["select * from namespaces where name=? and version=?" ns version]
(first rs)))))
(defn query-library [name version]
(jdbc/with-connection *db*
["select * from libraries where name=? and version=?" name version]
(first rs)))))
(defn store-var-map [library ns var-map]
(let [{:keys [ns name file line arglists added doc source]} var-map
version (:version library)]
(jdbc/with-connection *db*
(let [namespace (query-ns ns version)
existing (query-var (:id namespace) name version)]
(if namespace
(if existing
["id=?" (:id existing)]
{:namespace_id (:id namespace)
:version version
:name (str name)
:file file
:line line
:arglists_comp (apply str (interpose "|" arglists))
:added added
:doc doc
:shortdoc (if (:shortdoc existing) (:shortdoc existing) (apply str (take 70 doc)))
:source source
:updated_at (java.sql.Timestamp. (System/currentTimeMillis))
:url_friendly_name (url-friendly name)})
[:namespace_id :version :name :file :line :arglists_comp :added :doc :shortdoc :source :updated_at :created_at :url_friendly_name]
[(:id namespace)
(str name)
(apply str (interpose "|" arglists))
(apply str (take 70 doc))
(java.sql.Timestamp. (System/currentTimeMillis))
(java.sql.Timestamp. (System/currentTimeMillis))
(url-friendly name)]))
(println "Namespace" ns "not found, skipping insert of " name))))))
(catch Exception e (println (str (:name var-map) " -- " e)))))
(defn lookup-var-id [var-map]
(jdbc/with-query-results rs ["select * from functions where ns = ? and name = ? limit 1" (str (:ns var-map)) (str (:name var-map))]
(:id (first rs)))))
(defn remove-stale-vars [libname timestamp]
#_(let [to-remove
(jdbc/with-connection *db*
(jdbc/with-query-results rs ["select * from functions where library = ? and (updated_at < ? or updated_at is NULL)" libname (java.sql.Timestamp. timestamp)]
(doall rs))))
ids (map :id to-remove)]
(jdbc/with-connection *db*
(doseq [id ids]
(jdbc/delete-rows :functions ["id=?" id]))))
(jdbc/with-connection *db*
(doall (map #(jdbc/delete-rows :function_references ["from_function_id=?" %]) ids))
(doall (map #(jdbc/delete-rows :function_references ["to_function_id=?" %]) ids))))
(doall (seq to-remove))))
(defn store-ns-map [library ns-map]
(jdbc/with-connection *db*
(if-let [existing-lib (query-library (:name library) (:version library))]
(let [lib-id (:id existing-lib)
name (str (:name ns-map))
web-path (:web-path ns-map)
doc (:doc ns-map)
doc (remove-leading-whitespace (if doc doc ""))
existing (jdbc/with-query-results rs ["select * from namespaces where name = ? and version=? limit 1" name (:version library)] (first (doall rs)))]
(if existing
(jdbc/update-values :namespaces
["id=?" (:id existing)]
{:name name
:doc doc
:source_url web-path
:updated_at (sql-now)
:version (:version library)
:library_id (:id existing-lib)})
(jdbc/insert-values :namespaces
[name doc web-path
(:version library)
(:id existing-lib)])))
(println "!! Couldn't find library in database" (:name library) (:version library))))))
(defn store-var-references [var-map]
(when-let [vars-in (:vars-in var-map)]
(jdbc/with-connection *db*
(when-let [from-id (lookup-var-id var-map)]
(let [to-ids (map lookup-var-id vars-in)]
(doseq [to-id to-ids]
(when (not (nil? to-id))
(let [existing (jdbc/with-query-results rs
["select * from function_references where from_function_id = ? and to_function_id = ? limit 1" from-id to-id]
(first (doall rs)))]
(when (not existing)
(jdbc/insert-records :function_references {:from_function_id from-id :to_function_id to-id})))))
(catch Exception e
(reportln "Exception in store-var-references: ")
(reportln var-map " -> " (.getMessage e))
(def ccld {:name "Clojure Core"
:root-dir "/Users/zkim/clojurelibs/clojure"
:src-dir "/Users/zkim/clojurelibs/clojure/src"
:description "Clojure core environment and runtime library."
:site-url ""
:source-base-url ""
:copyright "&copy Rich Hickey. All rights reserved."
:license "<a href=\"\">Eclipse Public License 1.0</a>"}))
(defn track-import-start [libdef]
(jdbc/with-connection *db*
(when-let [libid (jdbc/with-query-results rs ["select id from libraries where name=?", (:name libdef)]
(:id (first rs)))]
(jdbc/insert-record :library_import_tasks
{:library_id libid
:status "RUNNING"
:created_at (java.sql.Timestamp. (System/currentTimeMillis))
:updated_at (java.sql.Timestamp. (System/currentTimeMillis))})))))
(defn track-import-end [task-id lib-stats]
(when (contains? lib-stats :status)
(jdbc/with-connection *db*
(jdbc/update-values :library_import_tasks
["id = ?" task-id]
(assoc lib-stats
:updated_at (java.sql.Timestamp. (System/currentTimeMillis))))))))
(defn import-log [task-id level message]
(jdbc/with-connection *db*
(jdbc/insert-record :library_import_logs
{:library_import_task_id task-id
:level (as-str level)
:message message
:created_at (java.sql.Timestamp. (System/currentTimeMillis))}))))
Jump to Line
Something went wrong with that request. Please try again.