Permalink
Browse files

Updated tests/http.lisp

  • Loading branch information...
Tomo Matsumoto Tomo Matsumoto
Tomo Matsumoto authored and Tomo Matsumoto committed Jul 14, 2009
1 parent 6cc1807 commit 6ea9d2207f226019604815a2999ec5a97468892a
Showing with 13 additions and 45 deletions.
  1. +13 −45 tests/http.lisp
View
@@ -18,63 +18,31 @@
(defpclass blog ()
((user-oid :index t :hide-for :all)
- (title :length 50 :size 40)
- (body :length 3000 :rows 25 :cols 70)))
+ (title :length 50)
+ (body :length 300)))
- (defun owner? (oid)
+ (defun owner-p* (oid)
(owner-p 'blog 'user-oid oid))
(defun owner-check (oid)
- (unless (owner? oid)
- (redirect/error-msgs (page-uri "blog") "Illegal action")))
+ (unless (owner-p* oid)
+ (redirect/error-msgs
+ (page-uri "blog") "Illegal action")))
(defpage blog (:default)
- (multiple-value-bind (items pager slots)
- (items-per-page 'blog 'updated-at)
- (html "Listing blogs"
- (msgs)
- (page-links pager)
- (if items
- [table
- [tr (dolist (s slots) [th (slot-label s)])
- (dotimes (x 3) [th (safe " ")])]
- (dolist (i items)
- [tr (dolist (s slots) [td (slot-display-value i s)])
- (let ((oid (oid i)))
- [td [a :href (page-uri "blog" "show" oid) "Show"]]
- (when (owner? oid)
- [td [a :href (page-uri "blog" "edit" oid) "Edit"]]
- [td [a :href (page-uri "blog" "delete" oid) "Delete"]]))])]
- [p "There is no blog"])
- [a :href (page-uri "blog" "edit") "New blog"]
- (if (login-user)
- [a :href (page-uri "logout") "Logout"]
- [div [a :href (page-uri "login") "Login"] " | "
- [a :href (page-uri "regist") "Sign up"]]))))
+ (index-page 'blog))
(defpage blog/show (oid)
- (html "Show blog"
- (aif (get-instance-by-oid 'blog oid)
- [table
- (dolist (s (get-excluded-slots 'blog))
- [tr [th (slot-label s)]
- [td :id (slot-id s) (slot-display-value it s)]])]
- [p "No such post."])))
+ (show-page 'blog oid))
(defpage blog/edit (oid :auth)
(when oid (owner-check oid))
- (let ((ins (get-instance-by-oid 'blog oid)))
- (html (concat (if oid "Editing" "New") " blog")
- (form-for/cont (edit/cont 'blog ins (page-uri "blog")
- :slot-values `((user-oid . ,(login-user-oid))))
- :class 'blog :instance ins :submit (if oid "Update" "Create")))))
+ (edit-page 'blog oid :slot-values
+ `((user-oid . ,(login-user-oid)))))
(defpage blog/delete (oid :auth)
(owner-check oid)
- (redirect/msgs (page-uri "blog")
- (aif (drop-instance-by-oid 'blog oid)
- "The blog post was deleted."
- "No such post")))
+ (delete-page 'blog oid))
(defpage user/is/loggedin ()
(p (if (login-user) "true" "false")))
@@ -83,8 +51,8 @@
(drop-instances-by-class 'blog)
(let ((class 'blog)
- (id "user1")
- (pass "pass1"))
+ (id "user1")
+ (pass "pass1"))
(with-new-cookie
(is-true (http-test-regist `((id . ,id)
(pass . ,pass)

0 comments on commit 6ea9d22

Please sign in to comment.