* lsdb-to-rdfdb.el: Don't require 'rdfdb; save database in ~/.lsdb.nt.

[elisp/lsdb.git] / lsdb.el

diff --git a/lsdb.el b/lsdb.el
index 8f76dfd..0062644 100644 (file)
--- 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))))