hunchentoot: trouble dispatching requests

Discussion of Common Lisp

hunchentoot: trouble dispatching requests

Postby fpt » Thu May 10, 2012 5:20 pm

hunchentoot: requests do not dispatch

Disclaimer: I am a Lisp & software engineering novice and utter web application newbie. This message regards my first attempt at a web application. I'm still at a stage where having basic things, particularly about web application development, explicitly spelled out helps me.

I just installed hunchentoot with Clozure CL 1.8 under Mac OS 10.7. Hunchentoot serves my pages, but query requests do not result in other code being called. What I'm trying to make is a simple web application that presents a webpage with some text and a link. When the link is clicked, the application is to compute some other random assortment of text, write it to an html file overwriting the old "index.html" file, and then refresh so that the new "index.html" loads into the browser.

When the link to recompute text is clicked, I see in the console that hunchentoot receives the request:
98.218.230.125 - [2012-05-10 10:48:42] "GET /index.html?recompute HTTP/1.1" 304 - "http://drpantzo.mine.nu:4242/index.html?recompute" "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_7_3) AppleWebKit/534.55.3 (KHTML, like Gecko) Version/5.1.5 Safari/534.55.3"

However, what I'm unclear on after reading hunchentoot's documentation as well as these three tutorials:
http://www.adampetersen.se/articles/lispweb.htm
http://msnyder.info/posts/2011/07/lisp- ... -ii/#sec-4
http://sites.google.com/site/sabraonthe ... p-packages

