Miniblog: A command-line static blog system in Common Lisp
Log | Files | Refs | README | LICENSE

db.lisp (11287B)

      1 (in-package :miniblog/tests)
      3 (in-suite miniblog-test)
      5 (defparameter +db-settings+ '(sqlite3 :database-name ":memory:"))
      7 (test add-and-get-entry
      8   "Add an entry and then fetch it back, verify all fields are correct"
      9   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
     10     (miniblog.db:init-tables)
     11     (let* ((title "Test entry")
     12            (content "Test content")
     13            (username "test")
     14            (new-entry (miniblog.db:add-entry title content :username username))
     15            (now (local-time:now))
     16            (new-id (getf new-entry :id))
     17            (fetched-entry (miniblog.db:get-entry new-id)))
     18       (is (and (string= title (getf new-entry :title))
     19                (string= title (getf fetched-entry :title))))
     20       (is (and (string= content (getf new-entry :content))
     21                (string= content (getf fetched-entry :content))))
     22       (is (and (string= username (getf new-entry :created-by))
     23                (string= username (getf fetched-entry :created-by))))
     24       (is (and (string= username (getf new-entry :last-updated-by))
     25                (string= username (getf fetched-entry :last-updated-by))))
     26       (is (and (< (timestamp-difference now (getf new-entry :created-at)) 1)
     27                (>= (timestamp-difference now (getf new-entry :created-at)) 0)))
     28       (is (and (timestamp= (getf new-entry :created-at)
     29                            (getf new-entry :last-updated-at))))  
     30       (is (and (timestamp= (getf new-entry :created-at)
     31                            (getf fetched-entry :created-at))))  
     32       (is (and (timestamp= (getf new-entry :last-updated-at)
     33                            (getf fetched-entry :last-updated-at)))))))
     35 (test modify-entry
     36   "Update an entry, verify update fields"
     37   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
     38     (miniblog.db:init-tables)
     39     (let* ((title "Before title")
     40            (content "Before content")
     41            (username "before")
     42            (entry (miniblog.db:add-entry title content :username username))
     43            (id (getf entry :id))
     44            (new-title "After title")
     45            (new-content "After content")
     46            (new-username "after")
     47            (updated-entry (miniblog.db:update-entry id new-title new-content :username new-username)))
     48       (is (string= new-title (getf updated-entry :title)))
     49       (is (string= new-content (getf updated-entry :content)))
     50       (is (string= username (getf updated-entry :created-by)))
     51       (is (string= new-username (getf updated-entry :last-updated-by)))
     52       (is (> (timestamp-difference (getf updated-entry :last-updated-at) (getf updated-entry :created-at)) 0)))))
     54 (test delete-entry
     55   "Add an entry, delete it and verify it's removed"
     56   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
     57     (miniblog.db:init-tables)
     58     (let* ((entry (miniblog.db:add-entry "foo" "foo"))
     59            (id (getf entry :id)))
     60       (is (miniblog.db:get-entry id))   
     61       (miniblog.db:delete-entry id)
     62       (is (not (miniblog.db:get-entry id))))))
     64 (test add-and-get-page
     65   "Add a page and then fetch it back, verify all fields are correct"
     66   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
     67     (miniblog.db:init-tables)
     68     (let* ((name "test")
     69            (title "Test page")
     70            (content "Test content")
     71            (username "test")
     72            (new-page (miniblog.db:add-page name title content :username username))
     73            (now (local-time:now))
     74            (new-id (getf new-page :id))
     75            (fetched-page (miniblog.db:get-page new-id)))
     76       (is (and (eql 0 (getf new-page :parent))
     77                (eql 0 (getf fetched-page :parent))))
     78       (is (and (string= name (getf new-page :name))
     79                (string= name (getf fetched-page :name))))
     80       (is (and (string= title (getf new-page :title))
     81                (string= title (getf fetched-page :title))))
     82       (is (and (string= content (getf new-page :content))
     83                (string= content (getf fetched-page :content))))
     84       (is (and (string= username (getf new-page :created-by))
     85                (string= username (getf fetched-page :created-by))))
     86       (is (and (string= username (getf new-page :last-updated-by))
     87                (string= username (getf fetched-page :last-updated-by))))
     88       (is (and (< (timestamp-difference now (getf new-page :created-at)) 1)
     89                (>= (timestamp-difference now (getf new-page :created-at)) 0)))
     90       (is (and (timestamp= (getf new-page :created-at)
     91                            (getf new-page :last-updated-at))))  
     92       (is (and (timestamp= (getf new-page :created-at)
     93                            (getf fetched-page :created-at))))  
     94       (is (and (timestamp= (getf new-page :last-updated-at)
     95                            (getf fetched-page :last-updated-at)))))))
     97 (test modify-page
     98   "Update a page, verify update fields"
     99   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    100     (miniblog.db:init-tables)
    101     (let* ((name "before")
    102            (title "Before title")
    103            (content "Before content")
    104            (username "before")
    105            (page (miniblog.db:add-page name title content :username username))
    106            (id (getf page :id))
    107            (new-name "after")
    108            (new-title "After title")
    109            (new-content "After content")
    110            (new-username "after")
    111            (updated-page (miniblog.db:update-page id new-name new-title new-content :username new-username)))
    112       (is (eql 0 (getf updated-page :parent)))
    113       (is (string= new-title (getf updated-page :title)))
    114       (is (string= new-content (getf updated-page :content)))
    115       (is (string= username (getf updated-page :created-by)))
    116       (is (string= new-username (getf updated-page :last-updated-by)))
    117       (is (> (timestamp-difference (getf updated-page :last-updated-at) (getf updated-page :created-at)) 0)))))
    119 (test move-page
    120   "Create several test pages, move one in the hierarchy and verify the move"
    121   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    122     (miniblog.db:init-tables)
    123     (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
    124            (page-1-id (getf page-1 :id)) 
    125            (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
    126            (page-2-id (getf page-2 :id)) 
    127            (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
    128            (page-3-id (getf page-3 :id))
    129            (moved-page-2 (miniblog.db:move-page page-2-id 0))
    130            (page-3-post-move (miniblog.db:get-page page-3-id)))
    131       (is (eql page-1-id (getf page-2 :parent)))  
    132       (is (eql 0 (getf moved-page-2 :parent)))  
    133       (is (and (eql page-2-id (getf page-3 :parent))
    134                (eql page-2-id (getf page-3-post-move :parent)))))))
    136 (test delete-page
    137   "Add a page, delete it and verify it's removed"
    138   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    139     (miniblog.db:init-tables)
    140     (let* ((page (miniblog.db:add-page "foo" "foo" "foo"))
    141            (id (getf page :id)))
    142       (is (miniblog.db:get-page id))   
    143       (miniblog.db:delete-page id)
    144       (is (not (miniblog.db:get-page id))))))
    146 (test delete-page-moving-subtree-to-root
    147   "Add a page with a child, delete it and verify that it's removed and its child is reparented to the root"
    148   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    149     (miniblog.db:init-tables)
    150     (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
    151            (page-1-id (getf page-1 :id))
    152            (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent (getf page-1 :id)))
    153            (page-2-id (getf page-2 :id)))
    154       (miniblog.db:delete-page page-1-id :children :move-to-root)
    155       (is (not (miniblog.db:get-page page-1-id)))
    156       (is (eql 0 (getf (miniblog.db:get-page page-2-id) :parent))))))
    158 (test delete-page-moving-subtree-to-parent
    159   "Add three test pages, each the next one's parent, delete the second one and verify that it's removed and its child is reparented to first page"
    160   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    161     (miniblog.db:init-tables)
    162     (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
    163            (page-1-id (getf page-1 :id))
    164            (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
    165            (page-2-id (getf page-2 :id)) 
    166            (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
    167            (page-3-id (getf page-3 :id)))
    168       (miniblog.db:delete-page page-2-id) ; :MOVE-TO-PARENT is default
    169       (is (eql page-1-id (getf (miniblog.db:get-page page-3-id) :parent))))))
    171 (test delete-page-deleting-subtree
    172   "Add six test pages with the first the second's parent and the second the top of a subtree containing the other four, delete the second one and verify that it's removed and all its children are as well"
    173   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    174     (miniblog.db:init-tables)
    175     (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
    176            (page-1-id (getf page-1 :id))
    177            (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
    178            (page-2-id (getf page-2 :id)) 
    179            (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
    180            (page-3-id (getf page-3 :id))
    181            (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id))
    182            (page-4-id (getf page-4 :id)) 
    183            (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id))
    184            (page-5-id (getf page-5 :id)) 
    185            (page-6 (miniblog.db:add-page "frotz" "frotz" "frotz" :parent page-5-id))
    186            (page-6-id (getf page-6 :id))) 
    187       (miniblog.db:delete-page page-2-id :children :delete)
    188       (is (and (not (miniblog.db:get-page page-3-id)))   
    189                (not (miniblog.db:get-page page-4-id))   
    190                (not (miniblog.db:get-page page-5-id))   
    191                (not (miniblog.db:get-page page-6-id))))))
    193 (test get-pages
    194   "Add a tree of pages and verify that get-pages returns the tree as constructed"
    195   (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
    196     (miniblog.db:init-tables)
    197     (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
    198            (page-1-id (getf page-1 :id))
    199            (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
    200            (page-2-id (getf page-2 :id)) 
    201            (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
    202            (page-3-id (getf page-3 :id))
    203            (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id))
    204            (page-4-id (getf page-4 :id)) 
    205            (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id))
    206            (page-5-id (getf page-5 :id))
    207            (pages (miniblog.db:get-pages))
    208            (maybe-page-1 (car (getf pages :children)))
    209            (maybe-page-2 (car (getf maybe-page-1 :children))) 
    210            (maybe-page-3 (cadr (getf maybe-page-2 :children))) 
    211            (maybe-page-4 (car (getf maybe-page-3 :children))) 
    212            (maybe-page-5 (car (getf maybe-page-2 :children))))
    213       (is (eql page-1-id (getf maybe-page-1 :id)))   
    214       (is (eql page-2-id (getf maybe-page-2 :id)))   
    215       (is (eql page-3-id (getf maybe-page-3 :id)))   
    216       (is (eql page-4-id (getf maybe-page-4 :id)))   
    217       (is (eql page-5-id (getf maybe-page-5 :id))))))