- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] ksprotte changed trunk/projects/bos/test/tsung
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3880 Author: ksprotte URL: http://bknr.net/trac/changeset/3880 small tsung test update U trunk/projects/bos/test/tsung.xml U trunk/projects/bos/test/tsung2.xml Modified: trunk/projects/bos/test/tsung.xml =================================================================== --- trunk/projects/bos/test/tsung.xml 2008-09-10 14:58:16 UTC (rev 3879) +++ trunk/projects/bos/test/tsung.xml 2008-09-10 15:16:21 UTC (rev 3880) @@ -9,7 +9,7 @@  <servers> - <server host="horst.headcraft.de" port="80" type="tcp"></server> + <server host="prod.headcraft.de" port="80" type="tcp"></server> </servers>  <servers> - <server host="horst.headcraft.de" port="80" type="tcp"></server> + <server host="prod.headcraft.de" port="80" type="tcp"></server> </servers> <!-- to start os monitoring (cpu, network, memory). Use an erlang

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3879 Author: ksprotte URL: http://bknr.net/trac/changeset/3879 bos hunchentoot single-threaded startup U trunk/projects/bos/test/web/drakma-requests.lisp U trunk/projects/bos/web/startup.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 14:06:45 UTC (rev 3878) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 14:58:16 UTC (rev 3879) @@ -1,24 +1,27 @@ (in-package :bos.test) (in-suite :bos.test.web) -(defmacro with-bos-test-server ((port-var) &body body) - (check-type port-var symbol) - `(with-fixture initial-bos-store () - (let* ((,port-var (+ 70000 (random 5253))) - (server (bos.web::init :port ,port-var - :worldpay-test-mode t))) - (check-type server hunchentoot::server) - (unwind-protect - (progn ,@body) - (hunchentoot:stop-server server))))) +;;; not functional anymore in single-threaded hunchentoot +;;; (server can't be stopped) -(test web-init - (with-bos-test-server (port) - (pass))) +;; (defmacro with-bos-test-server ((port-var) &body body) +;; (check-type port-var symbol) +;; `(with-fixture initial-bos-store () +;; (let* ((,port-var (+ 70000 (random 5253))) +;; (server (bos.web::init :port ,port-var +;; :worldpay-test-mode t))) +;; (check-type server hunchentoot::server) +;; (unwind-protect +;; (progn ,@body) +;; (hunchentoot:stop-server server))))) -(test request-start-page - #+(or ccl openmcl)(skip "known to fail on ccl") - #-(or ccl openmcl) - (with-bos-test-server (port) - (let ((uri (format nil "http://localhost:~D" port))) - (is (= 200 (nth-value 1 (drakma:http-request uri))))))) +;; (test web-init +;; (with-bos-test-server (port) +;; (pass))) + +;; (test request-start-page +;; #+(or ccl openmcl)(skip "known to fail on ccl") +;; #-(or ccl openmcl) +;; (with-bos-test-server (port) +;; (let ((uri (format nil "http://localhost:~D" port))) +;; (is (= 200 (nth-value 1 (drakma:http-request uri))))))) Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-09-10 14:06:45 UTC (rev 3878) +++ trunk/projects/bos/web/startup.lisp 2008-09-10 14:58:16 UTC (rev 3879) @@ -23,8 +23,7 @@ (website-url (format nil "http://~A" host) website-url-given) worldpay-test-mode (google-analytics-account "UA-3432041-1") - start-frontend - debug) + start-frontend) (when website-url-given (warn "Specifying :website-url in web.rc is deprecated. Use :host instead.~ ~%Website-url will then be initialized by (format nil \"http://~~A\" host).")) @@ -39,17 +38,20 @@ (bos.web::publish-website :website-directory *website-directory* :website-url *website-url* :worldpay-test-mode *worldpay-test-mode*) - (format t "~&; Starting hunchentoot~@[ in debug mode~].~%" debug) + (format t "~&; Starting hunchentoot.~%") (force-output) (when *webserver* - (hunchentoot:stop-server *webserver*)) + (error "webserver already running")) (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) hunchentoot:*rewrite-for-session-urls* nil ;; the reason for the following setting is that ptviewer sends ;; a different User-Agent -- (when requesting PTDefault.html) hunchentoot:*use-user-agent-for-sessions* nil) - (setq *webserver* (hunchentoot:start-server :port *port* :threaded (not debug) - :persistent-connections-p (not debug))) + (bt:make-thread (lambda () + (hunchentoot:start-server :port *port* :threaded nil + :persistent-connections-p nil)) + :name "hunchentoot non-threaded wrapper") + (setq *webserver* t) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t"))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3878 Author: ksprotte URL: http://bknr.net/trac/changeset/3878 rollback of last 3 commits U trunk/projects/bos/test/web/drakma-requests.lisp U trunk/projects/bos/web/startup.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:45:42 UTC (rev 3877) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 14:06:45 UTC (rev 3878) @@ -7,10 +7,10 @@ (let* ((,port-var (+ 70000 (random 5253))) (server (bos.web::init :port ,port-var :worldpay-test-mode t))) - (check-type server bos.web::bos-server) + (check-type server hunchentoot::server) (unwind-protect (progn ,@body) - (bos.web::bos-server-stop))))) + (hunchentoot:stop-server server))))) (test web-init (with-bos-test-server (port) Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-09-10 13:45:42 UTC (rev 3877) +++ trunk/projects/bos/web/startup.lisp 2008-09-10 14:06:45 UTC (rev 3878) @@ -8,6 +8,8 @@ :host (pathname-host me) :version nil))) +(defvar *webserver* nil) + (defvar *port*) (defvar *website-directory*) (defvar *website-url*) @@ -22,7 +24,7 @@ worldpay-test-mode (google-analytics-account "UA-3432041-1") start-frontend - threaded) + debug) (when website-url-given (warn "Specifying :website-url in web.rc is deprecated. Use :host instead.~ ~%Website-url will then be initialized by (format nil \"http://~~A\" host).")) @@ -37,9 +39,17 @@ (bos.web::publish-website :website-directory *website-directory* :website-url *website-url* :worldpay-test-mode *worldpay-test-mode*) - (format t "~&; Starting hunchentoot.~%") - (force-output) - (bos-server-restart :port *port* :threaded threaded) + (format t "~&; Starting hunchentoot~@[ in debug mode~].~%" debug) + (force-output) + (when *webserver* + (hunchentoot:stop-server *webserver*)) + (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) + hunchentoot:*rewrite-for-session-urls* nil + ;; the reason for the following setting is that ptviewer sends + ;; a different User-Agent -- (when requesting PTDefault.html) + hunchentoot:*use-user-agent-for-sessions* nil) + (setq *webserver* (hunchentoot:start-server :port *port* :threaded (not debug) + :persistent-connections-p (not debug))) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t")) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-09-10 13:45:42 UTC (rev 3877) +++ trunk/projects/bos/web/webserver.lisp 2008-09-10 14:06:45 UTC (rev 3878) @@ -2,115 +2,6 @@ (enable-interpol-syntax) -;;;; bos-server -(defvar *webserver* nil - "When the bos-server is running this is set to the server -instance.") - -(defclass bos-server () - ()) - -;;; internal protocol -(defgeneric bos-server-start-internal (server)) -(defgeneric bos-server-stop-internal (server)) -(defgeneric bos-server-running-p-internal (server)) - -;;; external protocol -(defun bos-server-start (&key port threaded) - (let ((server-class (if threaded - 'bos-multi-threaded-server - 'bos-single-threaded-server))) - (prog1 - (setq *webserver* (make-instance server-class :port port)) - (bos-server-start-internal *webserver*)))) - -(defun bos-server-stop () - (unless (bos-server-running-p) - (error "BOS server is not running")) - (bos-server-stop-internal *webserver*)) - -(defun bos-server-running-p () - (when *webserver* - (bos-server-running-p-internal *webserver*))) - -(defun bos-server-restart (&key port threaded) - (when (bos-server-running-p) - (bos-server-stop)) - (bos-server-start :port port :threaded threaded)) - -(defgeneric bos-server-port (server)) - -;;; bos-server-hunchentoot-mixin -(defclass bos-server-hunchentoot-mixin () - ()) - -(defmethod bos-server-start-internal :before ((server bos-server-hunchentoot-mixin)) - (declare (ignore server)) - (setf hunchentoot:*hunchentoot-default-external-format* - (flex:make-external-format :utf-8 :eol-style :lf) - hunchentoot:*rewrite-for-session-urls* - nil - ;; the reason for the following setting is that ptviewer sends - ;; a different User-Agent -- (when requesting PTDefault.html) - hunchentoot:*use-user-agent-for-sessions* - nil)) - -;;;; bos-multi-threaded-server -(defclass bos-multi-threaded-server (bos-server bos-server-hunchentoot-mixin) - ((port :reader bos-server-port :initarg :port) - (native-server :accessor bos-server-native-server))) - -(defmethod bos-server-start-internal ((server bos-multi-threaded-server)) - (setf (bos-server-native-server server) - (hunchentoot:start-server :port (bos-server-port server) - :threaded t :persistent-connections-p t))) - -(defmethod bos-server-stop-internal ((server bos-multi-threaded-server)) - (hunchentoot:stop-server (bos-server-native-server server))) - -(defmethod bos-server-running-p-internal ((server bos-multi-threaded-server)) - (not (hunchentoot::server-shutdown-p (bos-server-native-server server)))) - -;;;; bos-single-threaded-server -(defclass bos-single-threaded-server (bos-server bos-server-hunchentoot-mixin) - ((port :reader bos-server-port :initarg :port) - (server-thread :accessor bos-server-thread :initform nil))) - -(defmethod bos-server-start-internal ((server bos-single-threaded-server)) - (setf (bos-server-thread server) - (bt:make-thread (lambda () - (catch 'stop-tag - (hunchentoot:start-server :port (bos-server-port server) - :threaded nil :persistent-connections-p nil))) - :name "bos-single-threaded-server"))) - -(defvar *stop-server-handler-authorized-p* nil) - -(defmacro with-stop-server-handler-autorization (&body body) - `(unwind-protect - (progn - (setq *stop-server-handler-authorized-p* t) - ,@body) - (setq *stop-server-handler-authorized-p* nil))) - -(defclass stop-server-handler (page-handler) - ()) - -(defmethod handle ((handler stop-server-handler)) - (if *stop-server-handler-authorized-p* - (throw 'stop-tag nil) - (error "not found"))) - -(defmethod bos-server-stop-internal ((server bos-single-threaded-server)) - (with-stop-server-handler-autorization - (ignore-errors (drakma:http-request (format nil "http://localhost:~D/stop-server" - (bos-server-port server))))) - nil) - -(defmethod bos-server-running-p-internal ((server bos-single-threaded-server)) - (and (bos-server-thread server) - (bt:thread-alive-p (bos-server-thread server)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -265,8 +156,7 @@ (make-instance 'bos-website :name "create-rainforest.org CMS" - :handler-definitions `(("/stop-server" stop-server-handler) - ("/edit-poi-medium" edit-poi-medium-handler) + :handler-definitions `(("/edit-poi-medium" edit-poi-medium-handler) ("/edit-poi" edit-poi-handler) ("/edit-sponsor" edit-sponsor-handler) ("/kml-upload" kml-upload-handler)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/web/drakma-requests.lisp
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3877 Author: ksprotte URL: http://bknr.net/trac/changeset/3877 NOW fixed bos tests for prev commit U trunk/projects/bos/test/web/drakma-requests.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:33:04 UTC (rev 3876) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:45:42 UTC (rev 3877) @@ -10,7 +10,7 @@ (check-type server bos.web::bos-server) (unwind-protect (progn ,@body) - (hunchentoot:stop-server server))))) + (bos.web::bos-server-stop))))) (test web-init (with-bos-test-server (port)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/web/drakma-requests.lisp
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3876 Author: ksprotte URL: http://bknr.net/trac/changeset/3876 fixed bos tests for prev commit U trunk/projects/bos/test/web/drakma-requests.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:12:22 UTC (rev 3875) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:33:04 UTC (rev 3876) @@ -7,7 +7,7 @@ (let* ((,port-var (+ 70000 (random 5253))) (server (bos.web::init :port ,port-var :worldpay-test-mode t))) - (check-type server hunchentoot::server) + (check-type server bos.web::bos-server) (unwind-protect (progn ,@body) (hunchentoot:stop-server server)))))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3875 Author: ksprotte URL: http://bknr.net/trac/changeset/3875 implemented bos-multi-threaded-server and bos-single-threaded-server (now default) U trunk/projects/bos/web/startup.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-09-10 09:27:54 UTC (rev 3874) +++ trunk/projects/bos/web/startup.lisp 2008-09-10 13:12:22 UTC (rev 3875) @@ -8,8 +8,6 @@ :host (pathname-host me) :version nil))) -(defvar *webserver* nil) - (defvar *port*) (defvar *website-directory*) (defvar *website-url*) @@ -24,7 +22,7 @@ worldpay-test-mode (google-analytics-account "UA-3432041-1") start-frontend - debug) + threaded) (when website-url-given (warn "Specifying :website-url in web.rc is deprecated. Use :host instead.~ ~%Website-url will then be initialized by (format nil \"http://~~A\" host).")) @@ -39,17 +37,9 @@ (bos.web::publish-website :website-directory *website-directory* :website-url *website-url* :worldpay-test-mode *worldpay-test-mode*) - (format t "~&; Starting hunchentoot~@[ in debug mode~].~%" debug) - (force-output) - (when *webserver* - (hunchentoot:stop-server *webserver*)) - (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) - hunchentoot:*rewrite-for-session-urls* nil - ;; the reason for the following setting is that ptviewer sends - ;; a different User-Agent -- (when requesting PTDefault.html) - hunchentoot:*use-user-agent-for-sessions* nil) - (setq *webserver* (hunchentoot:start-server :port *port* :threaded (not debug) - :persistent-connections-p (not debug))) + (format t "~&; Starting hunchentoot.~%") + (force-output) + (bos-server-restart :port *port* :threaded threaded) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t")) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-09-10 09:27:54 UTC (rev 3874) +++ trunk/projects/bos/web/webserver.lisp 2008-09-10 13:12:22 UTC (rev 3875) @@ -2,6 +2,115 @@ (enable-interpol-syntax) +;;;; bos-server +(defvar *webserver* nil + "When the bos-server is running this is set to the server +instance.") + +(defclass bos-server () + ()) + +;;; internal protocol +(defgeneric bos-server-start-internal (server)) +(defgeneric bos-server-stop-internal (server)) +(defgeneric bos-server-running-p-internal (server)) + +;;; external protocol +(defun bos-server-start (&key port threaded) + (let ((server-class (if threaded + 'bos-multi-threaded-server + 'bos-single-threaded-server))) + (prog1 + (setq *webserver* (make-instance server-class :port port)) + (bos-server-start-internal *webserver*)))) + +(defun bos-server-stop () + (unless (bos-server-running-p) + (error "BOS server is not running")) + (bos-server-stop-internal *webserver*)) + +(defun bos-server-running-p () + (when *webserver* + (bos-server-running-p-internal *webserver*))) + +(defun bos-server-restart (&key port threaded) + (when (bos-server-running-p) + (bos-server-stop)) + (bos-server-start :port port :threaded threaded)) + +(defgeneric bos-server-port (server)) + +;;; bos-server-hunchentoot-mixin +(defclass bos-server-hunchentoot-mixin () + ()) + +(defmethod bos-server-start-internal :before ((server bos-server-hunchentoot-mixin)) + (declare (ignore server)) + (setf hunchentoot:*hunchentoot-default-external-format* + (flex:make-external-format :utf-8 :eol-style :lf) + hunchentoot:*rewrite-for-session-urls* + nil + ;; the reason for the following setting is that ptviewer sends + ;; a different User-Agent -- (when requesting PTDefault.html) + hunchentoot:*use-user-agent-for-sessions* + nil)) + +;;;; bos-multi-threaded-server +(defclass bos-multi-threaded-server (bos-server bos-server-hunchentoot-mixin) + ((port :reader bos-server-port :initarg :port) + (native-server :accessor bos-server-native-server))) + +(defmethod bos-server-start-internal ((server bos-multi-threaded-server)) + (setf (bos-server-native-server server) + (hunchentoot:start-server :port (bos-server-port server) + :threaded t :persistent-connections-p t))) + +(defmethod bos-server-stop-internal ((server bos-multi-threaded-server)) + (hunchentoot:stop-server (bos-server-native-server server))) + +(defmethod bos-server-running-p-internal ((server bos-multi-threaded-server)) + (not (hunchentoot::server-shutdown-p (bos-server-native-server server)))) + +;;;; bos-single-threaded-server +(defclass bos-single-threaded-server (bos-server bos-server-hunchentoot-mixin) + ((port :reader bos-server-port :initarg :port) + (server-thread :accessor bos-server-thread :initform nil))) + +(defmethod bos-server-start-internal ((server bos-single-threaded-server)) + (setf (bos-server-thread server) + (bt:make-thread (lambda () + (catch 'stop-tag + (hunchentoot:start-server :port (bos-server-port server) + :threaded nil :persistent-connections-p nil))) + :name "bos-single-threaded-server"))) + +(defvar *stop-server-handler-authorized-p* nil) + +(defmacro with-stop-server-handler-autorization (&body body) + `(unwind-protect + (progn + (setq *stop-server-handler-authorized-p* t) + ,@body) + (setq *stop-server-handler-authorized-p* nil))) + +(defclass stop-server-handler (page-handler) + ()) + +(defmethod handle ((handler stop-server-handler)) + (if *stop-server-handler-authorized-p* + (throw 'stop-tag nil) + (error "not found"))) + +(defmethod bos-server-stop-internal ((server bos-single-threaded-server)) + (with-stop-server-handler-autorization + (ignore-errors (drakma:http-request (format nil "http://localhost:~D/stop-server" + (bos-server-port server))))) + nil) + +(defmethod bos-server-running-p-internal ((server bos-single-threaded-server)) + (and (bos-server-thread server) + (bt:thread-alive-p (bos-server-thread server)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -156,7 +265,8 @@ (make-instance 'bos-website :name "create-rainforest.org CMS" - :handler-definitions `(("/edit-poi-medium" edit-poi-medium-handler) + :handler-definitions `(("/stop-server" stop-server-handler) + ("/edit-poi-medium" edit-poi-medium-handler) ("/edit-poi" edit-poi-handler) ("/edit-sponsor" edit-sponsor-handler) ("/kml-upload" kml-upload-handler)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/static/toplevel_style.css
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3874 Author: ksprotte URL: http://bknr.net/trac/changeset/3874 bos css anpassung menue_header_main U trunk/projects/bos/payment-website/static/toplevel_style.css Modified: trunk/projects/bos/payment-website/static/toplevel_style.css =================================================================== --- trunk/projects/bos/payment-website/static/toplevel_style.css 2008-09-10 09:17:03 UTC (rev 3873) +++ trunk/projects/bos/payment-website/static/toplevel_style.css 2008-09-10 09:27:54 UTC (rev 3874) @@ -105,10 +105,10 @@ /* menueleiste im header - neue version - mittlerer bereich hauptmenue */ #menue_header_main { position: absolute; - z-index: 9; + z-index: 120; margin-top: 74px; margin-left: 230px; - width: 450px; + width: 410px; height: 15px; visibility: visible; display: block;

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/static/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3873 Author: ksprotte URL: http://bknr.net/trac/changeset/3873 bos css anpassung menue_header_main U trunk/projects/bos/payment-website/static/poi/bos_style.css U trunk/projects/bos/payment-website/static/toplevel_style.css Modified: trunk/projects/bos/payment-website/static/poi/bos_style.css =================================================================== --- trunk/projects/bos/payment-website/static/poi/bos_style.css 2008-09-09 19:50:55 UTC (rev 3872) +++ trunk/projects/bos/payment-website/static/poi/bos_style.css 2008-09-10 09:17:03 UTC (rev 3873) @@ -266,7 +266,7 @@ #menue_header_main{ float:left; margin-top: 74px; - margin-left: 184px; + margin-left: 230px; width: 450px; height: 15px; visibility: visible; Modified: trunk/projects/bos/payment-website/static/toplevel_style.css =================================================================== --- trunk/projects/bos/payment-website/static/toplevel_style.css 2008-09-09 19:50:55 UTC (rev 3872) +++ trunk/projects/bos/payment-website/static/toplevel_style.css 2008-09-10 09:17:03 UTC (rev 3873) @@ -107,7 +107,7 @@ { position: absolute; z-index: 9; margin-top: 74px; - margin-left: 184px; + margin-left: 230px; width: 450px; height: 15px; visibility: visible;

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/
by BKNR Commits 09 Sep '08

