source: project/release/3/mysql/tags/1.31/mysql.scm @ 7943

Last change on this file since 7943 was 7943, checked in by Kon Lovett, 12 years ago

Chgd fetch row body to handle binary blob/string.

File size: 61.8 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-field-type-binary? )
122  (export
123    ;; direct api
124    foreign-mysql-affected-rows
125    foreign-mysql-change-user
126    foreign-mysql-character-set-name
127    foreign-mysql-close
128    foreign-mysql-data-seek
129    foreign-mysql-debug
130    foreign-mysql-dump-debug-info
131    foreign-mysql-errno
132    foreign-mysql-error
133    foreign-mysql-escape-string
134    foreign-mysql-fetch-field
135    foreign-mysql-fetch-fields
136    foreign-mysql-fetch-field-direct
137    foreign-mysql-fetch-lengths
138    foreign-mysql-fetch-row
139    foreign-mysql-field-count
140    foreign-mysql-field-seek
141    foreign-mysql-field-tell
142    foreign-mysql-free-result
143                foreign-mysql-get-character-set-info
144    foreign-mysql-get-client-info
145    foreign-mysql-get-client-version
146    foreign-mysql-get-host-info
147                foreign-mysql-get-proto-info
148    foreign-mysql-get-server-info
149    foreign-mysql-get-server-version
150    foreign-mysql-hex-string
151    foreign-mysql-info
152    foreign-mysql-init
153    foreign-mysql-insert-id
154    foreign-mysql-kill
155    foreign-mysql-library-init
156    foreign-mysql-library-end
157    foreign-mysql-list-dbs
158    foreign-mysql-list-fields
159    foreign-mysql-list-processes
160    foreign-mysql-list-tables
161    foreign-mysql-num-fields
162    foreign-mysql-num-rows
163    foreign-mysql-options
164    foreign-mysql-ping
165    foreign-mysql-query
166    foreign-mysql-real-connect
167    foreign-mysql-real-escape-string
168    foreign-mysql-real-query
169    foreign-mysql-row-seek
170    foreign-mysql-row-tell
171    foreign-mysql-select-db
172    foreign-mysql-set-character-set
173    foreign-mysql-set-server-option
174    foreign-mysql-shutdown
175    foreign-mysql-sqlstate
176    foreign-mysql-ssl-set
177    foreign-mysql-stat
178    foreign-mysql-store-result
179    foreign-mysql-thread-id
180    foreign-mysql-use-result
181    foreign-mysql-warning-count
182    foreign-mysql-commit
183    foreign-mysql-rollback
184    foreign-mysql-autocommit
185    foreign-mysql-more-results
186    foreign-mysql-next-result
187
188    ;; scheme api
189    mysql-connection?
190    mysql-affected-rows
191    mysql-change-user
192    mysql-character-set-name
193    mysql-close ; customized
194    mysql-connect ; customized
195                #;mysql-data-seek ; omitted (low level)
196    mysql-debug
197    mysql-dump-debug-info
198    mysql-errno
199    mysql-error ; customized
200    mysql-escape-string ; customized
201                mysql-fetch-field
202                mysql-fetch-fields
203                mysql-fetch-field-direct
204                mysql-fetch-lengths ; customized
205    mysql-fetch-row ; customized
206    mysql-field-count
207                #;mysql-field-seek ; omitted (low level)
208                #;mysql-field-tell ; omitted (low level)
209    mysql-free-result
210                mysql-get-character-set-info
211    mysql-get-client-info
212    mysql-get-client-version
213    mysql-get-host-info
214                mysql-get-proto-info
215    mysql-get-server-info
216    mysql-get-server-version
217                #;mysql-hex-string ; omitted (too new)
218    mysql-info
219                #;mysql-init ; omitted (low level)
220    mysql-insert-id
221    mysql-kill
222                #;mysql-library-init ; omitted (too new)
223                #;mysql-library-end ; omitted (too new)
224    mysql-list-dbs
225                mysql-list-fields ; (nearly deprecated)
226    mysql-list-processes
227    mysql-list-tables
228    mysql-num-fields
229    mysql-num-rows
230    mysql-ping
231    mysql-query
232                #;mysql-real-connect ; omitted (use mysql-connect)
233                #;mysql-real-escape-string ; omitted (use mysql-escape-string)
234                #;mysql-real-query ; omitted (use mysql-query)
235                #;mysql-row-seek ; omitted (low level)
236                #;mysql-row-tell ; omitted (low level)
237    mysql-select-db
238                mysql-set-character-set
239                #;mysql-set-server-option ; omitted (too new)
240                #;mysql-shutdown ; omitted (too new)
241                #;mysql-sqlstate ; omitted (too new)
242    mysql-stat
243    mysql-store-result
244    mysql-thread-id
245                #;mysql-use-result ; omitted (doesn't fit with Scheme layer; see mysql-query)
246                #;mysql-warning-count ; omitted (too new)
247                #;mysql-commit ; omitted (too new)
248                #;mysql-rollback ; omitted (too new)
249                #;mysql-autocommit ; omitted (too new)
250                #;mysql-more-results ; omitted (too new)
251                #;mysql-next-result ; omitted (too new)
252
253    ;;
254    make-mysql-options
255
256    ;; ssl parameters api
257    make-mysql-ssl
258    mysql-ssl?
259    mysql-ssl-key-pathname
260    mysql-ssl-certificate-pathname
261    mysql-ssl-certificate-authority-pathname
262    mysql-ssl-trusted-certificates-pathname
263    mysql-ssl-ciphers
264
265    ;; "extended" api
266    mysql-rewind
267
268    ;; "map" api
269    mysql-row-fold
270    mysql-row-for-each
271    mysql-row-map
272    mysql-query-fold
273    mysql-query-for-each
274    mysql-query-map
275    ; synonyms
276    mysql-foreach-row
277    mysql-query-foreach
278
279    ;; MY_CHARSET_INFO api
280    ; slot getters
281    my-charset-info-name
282    my-charset-info-csname
283    my-charset-info-comment
284    my-charset-info-dir
285    my-charset-info-mbminlen
286    my-charset-info-mbmaxlen
287
288    ;; MYSQL_FIELD api
289    ; predicates
290    mysql-field-flags-on?
291    mysql-field-flags-off?
292    mysql-field-primary-key?
293    mysql-field-not-null?
294    mysql-field-numeric?
295    mysql-field-type-any?
296    mysql-field-type=?
297    mysql-field-type-clock?
298    mysql-field-type-number?
299    mysql-field-type-string?
300    mysql-field-type-blob?
301    mysql-field-type-magnitude?
302    mysql-field-type-binary?
303    mysql-field-type-text?
304    ;
305    mysql-fetch-field-specific
306    ; multi-field getters
307    mysql-field-slots
308    mysql-fetch-field-slots-direct
309    mysql-fetch-field-slots
310    mysql-fetch-field-slot-direct
311    mysql-fetch-field-slot
312    ; slot getters
313                mysql-field-name
314                mysql-field-org-name
315                mysql-field-table
316                mysql-field-org-table
317                mysql-field-db
318                mysql-field-catalog
319                mysql-field-def
320                mysql-field-length
321                mysql-field-max-length
322                mysql-field-name-length
323                mysql-field-org-name-length
324                mysql-field-table-length
325                mysql-field-org-table-length
326                mysql-field-db-length
327                mysql-field-catalog-length
328                mysql-field-def-length
329                mysql-field-flags
330                mysql-field-decimals
331                mysql-field-charsetnr
332                mysql-field-type
333
334    ;; connection client flags
335    ; values
336    client-long-password
337    client-long-flag
338    client-connect-with-db
339    client-protocol-41
340    client-secure-connection
341    client-transactions
342    client-compress
343    client-found-rows
344    client-ignore-sigpipe
345    client-ignore-space
346    client-interactive
347    client-local-files
348    client-multi-results
349    client-multi-statements
350    client-no-schema
351    client-odbc
352    client-ssl
353                ; converters
354    mysql-client-flags-value
355    mysql-client-flags-symbol
356
357    ;; enum enum_mysql_set_option
358    ; values
359    mysql-option-multi-statements-on
360    mysql-option-multi-statements-off
361                ; converters
362    mysql-server-option-value
363    mysql-server-option-symbol
364
365    ;; enum mysql_option
366    ; values
367    mysql-opt-connect-timeout
368    mysql-opt-compress
369    mysql-opt-named-pipe
370    mysql-init-command
371    mysql-read-default-file
372    mysql-read-default-group
373    mysql-set-charset-dir
374    mysql-set-charset-name
375    mysql-opt-local-infile
376    mysql-opt-protocol
377    mysql-shared-memory-base-name
378    mysql-opt-read-timeout
379    mysql-opt-write-timeout
380    mysql-opt-use-result
381    mysql-opt-use-remote-connection
382    mysql-opt-use-embedded-connection
383    mysql-opt-guess-connection
384    mysql-set-client-ip
385    mysql-secure-auth
386    mysql-report-data-truncation
387                ; converters
388    mysql-option-value
389    mysql-option-symbol
390
391    ;; enum enum_field_types
392    ; values
393        mysql-type-decimal
394        mysql-type-tiny
395        mysql-type-short
396        mysql-type-long
397        mysql-type-float
398        mysql-type-double
399        mysql-type-null
400        mysql-type-timestamp
401        mysql-type-longlong
402        mysql-type-int24
403        mysql-type-date
404        mysql-type-time
405        mysql-type-datetime
406        mysql-type-year
407        mysql-type-newdate
408        mysql-type-varchar
409        mysql-type-bit
410        mysql-type-newdecimal
411        mysql-type-enum
412        mysql-type-set
413        mysql-type-tiny-blob
414        mysql-type-medium-blob
415        mysql-type-long-blob
416        mysql-type-blob
417        mysql-type-var-string
418        mysql-type-string
419        mysql-type-geometry
420                ; converters
421    mysql-type-value
422    mysql-type-symbol
423
424    ;; field flags
425    ; values
426    not-null-flag
427    pri-key-flag
428    unique-key-flag
429    multiple-key-flag
430    unsigned-flag
431    zerofill-flag
432    binary-flag
433    auto-increment-flag
434    no-default-value-flag
435    ; deprecated
436    enum-flag
437    set-flag
438    blob-flag
439    timestamp-flag
440                ; converters
441    mysql-field-flags-value
442    mysql-field-flags-symbol ) )
443
444;=======================================================================
445; Interface to C API
446;
447; The entire C API is mapped using Chicken's foreign function interface.
448;
449
450;-----------------------------------------------------------------------
451; Foreign type definitions.
452;
453
454(define-foreign-type mysql-ptr (c-pointer "MYSQL"))
455(define-foreign-type mysql-res-ptr (c-pointer "MYSQL_RES"))
456(define-foreign-type mysql-rows-ptr (c-pointer "MYSQL_ROWS"))
457(define-foreign-type mysql-field-ptr (c-pointer "MYSQL_FIELD"))
458
459; mysql-row-ptr represents the C type MYSQL_ROW, which is actually a char**,
460; but we're just going to pass it to other mysql functions, hence the generic
461; c-pointer.
462(define-foreign-type mysql-row c-pointer)
463
464;-----------------------------------------------------------------------
465; Private enumeration value constants
466;
467
468(define-foreign-enum (mysql-server-option (enum "enum_mysql_set_option"))
469  #f  ; No aliases!
470  MYSQL_OPTION_MULTI_STATEMENTS_ON
471  MYSQL_OPTION_MULTI_STATEMENTS_OFF )
472
473(define-foreign-enum (mysql-option (enum "mysql_option"))
474  #f  ; No aliases!
475  MYSQL_OPT_CONNECT_TIMEOUT
476  MYSQL_OPT_COMPRESS
477  MYSQL_OPT_NAMED_PIPE
478  MYSQL_INIT_COMMAND
479  MYSQL_READ_DEFAULT_FILE
480  MYSQL_READ_DEFAULT_GROUP
481  MYSQL_SET_CHARSET_DIR
482  MYSQL_SET_CHARSET_NAME
483  MYSQL_OPT_LOCAL_INFILE
484  MYSQL_OPT_PROTOCOL
485  MYSQL_SHARED_MEMORY_BASE_NAME
486  MYSQL_OPT_READ_TIMEOUT
487  MYSQL_OPT_WRITE_TIMEOUT
488  MYSQL_OPT_USE_RESULT
489  MYSQL_OPT_USE_REMOTE_CONNECTION
490  MYSQL_OPT_USE_EMBEDDED_CONNECTION
491  MYSQL_OPT_GUESS_CONNECTION
492  MYSQL_SET_CLIENT_IP
493  MYSQL_SECURE_AUTH
494  MYSQL_REPORT_DATA_TRUNCATION )
495
496(define-foreign-enum (mysql-type (enum "enum_field_types"))
497  #f  ; No aliases!
498  MYSQL_TYPE_DECIMAL
499        MYSQL_TYPE_TINY
500  MYSQL_TYPE_SHORT
501  MYSQL_TYPE_LONG
502  MYSQL_TYPE_FLOAT
503  MYSQL_TYPE_DOUBLE
504  MYSQL_TYPE_NULL
505  MYSQL_TYPE_TIMESTAMP
506  MYSQL_TYPE_LONGLONG
507  MYSQL_TYPE_INT24
508  MYSQL_TYPE_DATE
509  MYSQL_TYPE_TIME
510  MYSQL_TYPE_DATETIME
511        MYSQL_TYPE_YEAR
512  MYSQL_TYPE_NEWDATE
513        MYSQL_TYPE_VARCHAR
514  MYSQL_TYPE_BIT
515  MYSQL_TYPE_NEWDECIMAL
516  MYSQL_TYPE_ENUM
517  MYSQL_TYPE_SET
518  MYSQL_TYPE_TINY_BLOB
519  MYSQL_TYPE_MEDIUM_BLOB
520  MYSQL_TYPE_LONG_BLOB
521  MYSQL_TYPE_BLOB
522  MYSQL_TYPE_VAR_STRING
523  MYSQL_TYPE_STRING
524  MYSQL_TYPE_GEOMETRY )
525
526(define-foreign-enum (mysql-field-flags unsigned-int)
527  #f  ; No aliases!
528  NOT_NULL_FLAG                                         ; field can't be NULL
529  PRI_KEY_FLAG                                          ; field is part of a primary key
530  UNIQUE_KEY_FLAG                                       ; field is part of a unique key
531  MULTIPLE_KEY_FLAG                                     ; field is part of a key
532  UNSIGNED_FLAG                                         ; field is unsigned
533  ZEROFILL_FLAG                                         ; field is zerofill
534  BINARY_FLAG                                           ; field is binary
535  AUTO_INCREMENT_FLAG                                   ; field is a autoincrement field
536  NO_DEFAULT_VALUE_FLAG         ; field doesn't have default value
537  NUM_FLAG                      ; field is num (for clients)
538  ; deprecated
539  ENUM_FLAG                                             ; field is an enum
540  SET_FLAG                                              ; field is a set
541  BLOB_FLAG                                             ; field is a blob
542  TIMESTAMP_FLAG        )                                                       ; field is a timestamp
543
544(define-foreign-enum (mysql-client-flags unsigned-int)
545        #f      ; No aliases!
546  CLIENT_LONG_PASSWORD          ; new more secure passwords
547  CLIENT_LONG_FLAG              ; Get all column flags
548  CLIENT_CONNECT_WITH_DB        ; One can specify db on connect
549  CLIENT_PROTOCOL_41            ; New 4.1 protocol
550  CLIENT_SECURE_CONNECTION      ; New 4.1 authentication
551  CLIENT_TRANSACTIONS           ; Client knows about transactions
552        CLIENT_COMPRESS               ; Can use compression protocol
553        ; Return the number of found (matched) rows, not the number of affected rows.
554        CLIENT_FOUND_ROWS
555        ; Prevents the client library from installing a SIGPIPE signal handler. This
556        ; can be used to avoid conflicts with a handler that the application has
557        ; already installed.
558        CLIENT_IGNORE_SIGPIPE
559        ; Allow spaces after function names. Makes all functions names reserved
560        ; words.
561        CLIENT_IGNORE_SPACE
562        ; Allow interactive_timeout seconds (instead of wait_timeout seconds) of
563        ; inactivity before closing the connection. The client's session wait_timeout
564        ; variable is set to the value of the session interactive_timeout variable.
565        CLIENT_INTERACTIVE
566        ; Enable LOAD DATA LOCAL handling.
567        CLIENT_LOCAL_FILES
568        ; Tell the server that the client can handle multiple result sets from
569        ; multiple-statement executions or stored procedures. This is automatically set
570        ; if CLIENT_MULTI_STATEMENTS is set. See the note following this table for more
571        ; information about this flag.
572        CLIENT_MULTI_RESULTS
573        ; Tell the server that the client may send multiple statements in a single
574        ; string (separated by Ò;Ó). If this flag is not set, multiple-statement
575        ; execution is disabled. See the note following this table for more information
576        ; about this flag.
577        CLIENT_MULTI_STATEMENTS
578        ; Don't allow the db_name.tbl_name.col_name syntax. This is for ODBC. It
579        ; causes the parser to generate an error if you use that syntax, which is
580        ; useful for trapping bugs in some ODBC programs.
581        CLIENT_NO_SCHEMA
582        ; Unused.
583        CLIENT_ODBC
584        ; Use SSL (encrypted protocol). This option should not be set by application
585        ; programs; it is set internally in the client library. Instead, use
586        ; mysql_ssl_set() before calling mysql_real_connect().
587        CLIENT_SSL )
588
589;-----------------------------------------------------------------------
590; Public enumeration value constants
591;
592
593(define-macro (gen-public-enum ?typ . ?syms)
594  `(begin
595     ,@(map
596        (lambda (sym)
597          (if (pair? sym)
598            `(define ,(car sym) ,(cadr sym))
599            `(define ,(string->symbol (c-name->scheme-name (symbol->string sym))) ,sym)))
600        ?syms)
601     (define (,(string->symbol (string-append (symbol->string ?typ) "-value")) . syms)
602       (,(string->symbol (string-append (symbol->string ?typ) "->number")) syms))
603     (define (,(string->symbol (string-append (symbol->string ?typ) "-symbol")) val)
604       (,(string->symbol (string-append "number->" (symbol->string ?typ))) val))) )
605
606(gen-public-enum mysql-server-option
607  MYSQL_OPTION_MULTI_STATEMENTS_ON
608  MYSQL_OPTION_MULTI_STATEMENTS_OFF)
609
610(gen-public-enum mysql-option
611  MYSQL_OPT_CONNECT_TIMEOUT
612  MYSQL_OPT_COMPRESS
613  MYSQL_OPT_NAMED_PIPE
614  MYSQL_INIT_COMMAND
615  MYSQL_READ_DEFAULT_FILE
616  MYSQL_READ_DEFAULT_GROUP
617  MYSQL_SET_CHARSET_DIR
618  MYSQL_SET_CHARSET_NAME
619  MYSQL_OPT_LOCAL_INFILE
620  MYSQL_OPT_PROTOCOL
621  MYSQL_SHARED_MEMORY_BASE_NAME
622  MYSQL_OPT_READ_TIMEOUT
623  MYSQL_OPT_WRITE_TIMEOUT
624  MYSQL_OPT_USE_RESULT
625  MYSQL_OPT_USE_REMOTE_CONNECTION
626  MYSQL_OPT_USE_EMBEDDED_CONNECTION
627  MYSQL_OPT_GUESS_CONNECTION
628  MYSQL_SET_CLIENT_IP
629  MYSQL_SECURE_AUTH
630  MYSQL_REPORT_DATA_TRUNCATION)
631
632(gen-public-enum mysql-type
633  MYSQL_TYPE_DECIMAL
634        MYSQL_TYPE_TINY
635  MYSQL_TYPE_SHORT
636  MYSQL_TYPE_LONG
637  MYSQL_TYPE_FLOAT
638  MYSQL_TYPE_DOUBLE
639  MYSQL_TYPE_NULL
640  MYSQL_TYPE_TIMESTAMP
641  MYSQL_TYPE_LONGLONG
642  MYSQL_TYPE_INT24
643  MYSQL_TYPE_DATE
644  MYSQL_TYPE_TIME
645  MYSQL_TYPE_DATETIME
646        MYSQL_TYPE_YEAR
647  MYSQL_TYPE_NEWDATE
648        MYSQL_TYPE_VARCHAR
649  MYSQL_TYPE_BIT
650  MYSQL_TYPE_NEWDECIMAL
651  MYSQL_TYPE_ENUM
652  MYSQL_TYPE_SET
653  MYSQL_TYPE_TINY_BLOB
654  MYSQL_TYPE_MEDIUM_BLOB
655  MYSQL_TYPE_LONG_BLOB
656  MYSQL_TYPE_BLOB
657  MYSQL_TYPE_VAR_STRING
658  MYSQL_TYPE_STRING
659  MYSQL_TYPE_GEOMETRY)
660
661(gen-public-enum mysql-field-flags
662  NOT_NULL_FLAG
663  PRI_KEY_FLAG
664  UNIQUE_KEY_FLAG
665  MULTIPLE_KEY_FLAG
666  UNSIGNED_FLAG
667  ZEROFILL_FLAG
668  BINARY_FLAG
669  AUTO_INCREMENT_FLAG
670  NO_DEFAULT_VALUE_FLAG
671  NUM_FLAG
672  ; deprecated
673  ENUM_FLAG
674  SET_FLAG
675  BLOB_FLAG
676  TIMESTAMP_FLAG)
677
678(gen-public-enum mysql-client-flags
679  CLIENT_LONG_PASSWORD
680  CLIENT_LONG_FLAG
681  CLIENT_CONNECT_WITH_DB
682  CLIENT_PROTOCOL_41
683  CLIENT_SECURE_CONNECTION
684  CLIENT_TRANSACTIONS
685  CLIENT_COMPRESS
686  CLIENT_FOUND_ROWS
687  CLIENT_IGNORE_SIGPIPE
688  CLIENT_IGNORE_SPACE
689  CLIENT_INTERACTIVE
690  CLIENT_LOCAL_FILES
691  CLIENT_MULTI_RESULTS
692  CLIENT_MULTI_STATEMENTS
693  CLIENT_NO_SCHEMA
694  CLIENT_ODBC
695  CLIENT_SSL)
696
697;-----------------------------------------------------------------------
698; MySQL C Structures API
699;
700
701(define-foreign-record (mysql-field "MYSQL_FIELD")
702  (rename: c-name->scheme-name)
703  ; No ctor or dtor
704  (c-string name)                       ; Name of column
705  (c-string org_name)                   ; Original column name, if an alias
706  (c-string table)                      ; Table of column if column was a field
707  (c-string org_table)                  ; Org table name, if table was an alias
708  (c-string db)                         ; Database for table
709  (c-string catalog)                      ; Catalog for table
710  (c-string def)                        ; Default value (set by mysql_list_fields)
711  (unsigned-long length)                ; Width of column (create length)
712  (unsigned-long max_length)            ; Max width for selected set
713  (unsigned-integer name_length)
714  (unsigned-integer org_name_length)
715  (unsigned-integer table_length)
716  (unsigned-integer org_table_length)
717  (unsigned-integer db_length)
718  (unsigned-integer catalog_length)
719  (unsigned-integer def_length)
720  (unsigned-integer flags)              ; Div flags
721  (unsigned-integer decimals)           ; Number of decimals in field
722  (unsigned-integer charsetnr)          ; Character set
723  (mysql-type type) )                   ; Type of field. See mysql_com.h for types
724
725(define-foreign-record (my-charset-info "MY_CHARSET_INFO")
726  (rename: c-name->scheme-name)
727  (constructor: allocate-my-charset-info)
728  (destructor: free-my-charset-info)
729  (c-string name)                     ; character set name
730  (c-string csname)                 ; collation name
731  (c-string comment)              ; comment
732  (c-string dir)                ; directory
733  (unsigned-integer mbminlen)   ; multi byte character min. length
734  (unsigned-integer mbmaxlen) ) ; multi byte character max. length
735
736;-----------------------------------------------------------------------
737;
738
739(define UNSIGNED-LONG-SIZE (foreign-value "sizeof(unsigned long)" int))
740
741
742;-----------------------------------------------------------------------
743; Foreign function definitions for the MySQL C API using the
744; MySQL "my_ulonglong" type.
745;
746; We treat "my_ulonglong" in Scheme as the "number" type & as a
747; "double" in the C interface, converting to "my_ulonglong"
748; to/from the MySQL API.
749;
750
751#>
752static double
753C_mysql_affected_rows (MYSQL *mysql)
754{
755  return ((double) mysql_affected_rows (mysql));
756}
757
758static double
759C_mysql_insert_id (MYSQL *mysql)
760{
761  return ((double) mysql_insert_id (mysql));
762}
763
764static double
765C_mysql_num_rows (MYSQL_RES *result)
766{
767  return ((double) mysql_num_rows (result));
768}
769
770static void
771C_mysql_data_seek (MYSQL_RES *result, double offset)
772{
773  mysql_data_seek (result, (my_ulonglong) offset);
774}
775<#
776
777; just to be specific
778(define-foreign-type my-ulonglong number)
779
780; 24.2.3.1. mysql_affected_rows()
781; my_ulonglong mysql_affected_rows(MYSQL *mysql)
782(define foreign-mysql-affected-rows
783  (foreign-lambda my-ulonglong "C_mysql_affected_rows" mysql-ptr))
784
785; 24.2.3.34. mysql_insert_id()
786; my_ulonglong mysql_insert_id(MYSQL *mysql)
787(define foreign-mysql-insert-id
788  (foreign-lambda my-ulonglong "C_mysql_insert_id" mysql-ptr))
789
790; 24.2.3.43. mysql_num_rows()
791; my_ulonglong mysql_num_rows(MYSQL_RES *result)
792(define foreign-mysql-num-rows
793  (foreign-lambda my-ulonglong "C_mysql_num_rows" mysql-res-ptr))
794
795; 24.2.3.7. mysql_data_seek()
796; void mysql_data_seek(MYSQL_RES *result, my_ulonglong offset)
797(define foreign-mysql-data-seek
798  (foreign-lambda void "C_mysql_data_seek" mysql-res-ptr my-ulonglong))
799
800;-----------------------------------------------------------------------
801; Foreign function definitions for mysql_options from MySQL C API.
802;
803
804#>
805static int
806C_mysql_options_none (MYSQL *mysql, enum mysql_option option)
807{
808  return (mysql_options (mysql, option, NULL));
809}
810
811static int
812C_mysql_options_string (MYSQL *mysql, enum mysql_option option, char *value)
813{
814  return (mysql_options (mysql, option, value));
815}
816
817static int
818C_mysql_options_ulong (MYSQL *mysql, enum mysql_option option, unsigned long value)
819{
820  return (mysql_options (mysql, option, &value));
821}
822<#
823
824(define (%mysql-options mysqlptr option value)
825  (cond
826    [(null? value)
827      ((foreign-lambda int "C_mysql_options_none" mysql-ptr mysql-option)
828       mysqlptr option)]
829    [(string? value)
830      ((foreign-lambda int "C_mysql_options_string" mysql-ptr mysql-option c-string)
831        mysqlptr option value)]
832    [(number? value)
833      ((foreign-lambda int "C_mysql_options_ulong" mysql-ptr mysql-option unsigned-long)
834        mysqlptr option value)]) )
835
836;-----------------------------------------------------------------------
837; Foreign function definitions for mysqlaux functions.
838;
839
840#>
841static int
842mysqlaux_field_index (MYSQL_RES *result, const char *name, unsigned int num_fields)
843{
844  MYSQL_FIELD *fields = mysql_fetch_fields (result);
845  unsigned int i;
846
847  for (i = 0; i < num_fields; i++) {
848    if (0 == strcasecmp (name, fields[i].name)) {
849      return (i);
850    }
851  }
852
853  return (-1);
854}
855
856static char *
857mysqlaux_fetch_column_data_direct (MYSQL_RES *result, MYSQL_ROW row, unsigned int fldidx, int *binflg)
858{
859  MYSQL_FIELD *fields = mysql_fetch_fields (result);
860
861  switch (fields[fldidx].type) {
862    case MYSQL_TYPE_VARCHAR:
863    case MYSQL_TYPE_TINY_BLOB:
864    case MYSQL_TYPE_MEDIUM_BLOB:
865    case MYSQL_TYPE_LONG_BLOB:
866    case MYSQL_TYPE_BLOB:
867    case MYSQL_TYPE_VAR_STRING:
868    case MYSQL_TYPE_STRING:
869      *binflg = 1;
870      break;
871    default:
872      *binflg = 0;
873      break;
874  }
875  *binflg &= (63 == fields[fldidx].charsetnr);
876
877  return (((MYSQL_ROW)row)[fldidx]);
878}
879<#
880
881(define foreign-mysqlaux-field-index
882  (foreign-lambda int "mysqlaux_field_index" mysql-res-ptr nonnull-c-string unsigned-integer) )
883
884(define foreign-mysqlaux-fetch-column-data-direct
885  (foreign-lambda c-pointer "mysqlaux_fetch_column_data_direct"
886                            mysql-res-ptr mysql-row
887                            unsigned-integer
888                            (nonnull-c-pointer int)) )
889
890;-----------------------------------------------------------------------
891; Foreign function definitions from MySQL C API.
892;
893; I've copied the listing of MySQL C API functions straight from the
894; MySQL manual. They are in alphabetical order, exactly as they appear
895; in the manual. Further, the C function signature is copied below the
896; manual entry. Finally, the Scheme foreign lambda mapping follows the
897; C function signature.
898;
899
900; just to be specific
901(define-foreign-type my-bool bool)
902
903; 24.2.3.2. mysql_change_user()
904; my_bool mysql_change_user(MYSQL *mysql, const char *user,
905;   const char *password, const char *db)
906(define foreign-mysql-change-user
907  (foreign-lambda my-bool "mysql_change_user" mysql-ptr c-string c-string
908                  c-string))
909
910; 24.2.3.3. mysql_character_set_name()
911; const char *mysql_character_set_name(MYSQL *mysql)
912(define foreign-mysql-character-set-name
913  (foreign-lambda c-string "mysql_character_set_name" mysql-ptr))
914
915; 24.2.3.4. mysql_close()
916; void mysql_close(MYSQL *mysql)
917(define foreign-mysql-close
918  (foreign-lambda void "mysql_close" mysql-ptr))
919
920; 24.2.3.8. mysql_debug()
921; void mysql_debug(const char *debug)
922(define foreign-mysql-debug
923  (foreign-lambda void "mysql_debug" c-string))
924
925; 24.2.3.10. mysql_dump_debug_info()
926; int mysql_dump_debug_info(MYSQL *mysql)
927(define foreign-mysql-dump-debug-info
928  (foreign-lambda integer "mysql_dump_debug_info" mysql-ptr))
929
930; 24.2.3.12. mysql_errno()
931; unsigned int mysql_errno(MYSQL *mysql)
932(define foreign-mysql-errno
933  (foreign-lambda unsigned-integer "mysql_errno" mysql-ptr))
934
935; 24.2.3.13. mysql_error()
936; const char *mysql_error(MYSQL *mysql)
937(define foreign-mysql-error
938  (foreign-lambda c-string "mysql_error" mysql-ptr))
939
940; 24.2.3.14. mysql_escape_string()
941; unsigned long mysql_escape_string(char *to, const char *from,
942;   unsigned long length)
943(define foreign-mysql-escape-string
944  (foreign-lambda unsigned-long "mysql_escape_string" c-string c-string
945                  unsigned-long))
946
947; 24.2.3.15. mysql_fetch_field()
948; MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *result)
949(define foreign-mysql-fetch-field
950  (foreign-lambda mysql-field-ptr "mysql_fetch_field" mysql-res-ptr))
951
952; 24.2.3.16. mysql_fetch_fields()
953; MYSQL_FIELD *mysql_fetch_fields(MYSQL_RES *result)
954(define foreign-mysql-fetch-fields
955  (foreign-lambda mysql-field-ptr "mysql_fetch_fields" mysql-res-ptr))
956
957; 24.2.3.17. mysql_fetch_field_direct()
958; MYSQL_FIELD *mysql_fetch_field_direct(MYSQL_RES *result, unsigned int fieldnr)
959(define foreign-mysql-fetch-field-direct
960  (foreign-lambda mysql-field-ptr "mysql_fetch_field_direct" mysql-res-ptr
961                  unsigned-integer))
962
963; 24.2.3.18. mysql_fetch_lengths()
964; unsigned long *mysql_fetch_lengths(MYSQL_RES *result)
965(define foreign-mysql-fetch-lengths
966  (foreign-lambda (c-pointer unsigned-long) "mysql_fetch_lengths" mysql-res-ptr))
967
968; 24.2.3.19. mysql_fetch_row()
969; MYSQL_ROW mysql_fetch_row(MYSQL_RES *result)
970(define foreign-mysql-fetch-row
971  (foreign-lambda mysql-row "mysql_fetch_row" mysql-res-ptr))
972
973; 24.2.3.20. mysql_field_count()
974; unsigned int mysql_field_count(MYSQL *mysql)
975(define foreign-mysql-field-count
976  (foreign-lambda unsigned-integer "mysql_field_count" mysql-ptr))
977
978; 24.2.3.21. mysql_field_seek()
979; MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *result,
980;   MYSQL_FIELD_OFFSET offset)
981(define foreign-mysql-field-seek
982  (foreign-lambda unsigned-integer "mysql_field_seek" mysql-res-ptr
983                  unsigned-integer))
984
985; 24.2.3.22. mysql_field_tell()
986; MYSQL_FIELD_OFFSET mysql_field_tell(MYSQL_RES *result)
987(define foreign-mysql-field-tell
988  (foreign-lambda unsigned-integer "mysql_field_tell" mysql-res-ptr))
989
990; 24.2.3.23. mysql_free_result()
991; void mysql_free_result(MYSQL_RES *result)
992(define foreign-mysql-free-result
993  (foreign-lambda void "mysql_free_result" mysql-res-ptr))
994
995; 24.2.3.26.Êmysql_get_character_set_info()
996; void mysql_get_character_set_info(MYSQL *mysql, MY_CHARSET_INFO *cs)
997(define foreign-mysql-get-character-set-info
998  (foreign-lambda void "mysql_get_character_set_info" mysql-ptr my-charset-info))
999
1000; 24.2.3.25. mysql_get_client_info()
1001; char *mysql_get_client_info(void)
1002(define foreign-mysql-get-client-info
1003  (foreign-lambda c-string "mysql_get_client_info"))
1004
1005; 24.2.3.26. mysql_get_client_version()
1006; unsigned long mysql_get_client_version(void)
1007(define foreign-mysql-get-client-version
1008  (foreign-lambda unsigned-long "mysql_get_client_version"))
1009
1010; 24.2.3.27. mysql_get_host_info()
1011; char *mysql_get_host_info(MYSQL *mysql)
1012(define foreign-mysql-get-host-info
1013  (foreign-lambda c-string "mysql_get_host_info" mysql-ptr))
1014
1015; 24.2.3.28. mysql_get_proto_info()
1016; unsigned int mysql_get_proto_info(MYSQL *mysql)
1017(define foreign-mysql-get-proto-info
1018  (foreign-lambda unsigned-integer "mysql_get_proto_info" mysql-ptr))
1019
1020; 24.2.3.29. mysql_get_server_info()
1021; char *mysql_get_server_info(MYSQL *mysql)
1022(define foreign-mysql-get-server-info
1023  (foreign-lambda c-string "mysql_get_server_info" mysql-ptr))
1024
1025; 24.2.3.30. mysql_get_server_version()
1026; unsigned long mysql_get_server_version(MYSQL *mysql)
1027(define foreign-mysql-get-server-version
1028  (foreign-lambda unsigned-long "mysql_get_server_version" mysql-ptr))
1029
1030; 24.2.3.31. mysql_hex_string()
1031; unsigned long mysql_hex_string(char *to, const char *from,
1032;   unsigned long length)
1033(define foreign-mysql-hex-string
1034  (foreign-lambda unsigned-long "mysql_hex_string" c-string c-string
1035                  unsigned-long))
1036
1037; 24.2.3.32. mysql_info()
1038; char *mysql_info(MYSQL *mysql)
1039(define foreign-mysql-info
1040  (foreign-lambda c-string "mysql_info" mysql-ptr))
1041
1042; 24.2.3.33. mysql_init()
1043; MYSQL *mysql_init(MYSQL *mysql)
1044(define foreign-mysql-init
1045  (foreign-lambda mysql-ptr "mysql_init" mysql-ptr))
1046
1047; 24.2.3.35. mysql_kill()
1048; int mysql_kill(MYSQL *mysql, unsigned long pid)
1049(define foreign-mysql-kill
1050  (foreign-lambda integer "mysql_kill" mysql-ptr unsigned-long))
1051
1052; 24.2.3.36. mysql_library_init()
1053; int mysql_library_init(int argc, char **argv, char **groups)
1054(define foreign-mysql-library-init
1055  (foreign-lambda integer "mysql_library_init" integer c-pointer c-pointer))
1056
1057; 24.2.3.37. mysql_library_end()
1058; void mysql_library_end(void)
1059(define foreign-mysql-library-end
1060  (foreign-lambda void "mysql_library_end"))
1061
1062; 24.2.3.38. mysql_list_dbs()
1063; MYSQL_RES *mysql_list_dbs(MYSQL *mysql, const char *wild)
1064(define foreign-mysql-list-dbs
1065  (foreign-lambda mysql-res-ptr "mysql_list_dbs" mysql-ptr c-string))
1066
1067; 24.2.3.39. mysql_list_fields()
1068; MYSQL_RES *mysql_list_fields(MYSQL *mysql, const char *table,
1069;   const char *wild)
1070(define foreign-mysql-list-fields
1071  (foreign-lambda mysql-res-ptr "mysql_list_fields" mysql-ptr c-string
1072                  c-string))
1073
1074; 24.2.3.40. mysql_list_processes()
1075; MYSQL_RES *mysql_list_processes(MYSQL *mysql)
1076(define foreign-mysql-list-processes
1077  (foreign-lambda mysql-res-ptr "mysql_list_processes" mysql-ptr))
1078
1079; 24.2.3.41. mysql_list_tables()
1080; MYSQL_RES *mysql_list_tables(MYSQL *mysql, const char *wild)
1081(define foreign-mysql-list-tables
1082  (foreign-lambda mysql-res-ptr "mysql_list_tables" mysql-ptr c-string))
1083
1084; 24.2.3.42. mysql_num_fields()
1085; unsigned int mysql_num_fields(MYSQL_RES *result)
1086(define foreign-mysql-num-fields
1087  (foreign-lambda unsigned-integer "mysql_num_fields" mysql-res-ptr))
1088
1089; 24.2.3.44. mysql_options()
1090; int mysql_options(MYSQL *mysql, enum mysql_option option, const char *arg)
1091(define foreign-mysql-options
1092  (foreign-lambda integer "mysql_options" mysql-ptr mysql-option c-pointer))
1093
1094; 24.2.3.45. mysql_ping()
1095; int mysql_ping(MYSQL *mysql)
1096(define foreign-mysql-ping
1097  (foreign-lambda integer "mysql_ping" mysql-ptr))
1098
1099; 24.2.3.46. mysql_query()
1100; int mysql_query(MYSQL *mysql, const char *stmt_str)
1101;
1102; NOTE: use "mysql_real_query" instead
1103(define foreign-mysql-query
1104  (foreign-lambda integer "mysql_query" mysql-ptr c-string))
1105
1106; 24.2.3.47. mysql_real_connect()
1107; MYSQL *mysql_real_connect(MYSQL *mysql, const char *host, const char *user,
1108;   const char *passwd, const char *db, unsigned int port,
1109;   const char *unix_socket, unsigned long client_flag)
1110(define foreign-mysql-real-connect
1111  (foreign-lambda mysql-ptr "mysql_real_connect"
1112                  mysql-ptr c-string c-string
1113                  c-string c-string unsigned-integer
1114                  c-string unsigned-long))
1115
1116; 24.2.3.48. mysql_real_escape_string()
1117; unsigned long mysql_real_escape_string(MYSQL *mysql, char *to,
1118;   const char *from, unsigned long length)
1119(define foreign-mysql-real-escape-string
1120  (foreign-lambda unsigned-long "mysql_real_escape_string" mysql-ptr
1121                  c-string c-string unsigned-long))
1122
1123; 24.2.3.49. mysql_real_query()
1124; int mysql_real_query(MYSQL *mysql, const char *query, unsigned long length)
1125(define foreign-mysql-real-query
1126  (foreign-lambda unsigned-integer "mysql_real_query" mysql-ptr c-string
1127                  unsigned-long))
1128
1129; 24.2.3.51. mysql_row_seek()
1130; MYSQL_ROW_OFFSET mysql_row_seek(MYSQL_RES *result, MYSQL_ROW_OFFSET offset)
1131(define foreign-mysql-row-seek
1132  (foreign-lambda mysql-rows-ptr "mysql_row_seek" mysql-res-ptr mysql-rows-ptr))
1133
1134; 24.2.3.52. mysql_row_tell()
1135; MYSQL_ROW_OFFSET mysql_row_tell(MYSQL_RES *result)
1136(define foreign-mysql-row-tell
1137  (foreign-lambda mysql-rows-ptr "mysql_row_tell" mysql-res-ptr))
1138
1139; 24.2.3.53. mysql_select_db()
1140; int mysql_select_db(MYSQL *mysql, const char *db)
1141(define foreign-mysql-select-db
1142  (foreign-lambda integer "mysql_select_db" mysql-ptr c-string))
1143
1144; 24.2.3.54. mysql_set_character_set()
1145; int mysql_set_character_set(MYSQL *mysql, char *csname)
1146(define foreign-mysql-set-character-set
1147  (foreign-lambda integer "mysql_set_character_set" mysql-ptr c-string))
1148
1149; 24.2.3.55. mysql_set_server_option()
1150; int mysql_set_server_option(MYSQL *mysql, enum enum_mysql_set_option option)
1151(define foreign-mysql-set-server-option
1152  (foreign-lambda integer "mysql_set_server_option" mysql-ptr mysql-server-option))
1153
1154; 24.2.3.56. mysql_shutdown()
1155; int mysql_shutdown(MYSQL *mysql, enum enum_shutdown_level shutdown_level)
1156(define foreign-mysql-shutdown
1157  (foreign-lambda integer "mysql_shutdown" mysql-ptr integer))
1158
1159; 24.2.3.57. mysql_sqlstate()
1160; const char *mysql_sqlstate(MYSQL *mysql)
1161(define foreign-mysql-sqlstate
1162  (foreign-lambda c-string "mysql_sqlstate" mysql-ptr))
1163
1164; 24.2.3.58. mysql_ssl_set()
1165; int mysql_ssl_set(MYSQL *mysql, const char *key, const char *cert,
1166;   const char *ca, const char *capath, const char *cipher)
1167(define foreign-mysql-ssl-set
1168  (foreign-lambda integer "mysql_ssl_set" mysql-ptr c-string c-string
1169                  c-string c-string c-string))
1170
1171; 24.2.3.59. mysql_stat()
1172; char *mysql_stat(MYSQL *mysql)
1173(define foreign-mysql-stat
1174  (foreign-lambda c-string "mysql_stat" mysql-ptr))
1175
1176; 24.2.3.60. mysql_store_result()
1177; MYSQL_RES *mysql_store_result(MYSQL *mysql)
1178(define foreign-mysql-store-result
1179  (foreign-lambda mysql-res-ptr "mysql_store_result" mysql-ptr))
1180
1181; 24.2.3.61. mysql_thread_id()
1182; unsigned long mysql_thread_id(MYSQL *mysql)
1183(define foreign-mysql-thread-id
1184  (foreign-lambda unsigned-long "mysql_thread_id" mysql-ptr))
1185
1186; 24.2.3.62. mysql_use_result()
1187; MYSQL_RES *mysql_use_result(MYSQL *mysql)
1188(define foreign-mysql-use-result
1189  (foreign-lambda mysql-res-ptr "mysql_use_result" mysql-ptr))
1190
1191; 24.2.3.63. mysql_warning_count()
1192; unsigned int mysql_warning_count(MYSQL *mysql)
1193(define foreign-mysql-warning-count
1194  (foreign-lambda unsigned-integer "mysql_warning_count" mysql-ptr))
1195
1196; 24.2.3.64. mysql_commit()
1197; my_bool mysql_commit(MYSQL *mysql)
1198(define foreign-mysql-commit
1199  (foreign-lambda my-bool "mysql_commit" mysql-ptr))
1200
1201; 24.2.3.65. mysql_rollback()
1202; my_bool mysql_rollback(MYSQL *mysql)
1203(define foreign-mysql-rollback
1204  (foreign-lambda my-bool "mysql_rollback" mysql-ptr))
1205
1206; 24.2.3.66. mysql_autocommit()
1207; my_bool mysql_autocommit(MYSQL *mysql, my_bool mode)
1208(define foreign-mysql-autocommit
1209  (foreign-lambda my-bool "mysql_autocommit" mysql-ptr my-bool))
1210
1211; 24.2.3.67. mysql_more_results()
1212; my_bool mysql_more_results(MYSQL *mysql)
1213(define foreign-mysql-more-results
1214  (foreign-lambda my-bool "mysql_more_results" mysql-ptr))
1215
1216; 24.2.3.68. mysql_next_result()
1217; int mysql_next_result(MYSQL *mysql)
1218(define foreign-mysql-next-result
1219  (foreign-lambda integer "mysql_next_result" mysql-ptr))
1220
1221;=======================================================================
1222; Provided Scheme API.
1223;
1224; This is an attempt at a Schemer-friendly API to MySQL. Much of the API
1225; is the same, but the C API has been simplified where possible, and a
1226; few additional features have been layered on.
1227;
1228
1229; record printer helper
1230(define (record-slot->string val lbl #!optional (tst val))
1231  (if tst
1232      (conc #\space lbl #\: #\space #\" val #\")
1233      "") )
1234
1235(define (foreign-unsigned-long-pointer->u32vector ulptr cnt)
1236  (let* ([siz (* cnt UNSIGNED-LONG-SIZE)]
1237         [store (make-blob siz)])
1238    (move-memory! ulptr store siz)
1239    (blob->u32vector/shared store) ) )
1240
1241(define char-pointer->string
1242  (foreign-lambda* c-string ((c-pointer chrptr))
1243    "return ((char *) chrptr);") )
1244
1245(define (binary-char-pointer->string chrptr size)
1246  (let ([blob (make-blob size)])
1247    (move-memory! chrptr blob size)
1248    (blob->string blob) ) )
1249
1250(define (%mysql-get-field-index resptr field fldcnt)
1251  (let ([fldidx (if (number? field)
1252                    field
1253                    (foreign-mysqlaux-field-index resptr
1254                                                  (->string field) fldcnt))])
1255    (and (<= 0 fldidx) (< fldidx fldcnt) 
1256         fldidx ) ) )
1257
1258;-----------------------------------------------------------------------
1259; MySQL exceptions
1260;
1261
1262(define (make-exn-condition loc msg . args)
1263  (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
1264
1265(define (make-mysql-condition)
1266  (make-property-condition 'mysql) )
1267
1268(define (make-exn-mysql-condition loc msg . args)
1269  (make-composite-condition
1270   (apply make-exn-condition loc msg args)
1271   (make-mysql-condition)) )
1272
1273(define (signal-mysql-condition loc msg . args)
1274  (signal (apply make-exn-mysql-condition loc msg args)) )
1275
1276(define (signal-mysql-error loc conn . args)
1277  (apply signal-mysql-condition loc (mysql-error conn) args) )
1278
1279;-----------------------------------------------------------------------
1280; MySQL "SSL" record type definition.
1281;
1282; See <http://www.openssl.org/docs/apps/ciphers.html> for a discussion
1283; of the cipher-list format.
1284;
1285
1286(define-record-type mysql-ssl
1287  (%make-mysql-ssl key cert ca capath cipher)
1288  mysql-ssl?
1289  (key mysql-ssl-key-pathname)
1290  (cert mysql-ssl-certificate-pathname)
1291  (ca mysql-ssl-certificate-authority-pathname)
1292  (capath mysql-ssl-trusted-certificates-pathname)
1293  (cipher mysql-ssl-ciphers) )
1294
1295(define (make-mysql-ssl #!key key certificate certificate-authority
1296                              trusted-certificates ciphers)
1297  (%make-mysql-ssl key certificate certificate-authority trusted-certificates ciphers) )
1298
1299(define-record-printer (mysql-ssl ssl out)
1300  (let ([key (mysql-ssl-key-pathname ssl)]
1301        [cert (mysql-ssl-certificate-pathname ssl)]
1302        [ca (mysql-ssl-certificate-authority-pathname ssl)]
1303        [capath (mysql-ssl-trusted-certificates-pathname ssl)]
1304        [cipher (mysql-ssl-ciphers ssl)])
1305    (display
1306     (string-append
1307      "#<mysql-ssl"
1308      (record-slot->string key      "key")
1309      (record-slot->string cert     "cert")
1310      (record-slot->string ca       "ca")
1311      (record-slot->string capath   "capath")
1312      (record-slot->string cipher   "cipher")
1313      ">")
1314     out) ) )
1315
1316;-----------------------------------------------------------------------
1317; MySQL connection options helper.
1318;
1319
1320(define (make-mysql-options . opts)
1321  (let loop ([opts opts] [alst '()])
1322    (if (null? opts)
1323        alst
1324        (let* ([opt (car opts)]
1325               [nxt (cdr opts)]
1326               [val (if (null? nxt)
1327                        (error 'make-options "missing value for option" opt)
1328                        (car nxt))])
1329          (unless (number? opt)
1330            (error 'make-options "invalid option" opt) )
1331          (unless (or (number? val) (string? val) (not val) (null? val))
1332            (error 'make-options "invalid option value" val) )
1333          (loop (cdr nxt) (alist-cons opt val alst)) ) ) ) )
1334
1335;-----------------------------------------------------------------------
1336; MySQL "Connection" record type definition.
1337;
1338; I've stuffed the raw FFI pointer into a slot in the mysql-connection
1339; record. The record is here for a few reasons:
1340;
1341;   1) Instead of an ugly #<pointer>, I've defined a pretty printer
1342;      to demonstrate that we've actually got a MySQL connection.
1343;   2) The C API is somewhat more verbose than what normal usage would
1344;      need. (For example, usually you don't care whether results are
1345;      all read into memory as fast as possible, or if they're read from
1346;      the network one-by-one. Thus, the mysql-query function provided
1347;      automatically reads the results into memory. For finer granularity,
1348;      you're always free to write your own version to use the "raw"
1349;      foreign-* functions. I suppose a contribution to determine this
1350;      behavior via a (make-parameter ...) parameter may also be
1351;      accepted. ;)) Slots are provided in the mysql-connection record
1352;      type to allow for this sort of simplifying behavior.
1353;
1354; All of the "Scheme API" MySQL functions take instances of this record
1355; type, instead of a raw FFI pointer (as the foreign-* functions require).
1356;
1357
1358(define-record-type mysql-connection
1359  (make-mysql-connection host user passwd db port unix-socket
1360                         client-flag ptr result result-start
1361                         ssl opts)
1362  mysql-connection?
1363  (host mysql-connection-host)
1364  (user mysql-connection-user)
1365  (passwd mysql-connection-passwd)
1366  (db mysql-connection-db)
1367  (port mysql-connection-port)
1368  (unix-socket mysql-connection-unix-socket)
1369  (client-flag mysql-connection-client-flag)
1370  (ptr mysql-connection-ptr mysql-connection-ptr-set!)
1371  (result mysql-connection-result mysql-connection-result-set!)
1372  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
1373  (ssl mysql-connection-ssl)
1374  (opts mysql-connection-options) )
1375
1376(define-record-printer (mysql-connection conn out)
1377  (let [(host (mysql-connection-host conn))
1378        (user (mysql-connection-user conn))
1379        (passwd (mysql-connection-passwd conn))
1380        (db (mysql-connection-db conn))
1381        (tcp-port (mysql-connection-port conn))
1382        (unix-socket (mysql-connection-unix-socket conn))
1383        (client-flag (mysql-connection-client-flag conn))
1384        (ssl (mysql-connection-ssl conn))
1385        (opts (mysql-connection-options conn))]
1386    (display
1387     (string-append
1388      "#<mysql-connection"
1389      (if (mysql-connection-ptr conn)
1390          (string-append
1391            (record-slot->string host         "host")
1392            (record-slot->string user         "user")
1393            (record-slot->string passwd       "passwd")
1394            (record-slot->string db           "db")
1395            (record-slot->string tcp-port     "tcp-port"    (not (zero? tcp-port)))
1396            (record-slot->string unix-socket  "unix-socket")
1397            (record-slot->string client-flag  "client-flag" (not (zero? client-flag)))
1398            (record-slot->string ssl          "ssl")
1399            (record-slot->string opts         "options") )
1400          " INVALID")
1401      ">")
1402     out) ) )
1403
1404;-----------------------------------------------------------------------
1405; The "base" MySQL/Scheme API.
1406;
1407; This part of the API provides a slightly simplified version of the full
1408; MySQL C API.
1409;
1410
1411(define (mysql-affected-rows conn)
1412  (foreign-mysql-affected-rows (mysql-connection-ptr conn)) )
1413
1414(define (mysql-change-user conn #!key (user #f) (passwd #f) (db #f))
1415  (foreign-mysql-change-user (mysql-connection-ptr conn) user passwd db) )
1416
1417(define (mysql-character-set-name conn)
1418  (foreign-mysql-character-set-name (mysql-connection-ptr conn)))
1419
1420; Closes a mysql connection and invalidates the mysql connection object.
1421; Returns (void). You should do this when you're done with the MySQL
1422; connection; however, if you don't close it manually, it will be closed
1423; upon termination.
1424(define (mysql-close conn)
1425  (mysql-free-result conn)
1426  (foreign-mysql-close (mysql-connection-ptr conn))
1427  (mysql-connection-ptr-set! conn #f) )
1428
1429; Returns a mysql connection object, or #f on failure.
1430(define (mysql-connect #!key (host #f) (user #f) (passwd #f) (db #f) (port 0)
1431                       (unix-socket #f) (client-flag 0)
1432                       (options #f) (ssl #f))
1433  (let ([mysql (foreign-mysql-init #f)])
1434    (cond
1435      [mysql
1436        (when ssl
1437          (foreign-mysql-ssl-set mysql
1438                                 (mysql-ssl-key-pathname ssl)
1439                                 (mysql-ssl-certificate-pathname ssl)
1440                                 (mysql-ssl-certificate-authority-pathname ssl)
1441                                 (mysql-ssl-trusted-certificates-pathname ssl)
1442                                 (mysql-ssl-ciphers ssl)) )
1443        (when options
1444          (for-each
1445           (lambda (optitm)
1446             (let ([opt (car optitm)]
1447                   [val (cdr optitm)])
1448               (unless (zero? (%mysql-options mysql opt val))
1449                 (signal-mysql-condition 'mysql-connect "unknown option code" opt val))))
1450           options) )
1451        (let ([mysqlptr (foreign-mysql-real-connect mysql host user passwd db
1452                                                    port unix-socket
1453                                                    client-flag)])
1454          (if mysqlptr
1455              (make-mysql-connection host user passwd db port unix-socket
1456                                     client-flag mysqlptr #f #f options ssl)
1457              (signal-mysql-condition 'mysql-connect
1458               (foreign-mysql-error mysql)
1459               host user passwd db port unix-socket client-flag options ssl options) ) ) ]
1460      [else
1461        (signal-mysql-condition 'mysql-connect "failed to initialize mysql") ] ) ) )
1462
1463(define (mysql-debug debug)
1464  (foreign-mysql-debug debug) )
1465
1466(define (mysql-dump-debug-info conn)
1467  (foreign-mysql-dump-debug-info (mysql-connection-ptr conn)) )
1468
1469(define (mysql-errno conn)
1470  (foreign-mysql-errno (mysql-connection-ptr conn)))
1471
1472; Returns a string describing the last mysql error, or #f if no error
1473; has occurred.
1474(define (mysql-error conn)
1475  (let [(errstr (foreign-mysql-error (mysql-connection-ptr conn)))]
1476    (and (not (string=? "" errstr))
1477         errstr) ) )
1478
1479(define (mysql-escape-string conn str)
1480        (let-location ([escstr c-string*])
1481    ((foreign-lambda* void ((mysql-ptr mysql) (c-pointer to) (c-string from) (unsigned-long length))
1482      "if ((*((char **) to) = ((char *) C_malloc ((2 * length) + 1)))) {\n"
1483      "    (void) mysql_real_escape_string (mysql, *((char **) to), from, length);\n"
1484      "}")
1485     #$escstr
1486     str (string-length str))
1487    escstr ) )
1488
1489; returns a mysql-field-ptr or #f when no more fields.
1490; returns #f when no result set.
1491(define (mysql-fetch-field conn)
1492  (and-let* ([resptr (mysql-connection-result conn)])
1493    (foreign-mysql-fetch-field resptr) ) )
1494
1495; returns a mysql-field-ptr to a vector of MYSQL_FIELD or #f when no fields.
1496; returns #f when no result set.
1497(define (mysql-fetch-fields conn)
1498  (and-let* ([resptr (mysql-connection-result conn)])
1499    (foreign-mysql-fetch-fields resptr) ) )
1500
1501; returns a mysql-field-ptr or #f when no such field.
1502; returns #f when no result set.
1503(define (mysql-fetch-field-direct conn field-number)
1504  (and-let* ([resptr (mysql-connection-result conn)])
1505    (foreign-mysql-fetch-field-direct resptr field-number) ) )
1506
1507; returns a u32vector of length num-fields.
1508; returns #f when no result set.
1509(define (%mysql-fetch-lengths resptr cnt)
1510  (and-let* ([ulptr (foreign-mysql-fetch-lengths resptr)])
1511    (foreign-unsigned-long-pointer->u32vector ulptr cnt) ) )
1512
1513; returns a u32vector of length num-fields.
1514; returns #f when no result set.
1515(define (mysql-fetch-lengths conn)
1516  (and-let* ([resptr (mysql-connection-result conn)])
1517    (%mysql-fetch-lengths resptr (foreign-mysql-num-fields resptr)) ) )
1518
1519; After a mysql-query that has results, use mysql-fetch-row to retrieve
1520; results row-by-row. When no more rows are left, returns #f. When returning
1521; a "row", returns a procedure that takes exactly 1 argument, which may
1522; be either a number (in which case it is treated as the column index,
1523; starting at zero) or a symbol or string (which will be treated as the
1524; column name).
1525(define (mysql-fetch-row conn)
1526  (and-let* ([resptr (mysql-connection-result conn)]
1527             [row (foreign-mysql-fetch-row resptr)])
1528    (let* ([connptr (mysql-connection-ptr conn)]
1529           [fldcnt (foreign-mysql-num-fields resptr)]
1530           [fldlens (%mysql-fetch-lengths resptr fldcnt)])
1531      (lambda (field)
1532        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
1533          (let-location ([binary-flag bool])
1534            (and-let* ([datptr (foreign-mysqlaux-fetch-column-data-direct resptr row fldidx #$binary-flag)])
1535              (if binary-flag
1536                  (binary-char-pointer->string datptr (u32vector-ref fldlens fldidx))
1537                  (char-pointer->string datptr) ) ) ) ) ) ) ) )
1538
1539(define (mysql-field-count conn)
1540  (foreign-mysql-field-count (mysql-connection-ptr conn)))
1541
1542(define (mysql-free-result conn)
1543  (and-let* [(res (mysql-connection-result conn))]
1544    (foreign-mysql-free-result res) )
1545  (mysql-connection-result-set! conn #f)
1546  (mysql-connection-result-start-set! conn #f) )
1547
1548; returns a c-pointer to a MY_CHARSET_INFO struct.
1549; a finalizer is supplied.
1550(define (mysql-get-character-set-info conn)
1551  (let ([chrsetinfo (allocate-my-charset-info)])
1552    (foreign-mysql-get-character-set-info (mysql-connection-ptr conn) chrsetinfo)
1553    (set-finalizer! chrsetinfo free-my-charset-info)
1554    chrsetinfo ) )
1555
1556(define (mysql-get-client-info)
1557  (foreign-mysql-get-client-info) )
1558
1559(define (mysql-get-client-version)
1560  (foreign-mysql-get-client-version) )
1561
1562(define (mysql-get-host-info conn)
1563  (foreign-mysql-get-host-info (mysql-connection-ptr conn)) )
1564
1565(define (mysql-get-proto-info conn)
1566  (foreign-mysql-get-proto-info (mysql-connection-ptr conn)) )
1567
1568(define (mysql-get-server-info conn)
1569  (foreign-mysql-get-server-info (mysql-connection-ptr conn)) )
1570
1571(define (mysql-get-server-version conn)
1572  (foreign-mysql-get-server-version (mysql-connection-ptr conn)) )
1573
1574(define (mysql-info conn)
1575  (foreign-mysql-info (mysql-connection-ptr conn)) )
1576
1577(define (mysql-insert-id conn)
1578  (foreign-mysql-insert-id (mysql-connection-ptr conn)) )
1579
1580(define (mysql-kill conn pid)
1581  (foreign-mysql-kill (mysql-connection-ptr conn) pid) )
1582
1583(define (mysql-list-dbs conn like)
1584  (mysql-free-result conn)
1585  (mysql-connection-result-set! conn
1586    (foreign-mysql-list-dbs (mysql-connection-ptr conn) like)) )
1587
1588(define (mysql-list-fields conn table wild)
1589  (mysql-free-result conn)
1590  (mysql-connection-result-set! conn
1591    (foreign-mysql-list-fields (mysql-connection-ptr conn) table wild)) )
1592
1593(define (mysql-list-processes conn)
1594  (mysql-free-result conn)
1595  (mysql-connection-result-set! conn
1596    (foreign-mysql-list-processes (mysql-connection-ptr conn))) )
1597
1598(define (mysql-list-tables conn wild)
1599  (mysql-free-result conn)
1600  (mysql-connection-result-set! conn
1601    (foreign-mysql-list-tables (mysql-connection-ptr conn) wild)) )
1602
1603(define (mysql-num-fields conn)
1604  (foreign-mysql-num-fields (mysql-connection-result conn)) )
1605
1606(define (mysql-num-rows conn)
1607  (and-let* ([res (mysql-connection-result conn)])
1608    (foreign-mysql-num-rows res)) )
1609
1610(define (mysql-ping conn)
1611  (foreign-mysql-ping (mysql-connection-ptr conn)) )
1612
1613; returns #t if the query was successful, signals exception otherwise.
1614(define (mysql-query conn query)
1615  (let [(mysql-ptr (mysql-connection-ptr conn))]
1616    ; zero indicates success
1617    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
1618        (begin (mysql-store-result conn) #t)
1619        (signal-mysql-error 'mysql-query conn query) ) ) )
1620
1621; returns #t if the select was successful, signals exception otherwise.
1622(define (mysql-select-db conn db)
1623  (or (zero? (foreign-mysql-select-db (mysql-connection-ptr conn) db))
1624      (signal-mysql-error 'mysql-select-db conn db) ) )
1625
1626; returns #t if the set was successful, signals exception otherwise.
1627(define (mysql-set-character-set conn csname)
1628  (or (zero? (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
1629      (signal-mysql-condition 'mysql-set-character-set "bad character set name" csname) ) )
1630
1631(define (mysql-stat conn)
1632  (foreign-mysql-stat (mysql-connection-ptr conn)) )
1633
1634(define (mysql-store-result conn)
1635  (mysql-connection-result-set! conn
1636    (foreign-mysql-store-result (mysql-connection-ptr conn)))
1637  (mysql-connection-result-start-set! conn
1638    (and (mysql-connection-result conn)
1639         (foreign-mysql-row-tell (mysql-connection-result conn))) ) )
1640
1641(define (mysql-thread-id conn)
1642  (foreign-mysql-thread-id (mysql-connection-ptr conn)) )
1643
1644;-----------------------------------------------------------------------
1645; The "extended" MySQL/Scheme API.
1646;
1647; This API provides some additional functionality.
1648;
1649
1650; rewinds to the beginning of the result set. has no effect if there is no
1651; current result set.
1652(define (mysql-rewind conn)
1653  (and-let* ([res-st (mysql-connection-result-start conn)])
1654    (foreign-mysql-row-seek (mysql-connection-result conn) res-st) ) )
1655
1656;-----------------------------------------------------------------------
1657; The "map" MySQL/Scheme API.
1658;
1659; This API provides some additional functionality for traversing results
1660; in a Scheme-ish way.
1661;
1662
1663; calls proc on every row in the current result set. proc should take 3
1664; arguments: the row (as described for mysql-fetch-row), the row index
1665; (which starts with 1 and ends with (mysql-num-rows conn), and the
1666; current accumulated value.
1667;
1668; returns the final accumulated value.
1669;
1670; note: rewinds the result set before and after iterating over it; thus,
1671; all rows are included.
1672;
1673; you must call mysql-rewind if you later want to iterate over the result set
1674; using mysql-fetch-row.
1675(define (mysql-row-fold conn proc init)
1676  (mysql-rewind conn)
1677  (let loop ([rownum 1] [acc init])
1678    (let ([row (mysql-fetch-row conn)])
1679      (if row
1680          (loop (+ rownum 1) (proc row rownum acc))
1681          acc ) ) ) )
1682
1683; calls proc on every row in the current result set. proc should take 2
1684; arguments: the row (as described for mysql-fetch-row) and the row index
1685; (which starts with 1 and ends with (mysql-num-rows conn).
1686;
1687; note: rewinds the result set before and after iterating over it; thus,
1688; all rows are included.
1689;
1690; you must call mysql-rewind if you later want to iterate over the result set
1691; using mysql-fetch-row.
1692(define (mysql-row-for-each conn proc)
1693  (mysql-row-fold conn
1694                  (lambda (row rownum _) (proc row rownum))
1695                  #t) )
1696
1697; calls proc on every row in the current result set. proc should take 2
1698; arguments: the row (as described for mysql-fetch-row) and the row index
1699; (which starts with 1 and ends with (mysql-num-rows conn).
1700;
1701; returns a list of the results of each proc invocation.
1702;
1703; note: rewinds the result set before and after iterating over it; thus,
1704; all rows are included.
1705;
1706; you must call mysql-rewind if you later want to iterate over the result set
1707; using mysql-fetch-row.
1708(define (mysql-row-map conn proc)
1709  (reverse!
1710    (mysql-row-fold conn
1711                    (lambda (row rownum lst) (cons (proc row rownum) lst))
1712                    '())) )
1713
1714; executes query and then mysql-row-for-each with the given proc. the proc
1715; must meet the contract specified for the proc passed to mysql-row-for-each.
1716(define (mysql-query-fold conn query proc init)
1717  (mysql-query conn query)
1718  (mysql-row-fold conn proc init) )
1719
1720; executes query and then mysql-row-for-each with the given proc. the proc
1721; must meet the contract specified for the proc passed to mysql-row-for-each.
1722(define (mysql-query-for-each conn query proc)
1723  (mysql-query conn query)
1724  (mysql-row-for-each conn proc) )
1725
1726; executes query and then mysql-row-for-each with the given proc. the proc
1727; must meet the contract specified for the proc passed to mysql-row-for-each.
1728(define (mysql-query-map conn query proc)
1729  (mysql-query conn query)
1730  (mysql-row-map conn proc) )
1731
1732; synonyms
1733(define mysql-query-foreach mysql-query-for-each)
1734(define mysql-foreach-row mysql-row-for-each)
1735
1736;-----------------------------------------------------------------------
1737; The MySQL Field structure predicate API.
1738;
1739
1740(define (mysql-field-flags-test fldptr mask)
1741  (bitwise-and (mysql-field-flags fldptr) mask) )
1742
1743(define (mysql-field-flags-mask flags)
1744  (apply bitwise-ior flags) )
1745
1746;;
1747
1748(define (mysql-field-flags-on? fldptr . flags)
1749  (let ([mask (mysql-field-flags-mask flags)])
1750    (= mask (mysql-field-flags-test fldptr mask)) ) )
1751
1752(define (mysql-field-flags-off? fldptr . flags)
1753  (zero? (mysql-field-flags-test fldptr (mysql-field-flags-mask flags))) )
1754
1755;;
1756
1757(define (mysql-field-type-any? fldptr . types)
1758  (memv (mysql-field-type fldptr) types) )
1759
1760(define (mysql-field-type=? fldptr type)
1761  (eqv? type (mysql-field-type fldptr)) )
1762
1763;;
1764
1765(define (mysql-field-primary-key? fldptr)
1766  (mysql-field-flags-on? fldptr pri-key-flag) )
1767
1768(define (mysql-field-not-null? fldptr)
1769  (mysql-field-flags-on? fldptr not-null-flag) )
1770
1771(define (mysql-field-binary? fldptr)
1772  (= 63 (mysql-field-charsetnr fldptr)) )
1773
1774(define (mysql-field-numeric? fldptr)
1775  (mysql-field-flags-on? fldptr num-flag) )
1776
1777;;
1778
1779(define mysql-field-type-clock?
1780  (let ([numtypes (list mysql-type-timestamp mysql-type-datetime
1781                        mysql-type-date mysql-type-time
1782                        mysql-type-newdate mysql-type-year)])
1783    (lambda (fldptr)
1784      (apply mysql-field-type-any? fldptr numtypes) ) ) )
1785
1786; note - not the same as the "IS_NUM" macro.
1787(define mysql-field-type-number?
1788  (let ([numtypes (list mysql-type-decimal mysql-type-tiny mysql-type-short
1789                            mysql-type-long mysql-type-float mysql-type-double
1790                        mysql-type-longlong mysql-type-int24
1791                        mysql-type-newdecimal)])
1792    (lambda (fldptr)
1793      (apply mysql-field-type-any? fldptr numtypes) ) ) )
1794
1795(define mysql-field-type-blob?
1796  (let ([blobtypes (list mysql-type-tiny-blob mysql-type-medium-blob
1797                         mysql-type-long-blob mysql-type-blob)])
1798    (lambda (fldptr)
1799      (apply mysql-field-type-any? fldptr blobtypes) ) ) )
1800
1801(define mysql-field-type-string?
1802  (let ([numtypes (list mysql-type-varchar mysql-type-var-string
1803                        mysql-type-string)])
1804    (lambda (fldptr)
1805      (apply mysql-field-type-any? fldptr numtypes) ) ) )
1806
1807;;
1808
1809; note - the same as the "IS_NUM" macro.
1810(define mysql-field-type-magnitude?
1811  (let ([magtypes (list mysql-type-timestamp mysql-type-year mysql-type-null)])
1812    (lambda (fldptr)
1813      (or (mysql-field-type-number? fldptr)
1814          (apply mysql-field-type-any? fldptr magtypes) ) ) ) )
1815
1816(define (mysql-field-type-binary? fldptr)
1817  (and (mysql-field-binary? fldptr)
1818       (or (mysql-field-type-blob? fldptr)
1819           (mysql-field-type-string? fldptr) ) ) )
1820
1821(define (mysql-field-type-text? fldptr)
1822  (and (not (mysql-field-binary? fldptr))
1823       (or (mysql-field-type-blob? fldptr)
1824           (mysql-field-type-string? fldptr) ) ) )
1825
1826;-----------------------------------------------------------------------
1827; The MySQL Field structure multi-slot API.
1828;
1829
1830; returns a list of field items.
1831(define (mysql-field-slots fldptr . getters)
1832  (and fldptr
1833       (map (cut <> fldptr) getters) ) )
1834
1835; returns a list of field items for nth field.
1836(define (mysql-fetch-field-slots-direct conn nth . getters)
1837  (apply mysql-field-slots (mysql-fetch-field-direct conn nth) getters) )
1838
1839; returns a field item for nth field.
1840(define (mysql-fetch-field-slot-direct conn nth getter)
1841  (and-let* ([lst (mysql-field-slots (mysql-fetch-field-direct conn nth) getter)])
1842    (car lst) ) )
1843
1844; returns a list of field items for the next field.
1845(define (mysql-fetch-field-slots conn . getters)
1846  (apply mysql-field-slots (mysql-fetch-field conn) getters) )
1847
1848; returns a field item for the next field.
1849(define (mysql-fetch-field-slot conn getter)
1850  (and-let* ([lst (mysql-field-slots (mysql-fetch-field conn) getter)])
1851    (car lst) ) )
1852
1853; returns a field pointer or #f.
1854(define (mysql-fetch-field-specific conn field)
1855  (and-let* ([resptr (mysql-connection-result conn)]
1856             [fldidx (%mysql-get-field-index resptr field (foreign-mysql-num-fields resptr))])
1857    (foreign-mysql-fetch-field-direct resptr fldidx) ) )
Note: See TracBrowser for help on using the repository browser.