Author: hhubner Date: 2006-03-10 10:22:38 -0500 (Fri, 10 Mar 2006) New Revision: 1912
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/config.lisp branches/xml-class-rework/projects/lisp-ecoop/src/handlers.lisp branches/xml-class-rework/projects/lisp-ecoop/src/packages.lisp branches/xml-class-rework/projects/lisp-ecoop/src/participant.lisp branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp branches/xml-class-rework/projects/lisp-ecoop/src/webserver.lisp branches/xml-class-rework/projects/lisp-ecoop/website/static/javascript.js branches/xml-class-rework/projects/lisp-ecoop/website/static/styles.css branches/xml-class-rework/projects/lisp-ecoop/website/templates/create-submission.xml branches/xml-class-rework/projects/lisp-ecoop/website/templates/toplevel.xml Log: Integrated administration functions into the template based site. Numerous smaller changes.
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/config.lisp =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/src/config.lisp 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/src/config.lisp 2006-03-10 15:22:38 UTC (rev 1912) @@ -1,8 +1,12 @@ (in-package :lisp-ecoop.config)
;; URL für BASE HREFs -(defparameter *website-url* "http://lisp-ecoop.bknr.net") +(defparameter *base-path* "/")
+(eval-when (:load-toplevel :execute) + (when (probe-file "site.lisp") + (load "site.lisp"))) + (defparameter *root-directory* #p"home:bknr-svn/projects/lisp-ecoop/")
(defparameter *store-directory* (merge-pathnames #p"datastore/" *root-directory*))
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/handlers.lisp =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/src/handlers.lisp 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/src/handlers.lisp 2006-03-10 15:22:38 UTC (rev 1912) @@ -9,36 +9,6 @@ `(with-bknr-page (,req :title ,title) ,@body))
-(defclass add-participant-handler (admin-only-handler form-handler) - ()) - -(defmethod handle-form ((handler add-participant-handler) (action (eql nil)) req) - (with-lisp-ecoop-page (req "Create new participant") - ((:form :method "post" :enctype "multipart/form-data" :onsubmit "return check_participant_form(this);") - ((:table :border "1") - (:tr (:th "Login") - (:td (text-field "login" :size 15))) - (:tr (:th "Full Name") - (:td (text-field "full-name" :size 25))) - (:tr (:th "Email") - (:td (text-field "email" :size 25))) - (:tr (:th "Submission") - (:td ((:select :name "submission" :id "submission-selector" :size "1") - (dolist (submission (sort (copy-list (class-instances 'submission)) - #'string-lessp :key #'submission-title)) - (html ((:option :value (store-object-id submission)) - (:princ-safe (submission-title submission)))))) - ((:input :type "submit" :onclick "return create_submission_window();" :value "new"))))) - (submit-button "create" "create")))) - -(defmethod handle-form ((handler add-participant-handler) (action (eql :create)) req) - (with-query-params (req login full-name email text) - (when (find-user login) - (error "user ~A already exists" login)) - (make-participant login :full-name full-name :email email :text text :document-pathname (request-uploaded-file req "document")) - (with-lisp-ecoop-page (req "Pariticpant created") - "The participant has been created in the database and a welcome mail has been sent."))) - (defclass edit-participant-handler (edit-object-handler) () (:default-initargs :class 'participant :query-function #'find-user)) @@ -77,8 +47,8 @@ ())
(defmethod handle ((handler make-submission-handler) req) - (with-query-params (req title abstract) - (let ((submission (make-object 'submission :title title :abstract abstract))) + (with-query-params (req type title abstract) + (let ((submission (make-object (if (string-equal type "paper") 'paper 'breakout-group-proposal) :title title :abstract abstract))) (with-lisp-ecoop-page (req #?"Submission created") (html ((:script :type "text/javascript") (:princ-safe #?" @@ -131,11 +101,8 @@ "Please choose an administrative task from the menu"))
(define-bknr-webserver-module participants - ("/add-participant" add-participant-handler) - ("/edit-participant" edit-participant-handler) ("/make-submission" make-submission-handler) ("/pdf" pdf-handler) ("/upload-document" upload-document-handler) - ("/delete-document" delete-document-handler) - ("/admin" admin-handler)) + ("/delete-document" delete-document-handler))
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/packages.lisp =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/src/packages.lisp 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/src/packages.lisp 2006-03-10 15:22:38 UTC (rev 1912) @@ -3,7 +3,7 @@ (defpackage :lisp-ecoop.config (:use :cl :cl-user) - (:export #:*website-url* + (:export #:*base-path* #:*website-directory* #:*webserver-port* #:*store-directory* @@ -39,6 +39,7 @@ :xhtml-generator) (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:export #:participant + #:make-participant #:all-participants #:participant-p #:participant-text
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/participant.lisp =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/src/participant.lisp 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/src/participant.lisp 2006-03-10 15:22:38 UTC (rev 1912) @@ -82,6 +82,10 @@ (text :update :documentation "Self descriptionary text" :element t)) (:default-initargs :picture nil :submission nil :interests nil :text ""))
+(defun curry (fun &rest args) + #'(lambda (&rest more) + (apply fun (append args more)))) + (defmethod initialize-persistent-instance :after ((participant participant)) (make-email-list))
@@ -127,7 +131,7 @@ Please direct your questions regarding the workshop to Hans Hübner, who can be reached by email as hans@huebner.org.
-Have fun and see you in Glasgow!" +Have fun and see you on the workshop!" (user-login participant) initial-password)))
@@ -145,26 +149,19 @@ Your new password is: ~A
Please direct your questions regarding the workshop to Hans Hübner, who can -be reached by email as hans@huebner.org. - -Have fun and see you in Glasgow!" +be reached by email as hans@huebner.org." (user-login participant) (user-login participant) password)))
-(defun make-participant (login &key full-name email text document-pathname) +(defun make-participant (login &key full-name email text submission) (let* ((initial-password (generate-random-password)) - (participant (make-user login :full-name full-name :email email :password initial-password - :class 'participant))) - (when text - (with-transaction ("set participant text") - (setf (participant-text participant) text))) - (when document-pathname - (let* ((submission (make-object 'submission)) - (document (make-object 'document :info "Initial paper"))) - (blob-from-file document document-pathname) - (with-transaction ("set participant submission") - (push document (submission-documents submission)) - (setf (participant-submissions participant) (list submission))))) + (participant (make-user login :full-name full-name :email email :password initial-password + :class 'participant))) + (with-transaction (:initialize-participant) + (when text + (setf (participant-text participant) text)) + (when submission + (submission-add-submitter submission participant))) (send-welcome-mail participant initial-password) participant))
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp 2006-03-10 15:22:38 UTC (rev 1912) @@ -30,7 +30,8 @@ (let ((participant (participant-from-request))) (unless (or (admin-p (bknr-request-user *req*)) (eq participant (bknr-request-user *req*))) - (error "can't edit this profile")) + (html (:h2 "can't edit this profile")) + (return-from profile-editor)) (when (eq :post (request-method *req*)) (with-query-params (*req* action) (format t ";; ACTION ~A~%" action) @@ -109,7 +110,8 @@ (html (:h2 "Invalid submission ID")) (return-from submission-editor)) (unless (submission-edit-permitted-p submission) - (error "can't edit this submission")) + (html (:h2 "can't edit this submission")) + (return-from submission-editor)) (when (eq :post (request-method *req*)) (with-query-params (*req* action) (case (make-keyword-from-string action) @@ -143,13 +145,36 @@ (let ((*submission* submission)) (mapc #'emit-template-node children))))
+(define-bknr-tag add-participant (&key children) + (unless (admin-p (bknr-request-user *req*)) + (html "You must be logged in as adminstrator to create new participants") + (return-from add-participant)) + (with-query-params (*req* action) + (when (eq :create (make-keyword-from-string action)) + (with-query-params (*req* login full-name email text submission) + (when (find-user login) + (error "user ~A already exists" login)) + (when submission + (setf submission (find-store-object (parse-integer submission)))) + (make-participant login :full-name full-name :email email :text text :submission submission) + (html + (:princ-safe #?"The participant $(login) has been created in the database and a welcome mail has been sent."))))) + (mapc #'emit-template-node children)) + +(define-bknr-tag submission-option-list () + (dolist (submission (sort (copy-list (class-instances 'submission)) + #'string-lessp :key #'submission-title)) + (html ((:option :value (store-object-id submission)) + (:princ-safe (submission-title submission)))))) + (define-bknr-tag submission-submitter-editor () (let ((submission (submission-from-request))) (unless submission (html (:h2 "Invalid submission ID")) (return-from submission-submitter-editor)) (unless (submission-edit-permitted-p submission) - (error "can't edit this submission")) + (html (:h2 "can't edit this submission")) + (return-from submission-submitter-editor)) (with-query-params (*req* add-submitter-id remove-submitter-id add-submitter remove-submitter) (let ((submitters (submission-submitters submission))) (cond @@ -263,22 +288,26 @@ (let ((user (bknr-request-user *req*))) (cond ((anonymous-p user) - (when (query-param *req* "__username") - (html ((:div :id "logfail") "Login failed"))) (html ((:form :method "post") - "Login" :br - ((:input :type "text" :name "__username")) - "Password" :br - ((:input :type "password" :name "__password")) - ((:button :type "submit" :name "action" :value "login") "login")))) + "Login" :br + ((:input :type "text" :name "__username")) + "Password" :br + ((:input :type "password" :name "__password")) + (when (query-param *req* "__username") + (html ((:div :id "logfail") "Login failed"))) + ((:button :type "submit" :name "action" :value "login") "login")))) (t - (html ((:form :method "post" :action "/logout") - ((:input :type "hidden" :name "url" :value (puri:uri-path (request-uri *req*)))) + (html ((:form :method "post" :action (website-make-path *website* "logout")) + ((:input :type "hidden" :name "url" :value (puri:uri-path (request-uri *req*)))) (:div "Logged in as " :br ((:a :href (format-object-id "/edit-profile/~A" user)) (:princ-safe (user-full-name user)))) (:div ((:button :type "submit" :name "action" :value "logout") "logout"))))))))
+(define-bknr-tag admin-only (&key children) + (when (admin-p (bknr-request-user *req*)) + (mapc #'emit-template-node children))) + (defun parse-duration (string) (ignore-errors (destructuring-bind (hours minute) (mapcar #'parse-integer (coerce (nth-value 1 (scan-to-strings #?r"^(\d+):(\d\d)$" string)) 'list))
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/webserver.lisp =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/src/webserver.lisp 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/src/webserver.lisp 2006-03-10 15:22:38 UTC (rev 1912) @@ -8,7 +8,7 @@ (defun make-daily-statistics () (bknr.stats::make-yesterdays-stats :delete-events t :remove-referer-hosts '("lisp-ecoop.bknr.net")))
-(defun publish-lisp-ecoop (&key (port *webserver-port*) (listeners 20) (base-href "/")) +(defun publish-lisp-ecoop (&key (port *webserver-port*) (listeners 20) (base-href *base-path*))
(unless (bknr.cron:cron-job-with-name "daily webserver statistics") (bknr.cron:make-cron-job "daily webserver statistics" 'make-daily-statistics @@ -27,11 +27,7 @@ :destination ,(unix-namestring (merge-pathnames #p"static/" *website-directory*)))) :modules '(user images stats mailinglist mailinglist-registration participants schedule)
- :admin-navigation '(("add participant" . "/add-participant") - ("user" . "/user/") - ("stats" . "/stats") - ("post mailinglists" . "/post-mailinglist") - ("logout" . "/logout")) + :admin-navigation nil
:authorizer (make-instance 'bknr-authorizer) :style-sheet-urls (list (format nil "~Astatic/styles.css" base-href))
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/static/javascript.js =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/website/static/javascript.js 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/website/static/javascript.js 2006-03-10 15:22:38 UTC (rev 1912) @@ -101,7 +101,7 @@ var first_missing; for (var i = 1; i < arguments.length; i++) { var field = form[arguments[i]]; - if (field.value.match(/^\S+$/)) { + if (field.value.match(/\S+/)) { field.style.background = '#fff'; } else { input_complete = false; @@ -132,7 +132,7 @@ submission_selector.selectedIndex = 0; }
- open('/create-submission', 'createsubmission', POPUP_WINDOW_PARAMS); + open('create-submission', 'createsubmission', POPUP_WINDOW_PARAMS);
return false; } @@ -140,3 +140,18 @@ function check_create_submission_form(form) { return check_form_fields(form, 'title'); } + +// Make new participant + +function check_new_participant_form(form) +{ + var retval = check_form_fields(form, 'login', 'full-name', 'email'); + + if (retval && !form['email'].value.match(/^\S+@\S+.\S+$/)) { + alert("invalid email address"); + form['email'].focus(); + return false; + } + + return retval; +}
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/static/styles.css =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/website/static/styles.css 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/website/static/styles.css 2006-03-10 15:22:38 UTC (rev 1912) @@ -134,6 +134,12 @@ z-index: 2; }
+div.site-menu div.title { + border: 0px; + border-bottom: 1px solid #000000; + background-color: #f0f0f0; +} + div.site-menu a { text-decoration: none; color: #0000ff;
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/create-submission.xml =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/website/templates/create-submission.xml 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/create-submission.xml 2006-03-10 15:22:38 UTC (rev 1912) @@ -6,8 +6,8 @@ <head> <title>Create submission</title> <link rel="stylesheet" type="text/css" href="/static/document-utils.css" /> - <script src="/static/document-utils.js" language="javascript" type="text/javascript"> </script> - <script src="/static/javascript.js" language="javascript" type="text/javascript"> </script> + <script src="static/document-utils.js" language="javascript" type="text/javascript"> </script> + <script src="static/javascript.js" language="javascript" type="text/javascript"> </script> </head> <body class="utility-window" onload="init()"> <div id="form" class="page"> @@ -16,7 +16,11 @@ Using this form, a new submission may be created. </p> <form method="post" name="create_submission_form" id="create_submission_form" enctype="multipart/form-data" - action="/make-submission" onsubmit="return check_create_submission_form(this);"> + action="make-submission" onsubmit="return check_create_submission_form(this);"> + <p> + <input type="radio" name="type" value="paper" checked="checked"/> Paper + <input type="radio" name="type" value="breakout-group"/> Breakout group proposal + </p> <label for="title">Title</label><br/> <input type="text" size="40" maxlength="40" name="title" id="title_input"/><br/> <label for="abstract">Abstract</label><br/>
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/toplevel.xml =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/website/templates/toplevel.xml 2006-03-10 15:13:53 UTC (rev 1911) +++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/toplevel.xml 2006-03-10 15:22:38 UTC (rev 1912) @@ -30,6 +30,14 @@ container-class="site-menu" active-class="site-menu-active" inactive-class="site-menu-inactive" /> + lisp-ecoop:admin-only + <menu:site-menu config="admin-menu.xml" + menu-name="admin" + title="Admin" + container-class="site-menu" + active-class="site-menu-active" + inactive-class="site-menu-inactive" /> + </lisp-ecoop:admin-only> <div id="login"> <lisp-ecoop:login-widget /> </div>