From: ueno Date: Mon, 2 Feb 2004 10:29:57 +0000 (+0000) Subject: * rdfdb.el: New file. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=109abf26f09e40438ecdb62d4affef79c32c8653;p=elisp%2Flsdb.git * rdfdb.el: New file. * lsdb-to-rdfdb.el: New file. * LSDB-ELS (lsdb-modules-to-compile): Add rdfdb. --- diff --git a/LSDB-ELS b/LSDB-ELS index 9182139..0ffc31c 100644 --- a/LSDB-ELS +++ b/LSDB-ELS @@ -5,7 +5,8 @@ ;;; Code: (setq lsdb-modules-to-compile - '(lsdb)) + '(lsdb + rdfdb)) (setq lsdb-modules-not-to-compile nil) diff --git a/lsdb-to-rdfdb.el b/lsdb-to-rdfdb.el new file mode 100644 index 0000000..8ea9f32 --- /dev/null +++ b/lsdb-to-rdfdb.el @@ -0,0 +1,32 @@ +(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)))) + +(lsdb-maybe-load-hash-tables) +(setq database (rdfdb-make-database)) + +(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))))) + lsdb-hash-table) + +(rdfdb-save-database database ".rdfdb") diff --git a/rdfdb.el b/rdfdb.el new file mode 100644 index 0000000..262072e --- /dev/null +++ b/rdfdb.el @@ -0,0 +1,599 @@ +;;; rdfdb.el --- interface to RDF triple data model + +;; Copyright (C) 2004 Daiki Ueno + +;; Author: Daiki Ueno +;; 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