[bknr-cvs] ksprotte changed trunk/projects/bos/
BKNR Commits
bknr at bknr.net
Wed Jul 30 14:34:52 UTC 2008
Revision: 3699
Author: ksprotte
URL: http://bknr.net/trac/changeset/3699
finished m2 poi schema
U trunk/projects/bos/m2/poi.lisp
U trunk/projects/bos/test/poi.lisp
U trunk/projects/bos/web/poi-handlers.lisp
Modified: trunk/projects/bos/m2/poi.lisp
===================================================================
--- trunk/projects/bos/m2/poi.lisp 2008-07-30 13:44:57 UTC (rev 3698)
+++ trunk/projects/bos/m2/poi.lisp 2008-07-30 14:34:52 UTC (rev 3699)
@@ -16,6 +16,13 @@
(description :initform (make-string-hash-table)
:documentation "beschreibungstext")))
+(defmethod initialize-persistent-instance :after ((obj textual-attributes-mixin)
+ &key language title subtitle description)
+ (update-textual-attributes obj language
+ :title title
+ :subtitle subtitle
+ :description description))
+
(deftransaction update-textual-attributes (obj language &key title subtitle description)
(when title
(setf (slot-string obj 'title language) title))
@@ -36,13 +43,9 @@
or description is given")
(apply #'make-object class-name rest))
-(defmethod initialize-persistent-instance :after ((poi-medium poi-medium) &key language title subtitle description poi)
+(defmethod initialize-persistent-instance :after ((poi-medium poi-medium) &key poi)
(when poi
- (push poi-medium (poi-media poi)))
- (update-textual-attributes poi-medium language
- :title title
- :subtitle subtitle
- :description description))
+ (push poi-medium (poi-media poi))))
(defmethod print-object ((object poi-medium) stream)
(print-unreadable-object (object stream :type t :identity nil)
@@ -70,7 +73,7 @@
((url :accessor poi-movie-url :initarg :url :initform nil)))
;;; poi
-(defpersistent-class poi (textual-attributes-mixin)
+(defpersistent-class poi (textual-attributes-mixin)
((name
:reader poi-name :initarg :name
:index-type string-unique-index
@@ -89,18 +92,13 @@
:accessor poi-media :initarg :media :initform nil
:documentation "liste aller poi-medien, wie poi-image, poi-airal ...")))
-(deftransaction make-poi (language name &key title description area)
- (let ((poi (make-object 'poi :name name :area area)))
- (setf (slot-string poi 'title language) title)
- (setf (slot-string poi 'description language) description)
- poi))
+(deftransaction make-poi (name &rest rest &key area language title subtitle description)
+ (declare (ignore area))
+ (assert (if (or title subtitle description) language t) nil
+ "language needs to be specified, if any of title, subtitle
+ or description is given")
+ (apply #'make-object 'poi :name name rest))
-(defmethod initialize-persistent-instance :after ((poi poi) &key language title subtitle description)
- (update-textual-attributes poi language
- :title title
- :subtitle subtitle
- :description description))
-
(defmethod destroy-object :before ((poi poi))
(mapc #'delete-object (poi-media poi)))
Modified: trunk/projects/bos/test/poi.lisp
===================================================================
--- trunk/projects/bos/test/poi.lisp 2008-07-30 13:44:57 UTC (rev 3698)
+++ trunk/projects/bos/test/poi.lisp 2008-07-30 14:34:52 UTC (rev 3699)
@@ -8,3 +8,67 @@
(is (string= "a title" (slot-string medium 'title "de"))))
(signals (error) (make-poi-medium 'poi-medium :title "a title"))))
+(test make-poi-medium.with-poi
+ (with-fixture initial-bos-store ()
+ (let* ((poi (make-poi "turm"))
+ (medium (make-poi-medium 'poi-medium :language "de"
+ :title "a title"
+ :poi poi)))
+ (is (eq poi (poi-medium-poi medium)))
+ (is (member medium (poi-media poi))))))
+
+(test make-poi
+ (with-fixture initial-bos-store ()
+ (let ((poi (make-poi "turm" :area (list 50 60))))
+ (is (string= "turm" (poi-name poi)))
+ (is (= 50 (poi-center-x poi)))
+ (is (= 60 (poi-center-y poi)))
+ (is (string= "" (slot-string poi 'title "de")))
+ (is (string= "" (slot-string poi 'subtitle "de")))
+ (is (string= "" (slot-string poi 'description "de")))
+ (is (null (poi-images poi)))
+ (is (null (poi-airals poi)))
+ (is (null (poi-panoramas poi)))
+ (is (null (poi-movies poi))))
+ (signals (error) (make-poi "brunnen" :title "title"))
+ (let ((poi2 (make-poi "brunnen" :language "de"
+ :title "a title"
+ :subtitle "a subtitle"
+ :description "a description")))
+ (is (string= "brunnen" (poi-name poi2)))
+ (is (string= "a title" (slot-string poi2 'title "de")))
+ (is (string= "a subtitle" (slot-string poi2 'subtitle "de")))
+ (is (string= "a description" (slot-string poi2 'description "de"))))))
+
+(defun test-make-poi-javascript ()
+ (dolist (language '("de" "en" "da"))
+ (finishes (make-poi-javascript language))))
+
+(test make-poi-javascript
+ (with-fixture initial-bos-store ()
+ (test-make-poi-javascript)
+ (make-poi "turm" :area (list 50 60))
+ (test-make-poi-javascript)
+ (make-poi "brunnen" :language "de"
+ :title "a title"
+ :subtitle "a subtitle"
+ :description "a description")
+ (test-make-poi-javascript)))
+
+(test make-poi-image
+ (with-fixture initial-bos-store ()
+
+ (let ((test-image-path (merge-pathnames "test.png" (bknr.datastore::store-directory *store*)))
+ (poi (make-poi "turm")))
+ (cl-gd:with-image* (100 120 t)
+ (cl-gd:write-image-to-file test-image-path))
+ (is (null (poi-media poi)))
+ (import-image test-image-path :class-name 'poi-image
+ :initargs `(:poi ,poi :language "de" :title "a title"))
+ (is (poi-media poi))
+ (is (string= "a title" (slot-string (first (poi-media poi)) 'title "de")))
+ (is (= 100 (store-image-width (first (poi-media poi)))))
+ (is (= 120 (store-image-height (first (poi-media poi)))))
+ (let ((medium (first (poi-media poi))))
+ (is (eq poi (poi-medium-poi medium))))
+ (test-make-poi-javascript))))
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-07-30 13:44:57 UTC (rev 3698)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-07-30 14:34:52 UTC (rev 3699)
@@ -17,7 +17,7 @@
(html (:h2 "Bad technical name")
"Please use only alphanumerical characters, - and _ for technical POI names")))
(t
- (redirect (edit-object-url (make-poi (request-language) name)))))))
+ (redirect (edit-object-url (make-poi name)))))))
(defclass edit-poi-handler (editor-only-handler edit-object-handler)
()
More information about the Bknr-cvs
mailing list