Commits

carl douglas  committed 303f0ee

Added place holder syntax, and polymorphic arguments for underlying
access to MYSQL connection pointer. Included wiki page in the doc
directory.

  • Participants
  • Parent commits e36e3dd

Comments (0)

Files changed (6)

 scm-mysql-example: README
 	csc -o scm-mysql-example README
 
+test:
+	salmonella --this-egg
+
 clean:
 	rm -v -f mysql-client.so mysql-client.o mysql-client.c \
 	  mysql-client.import.scm \
 	  mysql-client.import.so mysql-client.import.o mysql-client.import.c \
 	  scm-mysql-example
 
-.PHONY: clean 
+.PHONY: all install clean 
 
 ; A minimal MySQL client library for chicken-scheme.
 ;
 ; Requires MySQL database system development components,
-; libmysqlclient and mysql_config.
+; libmysqlclient and mysql_config. The mysql_config
+; program needs to be in the $PATH.
 ;
 ; To install, from the directory containing mysql-client.setup:
 ;
 ;
 ;   make
 ;   ./scm-mysql-example
+;
+; 
+; To escape parameters used in a query, a placeholder
+; syntax can be used, and an association list provided.
+;
+; Example:
+
+;   (sql "SELECT * FROM t1 WHERE c1 = $1 AND c2 = $2" '(($1 . "value1") ($2 . "value2")))
+;
+; For access to the underlying MYSQL connection pointer object,
+; pass a procedure rather than a string. The provided procedure will 
+; be called with the connection pointer as the first argument.
+; 
+; Example:
+;
+;   (sql (lambda(c) (printf "Connection pointer: ~S~%" c)))
+;
 
 (use mysql-client)
 

File doc/mysql-client.wiki

+== MySQL client
+
+=== Description
+
+A small MySQL client library for chicken-scheme. This egg makes it possible to execute an SQL query on a MySQL database.
+
+=== Authors
+
+A. Carl Douglas
+
+=== Requirements
+
+Requires MySQL database system development components,
+libmysqlclient and mysql_config.
+
+The {{mysql_config}} program needs to be in the {{$PATH}} so the linker can find the native MySQL libraries.
+
+On a Linux machine, consider trying:
+
+  apt-get install libmysqlclient-dev
+
+The mysql-client egg also has a runtime dependency on the regex egg.
+
+
+=== API
+
+<procedure>(make-mysql-connection hostname username password schema)</procedure>
+
+This procedure will return a procedure that contains a closed off MySQL connection and can execute a query when called.
+
+=== Examples
+
+Here is a trivial example:
+
+  (use mysql-client)
+  (define mysql (make-mysql-connection "localhost" "root" #f "information_schema"))
+  (define fetch (mysql "SELECT * FROM schemata"))
+  (display (fetch))
+  (newline)
+
+
+Here is an example that will use the {{mysql_real_escape_string}} MySQL function to safely escape parameters in the query string using a placeholder syntax. In this case, the first argument is a string containing an SQL query, and the second argument will be an association list where the key represents the placeholder symbol in the query.
+
+  (use mysql-client)
+  (define mysql (make-mysql-connection "localhost" "username" "secret" "database"))
+  (define fetch (mysql "SELECT * FROM t1 WHERE c1 = '$1' OR c2 = '$2'" 
+                       '(($1 . "value 1';' ;")($2 . "value 2'; drop database; "))))
+  (display (fetch))
+  (newline)
+
+
+For power users, to access directly the MySQL connection object pointer, pass a procedure to the MySQL client closure.
+
+  (use mysql-client)
+  (define mysql (make-mysql-connection "localhost" "username" "secret" "database"))
+  (define fetch (mysql (lambda(c)(printf "~S ~%" c))))
+  (display (fetch))
+  (newline)
+
+=== License
+
+Copyright (C) 2012, A. Carl Douglas
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.
+Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+Neither the name of the author nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+=== Version History
+
+* 0.4  Initial publication
+
+

File mysql-client.meta

  (category db)
  (author "A. Carl Douglas")
  (synopsis "A MySQL client library.")
+ (depends regex)
  (files "mysql-client.scm" "mysql-client.setup"))

File mysql-client.scm

 
 (module mysql-client (make-mysql-connection)
         (import scheme chicken foreign)
+        (use srfi-1 regex)
 
 (define (make-mysql-connection host user pass database)
   (define mysql-c (make-mysql-c-connection host user pass database))
-  (set-finalizer! mysql-c 
-                  (lambda(x) 
-                    (close-mysql-c-connection mysql-c)))
-  (define (mysql-query sql)
-    (define result-c (mysql-c-query mysql-c sql))
-    (define (fetch-c)(let ((row (mysql-c-fetch-row result-c)))
-                        (if (> (length row) 0)
-                            row
-                            #f)))
-    (set-finalizer! result-c
-                    (lambda(x)
-                      (mysql-c-free-result result-c)))
-    fetch-c)
+  (set-finalizer! mysql-c (lambda(x) (close-mysql-c-connection mysql-c)))
+  (define (mysql-query query . parameters)
+    (cond ((and (string? query)(equal? parameters '())) (dispatch-query mysql-c query parameters))
+          ((string? query) (dispatch-query mysql-c query (car parameters)))
+          ((procedure? query) (dispatch-proc mysql-c query parameters))
+          (else (error "unrecognised query object: " query))))
   mysql-query)
 
+(define (dispatch-query conn query parameters)
+  (define result-c 
+    (cond ((equal? '() parameters) (mysql-c-query conn query))
+          (else (mysql-c-query conn (escape-placeholder-params conn query parameters)))))
+  (define (fetch-c)(let ((row (mysql-c-fetch-row result-c)))
+                      (if (> (length row) 0) row #f)))
+  (set-finalizer! result-c (lambda(x) (mysql-c-free-result result-c)))
+  fetch-c)
+
+(define (dispatch-proc conn proc . parameters)
+  (proc conn parameters))
+
+(define (escape-placeholder-params conn query parameters)
+  (let ((escaped-parameters (map (lambda(x)
+                                   (cons (string-append "\\" (symbol->string (car x))) (mysql-c-real-escape-string conn (cdr x))))
+                                 parameters)))
+       (string-substitute* query escaped-parameters)))
+
 (foreign-declare "#include \"mysql.h\"")
 
+(define mysql-c-real-escape-string
+  (foreign-lambda* c-string ((c-pointer conn) (c-string str))
+#<<END
+  char *dst = NULL;
+  unsigned long len1 = 0, len2 = 0;
+  len1 = strlen(str) * 2 + 1;
+  dst = (char *)calloc(len1, sizeof(char));
+  if (dst == NULL) {
+    fprintf(stderr, "out of memory\n");
+    return(C_SCHEME_FALSE);
+  }
+  len2 = mysql_real_escape_string(conn, dst, str, strlen(str));
+  return(dst);
+END
+))
+
 (define mysql-c-fetch-row
   (foreign-lambda* c-string-list* ((c-pointer result))
 #<<END
   (foreign-primitive c-pointer ((c-pointer conn) (c-string sql))
 #<<END
   MYSQL_RES *result;
+
+  fprintf (stderr, "MYSQL QUERY: %s\n", sql);
+
   int rc = mysql_query(conn, sql);
 
   if (mysql_errno(conn) != 0) {

File tests/run.scm

-(use mysql-client)
+(use mysql-client lolevel)
 
 (define mysql 
-  (make-mysql-connection "localhost" "root" "" "information_schema"))
+  (make-mysql-connection "localhost" "root" #f "information_schema"))
+(define fetch (mysql "select * from schemata"))
 (define (fetch-loop)
   (let ((row (fetch)))
     (if row
       (begin
         (printf "~A~%" row)
         (fetch-loop)))))
+(fetch-loop)
+
+(if (not (pointer? (mysql (lambda(c . a) c))))
+  (error "closure did not dispatch connection object"))
+
+(define fetch2 (mysql "select * from tables where table_name = '$1' or table_name = '$2'" 
+                      '(($1 . "reads")($2 . "'unknown'"))))
+(printf "~A~%" (fetch2))