--- /dev/null
+;;; rdfdb.el --- interface to RDF triple data model
+
+;; Copyright (C) 2004 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: RDF
+
+;; This file is part of the Lovely Sister Database.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module provides an interface to RDF triple data model.
+;;; NOTE: The integration with LSDB is not yet complete.
+
+;;; Code:
+
+(defvar rdfdb-file-coding-system 'ctext
+ "Coding system used to save RDFDB database.")
+
+(defconst rdfdb-namespace-uri
+ "http://deisui.org/xmlns/rdfdb/1.0"
+ "Base URI of the RDFDB entry resources.")
+
+(defconst rdfdb-internal-resource-uri-prefix
+ (concat rdfdb-namespace-uri "/internal#id_")
+ "URI prefix of internal resources.")
+
+(defconst rdfdb-literal-resource-uri-prefix
+ (concat rdfdb-namespace-uri "/literal#range_")
+ "URI prefix of literal resources.")
+
+(if (and (fboundp 'make-hash-table)
+ (subrp (symbol-function 'make-hash-table)))
+ (progn
+ (defalias 'rdfdb-puthash 'puthash)
+ (defalias 'rdfdb-gethash 'gethash)
+ (defalias 'rdfdb-remhash 'remhash)
+ (defalias 'rdfdb-maphash 'maphash)
+ (defalias 'rdfdb-clrhash 'maphash)
+ (defalias 'rdfdb-hash-table-size 'hash-table-size)
+ (defalias 'rdfdb-hash-table-index 'hash-table-index)
+ (defalias 'rdfdb-make-hash-table 'make-hash-table))
+ (defun rdfdb-puthash (key value hash-table)
+ "Hash KEY to VALUE in HASH-TABLE."
+ ;; Obarray is regarded as an open hash table, as a matter of
+ ;; fact, rehashing doesn't make sense.
+ (let (new-obarray)
+ (when (> (car hash-table)
+ (* (length (nth 1 hash-table)) 0.7))
+ (setq new-obarray (make-vector (* (length (nth 1 hash-table)) 2) 0))
+ (mapatoms
+ (lambda (symbol)
+ (set (intern (symbol-name symbol) new-obarray)
+ (symbol-value symbol)))
+ (nth 1 hash-table))
+ (setcdr hash-table (list new-obarray)))
+ (set (intern key (nth 1 hash-table)) value)
+ (setcar hash-table (1+ (car hash-table)))))
+ (defun rdfdb-gethash (key hash-table &optional default)
+ "Find hash value for KEY in HASH-TABLE.
+If there is no corresponding value, return DEFAULT (which defaults to nil)."
+ (let ((symbol (intern-soft key (nth 1 hash-table))))
+ (if symbol
+ (symbol-value symbol)
+ default)))
+ (defun rdfdb-remhash (key hash-table)
+ "Remove the entry for KEY from HASH-TABLE.
+Do nothing if there is no entry for KEY in HASH-TABLE."
+ (unintern key (nth 1 hash-table))
+ (setcar hash-table (1- (car hash-table))))
+ (defun rdfdb-maphash (function hash-table)
+ "Map FUNCTION over entries in HASH-TABLE, calling it with two args,
+each key and value in HASH-TABLE.
+
+FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION
+may remhash or puthash the entry currently being processed by FUNCTION."
+ (mapatoms
+ (lambda (symbol)
+ (funcall function (symbol-name symbol) (symbol-value symbol)))
+ (nth 1 hash-table)))
+ (defun rdfdb-clrhash (hash-table)
+ "Remove all entries from HASH-TABLE, leaving it empty."
+ (fillarray (nth 1 hash-table) 0)
+ (setcar hash-table 0))
+ (defun rdfdb-hash-table-size (hash-table)
+ "Return the size of HASH-TABLE.
+This is the current number of slots in HASH-TABLE, whether occupied or not."
+ (length (nth 1 hash-table)))
+ (defalias 'rdfdb-hash-table-index 'car)
+ (defun rdfdb-make-hash-table (&rest args)
+ "Return a new empty hash table object."
+ (list 0 (make-vector (or (plist-get args :size) 29) 0))))
+
+;;;###autoload
+(defun rdfdb-make-triple (subject property object)
+ "Create a triple with SUBJECT, PROPERTY, and OBJECT."
+ (vector subject property object))
+
+(defun rdfdb-triple-subject (triple)
+ "Return the subject resource of TRIPLE."
+ (aref triple 0))
+
+(defun rdfdb-triple-property (triple)
+ "Return the property resource of TRIPLE."
+ (aref triple 1))
+
+(defun rdfdb-triple-object (triple)
+ "Return the object resource of TRIPLE."
+ (aref triple 2))
+
+(defun rdfdb-triple-set-subject (triple subject)
+ "Set the SUBJECT resource of TRIPLE."
+ (aset triple 0 subject))
+
+(defun rdfdb-triple-set-property (triple property)
+ "Set the PROPERTY resource of TRIPLE."
+ (aset triple 1 property))
+
+(defun rdfdb-triple-set-object (triple object)
+ "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)
+ "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)))
+
+(defun rdfdb-database-triple-list (database)
+ "Return all the triples which DATABASE holds."
+ (aref database 0))
+
+(defsubst rdfdb-database-key-obarray (database)
+ "Return the hash-table which contains all the keys which
+DATABASE allocated.
+This function is for internal use only."
+ (aref database 1))
+
+(defsubst rdfdb-database-subject-index (database)
+ "Return the hash-table which is used to index triples in DATABASE.
+Triples in this hash-table is indexed by its subject resource.
+This function is for internal use only."
+ (aref database 2))
+
+(defsubst rdfdb-database-property-index (database)
+ "Return the hash-table which is used to index triples in DATABASE.
+Triples in this hash-table is indexed by its property resource.
+This function is for internal use only."
+ (aref database 3))
+
+(defsubst rdfdb-database-object-index (database)
+ "Return the hash-table which is used to index triples in DATABASE.
+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.
+This function is for internal use only."
+ (aref database 5))
+
+(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))
+
+(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.
+This function is for internal use only."
+ (aset database 1 key-obarray))
+
+(defsubst rdfdb-database-set-subject-index (database subject-index)
+ "Set SUBJECT-INDEX in DATABASE.
+This function is for internal use only."
+ (aset database 2 subject-index))
+
+(defsubst rdfdb-database-set-property-index (database property-index)
+ "Set PROPERTY-INDEX in DATABASE.
+This function is for internal use only."
+ (aset database 3 property-index))
+
+(defsubst rdfdb-database-set-object-index (database object-index)
+ "Set OBJECT-INDEX in DATABASE.
+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.
+This function is for internal use only."
+ (aset database 5 literal-buffer))
+
+(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))
+
+(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-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-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)))
+
+(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)))
+
+(defun rdfdb-get-internal-resource (database)
+ "Create a resource for internal use."
+ (concat rdfdb-internal-resource-uri-prefix
+ (number-to-string
+ (rdfdb-database-set-internal-resource-counter
+ database
+ (1+ (rdfdb-database-internal-resource-counter database))))))
+
+(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)))))))
+
+(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))))))
+
+(defun rdfdb-triple-lessp (first second)
+ "Return t if FIRST is less than SECOND."
+ (if (eq (rdfdb-triple-subject first)
+ (rdfdb-triple-subject second))
+ (if (eq (rdfdb-triple-property first)
+ (rdfdb-triple-property second))
+ (unless (eq (rdfdb-triple-object first)
+ (rdfdb-triple-object second))
+ (string-lessp (rdfdb-triple-object first)
+ (rdfdb-triple-object second)))
+ (string-lessp (rdfdb-triple-property first)
+ (rdfdb-triple-property second)))
+ (string-lessp (rdfdb-triple-subject first)
+ (rdfdb-triple-subject second))))
+
+(defun rdfdb-match-triples (database matcher)
+ "Retrieve triples indexed by MATCHER in DATABASE.
+MATCHER is a triple whose slots can be nil (wildcard)."
+ ;;[S,P,O]
+ (if (and (rdfdb-triple-subject matcher)
+ (rdfdb-triple-property matcher)
+ (rdfdb-triple-object matcher))
+ matcher
+ ;;[*,*,*]
+ (if (and (null (rdfdb-triple-subject matcher))
+ (null (rdfdb-triple-property matcher))
+ (null (rdfdb-triple-object matcher)))
+ (rdfdb-database-triple-list database))
+ (let (key)
+ (if (rdfdb-triple-subject matcher)
+ ;;[S,P,*] or [S,*,*]
+ (if (setq key (rdfdb-find-key database
+ (rdfdb-triple-subject matcher)
+ (rdfdb-triple-property matcher)))
+ (rdfdb-gethash key (rdfdb-database-subject-index database))
+ ;;[S,*,O] or [S,*,*]
+ (if (setq key (rdfdb-find-key database
+ (rdfdb-triple-object matcher)
+ (rdfdb-triple-subject matcher)))
+ (rdfdb-gethash key (rdfdb-database-object-index database))))
+ (if (rdfdb-triple-property matcher)
+ ;;[*,P,O] or [*,P,*]
+ (if (setq key (rdfdb-find-key database
+ (rdfdb-triple-property matcher)
+ (rdfdb-triple-object matcher)))
+ (rdfdb-gethash key (rdfdb-database-property-index database)))
+ ;;[*,*,O]
+ (if (setq key (rdfdb-find-key database
+ (rdfdb-triple-object matcher)))
+ (rdfdb-gethash key (rdfdb-database-object-index database))))))))
+
+(defun rdfdb-add-triple (database triple)
+ "Add TRIPLE in DATABASE."
+ (let (key)
+ ;; Index by subject and property.
+ (rdfdb-puthash (setq key (rdfdb-get-key database
+ (rdfdb-triple-subject triple)))
+ (cons triple
+ (rdfdb-gethash key
+ (rdfdb-database-subject-index
+ database)))
+ (rdfdb-database-subject-index database))
+ (rdfdb-puthash (setq key (rdfdb-get-key database
+ (rdfdb-triple-subject triple)
+ (rdfdb-triple-property triple)))
+ (cons triple
+ (rdfdb-gethash key
+ (rdfdb-database-subject-index
+ database)))
+ (rdfdb-database-subject-index database))
+ ;; Index by property and object.
+ (rdfdb-puthash (setq key (rdfdb-get-key database
+ (rdfdb-triple-property triple)))
+ (cons triple
+ (rdfdb-gethash key
+ (rdfdb-database-property-index
+ database)))
+ (rdfdb-database-property-index database))
+ (rdfdb-puthash (setq key (rdfdb-get-key database
+ (rdfdb-triple-property triple)
+ (rdfdb-triple-object triple)))
+ (cons triple
+ (rdfdb-gethash key
+ (rdfdb-database-property-index
+ database)))
+ (rdfdb-database-property-index database))
+ ;; Index by object and subject.
+ (rdfdb-puthash (setq key (rdfdb-get-key database
+ (rdfdb-triple-object triple)))
+ (cons triple
+ (rdfdb-gethash key
+ (rdfdb-database-object-index
+ database)))
+ (rdfdb-database-object-index database))
+ (rdfdb-puthash (setq key (rdfdb-get-key database
+ (rdfdb-triple-object triple)
+ (rdfdb-triple-subject triple)))
+ (cons triple
+ (rdfdb-gethash key
+ (rdfdb-database-object-index
+ database)))
+ (rdfdb-database-object-index database))
+ (rdfdb-database-set-triple-list
+ database
+ (cons triple (rdfdb-database-triple-list database)))))
+
+(defun rdfdb-remove-triple (database triple)
+ "Remove TRIPLE from DATABASE."
+ (let (key triples pointer)
+ ;; Remove a triple indexed by subject and property.
+ (if (and (setq key (rdfdb-find-key database
+ (rdfdb-triple-subject triple)))
+ (setq triples (rdfdb-gethash key
+ (rdfdb-database-subject-index
+ database)))
+ (setq pointer (member triple triples)))
+ (rdfdb-puthash key
+ (delq (car pointer) triples)
+ (rdfdb-database-subject-index database)))
+ (if (and (setq key (rdfdb-find-key database
+ (rdfdb-triple-subject triple)
+ (rdfdb-triple-property triple)))
+ (setq triples (rdfdb-gethash key
+ (rdfdb-database-subject-index
+ database)))
+ (setq pointer (member triple triples)))
+ (rdfdb-puthash key
+ (delq (car pointer) triples)
+ (rdfdb-database-subject-index database)))
+ ;; Remove a triple indexed by property and object.
+ (if (and (setq key (rdfdb-find-key database
+ (rdfdb-triple-property triple)))
+ (setq triples (rdfdb-gethash key
+ (rdfdb-database-property-index
+ database)))
+ (setq pointer (member triple triples)))
+ (rdfdb-puthash key
+ (delq (car pointer) triples)
+ (rdfdb-database-property-index database)))
+ (if (and (setq key (rdfdb-find-key database
+ (rdfdb-triple-property triple)
+ (rdfdb-triple-object triple)))
+ (setq triples (rdfdb-gethash key
+ (rdfdb-database-property-index
+ database)))
+ (setq pointer (member triple triples)))
+ (rdfdb-puthash key
+ (delq (car pointer) triples)
+ (rdfdb-database-property-index database)))
+ ;; Remove a triple indexed by object and subject.
+ (if (and (setq key (rdfdb-find-key database
+ (rdfdb-triple-object triple)))
+ (setq triples (rdfdb-gethash key
+ (rdfdb-database-object-index
+ database)))
+ (setq pointer (member triple triples)))
+ (rdfdb-puthash key
+ (delq (car pointer) triples)
+ (rdfdb-database-object-index database)))
+ (if (and (setq key (rdfdb-find-key database
+ (rdfdb-triple-object triple)
+ (rdfdb-triple-subject triple)))
+ (setq triples (rdfdb-gethash key
+ (rdfdb-database-object-index
+ database)))
+ (setq pointer (member triple triples)))
+ (rdfdb-puthash key
+ (delq (car pointer) triples)
+ (rdfdb-database-object-index database)))
+ (rdfdb-database-set-triple-list
+ database
+ (delete triple (rdfdb-database-triple-list database)))))
+
+(defconst rdfdb-escape-pair-alist
+ '((?\\ . ?\\)
+ (?\" . ?\")
+ (?\n . ?n)
+ (?\r . ?r)
+ (?\t . ?t))
+ "An alist used to escape literals.")
+
+(defun rdfdb-escape-literal (string)
+ "Escape STRING with backslash form."
+ (let ((start 0))
+ (while (string-match (concat "["
+ (apply #'string
+ (mapcar #'car rdfdb-escape-pair-alist))
+ "]")
+ string start)
+ (setq start (1+ (match-end 0))
+ string (replace-match
+ (string ?\\
+ (cdr (assq (aref string (match-beginning 0))
+ rdfdb-escape-pair-alist)))
+ nil t string)))
+ string))
+
+(defun rdfdb-unescape-literal (string)
+ "Unescape each backslash form found in STRING."
+ (let ((start 0))
+ (while (string-match (concat "\\\\["
+ (apply #'string
+ (mapcar #'cdr rdfdb-escape-pair-alist))
+ "]")
+ string start)
+ (setq start (1- (match-end 0))
+ string (replace-match
+ (char-to-string
+ (car (rassq (aref string (1+ (match-beginning 0)))
+ rdfdb-escape-pair-alist)))
+ nil t string)))
+ string))
+
+;;;###autoload
+(defun rdfdb-load-database (database file)
+ "Load DATABASE from FILE."
+ (let ((buffer (find-file-noselect file))
+ (urlref-regexp "<\\([\x21-\x3B\x3D\x3F-\x7E]+\\)>")
+ (named-node-regexp "_:\\([A-Za-z][A-Za-z0-9]*\\)")
+ named-node-alist)
+ (unwind-protect
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at (concat "[ \t]*\\(" urlref-regexp "\\|"
+ named-node-regexp "\\)[ \t]+"
+ urlref-regexp "[ \t]+\\("
+ urlref-regexp "\\|" named-node-regexp
+ "\\|\"\\(.*\\)\"\\)[ \t]*\\.[ \t]*"))
+ (rdfdb-add-triple
+ database
+ (rdfdb-make-triple
+ (or (match-string 2)
+ (cdr (assoc (match-string 3) named-node-alist))
+ (let ((resource (rdfdb-get-internal-resource
+ database)))
+ (setq named-node-alist
+ (cons (cons (match-string 3) resource)
+ named-node-alist))
+ resource))
+ (match-string 4)
+ (or (match-string 6)
+ (if (match-beginning 7)
+ (or (cdr (assoc (match-string 7) named-node-alist))
+ (let ((resource (rdfdb-get-internal-resource
+ database)))
+ (setq named-node-alist
+ (cons (cons (match-string 7) resource)
+ named-node-alist))
+ resource))
+ (rdfdb-get-literal-resource
+ database
+ (rdfdb-unescape-literal (match-string 8))))))))
+ (beginning-of-line 2))
+ database)
+ (kill-buffer buffer))))
+
+(defun rdfdb-save-database (database file)
+ "Save DATABASE to FILE."
+ (let ((coding-system-for-write rdfdb-file-coding-system)
+ (triple-list (sort (rdfdb-database-triple-list database)
+ #'rdfdb-triple-lessp))
+ resource literal)
+ (with-temp-file file
+ (if (and (or (featurep 'mule)
+ (featurep 'file-coding))
+ rdfdb-file-coding-system)
+ (let ((coding-system-name
+ (if (symbolp rdfdb-file-coding-system)
+ (symbol-name rdfdb-file-coding-system)
+ ;; XEmacs
+ (if (featurep 'xemacs)
+ (symbol-name (coding-system-name
+ rdfdb-file-coding-system))))))
+ (if coding-system-name
+ (insert "# -*- coding: "
+ coding-system-name " -*-\n"))))
+ (while triple-list
+ (setq resource (rdfdb-triple-subject (car triple-list)))
+ (if (string-match
+ (concat "^" (regexp-quote rdfdb-internal-resource-uri-prefix))
+ resource)
+ (insert "_:genid" (substring resource (match-end 0)) " ")
+ (insert "<" resource "> "))
+ (insert "<" (rdfdb-triple-property (car triple-list)) "> ")
+ (setq resource (rdfdb-triple-object (car triple-list)))
+ (if (string-match
+ (concat "^" (regexp-quote rdfdb-internal-resource-uri-prefix))
+ resource)
+ (insert "_:genid" (substring resource (match-end 0)) ".\n")
+ (if (setq literal (rdfdb-find-literal database resource))
+ (insert "\"" (rdfdb-escape-literal literal) "\".\n")
+ (insert "<" resource ">.\n")))
+ (setq triple-list (cdr triple-list))))))
+
+(provide 'rdfdb)
+
+;;; rdfdb.el ends here
projects / elisp / lsdb.git / commitdiff