プロジェクト

全般

プロフィール

SourceThird » 履歴 » バージョン 2

Yuumi Yoshida, 2008-06-04 22:02

1 1 Yuumi Yoshida
リスト1:RDBプログラム
2 2 Yuumi Yoshida
<pre>
3 1 Yuumi Yoshida
(use dbi)
4
(use gauche.collection)
5
6
(define (print-goal) 
7
  (let* ((conn (dbi-connect "dbi:sqlite3:alih.db"))
8
         (res  (dbi-do conn
9
                       "SELECT no, name, g FROM player WHERE pos='F' ORDER BY g desc"))
10
         (getter (relation-accessor res)))
11
    (for-each
12
     (lambda (row)
13
       (format #t "~3d ~22a ~5d\n"  
14
               (getter row "no")
15
               (getter row "name")
16
               (getter row "g")))
17
     res)
18
    (dbi-close conn)))
19
20
(print-goal)
21 2 Yuumi Yoshida
</pre>
22 1 Yuumi Yoshida
23
図1:GaucheでWebサーバー
24 2 Yuumi Yoshida
<pre>
25 1 Yuumi Yoshida
(use gauche.net) 
26
(use rfc.uri) 
27
(use www.cgi) 
28
29
(define (web-server)
30
  (let ((server-socket (make-server-socket 'inet 3030 :reuse-addr? #t)))
31
    (while #t
32
      (let ((client-socket (socket-accept server-socket)))
33
        (receive (path params)  (get-request (socket-input-port client-socket))
34
          (put-response (render path params)
35
                    (socket-output-port client-socket)))
36
        (socket-close client-socket)))))
37
      
38
(define (get-request in-port)
39
  (cond ((rxmatch #/^GET\s+(\S+)\s/ (read-line in-port)) 
40
         => (lambda (m) 
41
              (parse-uri (rxmatch-substring m 1))))
42
        (else (values "" ()))))
43
44
(define (parse-uri uri)
45
  (receive (host path query fragment) (uri-decompose-hierarchical uri) 
46
    (values path (cgi-parse-parameters :query-string (or query "")))))
47
48
(define (put-response content out-port)
49
  (display "HTTP/1.1 200 OK\r\n" out-port) 
50
  (display "Content-Type: text/html; charset=utf-8\r\n" out-port) 
51 2 Yuumi Yoshida
  (display #@"Content-Length: ,(string-size content)\r\n" out-port) 
52 1 Yuumi Yoshida
  (display "\r\n" out-port) 
53
  (display content out-port))
54
55
(define (render path params) 
56
  (let ((port (open-output-string)))
57
    (display "<html><body>\n" port)
58
    (display "<h1>simple web server</h1>\n" port)
59 2 Yuumi Yoshida
    (display #@"path: ,path <br>\n" port)
60 1 Yuumi Yoshida
    (for-each (lambda (p)
61 2 Yuumi Yoshida
                (display #@"  ,(car p) : ,(cdr p) <br>\n" port))
62 1 Yuumi Yoshida
              params)
63
    (display "</body></html>\n" port)
64
    (get-output-string port)))
65
66
(web-server)
67 2 Yuumi Yoshida
</pre>
68 1 Yuumi Yoshida
69
図3: GaucheでWebアプリ
70 2 Yuumi Yoshida
<pre>
71 1 Yuumi Yoshida
(use dbi)
72
(use gauche.collection)
73
(define (render path params) 
74
  (let* ((port (open-output-string))
75
         (conn (dbi-connect "dbi:sqlite3:alih.db"))
76
         (pos (cgi-get-parameter "pos" params))
77
         (sql (if (and pos (rxmatch #/^[DFG]$/ pos))
78 2 Yuumi Yoshida
                  #@"SELECT no, name, g FROM player WHERE pos=',pos' ORDER by no"
79 1 Yuumi Yoshida
                  "SELECT no, name, g FROM player ORDER by no"))
80
         (res  (dbi-do conn sql))
81
         (getter (relation-accessor res)))
82
    (display "<html><body>\n" port)
83
    (display "<h2>Asia League Ice Hockey</h2>\n" port)
84
    (display "<table border='1'>" port)
85
    (for-each
86
     (lambda (row)
87
       (display "  <tr>" port)
88 2 Yuumi Yoshida
       (display #@"<td>,(getter row \"no\")</td>" port)
89
       (display #@"<td>,(getter row \"name\")</td>" port)
90
       (display #@"<td>,(getter row \"g\")</td>" port)
91 1 Yuumi Yoshida
       (display "</tr>\n" port))
92
     res)
93
    (dbi-close conn)
94
    (display "</table></body></html>\n" port)
95
    (get-output-string port)))
96 2 Yuumi Yoshida
</pre>