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

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Fri Aug 5 15:12:24 EDT 2011

You can send log entries to one of the things that DrRacket displays. 
It's a call to log-info or a ~5 line indirection function if you want
additional info.  See docs and see below. -- Matthias

(define *n 0)
 
;; Sexpr -> Sexpr 
(define (logging tag x)
  (set! *n (+ *n 1))
  (define msg
    (with-output-to-string 
     (lambda ()
       (printf "~a\n~a ~a:\n" *n line tag)
       (pretty-print x)
       (flush-output))))
  (log-info msg)
  x)



On Aug 5, 2011, at 2:42 PM, J G Cho wrote:

> Right on! Thank you.
> 
> How can I have DrRacket display info (that would normally channel to
> 'log' such as http get etc)? Show log under View seems to do something
> different (more to do with DrRacket than the webserver).
> 
> On Fri, Aug 5, 2011 at 3:47 AM, Veer <diggerrrrr at gmail.com> wrote:
>> 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
>> 
> 
> _________________________________________________
>  For list-related administrative tasks:
>  http://lists.racket-lang.org/listinfo/users




Posted on the users mailing list.