Fix url-name when posting

parent 25a6eb28
......@@ -23,13 +23,13 @@
(ice-9 control)
(srfi srfi-1)
(srfi srfi-11)
(web uri)
(artanis utils)
(artanis artanis)
(artanis config)
(app models posts)
(app models cards)
(colt git)
(colt utils)
(colt config))
(define (gen-login-page rc)
......@@ -103,19 +103,16 @@
(article-tags (hash-ref json-content "tags"))
(article-content (hash-ref json-content "content"))
(status (hash-ref json-content "status"))
(time-stamp ((@(guile) current-time)))
(article-name (uri-encode
(string-append article-title
"__"
(number->string time-stamp))))
(article-meta `(("timestamp" . ,time-stamp)
(timestamp ((@(guile) current-time)))
(url-name (gen-proper-url-name timestamp article-title))
(article-meta `(("timestamp" . ,timestamp)
("tags" . ,article-tags)
("status" . ,status)
("status" . ,(if (string-null? status) "publish" status))
("title" . ,article-title)
("name" . ,article-author)
;; Always close here, we're going to use 3rd-party commenting system.
("comment_status" . "closed")))
(oid (git-post-article article-name article-content
(oid (git-post-article url-name article-content
article-meta)))
(update-index-posts-cache)
oid)))
......
......@@ -25,26 +25,25 @@
#:use-module (artanis utils)
#:use-module (artanis irregex)
#:use-module (srfi srfi-1)
#:use-module ((rnrs) #:select (get-string-all get-string-n)))
(export try-to-get-page-from-cache
update-index-posts-cache
get-one-article
get-all-posts
count-tags
get-ordered-tags-list
get-intro-page
get-the-latest-post
get-the-latest-post-update-time
gen-cache-file
get-article-content-by-name
get-intro-content
generate-editable-index-content
generate-editable-intro-content
get-one-article-by-oid
post-title
post-tags
post-timestamp)
#:use-module ((rnrs) #:select (get-string-all get-string-n))
#:export (try-to-get-page-from-cache
update-index-posts-cache
get-one-article
get-all-posts
count-tags
get-ordered-tags-list
get-intro-page
get-the-latest-post
get-the-latest-post-update-time
gen-cache-file
get-article-content-by-name
get-intro-content
generate-editable-index-content
generate-editable-intro-content
get-one-article-by-oid
post-title
post-tags
post-timestamp))
(define (post-title p)
(meta-data-title (post-meta-data p)))
......
......@@ -25,7 +25,6 @@
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-1)
#:use-module (web uri)
#:export (current-blog-repo
git-ls-tree
git/get-post-objs
......@@ -153,8 +152,7 @@
(any (lambda (o) (and (string=? name (git-object-file o)) o)) obj-list))
(define (get-post-by-url-name url-name post-list)
(define-syntax-rule (get-url-name p) (uri-decode (post-url-name p)))
(any (lambda (p) (and (string=? url-name (get-url-name p)) p)) post-list))
(any (lambda (p) (and (string=? url-name (uri-decode (post-url-name p))) p)) post-list))
(define (get-post-by-oid oid obj-list)
(any (lambda (o) (and (string=? oid (git-object-oid o)) (get-post o))) obj-list))
......@@ -351,29 +349,31 @@
"First commit" #:parent #f)))
(define (post-welcome-page)
(git-post-article
(uri-encode "Welcome to Colt Blog Engine!")
"Colt blog engine is written with GNU Artanis, and licenced under GPLv3.
(let ((timestamp (current-time)))
(git-post-article
(gen-proper-url-name timestamp "Welcome to Colt Blog Engine!")
"Colt blog engine is written with GNU Artanis, and licenced under GPLv3.
This project is created in hope of helping people with free software.
Happy hacking!"
`(("timestamp" . ,(current-time))
("tags" . "")
("status" . "publish")
("title" . "Welcome to Colt Blog Engine!")
("name" . "Colt")
("comment_status" . "closed"))
#:init? #t))
`(("timestamp" . ,timestamp)
("tags" . "")
("status" . "publish")
("title" . "Welcome to Colt Blog Engine!")
("name" . "Colt")
("comment_status" . "closed"))
#:init? #t)))
(define (post-intro-page)
(git-post-article
(uri-encode "About me")
"I'm too lazy to introduce myself at present."
`(("timestamp" . ,(current-time))
("tags" . "")
("status" . "publish")
("title" . "_____colt_____Intro")
("name" . "Colt")
("comment_status" . "closed"))))
(let ((timestamp (current-time)))
(git-post-article
(gen-proper-url-name timestamp "About me")
"I'm too lazy to introduce myself at present."
`(("timestamp" . ,timestamp)
("tags" . "")
("status" . "publish")
("title" . "_____colt_____Intro")
("name" . "Colt")
("comment_status" . "closed")))))
(define (ensure-blog-repo)
(let ((blog-repo (current-blog-repo)))
......
......@@ -15,6 +15,7 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(define-module (colt utils)
#:use-module (web uri)
#:use-module (srfi srfi-19)
#:use-module (rnrs)
#:export (date-comparator
......@@ -27,7 +28,8 @@
timestamp->rfc822-date
timestamp->readable-date
trim-content
record-type->list))
record-type->list
gen-proper-url-name))
(define (record-type->list rt)
(let ((v (record-type-field-names (record-rtd rt))))
......@@ -74,3 +76,8 @@
(let ((i (string-contains content "</p>"))
(len (string-length content)))
(substring content 0 (if i i (if (< len 256) len 256)))))
(define (gen-proper-url-name timestamp url-name)
(string-downcase
(string-append (strftime "%Y/%m/%d/" (localtime timestamp))
(uri-encode url-name))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment