Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 611 lines (543 sloc) 27.16 kb
e9950d9 Kanen Flowers first commit
authored
1 ;; @module Mysql
e2bb587 Kanen Flowers Ego commit
authored
2 ;; @author Jeff Ober <jeffober@gmail.com>, Kanen Flowers <kanendosei@gmail.com>
e9950d9 Kanen Flowers first commit
authored
3 ;; @version 1.05 beta
4 ;; @location http://static.artfulcode.net/newlisp/mysql.lsp
5 ;; @package http://static.artfulcode.net/newlisp/mysql.qwerty
6 ;; @description A new MySQL module to replace the distribution standard module (requires newlisp 10).
7 ;; The Mysql module has been written from scratch utilizing some of the more
8 ;; recent features of newLisp, such as FOOP and reference returns. One of its
9 ;; major design goals was to simplify use as well as broaden the features of
10 ;; the standard MySQL module, while at the same time allowing the creation of
11 ;; new, anonymous instances at run-time.
12 ;;
13 ;; The Mysql module differs from the distribution standard module in several
14 ;; important ways. Most obviously, it uses FOOP wrappers for MySQL types. It
15 ;; also requires clients to free results instances; in the standard module,
16 ;; only the base MYSQL instance itself must be freed (using MySQL:close-db).
17 ;;
18 ;; The significance of this is that it is much simpler to create multiple
19 ;; connections (without having to duplicate the entire context at compile
20 ;; time). Result sets are completely independent of each other, and several may
21 ;; be maintained in any state at once. This also means that a spawned process
22 ;; may be given its own Mysql instance to use without having to worry about
23 ;; other processes' instances interfering. Using the standard module, the
24 ;; entire context would need to be cloned at compile time and given a static
25 ;; symbol reference (e.g., (new 'MySQL 'db)) in order to run multiple instances
26 ;; or connections to a server.
27 ;;
28 ;; Moreover, because this module uses unpack and MySQL C API accessor
29 ;; functions, there is no need for the client to calculate member offsets in
30 ;; MySQL compound types. So long as newLisp was compiled for the same target as
31 ;; the libmysqlclient library (both are 32 bit or both are 64 bit), everything
32 ;; should work out of the box. Additionally, MySQL errors are now checked in
33 ;; the connect and query functions and re-thrown as interpreter errors. Instead
34 ;; of checking for nil returns and a using MySQL:error to get the error
35 ;; message, standard error handling with the catch function may be used.
36 ;;
37 ;; This module has been tested with MySQL version 5 and 5.1 and newLisp version
38 ;; 10.0.1. It requires newLisp 10.0 or later.
39 ;;
40 ;; <h3>Changelog</h3>
41 ;; <b>1.05</b>
42 ;; &bull; Mysql:query now checks if client mistakenly sent single, non-list, argument for format-args
43 ;;
44 ;; <b>1.04</b>
45 ;; &bull; fixed error in documentation example
46 ;; &bull; changed Mysql:query to allow lists as format parameters
47 ;; &bull; backward-incompatible change to Mysql:query parameter list
48 ;; &bull; added Mysql:coerce-type as an independent function
49 ;;
50 ;; <b>1.03</b>
51 ;; &bull; fixed truncation bug when inserting binary data in Mysql:query
52 ;;
53 ;; <b>1.02</b>
54 ;; &bull; field types are now correctly distinguished when MySQL is compiled with 64-bit pointers
55 ;; &bull; refactored MysqlResult:get-row
56 ;;
57 ;; <b>1.01</b>
58 ;; &bull; fixed invalid function in Mysql:tables, Mysql:fields, and Mysql:databases
59 ;;
60 ;; <b>1.0</b>
61 ;; &bull; initial release
62 ;;
63 ;; <h3>Known bugs</h3>
64 ;; &bull; None (at the moment); <i>please let me know if you find any!</i>
65 ;;
66 ;;
67 ;; @example
68 ;; &bull; Imperative usage
69 ;;
70 ;; (setf db (Mysql)) ; initialize Mysql instance
71 ;; (:connect db "localhost" "user" "secret" "my_database") ; connect to a server
72 ;; (setf result (:query db "SELECT * FROM some_table")) ; evaluate a query
73 ;; (setf rows (:fetch-all result)) ; generate a result
74 ;; (:close-db db) ; free the database
75 ;;
76 ;; &bull; Functional usage with the 'mysql context
77 ;;
78 ;; (mysql:on-connect '("localhost" "user" "secret" "my_database")
79 ;; (lambda (db err)
80 ;; (if err (throw-error err))
81 ;; (mysql:row-iter db "SELECT * FROM some_table" nil
82 ;; (lambda (row)
83 ;; (println row)))))
84
85 ;;;============================================================================
86 ;;; MyCType: a base class providing a basic framework for working with
87 ;;; MySQL C types and functions
88 ;;;============================================================================
89
90 (setf MyCType:pack-format nil)
91
92 (define (MyCType:MyCType addr)
93 (list (context) addr))
94
95 (define (MyCType:pointer inst)
96 (inst 1))
97
98 (define (MyCType:members inst)
99 (unpack MyCType:pack-format (:pointer inst)))
100
101 (define (MyCType:member inst n , unpacked)
102 (nth n (:members inst)))
103
104 ;;;============================================================================
105 ;;; Utility functions and macros
106 ;;;============================================================================
107
108 (unless if-not-zero
109 (define-macro (if-not-zero)
110 "If the first argument is not zero, evaluates the rest of the arguments.
111 Useful for checking if the return argument of a C function is non-NULL."
112 (letex ((ptr (eval (args 0))) (body (cons 'begin (rest (args)))))
113 (if-not (zero? ptr)
114 body
115 nil)))
116
117 (constant (global 'if-not-zero)))
118
119 ;;;============================================================================
120 ;;; Pre-declare classes and contexts to prevent circular dependencies
121 ;;;============================================================================
122
123 (new 'MyCType 'Mysql)
124 (new 'MyCType 'MysqlField)
125 (new 'MyCType 'MysqlResult)
126
127 (sym "_mysql" '_MYSQL)
128
129 ;;;============================================================================
130 ;;; _MYSQL context stores API functions from libmysqlclient
131 ;;;============================================================================
132
133 (context '_MYSQL)
134
135 ;;; Find the libmysqlclient library on this system
136 (setf is-64-bit nil)
137 (let ((paths '("/usr/lib/libmysqlclient.so"
138 "/usr/lib64/mysql/libmysqlclient.so"
139 "/usr/local/mysql/lib/libmysqlclient.dylib"
140 "/opt/local/lib/libmysqlclient.dylib"
141 "/sw/lib/libmysqlclient.dylib")))
142 (constant 'libmysqlclient
143 (catch
144 (dolist (path paths)
145 (when (file? path)
146 (if (find "lib64" path) ; some pack formats depend on this
147 (setf is-64-bit true))
148 (throw path))))))
149
150 ;;; Import library functions
151 (import libmysqlclient "mysql_affected_rows")
152 (import libmysqlclient "mysql_close")
153 (import libmysqlclient "mysql_error")
154 (import libmysqlclient "mysql_free_result")
155 (import libmysqlclient "mysql_init")
156 (import libmysqlclient "mysql_insert_id")
157 (import libmysqlclient "mysql_real_connect")
158 (import libmysqlclient "mysql_real_query")
159 (import libmysqlclient "mysql_store_result")
160 (import libmysqlclient "mysql_num_fields")
161 (import libmysqlclient "mysql_fetch_field")
162 (import libmysqlclient "mysql_num_rows")
163 (import libmysqlclient "mysql_fetch_row")
164 (import libmysqlclient "mysql_fetch_lengths")
165 (import libmysqlclient "mysql_fetch_field_direct")
166 (import libmysqlclient "mysql_real_escape_string")
167
168 (context 'MAIN)
169
170 ;;;============================================================================
171 ;;; Mysql: An independent MySQL connection
172 ;;;============================================================================
173
174 ;; @syntax (Mysql)
175 ;; <p>Returns a new Mysql instance that can safely be used in tandem with other
176 ;; Mysql instances.</p>
177 (define (Mysql:Mysql , ptr)
178 (setf ptr (_MYSQL:mysql_init 0))
179 (if-not-zero ptr
180 (list Mysql ptr)))
181
182 ;; @syntax (:connect <Mysql-instance> <str-host> <str-user> <str-pass> <str-db> <int-port> <str-socket>)
183 ;; @param <Mysql-instance> an instance of the Mysql class
184 ;; @param <str-host> the hostname to connect to
185 ;; @param <str-user> a MySQL username
186 ;; @param <str-pass> <str-user>'s password
187 ;; @param <str-db> the database to initially connect to
188 ;; @param <int-port> (optional) port number of the MySQL server
189 ;; @param <int-str> (optional) socket file to connect through
190 ;; <p>Connects an initialized Mysql instance to a database. Returns <true> if
191 ;; successful logging in, <nil> if not.</p>
192 ;; @example
193 ;; (setf db (Mysql))
194 ;; (:connect db "localhost" "user" "secret" "my-database")
195 ;; => true
196
197 (define (Mysql:connect inst host user pass db (port 0) (socket 0) , result)
198 "Connects to a MySQL database. Throws an error on failure."
199 (setf result (_MYSQL:mysql_real_connect (:pointer inst) host user pass db port socket 0))
200 (if (zero? result)
201 (throw-error (:error inst))
202 true))
203
204 ;; @syntax (:close <Mysql-instance>)
205 ;; @param <Mysql-instance> an instance of the Mysql class
206 ;; <p>Closes the connection and frees any memory used. This does <not> free the memory
207 ;; used by results sets from this connection.</p>
208 (define (Mysql:close-db inst)
209 (_MYSQL:mysql_close (:pointer inst)))
210
211 ;; @syntax (:error <Mysql-instance>)
212 ;; @param <Mysql-instance> an instance of the Mysql class
213 ;; <p>Returns the last error message as a string or <nil> if there is none.</p>
214 (define (Mysql:error inst , ptr str)
215 (setf ptr (_MYSQL:mysql_error (:pointer inst)))
216 ; mysql_error always returns a valid string. If there is no error,
217 ; the string will be empty.
218 (setf str (get-string ptr))
219 (if (= "" str) nil str))
220
221 ;; @syntax (:coerce-type <Mysql-instance> <object>)
222 ;; @param <Mysql-instance> an instance of the Mysql class
223 ;; @param <object> a newLisp object
224 ;; <p>Coerces <object> into something safe to use in a SQL statement. Lists are
225 ;; converted into MySQL lists (e.g. '("foo" "bar" "baz") to
226 ;; ('foo', 'bar', 'baz')) and string values are escaped. This is a helper
227 ;; function for <Mysql:query>.</p>
228 (define (Mysql:coerce-type inst value)
229 (cond
230 ((nil? value) "NULL")
231 ((or (= value "null") (= value "NULL")) value)
232 ((number? value) value)
233 ; Here the string must be packed to be sure that it is not truncated.
234 ((string? value) (format "'%s'" (:escape inst (pack (format "s%d" (length value)) value))))
235 ((list? value) (string "(" (join (map string (map (curry Mysql:coerce-type inst) value)) ", ") ")"))
236 (true (format "'%s'" (:escape inst (string value))))))
237
238 ;; @syntax (:query <Mysql-instance> <str-statement> [<lst-format-args>])
239 ;; @param <Mysql-instance> an instance of the Mysql class
240 ;; @param <str-statement> a SQL statement to execute
241 ;; @param <lst-format-args> format arguments to the SQL statement
242 ;; <p>Executes <str-statement>. Throws an error if the statement fails with the
243 ;; reason. If the statement returns results, a <MysqlResult> class instance is
244 ;; returned. Otherwise, returns the number of affected rows.</p>
245 ;; <p>If <lst-format-args> is specified, all parameters are escaped (as
246 ;; necessary) to generate safe, valid SQL. No quoting of values is required in
247 ;; the format string; quotes are inserted as needed. To generate a
248 ;; NULL in the SQL statement, pass <nil> or the string "NULL".</p>
249 ;; @example
250 ;; (:query db "SELECT name, employee_id FROM employees")
251 ;; => (MysqlResult 1069216)
252 ;;
253 ;; (:query db "DELETE FROM employees WHERE fired = 1")
254 ;; => 14
255 ;;
256 ;; (:query db '("SELECT id FROM employees WHERE name = %s" '("Johnson, John")))
257 ;; ; SQL generated: SELECT id FROM employees WHERE name = 'Johnson, John'
258 ;; => (MysqlResult 1069216)
259
260 (define (Mysql:query inst sql format-args , res ptr err params)
261 (unless (or (null? format-args) (list? format-args))
262 (throw-error "Format args must be passed to Mysql:query as a list!"))
263
264 (when (list? format-args)
265 (setf format-args (map (fn (v) (:coerce-type inst v)) format-args))
266 (setf sql (format sql format-args)))
267
268 (setf res (_MYSQL:mysql_real_query (:pointer inst) sql (+ 1 (length sql))))
269 (if (zero? res)
270 (begin
271 ; Always attempt to store result firt. This does not degrade performance
272 ; for non-result-returning queries (according to the MySQL C API docs).
273 (setf ptr (_MYSQL:mysql_store_result (:pointer inst)))
274 ; If mysql_store_result returns a null pointer, it may be an error or
275 ; just mean that a query has no results (e.g. INSERT, DELETE, UPDATE).
276 ; Error status requires a combination of a null pointer and a result
277 ; from error.
278 (when (and (zero? ptr) (setf err (:error inst)))
279 (throw-error err))
280 ; Otherwise, return an appropriate value. In the case of a non-result-
281 ; returning query, return the number of affected rows. Otherwise, return
282 ; a MysqlResult instance.
283 (if (zero? ptr)
284 (:affected-rows inst)
285 (MysqlResult ptr)))
286 ; mysql_real_query returns non-zero in case of an error.
287 (throw-error (:error inst))))
288
289 ;; @syntax (:insert-id <Mysql-instance>)
290 ;; @param <Mysql-instance> an instance of the Mysql class
291 ;; <p>Returns the id of the last inserted row when the target table contains
292 ;; an AUTOINCREMENT field.</p>
293 (define (Mysql:insert-id inst)
294 (_MYSQL:mysql_insert_id (:pointer inst)))
295
296 ;; @syntax (:affected-rows <Mysql-instance>)
297 ;; @param <Mysql-instance> an instance of the Mysql class
298 ;; <p>Returns the number of rows affected by the most recent query.</p>
299 (define (Mysql:affected-rows inst)
300 (_MYSQL:mysql_affected_rows (:pointer inst)))
301
302 ;; @syntax (:escape <Mysql-instance> <str-value>)
303 ;; @param <Mysql-instance> an instance of the Mysql class
304 ;; @param <str-value> the string to escape
305 ;; <p>Escapes a string to assure safety for use in a SQL statement.</p>
306 (define (Mysql:escape inst str , res)
307 (setf res (dup " " (+ 1 (* 2 (length str)))))
308 (_MYSQL:mysql_real_escape_string (:pointer inst) res str (length str))
309 res)
310
311 ;; @syntax (:databases <Mysql-instance>)
312 ;; @param <Mysql-instance> an instance of the Mysql class
313 ;; <p>Returns a list of the databases on this server.</p>
314 (define (Mysql:databases inst , res)
315 (setf res (:query inst "SHOW DATABASES"))
316 (map first (:fetch-rows res nil)))
317
318 ;; @syntax (:tables <Mysql-instance> <str-database>)
319 ;; @param <Mysql-instance> an instance of the Mysql class
320 ;; @param <str-database> (optional) the database to query for tables
321 ;; <p>Returns a list of tables available on this server. If <str-database> is
322 ;; provided, the list of tables will be limited to that database.
323 (define (Mysql:tables inst db , sql res)
324 (setf sql (if db (format "SHOW TABLES FROM `%s`" db) "SHOW TABLES"))
325 (setf res (:query inst sql))
326 (map first (:fetch-all res nil)))
327
328 ;; @syntax (:fields <Mysql-instance> <str-table>)
329 ;; @param <Mysql-instance> an instance of the Mysql class
330 ;; @param <str-table> the table to display
331 ;; <p>Returns metadata about the fields in <str-table>. The data is the result
332 ;; of a 'SHOW FIELDS' query.</p>
333 (define (Mysql:fields inst table)
334 (setf res (:query inst (format "SHOW FIELDS FROM `%s`" table)))
335 (:fetch-rows res))
336
337 ;;;============================================================================
338 ;;; MysqlResult: The result of a MySQL query
339 ;;;============================================================================
340
341 ;; @syntax (MysqlResult <int-pointer>)
342 ;; @param <int-pointer> a pointer to a MYSQL_RES struct
343 ;; <p>Objects of this class are returned by Mysql:query as a result of queries
344 ;; that generate result sets. This class is not generally instantiated directly
345 ;; by the client.</p>
346
347 ;; @syntax (:free <MysqlResult-instance>)
348 ;; @param <MysqlResult-instance> an instance of the MysqlResult class
349 ;; <p>Frees the memory used by a result. Must be called for each <MysqlResult>
350 ;; generated, even if unused.</p>
351 (define (MysqlResult:free inst)
352 (_MYSQL:mysql_free_result (:pointer inst)))
353
354 ;; @syntax (:num-rows <MysqlResult-instance>)
355 ;; @param <MysqlResult-instance> an instance of the MysqlResult class
356 ;; <p>Returns the number of results in this result.</p>
357 (define (MysqlResult:num-rows inst)
358 (_MYSQL:mysql_num_rows (:pointer inst)))
359
360 (define (MysqlResult:num-fields inst)
361 (_MYSQL:mysql_num_fields (:pointer inst)))
362
363 (define (MysqlResult:column-lengths inst)
364 (_MYSQL:mysql_fetch_lengths (:pointer inst)))
365
366 ;; @syntax (:fields <MysqlResult-instance>)
367 ;; @param <MysqlResult-instance> an instance of the MysqlResult class
368 ;; <p>Returns a list of MysqlField instances corresponding to the columns in
369 ;; this result.</p>
370 (define (MysqlResult:fields inst , n ptr fields)
371 (setf fields '())
372 (setf n (_MYSQL:mysql_num_fields (:pointer inst)))
373 (until (zero? (setf ptr (_MYSQL:mysql_fetch_field (:pointer inst))))
374 (push (MysqlField ptr) fields -1))
375 fields)
376
377 ;; @syntax (:fetch-row <MysqlResult-instance> <as-assoc>)
378 ;; @param <MysqlResult-instance> an instance of the MysqlResult class
379 ;; @param <as-assoc> (optional) whether to return results as a list or association list
380 ;; <p>Returns one row from this result. If <as-assoc> is true, the results will
381 ;; be returned as an association list (true by default). If this is the final row
382 ;; in the result set, the MysqlResult instance is automatically freed.</p>
383 (define (MysqlResult:fetch-row inst (as-assoc true) , ptr num-fields cols lengths row)
384 (setf ptr (_MYSQL:mysql_fetch_row (:pointer inst)))
385 (if-not-zero ptr
386 (setf num-fields (:num-fields inst))
387 (setf cols (unpack (dup "lu" num-fields) ptr)) ; pointers to each column's start
388 (setf lengths (unpack (dup "lu" num-fields) (:column-lengths inst))) ; the length of each column
389 ; We must use the lengths because binary fields might contain null characters,
390 ; which will fool get-string, which grabs chars until it hits a null.
391 (setf row
392 (map (lambda (len col i , value field result)
393 (setf field (MysqlField (_MYSQL:mysql_fetch_field_direct (:pointer inst) i)))
394 (setf value (first (unpack (format "s%d" len) col)))
395 (setf value
396 (case (:type field)
397 ("bigint" (int value))
398 ("bit" (int value 2)) ; untested
399 ("date " (apply date-value (map int (parse value "-"))))
400 ("datetime" (apply date-value (map int (parse value "[-: ]" 0))))
401 ("decimal" (float value))
402 ("double" (float value))
403 ("float" (float value))
404 ("integer" (int value))
405 ("mediumint" (int value))
406 ("null" nil)
407 ("smallint" (int value))
408 ("time" (map int (parse value ":"))) ; does not map to newlisp data type
409 ("timestamp" (apply date-value (map int (parse value "[-: ]" 0))))
410 ("tinyint" (int value))
411 ("year" (int value))
412 (true value)))
413 (if as-assoc (list (:name field) value) value))
414 lengths
415 cols
416 (sequence 0 (- (length cols) 1)))))
417 ; Either return the row value or free the result and return nil.
418 (if (zero? ptr)
419 (begin (:free inst) nil)
420 row))
421
422 ;; @syntax (:fetch-all <MysqlResult-instance> <as-assoc>)
423 ;; @param <MysqlResult-instance> an instance of the MysqlResult class
424 ;; @param <as-assoc> (optional) whether to return results as a list or association list
425 ;; <p>Returns all rows from this result. If <as-assoc> is true, the results
426 ;; will be returned as an association list (true by default).</p>
427 (define (MysqlResult:fetch-all inst (as-assoc true) , rows row)
428 (setf rows '())
429 (setf row (:fetch-row inst as-assoc))
430 (while row
431 (push row rows)
432 (setf row (:fetch-row inst as-assoc)))
433 rows)
434
435 ;;;============================================================================
436 ;;; MysqlField: A field in a MySQL result set
437 ;;;============================================================================
438
439 ;typedef struct st_mysql_field {
440 ; char *name; /* Name of column */
441 ; char *org_name; /* Original column name, if an alias */
442 ; char *table; /* Table of column if column was a field */
443 ; char *org_table; /* Org table name, if table was an alias */
444 ; char *db; /* Database for table */
445 ; char *catalog; /* Catalog for table */
446 ; char *def; /* Default value (set by mysql_list_fields) */
447 ; unsigned long length; /* Width of column (create length) */
448 ; unsigned long max_length; /* Max width for selected set */
449 ; unsigned int name_length;
450 ; unsigned int org_name_length;
451 ; unsigned int table_length;
452 ; unsigned int org_table_length;
453 ; unsigned int db_length;
454 ; unsigned int catalog_length;
455 ; unsigned int def_length;
456 ; unsigned int flags; /* Div flags */
457 ; unsigned int decimals; /* Number of decimals in field */
458 ; unsigned int charsetnr; /* Character set */
459 ; enum enum_field_types type; /* Type of field. See mysql_com.h for types */
460 ;} MYSQL_FIELD;
461
462 ;; @syntax (MysqlField <int-pointer>)
463 ;; @param <int-pointer> a pointer to a MYSQL_FIELD struct
464 ;; <p>Objects of this class are returned by MysqlResult:fields. It is used
465 ;; internally in generating result rows. This class is not generally
466 ;; instantiated directly by the client.</p>
467
468 (setf MysqlField:types ; see mysql_com.h for enum details
469 (map list
470 (append (sequence 0 16) (sequence 246 255))
471 '("decimal" "tinyint" "smallint" "integer" "float" "double" "null" "timestamp"
472 "bigint" "mediumint" "date " "time" "datetime" "year" "newdate" "varchar"
473 "bit" "decimal" "enum" "set" "tiny blob" "medium blob" "long blob" "blob"
474 "varchar" "char" "geometry")))
475
476 (if _MYSQL:is-64-bit
477 (setf MysqlField:pack-format (append (dup "Lu" 9) (dup "lu" 11))) ; use 64-bit pointers
478 (setf MysqlField:pack-format (append (dup "lu" 20))))
479
480 ;; @syntax (:name <MysqlField-instance>)
481 ;; @param <MysqlField-instance> an instance of the MysqlField class
482 ;; <p>Returns the name of this field (or its alias).</p>
483 (define (MysqlField:name inst)
484 (get-string (:member inst 0)))
485
486 ;; @syntax (:table <MysqlField-instance>)
487 ;; @param <MysqlField-instance> an instance of the MysqlField class
488 ;; <p>Returns this field's table (or its alias).</p>
489 (define (MysqlField:table inst)
490 (get-string (:member inst 2)))
491
492 ;; @syntax (:type <MysqlField-instance>)
493 ;; @param <MysqlField-instance> an instance of the MysqlField class
494 ;; <p>Returns this field's type.</p>
495 (define (MysqlField:type inst)
496 (lookup (:member inst 19) MysqlField:types))
497
498 ;;;============================================================================
499 ;;; mysql context contains convenience functions for working with MySQL
500 ;;; databases
501 ;;;============================================================================
502
503 (context 'mysql)
504
505 ;; @syntax (mysql:on-connect <list-credentials> <fn-callback>)
506 ;; @param <list-credentials> a list of parameters to pass to Mysql:connect
507 ;; @param <fn-callback> a function to call with the database connection
508 ;; <p>Connects to a MySQL server using <list-credentials> and calls
509 ;; <fn-callback> using the Mysql instance as the first argument. If an
510 ;; error occurred attempting connection, the error string is passed as the
511 ;; second parameter. The minimum contents of <list-credentials> must be
512 ;; '(<str-host> <str-username> <str-password> <str-database>).</p>
513 ;; <p>The connection is automatically freed when mysql:on-connect returns.</p>
514 ;; @example
515 ;; (mysql:on-connect '("localhost" "user" "secret" "my_database")
516 ;; (lambda (db err)
517 ;; (if err
518 ;; (println "Error! " err)
519 ;; (println "Success! " db))))
520 (define (on-connect credentials func , db err success? result)
521 (setf db (Mysql))
522 (if (catch (eval (append '(:connect db) credentials)) 'err)
523 (setf success? (catch (func db) 'result))
524 (setf success? (catch (func db err) 'result)))
525 (:close-db db)
526 (if success? result (throw-error (replace {(ERR: user error : )+} result "" 0))))
527
528 ;; @syntax (mysql:row-iter <Mysql-instance> <str-sql> <bool-as-assoc> <fn-callback>)
529 ;; @param <Mysql-instance> a connect instance of the Mysql class
530 ;; @param <str-sql> a sql statement
531 ;; @param <bool-as-assoc> flags whether or not to pass rows as regular or association lists
532 ;; @param <fn-callback> a function to call for each row returned by the query
533 ;; <p>Iterates over the results of a query, passing a row at a time to
534 ;; <fn-callback>. The MysqlResult is automatically freed. The return value
535 ;; of mysql:row-iter is the result of the last call to <fn-callback>.</p>
536 ;; <p>Note that each row is called with MysqlResult:fetch-row to avoid building
537 ;; intermediate lists.</p>
538 ;; @example
539 ;; (mysql:on-connect '("localhost" "user" "secret" "my_database")
540 ;; (lambda (db err)
541 ;; (if err
542 ;; (println "Error! " err)
543 ;; (mysql:row-iter db "SELECT * FROM some_table" true
544 ;; (lambda (row) (println row))))))
545 (define (row-iter db sql as-assoc func , result row)
546 (setf result (:query db sql))
547 (while (setf row (:fetch-row result as-assoc))
548 (func row)))
549
550 ;; @syntax (mysql:row-map <Mysql-instance> <str-sql> <bool-as-assoc> <fn-callback>)
551 ;; @param <Mysql-instance> a connect instance of the Mysql class
552 ;; @param <str-sql> a sql statement
553 ;; @param <bool-as-assoc> flags whether or not to pass rows as regular or association lists
554 ;; @param <fn-callback> a function to apply to each row returned by the query
555 ;; <p>Maps <fn-callback> over each row returned by querying <Mysql-instance>
556 ;; with <str-sql>. Memory used by the MysqlResult is automatically freed.
557 ;; Returns a list of the result of applying <fn-callback> to each row.</p>
558 ;; @example
559 ;; (mysql:on-connect '("localhost" "user" "secret" "my_database")
560 ;; (lambda (db err)
561 ;; (if err
562 ;; (println "Error! " err)
563 ;; (mysql:row-iter db "SELECT * FROM some_table" true first))))
564 (define (row-map db sql as-assoc func , res result rows)
565 (setf result (:query db sql))
566 (if (catch (:fetch-all result as-assoc) 'rows)
567 (map func rows)))
568
569 ;; @syntax (mysql:reduce-results <Mysql-instance> <str-sql> <bool-as-assoc> <fn-callback>)
570 ;; @param <Mysql-instance> a connect instance of the Mysql class
571 ;; @param <str-sql> a sql statement
572 ;; @param <bool-as-assoc> flags whether or not to pass rows as regular or association lists
573 ;; @param <fn-callback> a function to be applied in reducing the results of the query
574 ;; <p>Reduces the results of the query by applying <fn-callback> successively
575 ;; to slices of the list of rows from the left. On the first call to
576 ;; <fn-callback>, the arguments will be a number of rows equal to the number of
577 ;; parameters that <fn-callback> accepts. On each subsequent call, the first
578 ;; parameter will be replaced by the result of the previous call. See the
579 ;; @link http://www.newlisp.org/newlisp_manual.html#apply apply&nbsp;function
580 ;; for a more detailed description of the mechanics of apply/reduce. The return
581 ;; value is the result of the final application of <fn-callback>.</p>
582 ;; @example
583 ;; (mysql:on-connect '("localhost" "user" "secret" "my_database")
584 ;; (lambda (db err)
585 ;; (if err
586 ;; (println "Error! " err)
587 ;; (mysql:row-reduce db "SELECT * FROM some_table" true
588 ;; (lambda (row-1 row-2)
589 ;; (+ (if (list? row-1) (first row-1) row-1) (first row-2)))))))
590 (define (row-reduce db sql as-assoc func , reduce-by rows arg-list)
591 ; Determine the number of rows to reduce by on each call
592 (setf arg-list (map name (first func)))
593 (if (find "," arg-list)
594 (setf reduce-by (length (rest (member "," (reverse arg-list)))))
595 (setf reduce-by (length arg-list)))
596 ; Perform reduction
597 (setf result (:query db sql))
598 (if (catch (:fetch-all result as-assoc) 'rows)
599 (apply func rows reduce-by)))
600
601 (context 'MAIN)
602
603
604
605
606
607
608
609
610
Something went wrong with that request. Please try again.