Basic session implementation
This commit is contained in:
parent
635014400a
commit
a90caba4a5
|
@ -3,38 +3,66 @@
|
|||
(import (r7rs))
|
||||
(import (scheme base))
|
||||
(import (srfi 180))
|
||||
(import (srfi 99))
|
||||
(import coops)
|
||||
(import (chicken process))
|
||||
(import coops coops-extras coops-primitive-objects coops-utils)
|
||||
(import (chicken process)
|
||||
(chicken gc)
|
||||
(chicken condition))
|
||||
(import uri-common)
|
||||
(import intarweb)
|
||||
(import http-client)
|
||||
|
||||
(define-class <Browser> ()
|
||||
(url stdout stdin stderr pid))
|
||||
|
||||
(define-method (terminate (browser <Browser>))
|
||||
(process-signal (slot-value browser 'pid)))
|
||||
((base-url accessor: base-url)
|
||||
(stdout accessor: stdout)
|
||||
(stdin accessor: stdin)
|
||||
(stderr accessor: stderr)
|
||||
(pid accessor: pid)
|
||||
(session accessor: session)))
|
||||
|
||||
(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)
|
||||
(let ((uri (string-append (base-url browser) path)))
|
||||
(with-input-from-request
|
||||
(make-request method: method
|
||||
uri: (uri-reference (string-append (slot-value browser 'url) path))
|
||||
uri: (uri-reference uri)
|
||||
headers: (headers `((content-type application/json))))
|
||||
(lambda () (json-write struct))
|
||||
json-read))
|
||||
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 (firefox #!key ip ip port port)
|
||||
(let-values (((stdout stdin pid stderr) (process* "geckodriver")))
|
||||
(make <Browser>
|
||||
url: (string-append "http://" (or ip "127.0.0.1")
|
||||
(make <Firefox>
|
||||
'base-url (string-append "http://" (or ip "127.0.0.1")
|
||||
":" (or port "4444") "/")
|
||||
stdout: stdout
|
||||
stdin: stdin
|
||||
stderr: stderr
|
||||
pid: pid)))
|
||||
'stdout stdout
|
||||
'stdin stdin
|
||||
'stderr stderr
|
||||
'pid pid)))
|
||||
|
||||
(define-method (send (browser <Firefox>) struct path method)
|
||||
(let ((result (call-next-method)))
|
||||
(alist-ref 'value result)))
|
||||
|
|
Loading…
Reference in New Issue