プロジェクト

全般

プロフィール

SourceThird » 履歴 » バージョン 3

Yuumi Yoshida, 2015-08-03 22:24

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