09 Sep '08

Revision: 3872 Author: hans URL: http://bknr.net/trac/changeset/3872 Fix image editing. Factor out login Javascript. Minor tweaks. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/webserver.lisp U trunk/projects/quickhoney/website/static/javascript.js A trunk/projects/quickhoney/website/static/login.js U trunk/projects/quickhoney/website/templates/image-browse.xml U trunk/projects/quickhoney/website/templates/index.xml U trunk/projects/quickhoney/website/templates/login.xml Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-09 17:41:22 UTC (rev 3871) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-09 19:50:55 UTC (rev 3872) @@ -139,26 +139,32 @@ (:default-initargs :object-class 'quickhoney-image)) (defmethod handle-object-form ((handler json-edit-image-handler) action image) - (format t "; invalid action ~A or invalid object ~A~%" action image)) + (with-json-response () + (encode-object-element "result" "error") + (encode-object-element "message" (format nil "; invalid action ~A or invalid object ~A~%" action image)))) (defun image-keywords-from-request-parameters () (let (retval) - (dolist (keyword *editable-keywords* retval) + (dolist (keyword *editable-keywords* + retval) (when (query-param (string-downcase (symbol-name keyword))) (push keyword retval))))) (defmethod handle-object-form ((handler json-edit-image-handler) (action (eql :edit)) image) (with-query-params (client spider-keywords) + (format t "editing image ~A client ~A spider-keywords ~A~%" image client spider-keywords) (with-transaction (:edit-image) (setf (quickhoney-image-client image) client (quickhoney-image-spider-keywords image) spider-keywords (store-image-keywords image) (append (set-difference (store-image-keywords image) *editable-keywords*) (image-keywords-from-request-parameters))))) + (setf *last-image-upload-timestamp* (get-universal-time)) (with-json-response () (encode-object-element "result" "edited"))) (defmethod handle-object-form ((handler json-edit-image-handler) (action (eql :delete)) (image quickhoney-image)) (delete-object image) + (setf *last-image-upload-timestamp* (get-universal-time)) (with-json-response () (encode-object-element "result" "deleted"))) @@ -292,7 +298,8 @@ (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :class-name 'quickhoney-image :keywords (cons :upload (image-keywords-from-request-parameters)) - :initargs (list :cat-sub (mapcar #'make-keyword-from-string (decoded-handler-path handler)) + :initargs (list :owner (bknr-session-user) + :cat-sub (mapcar #'make-keyword-from-string (decoded-handler-path handler)) :client client :spider-keywords spider-keywords)))) (with-http-response () Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-09-09 17:41:22 UTC (rev 3871) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-09-09 19:50:55 UTC (rev 3872) @@ -59,4 +59,4 @@ :site-logo-url "/image/quickhoney/color,000000,33ff00" :login-logo-url "/image/quickhoney/color,000000,33ff00/double,3" :style-sheet-urls '("/static/yui/reset-fonts/reset-fonts.css" "/static/quickhoney.css" "/static/cms.css") - :javascript-urls '("/static/javascript.js"))) + :javascript-urls '("/MochiKit/MochiKit.js" "/static/javascript.js"))) Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-09 17:41:22 UTC (rev 3871) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-09 19:50:55 UTC (rev 3872) @@ -97,31 +97,76 @@ /* image editing */ +function all_inputs(parent) { + var inputs = []; + map(function (tag) { + inputs = inputs.concat(getElementsByTagAndClassName(tag, null, parent)); + }, ['textarea', 'select', 'input']); + return inputs; +} + +function submit_json(url, form, handler) { + var names = []; + var values = []; + + if (form) { + map(function (input) { + names.push(input.name); + if (input.type != 'checkbox' || input.checked) { + values.push(input.value); + } + }, all_inputs(form)); + } + + MochiKit.Async.doXHR(url, { mimeType: 'text/plain', + headers: [['Accept', 'application/json']], + method: 'POST', + headers: {"Content-Type":"application/x-www-form-urlencoded"}, + sendContent: queryString(names, values) }) + .addCallbacks(function (req) { handler(MochiKit.Base.evalJSON(req.responseText)) }, + alert); + +} + function do_edit() { current_image.client = $("edit_client").value; current_image.spider_keywords = $("edit_keywords").value; current_image.keywords.explicit = $("edit_explicit").checked ? true : false; show_cms_window('saving_edits_form'); // hide edit window until server replies + + submit_json('/json-edit-image/' + current_image.id + '?action=edit', 'edit_form_element', image_edited); + + return false; } -function image_edited() { +function image_edited(json_data) { + if (json_data.result == 'error') { + alert(json_data.message); + } show_cms_window("image_edited_form"); setTimeout("show_cms_window('edit_form')", 2000); // reload_clients(); } +function do_delete() { + + if (confirm('delete this image?')) { + show_cms_window('saving_edits_form'); // hide edit window until server replies + + submit_json('/json-edit-image/' + current_image.id + '?action=delete', null, image_deleted); + } + + return false; +} + function image_deleted() { show_cms_window("image_deleted_form"); current_image = null; $("image_detail").innerHTML = ''; - if (current_directory == 'home') { - load_button_images(); - } else { - setTimeout("if (!current_image) { show_cms_window('upload_form'); }", 2000); - do_query(); - } + setTimeout("if (!current_image) { show_cms_window('upload_form'); }", 2000); + do_query(); } /* clients list */ @@ -441,6 +486,11 @@ } } +function do_query() +{ + query_imagedb(current_directory, current_subdirectory, true); +} + /* pages handling */ function Page(link_color, action) { @@ -469,6 +519,7 @@ if (logged_in) { if (current_directory == "home") { + show_cms_window(); } else if (current_directory == "news") { show_cms_window("edit_news"); } else if (current_directory && current_subdirectory) { @@ -1008,14 +1059,12 @@ wait_for_images(function () { img.style.visibility = 'inherit' }); } - if (logged_in) { - $("edit_form_element").setAttribute("action", "/edit-image-js/" + current_image.id); $("edit_client").value = current_image.client; - $("edit_keywords").value = current_image.spider_keywords; + $("edit_keywords").value = current_image.spider_keywords || ""; map(function(keyword) { $('edit_' + keyword).checked = current_image.keywords[keyword] ? true : false; - }, ['explicit', 'buy-file', 'buy-print', 'buy-t-shirt']); + }, ['explicit']); show_cms_window("edit_form"); } } @@ -1217,7 +1266,11 @@ } function make_ipod_image() { - window.open('/image/' + encodeURI(current_image.name) + '/cell,,320,480/download,' + encodeURI(current_image.name) + '.jpg'); + window.open('/image/' + + encodeURI(current_image.name) + + '/cell,,' + + ((current_image.width < current_image.height) ? '320,480' : '480,320') + + '/download,' + encodeURI(current_image.name) + '.jpg'); } NOTICE = partial(SPAN, { 'class': 'notice' }); @@ -1414,7 +1467,7 @@ hidden_IMG({ src: recolored_image_path('hey'), 'class': 'flag', width: 37, height: 16}), DIV({ 'class': 'button-section-items last' }, UL(null, - make_image_action_button('ipod', 'iPod', make_ipod_image), + make_image_action_button('ipod', 'iPhone', make_ipod_image), make_image_action_button('comment', 'Comment', make_comment_form))))); replaceChildNodes('image_action_buttons', groups); @@ -1436,18 +1489,3 @@ wait_for_images(function () { $('image_action_buttons').style.visibility = 'inherit'; }); } -/* login stuff */ - -function init_login () { - $('username').focus(); - $('login_form').style.display = 'block'; -} - -function do_login () { - - $('login_form').style.display = 'none'; - $('logging-in').style.display = 'block'; - - return true; -} - Added: trunk/projects/quickhoney/website/static/login.js =================================================================== --- trunk/projects/quickhoney/website/static/login.js (rev 0) +++ trunk/projects/quickhoney/website/static/login.js 2008-09-09 19:50:55 UTC (rev 3872) @@ -0,0 +1,15 @@ +/* login stuff */ + +function init_login () { + $('login_form').style.display = 'block'; + $('username').focus(); +} + +function do_login () { + + $('login_form').style.display = 'none'; + $('logging-in').style.display = 'block'; + + return true; +} + Modified: trunk/projects/quickhoney/website/templates/image-browse.xml =================================================================== --- trunk/projects/quickhoney/website/templates/image-browse.xml 2008-09-09 17:41:22 UTC (rev 3871) +++ trunk/projects/quickhoney/website/templates/image-browse.xml 2008-09-09 19:50:55 UTC (rev 3872) @@ -10,8 +10,6 @@ <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css" /> <link rel="stylesheet" href="/static/quickhoney.css" /> <link rel="stylesheet" href="/static/image-browse.css" /> - <script src="/static/javascript.js" type="text/javascript"> - </script> <title>QuickHoney image</title> </head> <body id="image-browse"> Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-09 17:41:22 UTC (rev 3871) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-09 19:50:55 UTC (rev 3872) @@ -179,12 +179,15 @@ <input type="text" id="upload_client" name="client" value="" /><br /> <span id="upload_client_select"> </span> + <br /> Keywords:<br /> <input type="text" id="upload_keywords" name="spider-keywords" value="" /><br /> <input type="checkbox" id="explicit" name="explicit" value="1" /> Explicit<br/> +  </p> <p class="cms"> <input type="submit" name="upload" value="upload" /> @@ -240,24 +243,26 @@ </div> <div id="edit_form" class="cms_form"> - <form id="edit_form_element" action="/edit-image-js" target="edit_iframe" method="post" - onsubmit="return do_edit();"> + <form id="edit_form_element" action="#" method="post" onsubmit="return false;"> <div class="cms_title">Edit image</div> <p class="cms"> Client:<br /> <input type="text" id="edit_client" name="client" value="" /><br /> <span id="edit_client_select"> </span> + <br /> Keywords:<br /> <input type="text" id="edit_keywords" name="spider-keywords" value="" /><br /> <input type="checkbox" id="edit_explicit" name="explicit" value="1" /> Explicit<br/> +  </p> <p class="cms"> - <input type="submit" name="action" value="edit" /> - <input type="submit" name="action" value="delete" onclick="return confirm('Really delete this image?');" /> + <button type="submit" onclick="do_edit();">edit</button> + <button type="submit" onclick="do_delete();">delete</button> </p> </form> </div> Modified: trunk/projects/quickhoney/website/templates/login.xml =================================================================== --- trunk/projects/quickhoney/website/templates/login.xml 2008-09-09 17:41:22 UTC (rev 3871) +++ trunk/projects/quickhoney/website/templates/login.xml 2008-09-09 19:50:55 UTC (rev 3872) @@ -10,7 +10,7 @@ <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css" /> <link rel="stylesheet" href="/static/login.css" /> <script src="/MochiKit/MochiKit.js" type="text/javascript"> </script> - <script src="/static/javascript.js" type="text/javascript"> </script> + <script src="/static/login.js" type="text/javascript"> </script> <title>QuickHoney CMS Login</title> </head>

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/
by BKNR Commits 09 Sep '08

