I think #:servlet-regexp #rx"" will match anything , if I remove it
the application runs fine.
Otherwise http://localhost:8080/servlets/standalone.rkt will match ,
so will http://localhost:8080/servlets/standalone2.rkt and so on.
Most probably the browser is also requesting favicon.ico . You can
dump the request to see its content.
(require web-server/http)
(require web-server/servlet)
(require web-server/servlet-env)
(define (start request)
(printf "~a\n" (url->string (request-uri request)))
(response/xexpr
`(html (body (h1 "ok")))))
(serve/servlet start
#:port 8080
#:servlet-regexp #rx"")
On Fri, Aug 5, 2011 at 9:30 AM, J G Cho <g...@fundingmatters.com> wrote:
> There was a discussion about TOPSL paper not too long ago. I've been
> reading it with much interest and studying the code from SourceForge
> as well. In the course of my study, I wrote this code. (I think it's
> the kind that TOPSL was designed to replace/obviate.) Anyway there is
> one obvious bug in the following.:
>
> #lang racket
>
> (require web-server/servlet)
>
> (struct gui (form parser))
> (struct question (name form parser))
>
> (define questions-table (make-hash))
> (define answers-table (make-hash))
> (define reverse-orders empty)
>
> ;one time only per Q but seem to fire off more than once???
> (define (register-question! key val)
> (if (hash-has-key? questions-table key)
> (display (string-append
> (symbol->string key) " was already registered!\n"))
> (begin
> (display (string-append
> "registering "
> (symbol->string key) "\n"))
> (set! reverse-orders (cons key reverse-orders))
> (hash-set! answers-table key empty)
> (hash-set! questions-table key val))))
>
> (define (update-answer! key val)
> (hash-set! answers-table key val))
>
> (define (get-answers)
> (for/list ([key (reverse reverse-orders)])
> (list (hash-ref questions-table key)
> (hash-ref answers-table key))))
>
> (define (extract-single nom)
> (λ (binds)
> (extract-binding/single (string->symbol (symbol->string nom))
> binds)))
>
> (define (extract-multiple nom)
> (λ (binds)
> (extract-bindings (string->symbol (symbol->string nom))
> binds)))
>
> (define free
> (λ (nom)
> (gui (λ ()
> (list
> `(input ([type "text"]
> [name ,(symbol->string nom)]
> [size "40"]))))
> (extract-single nom))))
>
> (define (pull-down-input val)
> `(option ([value ,val])
> ,val))
>
>
> (define pull-down
> (λ args
> (λ (nom)
> (gui (λ ()
> (list `(select ([name ,(symbol->string nom)])
> ,@(for/list ([i (in-naturals)]
> [arg args])
> (pull-down-input arg)))))
> (extract-multiple nom)))))
>
> (define (radio-input nom val)
> `(input ([type "radio"]
> [name ,nom]
> [value ,val])
> ,val))
>
> (define radio
> (λ args
> (λ (nom)
> (gui (λ ()
> (for/list ([i (in-naturals)]
> [arg args])
> (radio-input (symbol->string nom) arg)))
> (extract-single nom)))))
>
> (define brands
> (pull-down "Côte d'Or"
> "Scharffen Burger"
> "Pierre Marcolini"
> "Others"))
>
> (define yes-no
> (λ (nom)
> (gui (λ ()
> (list (radio-input (symbol->string nom) "yes")
> (radio-input (symbol->string nom) "no")))
> (extract-single nom))))
>
> ;BUG?
> (define ?
> (λ (name words gui-type)
> (let* ([nom (if name
> name
> (gensym 'q))]
> [title (apply string-append words)]
> [a-gui (gui-type nom)])
> (register-question! nom title)
> (question nom
> `(div
> (p ,title)
> ,@((gui-form a-gui)))
> (gui-parser a-gui)
> ))))
>
> (define page
> (λ qs
>
> (define query
> (send/suspend
> (λ (k-url)
> (response/xexpr
> `(html (head (title ,(string-append "Page")))
> (body
> (form ([method "post"]
> [action
> ,k-url])
>
> ,@(for/list ([q qs])
> (question-form q))
>
> (br)
> (input ([type "submit"]
> [value "Go"])))))))))
>
> ;parse user input and then update table
> (for ([q qs])
> (let ([answer ((question-parser q) (request-bindings query))])
> (update-answer! (question-name q) answer)))
>
> answers-table))
>
>
>
> (define (start req)
>
> (let ([results (page (? 'like-choco? '("Do you like chocolate?") yes-no))])
> (let ([like-choco? (hash-ref results 'like-choco?)])
>
> (if (equal? "yes" like-choco?)
> (page (? #f '("Which have you tried?") brands))
> (page (? #f '("Why do you NOT like chocolate?") free))))
>
> (response/xexpr
> `(html (head (title "Your answer:"))
> (body ,@(map (λ (q-a)
> `(p ,(first q-a)
> (br)
> ,(if (list? (second q-a))
> (string-join (second q-a) ", ")
> (second q-a))))
> (get-answers))
> )
> ))))
>
> (require web-server/servlet-env)
> (serve/servlet start
> #:command-line? #t
> #:launch-browser? #t
> #:quit? #t
> #:listen-ip #f
> #:port 8080
> #:log-file "log"
> #:extra-files-paths (list (build-path
> (current-directory) "htdocs"))
> #:servlet-path "/"
> #:servlet-regexp #rx"")
>
> ;end of source code
>
> There is a code that registers a question (by writing to a global
> hash-table) in (define ?...) [BTW this is macro in TOPSL]
> In my understanding, it should go off just once but I get the
> following in DrRacket when I run the code:
>
> registering like-choco?
> like-choco? was already registered!
> registering q1671
> like-choco? was already registered!
> like-choco? was already registered!
>
> It escapes me why it seems to run more than once. There seems to be
> something going on behind the curtain, sorta speak.
>
> Much thanks in advance as usual.
>
> jGc
>
> PS: By the way, TOPSL at SourceForge seems a bit dormant. Home page
> mentions about a move to PlaneT depository, but nothing comes up in my
> (google) search. Does any body know of the status?
>
> _________________________________________________
> For list-related administrative tasks:
> http://lists.racket-lang.org/listinfo/users
_________________________________________________
For list-related administrative tasks:
http://lists.racket-lang.org/listinfo/users
