update code style, little fix

gihnius · Sep 7, 2011 · eae9a01 · eae9a01
1 parent 2ae7ed3
commit eae9a01
Show file tree

Hide file tree

Showing 6 changed files with 408 additions and 397 deletions.
diff --git a/blog.lisp b/blog.lisp
@@ -2,11 +2,6 @@
 
 ;;;; show by request uri ;;;;
 
-(defun handler-cb (err msg)
-  (ignore-errors
-    (with-open-file (s *blog-running-log* :direction :output :if-does-not-exist :create :if-exists :append)
-      (format s "~&~A Error: \"~A\" - Message: \"~A\" ~%" (make-post-url-by-timestamp (get-universal-time)) err msg))))
-
 (defun show-category-tag-index-page ()
   (let* ((req (request-url))
          (cp (ppcre:register-groups-bind (category-tag (#'parse-integer page))
@@ -23,14 +18,14 @@
     (if (and p2 (> p2 0)) p2 (setf p2 1))
     (if (find c (get-categories) :test #'string-equal)
         (html-page
-            (:title (str (concatenate 'string "Category: " c)))
-          (str (render-index-page p1 (get-all-posts-of-categories c) c nil))
-          (str (render-footpage)))
-        (if (find tag (get-tags) :test #'string-equal)
-            (html-page
-                (:title (str (concatenate 'string "Tag: " tag)))
-              (str (render-index-page p2 (get-all-posts-of-tags tag) nil tag))
-              (str (render-footpage)))))))
+         (:title (str (concatenate 'string "Category: " c)))
+         (str (render-index-page p1 (get-all-posts-of-categories c) c nil))
+         (str (render-footpage)))
+        (when (find tag (get-tags) :test #'string-equal)
+          (html-page
+           (:title (str (concatenate 'string "Tag: " tag)))
+           (str (render-index-page p2 (get-all-posts-of-tags tag) nil tag))
+           (str (render-footpage)))))))
 
 (defun show-archive-index ()
   (let* ((req (request-url))
@@ -45,12 +40,12 @@
                 (concatenate 'string year month date))))
     (flet ((render-archive (a)
              (html-page
-                 (:title (str (concatenate 'string "Archives: " a)))
-               (loop for ts in (get-by-archive a)
-                  do (htm
-                      (:div :class "post-achives"
-                            (str (render-post-page-title-only ts)))))
-               (str (render-footpage)))))
+              (:title (str (concatenate 'string "Archives: " a)))
+              (loop for ts in (get-by-archive a)
+                 do (htm
+                     (:div :class "post-achives"
+                           (str (render-post-page-title-only ts)))))
+              (str (render-footpage)))))
       (cond (y (render-archive y))
             (ym (render-archive ym))
             (ymd (render-archive ymd))))))
@@ -60,12 +55,12 @@
          (p (ppcre:register-groups-bind ((#'parse-integer page))
                 ("^/index/(\\d+)$" req)
               page)))
-    (if (or (string-equal "/" req) (string-equal "/index" req) (string-equal "/index/" req))
-        (setf p 1))
+    (when (or (string-equal "/" req) (string-equal "/index" req) (string-equal "/index/" req))
+      (setf p 1))
     (html-page
-        (:title (str *blog-title*))
-      (str (render-index-page p (get-all-posts-timestamp) nil nil))
-      (str (render-footpage)))))
+     (:title (str *blog-title*))
+     (str (render-index-page p (get-all-posts-timestamp) nil nil))
+     (str (render-footpage)))))
 
 (defun show-post ()
   (let* ((req (request-url))
@@ -74,15 +69,15 @@
                 post-url))
          (ts (and url (post-url-to-timestamp url))))
     (html-page
-        (:title (str (get-post-title ts)))
-      (str (render-post-page ts nil))
-      (str (render-footpage)))))
+     (:title (str (get-post-title ts)))
+     (str (render-post-page ts nil))
+     (str (render-footpage)))))
 
 (defun show-about ()
   (html-page
-      (:title (str (concatenate 'string "About: " *blog-title*)))
-    (str (render-about))
-    (str (render-footpage))))
+   (:title (str (concatenate 'string "About: " *blog-title*)))
+   (str (render-about))
+   (str (render-footpage))))
 
 (defun show-rss ()
   (with-html-output-to-string (*html-output-stream* nil :prologue "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>")
@@ -103,24 +98,24 @@
 (defun show-search-page ()
   (let ((srch (param-post-trim "search")))
     (html-page
-        (:title (str (concatenate 'string "Search: " srch)))
-      (str (render-search-page srch)))))
+     (:title (str (concatenate 'string "Search: " srch)))
+     (str (render-search-page srch)))))
 
 (defun edit-category-tag ()
   (let ((c (param-post-trim "new_category"))
         (tag (param-post-trim "new_tag"))
         (add (param-post "add"))
         (del (param-post "delete")))
-    (if (and add (login-p))
-        (progn
-          (if (validate c 'string :min 1 :max 30)
-              (handler-call (new-category (replace-space c)) "add new category failed!" handler-cb))
-          (if (validate tag 'string :min 1 :max 30)
-              (handler-call (new-tag (replace-space tag)) "add new tag failed!" handler-cb))))
-    (if (and del (login-p))
-        (progn
-          (if c (handler-call (delete-category c) "delete category failed!" handler-cb))
-          (if tag (handler-call (delete-tag tag) "delete tag failed!" handler-cb))))
+    (when (and add (login-p))
+      (progn
+        (when (validate c 'string :min 1 :max 30)
+          (handler-call (new-category (replace-space c)) "add new category failed!" handler-cb))
+        (when (validate tag 'string :min 1 :max 30)
+          (handler-call (new-tag (replace-space tag)) "add new tag failed!" handler-cb))))
+    (when (and del (login-p))
+      (progn
+        (when c (handler-call (delete-category c) "delete category failed!" handler-cb))
+        (when tag (handler-call (delete-tag tag) "delete tag failed!" handler-cb))))
     (http-redirect "/admin")))
 
 (defun save-post-blog (edit-ts title body allow-comment author relate-posts category tags)
@@ -135,11 +130,11 @@
                       :post-author author
                       :relate-posts relate-posts)
          ;; update category
-         (if (not (find category (get-categories-of-post edit-ts) :test #'string-equal))
-             (progn
-               (loop for c in (get-categories-of-post edit-ts)
-                  do (category-post-delete c edit-ts))
-               (category-post category edit-ts)))
+         (when (not (find category (get-categories-of-post edit-ts) :test #'string-equal))
+           (progn
+             (loop for c in (get-categories-of-post edit-ts)
+                do (category-post-delete c edit-ts))
+             (category-post category edit-ts)))
          ;; remove old tags
          (loop for tag in (get-tags-of-post edit-ts)
             do (tag-post-delete tag edit-ts))
@@ -224,45 +219,45 @@
          (ts (post-url-to-timestamp url))
          (cs (get-categories-of-post ts))
          (tags (get-tags-of-post ts)))
-    (if (and (login-p) (validate ts 'timestamp))
-        (progn
-          (handler-call (delete-post ts) "Delete the post failed!" handler-cb)
-          (loop for com in (get-comments-for-post (make-post-url-by-timestamp ts))
-             do (delete-comment com))
-          (loop for c in cs
-             do (category-post-delete c ts))
-          (loop for tag in tags
-             do (tag-post-delete tag ts))))
+    (when (and (login-p) (validate ts 'timestamp))
+      (progn
+        (handler-call (delete-post ts) "Delete the post failed!" handler-cb)
+        (loop for com in (get-comments-for-post (make-post-url-by-timestamp ts))
+           do (delete-comment com))
+        (loop for c in cs
+           do (category-post-delete c ts))
+        (loop for tag in tags
+           do (tag-post-delete tag ts))))
     (http-redirect "/")))
 
 (defun show-admin-page ()
   (let ((edit-post (param-get "a"))
         (ts nil))
-    (if (and edit-post (validate edit-post 'string :len 14)
-             (validate (get-post-title (post-url-to-timestamp edit-post)) 'string :min 2))
-        (setf ts (post-url-to-timestamp edit-post)))
+    (when (and edit-post (validate edit-post 'string :len 14)
+               (validate (get-post-title (post-url-to-timestamp edit-post)) 'string :min 2))
+      (setf ts (post-url-to-timestamp edit-post)))
     (html-page
-        (:title (str "Admin: "))
-      (if (login-p)
-          (str (render-admin-page ts))
-          (http-redirect "/login")))))
+     (:title (str "Admin: "))
+     (if (login-p)
+         (str (render-admin-page ts))
+         (http-redirect "/login")))))
 
 (defun show-login-page ()
   (html-page
-      (:title (str "Login: "))
-    (str (render-login))))
+   (:title (str "Login: "))
+   (str (render-login))))
 
 (defun auth-login ()
   (let ((user (param-post-trim "username"))
         (pass (param-post-trim "password")))
     (no-cache)
-    (if (and (equal *owner* user) (equal *pass* (md5sum pass)))
-        (login-session *owner*))
+    (when (and (equal *owner* user) (equal *pass* (md5sum pass)))
+      (login-session *owner*))
     (http-redirect "/admin")))
 
 (defun auth-logout ()
-  (if (login-p)
-      (logout-session))
+  (when (login-p)
+    (logout-session))
   (http-redirect "/"))
 
 (defun http-error-handler (return-code)

diff --git a/comments.lisp b/comments.lisp
@@ -31,14 +31,14 @@
                      :email email
                      :uri uri
                      :ip ip))
-    (if replay-for
-        (c-has-comments replay-for ts))
+    (when replay-for
+      (c-has-comments replay-for ts))
     (let ((p (get-instance-by-value 'blog-post 'post-url for-post-url)))
       (and p (incf (post-comments-count p))))))
 
 (defun get-comments-for-post (for-post-url)
   (loop for c in (get-instances-by-value 'blog-comment 'for-post-url for-post-url)
-       collect (timestamp c)))
+     collect (timestamp c)))
 
 (defun get-comment (ts)
   "Return a comment: :timestamp :content :for-post-url :has-comments :reply :author :email :uri"

diff --git a/ht-server.lisp b/ht-server.lisp
@@ -9,8 +9,8 @@
   (hunchentoot:post-parameter name))
 
 (defun param-post-trim (name)
-  (if (param-post name)
-      (string-trim " " (param-post name))))
+  (when (param-post name)
+    (string-trim " " (param-post name))))
 
 (defun request-url ()
   (hunchentoot:request-uri*))

diff --git a/posts.lisp b/posts.lisp
@@ -25,10 +25,7 @@
 ;; use this default => "201108202255"
 (defun make-post-url-by-timestamp (ts)
   "make url from post timestamp"
-  (multiple-value-bind (sec min hour date month year dow dst-p tz)
-      (decode-universal-time ts)
-    (declare (ignore dow tz dst-p))
-    (format nil "~&~4D~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D" year month date hour min sec)))
+  (timestamp-to-datetime ts))
 
 ;; (defmethod initialize-instance :after ((obj blog-post) &rest initargs)
 ;;   (cond ((eq nil (post-url obj))
@@ -37,10 +34,7 @@
 ;;;; => 3522841494
 (defun post-url-to-timestamp (ts-url)
   "revert the make-post-url-by-timestamp url to timestamp"
-  (ppcre:register-groups-bind ((#'parse-integer year month date hour min sec))
-      ("(\\d{4})(\\d{2})(\\d{2})(\\d{2})(\\d{2})(\\d{2})"
-       ts-url)
-    (encode-universal-time sec min hour date month year)))
+  (datetime-to-timestamp ts-url))
 
 ;;;; => 99
 (defun current-max-posts ()
@@ -188,11 +182,11 @@
 ;;;; => 12
 (defun category-count (name)
   (let ((c (get-instance-by-value 'post-categories 'name name)))
-    (if c (length (blog-post c)))))
+    (when c (length (blog-post c)))))
 
 (defun tag-count (name)
   (let ((tag (get-instance-by-value 'post-tags 'name name)))
-    (if tag (length (blog-post tag)))))
+    (when tag (length (blog-post tag)))))
 
 (defun get-post (ts)
   "Rutrun slots' value for blog-post: :title :body :timestamp :last-update :hits :comment-count :allow-comment :author :url"
@@ -223,8 +217,8 @@
          (end-ts (if (>= loc max)
                      max
                      loc)))
-    (if (> start-ts end-ts)
-        (setf start-ts end-ts))
+    (when (> start-ts end-ts)
+      (setf start-ts end-ts))
     (slice page-from start-ts end-ts)))
 
 ;;;; => (3522841401 3522841388 ...)