Browse files

update tools

  • Loading branch information...
1 parent 28c30ab commit dd2dbabc61ad588da9918d998c319e68e549b6e2 @gihnius committed Sep 6, 2011
Showing with 54 additions and 99 deletions.
  1. +9 −29 comments.lisp
  2. +23 −55 posts.lisp
  3. +22 −15 tools.lisp
View
38 comments.lisp
@@ -1,35 +1,15 @@
(in-package :cl-common-blog)
(defclass blog-comment ()
- ((content :initarg :content
- :accessor content
- :initform nil)
- (timestamp :initarg :timestamp
- :accessor timestamp
- :initform nil
- :index t)
- (for-post-url :initarg :for-post-url
- :accessor for-post-url
- :initform nil
- :index t)
- (has-comments :initarg :has-comments
- :accessor has-comments
- :initform nil)
- (reply :initarg :reply
- :accessor reply
- :initform "no")
- (author :initarg :author
- :accessor author
- :initform nil)
- (email :initarg :email
- :accessor email
- :initform nil)
- (ip :initarg :ip
- :accessor ip
- :initform nil)
- (uri :initarg :uri
- :accessor uri
- :initform nil))
+ ((content :initarg :content :accessor content :initform nil)
+ (timestamp :initarg :timestamp :accessor timestamp :initform nil :index t)
+ (for-post-url :initarg :for-post-url :accessor for-post-url :initform nil :index t)
+ (has-comments :initarg :has-comments :accessor has-comments :initform nil)
+ (reply :initarg :reply :accessor reply :initform "no")
+ (author :initarg :author :accessor author :initform nil)
+ (email :initarg :email :accessor email :initform nil)
+ (ip :initarg :ip :accessor ip :initform nil)
+ (uri :initarg :uri :accessor uri :initform nil))
(:metaclass persistent-metaclass))
;;;; the <from> comment is a replay for <replay-for> comment
View
78 posts.lisp
@@ -1,58 +1,26 @@
(in-package :cl-common-blog)
(defclass blog-post ()
- ((title :initarg :post-title
- :accessor post-title
- :initform nil) ;; save title "string"
- (body :initarg :post-body
- :accessor post-body
- :initform nil) ;;save blog post body "string"
- (timestamp :initarg :post-timestamp
- :accessor post-timestamp
- :initform nil
- :index t) ;; return get-universal-time
- (last-update :initarg :post-last-update
- :accessor post-last-update
- :initform (get-universal-time))
- (hits :initarg :post-hits
- :accessor post-hits
- :initform 0) ;; how many visits
- (comments-count :initarg :post-comments-count
- :accessor post-comments-count
- :initform 0) ;; how many comments
- (allow-comment :initarg :post-allow-comment
- :accessor post-allow-comment
- :initform "yes") ;; allow ? render add comment form if yes
- (author :initarg :post-author
- :accessor post-author
- :initform nil) ;; default for blog owner, this for group users
- (post-url :initarg :post-url
- :accessor post-url
- :initform nil
- :index t) ;; the query url for a post
- (relate-posts :initarg :relate-posts
- :accessor relate-posts
- :initform nil)) ;; save as timestamp
+ ((title :initarg :post-title :accessor post-title :initform nil)
+ (body :initarg :post-body :accessor post-body :initform nil)
+ (timestamp :initarg :post-timestamp :accessor post-timestamp :initform nil :index t)
+ (last-update :initarg :post-last-update :accessor post-last-update :initform (get-universal-time))
+ (hits :initarg :post-hits :accessor post-hits :initform 0)
+ (comments-count :initarg :post-comments-count :accessor post-comments-count :initform 0)
+ (allow-comment :initarg :post-allow-comment :accessor post-allow-comment :initform "yes")
+ (author :initarg :post-author :accessor post-author :initform nil)
+ (post-url :initarg :post-url :accessor post-url :initform nil :index t)
+ (relate-posts :initarg :relate-posts :accessor relate-posts :initform nil))
(:metaclass persistent-metaclass))
(defpclass post-categories ()
- ((blog-post :initarg :blog-post
- :accessor blog-post
- :initform nil)
- (name :initarg :name
- :accessor name
- :initform nil
- :index t)))
+ ((blog-post :initarg :blog-post :accessor blog-post :initform nil)
+ (name :initarg :name :accessor name :initform nil :index t)))
;; inherit ?
(defpclass post-tags ()
- ((blog-post :initarg :blog-post
- :accessor blog-post
- :initform nil)
- (name :initarg :name
- :accessor name
- :initform nil
- :index t)))
+ ((blog-post :initarg :blog-post :accessor blog-post :initform nil)
+ (name :initarg :name :accessor name :initform nil :index t)))
;; use this default => "201108202255"
(defun make-post-url-by-timestamp (ts)
@@ -72,7 +40,7 @@
(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)))
+ (encode-universal-time sec min hour date month year)))
;;;; => 99
(defun current-max-posts ()
@@ -167,22 +135,22 @@
(defun delete-category (name)
(with-transaction ()
(loop for c in (get-instances-by-value 'post-categories 'name name)
- do (drop-instances c))))
+ do (drop-instances c))))
;;;; => "web"
(defun new-tag (name)
"Add new tag"
(with-transaction ()
(let ((tag-names (loop for tag in (get-instances-by-class 'post-tags)
- collect (name tag))))
+ collect (name tag))))
(if (find name tag-names :test #'string-equal)
nil
(make-instance 'post-tags :name name)) name)))
(defun delete-tag (name)
(with-transaction ()
(loop for tag in (get-instances-by-value 'post-tags 'name name)
- do (drop-instances tag))))
+ do (drop-instances tag))))
;;;; "How to cook lisp?" => "Lisp"
(defun category-post (name post-timestamp)
@@ -194,7 +162,7 @@
(defun category-post-delete (name post-timestamp)
"remove the post from categories"
(let* ((c (get-instance-by-value 'post-categories 'name name))
- (p (get-instance-by-value 'blog-post 'timestamp post-timestamp))
+ (p (get-instance-by-value 'blog-post 'timestamp post-timestamp))
(news (loop for pp in (blog-post c)
when (and pp (not (eq pp p)))
collect pp)))
@@ -291,12 +259,12 @@
(defun get-all-posts-of-categories (name)
(let ((c (get-instance-by-value 'post-categories 'name name)))
(sort (loop for p in (blog-post c)
- when p
- collect (post-timestamp p)) #'> )))
+ when p
+ collect (post-timestamp p)) #'> )))
(defun get-all-posts-of-tags (name)
(let ((tag (get-instance-by-value 'post-tags 'name name)))
(sort (loop for p in (blog-post tag)
- when p
- collect (post-timestamp p)) #'>)))
+ when p
+ collect (post-timestamp p)) #'>)))
View
37 tools.lisp
@@ -12,21 +12,28 @@
;;;; => (nil b) from f('a '(a b c d e))
;;;; => (b d) from f('c '(a b c d e))
;;;; => (d nil) from f('e '(a b c d e))
-(defun cons-prev-next (mid lst)
- "Return a list of the previous and next elements."
- (let ((prev nil)
- (next nil)
- (pos 0))
- (dolist (e lst)
- (if pos (incf pos))
- (setf next e)
- (if (and (not pos) next) (return))
- (if (equal mid e)
- (progn
- (and (eq 1 pos) (setf prev nil))
- (setf pos nil next nil))
- (setf prev e)))
- (list prev next)))
+;; (defun cons-prev-next (mid lst)
+;; "Return a list of the previous and next elements."
+;; (let ((prev nil)
+;; (next nil)
+;; (pos 0))
+;; (dolist (e lst)
+;; (if pos (incf pos))
+;; (setf next e)
+;; (if (and (not pos) next) (return))
+;; (if (equal mid e)
+;; (progn
+;; (and (eq 1 pos) (setf prev nil))
+;; (setf pos nil next nil))
+;; (setf prev e)))
+;; (list prev next)))
+(defun cons-prev-next (x lst)
+ (if (equal x (car lst))
+ (list nil x)
+ (loop for xx on lst
+ do
+ (when (equal x (cadr xx))
+ (return (list (car xx) (caddr xx)))))))
;;;; a simple validate method for post blog data
;;;; return T for valid data Or Nil

0 comments on commit dd2dbab

Please sign in to comment.