4 files changed, 83 insertions(+), 3 deletions(-)

A database.lisp
M packages.lisp
M server.lisp
M wikisophy.asd

@@ 0,0 1,67 @@
+(in-package wikisophy.database)
+
+(defparameter *database* "wikisophy.db")
+(clsql-sys:file-enable-sql-reader-syntax)
+
+;; let's see if we need this
+;; (defun make-keyword (string)
+;;   "Return string as a keyword. Good for use in association lists."
+;;   (values (intern string "KEYWORD")))
+
+(defun database-exists-p (db)
+  "Check if database DB exists. DB is an sqlite3 database's filename."
+  (clsql:probe-database db :database-type :sqlite3))
+
+(defun connect ()
+  "Initiate connection to *database*."
+  (when (database-exists-p *database*)
+    (clsql:connect *database* :database-type :sqlite3)))
+
+;; adjacency list model
+
+(defparameter *adjacency-list-model*
+  '(([id] integer :primary-key :unique)
+    ([title] varchar :unique :collate nocase)
+    ([parent_id] integer)))
+
+(defun create-adjacency-list-table (table-name)
+  "Create the table NAME in the DB."
+  (if (not (clsql:table-exists-p table-name))
+      (clsql:create-table table-name *adjacency-list-model*)
+      "The table already exists!"))
+
+(defun get-id-by-title (title)
+  "Return the id of TITLE." 
+  (caar (clsql:select [id] :from [adj_list] :where [[= [title] title] [collate nocase]])))
+
+(defun get-parent-by-title (title)
+  "Return the parent_id of TITLE." 
+  (caar (clsql:select [parent_id] :from [adj_list] :where [= [title] title])))
+
+(defun get-title-by-id (id)
+  "Return the title of ID."
+  (caar (clsql:select [title] :from [adj_list] :where [= [id] id])))
+
+(defun clear-underscores (string)
+  "Given a string replace any underscores with spaces."
+  (substitute #\SPACE #\_ string))
+
+(defun insert-path (path &optional parent-id)
+  "Given a path of strings, insert them properly in database, by
+  filling the appropriate parent_ids."
+  (when path
+    (let ((current (clear-underscores (car path))))
+      (when (not (get-id-by-title current))
+	  (clsql:insert-records :into [adj_list]
+				:attributes '(title parent_id)
+				:values `(,current ,parent-id)))
+      (insert-path (cdr path) (get-id-by-title current)))))
+
+(defun get-path (title)
+  "Given the title of an entry return it's path up to the root of the
+  tree."
+  (let ((parent (get-parent-by-title title)))
+    (if parent
+	(cons (caar (clsql:select [title] :from [adj_list] :where [= [title] title]))
+	 (get-path (get-title-by-id parent)))
+	`(,(caar (clsql:select [title] :from [adj_list] :where [= [title] title]))))))

@@ 2,5 2,10 @@
   (:use :cl)
   (:export :path-to-philosophy))
 
+(defpackage wikisophy.database
+  (:use :cl)
+  (:export :insert-path
+	   :get-path))
+
 (defpackage wikisophy.server
-  (:use :cl))
+  (:use :cl :wikisophy.database))

@@ 5,7 5,12 @@
 philosophy in json format."
   (setf (hunchentoot:content-type*) "application/json")
   (setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*")
-  (cl-json:encode-json-to-string (wikisophy.crawler:path-to-philosophy query)))
+  (let ((path (get-path query)))
+    (if path
+	(cl-json:encode-json-to-string path)
+	(progn
+	  (insert-path (reverse (wikisophy.crawler:path-to-philosophy query)))
+	  (cl-json:encode-json-to-string (get-path query))))))
 
 (defvar *server* (make-instance 'hunchentoot:easy-acceptor :port 4242))
 (hunchentoot:start *server*)

@@ 18,7 18,10 @@
   :depends-on (:hunchentoot
 	       :drakma
 	       :cl-json
-	       :lquery)
+	       :lquery
+	       :clsql
+	       :clsql-sqlite3)
   :components ((:file "packages")
 	       (:file "crawler")
+	       (:file "database")
 	       (:file "server")))