Megatest

Check-in [cf97950521]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Switched rcp test to use sql-de-lite
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: cf979505211459c4f64ef479ba3d06f4f7d733b1
User & Date: matt on 2015-12-07 22:26:52
Other Links: branch diff | manifest | tags
Context
2015-12-08
08:44
Merged fork check-in: ca3c827888 user: mrwellan tags: v1.60
2015-12-07
22:26
Switched rcp test to use sql-de-lite check-in: cf97950521 user: matt tags: v1.60
21:32
Added script to run client and a little help to header of rpctest.scm check-in: 3c88ad926f user: matt tags: v1.60
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified rpctest/rpctest.scm from [9aa9c89e7f] to [900250564a]. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

























18
19
20
21
22
23
24

;;;; rpc-demo.scm
;;;; Simple database server / client

;;; start server thusly: ./rpctest server test.db
;;; you will need to init test.db:
;;; sqlite3 test.db "CREATE TABLE foo (id INTEGER PRIMARY KEY, var TEXT, val TEXT);"

(require-extension (srfi 18) extras tcp rpc sqlite3)

;;; Common things

(define total-queries 0)
(define start-time (current-seconds))

(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))
(print "Operation: " operation ", param: " param)


























(define rpc:listener
  (if (eq? operation 'server)
      (tcp-listen (rpc:default-server-port))
      (tcp-listen 0)))

;; Start server thread








|









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

;;;; rpc-demo.scm
;;;; Simple database server / client

;;; start server thusly: ./rpctest server test.db
;;; you will need to init test.db:
;;; sqlite3 test.db "CREATE TABLE foo (id INTEGER PRIMARY KEY, var TEXT, val TEXT);"

(require-extension (srfi 18) extras tcp rpc sql-de-lite)

;;; Common things

(define total-queries 0)
(define start-time (current-seconds))

(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))
(print "Operation: " operation ", param: " param)

;; have a pool of db's to pick from
(define *dbpool* '())
(define *pool-mutex* (make-mutex))

(define (get-db)
  (mutex-lock! *pool-mutex*)
  (if (null? *dbpool*)
      (begin
	(mutex-unlock! *pool-mutex*)
	(let ((db (open-database param)))
	  (set-busy-handler! db (busy-timeout 10000))
	  (exec (sql db "PRAGMA synchronous=0;"))
	  db))
      (let ((res (car *dbpool*)))
	(set! *dbpool* (cdr *dbpool*))
	(mutex-unlock! *pool-mutex*)
	res)))

(define (return-db db)
  (mutex-lock! *pool-mutex*)
  (set! *dbpool* (cons db *dbpool* ))
  (let ((res (length *dbpool*)))
    (mutex-unlock! *pool-mutex*)
    res))

(define rpc:listener
  (if (eq? operation 'server)
      (tcp-listen (rpc:default-server-port))
      (tcp-listen 0)))

;; Start server thread
︙︙
33
34
35
36
37
38
39
40
41
42
43
44
45
46

47
48
49
50

51
52
53
54
55
56
57


(define (server)
  (rpc:publish-procedure!
   'change-response-port
   (lambda (port)
     (rpc:default-server-port port))
   #f)
  (let ((db (open-database param)))
    (set-finalizer! db finalize!)
    (rpc:publish-procedure!
     'query
     (lambda (sql callback)
       (set! total-queries (+ total-queries 1))
       (print "Executing query '" sql "' ...")

       (for-each-row
	callback
	db sql)
       (print "Query rate: " (/ total-queries (/ (- (current-seconds) start-time) 60)) " per minute")

       )))
  (thread-join! rpc:server))

;;; Client side

(define (callback1 . columns)
  (let loop ((c columns) (i 0))








|
|
|
|
|
|
|
>
|
|
|

>








58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


(define (server)
  (rpc:publish-procedure!
   'change-response-port
   (lambda (port)
     (rpc:default-server-port port))
   #f)
  ;;(let ((db  (get-db))(open-database param)))
  ;; (set-finalizer! db finalize!)
  (rpc:publish-procedure!
   'query
   (lambda (sqlstmt callback)
     (set! total-queries (+ total-queries 1))
     (print "Executing query '" sqlstmt "' ...")
     (let ((db (get-db)))
       (query (for-each-row
	       callback)
	      (sql db sqlstmt))
       (print "Query rate: " (/ total-queries (/ (- (current-seconds) start-time) 60)) " per minute")
       (print "num dbs: " (return-db db))
       )))
  (thread-join! rpc:server))

;;; Client side

(define (callback1 . columns)
  (let loop ((c columns) (i 0))
︙︙
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81


(define (client)
  ((rpc:procedure 'change-response-port "localhost")
   (tcp-listener-port rpc:listener))
  ((rpc:procedure 'query "localhost") param callback1)
  (rpc:publish-procedure! 'callback2 callback2)
  ((rpc:procedure 'query "localhost") param callback2)
  (pp callback2-results))


;;; Run it

(if (eq? operation 'server)
    (server)
    (client))









|
>








94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109


(define (client)
  ((rpc:procedure 'change-response-port "localhost")
   (tcp-listener-port rpc:listener))
  ((rpc:procedure 'query "localhost") param callback1)
  (rpc:publish-procedure! 'callback2 callback2)
  ((rpc:procedure 'query "localhost") param callback2)
  (pp callback2-results)
  (rpc:close-connection! "localhost" (rpc:default-server-port)))

;;; Run it

(if (eq? operation 'server)
    (server)
    (client))

Modified rpctest/run-client.sh from [9287190e12] to [7217b9abad]. 

1
2
3
4
5
6
7
8
9
10
11
12

#!/bin/bash


while ./rpctest client "insert into foo (var,val) values ($RANDOM,$RANDOM);";do
    numrows=$(./rpctest client "select * from foo;"|wc -l)
    deletefrom=$RANDOM
    echo "numrows=$numrows, deletefrom=$deletefrom"
    if [[ $numrows -gt 300 ]];then
	echo "numrows=$numrows, deletefrom=$deletefrom"
	./rpctest client "delete from foo where var > $deletefrom;"
    fi
done





|








1
2
3
4
5
6
7
8
9
10
11
12

#!/bin/bash


while ./rpctest client "insert into foo (var,val) values ($RANDOM,$RANDOM);";do
    numrows=$(./rpctest client "select count(id) from foo;") # |wc -l)
    deletefrom=$RANDOM
    echo "numrows=$numrows, deletefrom=$deletefrom"
    if [[ $numrows -gt 300 ]];then
	echo "numrows=$numrows, deletefrom=$deletefrom"
	./rpctest client "delete from foo where var > $deletefrom;"
    fi
done

This page was generated in about 0.106s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00