Commits

carl douglas committed 0c0798c Merge

Merged in sjamaan/mysql-client.egg (pull request #1)

More flexible connection support and removal of annoying printf-statements

Comments (0)

Files changed (2)

 ;   (fetch)
 ;
 ; Provide password as #f to use the password from the .my.cnf
-; options file (/home/user/.my.cnf). 
+; options file (/home/user/.my.cnf).   If host is #f, it will
+; try to connect via a socket (same as "localhost", which differs
+; from "127.0.0.1").  If user is #f, it will connect as the current
+; UNIX user.
 ;
 ; Example .my.cnf:
 ;
 ;   user=root
 ;   password=secret
 ;
+; To connect to a host on a nonstandard port or socket, use the port: or
+; socket: keywords.  For example, to connect to socket /tmp/mysql.socket:
+; (define mysql (make-mysql-connection
+;                 #f "user" "pass" "schema" socket: "/tmp/mysql.socket"))
 
 (module mysql-client (make-mysql-connection mysql-null mysql-null?)
         (import scheme chicken foreign)
         (use irregex data-structures)
 
-(define (make-mysql-connection host user pass database)
-  (define mysql-c (make-mysql-c-connection host user pass database))
+(define (make-mysql-connection host user pass database #!key port socket)
+  (define mysql-c (make-mysql-c-connection host user pass database
+                                           (or port 0) socket))
   (set-finalizer! mysql-c close-mysql-c-connection)
 
+  ;; XXX Should the password be in the arguments list?
+  ;; It'll appear in the error trace.  OTOH, it's important that
+  ;; we can debug how/why it went wrong.
+  (mysql-check-error mysql-c 'make-mysql-connection
+                     `(,host ,user ,pass ,database
+                             ,@(if port (list port: port) '())
+                             ,@(if socket (list socket: socket) '())))
+
   (define (mysql-query query . parameters)
     (cond ((procedure? query)(mysql-query-with-proc mysql-c query parameters))
           ((string? query)   (mysql-query-with-string mysql-c query parameters))
         ((pair? parameters) (execute-query mysql-c (escape-parameters mysql-c query (car parameters))))
         (else (error "unrecognised parameter object: " parameters))))
 
+
+(define-inline (fetch-row result-c)
+  (or (mysql-c-fetch-row result-c)
+      ;; result-c could also be NULL, but that should
+      ;; never be possible in a normal situation.
+      (error "Out of memory while fetching row")))
+
 (define (execute-query mysql-c query)
   (define result-c (mysql-c-query mysql-c query))
+  (mysql-check-error mysql-c 'execute-query query)
   (set-finalizer! result-c mysql-c-free-result)
-  (define (fetch . fetch-args)
-    (cond ((null? fetch-args)
-             (let ((row (mysql-c-fetch-row result-c)))
-                  (if (pair? row) row #f)))
-          ((pair? fetch-args)
-             (fetch-loop result-c (car fetch-args)))))
-  (if result-c fetch (lambda r #f)))
+  (if (not result-c)
+      (constantly #f)
+      (lambda fetch-args
+        (cond ((null? fetch-args)
+               (let ((row (fetch-row result-c)))
+                 (and (pair? row) row)))
+              ((pair? fetch-args)
+               (fetch-loop result-c (car fetch-args)))))))
 
 (define (fetch-loop result-c thunk)
   (let process ()
-       (let ((row (mysql-c-fetch-row result-c)))
-            (if (pair? row)
-               (begin
-                 (thunk row)
-                 (process))))))
+    (let ((row (fetch-row result-c)))
+      (when (pair? row)
+        (thunk row)
+        (process)))))
 
 (define (make-irx parameters)
   (flatten (list 'or (map (lambda(x) (car x)) parameters))))
       (make-irx stringified-keys) 
       query 
       (lambda(r)
-        (mysql-c-real-escape-string mysql-c 
-          (alist-ref (irregex-match-substring r 0) stringified-keys string=?))))))
+        (or (mysql-c-real-escape-string
+             mysql-c (alist-ref (irregex-match-substring r 0)
+                                stringified-keys string=?))
+            (error "Out of memory while escaping parameter"))))))
 
 (define mysql-null (make-parameter "(NULL)"))
 
   len1 = strlen(str) * 2 + 1;
   dst = (char *)calloc(len1, sizeof(char));
   if (dst == NULL) {
-    fprintf(stderr, "out of memory\n");
     return(NULL);
   }
   len2 = mysql_real_escape_string(conn, dst, str, strlen(str));
   row = mysql_fetch_row(result);
   fields = (char **)calloc(num_fields + 1, sizeof(char *));
   if (fields == NULL) {
-    fprintf(stderr, "out of memory\n");
     return(NULL);
   }
   for (;row && index--;) {
 #<<END
   MYSQL_RES *result;
 
-  fprintf (stderr, "MYSQL QUERY: %s\n", sql);
-
-  int rc = mysql_query(conn, sql);
-
-  if (mysql_errno(conn) != 0) {
-    fprintf (stderr, "MYSQL ERROR: %d %s\n", 
-            mysql_errno(conn), mysql_error(conn));
-  }
-
-  if (rc != 0) {
+  if (mysql_query(conn, sql) != 0) {
     return(NULL); /*C_return(C_SCHEME_FALSE);*/
   }
 
     (c-string host)
     (c-string user)
     (c-string pass)
-    (c-string database))
+    (c-string database)
+    (int port)
+    (c-string socket))
 #<<END
   MYSQL *conn;
   conn = mysql_init(NULL);
   mysql_options(conn, MYSQL_READ_DEFAULT_GROUP, "client");
-  mysql_real_connect(conn, host, user, pass, database, 0, NULL, 0);
-  if (mysql_errno(conn) != 0) {
-    fprintf (stderr, "MYSQL ERROR: %d %s\n", 
-            mysql_errno(conn), mysql_error(conn));
-  }
+  mysql_real_connect(conn, host, user, pass, database, port, socket, 0);
   return(conn);
 END
 ))
 
+(define (mysql-check-error mysql-c loc . args)
+  (let ((errno ((foreign-lambda int "mysql_errno" c-pointer) mysql-c)))
+    (unless (zero? errno)
+      (let ((msg ((foreign-lambda c-string "mysql_error" c-pointer) mysql-c)))
+        (signal (make-composite-condition
+                 (make-property-condition
+                  'exn 'location loc 'message msg 'arguments args)
+                 (make-property-condition
+                  'mysql 'errno errno 'error msg)))))))
 )
 
 (define-syntax exec-sql
   (syntax-rules ()
-      ((_ sql ...) (begin 
-                     ((mysql sql ...) (lambda r (printf "~A~%" r)))))))
+    ((_ sql ...)
+     (begin
+       ((mysql sql ...) (lambda r (printf "~A~%" r)))))))
+
+(define-syntax assert-mysql-error
+  (syntax-rules ()
+    ((_ code ...)
+     (assert (condition-case
+              (begin code ... #f)
+              ((exn mysql) #t))))))
+
+(assert-mysql-error (exec-sql "gibberish"))
 
 (exec-sql "CREATE DATABASE IF NOT EXISTS chicken_scheme_mysql_client_test")
 (exec-sql "USE chicken_scheme_mysql_client_test")
 (exec-sql
 #<#SQL
-  CREATE TABLE IF NOT EXISTS `scheme_test` (
+  CREATE TEMPORARY TABLE IF NOT EXISTS `scheme_test` (
     `created_at`   TIMESTAMP,
     `name`         VARCHAR(32)
   )
           '(($name . "hello%2")))
 (exec-sql "INSERT INTO scheme_test (created_at, name) VALUES (NOW(), NULL)") 
 (exec-sql "SELECT * FROM scheme_test")
-
 (assert (mysql-null? "(NULL)"))
-(mysql-null "(ANOTHER NULL)")
 
+(let ((result '()))
+  ((mysql "SELECT name FROM scheme_test ORDER BY name")
+   (lambda (r)
+     (set! result (cons (car r) result))))
+  (assert (equal? result '("hello%2" "hell'o1" "(NULL)"))))
+
+(mysql-null "(ANOTHER NULL)")
 (assert (mysql-null? "(ANOTHER NULL)"))
-(exec-sql "SELECT * FROM scheme_test")
+(let ((result '()))
+  ((mysql "SELECT name FROM scheme_test ORDER BY name")
+   (lambda (r)
+     (set! result (cons (car r) result))))
+  (assert (equal? result '("hello%2" "hell'o1" "(ANOTHER NULL)"))))
 
-(exec-sql "DROP DATABASE chicken_scheme_mysql_client_test")
 (exec-sql "USE information_schema")
-
+(exec-sql "DROP DATABASE chicken_scheme_mysql_client_test")
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.