…is how the request gets processed by hunchentoot such that my page generation macro gets called again and the webpage gets reloaded. My understanding is that the link is to contain a query, the portion of the link request identified by the "?" prefix. When hunchentoot sees the "recompute" query it should check its *dispatch-table* where it should find an easy-handler function as defined by the macro, define-easy-handler. The easy-handler, having a name matching the query, should call my page generation macro and then redirect to "index.html" so that the page refreshes, showing the lovely new bag of words. However, when I have an easy handler defined and request the page with Safari, I get an internal server error message,
Incorrect keyword arguments in (#<HUNCHENTOOT:REQUEST #x302001F7AF9D>) .
Backtrace

(A019568) : 0 (PRINT-CALL-HISTORY :CONTEXT NIL :PROCESS NIL :ORIGIN NIL :DETAILED-P NIL :COUNT 1152921504606846975 :START-FRAME-NUMBER 0 :STREAM #<STRING-OUTPUT-STREAM #x302001F7ABFD> :PRINT-LEVEL 2 :PRINT-LENGTH 5 :SHOW-INTERNAL-FRAMES NIL :FORMAT :TRADITIONAL) 853
(A0196D0) : 1 (PRINT-BACKTRACE-TO-STREAM #<STRING-OUTPUT-STREAM #x302001F7ABFD>) 85
(A019700) : 2 (GET-BACKTRACE) 365
(A019768) : 3 (FUNCALL #'#<(:INTERNAL (HUNCHENTOOT:HANDLE-REQUEST (HUNCHENTOOT:ACCEPTOR HUNCHENTOOT:REQUEST)))> #<CCL::SIMPLE-PROGRAM-ERROR #x302001F7AC2D>) 109
(A019798) : 4 (SIGNAL #<CCL::SIMPLE-PROGRAM-ERROR #x302001F7AC2D>) 981
(A0197F0) : 5 (%ERROR #<CCL::SIMPLE-PROGRAM-ERROR #x302001F7AC2D> NIL 20984579) 117
(A019820) : 6 (FUNCALL #'#<(CCL::TRACED RECOMPUTE)> #<HUNCHENTOOT:REQUEST #x302001F7AF9D>) 605
(A019868) : 7 (FUNCALL #'#<#<STANDARD-METHOD HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST (HUNCHENTOOT:EASY-ACCEPTOR T)>> #<EASY-ACCEPTOR (host *, port 4242)> #<HUNCHENTOOT:REQUEST #x302001F7AF9D>) 141
(A0198A8) : 8 (%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST #> #<STANDARD-METHOD HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST #>) 20984609) 669
(A019920) : 9 (FUNCALL #'#<#<STANDARD-METHOD HUNCHENTOOT:HANDLE-REQUEST (HUNCHENTOOT:ACCEPTOR HUNCHENTOOT:REQUEST)>> #<EASY-ACCEPTOR (host *, port 4242)> #<HUNCHENTOOT:REQUEST #x302001F7AF9D>) 533
(A0199B8) : 10 (FUNCALL #'#<#<STANDARD-METHOD HUNCHENTOOT:PROCESS-REQUEST (T)>> #<HUNCHENTOOT:REQUEST #x302001F7AF9D>) 1349
(A019AA8) : 11 (DO-WITH-ACCEPTOR-REQUEST-COUNT-INCREMENTED #<EASY-ACCEPTOR (host *, port 4242)> #<COMPILED-LEXICAL-CLOSURE (:INTERNAL #) #x302001F7B06F>) 1157
(A019B30) : 12 (FUNCALL #'#<#<STANDARD-METHOD HUNCHENTOOT:PROCESS-CONNECTION (HUNCHENTOOT:ACCEPTOR T)>> #<EASY-ACCEPTOR (host *, port 4242)> #<USOCKET:STREAM-USOCKET #x302001EBEC5D>) 2837
(A019C50) : 13 (%CALL-NEXT-METHOD (NIL #<STANDARD-METHOD HUNCHENTOOT:PROCESS-CONNECTION #> . 20984761)) 989
(A019CD0) : 14 (FUNCALL #'#<#<STANDARD-METHOD HUNCHENTOOT:PROCESS-CONNECTION :AROUND (HUNCHENTOOT:ACCEPTOR T)>> #<EASY-ACCEPTOR (host *, port 4242)> #<USOCKET:STREAM-USOCKET #x302001EBEC5D>) 637
(A019D68) : 15 (%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD HUNCHENTOOT:PROCESS-CONNECTION :AROUND #> #<STANDARD-METHOD HUNCHENTOOT:PROCESS-CONNECTION #>) 20984761) 669
(A019DE0) : 16 (FUNCALL #'#<(:INTERNAL (HUNCHENTOOT:CREATE-REQUEST-HANDLER-THREAD (HUNCHENTOOT:ONE-THREAD-PER-CONNECTION-TASKMASTER T)))>) 181
(A019E38) : 17 (FUNCALL #'#<(:INTERNAL BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS)>) 757
(A019E78) : 18 (RUN-PROCESS-INITIAL-FORM #<PROCESS hunchentoot-worker-98.218.230.125:33226(91) [Active] #x302001EBDCAD> (#<COMPILED-LEXICAL-CLOSURE # #x302001EBDA1F>)) 669
(A019F08) : 19 (FUNCALL #'#<(:INTERNAL (CCL::%PROCESS-PRESET-INTERNAL (PROCESS)))> #<PROCESS hunchentoot-worker-98.218.230.125:33226(91) [Active] #x302001EBDCAD> (#<COMPILED-LEXICAL-CLOSURE # #x302001EBDA1F>)) 549
(A019F98) : 20 (FUNCALL #'#<(:INTERNAL CCL::THREAD-MAKE-STARTUP-FUNCTION)>) 301

Yet when I (setf hunchentoot:*dispatch-table* nil) I can at least get the page back, but of course then it won't compute a new page and load that. So I seem to misunderstand how to define an easy-handler:

(setf hunchentoot:*dispatch-table*
(list
(hunchentoot:define-easy-handler (recompute :uri "index.html") ()
(page 'index '|ice cream computer| (compute-ice-cream))
(hunchentoot:redirect "index.html"))))


Am I correct in my suspicion that I'm going awry in my easy-handler definition? What can I do to get my page to recompute and reload?
fpt
 
Posts: 5
Joined: Thu May 10, 2012 5:52 am

Re: hunchentoot: trouble dispatching requests

Postby wvxvw » Fri May 11, 2012 2:23 am

I can't say that I entirely understood what were you trying to do, but one thing that looks like I could understand is that you wanted the server to serve new information, when called with the same query string (GET request). You see in the headers sent back there's "magic number" 304 - this is a so-called "not-modified" HTTP status, basically, it says that the file you are trying to load is already on the machine that requests this file (cached).

If you really want to get new page when sending the same request, you should send HTTP headers that invalidate client's cache before client makes next request. You probably need to look into header-out accessor to set "cache-control" to "no-cache", but this is somewhat against the purpose of GET requests. In general this sort of requests is intended for static content, or, in other words, content that doesn't change much. POST requests are a better match for sending and receiving information that is discarded as soon as it is processed. Also GET has inherent restrictions on what characters it can contain, its length etc.

And, to be honest, I never tried the define-easy-handler macro, I found it to be much easier to write a "normal" function and then add it to the dispatch table.
wvxvw
 
Posts: 127
Joined: Sat Mar 26, 2011 6:23 am

Re: hunchentoot: trouble dispatching requests

Postby fpt » Fri May 11, 2012 6:51 am

Thanks for the feedback, wvxvw. So then it seems it'd be simpler to avoid caches and headers. I'll break this web application up into two pages:
1. Let index.html have a link to output html.
2. When index.html's link to output.html is clicked, the application is to compute a new output.html file…
3. …where output.html has a new body text…
4. …and a link back to index.html.
5. The web application is to serve output.html.

At least that's what I'm shooting for. So far I've accomplished all objectives except #2. How can I have hunchentoot call my output.html page generation macro when output.html is requested from the link in index.html?

I feel like I'm missing some important knowledge nugget that lies somewhere between hunchentoot, http, and my web application. Remember, I'm a total newb at web applications, so I probably don't even know what I don't know. Let me attempt to enumerate what I don't know:

1. When a link with a query is clicked, how does hunchentoot know what to do with the request?
2. …that's what hunchentoot's handlers (or any other function in the dispatch-table) are for, are they not?
3. How does hunchentoot know which handler goes with which request?
fpt
 
Posts: 5
Joined: Thu May 10, 2012 5:52 am

Re: hunchentoot: trouble dispatching requests

Postby wvxvw » Fri May 11, 2012 2:04 pm

Does it have to be yet another HTML page? I mean, if the purpose of the exercise is to generate HTML page in response to a request, then, you probably, upon generating the page, need to send redirect headers (like "location: new-page.html") + make sure that hunchentoot has a handler for static files in the directory where you generated the new file, but if your final goal was to just display the new information, then, normally it's achieved in a different way: AJAX. I.e. you request the calculation from the server, and only receive the results of the calculation, but the client takes care of the presentation - this, normally results in less server-side processing and less traffic.

AJAX was originally meant for sending data in XML format, but today it's mostly JSON. http://common-lisp.net/project/cl-json/ this library looks just fine for the task. JSON is simple to write and on the JS side you have either a built-in parser, or you could just eval() it - it's basically the JavaScript code (eval() is not a good way to do it in real-world application, but for simplicity - this is ok).

I do more Flash then JavaScript, so I'd normally use AMF format for client-server communication, it uses less space then JSON, can send custom type objects and preserve references.
wvxvw
 
Posts: 127
Joined: Sat Mar 26, 2011 6:23 am

Re: hunchentoot: trouble dispatching requests

Postby fpt » Sun May 13, 2012 6:36 pm

The purpose of the exercise is to display new text generated by another function. It doesn't have to be yet another HTML page. So then it seems like the way to go is to install CL-JSON and learn some Javascript.

WRT the normal functions you said you add to the dispatch table: Are they acceptor-dispatch-request and handle-request generic functions or do they take some other form? Is that how hunchentoot takes a request from the client and calls the appropriate function/method on the server (ie my text generation function)?
fpt
 
Posts: 5
Joined: Thu May 10, 2012 5:52 am

Re: hunchentoot: trouble dispatching requests

Postby wvxvw » Mon May 14, 2012 1:52 am

Code: Select all
(setq hunchentoot:*dispatch-table*
      `(,(hunchentoot:create-regex-dispatcher
     "\\/services\\/save\\/[^\\/]+"
     'save-from-raw-post) #| more dispatchers here |#))

(defun save-from-raw-post ()
  "Accepts the request to \\/services\\/save\\/[^\\/]+ and generates
response. Successful response will contain new image URL. Fail response will
contain error message."
  (handler-case
      (let ((save-path
        (find-name-re
         (hunchentoot:request-uri
          hunchentoot:*request*))))
   (if (hunchentoot:raw-post-data
        :request hunchentoot:*request*
        :force-binary t)
       (progn
         (save-image (save-original-image save-path) save-path)
         (result-to-xml
          (concatenate 'string
             "images/snapshots/"
             save-path ".jpeg") nil))
       (result-to-xml "The client did not send a proper request" t)))
    (condition (the-condition) (result-to-xml the-condition t))))


I've copy-pasted this from my testing server - there are parts missing, but pasting it all here would be too much, but I think what the other functions do isn't very important. result-to-xml generates some output encoded as XML, save-original-image - saves the image somewhere. find-name-re generates a file name based on the last part of the request made.

If you need, I can post the entire file (which is possible to use as a standalone example), but I wrote it some time ago, and I'd probably do it differently today... nevertheless, it's working (or used to, the last time I tried :P).
wvxvw
 
Posts: 127
Joined: Sat Mar 26, 2011 6:23 am

Re: hunchentoot: trouble dispatching requests

Postby fpt » Wed May 16, 2012 2:22 pm

I think seeing your entire file may be helpful.

After your suggestion I decided to learn some Javascript and try the AJAX route, though not yet all the way to JSON. With hunchentoot's default dispatcher (that is, NIL), index.html loads with a blank space below the "Compute Ice Cream" button. When the button is clicked, the contents of output.txt (computed by ice-cream-computer.lisp) are loaded into the page (later I think I'd prefer sending a JSON to the client instead of a file). However, clicking the button again does not generate new text and load it into the page as I wish.

Then when I
(setq *dispatch-table* `(,(create-prefix-dispatcher "/output" 'output-ice-cream)))
the behavior of the page changes such that clicking the button no longer results in the output text being loaded. I see when I trace output-ice-cream that it is being called, that output.txt is rewritten. However, each time output.txt contains the same text. Then I noticed that when I created my dispatcher, the toplevel had this message:
(#<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CREATE-PREFIX-DISPATCHER) #x3020022BEE3F>)

Is it possible that creating the dispatcher somehow captures one call of output-ice-cream in its closure, and that that's why output.txt never changes? Even so, why would the new dispatcher cause the webpage to now not add the text from output.txt? Are these problems that would likely be sidestepped anyway by moving from text file transmission to JSON?


ice-cream-computer.lisp
Code: Select all
;;;; Ice Cream Computer - hunchentoot version
;;;; A brief software exploration inspired by a game of crazy or bluetooth
;;;; © 2012 Frank Tamborello
;;;; License granted according to Attribution-Noncommercial-Sharealike Creative Commons

;;;; Revision History
;;;; 5   fpt   ?      transform this into a web application
;;;; 4   fpt   2012-05-13   clean up my non-packaged mess
;;;; 3   fpt   2012-05-06   output it as an html file
;;;; 2   fpt   2012-05-06   it's just toppings, give it some ice cream
;;;; 1   fpt   2012-05-05   inception: take some integer from a user, return some random text that many words long constructed from icecream-toppings-corpus.txt. Taken from ANSI Common Lisp (Graham, 1996).


;;;; Try
;;;; 1. AJAX: Javascript & possibly CL-JSON

;;; setup

(defpackage :ice-cream-computer
  (:use :common-lisp :hunchentoot))

(in-package :ice-cream-computer)

(load "/Users/frank/Documents/Lisp/icecream-computer/quicklisp.lisp")

(load "/Users/frank/quicklisp/setup.lisp")

(ql:quickload "hunchentoot") ; version 1.2.3

(setf *hunchentoot-default-dispatching* hunchentoot:*dispatch-table*)

(defparameter *ice-creams* (make-hash-table :size 1200))

(defparameter *toppings* (make-hash-table :size 1200))

(defconstant maxword 100)



;;; text input & processing

(defun process-ingredients ()
  "Pass two text files to read-ingredients for parsing."
  (let ((pathnames '("/Users/frank/Documents/Lisp/icecream-computer/ice-creams.txt"
                     "/Users/frank/Documents/Lisp/icecream-computer/toppings.txt"))
        (dicts '(*ice-creams* *toppings*))
        (prev '(|watermelon| |mike and ike|)))
    (dotimes (i 2)
     (defun see (symb dict)
       "If symb appears in dict, recur on the next symb, else add symb to dict."
          (let ((pair (assoc symb (gethash (nth i prev) (eval dict)))))
            (if (null pair)
              (push (cons symb 1) (gethash (nth i prev) (eval dict)))
              (incf (cdr pair))))
          (setf (nth i prev) symb))
      (read-ingredients (nth i pathnames) (nth i dicts)))))

(defun read-ingredients (pathname dict)
  "Read text from pathname one line at a time, pass the line to see with dict."
  (let ((inputlst nil))
    (with-open-file (s pathname :direction :input)
      (do ((item (read-line s nil :eof)
                 (read-line s nil :eof)))
          ((eql item :eof))
        (dotimes (i (1+ (random 9)))
                    (push item inputlst))))
      (dolist (item (randomize-list inputlst))
                     (see (intern (string-downcase item)) dict))))

(defun randomize-list (in-list)
  "Randomly permute the items on a list"
  (let* ((the-list (copy-list in-list))
         (new-list nil)
         (start-len (length the-list))
         (current-len start-len)
         (the-item nil))
    (dotimes (i start-len new-list)
      (setf the-item (nth (random current-len) the-list))
      (push the-item new-list)
      (setf the-list (remove the-item the-list :count 1))
      (decf current-len))))

(process-ingredients)



;; text generation and output

(defun output-ice-cream ()
  "Wrapper for compute-ice-cream just to output to a text file."
  (with-open-file (*standard-output*
                   "/Users/frank/Documents/Lisp/icecream-computer/public-html/output.txt"
                   :direction :output
                   :if-exists :supersede)
    (compute-ice-cream)))

(defun compute-ice-cream ()
  "Generates a random text from the dictionaries, *ice-creams* and *toppings*."
  (let ((dicts '(*ice-creams* *toppings*))
        (max-items '(5 10))
        (epilogs '(|ice cream with | |on top.|))
        (prev '(|watermelon| |mike and ike|)))
    (dotimes (i 2)
      (generate-text (1+ (random (nth i max-items))) (nth i dicts) (nth i epilogs) (nth i prev)))))

(defun generate-text (n dict epilog prev)
  "Generates n text elements by calling random-next with dict and prev."
  (if (zerop n)
    (format t "~A" epilog)
    (let ((next (random-next dict prev)))
      (format t "~A " next)
      (generate-text (1- n) dict epilog next))))

(defun random-next (dict prev)
  "Picks a text element at random from a dict's entry for a given prev."
  (let* ((choices (gethash prev (eval dict)))
         (i (random (reduce #'+ choices :key #'cdr))))
    (dolist (pair choices)
      (if (minusp (decf i (cdr pair)))
        (return (car pair))))))

(output-ice-cream)



;; make & start a webserver
(setf ice-cream-server (make-instance 'easy-acceptor :port 4242 :document-root (make-pathname :directory "/Users/frank/Documents/Lisp/icecream-computer/public-html/")))

(start ice-cream-server)



;; hunchentoot handler stuff
;; based on wvxvw's example
(setq *dispatch-table* `(,(create-prefix-dispatcher "/output" 'output-ice-cream)))




index.html
Code: Select all
<html>
<head>
<title>Ice Cream Computer</title>
<script type="text/javascript">
function loadIceCream()
{
var xmlhttp;
xmlhttp=new XMLHttpRequest();
xmlhttp.onreadystatechange=function()
  {
  if (xmlhttp.readyState==4 && xmlhttp.status==200)
    {
    document.getElementById("IceCreamDiv").innerHTML=xmlhttp.responseText;
    }
  }
xmlhttp.open("GET","output.txt?t=" + Math.random(),true);
xmlhttp.send();
}
</script>
</head>
<body>
<center>
<h1>Ice Cream Computer</h1>
<table>
<tr>
<td>
<button type="button" onclick="loadIceCream()">Compute Ice Cream</button>
</td>
<td>
&nbsp;
</td>
<td>
<a href="colophon.html">colophon</a>
</td>
</tr>
</table>
</center>
<br /><br /><br />
<div id="IceCreamDiv"></div>
</body>
</html>
fpt
 
Posts: 5
Joined: Thu May 10, 2012 5:52 am

Re: hunchentoot: trouble dispatching requests

Postby fpt » Wed May 16, 2012 8:54 pm

I finally got it!

http://drpantzo.mine.nu:4242/

The answer turned out to be a combination of AJAX and supplying the output of the text generation function directly to the dispatcher as a string (compute-ice-cream returns a string):
(setq *dispatch-table* `(,(create-prefix-dispatcher "/compute" 'compute-ice-cream)))

Thanks for all your help, wvxvw!

Code: Select all
;;;; Ice Cream Computer - hunchentoot version
;;;; A brief software exploration inspired by a game of crazy or bluetooth
;;;; © 2012 Frank Tamborello
;;;; License granted according to Attribution-Noncommercial-Sharealike Creative Commons
;;;; Thanks to wvxvw at lispforum.com for guidance.


;;;; Revision History
;;;; 5   fpt   2012-05-16   transform this into a web application
;;;; 4   fpt   2012-05-13   clean up my non-packaged mess
;;;; 3   fpt   2012-05-06   output it as an html file
;;;; 2   fpt   2012-05-06   it's just toppings, give it some ice cream
;;;; 1   fpt   2012-05-05   inception: take some integer from a user, return some random text that many words long constructed from icecream-toppings-corpus.txt. Taken from ANSI Common Lisp (Graham, 1996).


;;; setup

(defpackage :ice-cream-computer
  (:use :common-lisp :hunchentoot))

(in-package :ice-cream-computer)

(load "/Users/frank/Documents/Lisp/icecream-computer/quicklisp.lisp")

(load "/Users/frank/quicklisp/setup.lisp")

(ql:quickload "hunchentoot") ; version 1.2.3

(setf *hunchentoot-default-dispatching* hunchentoot:*dispatch-table*)

(defparameter *ice-creams* (make-hash-table :size 1200))

(defparameter *toppings* (make-hash-table :size 1200))

(defconstant maxword 100)



;;; text input & processing

(defun process-ingredients ()
  "Pass two text files to read-ingredients for parsing."
  (let ((pathnames '("/Users/frank/Documents/Lisp/icecream-computer/ice-creams.txt"
                     "/Users/frank/Documents/Lisp/icecream-computer/toppings.txt"))
        (dicts '(*ice-creams* *toppings*))
        (prev '(|watermelon| |mike and ike|)))
    (dotimes (i 2)
     (defun see (symb dict)
       "If symb appears in dict, recur on the next symb, else add symb to dict."
          (let ((pair (assoc symb (gethash (nth i prev) (eval dict)))))
            (if (null pair)
              (push (cons symb 1) (gethash (nth i prev) (eval dict)))
              (incf (cdr pair))))
          (setf (nth i prev) symb))
      (read-ingredients (nth i pathnames) (nth i dicts)))))

(defun read-ingredients (pathname dict)
  "Read text from pathname one line at a time, pass the line to see with dict."
  (let ((inputlst nil))
    (with-open-file (s pathname :direction :input)
      (do ((item (read-line s nil :eof)
                 (read-line s nil :eof)))
          ((eql item :eof))
        (dotimes (i (1+ (random 9)))
                    (push item inputlst))))
      (dolist (item (randomize-list inputlst))
                     (see (intern (string-downcase item)) dict))))

(defun randomize-list (in-list)
  "Randomly permute the items on a list"
  (let* ((the-list (copy-list in-list))
         (new-list nil)
         (start-len (length the-list))
         (current-len start-len)
         (the-item nil))
    (dotimes (i start-len new-list)
      (setf the-item (nth (random current-len) the-list))
      (push the-item new-list)
      (setf the-list (remove the-item the-list :count 1))
      (decf current-len))))

(process-ingredients)



;; text generation and output
#| maybe later I'll want the ability to easily output to file or variable
(defun output-ice-cream (place)
  "Wrapper for compute-ice-cream to slurp its output into output.txt or *output*"
  (case place
    (file (with-open-file (*standard-output*
                            "/Users/frank/Documents/Lisp/icecream-computer/public-html/output.txt"
                            :direction :output
                            :if-exists :supersede)
             (compute-ice-cream)))
    (var (setf *output* (compute-ice-cream)))))
|#

(defun compute-ice-cream ()
  "Generates a random text from the dictionaries, *ice-creams* and *toppings*."
  (let ((dicts '(*ice-creams* *toppings*))
        (max-items '(5 10))
        (epilogs '(|ice cream with | |on top.|))
        (prev '(|watermelon| |mike and ike|)))
    (with-output-to-string (str)
      (dotimes (i 2)
      (generate-text str (1+ (random (nth i max-items))) (nth i dicts) (nth i epilogs) (nth i prev))))))

(defun generate-text (str n dict epilog prev)
  "Generates n text elements by calling random-next with dict and prev."
  (if (zerop n)
      (format str "~A" epilog)
      (let ((next (random-next dict prev)))
        (format str "~A " next)
        (generate-text str (1- n) dict epilog next))))

(defun random-next (dict prev)
  "Picks a text element at random from a dict's entry for a given prev."
  (let* ((choices (gethash prev (eval dict)))
         (i (random (reduce #'+ choices :key #'cdr))))
    (dolist (pair choices)
      (if (minusp (decf i (cdr pair)))
        (return (car pair))))))

(setf *output* (compute-ice-cream))
*output*


;; make & start a webserver
(setf ice-cream-server (make-instance 'easy-acceptor :port 4242 :document-root (make-pathname :directory "/Users/frank/Documents/Lisp/icecream-computer/public-html/")))

(start ice-cream-server)



;; hunchentoot handler stuff
;; based on wvxvw's example
(setq *dispatch-table* `(,(create-prefix-dispatcher "/compute" 'compute-ice-cream)))
(setq *dispatch-table* nil)

(stop ice-cream-server)



Code: Select all
<html>
<head>
<title>Ice Cream Computer</title>
<script type="text/javascript">
function ComputeIceCream()
{var xmlhttp;
 xmlhttp=new XMLHttpRequest();
 xmlhttp.onreadystatechange=function()
  {if (xmlhttp.readyState==4 && xmlhttp.status==200)
    {document.getElementById("IceCreamDiv").innerHTML=xmlhttp.responseText;}}
xmlhttp.open("GET","compute?t=" + Math.random(),true);
xmlhttp.send();}
</script>
</head>
<body>
<center>
<h1>Ice Cream Computer</h1>
<table>
<tr>
<td>
<button type="button" onclick="ComputeIceCream()">Compute Ice Cream</button>
</td>
<td>
&nbsp;
</td>
<td>
<a href="colophon.html">colophon</a>
</td>
</tr>
</table>
</center>
<br /><br /><br />
<div id="IceCreamDiv"></div>
<br /><br /><br />
</body>
</html>
fpt
 
Posts: 5
Joined: Thu May 10, 2012 5:52 am

Re: hunchentoot: trouble dispatching requests

Postby wvxvw » Thu May 17, 2012 1:01 am

Glad you get it right!

And, by the way, the function that randomizes the list (of recipes I presume) could've been better ;) For my tests the below runs about 3 times faster for lists of length of 4 and will run even faster for longer lists, proportionally to their length:

Code: Select all
(defun randomize-list (x &optional (len (length x)) y)
  (if (null x) y
      (do ((next x (cdr next))
           (previous)
           (i 0 (1+ i))
           (removed (random len)))
          (nil)
        (when (= i removed)
          (if previous (rplacd previous (cdr next))
              (setf x (cdr x)))
          (return (randomize-list
                   x (1- len) (rplacd next y))))
        (setf previous next))))
wvxvw
 
Posts: 127
Joined: Sat Mar 26, 2011 6:23 am


Return to Common Lisp

Who is online

Users browsing this forum: Yahoo [Bot] and 3 guests