Overview
| Comment: | Initial version of rpctest directly from rpc egg page (plus minor changes to get it to work) |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
f728a7aa955fd2f704434a711ba19e40 |
| User & Date: | matt on 2015-12-07 19:54:36 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-12-07
| ||
| 21:32 | Added script to run client and a little help to header of rpctest.scm check-in: 3c88ad926f user: matt tags: v1.60 | |
| 19:54 | Initial version of rpctest directly from rpc egg page (plus minor changes to get it to work) check-in: f728a7aa95 user: matt tags: v1.60 | |
|
2015-12-04
| ||
| 14:33 | turn off ~/.spublishrc for safety check-in: 134ed6b113 user: mrwellan tags: v1.60 | |
Changes
Added rpctest/rpctest.scm version [5373d511d9].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
;;;; rpc-demo.scm
;;;; Simple database server / client
(require-extension (srfi 18) extras tcp rpc sqlite3)
;;; Common things
(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
(define rpc:server
(make-thread
(cute (rpc:make-server rpc:listener) "rpc:server")
'rpc:server))
(thread-start! rpc:server)
;;; Server side
(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)
(print "Executing query '" sql "' ...")
(for-each-row
callback
db sql))))
(thread-join! rpc:server))
;;; Client side
(define (callback1 . columns)
(let loop ((c columns) (i 0))
(unless (null? c)
(printf "~a=~s " i (car c))
(loop (cdr c) (+ i 1))))
(newline))
(define callback2-results '())
(define (callback2 . columns)
(set! callback2-results (cons columns callback2-results)))
(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))
|