プロジェクト

全般

プロフィール

履歴

SourceThird » 履歴 » リビジョン 2

リビジョン 1 (Yuumi Yoshida, 2008-06-04 22:02) → リビジョン 2/3 (Yuumi Yoshida, 2008-06-04 22:02) 

リスト１：ＲＤＢプログラム 
 <pre> {{{ 
 (use dbi) 
 (use gauche.collection) 

 (define (print-goal)  
   (let* ((conn (dbi-connect "dbi:sqlite3:alih.db")) 
          (res    (dbi-do conn 
                        "SELECT no, name, g FROM player WHERE pos='F' ORDER BY g desc")) 
          (getter (relation-accessor res))) 
     (for-each 
      (lambda (row) 
        (format #t "~3d ~22a ~5d\n"   
                (getter row "no") 
                (getter row "name") 
                (getter row "g"))) 
      res) 
     (dbi-close conn))) 

 (print-goal) 
 </pre> }}} 

 図１：GaucheでWebサーバー 
 <pre> {{{ 
 (use gauche.net)  
 (use rfc.uri)  
 (use www.cgi)  

 (define (web-server) 
   (let ((server-socket (make-server-socket 'inet 3030 :reuse-addr? #t))) 
     (while #t 
       (let ((client-socket (socket-accept server-socket))) 
         (receive (path params)    (get-request (socket-input-port client-socket)) 
           (put-response (render path params) 
                     (socket-output-port client-socket))) 
         (socket-close client-socket))))) 
      
 (define (get-request in-port) 
   (cond ((rxmatch #/^GET\s+(\S+)\s/ (read-line in-port))  
          => (lambda (m)  
               (parse-uri (rxmatch-substring m 1)))) 
         (else (values "" ())))) 

 (define (parse-uri uri) 
   (receive (host path query fragment) (uri-decompose-hierarchical uri)  
     (values path (cgi-parse-parameters :query-string (or query ""))))) 

 (define (put-response content out-port) 
   (display "HTTP/1.1 200 OK\r\n" out-port)  
   (display "Content-Type: text/html; charset=utf-8\r\n" out-port)  
   (display #@"Content-Length: #`"Content-Length: ,(string-size content)\r\n" out-port)  
   (display "\r\n" out-port)  
   (display content out-port)) 

 (define (render path params)  
   (let ((port (open-output-string))) 
     (display "<html><body>\n" port) 
     (display "<h1>simple web server</h1>\n" port) 
     (display #@"path: #`"path: ,path <br>\n" port) 
     (for-each (lambda (p) 
                 (display #@" #`"    ,(car p) : ,(cdr p) <br>\n" port)) 
               params) 
     (display "</body></html>\n" port) 
     (get-output-string port))) 

 (web-server) 
 </pre> }}} 

 図３： GaucheでWebアプリ 
 <pre> {{{ 
 (use dbi) 
 (use gauche.collection) 
 (define (render path params)  
   (let* ((port (open-output-string)) 
          (conn (dbi-connect "dbi:sqlite3:alih.db")) 
          (pos (cgi-get-parameter "pos" params)) 
          (sql (if (and pos (rxmatch #/^[DFG]$/ pos)) 
                   #@"SELECT #`"SELECT no, name, g FROM player WHERE pos=',pos' ORDER by no" 
                   "SELECT no, name, g FROM player ORDER by no")) 
          (res    (dbi-do conn sql)) 
          (getter (relation-accessor res))) 
     (display "<html><body>\n" port) 
     (display "<h2>Asia League Ice Hockey</h2>\n" port) 
     (display "<table border='1'>" port) 
     (for-each 
      (lambda (row) 
        (display "    <tr>" port) 
        (display #@"<td>,(getter #`"<td>,(getter row \"no\")</td>" port) 
        (display #@"<td>,(getter #`"<td>,(getter row \"name\")</td>" port) 
        (display #@"<td>,(getter #`"<td>,(getter row \"g\")</td>" port) 
        (display "</tr>\n" port)) 
      res) 
     (dbi-close conn) 
     (display "</table></body></html>\n" port) 
     (get-output-string port))) 
 </pre> }}}