Basic session implementation
This commit is contained in:
parent
635014400a
commit
a90caba4a5
|
@ -3,38 +3,66 @@
|
||||||
(import (r7rs))
|
(import (r7rs))
|
||||||
(import (scheme base))
|
(import (scheme base))
|
||||||
(import (srfi 180))
|
(import (srfi 180))
|
||||||
(import (srfi 99))
|
(import coops coops-extras coops-primitive-objects coops-utils)
|
||||||
(import coops)
|
(import (chicken process)
|
||||||
(import (chicken process))
|
(chicken gc)
|
||||||
|
(chicken condition))
|
||||||
|
(import uri-common)
|
||||||
(import intarweb)
|
(import intarweb)
|
||||||
(import http-client)
|
(import http-client)
|
||||||
|
|
||||||
(define-class <Browser> ()
|
(define-class <Browser> ()
|
||||||
(url stdout stdin stderr pid))
|
((base-url accessor: base-url)
|
||||||
|
(stdout accessor: stdout)
|
||||||
(define-method (terminate (browser <Browser>))
|
(stdin accessor: stdin)
|
||||||
(process-signal (slot-value browser 'pid)))
|
(stderr accessor: stderr)
|
||||||
|
(pid accessor: pid)
|
||||||
|
(session accessor: session)))
|
||||||
|
|
||||||
(define-method (initialize-instance (browser <Browser>))
|
(define-method (initialize-instance (browser <Browser>))
|
||||||
(call-next-method)
|
(set-finalizer! browser (lambda (obj) (terminate browser)))
|
||||||
(set-finalizer! browser (lambda (obj) (terminate browser))))
|
(call-next-method))
|
||||||
|
|
||||||
(define-method (send (browser <Browser>) struct #!key to path using method)
|
(define-method (send (browser <Browser>) struct path method)
|
||||||
(with-input-from-request
|
(let ((uri (string-append (base-url browser) path)))
|
||||||
(make-request method: method
|
(with-input-from-request
|
||||||
uri: (uri-reference (string-append (slot-value browser 'url) path))
|
(make-request method: method
|
||||||
headers: (headers `((content-type application/json))))
|
uri: (uri-reference uri)
|
||||||
(lambda () (json-write struct))
|
headers: (headers `((content-type application/json))))
|
||||||
json-read))
|
(lambda () (json-write struct))
|
||||||
|
json-read)))
|
||||||
|
|
||||||
|
(define-method (initialize-session (browser <Browser>))
|
||||||
|
(set! (session browser) (alist-ref 'sessionId (send browser '() "session" 'POST))))
|
||||||
|
|
||||||
|
(define-method (terminate-session (browser <Browser>))
|
||||||
|
(send browser '() (string-append "session/" (session browser)) 'DELETE))
|
||||||
|
|
||||||
|
;; TODO: Apparently session has to be closed first
|
||||||
|
(define-method (terminate (browser <Browser>))
|
||||||
|
(call/cc
|
||||||
|
(lambda (c)
|
||||||
|
(with-exception-handler
|
||||||
|
(lambda (x) (c #t))
|
||||||
|
(lambda ()
|
||||||
|
(terminate-session browser)
|
||||||
|
(process-signal (pid browser))
|
||||||
|
(close-input-port (stdout browser))
|
||||||
|
(close-input-port (stderr browser))
|
||||||
|
(close-output-port (stdin browser)))))))
|
||||||
|
|
||||||
(define-class <Firefox> (<Browser>))
|
(define-class <Firefox> (<Browser>))
|
||||||
|
|
||||||
(define (firefox #!key ip ip port port)
|
(define (firefox #!key ip ip port port)
|
||||||
(let-values (((stdout stdin pid stderr) (process* "geckodriver")))
|
(let-values (((stdout stdin pid stderr) (process* "geckodriver")))
|
||||||
(make <Browser>
|
(make <Firefox>
|
||||||
url: (string-append "http://" (or ip "127.0.0.1")
|
'base-url (string-append "http://" (or ip "127.0.0.1")
|
||||||
":" (or port "4444") "/")
|
":" (or port "4444") "/")
|
||||||
stdout: stdout
|
'stdout stdout
|
||||||
stdin: stdin
|
'stdin stdin
|
||||||
stderr: stderr
|
'stderr stderr
|
||||||
pid: pid)))
|
'pid pid)))
|
||||||
|
|
||||||
|
(define-method (send (browser <Firefox>) struct path method)
|
||||||
|
(let ((result (call-next-method)))
|
||||||
|
(alist-ref 'value result)))
|
||||||
|
|
Loading…
Reference in New Issue