fixedpoint.jp

#!/usb/bin/env ypsilon
#!r6rs

(import (rnrs)
        (only (srfi :13) string-prefix-ci?)
        (only (srfi :48) format)
        (ypsilon ffi)
        (ypsilon mysql))

(define NULL 0)
(define host "localhost")
(define user "root")
(define passwd "...")
(define database "mysql")
(define mysql)

(define (report-error cont)
  (format (current-error-port) "; ~a~%" (mysql_error mysql))
  (flush-output-port (current-error-port))
  (cont 1))

(define query "SELECT * FROM user")
;; (define query "desc user")
;; (define query "show databases")
;; (define query "show tables")

(define (execute query cont)
  (if (not (zero? (mysql_query mysql query)))
      (report-error cont))
  (cond ((or (string-prefix-ci? "SELECT" query)
             (string-prefix-ci? "SHOW" query)
             (string-prefix-ci? "DESC" query))
         (let ((result (mysql_store_result mysql)))
           (dynamic-wind
               (lambda ()
                 (if (zero? result)
                     (report-error cont)))
               (lambda ()
                 (let ((n (mysql_num_fields result)))
                   (let lp ((row (mysql_fetch_row result)))
                     (if (zero? row)
                         (cont 0))
                     (let ((ls (mysql_fetch_lengths result)))
                       (let ilp ((i 0)
                                 (r '()))
                         (cond ((= i n)
                                (format #t "~s~%" (reverse r))
                                (lp (mysql_fetch_row result)))
                               (else
                                (let* ((f (c-void*-ref (+ row (* i sizeof:void*))))
                                       (v (if (zero? f)
                                              'NULL
                                              (utf8->string
                                               (make-bytevector-mapping f (c-unsigned-int-ref (+ ls (* i sizeof:int))))))))
                                  (ilp (+ i 1) (cons v r))))))))))
               (lambda ()
                 (mysql_free_result result)))))))

(define (main cont)
  (if (zero? (mysql_real_connect mysql host user passwd database 0 NULL 0))
      (report-error cont))
  (format #t ";; ~a\n" (mysql_stat mysql))
  (execute query cont))

(exit
 (call/cc
  (lambda (cont)
    (dynamic-wind
        (lambda ()
          (set! mysql (mysql_init NULL))
          (display ";;; initialized.")
          (newline))
        (lambda ()
          (main cont))
        (lambda ()
          (mysql_close mysql)
          (display ";;; closed.")
          (newline)))
    0)))