I am using Emacs 24.3.1 on Ubuntu 14.04, slime-20160402.549, GNU CLISP 2.4. Whenever i use read() or read-line() function in slime-repl, it will freeze after one or two input characters (e.g. "wa"),
; SLIME 2016-04-02
CL-USER> (read)
wa
Trying C-g it shows the error below:
Debugger entered--Lisp error: (quit)
accept-process-output(nil 0.01)
#[0 "\306\307!\306\310!\211\302L\266\211\211\300L\266\311\312J\301#\313\314\315\316\317D\316\nD\316\fD\320\257E\257!\266\321\322\323 \322\262\322\262\324!\325=\204J
slime-eval((swank:simple-completions "wa" (quote "COMMON-LISP-USER")))
slime-simple-completions("wa")
ac-source-slime-simple-candidates()
ac-candidates-1(((init . ac-slime-init) (candidates . ac-source-slime-simple-candidates) (candidate-face . ac-slime-menu-face) (selection-face . ac-slime-selection-face) (prefix . slime-symbol-start-pos) (symbol . "l") (document . ac-slime-documentation) (match . ac-source-slime-case-correcting-completions)))
ac-candidates()
ac-update(t)
ac-show-menu()
apply(ac-show-menu nil)
...
This problem does not happen in clisp REPL on command line.
Any helps?
Related
Before Emacs 28.1 (Linux) I used:
(eval-after-load 'parse-time
'(progn
(setq parse-time-weekdays (nconc parse-time-weekdays
'(("so" . 0) ("mo" . 1) ("di" . 2) ("mi" . 3) ("do" . 4) ("fr" . 5) ("sa" . 6)))))
which gives german weekdays when entering org-mode dates, like <2022-08-21 So>, now I'am getting <2022-08-21 Sun> (Org mode version 9.5.4).
Why?
To get the list of all valid encodings for sbcl, I do this:
(let (encoding-list)
(let (symbol-list)
(do-external-symbols (s :keyword)
(push s symbol-list))
(setf symbol-list (sort symbol-list #'string<))
(mapc (lambda (x)
(when (ignore-errors
(with-open-file
(phyle "scratch1"
:direction :output
:if-exists :supersede
:external-format x)
1)) ; <-- produce something non-NIL
(push x encoding-list)))
symbol-list))
(nreverse encoding-list))
Is there an easier way to do this in sbcl? (For example, in clisp, all the encodings are external symbols in the CHARSET package.)
The only "official" list is in the manual. If you don't mind looking into SBCLs internals, external formats are stored in a hash table, SB-IMPL::*EXTERNAL-FORMATS*.
CL-USER> (alexandria:hash-table-keys sb-impl::*external-formats*)
(:UTF32BE :UTF-32BE :UTF32LE :UTF-32LE :UTF16BE :UTF-16BE :UTF16LE :UTF-16LE
:UCS4BE :UCS-4BE :UCS4LE :UCS-4LE :UCS2BE :UCS-2BE :UCS2LE :UCS-2LE :CP932
:|Shift_JIS| :SJIS :SHIFT_JIS :|eucJP| :EUCJP :EUC-JP :CP936 :GBK :|macintosh|
:MACINTOSH :|mac| :MAC :|MacRoman| :|mac-roman| :MAC-ROMAN :|windows-1258|
:WINDOWS-1258 :|cp1258| :CP1258 :|windows-1257| :WINDOWS-1257 :|cp1257|
:CP1257 :|windows-1256| :WINDOWS-1256 :|cp1256| :CP1256 :|windows-1255|
:WINDOWS-1255 :|cp1255| :CP1255 :|cp1254| :CP1254 :|windows-1253|
:WINDOWS-1253 :|cp1253| :CP1253 :|windows-1252| :WINDOWS-1252 :|cp1252|
:CP1252 :|windows-1251| :WINDOWS-1251 :|cp1251| :CP1251 :|windows-1250|
:WINDOWS-1250 :|cp1250| :CP1250 :ISO8859-15 :ISO-8859-15 :LATIN9 :LATIN-9
:|latin-8| :LATIN-8 :|iso-8859-14| :ISO-8859-14 :|latin-7| :LATIN-7
:|iso-8859-13| :ISO-8859-13 :|iso-8859-11| :ISO-8859-11 :|latin-6| :LATIN-6
:|iso-8859-10| :ISO-8859-10 :|latin-5| :LATIN-5 :|iso-8859-9| :ISO-8859-9
:|iso-8859-8| :ISO-8859-8 :|iso-8859-7| :ISO-8859-7 :|iso-8859-6| :ISO-8859-6
:|iso-8859-5| :ISO-8859-5 :|latin-4| :LATIN-4 :|iso-8859-4| :ISO-8859-4
:|latin-3| :LATIN-3 :|iso-8859-3| :ISO-8859-3 :|latin-2| :LATIN-2
:|iso-8859-2| :ISO-8859-2 :|cp874| :CP874 :|cp869| :CP869 :|cp866| :CP866
:|cp865| :CP865 :|cp864| :CP864 :|cp863| :CP863 :|cp862| :CP862 :|cp861|
:CP861 :|cp860| :CP860 :|cp857| :CP857 :|cp855| :CP855 :|cp852| :CP852
:|cp850| :CP850 :|cp437| :CP437 :|x-mac-cyrillic| :X-MAC-CYRILLIC :|koi8-u|
:KOI8-U :|koi8-r| :KOI8-R :IBM037 :IBM-037 :|cp037| :CP037 :EBCDIC-US :UTF8
:UTF-8 :ISO8859-1 :ISO-8859-1 :LATIN1 :LATIN-1 :|646| :ISO-646-US :ISO-646
:ANSI_X3.4-1968 :US-ASCII :ASCII)
Of course, since this is not a public API there is no guarantee that it won't be broken in future releases.
I'm running the teapot example from cl-opengl package. The only changes I've made are loading the required packages. It works fine when executed from unix shell (sbcl --load "3.cl"), but when I try to compile and load it through SLIME (C-c C-k) i get the error about package GLUT not found.
Curiously, the compiler chokes on the (defclass glut-teapot-window (glut:window).
What gives???
Here's a screenshot of what happens
Here's the code for 3.cl.
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;; glut-teapot.lisp --- Simple usage of glut:solid-teapot.
(ql:quickload :cl-opengl)
(ql:quickload :cl-glu)
(ql:quickload :cl-glut)
;(setf *communication-style* :fd-handler)
(defclass glut-teapot-window (glut:window)
()
(:default-initargs :width 250 :height 250 :title "glut-teapot.lisp"
:mode '(:single :rgb :depth)))
(defmethod glut:display-window :before ((w glut-teapot-window))
(gl:clear-color 0 0 0 0)
(gl:cull-face :back)
(gl:depth-func :less)
(gl:disable :dither)
(gl:shade-model :smooth)
(gl:light-model :light-model-local-viewer 1)
(gl:color-material :front :ambient-and-diffuse)
(gl:enable :light0 :light1 :lighting :cull-face :depth-test))
(defmethod glut:display ((window glut-teapot-window))
(gl:load-identity)
(gl:translate 0 0 -5)
(gl:rotate 30 1 1 0)
(gl:light :light0 :position '(100 1000 1 0))
(gl:light :light0 :diffuse '(1.2 0.4 0.6 0))
(gl:light :light1 :position '(-100 1000 1 0))
(gl:clear :color-buffer :depth-buffer)
(gl:color 1 10 1)
(gl:front-face :cw)
(glut:solid-teapot 1.3)
;(glut:solid-torus 0.5 1.0 50 50)
;(glu:cylinder (glu:new-quadric) 0.5 0.5 0.5 20 20)
(gl:front-face :ccw)
(gl:flush))
(defmethod glut:reshape ((window glut-teapot-window) width height)
(gl:viewport 0 0 width height)
(gl:matrix-mode :projection)
(gl:load-identity)
(glu:perspective 50 (/ width height) 0.5 20)
(gl:matrix-mode :modelview)
(gl:load-identity))
(defmethod glut:keyboard ((window glut-teapot-window) key x y)
(declare (ignore x y))
(when (eql key #\Esc)
(glut:destroy-current-window)))
(defun glut-teapot ()
(glut:display-window (make-instance 'glut-teapot-window)))
(glut-teapot)
If you load the file, the Lisp system reads the file expression by expression and executes them after reading each single expression.
If you compile the file in a fresh Lisp, then it reads the expressions and compiles them. But it does not execute them. Thus it sees the quickload command, compiles it, but does not execute it. This OpenGL code is not loaded and the packages are not known to the compiler. But that makes sense: a compile usually should compile the file, not execute it. Lisp would execute the expressions then when you load the compiled fasl file.
There are two simple ways around it:
put the quickload operation in a separate file and compile/execute it before compiling the next file.
enclose the load operations in an EVAL-WHEN statement. (eval-when (:execute :load-toplevel :compile-toplevel) ... your code here ...).
The :compile-toplevel symbol means, that the code will be executed when the compiler sees it as a top-level form. Which it otherwise would not do. Thus you can have code in a file to compile which creates side effects - here loading other code.
On Debian, I am trying to compile a CLISP program which uses the cl-ppcre package.
A sample, simplified program (which I will call variant 1) looks like this:
(asdf:load-system :cl-ppcre)
(princ (cl-ppcre:regex-replace-all "a" "abcde" "x"))
(terpri)
When I ran it thus::
clisp -q a3.lisp
I got this:
home:~/clisp/ercpp/compiling-program$ clisp -q a3.lisp
; Loading system definition from /usr/share/common-lisp/systems/cl-ppcre.asd into #<PACKAGE ASDF0>
; Registering #<SYSTEM :CL-PPCRE> as CL-PPCRE
; Registering #<SYSTEM :CL-PPCRE-TEST> as CL-PPCRE-TEST
0 errors, 0 warnings
xbcde
home:~/clisp/ercpp/compiling-program$
But when I tried to compile it thus:
clisp -q -c a3.lisp
I got this:
home:~/clisp/ercpp/compiling-program$ clisp -q -c a3.lisp
;; Compiling file /u/home/clisp/ercpp/compiling-program/a3.lisp ...
*** - READ from
#<INPUT BUFFERED FILE-STREAM CHARACTER
#P"/u/home/clisp/ercpp/compiling-program/a3.lisp" #3>
: there is no package with name "CL-PPCRE"
0 errors, 0 warnings
home:~/clisp/ercpp/compiling-program$
I got similar results with successful run and unsuccessful compile with variant 2:
(clc:clc-require :cl-ppcre)
(princ (cl-ppcre:regex-replace-all "a" "abcde" "x"))
(terpri)
What do I need to do to get it to compile?
In case it might help come up with an answer, I looked at the file I/O triggered by running variant 1. I used strace, and sliced and diced the output to show only names of relevant files and directories. When I did this:
strace -o strace.1 clisp -q a3.lisp
grep pcre strace.1 \
| sed -e 's/^[^"]*"//' \
| sed -e 's/".*$//' \
| sort \
| uniq \
> strace.2
I got this output:
(asdf:load-system :cl-ppcre)\n\n(p
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/api.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/charmap.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/charset.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/chartest.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/closures.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/convert.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/errors.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/lexer.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/optimize.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/packages.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/parser.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/regex-class-util.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/regex-class.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/repetition-closures.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/scanner.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/specials.fas
/u/home/.cache/common-lisp/clisp-2.48-unix-x86/usr/share/common-lisp/source/cl-ppcre/util.fas
/u/home/clisp/ercpp/compiling-program/cl-ppcre-test.asd
/usr/share/common-lisp/source/aima/cl-ppcre-test.asd
/usr/share/common-lisp/source/alexandria/cl-ppcre-test.asd
/usr/share/common-lisp/source/arnesi/cl-ppcre-test.asd
/usr/share/common-lisp/source/arnesi/src/cl-ppcre-extras.lisp
/usr/share/common-lisp/source/aspectl/cl-ppcre-test.asd
/usr/share/common-lisp/source/babel/cl-ppcre-test.asd
/usr/share/common-lisp/source/binary-types/cl-ppcre-test.asd
/usr/share/common-lisp/source/blowfish/cl-ppcre-test.asd
/usr/share/common-lisp/source/cedilla/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-acl-compat/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-asdf/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-cffi/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-fad/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-interpol/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-jpeg/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-launch/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-menusystem/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-pdf/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-photo/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-plplot/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-port/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-ppcre
/usr/share/common-lisp/source/cl-ppcre/.
/usr/share/common-lisp/source/cl-ppcre/api.fas
/usr/share/common-lisp/source/cl-ppcre/api.lisp
/usr/share/common-lisp/source/cl-ppcre/charmap.fas
/usr/share/common-lisp/source/cl-ppcre/charmap.lisp
/usr/share/common-lisp/source/cl-ppcre/charset.fas
/usr/share/common-lisp/source/cl-ppcre/charset.lisp
/usr/share/common-lisp/source/cl-ppcre/chartest.fas
/usr/share/common-lisp/source/cl-ppcre/chartest.lisp
/usr/share/common-lisp/source/cl-ppcre/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-ppcre/cl-ppcre-unicode.asd
/usr/share/common-lisp/source/cl-ppcre/cl-ppcre.asd
/usr/share/common-lisp/source/cl-ppcre/closures.fas
/usr/share/common-lisp/source/cl-ppcre/closures.lisp
/usr/share/common-lisp/source/cl-ppcre/convert.fas
/usr/share/common-lisp/source/cl-ppcre/convert.lisp
/usr/share/common-lisp/source/cl-ppcre/errors.fas
/usr/share/common-lisp/source/cl-ppcre/errors.lisp
/usr/share/common-lisp/source/cl-ppcre/lexer.fas
/usr/share/common-lisp/source/cl-ppcre/lexer.lisp
/usr/share/common-lisp/source/cl-ppcre/optimize.fas
/usr/share/common-lisp/source/cl-ppcre/optimize.lisp
/usr/share/common-lisp/source/cl-ppcre/packages.fas
/usr/share/common-lisp/source/cl-ppcre/packages.lisp
/usr/share/common-lisp/source/cl-ppcre/parser.fas
/usr/share/common-lisp/source/cl-ppcre/parser.lisp
/usr/share/common-lisp/source/cl-ppcre/regex-class-util.fas
/usr/share/common-lisp/source/cl-ppcre/regex-class-util.lisp
/usr/share/common-lisp/source/cl-ppcre/regex-class.fas
/usr/share/common-lisp/source/cl-ppcre/regex-class.lisp
/usr/share/common-lisp/source/cl-ppcre/repetition-closures.fas
/usr/share/common-lisp/source/cl-ppcre/repetition-closures.lisp
/usr/share/common-lisp/source/cl-ppcre/scanner.fas
/usr/share/common-lisp/source/cl-ppcre/scanner.lisp
/usr/share/common-lisp/source/cl-ppcre/specials.fas
/usr/share/common-lisp/source/cl-ppcre/specials.lisp
/usr/share/common-lisp/source/cl-ppcre/util.fas
/usr/share/common-lisp/source/cl-ppcre/util.lisp
/usr/share/common-lisp/source/cl-salza/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-split-sequence/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-statistics/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-utilities/cl-ppcre-test.asd
/usr/share/common-lisp/source/cl-who/cl-ppcre-test.asd
/usr/share/common-lisp/source/closer-mop/cl-ppcre-test.asd
/usr/share/common-lisp/source/contextl/cl-ppcre-test.asd
/usr/share/common-lisp/source/csv/cl-ppcre-test.asd
/usr/share/common-lisp/source/fiveam/cl-ppcre-test.asd
/usr/share/common-lisp/source/ftp/cl-ppcre-test.asd
/usr/share/common-lisp/source/getopt/cl-ppcre-test.asd
/usr/share/common-lisp/source/infix/cl-ppcre-test.asd
/usr/share/common-lisp/source/inflate/cl-ppcre-test.asd
/usr/share/common-lisp/source/ironclad/cl-ppcre-test.asd
/usr/share/common-lisp/source/iterate/cl-ppcre-test.asd
/usr/share/common-lisp/source/kmrcl-tests/cl-ppcre-test.asd
/usr/share/common-lisp/source/kmrcl/cl-ppcre-test.asd
/usr/share/common-lisp/source/lexer/cl-ppcre-test.asd
/usr/share/common-lisp/source/lw-compat/cl-ppcre-test.asd
/usr/share/common-lisp/source/md5/cl-ppcre-test.asd
/usr/share/common-lisp/source/metering/cl-ppcre-test.asd
/usr/share/common-lisp/source/net-telent-date/cl-ppcre-test.asd
/usr/share/common-lisp/source/onlisp/cl-ppcre-test.asd
/usr/share/common-lisp/source/pipes/cl-ppcre-test.asd
/usr/share/common-lisp/source/png/cl-ppcre-test.asd
/usr/share/common-lisp/source/ptester/cl-ppcre-test.asd
/usr/share/common-lisp/source/puri/cl-ppcre-test.asd
/usr/share/common-lisp/source/qbook/cl-ppcre-test.asd
/usr/share/common-lisp/source/readline/cl-ppcre-test.asd
/usr/share/common-lisp/source/regex/cl-ppcre-test.asd
/usr/share/common-lisp/source/reversi/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-bitcomp/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-bool-comp/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-cache/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-delayed/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-filter/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-fuzzy/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-mod/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-modal/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-queue/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-rand/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-random/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-rsa/cl-ppcre-test.asd
/usr/share/common-lisp/source/rsm-string/cl-ppcre-test.asd
/usr/share/common-lisp/source/rt/cl-ppcre-test.asd
/usr/share/common-lisp/source/series/cl-ppcre-test.asd
/usr/share/common-lisp/source/slime/cl-ppcre-test.asd
/usr/share/common-lisp/source/trivial-features/cl-ppcre-test.asd
/usr/share/common-lisp/source/uffi-tests/cl-ppcre-test.asd
/usr/share/common-lisp/source/uffi/cl-ppcre-test.asd
/usr/share/common-lisp/source/units/cl-ppcre-test.asd
/usr/share/common-lisp/source/url-rewrite/cl-ppcre-test.asd
/usr/share/common-lisp/source/usocket/cl-ppcre-test.asd
/usr/share/common-lisp/source/usocket/test/cl-ppcre-test.asd
/usr/share/common-lisp/source/yacc/cl-ppcre-test.asd
/usr/share/common-lisp/source/yaclml/cl-ppcre-test.asd
/usr/share/common-lisp/systems/cl-ppcre-test.asd
/usr/share/common-lisp/systems/cl-ppcre.asd
So what do I do?
If you compile some file which uses a package like (cl-ppcre:bar ...) then you need make sure that the package exists.
Compiling a statement like (asdf:load-system :cl-ppcre) does not cause loading the system at compile-time. Thus the package definition is also not loaded and executed. The compiler generates code for this statement, so that it only executes at load-time.
Either you load the system some way before you compile the file or you use
(eval-when (:compile-toplevel :load-toplevel :execute)
(asdf:load-system :cl-ppcre))
in the file to make sure that it is loaded into the compile-time environment.
I am trying to make a servlet for the Racket Web Server that would allow a user to upload pictures to the site and display the already uploaded files as images on the same page. I would like to stream the pictures directly in and out of a PostgreSQL database, rather than saving them to a temporary file on disk or in memory. Is it possible? If so, what is the best way to do it? Can it be done with a stateless servlet? Any help is greatly appreciated!
Should be. I recommend the db package from PLaneT (because I wrote it). You can read the docs online.
The PostgreSQL table should have a bytea field for the image contents; on the Racket side it will be represented as a byte string.
In your servlet, you should probably return a response/full structure with the image contents. You'll have to deal with the return code, MIME type, etc yourself. (See the example in the documentation.)
In the name of science, I am posting one half of the answer to my own question. This page will show images that are already in the database. The upload page is still an open question.
Ryan Culpepper helped me in private correspondence beyond of what is posted here. I thank him for his help. All things that may look like black magic come from him, and all clumsy goofs are mine. I will be grateful for all suggestions on how to improve the code.
#lang racket
#|
================================================================================================================
We are assuming that the PostgreSQL database we are connecting to
has a table "person" with columns
"id", "firstname", "lastname" and "portrait".
The "portrait" column contains the OID of a BLOB
that stores the image file we want to display.
Suppose further that the table "person" has a legitimate entry with
id=22, firstname="John", lastname="Doe"
Then the page
http://127.0.0.1/page/22
should display greetings "Hello, John Doe!"
and show the portrait of the person below the greeting.
The portrait itself should be at
http://127.0.0.1/portrait/22.jpg
The program should be run via Racket -t "<filename>"
after defining the environment variables
"DB_USER", "DB_NAME", "DB_PORT", "DB_PASSWORD".
================================================================================================================
|#
(require
web-server/servlet
web-server/servlet-env
web-server/dispatch
web-server/stuffers/hmac-sha1
web-server/http
web-server/http/response-structs
(planet ryanc/db:1:4)
(planet ryanc/db:1:4/util/connect)
net/base64)
;---------------------------------------------------------------------------------------------------------------
; response
;---------------------------------------------------------------------------------------------------------------
(define (start given-request)
(site-dispatch given-request))
(define-values (site-dispatch given-request)
(dispatch-rules
[("page" (integer-arg)) show-page]
[("portrait" (string-arg)) show-portrait]))
(define (show-page given-request given-person-id)
(let* ( [db-person_firstname_lastname
(query-maybe-row my-connection
"SELECT firstname, lastname FROM person WHERE id = $1"
given-person-id)]
[my-firstname (vector-ref db-person_firstname_lastname 0)]
[my-lastname (vector-ref db-person_firstname_lastname 1)])
(response/xexpr
`(html ([xmlns "http://www.w3.org/1999/xhtml"])
(head
(title "Page with a portrait"))
(body
(div ([id "greetings"])
,(string-append
"Hello, " my-firstname " " my-lastname "! "))
(img ( [src ,(string-append "/portrait/"
(number->string given-person-id) ".jpg")])))))))
(define (show-portrait given-request given-portrait-file)
(let* ( [my-user-id (car (regexp-match #rx"^([0-9]+)"
given-portrait-file))]
[my-portrait-oid (query-value my-connection
"SELECT portrait FROM person WHERE id = $1"
(string->number my-user-id))]
[STREAMOUT_CHUNK_SIZE 1000]
[INV_READ #x00040000])
(response
200 ; code
#"Okay" ; message
(current-seconds) ; seconds
#"image/jpeg" ; mime type
empty ; headers
(lambda (given-output-stream) ; body generator
(start-transaction my-connection)
(define object-descriptor
(query-value my-connection
"SELECT LO_OPEN( $1, $2 )" my-portrait-oid INV_READ))
(define (stream-next-chunk)
(begin
(define my-next-chunk
(query-value my-connection
"SELECT LOREAD( $1, $2 )"
object-descriptor STREAMOUT_CHUNK_SIZE))
(if (> (bytes-length my-next-chunk) 0)
(begin
(write-bytes my-next-chunk given-output-stream)
(stream-next-chunk)
#t)
#f)))
(stream-next-chunk)
(commit-transaction my-connection)))))
;---------------------------------------------------------------------------------------------------------------
; database connection
;---------------------------------------------------------------------------------------------------------------
(define my-connection
(virtual-connection
(connection-pool
(lambda ()
(eprintf "(Re)establishing database connection...\n")
(postgresql-connect
#:user (getenv "DB_USER")
#:database (getenv "DB_NAME")
#:port (string->number (getenv "DB_PORT"))
#:socket #f
#:password (getenv "DB_PASSWORD")
#:allow-cleartext-password? #f
#:ssl 'optional ; other choices: 'yes 'no
)))))
;---------------------------------------------------------------------------------------------------------------
; servlet parameters
;---------------------------------------------------------------------------------------------------------------
(serve/servlet start
#:command-line? #t ; #t to use serve/servlet in a start up script for a Web application, and don't want a browser opened or the DrRacket banner printed
#:connection-close? #f ; #t to close every connection after one request. (Otherwise, the client decides based on what HTTP version it uses.)
#:launch-browser? #f
#:quit? #f ; #t makes the URL "/quit" end the server
#:banner? #t ; #t to print an informative banner
#:listen-ip #f ; give an IP to accept connections from external machines
#:port 80 ; 443 is the default for SSL, 80 - for open connections
#:servlet-regexp #rx"" ; #rx"" captures top-level requests
#:stateless? #t
#:server-root-path ; where the server files are rooted, default=(the distribution root)
(build-path ".")
#:ssl? #f
#:log-file (build-path "server.log"))