Megatest

Artifact [5621476534]
Login

Artifact 56214765341be6ba4ae107ce4a9d29950a4e1611:


;;  Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;


(define (make-cached-writer the-db)
  (let ((db    the-db)
	(queue '()))
    (lambda (cacheable . qry-params) ;; fn qry
      (if cacheable
	  (begin
	    (set! queue (cons qry-params queue))
	    (call/cc))
	  (begin
	    (print "Starting transaction")
	    (for-each
	     (lambda (queue-item)
	       (let ((fn  (car queue-item))
		     (qry (cdr queue-item)))
		 (print "WRITE to " db ": " qry)
		 )
	     (reverse queue))
	    (print "End transaction")
	    (print "READ from " db ": " qry-params))))))

(define *cw* (make-cached-writer "the db"))

(define (dbcall cacheable query)
  (*cw* cacheable query))

(dbcall #t "insert abc")
(dbcall #t "insert def")
(dbcall #t "insert hij")
(dbcall #f "select foo")