09 Sep '08

Revision: 3871 Author: ksprotte URL: http://bknr.net/trac/changeset/3871 added handlers /sitemap.xml and /contract-placemark for Google crawler U trunk/projects/bos/web/contract-tree.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-09-09 15:57:45 UTC (rev 3870) +++ trunk/projects/bos/web/contract-tree.lisp 2008-09-09 17:41:22 UTC (rev 3871) @@ -132,7 +132,64 @@ (hunchentoot:handle-if-modified-since (timestamp node)) ,@body)) -;;; kml handler +;;; contract-placemark-handler +(defclass contract-placemark-handler (object-handler) + () + (:default-initargs :object-class 'contract) + (:documentation "Publishes a contract as a kml placemark to be +crawled by Google.")) + +(defmethod handle-object ((handler contract-placemark-handler) contract + &aux (last-change (store-object-last-change contract 0))) + (hunchentoot:handle-if-modified-since last-change) + (setf (hunchentoot:header-out :last-modified) + (hunchentoot:rfc-1123-date last-change)) + (let ((name (user-full-name (contract-sponsor contract)))) + (with-xml-response (:content-type "application/vnd.google-earth.kml+xml") + (with-namespace (nil "http://www.opengis.net/kml/2.2") + (with-namespace ("atom" "http://www.w3.org/2005/Atom") + (with-element "kml" + (with-element "Document" + (when name (with-element "name" (text name))) + (with-element* ("atom" "author") + (with-element* ("atom" "name") + (text "BOS Deutschland e.V. - Borneo Orangutan Survival Deutschland"))) + (with-element* ("atom" "link") + (attribute "href" (format nil "http://~A" (website-host)))) + (with-element "Placemark" + (when name (with-element "name" (text name))) + (with-element "Snippet" + (attribute "maxLines" "2") + (text (format-date-time (contract-date contract) :show-time nil)) + (with-element "br") + (text (format nil "~D m²" (contract-area contract)))) + (with-element "description" (cdata (contract-description contract "en"))) + (with-element "Point" + (with-element "coordinates" + (destructuring-bind (x y) + (contract-center contract) + (text (with-output-to-string (out) + (kml-format-point (make-point :x x :y y) out)))))))))))))) + +;;; sitemap-handler +(defclass sitemap-handler (page-handler) + ()) + +(defmethod handle ((handler sitemap-handler)) + (with-xml-response () + (with-namespace (nil "http://www.sitemaps.org/schemas/sitemap/0.9") + (with-namespace ("geo" "http://www.google.com/geo/schemas/sitemap/1.0") + (with-element "urlset" + (dolist (contract (class-instances 'contract)) + (when (user-full-name (contract-sponsor contract)) + (with-element "url" + (with-element "loc" + (text (format nil "http://~A/contract-placemark/~D" + (website-host) (store-object-id contract)))) + (with-element* ("geo" "geo") + (with-element* ("geo" "format") (text "kml"))))))))))) + +;;; contract-tree-kml-handler (defclass contract-tree-kml-handler (page-handler) () (:documentation "Generates a kml representation of the queried Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-09-09 15:57:45 UTC (rev 3870) +++ trunk/projects/bos/web/webserver.lisp 2008-09-09 17:41:22 UTC (rev 3871) @@ -163,6 +163,8 @@ ("/kml-root-dynamic" kml-root-dynamic-handler) ("/kml-root" kml-root-handler) ("/country-stats" country-stats-handler) + ("/sitemap.xml" sitemap-handler) + ("/contract-placemark" contract-placemark-handler) ("/contract-tree-kml" contract-tree-kml-handler) ("/contract-tree-image" contract-tree-image-handler) ("/contract-image" contract-image-handler)

1 0