[bknr-cvs] ksprotte changed trunk/projects/bos/
BKNR Commits
bknr at bknr.net
Mon Jul 28 14:07:28 UTC 2008
Revision: 3658
Author: ksprotte
URL: http://bknr.net/trac/changeset/3658
added support for displaying and uploading multiple poi movies
U trunk/projects/bos/m2/packages.lisp
U trunk/projects/bos/m2/poi.lisp
U trunk/projects/bos/payment-website/static/cms.js
U trunk/projects/bos/web/poi-handlers.lisp
U trunk/projects/bos/web/webserver.lisp
Modified: trunk/projects/bos/m2/packages.lisp
===================================================================
--- trunk/projects/bos/m2/packages.lisp 2008-07-28 13:41:45 UTC (rev 3657)
+++ trunk/projects/bos/m2/packages.lisp 2008-07-28 14:07:28 UTC (rev 3658)
@@ -220,6 +220,9 @@
#:panoramas
#:poi-movies
#:movies
+ #:poi-movie
+ #:poi-movie-poi
+ #:poi-movie-url
#:make-poi-image
#:update-poi-image
#:poi
Modified: trunk/projects/bos/m2/poi.lisp
===================================================================
--- trunk/projects/bos/m2/poi.lisp 2008-07-28 13:41:45 UTC (rev 3657)
+++ trunk/projects/bos/m2/poi.lisp 2008-07-28 14:07:28 UTC (rev 3658)
@@ -31,8 +31,9 @@
(loop for (slot-name value) on args by #'cddr
do (setf (slot-string object slot-name language) value)))
-;; POI-Anwendungsklassen und Konstruktoren
+;;; POI-Anwendungsklassen und Konstruktoren
+;;; poi-image
(define-persistent-class poi-image (store-image)
((poi :read)
(title :update :initform (make-string-hash-table))
@@ -67,6 +68,21 @@
(when description
(setf (slot-string poi-image 'description language) description)))
+;;; poi-movie
+(define-persistent-class poi-movie ()
+ ((poi :read)
+ (url :update :initform nil)))
+
+(defmethod poi-movies :before ((poi poi))
+ "Lazily update the db schema. Method can be removed later."
+ (macrolet ((movie (tail) `(car ,tail)))
+ (mapl (lambda (tail)
+ (when (stringp (movie tail))
+ (setf (movie tail)
+ (make-object 'poi-movie :poi poi :url (movie tail)))))
+ (slot-value poi 'movies))))
+
+;;; poi
(define-persistent-class poi ()
((name :read :index-type string-unique-index
:index-reader find-poi :index-values all-pois
Modified: trunk/projects/bos/payment-website/static/cms.js
===================================================================
--- trunk/projects/bos/payment-website/static/cms.js 2008-07-28 13:41:45 UTC (rev 3657)
+++ trunk/projects/bos/payment-website/static/cms.js 2008-07-28 14:07:28 UTC (rev 3658)
@@ -3,7 +3,6 @@
// Allgemeine Initialisierungsfunktion fuer alle CMS-Seiten
function init() {
- update_movie_preview();
}
// Formularcheck für Sponsoren-Erzeugung
@@ -65,18 +64,6 @@
function $(id) { return document.getElementById(id); }
-function update_movie_preview()
-{
- if ($('movie') && $('movie_preview')) {
- var url = $('movie').value;
- if (url == "") {
- $('movie_preview').innerHTML = '';
- } else {
- $('movie_preview').innerHTML = '<object width="360" height="340"> <param name="movie" value=" ' + url + '"> </param> <embed src=" ' + url + '" type="application/x-shockwave-flash" width="360" height="340"> </embed> </object>';
- }
- }
-}
-
function parse_youtube_link (input)
{
var text = input.value;
@@ -88,7 +75,6 @@
input.value = "";
return false;
} else {
- update_movie_preview();
return true;
}
}
@@ -97,4 +83,5 @@
{
$(field_name).value = value;
return confirm(confirm_string);
-}
\ No newline at end of file
+}
+
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-07-28 13:41:45 UTC (rev 3657)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-07-28 14:07:28 UTC (rev 3658)
@@ -154,20 +154,25 @@
(html "Upload new panorama view"
((:input :type "file" :name "image-file"))
:br
- (submit-button "upload-panorama" "upload-panorama"))))
- (:tr (:td "movie")
- (:td (html "URL or 'embed' string: "
+ (submit-button "upload-panorama" "upload-panorama"))))
+ (:tr (:td "movies"
+ ((:input :id "movie-id" :type "hidden" :name "movie-id")))
+ (:td (dolist (movie (poi-movies poi))
+ (html (:princ-safe (format-date-time (store-object-last-change movie 0)))
+ ((:a :href (format nil "/poi-movie/~D" (store-object-id movie)) :target "_new" :class "cmslink")
+ " view ")
+ (submit-button "delete-movie" "delete-movie"
+ :formcheck #?"javascript:confirm_delete('movie-id', $((store-object-id movie)), 'Really delete this movie?')")
+ :br))
+ (html "URL or 'embed' string: "
((:input :type "text"
:size "50"
- :name "movie"
+ :name "movie-url"
:id "movie"
- :value (or (first (poi-movies poi)) "")
+ :value ""
:onchange "parse_youtube_link(this)"))
- " "
- (when (poi-movies poi)
- (html :br (submit-button "delete-movie" "delete-movie" :confirm "Really delete the movie?")))
:br
- ((:div :id "movie_preview" :style "height: 340px; width: 360px;") ""))))
+ (submit-button "add-movie" "add-movie"))))
(:tr (:td (submit-button "save" "save")
(submit-button "delete" "delete" :confirm "Really delete the POI?"))))))))
@@ -225,12 +230,27 @@
(redirect (format nil "/edit-poi/~D"
(store-object-id poi))))
+
(defmethod handle-object-form ((handler edit-poi-handler)
+ (action (eql :add-movie))
+ (poi poi))
+ (with-query-params (movie-url)
+ (with-transaction ("add poi movie")
+ (push (make-object 'poi-movie :poi poi :url movie-url)
+ (poi-movies poi)))
+ (redirect (format nil "/edit-poi/~D" (store-object-id poi)))))
+
+
+(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :delete-movie))
(poi poi))
- (with-transaction ("setf poi-movies nil")
- (setf (poi-movies poi) nil))
- (redirect (format nil "/edit-poi/~D" (store-object-id poi))))
+ (with-query-params (movie-id)
+ (let ((movie (find-store-object (parse-integer movie-id))))
+ (with-transaction ("delete poi-movie")
+ (alexandria:deletef (poi-movies poi) movie))
+ (delete-object movie)))
+ (redirect (format nil "/edit-poi/~D"
+ (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :upload-panorama))
@@ -402,7 +422,23 @@
imageproc-arguments))
(error "image index ~a out of bounds for poi ~a" image-index poi)))))
+(defclass poi-movie-handler (admin-only-handler object-handler)
+ ()
+ (:default-initargs :object-class 'poi-movie))
+(defmethod handle-object ((handler poi-movie-handler) (poi-movie (eql nil)))
+ (error "poi-movie not found"))
+
+(defmethod handle-object ((handler poi-movie-handler) poi-movie)
+ (with-bos-cms-page (:title "POI movie preview")
+ (:p (cmslink (edit-object-url (poi-movie-poi poi-movie)) "Back to POI"))
+ ((:object :width "425" :height "344")
+ ((:param :name "movie" :value (poi-movie-url poi-movie)))
+ ((:param :name "allowFullScreen" :value "true"))
+ ((:embed :src (poi-movie-url poi-movie) :type "application/x-shockwave-flash"
+ :allowFullScreen "true"
+ :width "425" :height "344")))))
+
(defun write-poi-xml (poi language)
"Writes the poi xml format for one specific language. This is used
to generate the POI microsite using XSLT (client side)."
@@ -452,9 +488,9 @@
(dolist (panorama panoramas)
(with-media ("panorama" "Panorama" (store-image-name panorama))
(format-image panorama)))
- (dolist (url movies)
+ (dolist (movie movies)
(with-media ("movie" "Video")
- (with-element "url" (text url)))))))))
+ (with-element "url" (text (poi-movie-url movie))))))))))
(defun poi-description-google-earth (poi language &key (image-width 120))
(labels ((website-path (path &rest args)
Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp 2008-07-28 13:41:45 UTC (rev 3657)
+++ trunk/projects/bos/web/webserver.lisp 2008-07-28 14:07:28 UTC (rev 3658)
@@ -175,6 +175,7 @@
("/edit-news" edit-news-handler)
("/make-poi" make-poi-handler)
("/poi-image" poi-image-handler)
+ ("/poi-movie" poi-movie-handler)
("/poi-xml" poi-xml-handler)
("/poi-kml-all" poi-kml-all-handler)
("/poi-kml" poi-kml-handler)
More information about the Bknr-cvs
mailing list