From: ueno <ueno>
Date: Wed, 4 Feb 2004 07:51:25 +0000 (+0000)
Subject: * lsdb-to-rdfdb.el: Don't require 'rdfdb; save database in ~/.lsdb.nt.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0772032b86f5cb69277fe931e42297fd555928ea;p=elisp%2Flsdb.git

* lsdb-to-rdfdb.el: Don't require 'rdfdb; save database in ~/.lsdb.nt.
(lsdb-rdfdb-prepare-record-triples): Rename from add-entry-triples.
* lsdb.el: Require 'rdfdb.
(lsdb-rdfdb-file): New user option.
(lsdb-use-rdfdb): New user option.
(lsdb-rdfdb-database): New variable.
(lsdb-rdfdb-namespace-uri): New constant.
(lsdb-rdfdb-maybe-load-database): New function.
(lsdb-rdfdb-convert-triples-to-alist): New function.
(lsdb-rdfdb-lookup-records): New function.
(lsdb-mode-lookup): Use RDFDB.
* rdfdb.el (rdfdb-literal-resource-uri-prefix): Change.
(rdfdb-prime-list): Abolish.
(rdfdb-make-database): Use only native hash-tables; don't pick up
literals from " *rdfdb literals*" buffer.
(rdfdb-database-key-index): Rename from rdfdb-database-key-obarray.
(rdfdb-database-set-key-index): Rename from rdfdb-database-set-key-obarray.
(rdfdb-database-literal-index): Rename from rdfdb-database-literal-buffer.
(rdfdb-database-literal-reverse-index): New inline function.
(rdfdb-database-set-literal-reverse-index): New inline function.
(rdfdb-clear-database): Follow changes of rdfdb-database structure.
(rdfdb-find-key): Ditto.
(rdfdb-get-key): Ditto.
(rdfdb-get-literal-resource): Ditto.
(rdfdb-find-literal): Ditto.
---

