;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff ;;+ ;;+ Isidorus is freely distributable under the LLGPL license. ;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and ;;+ trunk/docs/LGPL-LICENSE.txt. ;;+----------------------------------------------------------------------------- (defpackage :fixtures (:use :common-lisp :xtm-importer :datamodel :it.bese.FiveAM :base-tools :unittests-constants) (:import-from :constants *xtm2.0-ns*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-select-location-path) (:import-from :exceptions missing-reference-error duplicate-identifier-error) (:export :atom-test-db :bare-test-db :clean-out-db :initialized-test-db :initialize-destination-db :merge-test-db :set-up-test-db :tear-down-test-db :rdf-exporter-test-db :*TEST-TM* :*NOTIFICATIONBASE-TM* :*XTM-TM* :*XTM-MERGE1-TM* :*XTM-MERGE2-TM* :rdf-init-db :rdf-test-db :with-empty-db :with-tm-filled-db)) (in-package :fixtures) (defvar *XTM-TM* nil) (defvar *TEST-TM* "test-tm") (defvar *NOTIFICATIONBASE-TM* (dom:document-element (cxml:parse-file *notificationbase.xtm* (cxml-dom:make-dom-builder)))) (setf *debug-on-error* t) (setf *debug-on-failure* t) (defun clean-out-db (dir) (let ((dirname (make-pathname :directory (list :relative dir)))) (ensure-directories-exist dirname) (loop for filename in (com.gigamonkeys.pathnames:list-directory dirname) do (delete-file filename)))) (defun set-up-test-db (&optional (revision 0)) "clears out the database and parses the test file" (clean-out-db "data_base") (open-tm-store "data_base") (init-isidorus revision) (setf *current-xtm* *TEST-TM*) ;deliberately only use stubs at this stage (import-only-topics *xtm-tm* :tm-id "http://www.isidor.us/unittests/testtm" :revision revision :xtm-id *TEST-TM*)) (defun set-up-raw-test-db () (clean-out-db "data_base") (open-tm-store "data_base") (init-isidorus) (setf *current-xtm* *TEST-TM*)) (defun tear-down-test-db () "make sure the elephant store is properly closed" (close-tm-store)) (def-fixture bare-test-db () (set-up-raw-test-db) (&body) (tear-down-test-db)) (def-fixture initialize-destination-db (dir) (clean-out-db dir) (&body) (tear-down-test-db)) (def-fixture initialized-test-db (&optional (xtm *NOTIFICATIONBASE-TM*)) (let ((revision (get-revision))) (declare (ignorable revision)) (setf *TM-REVISION* revision) (setf *XTM-TM* xtm) (set-up-test-db revision) (let ((tm (get-item-by-item-identifier "http://www.isidor.us/unittests/testtm" :revision revision))) (declare (ignorable tm)) (&body) (tear-down-test-db)))) (defvar *XTM-MERGE1-TM* (dom:document-element (cxml:parse-file *notification_merge1.xtm* (cxml-dom:make-dom-builder)))) (defparameter *XTM-MERGE2-TM* (dom:document-element (cxml:parse-file *notification_merge2.xtm* (cxml-dom:make-dom-builder)))) (defparameter *XTM-ATOM-TM* (dom:document-element (cxml:parse-file *atom_test.xtm* (cxml-dom:make-dom-builder)))) (def-fixture merge-test-db () (setf *XTM-TM* *NOTIFICATIONBASE-TM*) (let* ((revision1 (get-revision)) (revision2 (+ 200 revision1)) ; some arbitrary differences (revision3 (+ 400 revision1))) (set-up-test-db revision1) (importer *XTM-TM* :tm-id "http://www.isidor.us/unittests/testtm" :xtm-id *TEST-TM* :revision revision1) (importer *XTM-MERGE1-TM* :xtm-id "merge1" :tm-id "http://www.isidor.us/unittests/testtm" :revision revision2) (importer *XTM-MERGE2-TM* :xtm-id "merge2" :tm-id "http://www.isidor.us/unittests/testtm" :revision revision3) (&body) (tear-down-test-db))) (defun init-conf () (in-package :atom) ;;test configuration ;(defparameter *tm-feed* nil) (setf atom:*base-url* "http://london.ztt.fh-worms.de:8000") (load *atom-conf.lisp*)) (def-fixture atom-test-db () (setf *XTM-TM* *NOTIFICATIONBASE-TM*) (init-conf) (let* ((revision1 (get-revision)) (revision2 (+ 200 revision1)) ; some arbitrary differences (revision3 (+ 400 revision1))) (set-up-test-db revision1) (importer *XTM-TM* ;;aligned with conf.lisp :tm-id "http://psi.egovpt.org/tm/worms" :xtm-id *TEST-TM* :revision revision1) (importer *XTM-MERGE1-TM* :xtm-id "merge1" :tm-id "http://psi.egovpt.org/tm/worms" :revision revision2) (importer *XTM-MERGE2-TM* :xtm-id "merge2" :tm-id "http://psi.egovpt.org/tm/worms" :revision revision3) (importer *XTM-ATOM-TM* :xtm-id "atom-tm1" :tm-id "http://psi.egovpt.org/tm/egov-ontology" :revision revision1) (&body) (tear-down-test-db))) (defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision))) "Deletes the data base files and initializes isidorus for rdf." (when elephant:*store-controller* (close-tm-store)) (clean-out-db db-dir) (open-tm-store db-dir) (xtm-importer:init-isidorus start-revision) (rdf-importer:init-rdf-module start-revision)) (def-fixture rdf-test-db () (let ((db-dir "data_base") (tm-id "http://test-tm/") (document-id "doc-id")) (clean-out-db db-dir) (setf d:*current-xtm* document-id) (rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id :document-id document-id) (open-tm-store db-dir) (&body) (tear-down-test-db))) (def-fixture rdf-exporter-test-db() (let ((db-dir "data_base") (tm-id "http://test-tm") (document-id "doc-id") (exported-file-path "./__out__.rdf")) (clean-out-db db-dir) (handler-case (delete-file exported-file-path) (error () )) ;do nothing (setf d:*current-xtm* document-id) (setup-repository *poems_light.xtm* db-dir :tm-id tm-id :xtm-id document-id) (open-tm-store db-dir) (rdf-exporter:export-as-rdf exported-file-path :tm-id tm-id) (&body) (handler-case (delete-file exported-file-path) (error () )) ;do nothing (tear-down-test-db))) (def-fixture with-empty-db (dir) (clean-out-db dir) (open-tm-store dir) (&body) (tear-down-test-db)) (def-fixture with-tm-filled-db (dir xtm-path) (clean-out-db dir) (let ((tm-id "http://www.isidor.us/unittests/testtm") (xtm-id (full-path xtm-path))) (xtm-importer:setup-repository xtm-path dir :tm-id tm-id :xtm-id xtm-id) (open-tm-store dir) (&body) (tear-down-test-db)))