From 0772032b86f5cb69277fe931e42297fd555928ea Mon Sep 17 00:00:00 2001 From: ueno Date: Wed, 4 Feb 2004 07:51:25 +0000 Subject: [PATCH] * 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. --- lsdb-to-rdfdb.el | 53 ++++++++++++----------- lsdb.el | 78 +++++++++++++++++++++++++++++++++- rdfdb.el | 123 +++++++++++++++++++++++++----------------------------- 3 files changed, 161 insertions(+), 93 deletions(-) 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." -- 1.7.10.4