(use test)
;; (use (prefix pkts pkts:))
(use pkts (prefix dbi dbi:))
;; (use trace)(trace sdat->alist pkt->alist)
(if (file-exists? "queue.db")(delete-file "queue.db"))
(test-begin "pkts and pkt archives")
;;======================================================================
;; Basic pkt creation, parsing and conversion routines
;;======================================================================
(test-begin "basic packets")
(test #f '(A "This is a packet") (let-values (((t v)
(card->type/value "A This is a packet")))
(list t v)))
(test #f "A A\nZ 664449e7299e0065a3e25c138ccef2df13ba291e"
(let-values (((uuid res)
(add-z-card '("A A"))))
res))
(test #f '("CC C++" "D 1486332719.0" "a A" "b C")(sort (construct-sdat 'b "C" 'a "A" 'CC "C++" 'D 1486332719.0)
string<=?))
(define pkt-example #f)
(test #f "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84"
(let-values (((uuid res)
(construct-pkt 'b "C" 'a "A" 'CC "C++" 'D 1486332719.0)))
(set! pkt-example (cons uuid res))
res))
(test-end "basic packets")
;;======================================================================
;; Sqlite and postgresql based queue of pkts
;;======================================================================
(test-begin "pkt queue")
(define db #f)
(test #f 'sqlite3 (let ((dbh (open-queue-db "." "queue.db")))
(set! db dbh)
(dbi:db-dbtype dbh)))
(test #f (cdr pkt-example)
(begin
(add-to-queue db (cdr pkt-example)(car pkt-example) 'basic #f 0)
(lookup-by-uuid db (car pkt-example) 0)))
(test #f (cdr pkt-example)
(lookup-by-id db 1))
(test #f 1 (length (find-pkts db '(basic) '())))
(test-end "pkt queue")
;;======================================================================
;; Process groups of pkts
;;======================================================================
(test-begin "lists of packets")
(test #f '((apkt . #f) (id . 1) (group-id . 2) (uuid . 3) (parent . 4) (pkt-type . 5)) ;; ((id . 1) (group-id . 2) (uuid . 3) (parent . 4) (pkt-type . 5))
(dblst->dpkts '(1 2 3 4 5)))
(test #f '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (processed . 0)))
;; '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
;; '(((id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
(get-dpkts db '(basic) 0 #f))
(test #f '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (processed . 0)))
;; '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
;; '(((id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
(get-not-processed-pkts db 0 'basic 1000 0))
(test-end "lists of packets")
(test-begin "pkts as alists")
(define pktspec '((posting . ((title . t) ;; NOTE: same as ((posting (title . t)(url . u)(blub . b)) ...
(url . u)
(blurb . b)))
(comment . ((comment . c)
(score . s)))
(basic . ((b-field . b)
(a-field . a)))))
(define pktlst (find-pkts db '(basic) '()))
(define dpkt (car pktlst))
(test #f "A" (get-value 'a-field dpkt pktspec))
(test #f "C" (alist-ref 'b-field (dpkt->alist dpkt pktspec)))
(define basic-spec '((nada (foo . b)(bar . f))(basic (foo . f)(bar . b))))
(define test-pkt '((foo . "fooval")(bar . "barval")))
(let*-values (((u p) (alist->pkt test-pkt basic-spec ptype: 'basic))
((apkt) (pkt->alist p))
((bpkt) (pkt->alist p pktspec: basic-spec)))
(test #f "fooval" (alist-ref 'f apkt))
(test #f "fooval" (alist-ref 'foo bpkt))
(test #f #f (alist-ref 'f bpkt)))
(test-end "pkts as alists")
(test-begin "descendents and ancestors")
(define (get-uuid pkt)(alist-ref 'uuid pkt))
;; add a child to 263e
(let-values (((uuid pkt)
(construct-pkt 'x "X" 'y "Y" 'P "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84"
'D "1486332719.0")))
(add-to-queue db pkt uuid 'basic "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84" 0))
(test #f '("263eb3b6193de7fe65b1ded5bcda513e8b4d6b84" "818fe30988c9673441b8f203972a8bda6af682f8")
(map (lambda (x)(alist-ref 'uuid x))
(get-descendents
db 0
"263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
(test #f '("263eb3b6193de7fe65b1ded5bcda513e8b4d6b84" "818fe30988c9673441b8f203972a8bda6af682f8")
(map (lambda (x)(alist-ref 'uuid x))
(get-ancestors
db 0
"818fe30988c9673441b8f203972a8bda6af682f8")))
(test-end "descendents and ancestors")
(test-end "pkts and pkt archives")
(test-begin "pktsdb")
(define spec '((tests (testname n TEXT)
(testpath p TEXT)
(duration d INTEGER))))
;; (define pktsdb (make-pktdb))
;; (pktdb-pktsdb-spec-set! pktsdb spec)
(define pktsdb #f)
(test #f #t (dbi:database? (let ((pdb (pktsdb-open "test.db" spec)))
(set! pktsdb pdb)
(pktdb-conn pdb))))
;; (pp (pktdb-pktspec pktsdb))
(test #f #t (pktsdb-add-record pktsdb 'tests '((testname . "test1"))))
(pktsdb-close pktsdb)
(test-end "pktsdb")