Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
update tools
  • Loading branch information
gihnius committed Sep 6, 2011
1 parent 28c30ab commit dd2dbab
Show file tree
Hide file tree
Showing 3 changed files with 54 additions and 99 deletions.
38 changes: 9 additions & 29 deletions 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
Expand Down
78 changes: 23 additions & 55 deletions 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)
Expand All @@ -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 ()
Expand Down Expand Up @@ -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)
Expand All @@ -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)))
Expand Down Expand Up @@ -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)) #'>)))

37 changes: 22 additions & 15 deletions tools.lisp
Expand Up @@ -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
Expand Down

0 comments on commit dd2dbab

Please sign in to comment.