source: project/release/3/mysql/trunk/mysql.scm @ 7969

Last change on this file since 7969 was 7969, checked in by Kon Lovett, 13 years ago

More pref stmt work. Rewrote fetch-row for lower overhead when non-binary.

File size: 90.3 KB
Line 
1; vim:ts=2:sw=2:et:
2
3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4;; MySQL Egg for the Chicken Scheme system.
5;;
6;; mysql.scm,v 1.4 2005/08/04 10:09:26 tbutzon Exp
7;;
8;; Author: Toby Butzon (toby@butzon.com)
9;; Revisions:
10;;   2005.08.04 Initial release.
11;;   2007.01.20 Added -lz for Mac OS X compilation.
12;;                (Thanks to Daniel Sadilek.)
13;;              Changed #include <mysql/mysql.h> to #include <mysql.h>
14;;                (Thanks to Kon Lovett and Daniel Sadilek.)
15;;              Removed some misc. compilation warnings.
16;;                (Thanks to Kon Lovett.)
17;;              Added (error ...) calls instead of silently failing in
18;;                mysql-connect.
19;;                (Thanks to Daniel Sadilek.)
20;;   2008.01.24 Use of SRFI-12 conditions instead of 'error'.
21;;              MYSQL_FIELD support.
22;;              MY_CHARSET_INFO support.
23;;              More row mapping functions.
24;;              Options support
25;;              SSL support
26;;              Removed deprecated procedures:
27;;                mysql-create-db
28;;                mysql-drop-db
29;;                mysql-eof
30;;                mysql-reload
31;;              (Kon Lovett)
32;;
33;; This egg provides the MySQL C API via Chicken's foreign function
34;; interface. The function names in the MySQL C API are uniformly
35;; exported with "foreign-" prefixed to the name, and underscores are
36;; mapped to the more Scheme-ish dash; e.g., the MySQL C API's
37;; mysql_query is provided by this egg as foreign-mysql-query. Although
38;; these functions are exported, they are not verbosely documented in
39;; the egg documentation simply because the MySQL C API is already
40;; documented in full on MySQL's website:
41;;
42;;    http://dev.mysql.com/doc/mysql/en/c.html
43;;
44;; Further, this egg provides a layer on top of the foreign API to
45;; provide a simpler API that is appropriate to Scheme. These functions
46;; are _not_ prefixed with "foreign-" -- instead they are named according
47;; to the closest MySQL C API analog, if one exists. For example, the
48;; provided mysql-connect is briefer, yet provides the same functionality
49;; as, the C API sequence mysql_init, mysql_real_connect, and returns a
50;; Scheme-friendly record instead of a FFI C pointer.
51;;
52;; Please report bugs to <toby@butzon.com>.
53;;
54;; Copyright (c) 2005 Toby Butzon.
55;;
56;; Permission is hereby granted, free of charge, to any person obtaining a
57;; copy of this software and associated documentation files (the "Software"),
58;; to deal in the Software without restriction, including without limitation
59;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
60;; and/or sell copies of the Software, and to permit persons to whom the
61;; Software is furnished to do so, subject to the following conditions:
62;;
63;; The above copyright notice and this permission notice shall be included
64;; in all copies or substantial portions of the Software.
65;;
66;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
67;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
68;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
69;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
70;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
71;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
72;; OTHER DEALINGS IN THE SOFTWARE.
73;;
74;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75
76#>#include <mysql.h><#
77
78(use srfi-1 srfi-4 srfi-12)
79(use lolevel)
80
81(require-for-syntax 'srfi-13)
82
83(define-for-syntax (c-name->scheme-name str)
84  (string-downcase (string-translate str "_" "-")) )
85
86(declare
87  (usual-integrations)
88  (generic)
89  (no-procedure-checks-for-usual-bindings)
90  (inline)
91  (unused
92    my-charset-info-name-set!
93    my-charset-info-csname-set!
94    my-charset-info-comment-set!
95    my-charset-info-dir-set!
96    my-charset-info-mbminlen-set!
97    my-charset-info-mbmaxlen-set!
98                mysql-field-db-set!
99                mysql-field-type-set!
100                mysql-field-charsetnr-set!
101                mysql-field-catalog-set!
102                mysql-field-org-name-set!
103                mysql-field-name-set!
104                mysql-field-def-set!
105                mysql-field-org-table-set!
106                mysql-field-table-set!
107                mysql-field-flags-set!
108                mysql-field-org-table
109                mysql-field-decimals-set!
110                mysql-field-def-length-set!
111                mysql-field-catalog-length-set!
112                mysql-field-db-length-set!
113                mysql-field-org-table-length-set!
114                mysql-field-table-length-set!
115                mysql-field-org-name-length-set!
116                mysql-field-name-length-set!
117                mysql-field-max-length-set!
118                mysql-field-length-set! )
119  (bound-to-procedure
120    mysql-error
121    mysql-errno
122    #;%mysql-stmt-close )
123  (export
124    ;; direct api
125    foreign-mysql-affected-rows
126    foreign-mysql-change-user
127    foreign-mysql-character-set-name
128    foreign-mysql-close
129    foreign-mysql-data-seek
130    foreign-mysql-debug
131    foreign-mysql-dump-debug-info
132    foreign-mysql-errno
133    foreign-mysql-error
134    foreign-mysql-escape-string
135    foreign-mysql-fetch-field
136    foreign-mysql-fetch-fields
137    foreign-mysql-fetch-field-direct
138    foreign-mysql-fetch-lengths
139    foreign-mysql-fetch-row
140    foreign-mysql-field-count
141    foreign-mysql-field-seek
142    foreign-mysql-field-tell
143    foreign-mysql-free-result
144                foreign-mysql-get-character-set-info
145    foreign-mysql-get-client-info
146    foreign-mysql-get-client-version
147    foreign-mysql-get-host-info
148                foreign-mysql-get-proto-info
149    foreign-mysql-get-server-info
150    foreign-mysql-get-server-version
151    foreign-mysql-hex-string
152    foreign-mysql-info
153    foreign-mysql-init
154    foreign-mysql-insert-id
155    foreign-mysql-kill
156    foreign-mysql-library-init
157    foreign-mysql-library-end
158    foreign-mysql-list-dbs
159    foreign-mysql-list-fields
160    foreign-mysql-list-processes
161    foreign-mysql-list-tables
162    foreign-mysql-num-fields
163    foreign-mysql-num-rows
164    foreign-mysql-options
165    foreign-mysql-ping
166    foreign-mysql-query
167    foreign-mysql-real-connect
168    foreign-mysql-real-escape-string
169    foreign-mysql-real-query
170    foreign-mysql-row-seek
171    foreign-mysql-row-tell
172    foreign-mysql-select-db
173    foreign-mysql-set-character-set
174    foreign-mysql-set-server-option
175    foreign-mysql-shutdown
176    foreign-mysql-sqlstate
177    foreign-mysql-ssl-set
178    foreign-mysql-stat
179    foreign-mysql-store-result
180    foreign-mysql-thread-id
181    foreign-mysql-use-result
182    foreign-mysql-warning-count
183    foreign-mysql-commit
184    foreign-mysql-rollback
185    foreign-mysql-autocommit
186    foreign-mysql-more-results
187    foreign-mysql-next-result
188
189    ;; scheme api
190    mysql-connection?
191    mysql-affected-rows
192    mysql-change-user
193    mysql-character-set-name
194    mysql-close ; customized
195    mysql-connect ; customized
196                #;mysql-data-seek ; omitted (low level)
197    mysql-debug
198    mysql-dump-debug-info
199    mysql-errno
200    mysql-error ; customized
201    mysql-escape-string ; customized
202                mysql-fetch-field
203                mysql-fetch-fields
204                mysql-fetch-field-direct
205                mysql-fetch-lengths ; customized
206    mysql-fetch-row ; customized
207    mysql-field-count
208                #;mysql-field-seek ; omitted (low level)
209                #;mysql-field-tell ; omitted (low level)
210    mysql-free-result
211                mysql-get-character-set-info
212    mysql-get-client-info
213    mysql-get-client-version
214    mysql-get-host-info
215                mysql-get-proto-info
216    mysql-get-server-info
217    mysql-get-server-version
218                #;mysql-hex-string ; omitted (too new)
219    mysql-info
220                #;mysql-init ; omitted (low level)
221    mysql-insert-id
222    mysql-kill
223                #;mysql-library-init ; omitted (too new)
224                #;mysql-library-end ; omitted (too new)
225    mysql-list-dbs
226                mysql-list-fields ; (nearly deprecated)
227    mysql-list-processes
228    mysql-list-tables
229    mysql-num-fields
230    mysql-num-rows
231    mysql-ping
232    mysql-query
233                #;mysql-real-connect ; omitted (use mysql-connect)
234                #;mysql-real-escape-string ; omitted (use mysql-escape-string)
235                #;mysql-real-query ; omitted (use mysql-query)
236                #;mysql-row-seek ; omitted (low level)
237                #;mysql-row-tell ; omitted (low level)
238    mysql-select-db
239                mysql-set-character-set
240                #;mysql-set-server-option ; omitted (too new)
241                #;mysql-shutdown ; omitted (too new)
242                #;mysql-sqlstate ; omitted (too new)
243    mysql-stat
244    mysql-store-result
245    mysql-thread-id
246                #;mysql-use-result ; omitted (doesn't fit with Scheme layer; see mysql-query)
247                #;mysql-warning-count ; omitted (too new)
248                #;mysql-commit ; omitted (too new)
249                #;mysql-rollback ; omitted (too new)
250                #;mysql-autocommit ; omitted (too new)
251                #;mysql-more-results ; omitted (too new)
252                #;mysql-next-result ; omitted (too new)
253
254    ;;
255    make-mysql-options
256
257    ;; ssl parameters api
258    make-mysql-ssl
259    mysql-ssl?
260    mysql-ssl-key-pathname
261    mysql-ssl-certificate-pathname
262    mysql-ssl-certificate-authority-pathname
263    mysql-ssl-trusted-certificates-pathname
264    mysql-ssl-ciphers
265
266    ;; "extended" api
267    mysql-rewind
268
269    ;; "map" api
270    mysql-row-fold
271    mysql-row-for-each
272    mysql-row-map
273    mysql-query-fold
274    mysql-query-for-each
275    mysql-query-map
276    ; synonyms
277    mysql-foreach-row
278    mysql-query-foreach
279
280    ;; MY_CHARSET_INFO api
281    ; slot getters
282    my-charset-info-name
283    my-charset-info-csname
284    my-charset-info-comment
285    my-charset-info-dir
286    my-charset-info-mbminlen
287    my-charset-info-mbmaxlen
288
289    ;; MYSQL_FIELD api
290    ; predicates
291    mysql-field-flags-on?
292    mysql-field-flags-off?
293    mysql-field-primary-key?
294    mysql-field-not-null?
295    mysql-field-numeric?
296    mysql-field-type-any?
297    mysql-field-type=?
298    mysql-field-type-clock?
299    mysql-field-type-number?
300    mysql-field-type-string?
301    mysql-field-type-blob?
302    mysql-field-type-magnitude?
303    mysql-field-type-binary?
304    mysql-field-type-text?
305    ;
306    mysql-fetch-field-specific
307    ; multi-field getters
308    mysql-field-slots
309    mysql-fetch-field-slots-direct
310    mysql-fetch-field-slots
311    mysql-fetch-field-slot-direct
312    mysql-fetch-field-slot
313    ; slot getters
314                mysql-field-name
315                mysql-field-org-name
316                mysql-field-table
317                mysql-field-org-table
318                mysql-field-db
319                mysql-field-catalog
320                mysql-field-def
321                mysql-field-length
322                mysql-field-max-length
323                mysql-field-name-length
324                mysql-field-org-name-length
325                mysql-field-table-length
326                mysql-field-org-table-length
327                mysql-field-db-length
328                mysql-field-catalog-length
329                mysql-field-def-length
330                mysql-field-flags
331                mysql-field-decimals
332                mysql-field-charsetnr
333                mysql-field-type
334
335    ;; connection client flags
336    ; values
337    client-long-password
338    client-long-flag
339    client-connect-with-db
340    client-protocol-41
341    client-secure-connection
342    client-transactions
343    client-compress
344    client-found-rows
345    client-ignore-sigpipe
346    client-ignore-space
347    client-interactive
348    client-local-files
349    client-multi-results
350    client-multi-statements
351    client-no-schema
352    client-odbc
353    client-ssl
354                ; converters
355    mysql-client-flags-value
356    mysql-client-flags-symbol
357
358    ;; enum enum_mysql_set_option
359    ; values
360    mysql-option-multi-statements-on
361    mysql-option-multi-statements-off
362                ; converters
363    mysql-server-option-value
364    mysql-server-option-symbol
365
366    ;; enum mysql_option
367    ; values
368    mysql-opt-connect-timeout
369    mysql-opt-compress
370    mysql-opt-named-pipe
371    mysql-init-command
372    mysql-read-default-file
373    mysql-read-default-group
374    mysql-set-charset-dir
375    mysql-set-charset-name
376    mysql-opt-local-infile
377    mysql-opt-protocol
378    mysql-shared-memory-base-name
379    mysql-opt-read-timeout
380    mysql-opt-write-timeout
381    mysql-opt-use-result
382    mysql-opt-use-remote-connection
383    mysql-opt-use-embedded-connection
384    mysql-opt-guess-connection
385    mysql-set-client-ip
386    mysql-secure-auth
387    mysql-report-data-truncation
388                ; converters
389    mysql-option-value
390    mysql-option-symbol
391
392    ;; enum enum_field_types
393    ; values
394        mysql-type-decimal
395        mysql-type-tiny
396        mysql-type-short
397        mysql-type-long
398        mysql-type-int24
399        mysql-type-float
400        mysql-type-double
401        mysql-type-null
402        mysql-type-timestamp
403        mysql-type-longlong
404        mysql-type-date
405        mysql-type-time
406        mysql-type-datetime
407        mysql-type-year
408        mysql-type-newdate
409        mysql-type-varchar
410        mysql-type-bit
411        mysql-type-newdecimal
412        mysql-type-enum
413        mysql-type-set
414        mysql-type-tiny-blob
415        mysql-type-medium-blob
416        mysql-type-long-blob
417        mysql-type-blob
418        mysql-type-var-string
419        mysql-type-string
420        mysql-type-geometry
421                ; converters
422    mysql-type-value
423    mysql-type-symbol
424
425    ;; field flags
426    ; values
427    not-null-flag
428    pri-key-flag
429    unique-key-flag
430    multiple-key-flag
431    unsigned-flag
432    zerofill-flag
433    binary-flag
434    auto-increment-flag
435    no-default-value-flag
436    ; deprecated
437    enum-flag
438    set-flag
439    blob-flag
440    timestamp-flag
441                ; converters
442    mysql-field-flags-value
443    mysql-field-flags-symbol ) )
444
445;=======================================================================
446; Interface to C API
447;
448; The entire C API is mapped using Chicken's foreign function interface.
449;
450
451;-----------------------------------------------------------------------
452; Foreign type definitions.
453;
454
455(define-foreign-type mysql-ptr (c-pointer "MYSQL"))
456(define-foreign-type mysql-res-ptr (c-pointer "MYSQL_RES"))
457(define-foreign-type mysql-rows-ptr (c-pointer "MYSQL_ROWS"))
458(define-foreign-type mysql-field-ptr (c-pointer "MYSQL_FIELD"))
459
460; MYSQL_ROW (we just pass it around, not def-ref'ed)
461(define-foreign-type mysql-row (c-pointer (c-pointer char)))
462
463; my_ulonglong
464(define-foreign-type my-ulonglong number)
465
466; my_bool
467(define-foreign-type my-bool bool)
468
469; MYSQL_FIELD_OFFSET
470(define-foreign-type mysql-field-offset unsigned-int)
471
472;-----------------------------------------------------------------------
473; Enumeration & flag value constants
474;
475
476(define-macro (gen-public-enum ?typ . ?syms)
477  `(begin
478     ,@(map
479        (lambda (sym)
480          (if (pair? sym)
481            `(define ,(car sym) ,(cadr sym))
482            `(define ,(string->symbol (c-name->scheme-name (symbol->string sym))) ,sym)))
483        ?syms)
484     (define (,(string->symbol (string-append (symbol->string ?typ) "-value")) . syms)
485       (,(string->symbol (string-append (symbol->string ?typ) "->number")) syms))
486     (define (,(string->symbol (string-append (symbol->string ?typ) "-symbol")) val)
487       (,(string->symbol (string-append "number->" (symbol->string ?typ))) val))) )
488
489(define-foreign-enum (mysql-server-option (enum "enum_mysql_set_option"))
490  #f  ; No aliases!
491  MYSQL_OPTION_MULTI_STATEMENTS_ON
492  MYSQL_OPTION_MULTI_STATEMENTS_OFF )
493
494(gen-public-enum mysql-server-option
495  MYSQL_OPTION_MULTI_STATEMENTS_ON
496  MYSQL_OPTION_MULTI_STATEMENTS_OFF)
497
498(define-foreign-enum (mysql-option (enum "mysql_option"))
499  #f  ; No aliases!
500  MYSQL_OPT_CONNECT_TIMEOUT
501  MYSQL_OPT_COMPRESS
502  MYSQL_OPT_NAMED_PIPE
503  MYSQL_INIT_COMMAND
504  MYSQL_READ_DEFAULT_FILE
505  MYSQL_READ_DEFAULT_GROUP
506  MYSQL_SET_CHARSET_DIR
507  MYSQL_SET_CHARSET_NAME
508  MYSQL_OPT_LOCAL_INFILE
509  MYSQL_OPT_PROTOCOL
510  MYSQL_SHARED_MEMORY_BASE_NAME
511  MYSQL_OPT_READ_TIMEOUT
512  MYSQL_OPT_WRITE_TIMEOUT
513  MYSQL_OPT_USE_RESULT
514  MYSQL_OPT_USE_REMOTE_CONNECTION
515  MYSQL_OPT_USE_EMBEDDED_CONNECTION
516  MYSQL_OPT_GUESS_CONNECTION
517  MYSQL_SET_CLIENT_IP
518  MYSQL_SECURE_AUTH
519  MYSQL_REPORT_DATA_TRUNCATION )
520
521(gen-public-enum mysql-option
522  MYSQL_OPT_CONNECT_TIMEOUT
523  MYSQL_OPT_COMPRESS
524  MYSQL_OPT_NAMED_PIPE
525  MYSQL_INIT_COMMAND
526  MYSQL_READ_DEFAULT_FILE
527  MYSQL_READ_DEFAULT_GROUP
528  MYSQL_SET_CHARSET_DIR
529  MYSQL_SET_CHARSET_NAME
530  MYSQL_OPT_LOCAL_INFILE
531  MYSQL_OPT_PROTOCOL
532  MYSQL_SHARED_MEMORY_BASE_NAME
533  MYSQL_OPT_READ_TIMEOUT
534  MYSQL_OPT_WRITE_TIMEOUT
535  MYSQL_OPT_USE_RESULT
536  MYSQL_OPT_USE_REMOTE_CONNECTION
537  MYSQL_OPT_USE_EMBEDDED_CONNECTION
538  MYSQL_OPT_GUESS_CONNECTION
539  MYSQL_SET_CLIENT_IP
540  MYSQL_SECURE_AUTH
541  MYSQL_REPORT_DATA_TRUNCATION )
542
543(define-foreign-enum (mysql-type (enum "enum_field_types"))
544  #f  ; No aliases!
545  MYSQL_TYPE_DECIMAL
546        MYSQL_TYPE_TINY
547  MYSQL_TYPE_SHORT
548  MYSQL_TYPE_LONG
549  MYSQL_TYPE_INT24
550  MYSQL_TYPE_FLOAT
551  MYSQL_TYPE_DOUBLE
552  MYSQL_TYPE_NULL
553  MYSQL_TYPE_TIMESTAMP
554  MYSQL_TYPE_LONGLONG
555  MYSQL_TYPE_DATE
556  MYSQL_TYPE_TIME
557  MYSQL_TYPE_DATETIME
558        MYSQL_TYPE_YEAR
559  MYSQL_TYPE_NEWDATE
560        MYSQL_TYPE_VARCHAR
561  MYSQL_TYPE_BIT
562  MYSQL_TYPE_NEWDECIMAL
563  MYSQL_TYPE_ENUM
564  MYSQL_TYPE_SET
565  MYSQL_TYPE_TINY_BLOB
566  MYSQL_TYPE_MEDIUM_BLOB
567  MYSQL_TYPE_LONG_BLOB
568  MYSQL_TYPE_BLOB
569  MYSQL_TYPE_VAR_STRING
570  MYSQL_TYPE_STRING
571  MYSQL_TYPE_GEOMETRY )
572
573(gen-public-enum mysql-type
574  MYSQL_TYPE_DECIMAL
575        MYSQL_TYPE_TINY
576  MYSQL_TYPE_SHORT
577  MYSQL_TYPE_LONG
578  MYSQL_TYPE_INT24
579  MYSQL_TYPE_FLOAT
580  MYSQL_TYPE_DOUBLE
581  MYSQL_TYPE_NULL
582  MYSQL_TYPE_TIMESTAMP
583  MYSQL_TYPE_LONGLONG
584  MYSQL_TYPE_DATE
585  MYSQL_TYPE_TIME
586  MYSQL_TYPE_DATETIME
587        MYSQL_TYPE_YEAR
588  MYSQL_TYPE_NEWDATE
589        MYSQL_TYPE_VARCHAR
590  MYSQL_TYPE_BIT
591  MYSQL_TYPE_NEWDECIMAL
592  MYSQL_TYPE_ENUM
593  MYSQL_TYPE_SET
594  MYSQL_TYPE_TINY_BLOB
595  MYSQL_TYPE_MEDIUM_BLOB
596  MYSQL_TYPE_LONG_BLOB
597  MYSQL_TYPE_BLOB
598  MYSQL_TYPE_VAR_STRING
599  MYSQL_TYPE_STRING
600  MYSQL_TYPE_GEOMETRY )
601
602(define-foreign-enum (mysql-field-flags unsigned-int)
603  #f  ; No aliases!
604  NOT_NULL_FLAG                                         ; field can't be NULL
605  PRI_KEY_FLAG                                          ; field is part of a primary key
606  UNIQUE_KEY_FLAG                                       ; field is part of a unique key
607  MULTIPLE_KEY_FLAG                                     ; field is part of a key
608  UNSIGNED_FLAG                                         ; field is unsigned
609  ZEROFILL_FLAG                                         ; field is zerofill
610  BINARY_FLAG                                           ; field is binary
611  AUTO_INCREMENT_FLAG                                   ; field is a autoincrement field
612  NO_DEFAULT_VALUE_FLAG         ; field doesn't have default value
613  NUM_FLAG                      ; field is num (for clients)
614  ; deprecated
615  ENUM_FLAG                                             ; field is an enum
616  SET_FLAG                                              ; field is a set
617  BLOB_FLAG                                             ; field is a blob
618  TIMESTAMP_FLAG        )                                                       ; field is a timestamp
619
620(gen-public-enum mysql-field-flags
621  NOT_NULL_FLAG
622  PRI_KEY_FLAG
623  UNIQUE_KEY_FLAG
624  MULTIPLE_KEY_FLAG
625  UNSIGNED_FLAG
626  ZEROFILL_FLAG
627  BINARY_FLAG
628  AUTO_INCREMENT_FLAG
629  NO_DEFAULT_VALUE_FLAG
630  NUM_FLAG
631  ; deprecated
632  ENUM_FLAG
633  SET_FLAG
634  BLOB_FLAG
635  TIMESTAMP_FLAG )
636
637(define-foreign-enum (mysql-client-flags unsigned-int)
638        #f      ; No aliases!
639  CLIENT_LONG_PASSWORD          ; new more secure passwords
640  CLIENT_LONG_FLAG              ; Get all column flags
641  CLIENT_CONNECT_WITH_DB        ; One can specify db on connect
642  CLIENT_PROTOCOL_41            ; New 4.1 protocol
643  CLIENT_SECURE_CONNECTION      ; New 4.1 authentication
644  CLIENT_TRANSACTIONS           ; Client knows about transactions
645        CLIENT_COMPRESS               ; Can use compression protocol
646        ; Return the number of found (matched) rows, not the number of affected rows.
647        CLIENT_FOUND_ROWS
648        ; Prevents the client library from installing a SIGPIPE signal handler. This
649        ; can be used to avoid conflicts with a handler that the application has
650        ; already installed.
651        CLIENT_IGNORE_SIGPIPE
652        ; Allow spaces after function names. Makes all functions names reserved
653        ; words.
654        CLIENT_IGNORE_SPACE
655        ; Allow interactive_timeout seconds (instead of wait_timeout seconds) of
656        ; inactivity before closing the connection. The client's session wait_timeout
657        ; variable is set to the value of the session interactive_timeout variable.
658        CLIENT_INTERACTIVE
659        ; Enable LOAD DATA LOCAL handling.
660        CLIENT_LOCAL_FILES
661        ; Tell the server that the client can handle multiple result sets from
662        ; multiple-statement executions or stored procedures. This is automatically set
663        ; if CLIENT_MULTI_STATEMENTS is set. See the note following this table for more
664        ; information about this flag.
665        CLIENT_MULTI_RESULTS
666        ; Tell the server that the client may send multiple statements in a single
667        ; string (separated by Ò;Ó). If this flag is not set, multiple-statement
668        ; execution is disabled. See the note following this table for more information
669        ; about this flag.
670        CLIENT_MULTI_STATEMENTS
671        ; Don't allow the db_name.tbl_name.col_name syntax. This is for ODBC. It
672        ; causes the parser to generate an error if you use that syntax, which is
673        ; useful for trapping bugs in some ODBC programs.
674        CLIENT_NO_SCHEMA
675        ; Unused.
676        CLIENT_ODBC
677        ; Use SSL (encrypted protocol). This option should not be set by application
678        ; programs; it is set internally in the client library. Instead, use
679        ; mysql_ssl_set() before calling mysql_real_connect().
680        CLIENT_SSL )
681
682(gen-public-enum mysql-client-flags
683  CLIENT_LONG_PASSWORD
684  CLIENT_LONG_FLAG
685  CLIENT_CONNECT_WITH_DB
686  CLIENT_PROTOCOL_41
687  CLIENT_SECURE_CONNECTION
688  CLIENT_TRANSACTIONS
689  CLIENT_COMPRESS
690  CLIENT_FOUND_ROWS
691  CLIENT_IGNORE_SIGPIPE
692  CLIENT_IGNORE_SPACE
693  CLIENT_INTERACTIVE
694  CLIENT_LOCAL_FILES
695  CLIENT_MULTI_RESULTS
696  CLIENT_MULTI_STATEMENTS
697  CLIENT_NO_SCHEMA
698  CLIENT_ODBC
699  CLIENT_SSL )
700
701;-----------------------------------------------------------------------
702; C Structures
703;
704
705; not "mysql-field-ptr", named so getters have nice name.
706(define-foreign-record (mysql-field "MYSQL_FIELD")
707  (rename: c-name->scheme-name)
708  ; No ctor or dtor
709  (c-string name)                       ; Name of column
710  (c-string org_name)                   ; Original column name, if an alias
711  (c-string table)                      ; Table of column if column was a field
712  (c-string org_table)                  ; Org table name, if table was an alias
713  (c-string db)                         ; Database for table
714  (c-string catalog)                      ; Catalog for table
715  (c-string def)                        ; Default value (set by mysql_list_fields)
716  (unsigned-long length)                ; Width of column (create length)
717  (unsigned-long max_length)            ; Max width for selected set
718  (unsigned-integer name_length)
719  (unsigned-integer org_name_length)
720  (unsigned-integer table_length)
721  (unsigned-integer org_table_length)
722  (unsigned-integer db_length)
723  (unsigned-integer catalog_length)
724  (unsigned-integer def_length)
725  (unsigned-integer flags)              ; Div flags
726  (unsigned-integer decimals)           ; Number of decimals in field
727  (unsigned-integer charsetnr)          ; Character set
728  (mysql-type type) )                   ; Type of field. See mysql_com.h for types
729
730; not "my-charset-info-ptr", named so getters have nice name.
731(define-foreign-record (my-charset-info "MY_CHARSET_INFO")
732  (rename: c-name->scheme-name)
733  (constructor: allocate-my-charset-info)
734  (destructor: free-my-charset-info)
735  (c-string name)                     ; character set name
736  (c-string csname)                 ; collation name
737  (c-string comment)              ; comment
738  (c-string dir)                ; directory
739  (unsigned-integer mbminlen)   ; multi byte character min. length
740  (unsigned-integer mbmaxlen) ) ; multi byte character max. length
741
742;-----------------------------------------------------------------------
743;
744
745(define-constant UNSIGNED-LONG-SIZE 4)
746
747;-----------------------------------------------------------------------
748; Foreign function definitions for the MySQL C API using the
749; MySQL "my_ulonglong" type.
750;
751; We treat "my_ulonglong" in Scheme as the "number" type & as a
752; "double" in the C interface, converting to "my_ulonglong"
753; to/from the MySQL API.
754;
755
756#>
757static double
758mysqlaux_mysql_affected_rows (MYSQL *mysql)
759{
760  return ((double) mysql_affected_rows (mysql));
761}
762
763static double
764mysqlaux_mysql_insert_id (MYSQL *mysql)
765{
766  return ((double) mysql_insert_id (mysql));
767}
768
769static double
770mysqlaux_mysql_num_rows (MYSQL_RES *result)
771{
772  return ((double) mysql_num_rows (result));
773}
774
775static void
776mysqlaux_mysql_data_seek (MYSQL_RES *result, double offset)
777{
778  mysql_data_seek (result, (my_ulonglong) offset);
779}
780<#
781
782; 24.2.3.1. mysql_affected_rows()
783; my_ulonglong mysql_affected_rows(MYSQL *mysql)
784(define foreign-mysql-affected-rows
785  (foreign-lambda my-ulonglong "mysqlaux_mysql_affected_rows" mysql-ptr))
786
787; 24.2.3.34. mysql_insert_id()
788; my_ulonglong mysql_insert_id(MYSQL *mysql)
789(define foreign-mysql-insert-id
790  (foreign-lambda my-ulonglong "mysqlaux_mysql_insert_id" mysql-ptr))
791
792; 24.2.3.43. mysql_num_rows()
793; my_ulonglong mysql_num_rows(MYSQL_RES *result)
794(define foreign-mysql-num-rows
795  (foreign-lambda my-ulonglong "mysqlaux_mysql_num_rows" mysql-res-ptr))
796
797; 24.2.3.7. mysql_data_seek()
798; void mysql_data_seek(MYSQL_RES *result, my_ulonglong offset)
799(define foreign-mysql-data-seek
800  (foreign-lambda void "mysqlaux_mysql_data_seek" mysql-res-ptr my-ulonglong))
801
802;-----------------------------------------------------------------------
803; Foreign function definitions for mysql_options from MySQL C API.
804;
805
806#>
807static int
808mysqlaux_mysql_options_none (MYSQL *mysql, enum mysql_option opt)
809{
810  return (mysql_options (mysql, opt, NULL));
811}
812
813static int
814mysqlaux_mysql_options_string (MYSQL *mysql, enum mysql_option opt, char *value)
815{
816  return (mysql_options (mysql, opt, value));
817}
818
819static int
820mysqlaux_mysql_options_ulong (MYSQL *mysql, enum mysql_option opt, unsigned long value)
821{
822  return (mysql_options (mysql, opt, &value));
823}
824<#
825
826(define foreign-mysqlaux-options-none
827  (foreign-lambda int "mysqlaux_mysql_options_none" mysql-ptr mysql-option) )
828
829(define foreign-mysqlaux-options-string
830  (foreign-lambda int "mysqlaux_mysql_options_string" mysql-ptr mysql-option c-string) )
831
832(define foreign-mysqlaux-options-ulong
833  (foreign-lambda int "mysqlaux_mysql_options_ulong" mysql-ptr mysql-option unsigned-long) )
834
835;-----------------------------------------------------------------------
836; Foreign function definitions for mysqlaux functions.
837;
838
839#>
840static int
841mysqlaux_field_index (MYSQL_RES *result, const char *name, unsigned int num_fields)
842{
843  MYSQL_FIELD *fields = mysql_fetch_fields (result);
844  unsigned int i;
845
846  for (i = 0; i < num_fields; i++) {
847    if (0 == strcasecmp (name, fields[i].name)) {
848      return (i);
849    }
850  }
851
852  return (-1);
853}
854
855static int
856mysqlaux_is_binary_field (MYSQL_RES *result, unsigned int fldidx)
857{
858  MYSQL_FIELD *fields = mysql_fetch_fields (result);
859
860  switch (fields[fldidx].type) {
861    case MYSQL_TYPE_VARCHAR:
862    case MYSQL_TYPE_TINY_BLOB:
863    case MYSQL_TYPE_MEDIUM_BLOB:
864    case MYSQL_TYPE_LONG_BLOB:
865    case MYSQL_TYPE_BLOB:
866    case MYSQL_TYPE_VAR_STRING:
867    case MYSQL_TYPE_STRING:
868      return (63 == fields[fldidx].charsetnr);
869    default:
870     break;
871  }
872
873  return (0);
874}
875
876static char *
877mysqlaux_fetch_column_data_direct (MYSQL_ROW row, unsigned int fldidx)
878{
879  return (row[fldidx]);
880}
881<#
882
883(define foreign-mysqlaux-field-index
884  (foreign-lambda int "mysqlaux_field_index" mysql-res-ptr
885                                             nonnull-c-string unsigned-integer))
886
887(define foreign-mysqlaux-is-binary-field
888  (foreign-lambda bool "mysqlaux_is_binary_field"
889                        mysql-res-ptr unsigned-integer))
890
891(define foreign-mysqlaux-fetch-column-string-direct
892  (foreign-lambda c-string "mysqlaux_fetch_column_data_direct"
893                            mysql-row unsigned-integer))
894
895(define foreign-mysqlaux-fetch-column-data-direct
896  (foreign-lambda c-pointer "mysqlaux_fetch_column_data_direct"
897                             mysql-row unsigned-integer))
898
899;-----------------------------------------------------------------------
900; Foreign function definitions from MySQL C API.
901;
902; I've copied the listing of MySQL C API functions straight from the
903; MySQL manual. They are in alphabetical order, exactly as they appear
904; in the manual. Further, the C function signature is copied below the
905; manual entry. Finally, the Scheme foreign lambda mapping follows the
906; C function signature.
907;
908
909; 24.2.3.2. mysql_change_user()
910; my_bool mysql_change_user(MYSQL *mysql, const char *user,
911;   const char *password, const char *db)
912(define foreign-mysql-change-user
913  (foreign-lambda my-bool "mysql_change_user" mysql-ptr c-string c-string
914                  c-string))
915
916; 24.2.3.3. mysql_character_set_name()
917; const char *mysql_character_set_name(MYSQL *mysql)
918(define foreign-mysql-character-set-name
919  (foreign-lambda c-string "mysql_character_set_name" mysql-ptr))
920
921; 24.2.3.4. mysql_close()
922; void mysql_close(MYSQL *mysql)
923(define foreign-mysql-close
924  (foreign-lambda void "mysql_close" mysql-ptr))
925
926; 24.2.3.8. mysql_debug()
927; void mysql_debug(const char *debug)
928(define foreign-mysql-debug
929  (foreign-lambda void "mysql_debug" c-string))
930
931; 24.2.3.10. mysql_dump_debug_info()
932; int mysql_dump_debug_info(MYSQL *mysql)
933(define foreign-mysql-dump-debug-info
934  (foreign-lambda integer "mysql_dump_debug_info" mysql-ptr))
935
936; 24.2.3.12. mysql_errno()
937; unsigned int mysql_errno(MYSQL *mysql)
938(define foreign-mysql-errno
939  (foreign-lambda unsigned-integer "mysql_errno" mysql-ptr))
940
941; 24.2.3.13. mysql_error()
942; const char *mysql_error(MYSQL *mysql)
943(define foreign-mysql-error
944  (foreign-lambda c-string "mysql_error" mysql-ptr))
945
946; 24.2.3.14. mysql_escape_string()
947; unsigned long mysql_escape_string(char *to, const char *from,
948;   unsigned long length)
949(define foreign-mysql-escape-string
950  (foreign-lambda unsigned-long "mysql_escape_string" c-string c-string
951                  unsigned-long))
952
953; 24.2.3.15. mysql_fetch_field()
954; MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *result)
955(define foreign-mysql-fetch-field
956  (foreign-lambda mysql-field-ptr "mysql_fetch_field" mysql-res-ptr))
957
958; 24.2.3.16. mysql_fetch_fields()
959; MYSQL_FIELD *mysql_fetch_fields(MYSQL_RES *result)
960(define foreign-mysql-fetch-fields
961  (foreign-lambda mysql-field-ptr "mysql_fetch_fields" mysql-res-ptr))
962
963; 24.2.3.17. mysql_fetch_field_direct()
964; MYSQL_FIELD *mysql_fetch_field_direct(MYSQL_RES *result, unsigned int fieldnr)
965(define foreign-mysql-fetch-field-direct
966  (foreign-lambda mysql-field-ptr "mysql_fetch_field_direct" mysql-res-ptr
967                  unsigned-integer))
968
969; 24.2.3.18. mysql_fetch_lengths()
970; unsigned long *mysql_fetch_lengths(MYSQL_RES *result)
971(define foreign-mysql-fetch-lengths
972  (foreign-lambda (c-pointer unsigned-long) "mysql_fetch_lengths" mysql-res-ptr))
973
974; 24.2.3.19. mysql_fetch_row()
975; MYSQL_ROW mysql_fetch_row(MYSQL_RES *result)
976(define foreign-mysql-fetch-row
977  (foreign-lambda mysql-row "mysql_fetch_row" mysql-res-ptr))
978
979; 24.2.3.20. mysql_field_count()
980; unsigned int mysql_field_count(MYSQL *mysql)
981(define foreign-mysql-field-count
982  (foreign-lambda unsigned-integer "mysql_field_count" mysql-ptr))
983
984; 24.2.3.21. mysql_field_seek()
985; MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *result,
986;   MYSQL_FIELD_OFFSET offset)
987(define foreign-mysql-field-seek
988  (foreign-lambda mysql-field-offset "mysql_field_seek" mysql-res-ptr
989                  mysql-field-offset))
990
991; 24.2.3.22. mysql_field_tell()
992; MYSQL_FIELD_OFFSET mysql_field_tell(MYSQL_RES *result)
993(define foreign-mysql-field-tell
994  (foreign-lambda mysql-field-offset "mysql_field_tell" mysql-res-ptr))
995
996; 24.2.3.23. mysql_free_result()
997; void mysql_free_result(MYSQL_RES *result)
998(define foreign-mysql-free-result
999  (foreign-lambda void "mysql_free_result" mysql-res-ptr))
1000
1001; 24.2.3.26.Êmysql_get_character_set_info()
1002; void mysql_get_character_set_info(MYSQL *mysql, MY_CHARSET_INFO *cs)
1003(define foreign-mysql-get-character-set-info
1004  (foreign-lambda void "mysql_get_character_set_info" mysql-ptr my-charset-info))
1005
1006; 24.2.3.25. mysql_get_client_info()
1007; char *mysql_get_client_info(void)
1008(define foreign-mysql-get-client-info
1009  (foreign-lambda c-string "mysql_get_client_info"))
1010
1011; 24.2.3.26. mysql_get_client_version()
1012; unsigned long mysql_get_client_version(void)
1013(define foreign-mysql-get-client-version
1014  (foreign-lambda unsigned-long "mysql_get_client_version"))
1015
1016; 24.2.3.27. mysql_get_host_info()
1017; char *mysql_get_host_info(MYSQL *mysql)
1018(define foreign-mysql-get-host-info
1019  (foreign-lambda c-string "mysql_get_host_info" mysql-ptr))
1020
1021; 24.2.3.28. mysql_get_proto_info()
1022; unsigned int mysql_get_proto_info(MYSQL *mysql)
1023(define foreign-mysql-get-proto-info
1024  (foreign-lambda unsigned-integer "mysql_get_proto_info" mysql-ptr))
1025
1026; 24.2.3.29. mysql_get_server_info()
1027; char *mysql_get_server_info(MYSQL *mysql)
1028(define foreign-mysql-get-server-info
1029  (foreign-lambda c-string "mysql_get_server_info" mysql-ptr))
1030
1031; 24.2.3.30. mysql_get_server_version()
1032; unsigned long mysql_get_server_version(MYSQL *mysql)
1033(define foreign-mysql-get-server-version
1034  (foreign-lambda unsigned-long "mysql_get_server_version" mysql-ptr))
1035
1036; 24.2.3.31. mysql_hex_string()
1037; unsigned long mysql_hex_string(char *to, const char *from,
1038;   unsigned long length)
1039(define foreign-mysql-hex-string
1040  (foreign-lambda unsigned-long "mysql_hex_string" c-string c-string
1041                  unsigned-long))
1042
1043; 24.2.3.32. mysql_info()
1044; char *mysql_info(MYSQL *mysql)
1045(define foreign-mysql-info
1046  (foreign-lambda c-string "mysql_info" mysql-ptr))
1047
1048; 24.2.3.33. mysql_init()
1049; MYSQL *mysql_init(MYSQL *mysql)
1050(define foreign-mysql-init
1051  (foreign-lambda mysql-ptr "mysql_init" mysql-ptr))
1052
1053; 24.2.3.35. mysql_kill()
1054; int mysql_kill(MYSQL *mysql, unsigned long pid)
1055(define foreign-mysql-kill
1056  (foreign-lambda integer "mysql_kill" mysql-ptr unsigned-long))
1057
1058; 24.2.3.36. mysql_library_init()
1059; int mysql_library_init(int argc, char **argv, char **groups)
1060(define foreign-mysql-library-init
1061  (foreign-lambda integer "mysql_library_init" integer c-pointer c-pointer))
1062
1063; 24.2.3.37. mysql_library_end()
1064; void mysql_library_end(void)
1065(define foreign-mysql-library-end
1066  (foreign-lambda void "mysql_library_end"))
1067
1068; 24.2.3.38. mysql_list_dbs()
1069; MYSQL_RES *mysql_list_dbs(MYSQL *mysql, const char *wild)
1070(define foreign-mysql-list-dbs
1071  (foreign-lambda mysql-res-ptr "mysql_list_dbs" mysql-ptr c-string))
1072
1073; 24.2.3.39. mysql_list_fields()
1074; MYSQL_RES *mysql_list_fields(MYSQL *mysql, const char *table,
1075;   const char *wild)
1076(define foreign-mysql-list-fields
1077  (foreign-lambda mysql-res-ptr "mysql_list_fields" mysql-ptr c-string
1078                  c-string))
1079
1080; 24.2.3.40. mysql_list_processes()
1081; MYSQL_RES *mysql_list_processes(MYSQL *mysql)
1082(define foreign-mysql-list-processes
1083  (foreign-lambda mysql-res-ptr "mysql_list_processes" mysql-ptr))
1084
1085; 24.2.3.41. mysql_list_tables()
1086; MYSQL_RES *mysql_list_tables(MYSQL *mysql, const char *wild)
1087(define foreign-mysql-list-tables
1088  (foreign-lambda mysql-res-ptr "mysql_list_tables" mysql-ptr c-string))
1089
1090; 24.2.3.42. mysql_num_fields()
1091; unsigned int mysql_num_fields(MYSQL_RES *result)
1092(define foreign-mysql-num-fields
1093  (foreign-lambda unsigned-integer "mysql_num_fields" mysql-res-ptr))
1094
1095; 24.2.3.44. mysql_options()
1096; int mysql_options(MYSQL *mysql, enum mysql_option option, const char *arg)
1097(define foreign-mysql-options
1098  (foreign-lambda integer "mysql_options" mysql-ptr mysql-option c-pointer))
1099
1100; 24.2.3.45. mysql_ping()
1101; int mysql_ping(MYSQL *mysql)
1102(define foreign-mysql-ping
1103  (foreign-lambda integer "mysql_ping" mysql-ptr))
1104
1105; 24.2.3.46. mysql_query()
1106; int mysql_query(MYSQL *mysql, const char *stmt_str)
1107;
1108; NOTE: use "mysql_real_query" instead
1109(define foreign-mysql-query
1110  (foreign-lambda integer "mysql_query" mysql-ptr c-string))
1111
1112; 24.2.3.47. mysql_real_connect()
1113; MYSQL *mysql_real_connect(MYSQL *mysql, const char *host, const char *user,
1114;   const char *passwd, const char *db, unsigned int port,
1115;   const char *unix_socket, unsigned long client_flag)
1116(define foreign-mysql-real-connect
1117  (foreign-lambda mysql-ptr "mysql_real_connect"
1118                  mysql-ptr c-string c-string
1119                  c-string c-string unsigned-integer
1120                  c-string unsigned-long))
1121
1122; 24.2.3.48. mysql_real_escape_string()
1123; unsigned long mysql_real_escape_string(MYSQL *mysql, char *to,
1124;   const char *from, unsigned long length)
1125(define foreign-mysql-real-escape-string
1126  (foreign-lambda unsigned-long "mysql_real_escape_string" mysql-ptr
1127                  c-string c-string unsigned-long))
1128
1129; 24.2.3.49. mysql_real_query()
1130; int mysql_real_query(MYSQL *mysql, const char *query, unsigned long length)
1131(define foreign-mysql-real-query
1132  (foreign-lambda unsigned-integer "mysql_real_query" mysql-ptr c-string
1133                  unsigned-long))
1134
1135; 24.2.3.51. mysql_row_seek()
1136; MYSQL_ROW_OFFSET mysql_row_seek(MYSQL_RES *result, MYSQL_ROW_OFFSET offset)
1137(define foreign-mysql-row-seek
1138  (foreign-lambda mysql-rows-ptr "mysql_row_seek" mysql-res-ptr mysql-rows-ptr))
1139
1140; 24.2.3.52. mysql_row_tell()
1141; MYSQL_ROW_OFFSET mysql_row_tell(MYSQL_RES *result)
1142(define foreign-mysql-row-tell
1143  (foreign-lambda mysql-rows-ptr "mysql_row_tell" mysql-res-ptr))
1144
1145; 24.2.3.53. mysql_select_db()
1146; int mysql_select_db(MYSQL *mysql, const char *db)
1147(define foreign-mysql-select-db
1148  (foreign-lambda integer "mysql_select_db" mysql-ptr c-string))
1149
1150; 24.2.3.54. mysql_set_character_set()
1151; int mysql_set_character_set(MYSQL *mysql, char *csname)
1152(define foreign-mysql-set-character-set
1153  (foreign-lambda integer "mysql_set_character_set" mysql-ptr c-string))
1154
1155; 24.2.3.55. mysql_set_server_option()
1156; int mysql_set_server_option(MYSQL *mysql, enum enum_mysql_set_option option)
1157(define foreign-mysql-set-server-option
1158  (foreign-lambda integer "mysql_set_server_option" mysql-ptr mysql-server-option))
1159
1160; 24.2.3.56. mysql_shutdown()
1161; int mysql_shutdown(MYSQL *mysql, enum enum_shutdown_level shutdown_level)
1162(define foreign-mysql-shutdown
1163  (foreign-lambda integer "mysql_shutdown" mysql-ptr integer))
1164
1165; 24.2.3.57. mysql_sqlstate()
1166; const char *mysql_sqlstate(MYSQL *mysql)
1167(define foreign-mysql-sqlstate
1168  (foreign-lambda c-string "mysql_sqlstate" mysql-ptr))
1169
1170; 24.2.3.58. mysql_ssl_set()
1171; int mysql_ssl_set(MYSQL *mysql, const char *key, const char *cert,
1172;   const char *ca, const char *capath, const char *cipher)
1173(define foreign-mysql-ssl-set
1174  (foreign-lambda integer "mysql_ssl_set" mysql-ptr c-string c-string
1175                  c-string c-string c-string))
1176
1177; 24.2.3.59. mysql_stat()
1178; char *mysql_stat(MYSQL *mysql)
1179(define foreign-mysql-stat
1180  (foreign-lambda c-string "mysql_stat" mysql-ptr))
1181
1182; 24.2.3.60. mysql_store_result()
1183; MYSQL_RES *mysql_store_result(MYSQL *mysql)
1184(define foreign-mysql-store-result
1185  (foreign-lambda mysql-res-ptr "mysql_store_result" mysql-ptr))
1186
1187; 24.2.3.61. mysql_thread_id()
1188; unsigned long mysql_thread_id(MYSQL *mysql)
1189(define foreign-mysql-thread-id
1190  (foreign-lambda unsigned-long "mysql_thread_id" mysql-ptr))
1191
1192; 24.2.3.62. mysql_use_result()
1193; MYSQL_RES *mysql_use_result(MYSQL *mysql)
1194(define foreign-mysql-use-result
1195  (foreign-lambda mysql-res-ptr "mysql_use_result" mysql-ptr))
1196
1197; 24.2.3.63. mysql_warning_count()
1198; unsigned int mysql_warning_count(MYSQL *mysql)
1199(define foreign-mysql-warning-count
1200  (foreign-lambda unsigned-integer "mysql_warning_count" mysql-ptr))
1201
1202; 24.2.3.64. mysql_commit()
1203; my_bool mysql_commit(MYSQL *mysql)
1204(define foreign-mysql-commit
1205  (foreign-lambda my-bool "mysql_commit" mysql-ptr))
1206
1207; 24.2.3.65. mysql_rollback()
1208; my_bool mysql_rollback(MYSQL *mysql)
1209(define foreign-mysql-rollback
1210  (foreign-lambda my-bool "mysql_rollback" mysql-ptr))
1211
1212; 24.2.3.66. mysql_autocommit()
1213; my_bool mysql_autocommit(MYSQL *mysql, my_bool mode)
1214(define foreign-mysql-autocommit
1215  (foreign-lambda my-bool "mysql_autocommit" mysql-ptr my-bool))
1216
1217; 24.2.3.67. mysql_more_results()
1218; my_bool mysql_more_results(MYSQL *mysql)
1219(define foreign-mysql-more-results
1220  (foreign-lambda my-bool "mysql_more_results" mysql-ptr))
1221
1222; 24.2.3.68. mysql_next_result()
1223; int mysql_next_result(MYSQL *mysql)
1224(define foreign-mysql-next-result
1225  (foreign-lambda integer "mysql_next_result" mysql-ptr))
1226
1227;=======================================================================
1228; Provided Scheme API.
1229;
1230; This is an attempt at a Schemer-friendly API to MySQL. Much of the API
1231; is the same, but the C API has been simplified where possible, and a
1232; few additional features have been layered on.
1233;
1234
1235; record printer helper
1236(define (record-slot->string val lbl #!optional (tst val))
1237  (if tst
1238      (conc #\space lbl #\: #\space #\" val #\")
1239      "") )
1240
1241(define (unsigned-long-array->u32vector ulptr cnt)
1242  (let* ([siz (* cnt UNSIGNED-LONG-SIZE)]
1243         [store (make-blob siz)])
1244    (move-memory! ulptr store siz)
1245    (blob->u32vector/shared store) ) )
1246
1247#; ; UNUSED
1248(define char-pointer->string
1249  (foreign-lambda* c-string ((c-pointer chrptr))
1250    "return ((char *) chrptr);") )
1251
1252(define (binary-char-pointer->string chrptr size)
1253  (let ([blob (make-blob size)])
1254    (move-memory! chrptr blob size)
1255    (blob->string blob) ) )
1256
1257(define (%mysql-get-field-index resptr field fldcnt)
1258  (let ([fldidx (if (number? field)
1259                    field
1260                    (foreign-mysqlaux-field-index resptr
1261                                                  (->string field) fldcnt))])
1262    (and (<= 0 fldidx) (< fldidx fldcnt)
1263         fldidx ) ) )
1264
1265(define (%mysql-options mysqlptr opt val)
1266  (cond [(null? val)
1267          (foreign-mysqlaux-options-none mysqlptr opt)]
1268        [(string? val)
1269          (foreign-mysqlaux-options-string mysqlptr opt val)]
1270        [(number? val)
1271          (foreign-mysqlaux-options-ulong mysqlptr opt val)]
1272        [else
1273          1 ] ) )
1274
1275;-----------------------------------------------------------------------
1276; MySQL exceptions
1277;
1278
1279(define (make-exn-condition loc msg . args)
1280  (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
1281
1282(define (make-mysql-condition)
1283  (make-property-condition 'mysql) )
1284
1285(define (make-exn-mysql-condition loc msg . args)
1286  (make-composite-condition
1287   (apply make-exn-condition loc msg args)
1288   (make-mysql-condition)) )
1289
1290(define (signal-mysql-condition loc msg . args)
1291  (signal (apply make-exn-mysql-condition loc msg args)) )
1292
1293(define (signal-mysql-error loc conn . args)
1294  (let ([msg (or (mysql-error conn)
1295                 (mysql-errno conn))])
1296    (apply signal-mysql-condition loc msg args) ) )
1297
1298;-----------------------------------------------------------------------
1299; MySQL "SSL" record type definition.
1300;
1301; See <http://www.openssl.org/docs/apps/ciphers.html> for a discussion
1302; of the cipher-list format.
1303;
1304
1305(define-record-type mysql-ssl
1306  (%make-mysql-ssl key cert ca capath cipher)
1307  mysql-ssl?
1308  (key mysql-ssl-key-pathname)
1309  (cert mysql-ssl-certificate-pathname)
1310  (ca mysql-ssl-certificate-authority-pathname)
1311  (capath mysql-ssl-trusted-certificates-pathname)
1312  (cipher mysql-ssl-ciphers) )
1313
1314(define (make-mysql-ssl #!key key certificate certificate-authority
1315                              trusted-certificates ciphers)
1316  (%make-mysql-ssl key certificate certificate-authority trusted-certificates ciphers) )
1317
1318(define-record-printer (mysql-ssl ssl out)
1319  (let ([key (mysql-ssl-key-pathname ssl)]
1320        [cert (mysql-ssl-certificate-pathname ssl)]
1321        [ca (mysql-ssl-certificate-authority-pathname ssl)]
1322        [capath (mysql-ssl-trusted-certificates-pathname ssl)]
1323        [cipher (mysql-ssl-ciphers ssl)])
1324    (display
1325     (string-append
1326      "#<mysql-ssl"
1327      (record-slot->string key      "key")
1328      (record-slot->string cert     "cert")
1329      (record-slot->string ca       "ca")
1330      (record-slot->string capath   "capath")
1331      (record-slot->string cipher   "cipher")
1332      ">")
1333     out) ) )
1334
1335;-----------------------------------------------------------------------
1336; MySQL connection options helper.
1337;
1338
1339(define (make-mysql-options . opts)
1340  (let loop ([opts opts] [alst '()])
1341    (if (null? opts)
1342        alst
1343        (let* ([opt (car opts)]
1344               [nxt (cdr opts)]
1345               [val (if (null? nxt)
1346                        (error 'make-options "missing value for option" opt)
1347                        (car nxt))])
1348          (unless (number? opt)
1349            (error 'make-options "invalid option" opt) )
1350          (unless (or (number? val) (string? val) (not val) (null? val))
1351            (error 'make-options "invalid option value" val) )
1352          (loop (cdr nxt) (alist-cons opt val alst)) ) ) ) )
1353
1354;-----------------------------------------------------------------------
1355; MySQL "Connection" record type definition.
1356;
1357; I've stuffed the raw FFI pointer into a slot in the mysql-connection
1358; record. The record is here for a few reasons:
1359;
1360;   1) Instead of an ugly #<pointer>, I've defined a pretty printer
1361;      to demonstrate that we've actually got a MySQL connection.
1362;   2) The C API is somewhat more verbose than what normal usage would
1363;      need. (For example, usually you don't care whether results are
1364;      all read into memory as fast as possible, or if they're read from
1365;      the network one-by-one. Thus, the mysql-query function provided
1366;      automatically reads the results into memory. For finer granularity,
1367;      you're always free to write your own version to use the "raw"
1368;      foreign-* functions. I suppose a contribution to determine this
1369;      behavior via a (make-parameter ...) parameter may also be
1370;      accepted. ;)) Slots are provided in the mysql-connection record
1371;      type to allow for this sort of simplifying behavior.
1372;
1373; All of the "Scheme API" MySQL functions take instances of this record
1374; type, instead of a raw FFI pointer (as the foreign-* functions require).
1375;
1376
1377(define-record-type mysql-connection
1378  (make-mysql-connection host user passwd db port unix-socket
1379                         client-flag ptr result result-start ssl opts
1380                         #;stmt #;bind)
1381  mysql-connection?
1382  (host mysql-connection-host)
1383  (user mysql-connection-user)
1384  (passwd mysql-connection-passwd)
1385  (db mysql-connection-db)
1386  (port mysql-connection-port)
1387  (unix-socket mysql-connection-unix-socket)
1388  (client-flag mysql-connection-client-flag)
1389  (ptr mysql-connection-ptr mysql-connection-ptr-set!)
1390  (result mysql-connection-result mysql-connection-result-set!)
1391  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
1392  (ssl mysql-connection-ssl)
1393  (opts mysql-connection-options)
1394  #;(stmt mysql-connection-statement mysql-connection-statement-set!)
1395  #;(bind mysql-connection-binding mysql-connection-binding-set!) )
1396
1397(define-record-printer (mysql-connection conn out)
1398  (let ([host (mysql-connection-host conn)]
1399        [user (mysql-connection-user conn)]
1400        [passwd (mysql-connection-passwd conn)]
1401        [db (mysql-connection-db conn)]
1402        [tcp-port (mysql-connection-port conn)]
1403        [unix-socket (mysql-connection-unix-socket conn)]
1404        [client-flag (mysql-connection-client-flag conn)]
1405        [ssl (mysql-connection-ssl conn)]
1406        [opts (mysql-connection-options conn)]
1407        #;[stmt (mysql-connection-statement conn)]
1408        #;[bind (mysql-connection-binding conn)])
1409    (display
1410     (string-append
1411      "#<mysql-connection"
1412      (if (mysql-connection-ptr conn)
1413          (string-append
1414            (record-slot->string host         "host")
1415            (record-slot->string user         "user")
1416            (record-slot->string passwd       "passwd")
1417            (record-slot->string db           "db")
1418            (record-slot->string tcp-port     "tcp-port"    (not (zero? tcp-port)))
1419            (record-slot->string unix-socket  "unix-socket")
1420            (record-slot->string client-flag  "client-flag" (not (zero? client-flag)))
1421            (record-slot->string ssl          "ssl")
1422            (record-slot->string opts         "options")
1423            #;(record-slot->string stmt         "statement")
1424            #;(record-slot->string bind         "binding") )
1425          " INVALID")
1426      ">")
1427     out) ) )
1428
1429;-----------------------------------------------------------------------
1430; The "base" MySQL/Scheme API.
1431;
1432; This part of the API provides a slightly simplified version of the full
1433; MySQL C API.
1434;
1435
1436(define (mysql-affected-rows conn)
1437  (let ([cnt (foreign-mysql-affected-rows (mysql-connection-ptr conn))])
1438    (and (not (= -1 cnt))
1439         cnt ) ) )
1440
1441(define (mysql-change-user conn #!key (user #f) (passwd #f) (db #f))
1442  (foreign-mysql-change-user (mysql-connection-ptr conn) user passwd db) )
1443
1444(define (mysql-character-set-name conn)
1445  (foreign-mysql-character-set-name (mysql-connection-ptr conn)))
1446
1447; Closes a mysql connection and invalidates the mysql connection object.
1448; Returns (void). You should do this when you're done with the MySQL
1449; connection; however, if you don't close it manually, it will be closed
1450; upon termination.
1451(define (mysql-close conn)
1452  #;(%mysql-stmt-close conn)
1453  (mysql-free-result conn)
1454  (foreign-mysql-close (mysql-connection-ptr conn))
1455  (mysql-connection-ptr-set! conn #f) )
1456
1457; Returns a mysql connection object, or #f on failure.
1458(define (mysql-connect #!key (host #f) (user #f) (passwd #f) (db #f) (port 0)
1459                       (unix-socket #f) (client-flag 0)
1460                       (options #f) (ssl #f))
1461  (let ([mysql (foreign-mysql-init #f)])
1462    (cond
1463      [mysql
1464        (when ssl
1465          (foreign-mysql-ssl-set mysql
1466                                 (mysql-ssl-key-pathname ssl)
1467                                 (mysql-ssl-certificate-pathname ssl)
1468                                 (mysql-ssl-certificate-authority-pathname ssl)
1469                                 (mysql-ssl-trusted-certificates-pathname ssl)
1470                                 (mysql-ssl-ciphers ssl)) )
1471        (when options
1472          (for-each
1473           (lambda (optitm)
1474             (let ([opt (car optitm)]
1475                   [val (cdr optitm)])
1476               (unless (zero? (%mysql-options mysql opt val))
1477                 (signal-mysql-condition 'mysql-connect "unknown option" opt val))))
1478           options) )
1479        (let ([mysqlptr (foreign-mysql-real-connect mysql
1480                                                    host user passwd
1481                                                    db
1482                                                    port unix-socket
1483                                                    client-flag)])
1484          (if mysqlptr
1485              (make-mysql-connection host user passwd db port unix-socket
1486                                     client-flag mysqlptr #f #f options ssl
1487                                     #;#f #;#f)
1488              (signal-mysql-condition 'mysql-connect
1489               (foreign-mysql-error mysql)
1490               host user passwd db port unix-socket client-flag options ssl options) ) ) ]
1491      [else
1492        (signal-mysql-condition 'mysql-connect "failed to initialize mysql") ] ) ) )
1493
1494(define (mysql-debug debug)
1495  (foreign-mysql-debug debug) )
1496
1497(define (mysql-dump-debug-info conn)
1498  (foreign-mysql-dump-debug-info (mysql-connection-ptr conn)) )
1499
1500(define (mysql-errno conn)
1501  (foreign-mysql-errno (mysql-connection-ptr conn)))
1502
1503; Returns a string describing the last mysql error, or #f if no error
1504; has occurred.
1505(define (mysql-error conn)
1506  (let ([errstr (foreign-mysql-error (mysql-connection-ptr conn))])
1507    (and (not (string=? "" errstr))
1508         errstr) ) )
1509
1510(define (mysql-escape-string conn str)
1511        (let-location ([escstr c-string*])
1512    ((foreign-lambda* void ((mysql-ptr mysql) (c-pointer to) (c-string from) (unsigned-long length))
1513      "if ((*((char **) to) = ((char *) C_malloc ((2 * length) + 1)))) {\n"
1514      "    (void) mysql_real_escape_string (mysql, *((char **) to), from, length);\n"
1515      "}")
1516     #$escstr
1517     str (string-length str))
1518    escstr ) )
1519
1520; returns a mysql-field-ptr or #f when no more fields.
1521; returns #f when no result set.
1522(define (mysql-fetch-field conn)
1523  (and-let* ([resptr (mysql-connection-result conn)])
1524    (foreign-mysql-fetch-field resptr) ) )
1525
1526; returns a mysql-field-ptr to a vector of MYSQL_FIELD or #f when no fields.
1527; returns #f when no result set.
1528(define (mysql-fetch-fields conn)
1529  (and-let* ([resptr (mysql-connection-result conn)])
1530    (foreign-mysql-fetch-fields resptr) ) )
1531
1532; returns a mysql-field-ptr or #f when no such field.
1533; returns #f when no result set.
1534(define (mysql-fetch-field-direct conn field-number)
1535  (and-let* ([resptr (mysql-connection-result conn)])
1536    (foreign-mysql-fetch-field-direct resptr field-number) ) )
1537
1538; returns a u32vector of length num-fields.
1539; returns #f when no result set.
1540(define (%mysql-fetch-lengths resptr cnt)
1541  (and-let* ([ulptr (foreign-mysql-fetch-lengths resptr)])
1542    (unsigned-long-array->u32vector ulptr cnt) ) )
1543
1544; returns a u32vector of length num-fields.
1545; returns #f when no result set.
1546(define (mysql-fetch-lengths conn)
1547  (and-let* ([resptr (mysql-connection-result conn)])
1548    (%mysql-fetch-lengths resptr (foreign-mysql-num-fields resptr)) ) )
1549
1550; After a mysql-query that has results, use mysql-fetch-row to retrieve
1551; results row-by-row. When no more rows are left, returns #f. When returning
1552; a "row", returns a procedure that takes exactly 1 argument, which may
1553; be either a number (in which case it is treated as the column index,
1554; starting at zero) or a symbol or string (which will be treated as the
1555; column name).
1556(define (mysql-fetch-row conn)
1557  (and-let* ([resptr (mysql-connection-result conn)]
1558             [row (foreign-mysql-fetch-row resptr)])
1559    (let ([fldcnt (foreign-mysql-num-fields resptr)]
1560          [fldlens #f])
1561      (lambda (field)
1562        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
1563          (if (foreign-mysqlaux-is-binary-field resptr fldidx)
1564              (binary-char-pointer->string
1565               (foreign-mysqlaux-fetch-column-data-direct row fldidx)
1566               (u32vector-ref
1567                (or fldlens
1568                    (begin
1569                      (set! fldlens (%mysql-fetch-lengths resptr fldcnt))
1570                      fldlens ) )
1571                fldidx))
1572              (foreign-mysqlaux-fetch-column-string-direct row fldidx) ) ) ) ) ) )
1573
1574(define (mysql-field-count conn)
1575  (foreign-mysql-field-count (mysql-connection-ptr conn)) )
1576
1577(define (mysql-free-result conn)
1578  (and-let* ([res (mysql-connection-result conn)])
1579    (foreign-mysql-free-result res) )
1580  (mysql-connection-result-set! conn #f)
1581  (mysql-connection-result-start-set! conn #f) )
1582
1583; returns a c-pointer to a MY_CHARSET_INFO struct.
1584; a finalizer is supplied.
1585(define (mysql-get-character-set-info conn)
1586  (let ([chrsetinfo (allocate-my-charset-info)])
1587    (foreign-mysql-get-character-set-info (mysql-connection-ptr conn) chrsetinfo)
1588    (set-finalizer! chrsetinfo free-my-charset-info)
1589    chrsetinfo ) )
1590
1591(define (mysql-get-client-info)
1592  (foreign-mysql-get-client-info) )
1593
1594(define (mysql-get-client-version)
1595  (foreign-mysql-get-client-version) )
1596
1597(define (mysql-get-host-info conn)
1598  (foreign-mysql-get-host-info (mysql-connection-ptr conn)) )
1599
1600(define (mysql-get-proto-info conn)
1601  (foreign-mysql-get-proto-info (mysql-connection-ptr conn)) )
1602
1603(define (mysql-get-server-info conn)
1604  (foreign-mysql-get-server-info (mysql-connection-ptr conn)) )
1605
1606(define (mysql-get-server-version conn)
1607  (foreign-mysql-get-server-version (mysql-connection-ptr conn)) )
1608
1609(define (mysql-info conn)
1610  (foreign-mysql-info (mysql-connection-ptr conn)) )
1611
1612(define (mysql-insert-id conn)
1613  (foreign-mysql-insert-id (mysql-connection-ptr conn)) )
1614
1615(define (mysql-kill conn pid)
1616  (foreign-mysql-kill (mysql-connection-ptr conn) pid) )
1617
1618(define (mysql-list-dbs conn like)
1619  (mysql-free-result conn)
1620  (mysql-connection-result-set! conn
1621    (foreign-mysql-list-dbs (mysql-connection-ptr conn) like)) )
1622
1623(define (mysql-list-fields conn table wild)
1624  (mysql-free-result conn)
1625  (mysql-connection-result-set! conn
1626    (foreign-mysql-list-fields (mysql-connection-ptr conn) table wild)) )
1627
1628(define (mysql-list-processes conn)
1629  (mysql-free-result conn)
1630  (mysql-connection-result-set! conn
1631    (foreign-mysql-list-processes (mysql-connection-ptr conn))) )
1632
1633(define (mysql-list-tables conn wild)
1634  (mysql-free-result conn)
1635  (mysql-connection-result-set! conn
1636    (foreign-mysql-list-tables (mysql-connection-ptr conn) wild)) )
1637
1638(define (mysql-num-fields conn)
1639  (foreign-mysql-num-fields (mysql-connection-result conn)) )
1640
1641(define (mysql-num-rows conn)
1642  (and-let* ([res (mysql-connection-result conn)])
1643    (foreign-mysql-num-rows res)) )
1644
1645(define (mysql-ping conn)
1646  (foreign-mysql-ping (mysql-connection-ptr conn)) )
1647
1648; returns #t if the query was successful, signals exception otherwise.
1649(define (mysql-query conn query)
1650  (let ([mysql-ptr (mysql-connection-ptr conn)])
1651    ; zero indicates success
1652    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
1653        (begin (mysql-store-result conn) #t)
1654        (signal-mysql-error 'mysql-query conn query) ) ) )
1655
1656; returns #t if the select was successful, signals exception otherwise.
1657(define (mysql-select-db conn db)
1658  (or (zero? (foreign-mysql-select-db (mysql-connection-ptr conn) db))
1659      (signal-mysql-error 'mysql-select-db conn db) ) )
1660
1661; returns #t if the set was successful, signals exception otherwise.
1662(define (mysql-set-character-set conn csname)
1663  (or (zero? (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
1664      (signal-mysql-condition 'mysql-set-character-set "bad character set name" csname) ) )
1665
1666(define (mysql-stat conn)
1667  (foreign-mysql-stat (mysql-connection-ptr conn)) )
1668
1669(define (mysql-store-result conn)
1670  (mysql-connection-result-set! conn
1671    (foreign-mysql-store-result (mysql-connection-ptr conn)))
1672  (mysql-connection-result-start-set! conn
1673    (and (mysql-connection-result conn)
1674         (foreign-mysql-row-tell (mysql-connection-result conn))) ) )
1675
1676(define (mysql-thread-id conn)
1677  (foreign-mysql-thread-id (mysql-connection-ptr conn)) )
1678
1679;-----------------------------------------------------------------------
1680; The "extended" MySQL/Scheme API.
1681;
1682; This API provides some additional functionality.
1683;
1684
1685; rewinds to the beginning of the result set. has no effect if there is no
1686; current result set.
1687(define (mysql-rewind conn)
1688  (and-let* ([resptr (mysql-connection-result-start conn)])
1689    (foreign-mysql-row-seek (mysql-connection-result conn) resptr) ) )
1690
1691;-----------------------------------------------------------------------
1692; The "map" MySQL/Scheme API.
1693;
1694; This API provides some additional functionality for traversing results
1695; in a Scheme-ish way.
1696;
1697
1698; calls proc on every row in the current result set. proc should take 3
1699; arguments: the row (as described for mysql-fetch-row), the row index
1700; (which starts with 1 and ends with (mysql-num-rows conn)), and the
1701; current accumulated value.
1702;
1703; returns the final accumulated value.
1704;
1705; note: rewinds the result set before and after iterating over it; thus,
1706; all rows are included.
1707;
1708; you must call mysql-rewind if you later want to iterate over the result set
1709; using mysql-fetch-row.
1710(define (mysql-row-fold conn proc init)
1711  (mysql-rewind conn)
1712  (let loop ([rownum 1] [acc init])
1713    (let ([row (mysql-fetch-row conn)])
1714      (if row
1715          (loop (+ rownum 1) (proc row rownum acc))
1716          acc ) ) ) )
1717
1718; calls proc on every row in the current result set. proc should take 2
1719; arguments: the row (as described for mysql-fetch-row) and the row index
1720; (which starts with 1 and ends with (mysql-num-rows conn)).
1721;
1722; note: rewinds the result set before and after iterating over it; thus,
1723; all rows are included.
1724;
1725; you must call mysql-rewind if you later want to iterate over the result set
1726; using mysql-fetch-row.
1727(define (mysql-row-for-each conn proc)
1728  (mysql-row-fold conn
1729                  (lambda (row rownum _) (proc row rownum))
1730                  #t) )
1731
1732; calls proc on every row in the current result set. proc should take 2
1733; arguments: the row (as described for mysql-fetch-row) and the row index
1734; (which starts with 1 and ends with (mysql-num-rows conn)).
1735;
1736; returns a list of the results of each proc invocation.
1737;
1738; note: rewinds the result set before and after iterating over it; thus,
1739; all rows are included.
1740;
1741; you must call mysql-rewind if you later want to iterate over the result set
1742; using mysql-fetch-row.
1743(define (mysql-row-map conn proc)
1744  (reverse!
1745    (mysql-row-fold conn
1746                    (lambda (row rownum lst) (cons (proc row rownum) lst))
1747                    '())) )
1748
1749; executes query and then mysql-row-for-each with the given proc. the proc
1750; must meet the contract specified for the proc passed to mysql-row-for-each.
1751(define (mysql-query-fold conn query proc init)
1752  (mysql-query conn query)
1753  (mysql-row-fold conn proc init) )
1754
1755; executes query and then mysql-row-for-each with the given proc. the proc
1756; must meet the contract specified for the proc passed to mysql-row-for-each.
1757(define (mysql-query-for-each conn query proc)
1758  (mysql-query conn query)
1759  (mysql-row-for-each conn proc) )
1760
1761; executes query and then mysql-row-for-each with the given proc. the proc
1762; must meet the contract specified for the proc passed to mysql-row-for-each.
1763(define (mysql-query-map conn query proc)
1764  (mysql-query conn query)
1765  (mysql-row-map conn proc) )
1766
1767; synonyms
1768(define mysql-query-foreach mysql-query-for-each)
1769(define mysql-foreach-row mysql-row-for-each)
1770
1771;-----------------------------------------------------------------------
1772; The MySQL Field structure predicate API.
1773;
1774
1775(define (mysql-field-flags-test fldptr mask)
1776  (bitwise-and (mysql-field-flags fldptr) mask) )
1777
1778(define (mysql-field-flags-mask flags)
1779  (apply bitwise-ior flags) )
1780
1781;;
1782
1783(define (mysql-field-flags-on? fldptr . flags)
1784  (let ([mask (mysql-field-flags-mask flags)])
1785    (= mask (mysql-field-flags-test fldptr mask)) ) )
1786
1787(define (mysql-field-flags-off? fldptr . flags)
1788  (zero? (mysql-field-flags-test fldptr (mysql-field-flags-mask flags))) )
1789
1790;;
1791
1792(define (mysql-field-type-any? fldptr . types)
1793  (memv (mysql-field-type fldptr) types) )
1794
1795(define (mysql-field-type=? fldptr type)
1796  (eqv? type (mysql-field-type fldptr)) )
1797
1798;;
1799
1800(define (mysql-field-primary-key? fldptr)
1801  (mysql-field-flags-on? fldptr pri-key-flag) )
1802
1803(define (mysql-field-not-null? fldptr)
1804  (mysql-field-flags-on? fldptr not-null-flag) )
1805
1806(define (mysql-field-binary? fldptr)
1807  (= 63 (mysql-field-charsetnr fldptr)) )
1808
1809(define (mysql-field-numeric? fldptr)
1810  (mysql-field-flags-on? fldptr num-flag) )
1811
1812;;
1813
1814(define mysql-field-type-clock?
1815  (let ([numtypes (list mysql-type-timestamp mysql-type-datetime
1816                        mysql-type-date mysql-type-time
1817                        mysql-type-newdate mysql-type-year)])
1818    (lambda (fldptr)
1819      (apply mysql-field-type-any? fldptr numtypes) ) ) )
1820
1821; note - not the same as the "IS_NUM" macro.
1822(define mysql-field-type-number?
1823  (let ([numtypes (list mysql-type-decimal mysql-type-tiny mysql-type-short
1824                            mysql-type-long mysql-type-float mysql-type-double
1825                        mysql-type-longlong mysql-type-newdecimal
1826                        mysql-type-bit)])
1827    (lambda (fldptr)
1828      (apply mysql-field-type-any? fldptr numtypes) ) ) )
1829
1830(define mysql-field-type-blob?
1831  (let ([blobtypes (list mysql-type-tiny-blob mysql-type-medium-blob
1832                         mysql-type-long-blob mysql-type-blob)])
1833    (lambda (fldptr)
1834      (apply mysql-field-type-any? fldptr blobtypes) ) ) )
1835
1836(define mysql-field-type-string?
1837  (let ([numtypes (list mysql-type-varchar mysql-type-var-string
1838                        mysql-type-string
1839                        mysql-type-enum mysql-type-set)])
1840    (lambda (fldptr)
1841      (apply mysql-field-type-any? fldptr numtypes) ) ) )
1842
1843;;
1844
1845; note - the same as the "IS_NUM" macro.
1846(define mysql-field-type-magnitude?
1847  (let ([magtypes (list mysql-type-timestamp mysql-type-year mysql-type-null)])
1848    (lambda (fldptr)
1849      (or (mysql-field-type-number? fldptr)
1850          (apply mysql-field-type-any? fldptr magtypes) ) ) ) )
1851
1852(define (mysql-field-type-binary? fldptr)
1853  (and (mysql-field-binary? fldptr)
1854       (or (mysql-field-type-blob? fldptr)
1855           (mysql-field-type-string? fldptr) ) ) )
1856
1857(define (mysql-field-type-text? fldptr)
1858  (and (not (mysql-field-binary? fldptr))
1859       (or (mysql-field-type-blob? fldptr)
1860           (mysql-field-type-string? fldptr) ) ) )
1861
1862;-----------------------------------------------------------------------
1863; The MySQL Field structure multi-slot API.
1864;
1865
1866; returns a list of field items.
1867(define (mysql-field-slots fldptr . getters)
1868  (and fldptr
1869       (map (cut <> fldptr) getters) ) )
1870
1871; returns a list of field items for nth field.
1872(define (mysql-fetch-field-slots-direct conn nth . getters)
1873  (apply mysql-field-slots (mysql-fetch-field-direct conn nth) getters) )
1874
1875; returns a field item for nth field.
1876(define (mysql-fetch-field-slot-direct conn nth getter)
1877  (and-let* ([lst (mysql-field-slots (mysql-fetch-field-direct conn nth) getter)])
1878    (car lst) ) )
1879
1880; returns a list of field items for the next field.
1881(define (mysql-fetch-field-slots conn . getters)
1882  (apply mysql-field-slots (mysql-fetch-field conn) getters) )
1883
1884; returns a field item for the next field.
1885(define (mysql-fetch-field-slot conn getter)
1886  (and-let* ([lst (mysql-field-slots (mysql-fetch-field conn) getter)])
1887    (car lst) ) )
1888
1889; returns a field pointer or #f.
1890(define (mysql-fetch-field-specific conn field)
1891  (and-let* ([resptr (mysql-connection-result conn)]
1892             [fldidx (%mysql-get-field-index resptr field (foreign-mysql-num-fields resptr))])
1893    (foreign-mysql-fetch-field-direct resptr fldidx) ) )
1894
1895#|
1896;=======================================================================
1897; The MYSQL_TIME API.
1898;
1899
1900(declare
1901  (export
1902    ;; enum enum_mysql_timestamp_type
1903    mysql-timestamp-date
1904    mysql-timestamp-datetime
1905    mysql-timestamp-error
1906    mysql-timestamp-none
1907    mysql-timestamp-time
1908    ;
1909    mysql-timestamp-type-symbol
1910    mysql-timestamp-type-value
1911    ;; MYSQL_TIME
1912    mysql-time-day-set!
1913    mysql-time-hour-set!
1914    mysql-time-minute-set!
1915    mysql-time-month-set!
1916    mysql-time-neg-set!
1917    mysql-time-second-part-set!
1918    mysql-time-second-set!
1919    mysql-time-time-type-set!
1920    mysql-time-year-set!
1921    ;
1922    mysql-time-day
1923    mysql-time-hour
1924    mysql-time-minute
1925    mysql-time-month
1926    mysql-time-neg
1927    mysql-time-second
1928    mysql-time-second-part
1929    mysql-time-time-type
1930    mysql-time-year
1931    ;
1932    make-mysql-time
1933    allocate-myysql-time
1934    free-mysql-time ) )
1935
1936;;
1937
1938(define-foreign-type mysql-time-ptr (c-pointer "MYSQL_TIME"))
1939
1940;;
1941
1942(define-foreign-enum (mysql-timestamp-type (enum "enum_mysql_timestamp_type"))
1943  #f  ; No aliases!
1944  MYSQL_TIMESTAMP_NONE
1945  MYSQL_TIMESTAMP_ERROR
1946  MYSQL_TIMESTAMP_DATE
1947  MYSQL_TIMESTAMP_DATETIME
1948  MYSQL_TIMESTAMP_TIME )
1949
1950(gen-public-enum mysql-timestamp-type
1951  MYSQL_TIMESTAMP_NONE
1952  MYSQL_TIMESTAMP_ERROR
1953  MYSQL_TIMESTAMP_DATE
1954  MYSQL_TIMESTAMP_DATETIME
1955  MYSQL_TIMESTAMP_TIME )
1956;;
1957
1958(define-foreign-record (mysql-time "MYSQL_TIME")
1959  (rename: c-name->scheme-name)
1960  (constructor: allocate-myysql-time)
1961  (destructor: free-mysql-time)
1962  (unsigned-int year)
1963  (unsigned-int month)
1964  (unsigned-int day)
1965  (unsigned-int hour)
1966  (unsigned-int minute)
1967  (unsigned-int second)
1968  (unsigned-long second_part)
1969  (my-bool neg)
1970  (mysql-timestamp-type time_type) )
1971
1972(define (make-mysql-time type #!key (year 0) (month 0) (day 0)
1973                                    (hour 0) (minute 0) (second 0)
1974                                    (second-part 0)
1975                                    is-negative)
1976  (let ([timptr (allocate-myysql-time)])
1977    (mysql-time-time-type-set! timptr type)
1978    (mysql-time-year-set! timptr year)
1979    (mysql-time-month-set! timptr month)
1980    (mysql-time-day-set! timptr day)
1981    (mysql-time-hour-set! timptr hour)
1982    (mysql-time-minute-set! timptr minute)
1983    (mysql-time-second-set! timptr second)
1984    (mysql-time-second-part-set! timptr second-part)
1985    (mysql-time-neg-set! timptr is-negative)
1986    (set-finalizer! timptr free-mysql-time)
1987    timptr ) )
1988
1989;=======================================================================
1990; The MySQL prepared statement API.
1991;
1992
1993(declare
1994  (bound-to-procedure
1995    mysql-stmt-errno
1996    mysql-stmt-error
1997    mysql-stmt-sqlstate )
1998  (export
1999    ;;
2000    stmt-attr-cursor-type
2001    stmt-attr-prefetch-rows
2002    stmt-attr-update-max-length
2003    ;
2004    mysql-stmt-attr-type-symbol
2005    mysql-stmt-attr-type-value
2006    ;;
2007    mysql-stmt-init-done
2008    mysql-stmt-execute-done
2009    mysql-stmt-prepare-done
2010    mysql-stmt-fetch-done
2011    ;
2012    mysql-stmt-state-symbol
2013    mysql-stmt-state-value
2014    ;;
2015    mysql-no-data
2016    mysql-data-truncated
2017    ;
2018    mysql-status-return-code-symbol
2019    mysql-status-return-code-value
2020    ;;
2021    foreign-mysql-stmt-affected-rows
2022    foreign-mysql-stmt-attr-get
2023    foreign-mysql-stmt-attr-set
2024    foreign-mysql-stmt-bind-param
2025    foreign-mysql-stmt-bind-result
2026    foreign-mysql-stmt-close
2027    foreign-mysql-stmt-data-seek
2028    foreign-mysql-stmt-errno
2029    foreign-mysql-stmt-error
2030    foreign-mysql-stmt-execute
2031    foreign-mysql-stmt-fetch
2032    foreign-mysql-stmt-fetch-column
2033    foreign-mysql-stmt-field-count
2034    foreign-mysql-stmt-free-result
2035    foreign-mysql-stmt-init
2036    foreign-mysql-stmt-insert-id
2037    foreign-mysql-stmt-num-rows
2038    foreign-mysql-stmt-param-count
2039    foreign-mysql-stmt-param-metadata
2040    foreign-mysql-stmt-prepare
2041    foreign-mysql-stmt-reset
2042    foreign-mysql-stmt-result-metadata
2043    foreign-mysql-stmt-row-seek
2044    foreign-mysql-stmt-row-tell
2045    foreign-mysql-stmt-send-long-data
2046    foreign-mysql-stmt-sqlstate
2047    foreign-mysql-stmt-store-result
2048    ;; basic
2049                mysql-stmt-errno
2050                mysql-stmt-error
2051                mysql-stmt-sqlstate
2052                mysql-stmt-init ; custom
2053                #;mysql-stmt-close ; called by custom mysql-stmt-init
2054                mysql-stmt-prepare
2055                mysql-stmt-param-count
2056                mysql-stmt-bind-param
2057                mysql-stmt-execute
2058                mysql-stmt-affected-rows
2059                mysql-stmt-bind-result
2060                mysql-stmt-fetch
2061                mysql-stmt-store-result
2062                mysql-stmt-result-metadata
2063                mysql-stmt-attr-set
2064                mysql-stmt-attr-get
2065    ;; extended
2066                mysql-stmt-rewind
2067                mysql-stmt-row-fetch
2068                mysql-stmt-query
2069    ;; mapping
2070                mysql-stmt-row-fold
2071                mysql-stmt-row-for-each
2072                mysql-stmt-row-map
2073                mysql-stmt-query-fold
2074                mysql-stmt-query-for-each
2075                mysql-stmt-query-map
2076    ;; MYSQL_BIND
2077    allocate-mysql-bind
2078    free-mysql-bind
2079    mysql-bind-ref
2080    mysql-bind-clear!
2081    mysql-bind-param-init
2082    mysql-bind-result-init
2083    ;
2084    mysql-bind-buffer-set!
2085    mysql-bind-buffer-length-set!
2086    mysql-bind-buffer-type-set!
2087    mysql-bind-error-set!
2088    mysql-bind-error-value-set!
2089    mysql-bind-is-null-set!
2090    mysql-bind-is-null-value-set!
2091    mysql-bind-is-unsigned-set!
2092    mysql-bind-length-set!
2093    ;
2094    mysql-bind-buffer
2095    mysql-bind-buffer-length
2096    mysql-bind-buffer-type
2097    mysql-bind-error
2098    mysql-bind-error-value
2099    mysql-bind-is-null
2100    mysql-bind-is-null-value
2101    mysql-bind-is-unsigned
2102    mysql-bind-length ) )
2103
2104;;
2105
2106(define-foreign-type mysql-row-offset mysql-rows-ptr)
2107
2108(define-foreign-type mysql-bind-ptr (c-pointer "MYSQL_BIND"))
2109
2110(define-foreign-type mysql-stmt-ptr (c-pointer "MYSQL_STMT"))
2111
2112;;
2113
2114(define-foreign-enum (mysql-stmt-state (enum "enum_mysql_stmt_state"))
2115  #f  ; No aliases!
2116  MYSQL_STMT_INIT_DONE
2117  MYSQL_STMT_PREPARE_DONE
2118  MYSQL_STMT_EXECUTE_DONE
2119  MYSQL_STMT_FETCH_DONE )
2120
2121(gen-public-enum mysql-stmt-state
2122  MYSQL_STMT_INIT_DONE
2123  MYSQL_STMT_PREPARE_DONE
2124  MYSQL_STMT_EXECUTE_DONE
2125  MYSQL_STMT_FETCH_DONE )
2126
2127(define-foreign-enum (mysql-stmt-attr-type (enum "enum_stmt_attr_type"))
2128  #f  ; No aliases!
2129  STMT_ATTR_UPDATE_MAX_LENGTH
2130  STMT_ATTR_CURSOR_TYPE
2131  STMT_ATTR_PREFETCH_ROWS )
2132
2133(gen-public-enum mysql-stmt-attr-type
2134  STMT_ATTR_UPDATE_MAX_LENGTH
2135  STMT_ATTR_CURSOR_TYPE
2136  STMT_ATTR_PREFETCH_ROWS )
2137
2138(define-foreign-enum (mysql-status-return-code unsigned-int)
2139  #f  ; No aliases!
2140  MYSQL_NO_DATA
2141  MYSQL_DATA_TRUNCATED )
2142
2143(gen-public-enum mysql-status-return-code
2144  MYSQL_NO_DATA
2145  MYSQL_DATA_TRUNCATED )
2146
2147;;
2148
2149;MYSQL_STMT *mysql_stmt_init(MYSQL *mysql)
2150(define foreign-mysql-stmt-init
2151  (foreign-lambda mysql-stmt-ptr "mysql_stmt_init" mysql-ptr))
2152
2153;my_bool mysql_stmt_close(MYSQL_STMT *mysql)
2154(define foreign-mysql-stmt-close
2155        (foreign-lambda my-bool "mysql_stmt_close" mysql-stmt-ptr))
2156
2157;my_bool mysql_stmt_bind_param(MYSQL_STMT *stmt, MYSQL_BIND *bind)
2158(define foreign-mysql-stmt-bind-param
2159        (foreign-lambda my-bool "mysql_stmt_bind_param" mysql-stmt-ptr mysql-bind-ptr))
2160
2161;my_bool mysql_stmt_bind_result(MYSQL_STMT *stmt, MYSQL_BIND *bind)
2162(define foreign-mysql-stmt-bind-result
2163        (foreign-lambda my-bool "mysql_stmt_bind_result" mysql-stmt-ptr mysql-bind-ptr))
2164
2165;int mysql_stmt_execute(MYSQL_STMT *stmt)
2166(define foreign-mysql-stmt-execute
2167        (foreign-lambda int "mysql_stmt_execute" mysql-stmt-ptr))
2168
2169;int mysql_stmt_fetch(MYSQL_STMT *stmt)
2170(define foreign-mysql-stmt-fetch
2171        (foreign-lambda int "mysql_stmt_fetch" mysql-stmt-ptr))
2172
2173;int mysql_stmt_prepare(MYSQL_STMT *stmt, const char *query, unsigned long length)
2174(define foreign-mysql-stmt-prepare
2175        (foreign-lambda int "mysql_stmt_prepare" mysql-stmt-ptr c-string unsigned-long))
2176
2177;int mysql_stmt_fetch_column(MYSQL_STMT *stmt, MYSQL_BIND *bind_arg, unsigned int column, unsigned long offset)
2178(define foreign-mysql-stmt-fetch-column
2179        (foreign-lambda int "mysql_stmt_fetch_column" mysql-stmt-ptr mysql-bind-ptr unsigned-int unsigned-long))
2180
2181;int mysql_stmt_store_result(MYSQL_STMT *stmt)
2182(define foreign-mysql-stmt-store-result
2183        (foreign-lambda int "mysql_stmt_store_result" mysql-stmt-ptr))
2184
2185;unsigned long mysql_stmt_param_count(MYSQL_STMT * stmt)
2186(define foreign-mysql-stmt-param-count
2187        (foreign-lambda unsigned-long "mysql_stmt_param_count" mysql-stmt-ptr))
2188
2189;my_bool mysql_stmt_attr_set(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, const void *attr)
2190(define foreign-mysql-stmt-attr-set
2191        (foreign-lambda my-bool "mysql_stmt_attr_set" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
2192
2193;my_bool mysql_stmt_attr_get(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, void *attr)
2194(define foreign-mysql-stmt-attr-get
2195        (foreign-lambda my-bool "mysql_stmt_attr_get" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
2196
2197#>
2198static my_bool
2199mysqlaux_stmt_attr_set_bool (MYSQL_STMT *stmt, enum enum_stmt_attr_type attr, my_bool value)
2200{
2201  return (mysql_stmt_attr_set (stmt, attr, &value));
2202}
2203
2204static my_bool
2205mysqlaux_stmt_attr_set_ulong (MYSQL_STMT *stmt, enum enum_stmt_attr_type attr, unsigned long value)
2206{
2207  return (mysql_stmt_attr_set (stmt, attr, &value));
2208}
2209<#
2210
2211(define foreign-mysqlaux-stmt-attr-set-bool
2212  (foreign-lambda int "mysqlaux_stmt_attr_set_bool"
2213                      mysql-stmt-ptr mysql-stmt-attr-type my-bool) )
2214
2215(define foreign-mysqlaux-stmt-attr-set-ulong
2216  (foreign-lambda int "mysqlaux_stmt_attr_set_ulong"
2217                      mysql-stmt-ptr mysql-stmt-attr-type unsigned-long) )
2218
2219;my_bool mysql_stmt_reset(MYSQL_STMT * stmt)
2220(define foreign-mysql-stmt-reset
2221        (foreign-lambda my-bool "mysql_stmt_reset" mysql-stmt-ptr))
2222
2223;my_bool mysql_stmt_free_result(MYSQL_STMT *stmt)
2224(define foreign-mysql-stmt-free-result
2225        (foreign-lambda my-bool "mysql_stmt_free_result" mysql-stmt-ptr))
2226
2227;my_bool mysql_stmt_send_long_data(MYSQL_STMT *stmt, unsigned-int param_number, const char *data, unsigned long length)
2228(define foreign-mysql-stmt-send-long-data
2229        (foreign-lambda my-bool "mysql_stmt_send_long_data" mysql-stmt-ptr unsigned-int c-pointer unsigned-long))
2230
2231;MYSQL_RES *mysql_stmt_result_metadata(MYSQL_STMT *stmt)
2232(define foreign-mysql-stmt-result-metadata
2233        (foreign-lambda mysql-res-ptr "mysql_stmt_result_metadata" mysql-stmt-ptr))
2234
2235;MYSQL_RES *mysql_stmt_param_metadata(MYSQL_STMT *stmt)
2236(define foreign-mysql-stmt-param-metadata
2237        (foreign-lambda mysql-res-ptr "mysql_stmt_param_metadata" mysql-stmt-ptr))
2238
2239;unsigned int mysql_stmt_errno(MYSQL_STMT * stmt)
2240(define foreign-mysql-stmt-errno
2241        (foreign-lambda unsigned-int "mysql_stmt_errno" mysql-stmt-ptr))
2242
2243;const char *mysql_stmt_error(MYSQL_STMT * stmt)
2244(define foreign-mysql-stmt-error
2245        (foreign-lambda c-string "mysql_stmt_error" mysql-stmt-ptr))
2246
2247;const char *mysql_stmt_sqlstate(MYSQL_STMT * stmt)
2248(define foreign-mysql-stmt-sqlstate
2249        (foreign-lambda c-string "mysql_stmt_sqlstate" mysql-stmt-ptr))
2250
2251;MYSQL_ROW_OFFSET mysql_stmt_row_seek(MYSQL_STMT *stmt, MYSQL_ROW_OFFSET offset)
2252(define foreign-mysql-stmt-row-seek
2253        (foreign-lambda mysql-row-offset "mysql_stmt_row_seek" mysql-stmt-ptr mysql-row-offset))
2254
2255;MYSQL_ROW_OFFSET mysql_stmt_row_tell(MYSQL_STMT *stmt)
2256(define foreign-mysql-stmt-row-tell
2257        (foreign-lambda mysql-row-offset "mysql_stmt_row_tell" mysql-stmt-ptr))
2258
2259#>
2260static void
2261mysqlaux_stmt_data_seek (MYSQL_STMT *stmt, double offset)
2262{
2263  mysql_stmt_data_seek (stmt, (my_ulonglong) offset);
2264}
2265
2266static double
2267mysqlaux_stmt_num_rows (MYSQL_STMT *stmt)
2268{
2269  return ((double) mysql_stmt_num_rows (stmt));
2270}
2271
2272static double
2273mysqlaux_stmt_affected_rows (MYSQL_STMT *stmt)
2274{
2275  return ((double) mysql_stmt_affected_rows (stmt));
2276}
2277
2278static double
2279mysqlaux_stmt_insert_id (MYSQL_STMT *stmt)
2280{
2281  return ((double) mysql_stmt_insert_id (stmt));
2282}
2283<#
2284
2285;void mysql_stmt_data_seek(MYSQL_STMT *stmt, my_ulonglong offset)
2286(define foreign-mysql-stmt-data-seek
2287        (foreign-lambda void "mysqlaux_stmt_data_seek" mysql-stmt-ptr my-ulonglong))
2288
2289;my_ulonglong mysql_stmt_num_rows(MYSQL_STMT *stmt)
2290(define foreign-mysql-stmt-num-rows
2291        (foreign-lambda my-ulonglong "mysqlaux_stmt_num_rows" mysql-stmt-ptr))
2292
2293;my_ulonglong mysql_stmt_affected_rows(MYSQL_STMT *stmt)
2294(define foreign-mysql-stmt-affected-rows
2295        (foreign-lambda my-ulonglong "mysqlaux_stmt_affected_rows" mysql-stmt-ptr))
2296
2297;my_ulonglong mysql_stmt_insert_id(MYSQL_STMT *stmt)
2298(define foreign-mysql-stmt-insert-id
2299        (foreign-lambda my-ulonglong "mysqlaux_stmt_insert_id" mysql-stmt-ptr))
2300
2301;unsigned int mysql_stmt_field_count(MYSQL_STMT *stmt)
2302(define foreign-mysql-stmt-field-count
2303        (foreign-lambda unsigned-int "mysql_stmt_field_count" mysql-stmt-ptr))
2304
2305;;
2306
2307(define-foreign-record (mysql-bind "MYSQL_BIND")
2308  (rename: c-name->scheme-name)
2309  ; special ctor
2310  (destructor: free-mysql-bind)
2311  ((c-pointer "unsigned long") length)    ; output length pointer
2312  ((c-pointer "my_bool") is_null)                   ; Pointer to null indicator
2313  (c-pointer buffer)                      ; buffer to get/put data
2314  ((c-pointer "my_bool") error)                 ; set this if you want to track data truncations happened during fetch
2315  (unsigned-long buffer_length)           ; output buffer length, must be set when fetching str/binary
2316  (mysql-type buffer_type)                          ; buffer type
2317  (my-bool error_value)                         ; used if error is 0
2318  (my-bool is_unsigned)                         ; set if integer type is unsigned
2319  (my-bool is_null_value) )               ; Used if is_null is 0
2320
2321(define (allocate-mysql-bind cnt)
2322  ((foreign-lambda* mysql-bind-ptr ((unsigned-integer cnt))
2323   "return ((1 <= cnt) ? ((MYSQL_BIND *) calloc (cnt, sizeof(MYSQL_BIND))) : NULL);")
2324  cnt) )
2325
2326(define (mysql-bind-ref bindptr idx)
2327  ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
2328   "return (&(ptr[idx]));")
2329   bindptr idx) )
2330
2331(define (mysql-bind-clear! bindptr idx)
2332  ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
2333   "memset (&(ptr[idx]), 0, sizeof(MYSQL_BIND));")
2334   bindptr idx) )
2335
2336(define (allocate-mysql-bind-slots bindptr len is-null error)
2337  ((foreign-lambda* void ((mysql-bind-ptr bind) (unsigned-integer len)
2338                          (my-bool is_null) (my-bool error))
2339#<<END
2340    typedef struct {
2341      unsigned long length;
2342      my_bool is_null;
2343      my_bool error;
2344      C_word buffer[1];
2345    } bind_slots;
2346    size_t siz = (sizeof(bind_slots) - sizeof(((bind_slots *)0)->buffer))
2347                  + (((len / sizeof (C_word)) + (len % sizeof (C_word))) * sizeof (C_word));
2348    bind_slots * ptr = ((bind_slots *) malloc (siz));
2349    memset (ptr, 0, siz);
2350    bind->buffer = (char *) &(ptr->buffer);
2351    bind->buffer_length = len;
2352    ptr->is_null = is_null;
2353    bind->is_null = &(ptr->is_null);
2354    ptr->length = len;
2355    bind->length = &(ptr->length);
2356    ptr->error = error;
2357    bind->error = &(ptr->error);
2358END
2359   )
2360     bindptr len is-null error) )
2361
2362(define (%mysql-foreign-type-length foreign-type #!optional (obj (void)))
2363 (void) )
2364
2365(define (%mysql-determine-type obj is-unsigned is-null)
2366 (void) )
2367
2368(define (%mysql-determine-foreign-type type is-unsigned is-null)
2369 (void) )
2370
2371(define (mysql-bind-param-init-direct bindptr idx obj #!key type is-unsigned is-null error)
2372  (mysql-bind-clear! bindptr idx)
2373  (unless type
2374    (let-values ([(typ uflg nflg) (%mysql-determine-type obj is-unsigned is-null)])
2375      (set! type typ)
2376      (set! is-unsigned uflg)
2377      (set! is-null nflg) ) )
2378  (when (and (mysql-null-object? obj) (not (eqv? mysql-type-null type)))
2379    (warning "null object implies null type")
2380    (set! type mysql-type-null) )
2381  (mysql-bind-buffer-type-set! bindptr type)
2382  (unless (eqv? mysql-type-null type)
2383    (mysql-bind-is-unsigned-set! bindptr is-unsigned)
2384    (let* ([foreign-type (%mysql-determine-foreign-type type is-unsigned is-null)]
2385           [len (%mysql-foreign-type-length foreign-type obj)])
2386      (allocate-mysql-bind-slots bindptr len is-null error) ) ) )
2387
2388(define (mysql-bind-result-init-direct bindptr idx type #!optional len)
2389  (mysql-bind-clear! bindptr idx)
2390  (mysql-bind-buffer-type-set! bindptr type)
2391  (unless (eqv? mysql-type-null type)
2392    (let* ([foreign-type (%mysql-determine-foreign-type type #f #f)]
2393           [len (or len
2394                    (%mysql-foreign-type-length foreign-type))])
2395      (allocate-mysql-bind-slots bindptr len #f #f) ) ) )
2396
2397;;
2398
2399; (mysql-bind-param-init
2400;   (list obj #:key T #:is-unsigned B #:is-null B #:error B)
2401;   ...
2402;   (list obj #:key T #:is-unsigned B #:is-null B #:error B))
2403
2404(define (mysql-bind-param-init . inits)
2405  (let ([bindptr (allocate-mysql-bind (length inits))])
2406    (let loop ([inits inits] [idx 0])
2407      (if (null? inits)
2408          bindptr
2409          (begin
2410            (apply mysql-bind-param-init-direct bindptr idx (car inits))
2411            (loop (cdr inits) (+ idx 1)) ) ) ) ) )
2412
2413; (mysql-bind-result-init
2414;   (list T #:len I)
2415;   ...
2416;   (list T #:len I))
2417
2418(define (mysql-bind-result-init conn . inits)
2419  (let ([bindptr (allocate-mysql-bind (length inits))])
2420    (let loop ([inits inits] [idx 0])
2421      (if (null? inits)
2422          bindptr
2423          (begin
2424            (apply mysql-bind-result-init-direct bindptr idx (car inits))
2425            (loop (cdr inits) (+ idx 1)) ) ) ) ) )
2426
2427;;
2428
2429#;
2430(define (mysql-bind-result->object bindptr)
2431  (void) )
2432
2433;;
2434
2435(define (%mysql-stmt-attr-set stmtptr attr val)
2436  (cond [(boolean? val)
2437          (foreign-mysqlaux-stmt-attr-set-bool stmtptr attr val)]
2438        [(number? val)
2439          (foreign-mysqlaux-stmt-attr-set-ulong stmtptr attr val)]
2440        [else
2441          #t ] ) )
2442
2443(define (%mysql-stmt-attr-get stmtptr attr)
2444  (select attr
2445    [(stmt-attr-cursor-type stmt-attr-prefetch-rows)
2446      (let-location ([val unsigned-long])
2447        (foreign-mysql-stmt-attr-get stmtptr attr #$val)
2448        val ) ]
2449    [(stmt-attr-update-max-length)
2450      (let-location ([val my-bool])
2451        (foreign-mysql-stmt-attr-get stmtptr attr #$val)
2452        val ) ]
2453    [else
2454      (void) ] ) )
2455
2456(define (%mysql-free-bind conn)
2457  (and-let* ([bindptr (mysql-connection-binding conn)])
2458    (free-mysql-bind bindptr)
2459    (mysql-connection-binding-set! conn #f) ) )
2460
2461(define (%mysql-stmt-close conn)
2462  (and-let* ([stmtptr (mysql-connection-statement conn)])
2463    (mysql-connection-statement-set! conn #f)
2464    (%mysql-free-bind conn) ; free any result/param binding
2465    (when (foreign-mysql-stmt-close stmtptr)
2466      (signal-mysql-stmt-error 'mysql-stmt-close conn) ) ) )
2467
2468;;
2469
2470(define (mysql-null-object? obj)
2471  (void) )
2472
2473;;
2474
2475(define (signal-mysql-stmt-error loc conn . args)
2476  (and-let* ([stmtptr (mysql-connection-statement conn)])
2477    (let ([err (or (mysql-stmt-error stmtptr)
2478                   (mysql-stmt-errno stmtptr))]
2479          [sta (mysql-stmt-sqlstate conn)])
2480      (apply signal-mysql-condition loc
2481                                    (string-append err
2482                                                   (if sta
2483                                                      (string-append " - " sta)
2484                                                      ""))
2485                                    conn args) ) ) )
2486
2487;-----------------------------------------------------------------------
2488; The statement MySQL/Scheme API.
2489;
2490; This API provides some additional functionality.
2491;
2492
2493(define (mysql-stmt-errno conn)
2494  (and-let* ([stmtptr (mysql-connection-statement conn)])
2495    (foreign-mysql-stmt-errno stmtptr) ) )
2496
2497; Returns a string describing the last mysql stmt error, or #f if no error
2498; has occurred.
2499(define (mysql-stmt-error conn)
2500  (and-let* ([stmtptr (mysql-connection-statement conn)])
2501    (let ([errstr (foreign-mysql-stmt-error stmtptr)])
2502      (and (not (string=? "" errstr))
2503           errstr ) ) ) )
2504
2505; Returns a string describing the last mysql stmt state error, or #f if no error
2506; has occurred.
2507(define (mysql-stmt-sqlstate conn)
2508  (and-let* ([stmtptr (mysql-connection-statement conn)])
2509    (let ([errstr (foreign-mysql-stmt-sqlstate stmtptr)])
2510      (and (not (or (string=? "00000" errstr)
2511                    (string=? "HY000" errstr)))
2512           errstr ) ) ) )
2513
2514(define (mysql-stmt-init conn)
2515  (%mysql-stmt-close conn)
2516  (let ([stmtptr (foreign-mysql-stmt-init (mysql-connection-ptr conn))])
2517    (if stmtptr
2518        (mysql-connection-statement-set! conn stmtptr)
2519        (signal-mysql-condition 'mysql-stmt-init "out of memory") ) ) )
2520
2521(define (mysql-stmt-prepare conn sql)
2522  (and-let* ([stmtptr (mysql-connection-statement conn)])
2523    (unless (zero? (foreign-mysql-stmt-prepare stmtptr sql (string-length sql)))
2524      (signal-mysql-stmt-error 'mysql-stmt-prepare stmtptr) ) ) )
2525
2526(define (mysql-stmt-param-count conn)
2527  (and-let* ([stmtptr (mysql-connection-statement conn)])
2528    (foreign-mysql-stmt-param-count stmtptr) ) )
2529
2530(define (mysql-stmt-bind-param conn bindptr)
2531  (and-let* ([stmtptr (mysql-connection-statement conn)])
2532    #; ;This souldn't be necessary
2533    (%mysql-free-bind conn)
2534    (if (foreign-mysql-stmt-bind-param stmtptr bindptr)
2535        (signal-mysql-stmt-error 'mysql-stmt-bind-param stmtptr)
2536        (mysql-connection-binding-set! conn bindptr) ) ) )
2537
2538(define (mysql-stmt-execute conn)
2539  (and-let* ([stmtptr (mysql-connection-statement conn)])
2540    (unless (zero? (foreign-mysql-stmt-execute stmtptr))
2541      (signal-mysql-stmt-error 'mysql-stmt-execute stmtptr) ) ) )
2542
2543(define (mysql-stmt-affected-rows conn)
2544  (and-let* ([stmtptr (mysql-connection-statement conn)])
2545    (let ([cnt (foreign-mysql-stmt-affected-rows stmtptr)])
2546      (and (not (= -1 cnt))
2547           cnt ) ) ) )
2548
2549(define (mysql-stmt-bind-result conn bindptr)
2550  (and-let* ([stmtptr (mysql-connection-statement conn)])
2551    (%mysql-free-bind conn) ; free the param bindings
2552    (if (foreign-mysql-stmt-bind-result stmtptr bindptr)
2553        (signal-mysql-stmt-error 'mysql-stmt-bind-result stmtptr)
2554        (mysql-connection-binding-set! conn bindptr) ) ) )
2555
2556; returns boolean for success, mysql-data-truncated, or signals
2557; an exception.
2558(define (mysql-stmt-fetch conn)
2559  (and-let* ([stmtptr (mysql-connection-statement conn)])
2560    (let ([val (foreign-mysql-stmt-fetch stmtptr)])
2561      (cond [(zero? val)
2562              #t]
2563            [(= mysql-no-data val)
2564              #f]
2565            [(= mysql-data-truncated val)
2566              mysql-data-truncated]
2567            [(= 1 val)
2568              (signal-mysql-stmt-error 'mysql-stmt-fetch stmtptr) ] ) ) ) )
2569
2570; causes the result to be buffered. does not touch the connection
2571; result!
2572(define (mysql-stmt-store-result conn)
2573  (and-let* ([stmtptr (mysql-connection-statement conn)])
2574    (when (zero? (foreign-mysql-stmt-store-result stmtptr))
2575      (signal-mysql-stmt-error 'mysql-stmt-store-result stmtptr) ) ) )
2576
2577; can only be invoked after a stmt-store-result and stmt-fetch.
2578(define (mysql-stmt-result-metadata conn)
2579  (mysql-free-result conn)
2580  (and-let* ([stmtptr (mysql-connection-statement conn)])
2581    (let ([resptr (foreign-mysql-stmt-result-metadata stmtptr)])
2582      (if resptr
2583          (begin
2584            (mysql-connection-result-set! conn resptr)
2585            (mysql-connection-result-start-set! conn
2586              (foreign-mysql-stmt-row-tell (mysql-connection-result conn))) )
2587          (signal-mysql-stmt-error 'mysql-stmt-result-metadata stmtptr) ) ) ) )
2588
2589(define (mysql-stmt-attr-set conn attr val)
2590  (and-let* ([stmtptr (mysql-connection-statement conn)])
2591    (when (%mysql-stmt-attr-set stmtptr attr val)
2592      (signal-mysql-condition 'stmt-attr-set
2593                              "unknown statement attribute" attr val) ) ) )
2594
2595(define (mysql-stmt-attr-get conn attr)
2596  (and-let* ([stmtptr (mysql-connection-statement conn)])
2597    (let ([val (%mysql-stmt-attr-get stmtptr attr)])
2598      (if (eq? (void) val)
2599          (signal-mysql-condition 'stmt-attr-get
2600                                   "unknown statement attribute" attr)
2601          val ) ) ) )
2602
2603;-----------------------------------------------------------------------
2604; The statement "extended" MySQL/Scheme API.
2605;
2606; This API provides some additional functionality.
2607;
2608
2609; rewinds to the beginning of the result set. has no effect if there is no
2610; current result set.
2611(define (mysql-stmt-rewind conn)
2612  (and-let* ([stmtptr (mysql-connection-statement conn)]
2613             [resptr (mysql-connection-result-start conn)])
2614    (foreign-mysql-stmt-row-seek stmtptr resptr) ) )
2615
2616; returns a procedure, or #f when no connection.
2617; the procedure takes a parameter index and returns the
2618; the mysql-bind-ptr of the mysql-bind record, of #f
2619; when no more rows to fetch.
2620(define (mysql-stmt-row-fetch conn)
2621  (and-let* ([resptr (mysql-connection-result conn)]
2622             [bindptr (mysql-connection-binding conn)]
2623             [(mysql-stmt-fetch conn)])
2624    (let ([fldcnt (mysql-num-fields conn)])
2625      (lambda (field)
2626        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
2627          (mysql-bind-ref bindptr fldidx) ) ) ) ) )
2628
2629;
2630(define (mysql-stmt-query conn query params #!optional results)
2631  (mysql-stmt-prepare conn query)
2632  (mysql-stmt-bind-param conn params)
2633  (mysql-stmt-execute conn)
2634  (when results
2635    (mysql-stmt-result-metadata conn)
2636    (mysql-stmt-bind-result conn results) ) )
2637
2638;-----------------------------------------------------------------------
2639; The statement "map" MySQL/Scheme API.
2640;
2641; This API provides some additional functionality for traversing results
2642; in a Scheme-ish way.
2643;
2644
2645; calls proc on every row in the current result set. proc should take 3
2646; arguments: the row (as described for mysql-stmt-row-fetch), the row index
2647; (which starts with 1 and ends with (mysql-stmt-num-rows conn)), and the
2648; current accumulated value.
2649;
2650; returns the final accumulated value.
2651;
2652; note: rewinds the result set before and after iterating over it; thus,
2653; all rows are included.
2654;
2655; you must call mysql-stmt-rewind if you later want to iterate over the result set
2656; using mysql-stmt-row-fetch.
2657(define (mysql-stmt-row-fold conn proc init)
2658  (mysql-stmt-rewind conn)
2659  (let loop ([rownum 1] [acc init])
2660    (let ([row (mysql-stmt-row-fetch conn)])
2661      (if row
2662          (loop (+ rownum 1) (proc row rownum acc))
2663          acc ) ) ) )
2664
2665; calls proc on every row in the current result set. proc should take 2
2666; arguments: the row (as described for mysql-stmt-row-fetch) and the row index
2667; (which starts with 1 and ends with (mysql-stmt-num-rows conn)).
2668;
2669; note: rewinds the result set before and after iterating over it; thus,
2670; all rows are included.
2671;
2672; you must call mysql-stmt-rewind if you later want to iterate over the result set
2673; using mysql-stmt-row-fetch.
2674(define (mysql-stmt-row-for-each conn proc)
2675  (mysql-stmt-row-fold conn
2676                       (lambda (row rownum _) (proc row rownum))
2677                       #t) )
2678
2679; calls proc on every row in the current result set. proc should take 2
2680; arguments: the row (as described for mysql-stmt-row-fetch) and the row index
2681; (which starts with 1 and ends with (mysql-stmt-num-rows conn)).
2682;
2683; returns a list of the results of each proc invocation.
2684;
2685; note: rewinds the result set before and after iterating over it; thus,
2686; all rows are included.
2687;
2688; you must call mysql-stmt-rewind if you later want to iterate over the result set
2689; using mysql-stmt-row-fetch.
2690(define (mysql-stmt-row-map conn proc)
2691  (reverse!
2692    (mysql-stmt-row-fold conn
2693                         (lambda (row rownum lst) (cons (proc row rownum) lst))
2694                         '())) )
2695
2696; executes query and then mysql-row-for-each with the given proc. the proc
2697; must meet the contract specified for the proc passed to mysql-stmt-row-fold.
2698(define (mysql-stmt-query-fold conn query proc init params #!optional results)
2699  (mysql-stmt-query conn query params results)
2700  (mysql-stmt-row-fold conn proc init) )
2701
2702; executes query and then mysql-row-for-each with the given proc. the proc
2703; must meet the contract specified for the proc passed to mysql-stmt-row-for-each.
2704(define (mysql-stmt-query-for-each conn query proc params #!optional results)
2705  (mysql-stmt-query conn query params results)
2706  (mysql-stmt-row-for-each conn proc) )
2707
2708; executes query and then mysql-row-for-each with the given proc. the proc
2709; must meet the contract specified for the proc passed to mysql-stmt-row-map.
2710(define (mysql-stmt-query-map conn query proc params #!optional results)
2711  (mysql-stmt-query conn query params results)
2712  (mysql-stmt-row-map conn proc) )
2713|#
2714
2715
Note: See TracBrowser for help on using the repository browser.