[racket] A function (in web-servlet) is expected to be invoked just once but seems to have more lives ...

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 <gcho at 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