diff --git a/lsdb-to-rdfdb.el b/lsdb-to-rdfdb.el
index 8ea9f32..e33e093 100644
--- a/lsdb-to-rdfdb.el
+++ b/lsdb-to-rdfdb.el
@@ -1,32 +1,37 @@
 (require 'lsdb)
-(require 'rdfdb)
 
-(defun add-entry-triples (database identity name values)
-  (while values
-    (rdfdb-add-triple database
-		      (rdfdb-make-triple
-		       identity
-			(concat rdfdb-namespace-uri "/entry#" name)
-		       (rdfdb-get-literal-resource database (car values))))
-    (setq values (cdr values))))
+(defun lsdb-rdfdb-prepare-record-triples (identity entries)
+  (let (triples
+	value)
+  (while entries
+    (setq value (if (listp (cdr (car entries)))
+		    (cdr (car entries))
+		  (list (cdr (car entries)))))
+    (while value
+      (setq triples (cons (rdfdb-make-triple
+			   identity
+			   (concat lsdb-rdfdb-namespace-uri "/entry#"
+				   (capitalize
+				    (symbol-name (car (car entries)))))
+			   (rdfdb-get-literal-resource lsdb-rdfdb-database
+						       (car value)))
+			  triples)
+	    value (cdr value)))
+    (setq entries (cdr entries)))
+  triples))
 
 (lsdb-maybe-load-hash-tables)
-(setq database (rdfdb-make-database))
-
+(setq lsdb-rdfdb-database (rdfdb-make-database))
+(setq debug-on-error t)
 (lsdb-maphash
  (lambda (key value)
-   (let ((identity (rdfdb-get-internal-resource database))
-         values)
-     (add-entry-triples database identity "Name" (list key))
-     (while value
-       (add-entry-triples
-	database
-	identity
-	(capitalize (symbol-name (car (car value))))
-	(if (listp (cdr (car value)))
-	   (cdr (car value))
-	 (list (cdr (car value)))))
-       (setq value (cdr value)))))
+   (let* ((identity (rdfdb-get-internal-resource lsdb-rdfdb-database))
+	  (triples  (lsdb-rdfdb-prepare-record-triples identity
+						       (cons (cons 'name key)
+							     value))))
+     (while triples
+       (rdfdb-add-triple lsdb-rdfdb-database (car triples))
+       (setq triples (cdr triples)))))
  lsdb-hash-table)
 
-(rdfdb-save-database database ".rdfdb")
+(rdfdb-save-database lsdb-rdfdb-database lsdb-rdfdb-file)
diff --git a/lsdb.el b/lsdb.el
index 8f76dfd..0062644 100644
--- a/lsdb.el
+++ b/lsdb.el
@@ -61,6 +61,7 @@
 (require 'pces)
 (require 'mime)
 (require 'static)
+(require 'rdfdb)
 
 ;;;_* USER CUSTOMIZATION VARIABLES:
 (defgroup lsdb nil
@@ -291,6 +292,16 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
   :type 'boolean
   :group 'lsdb)
 
+(defcustom lsdb-rdfdb-file (expand-file-name "~/.lsdb.nt")
+  "The name of the Lovely Sister Database file (RDFDB)."
+  :group 'lsdb
+  :type 'file)
+
+(defcustom lsdb-use-rdfdb nil
+  "If non-nil, use RDFDB to store records."
+  :type 'boolean
+  :group 'lsdb)
+
 ;;;_. Faces
 (defface lsdb-header-face
   '((t (:underline t)))
@@ -350,6 +361,12 @@ It represents address to full-name mapping.")
 The function is called with one argument, the buffer to be displayed.
 Overrides `temp-buffer-show-function'.")
 
+(defvar lsdb-rdfdb-database nil)
+
+(defconst lsdb-rdfdb-namespace-uri
+  "http://lsdb.sourceforge.jp/xmlns/1.0"
+  "Base URI of the LSDB entry resources.")
+
 ;;;_. Hash Table Emulation
 (if (and (fboundp 'make-hash-table)
 	 (subrp (symbol-function 'make-hash-table)))
@@ -585,6 +602,35 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (setq lsdb-hash-table (lsdb-make-hash-table :test 'equal)))
     (lsdb-rebuild-secondary-hash-tables)))
 
+(defun lsdb-rdfdb-maybe-load-database ()
+  (unless lsdb-rdfdb-database
+    (setq lsdb-rdfdb-database (rdfdb-make-database))
+    (if (file-exists-p lsdb-rdfdb-file)
+	(rdfdb-load-database lsdb-rdfdb-database lsdb-rdfdb-file))))
+
+(defun lsdb-rdfdb-convert-triples-to-alist (triples)
+  (let (alist
+	entry-name
+	literal
+	entry)
+    (while triples
+      (when (string-match
+	     (concat "^" (regexp-quote lsdb-rdfdb-namespace-uri) "/entry#")
+	     (rdfdb-triple-property (car triples)))
+	(setq entry-name
+	      (intern (downcase (substring
+				 (rdfdb-triple-property (car triples))
+				 (match-end 0))))
+	      literal (rdfdb-find-literal lsdb-rdfdb-database
+					  (rdfdb-triple-object (car triples))))
+	(if (eq ?. (nth 2 (assq entry-name lsdb-entry-type-alist)))
+	    (setq alist (cons (cons entry-name literal) alist))
+	  (if (setq entry (assq entry-name alist))
+	      (setcdr entry (cons literal (cdr entry)))
+	    (setq alist (cons (cons entry-name (list literal)) alist)))))
+      (setq triples (cdr triples)))
+    alist))
+
 ;;;_ : Fallback Lookup Functions
 ;;;_  , #1 Address Cache
 (defun lsdb-lookup-full-name-from-address-cache (sender)
@@ -1380,6 +1426,30 @@ performed against the entry field."
      lsdb-hash-table)
     records))
 
+(defun lsdb-rdfdb-lookup-records (regexp &optional entry-name)
+  "Return the all records in the LSDB matching the REGEXP.
+If the optional 2nd argument ENTRY-NAME is given, matching only
+performed against the entry field."
+  (let ((subjects
+	 (mapcar
+	  #'rdfdb-triple-subject
+	  (rdfdb-match-triples
+	   lsdb-rdfdb-database
+	   (rdfdb-make-triple
+	    nil
+	    (concat lsdb-rdfdb-namespace-uri
+		    (if (and entry-name (not (equal entry-name "")))
+			(concat "/entry#" (capitalize entry-name))
+		      "/entry#Name"))
+	    (rdfdb-get-literal-resource lsdb-rdfdb-database regexp))))))
+    (mapcar
+     (lambda (subject)
+       (cons regexp
+	     (lsdb-rdfdb-convert-triples-to-alist
+	      (rdfdb-match-triples lsdb-rdfdb-database
+				   (rdfdb-make-triple subject nil nil)))))
+     subjects)))
+
 (defvar lsdb-mode-lookup-history nil)
 
 (defun lsdb-mode-lookup (regexp &optional entry-name)
@@ -1400,8 +1470,12 @@ performed against the entry field."
        nil nil nil 'lsdb-mode-lookup-history)
       (if (and entry-name (not (equal entry-name "")))
 	  (intern (downcase entry-name))))))
-  (lsdb-maybe-load-hash-tables)
-  (let ((records (lsdb-lookup-records regexp entry-name)))
+  (if lsdb-use-rdfdb
+      (lsdb-rdfdb-maybe-load-database)
+    (lsdb-maybe-load-hash-tables))
+  (let ((records (if lsdb-use-rdfdb
+		     (lsdb-rdfdb-lookup-records regexp entry-name)
+		   (lsdb-lookup-records regexp entry-name))))
     (if records
 	(lsdb-display-records records))))
 
diff --git a/rdfdb.el b/rdfdb.el
index 11df39d..4b63718 100644
--- a/rdfdb.el
+++ b/rdfdb.el
@@ -41,7 +41,7 @@
   "URI prefix of internal resources.")
 
 (defconst rdfdb-literal-resource-uri-prefix
-  (concat rdfdb-namespace-uri "/literal#range_")
+  (concat rdfdb-namespace-uri "/literal#id_")
   "URI prefix of literal resources.")
 
 (if (and (fboundp 'make-hash-table)
@@ -135,41 +135,23 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
   "Set the OBJECT resource of TRIPLE."
   (aset triple 2 object))
 
-(defconst rdfdb-prime-list
-  '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761
-       919 1103 1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103
-       12143 14591 17519 21023 25229 30293 36353 43627 52361 62851 75431
-       90523 108631 130363 156437 187751 225307 270371 324449 389357 467237
-       560689 672827 807403 968897 1162687 1395263 1674319 2009191 2411033
-       2893249))
-
 ;;;###autoload
-(defun rdfdb-make-database (&optional size)
+(defun rdfdb-make-database ()
   "Create a database."
-  (unless size
-    (setq size 29))
-  (let ((prime-list rdfdb-prime-list)
-	(key-obarray-size (* size 6)))
-    (while (and prime-list
-		(> key-obarray-size (car prime-list)))
-      (setq prime-list (cdr prime-list)))
-    (if prime-list
-	(setq key-obarray-size (car prime-list)))
-    (vector nil
-	    (make-vector key-obarray-size 0)
-	    (rdfdb-make-hash-table :size size)
-	    (rdfdb-make-hash-table :size size)
-	    (rdfdb-make-hash-table :size size)
-	  (with-current-buffer (generate-new-buffer " *rdfdb literals*")
-	    (buffer-disable-undo)
-	    (current-buffer))
-	  0)))
+  (vector nil
+	  (rdfdb-make-hash-table :test 'equal)
+	  (rdfdb-make-hash-table)
+	  (rdfdb-make-hash-table)
+	  (rdfdb-make-hash-table)
+	  (rdfdb-make-hash-table)
+	  (rdfdb-make-hash-table :test 'equal)
+	  0))
 
 (defun rdfdb-database-triple-list (database)
   "Return all the triples which DATABASE holds."
   (aref database 0))
 
-(defsubst rdfdb-database-key-obarray (database)
+(defsubst rdfdb-database-key-index (database)
   "Return the hash-table which contains all the keys which
 DATABASE allocated.
 This function is for internal use only."
@@ -193,24 +175,29 @@ Triples in this hash-table is indexed by its object resource.
 This function is for internal use only."
   (aref database 4))
 
-(defsubst rdfdb-database-literal-buffer (database)
-  "Return the buffer which holds literal contents.
+(defsubst rdfdb-database-literal-index (database)
+  "Return the hash-table which is used to index literals in DATABASE.
 This function is for internal use only."
   (aref database 5))
 
+(defsubst rdfdb-database-literal-reverse-index (database)
+  "Return the hash-table which is used to index literals in DATABASE.
+This function is for internal use only."
+  (aref database 6))
+
 (defsubst rdfdb-database-internal-resource-counter (database)
   "Return the next index number of internal resources.
 This function is for internal use only."
-  (aref database 6))
+  (aref database 7))
 
 (defun rdfdb-database-set-triple-list (database triple-list)
   "Set TRIPLE-LIST in DATABASE."
   (aset database 0 triple-list))
 
-(defsubst rdfdb-database-set-key-obarray (database key-obarray)
-  "Set KEY-OBARRAY in DATABASE.
+(defsubst rdfdb-database-set-key-index (database key-index)
+  "Set KEY-INDEX in DATABASE.
 This function is for internal use only."
-  (aset database 1 key-obarray))
+  (aset database 1 key-index))
 
 (defsubst rdfdb-database-set-subject-index (database subject-index)
   "Set SUBJECT-INDEX in DATABASE.
@@ -227,43 +214,52 @@ This function is for internal use only."
 This function is for internal use only."
   (aset database 4 object-index))
 
-(defsubst rdfdb-database-set-literal-buffer (database literal-buffer)
-  "Set LITERAL-BUFFER in DATABASE.
+(defsubst rdfdb-database-set-literal-index (database literal-index)
+  "Set LITERAL-INDEX in DATABASE.
+This function is for internal use only."
+  (aset database 5 literal-index))
+
+(defsubst rdfdb-database-set-literal-reverse-index (database literal-index)
+  "Set LITERAL-INDEX in DATABASE.
 This function is for internal use only."
-  (aset database 5 literal-buffer))
+  (aset database 6 literal-index))
 
 (defsubst rdfdb-database-set-internal-resource-counter (database
 							resource-index)
   "Set RESOURCE-INDEX in DATABASE.
 This function is for internal use only."
-  (aset database 6 resource-index))
+  (aset database 7 resource-index))
 
 (defun rdfdb-clear-database (database)
   "Clear all entries in DATABASE."
   (rdfdb-database-set-triple-list database nil)
-  (fillarray (rdfdb-database-key-obarray database) 0)
+  (rdfdb-clrhash (rdfdb-database-key-index database))
   (rdfdb-clrhash (rdfdb-database-subject-index database))
   (rdfdb-clrhash (rdfdb-database-property-index database))
   (rdfdb-clrhash (rdfdb-database-object-index database))
-  (kill-buffer (rdfdb-database-literal-buffer database))
+  (rdfdb-clrhash (rdfdb-database-literal-index database))
+  (rdfdb-clrhash (rdfdb-database-literal-reverse-index database))
   (rdfdb-database-set-internal-resource-counter database 0))
 
 (defun rdfdb-find-key (database first &optional second)
   "Return the canonical key object whose name is constructed by
 concatenating FIRST and SECOND resources, or nil if none exists."
-  (intern-soft (if second
-		   (concat first "\0" second)
-		 first)
-	       (rdfdb-database-key-obarray database)))
+  (rdfdb-gethash (if second
+		     (concat first "\0" second)
+		   first)
+		 (rdfdb-database-key-index database)))
 
 (defun rdfdb-get-key (database first &optional second)
   "Return the canonical key object whose name is constructed by
 concatenating FIRST and SECOND resources.
 If there is none, one is created in DATABASE and returned."
-  (intern (if second
-	      (concat first "\0" second)
-	    first)
-	  (rdfdb-database-key-obarray database)))
+  (let ((key-string (if second
+		 (concat first "\0" second)
+	       first)))
+    (or (rdfdb-gethash key-string
+		       (rdfdb-database-key-index database))
+	(rdfdb-puthash key-string key-string
+		       (rdfdb-database-key-index database)))))
 
 (defun rdfdb-get-internal-resource (database)
   "Create a resource for internal use."
@@ -276,27 +272,20 @@ If there is none, one is created in DATABASE and returned."
 (defun rdfdb-get-literal-resource (database string)
   "Return the canonical resource object which represents STRING.
 If there is none, one is created in DATABASE and returned."
-  (save-excursion
-    (set-buffer (rdfdb-database-literal-buffer database))
-    (goto-char (point-min))
-    (concat rdfdb-literal-resource-uri-prefix
-	    (if (search-forward string nil t)
-		(format "%d_%d" (match-beginning 0) (match-end 0))
-	      (format "%d_%d"
-		      (goto-char (point-max))
-		      (progn (insert string) (point)))))))
+  (or (rdfdb-gethash string
+		     (rdfdb-database-literal-index database))
+      (let* ((resource (rdfdb-get-internal-resource database))
+	     (key (rdfdb-get-key database resource)))
+	(rdfdb-puthash key string
+		       (rdfdb-database-literal-index database))
+	(rdfdb-puthash string key
+		       (rdfdb-database-literal-reverse-index database)))))
 
 (defun rdfdb-find-literal (database resource)
   "Return the literal value of RESOURCE, or nil if none exists."
-  (with-current-buffer (rdfdb-database-literal-buffer database)
-    (if (string-match
-	 (concat "^" (regexp-quote rdfdb-literal-resource-uri-prefix)
-		 "\\([0-9A-F]+\\)_\\([0-9A-F]+\\)")
-	 resource)
-	(buffer-substring (string-to-number
-			   (match-string 1 resource))
-			  (string-to-number
-			   (match-string 2 resource))))))
+  (let ((key (rdfdb-find-key database resource)))
+    (if key
+	(rdfdb-gethash key (rdfdb-database-literal-reverse-index database)))))
 
 (defun rdfdb-triple-lessp (first second)
   "Return t if FIRST is less than SECOND."