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

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

Save.

File size: 65.5 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-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 from MySQL C API.
838;
839; I've copied the listing of MySQL C API functions straight from the
840; MySQL manual. They are in alphabetical order, exactly as they appear
841; in the manual. Further, the C function signature is copied below the
842; manual entry. Finally, the Scheme foreign lambda mapping follows the
843; C function signature.
844;
845
846; just to be specific
847(define-foreign-type my-bool bool)
848
849; 24.2.3.2. mysql_change_user()
850; my_bool mysql_change_user(MYSQL *mysql, const char *user,
851;   const char *password, const char *db)
852(define foreign-mysql-change-user
853  (foreign-lambda my-bool "mysql_change_user" mysql-ptr c-string c-string
854                  c-string))
855
856; 24.2.3.3. mysql_character_set_name()
857; const char *mysql_character_set_name(MYSQL *mysql)
858(define foreign-mysql-character-set-name
859  (foreign-lambda c-string "mysql_character_set_name" mysql-ptr))
860
861; 24.2.3.4. mysql_close()
862; void mysql_close(MYSQL *mysql)
863(define foreign-mysql-close
864  (foreign-lambda void "mysql_close" mysql-ptr))
865
866; 24.2.3.8. mysql_debug()
867; void mysql_debug(const char *debug)
868(define foreign-mysql-debug
869  (foreign-lambda void "mysql_debug" c-string))
870
871; 24.2.3.10. mysql_dump_debug_info()
872; int mysql_dump_debug_info(MYSQL *mysql)
873(define foreign-mysql-dump-debug-info
874  (foreign-lambda integer "mysql_dump_debug_info" mysql-ptr))
875
876; 24.2.3.12. mysql_errno()
877; unsigned int mysql_errno(MYSQL *mysql)
878(define foreign-mysql-errno
879  (foreign-lambda unsigned-integer "mysql_errno" mysql-ptr))
880
881; 24.2.3.13. mysql_error()
882; const char *mysql_error(MYSQL *mysql)
883(define foreign-mysql-error
884  (foreign-lambda c-string "mysql_error" mysql-ptr))
885
886; 24.2.3.14. mysql_escape_string()
887; unsigned long mysql_escape_string(char *to, const char *from,
888;   unsigned long length)
889(define foreign-mysql-escape-string
890  (foreign-lambda unsigned-long "mysql_escape_string" c-string c-string
891                  unsigned-long))
892
893; 24.2.3.15. mysql_fetch_field()
894; MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *result)
895(define foreign-mysql-fetch-field
896  (foreign-lambda mysql-field-ptr "mysql_fetch_field" mysql-res-ptr))
897
898; 24.2.3.16. mysql_fetch_fields()
899; MYSQL_FIELD *mysql_fetch_fields(MYSQL_RES *result)
900(define foreign-mysql-fetch-fields
901  (foreign-lambda mysql-field-ptr "mysql_fetch_fields" mysql-res-ptr))
902
903; 24.2.3.17. mysql_fetch_field_direct()
904; MYSQL_FIELD *mysql_fetch_field_direct(MYSQL_RES *result, unsigned int fieldnr)
905(define foreign-mysql-fetch-field-direct
906  (foreign-lambda mysql-field-ptr "mysql_fetch_field_direct" mysql-res-ptr
907                  unsigned-integer))
908
909; 24.2.3.18. mysql_fetch_lengths()
910; unsigned long *mysql_fetch_lengths(MYSQL_RES *result)
911(define foreign-mysql-fetch-lengths
912  (foreign-lambda (c-pointer unsigned-long) "mysql_fetch_lengths" mysql-res-ptr))
913
914; 24.2.3.19. mysql_fetch_row()
915; MYSQL_ROW mysql_fetch_row(MYSQL_RES *result)
916(define foreign-mysql-fetch-row
917  (foreign-lambda mysql-row "mysql_fetch_row" mysql-res-ptr))
918
919; 24.2.3.20. mysql_field_count()
920; unsigned int mysql_field_count(MYSQL *mysql)
921(define foreign-mysql-field-count
922  (foreign-lambda unsigned-integer "mysql_field_count" mysql-ptr))
923
924; 24.2.3.21. mysql_field_seek()
925; MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *result,
926;   MYSQL_FIELD_OFFSET offset)
927(define foreign-mysql-field-seek
928  (foreign-lambda unsigned-integer "mysql_field_seek" mysql-res-ptr
929                  unsigned-integer))
930
931; 24.2.3.22. mysql_field_tell()
932; MYSQL_FIELD_OFFSET mysql_field_tell(MYSQL_RES *result)
933(define foreign-mysql-field-tell
934  (foreign-lambda unsigned-integer "mysql_field_tell" mysql-res-ptr))
935
936; 24.2.3.23. mysql_free_result()
937; void mysql_free_result(MYSQL_RES *result)
938(define foreign-mysql-free-result
939  (foreign-lambda void "mysql_free_result" mysql-res-ptr))
940
941; 24.2.3.26.Êmysql_get_character_set_info()
942; void mysql_get_character_set_info(MYSQL *mysql, MY_CHARSET_INFO *cs)
943(define foreign-mysql-get-character-set-info
944  (foreign-lambda void "mysql_get_character_set_info" mysql-ptr my-charset-info))
945
946; 24.2.3.25. mysql_get_client_info()
947; char *mysql_get_client_info(void)
948(define foreign-mysql-get-client-info
949  (foreign-lambda c-string "mysql_get_client_info"))
950
951; 24.2.3.26. mysql_get_client_version()
952; unsigned long mysql_get_client_version(void)
953(define foreign-mysql-get-client-version
954  (foreign-lambda unsigned-long "mysql_get_client_version"))
955
956; 24.2.3.27. mysql_get_host_info()
957; char *mysql_get_host_info(MYSQL *mysql)
958(define foreign-mysql-get-host-info
959  (foreign-lambda c-string "mysql_get_host_info" mysql-ptr))
960
961; 24.2.3.28. mysql_get_proto_info()
962; unsigned int mysql_get_proto_info(MYSQL *mysql)
963(define foreign-mysql-get-proto-info
964  (foreign-lambda unsigned-integer "mysql_get_proto_info" mysql-ptr))
965
966; 24.2.3.29. mysql_get_server_info()
967; char *mysql_get_server_info(MYSQL *mysql)
968(define foreign-mysql-get-server-info
969  (foreign-lambda c-string "mysql_get_server_info" mysql-ptr))
970
971; 24.2.3.30. mysql_get_server_version()
972; unsigned long mysql_get_server_version(MYSQL *mysql)
973(define foreign-mysql-get-server-version
974  (foreign-lambda unsigned-long "mysql_get_server_version" mysql-ptr))
975
976; 24.2.3.31. mysql_hex_string()
977; unsigned long mysql_hex_string(char *to, const char *from,
978;   unsigned long length)
979(define foreign-mysql-hex-string
980  (foreign-lambda unsigned-long "mysql_hex_string" c-string c-string
981                  unsigned-long))
982
983; 24.2.3.32. mysql_info()
984; char *mysql_info(MYSQL *mysql)
985(define foreign-mysql-info
986  (foreign-lambda c-string "mysql_info" mysql-ptr))
987
988; 24.2.3.33. mysql_init()
989; MYSQL *mysql_init(MYSQL *mysql)
990(define foreign-mysql-init
991  (foreign-lambda mysql-ptr "mysql_init" mysql-ptr))
992
993; 24.2.3.35. mysql_kill()
994; int mysql_kill(MYSQL *mysql, unsigned long pid)
995(define foreign-mysql-kill
996  (foreign-lambda integer "mysql_kill" mysql-ptr unsigned-long))
997
998; 24.2.3.36. mysql_library_init()
999; int mysql_library_init(int argc, char **argv, char **groups)
1000(define foreign-mysql-library-init
1001  (foreign-lambda integer "mysql_library_init" integer c-pointer c-pointer))
1002
1003; 24.2.3.37. mysql_library_end()
1004; void mysql_library_end(void)
1005(define foreign-mysql-library-end
1006  (foreign-lambda void "mysql_library_end"))
1007
1008; 24.2.3.38. mysql_list_dbs()
1009; MYSQL_RES *mysql_list_dbs(MYSQL *mysql, const char *wild)
1010(define foreign-mysql-list-dbs
1011  (foreign-lambda mysql-res-ptr "mysql_list_dbs" mysql-ptr c-string))
1012
1013; 24.2.3.39. mysql_list_fields()
1014; MYSQL_RES *mysql_list_fields(MYSQL *mysql, const char *table,
1015;   const char *wild)
1016(define foreign-mysql-list-fields
1017  (foreign-lambda mysql-res-ptr "mysql_list_fields" mysql-ptr c-string
1018                  c-string))
1019
1020; 24.2.3.40. mysql_list_processes()
1021; MYSQL_RES *mysql_list_processes(MYSQL *mysql)
1022(define foreign-mysql-list-processes
1023  (foreign-lambda mysql-res-ptr "mysql_list_processes" mysql-ptr))
1024
1025; 24.2.3.41. mysql_list_tables()
1026; MYSQL_RES *mysql_list_tables(MYSQL *mysql, const char *wild)
1027(define foreign-mysql-list-tables
1028  (foreign-lambda mysql-res-ptr "mysql_list_tables" mysql-ptr c-string))
1029
1030; 24.2.3.42. mysql_num_fields()
1031; unsigned int mysql_num_fields(MYSQL_RES *result)
1032(define foreign-mysql-num-fields
1033  (foreign-lambda unsigned-integer "mysql_num_fields" mysql-res-ptr))
1034
1035; 24.2.3.44. mysql_options()
1036; int mysql_options(MYSQL *mysql, enum mysql_option option, const char *arg)
1037(define foreign-mysql-options
1038  (foreign-lambda integer "mysql_options" mysql-ptr mysql-option c-pointer))
1039
1040; 24.2.3.45. mysql_ping()
1041; int mysql_ping(MYSQL *mysql)
1042(define foreign-mysql-ping
1043  (foreign-lambda integer "mysql_ping" mysql-ptr))
1044
1045; 24.2.3.46. mysql_query()
1046; int mysql_query(MYSQL *mysql, const char *stmt_str)
1047;
1048; NOTE: use "mysql_real_query" instead
1049(define foreign-mysql-query
1050  (foreign-lambda integer "mysql_query" mysql-ptr c-string))
1051
1052; 24.2.3.47. mysql_real_connect()
1053; MYSQL *mysql_real_connect(MYSQL *mysql, const char *host, const char *user,
1054;   const char *passwd, const char *db, unsigned int port,
1055;   const char *unix_socket, unsigned long client_flag)
1056(define foreign-mysql-real-connect
1057  (foreign-lambda mysql-ptr "mysql_real_connect"
1058                  mysql-ptr c-string c-string
1059                  c-string c-string unsigned-integer
1060                  c-string unsigned-long))
1061
1062; 24.2.3.48. mysql_real_escape_string()
1063; unsigned long mysql_real_escape_string(MYSQL *mysql, char *to,
1064;   const char *from, unsigned long length)
1065(define foreign-mysql-real-escape-string
1066  (foreign-lambda unsigned-long "mysql_real_escape_string" mysql-ptr
1067                  c-string c-string unsigned-long))
1068
1069; 24.2.3.49. mysql_real_query()
1070; int mysql_real_query(MYSQL *mysql, const char *query, unsigned long length)
1071(define foreign-mysql-real-query
1072  (foreign-lambda unsigned-integer "mysql_real_query" mysql-ptr c-string
1073                  unsigned-long))
1074
1075; 24.2.3.51. mysql_row_seek()
1076; MYSQL_ROW_OFFSET mysql_row_seek(MYSQL_RES *result, MYSQL_ROW_OFFSET offset)
1077(define foreign-mysql-row-seek
1078  (foreign-lambda mysql-rows-ptr "mysql_row_seek" mysql-res-ptr mysql-rows-ptr))
1079
1080; 24.2.3.52. mysql_row_tell()
1081; MYSQL_ROW_OFFSET mysql_row_tell(MYSQL_RES *result)
1082(define foreign-mysql-row-tell
1083  (foreign-lambda mysql-rows-ptr "mysql_row_tell" mysql-res-ptr))
1084
1085; 24.2.3.53. mysql_select_db()
1086; int mysql_select_db(MYSQL *mysql, const char *db)
1087(define foreign-mysql-select-db
1088  (foreign-lambda integer "mysql_select_db" mysql-ptr c-string))
1089
1090; 24.2.3.54. mysql_set_character_set()
1091; int mysql_set_character_set(MYSQL *mysql, char *csname)
1092(define foreign-mysql-set-character-set
1093  (foreign-lambda integer "mysql_set_character_set" mysql-ptr c-string))
1094
1095; 24.2.3.55. mysql_set_server_option()
1096; int mysql_set_server_option(MYSQL *mysql, enum enum_mysql_set_option option)
1097(define foreign-mysql-set-server-option
1098  (foreign-lambda integer "mysql_set_server_option" mysql-ptr mysql-server-option))
1099
1100; 24.2.3.56. mysql_shutdown()
1101; int mysql_shutdown(MYSQL *mysql, enum enum_shutdown_level shutdown_level)
1102(define foreign-mysql-shutdown
1103  (foreign-lambda integer "mysql_shutdown" mysql-ptr integer))
1104
1105; 24.2.3.57. mysql_sqlstate()
1106; const char *mysql_sqlstate(MYSQL *mysql)
1107(define foreign-mysql-sqlstate
1108  (foreign-lambda c-string "mysql_sqlstate" mysql-ptr))
1109
1110; 24.2.3.58. mysql_ssl_set()
1111; int mysql_ssl_set(MYSQL *mysql, const char *key, const char *cert,
1112;   const char *ca, const char *capath, const char *cipher)
1113(define foreign-mysql-ssl-set
1114  (foreign-lambda integer "mysql_ssl_set" mysql-ptr c-string c-string
1115                  c-string c-string c-string))
1116
1117; 24.2.3.59. mysql_stat()
1118; char *mysql_stat(MYSQL *mysql)
1119(define foreign-mysql-stat
1120  (foreign-lambda c-string "mysql_stat" mysql-ptr))
1121
1122; 24.2.3.60. mysql_store_result()
1123; MYSQL_RES *mysql_store_result(MYSQL *mysql)
1124(define foreign-mysql-store-result
1125  (foreign-lambda mysql-res-ptr "mysql_store_result" mysql-ptr))
1126
1127; 24.2.3.61. mysql_thread_id()
1128; unsigned long mysql_thread_id(MYSQL *mysql)
1129(define foreign-mysql-thread-id
1130  (foreign-lambda unsigned-long "mysql_thread_id" mysql-ptr))
1131
1132; 24.2.3.62. mysql_use_result()
1133; MYSQL_RES *mysql_use_result(MYSQL *mysql)
1134(define foreign-mysql-use-result
1135  (foreign-lambda mysql-res-ptr "mysql_use_result" mysql-ptr))
1136
1137; 24.2.3.63. mysql_warning_count()
1138; unsigned int mysql_warning_count(MYSQL *mysql)
1139(define foreign-mysql-warning-count
1140  (foreign-lambda unsigned-integer "mysql_warning_count" mysql-ptr))
1141
1142; 24.2.3.64. mysql_commit()
1143; my_bool mysql_commit(MYSQL *mysql)
1144(define foreign-mysql-commit
1145  (foreign-lambda my-bool "mysql_commit" mysql-ptr))
1146
1147; 24.2.3.65. mysql_rollback()
1148; my_bool mysql_rollback(MYSQL *mysql)
1149(define foreign-mysql-rollback
1150  (foreign-lambda my-bool "mysql_rollback" mysql-ptr))
1151
1152; 24.2.3.66. mysql_autocommit()
1153; my_bool mysql_autocommit(MYSQL *mysql, my_bool mode)
1154(define foreign-mysql-autocommit
1155  (foreign-lambda my-bool "mysql_autocommit" mysql-ptr my-bool))
1156
1157; 24.2.3.67. mysql_more_results()
1158; my_bool mysql_more_results(MYSQL *mysql)
1159(define foreign-mysql-more-results
1160  (foreign-lambda my-bool "mysql_more_results" mysql-ptr))
1161
1162; 24.2.3.68. mysql_next_result()
1163; int mysql_next_result(MYSQL *mysql)
1164(define foreign-mysql-next-result
1165  (foreign-lambda integer "mysql_next_result" mysql-ptr))
1166
1167;-----------------------------------------------------------------------
1168; Foreign function definitions for mysqlaux functions.
1169;
1170
1171#>
1172static int
1173mysqlaux_field_index (MYSQL *mysql, MYSQL_RES *result, const char *name)
1174{
1175  unsigned int num_fields = mysql_field_count(mysql);
1176  MYSQL_FIELD *fields = mysql_fetch_fields(result);
1177  unsigned int i;
1178
1179  for (i = 0; i < num_fields; i++) {
1180    if (0 == strcasecmp (name, fields[i].name)) {
1181      return (i);
1182    }
1183  }
1184
1185  return (-1);
1186}
1187<#
1188
1189; int mysqlaux_field_index (MYSQL *mysql, MYSQL_RES *result, const char *name)
1190(define foreign-mysqlaux-field-index
1191  (foreign-lambda int "mysqlaux_field_index" mysql-ptr mysql-res-ptr nonnull-c-string) )
1192
1193; char *mysqlaux_fetch_column_direct(MYSQL_ROW, unsigned int);
1194(define foreign-mysqlaux-fetch-column-direct
1195  (foreign-lambda* c-pointer ((mysql-row row) (unsigned-integer idx))
1196    "return (((MYSQL_ROW)row)[idx]);") )
1197
1198;
1199(define (%mysql-get-field-index connptr resptr field)
1200  (if (number? field)
1201      field
1202      (foreign-mysqlaux-field-index connptr resptr (->string field)) ) )
1203
1204;=======================================================================
1205; Provided Scheme API.
1206;
1207; This is an attempt at a Schemer-friendly API to MySQL. Much of the API
1208; is the same, but the C API has been simplified where possible, and a
1209; few additional features have been layered on.
1210;
1211
1212; record printer helper
1213(define (record-slot->string val lbl #!optional (tst val))
1214  (if tst
1215      (conc #\space lbl #\: #\space #\" val #\")
1216      "") )
1217
1218(define foreign-char-pointer->string
1219  (foreign-lambda* c-string ((nonnull-c-pointer chrptr))
1220    "return ((char *) chrptr);") )
1221
1222(define (foreign-unsigned-long-pointer->u32vector ulptr cnt)
1223  (let* ([siz (* cnt UNSIGNED-LONG-SIZE)]
1224         [store (make-blob siz)])
1225    (move-memory! ulptr store siz)
1226    (blob->u32vector/shared store) ) )
1227
1228(define foreign-char-pointer->string
1229  (foreign-lambda* c-string ((c-pointer chrptr))
1230    "return ((char *) chrptr);") )
1231
1232(define (foreign-binary-char-pointer->string chrptr size)
1233  (let ([blob (make-blob size)])
1234    (move-memory! chrptr blob size)
1235    (blob->string blob) ) )
1236
1237;-----------------------------------------------------------------------
1238; MySQL exceptions
1239;
1240
1241(define (make-exn-condition loc msg . args)
1242  (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
1243
1244(define (make-mysql-condition)
1245  (make-property-condition 'mysql) )
1246
1247(define (make-exn-mysql-condition loc msg . args)
1248  (make-composite-condition
1249   (apply make-exn-condition loc msg args)
1250   (make-mysql-condition)) )
1251
1252(define (signal-mysql-condition loc msg . args)
1253  (signal (apply make-exn-mysql-condition loc msg args)) )
1254
1255(define (signal-mysql-error loc conn . args)
1256  (apply signal-mysql-condition loc (mysql-error conn) args) )
1257
1258;-----------------------------------------------------------------------
1259; MySQL "SSL" record type definition.
1260;
1261; See <http://www.openssl.org/docs/apps/ciphers.html> for a discussion
1262; of the cipher-list format.
1263;
1264
1265(define-record-type mysql-ssl
1266  (%make-mysql-ssl key cert ca capath cipher)
1267  mysql-ssl?
1268  (key mysql-ssl-key-pathname)
1269  (cert mysql-ssl-certificate-pathname)
1270  (ca mysql-ssl-certificate-authority-pathname)
1271  (capath mysql-ssl-trusted-certificates-pathname)
1272  (cipher mysql-ssl-ciphers) )
1273
1274(define (make-mysql-ssl #!key key certificate certificate-authority
1275                              trusted-certificates ciphers)
1276  (%make-mysql-ssl key certificate certificate-authority trusted-certificates ciphers) )
1277
1278(define-record-printer (mysql-ssl ssl out)
1279  (let ([key (mysql-ssl-key-pathname ssl)]
1280        [cert (mysql-ssl-certificate-pathname ssl)]
1281        [ca (mysql-ssl-certificate-authority-pathname ssl)]
1282        [capath (mysql-ssl-trusted-certificates-pathname ssl)]
1283        [cipher (mysql-ssl-ciphers ssl)])
1284    (display
1285     (string-append
1286      "#<mysql-ssl"
1287      (record-slot->string key      "key")
1288      (record-slot->string cert     "cert")
1289      (record-slot->string ca       "ca")
1290      (record-slot->string capath   "capath")
1291      (record-slot->string cipher   "cipher")
1292      ">")
1293     out) ) )
1294
1295;-----------------------------------------------------------------------
1296; MySQL connection options helper.
1297;
1298
1299(define (make-mysql-options . opts)
1300  (let loop ([opts opts] [alst '()])
1301    (if (null? opts)
1302        alst
1303        (let* ([opt (car opts)]
1304               [nxt (cdr opts)]
1305               [val (if (null? nxt)
1306                        (error 'make-options "missing value for option" opt)
1307                        (car nxt))])
1308          (unless (number? opt)
1309            (error 'make-options "invalid option" opt) )
1310          (unless (or (number? val) (string? val) (not val) (null? val))
1311            (error 'make-options "invalid option value" val) )
1312          (loop (cdr nxt) (alist-cons opt val alst)) ) ) ) )
1313
1314;-----------------------------------------------------------------------
1315; MySQL "Connection" record type definition.
1316;
1317; I've stuffed the raw FFI pointer into a slot in the mysql-connection
1318; record. The record is here for a few reasons:
1319;
1320;   1) Instead of an ugly #<pointer>, I've defined a pretty printer
1321;      to demonstrate that we've actually got a MySQL connection.
1322;   2) The C API is somewhat more verbose than what normal usage would
1323;      need. (For example, usually you don't care whether results are
1324;      all read into memory as fast as possible, or if they're read from
1325;      the network one-by-one. Thus, the mysql-query function provided
1326;      automatically reads the results into memory. For finer granularity,
1327;      you're always free to write your own version to use the "raw"
1328;      foreign-* functions. I suppose a contribution to determine this
1329;      behavior via a (make-parameter ...) parameter may also be
1330;      accepted. ;)) Slots are provided in the mysql-connection record
1331;      type to allow for this sort of simplifying behavior.
1332;
1333; All of the "Scheme API" MySQL functions take instances of this record
1334; type, instead of a raw FFI pointer (as the foreign-* functions require).
1335;
1336
1337(define-record-type mysql-connection
1338  (make-mysql-connection host user passwd db port unix-socket
1339                         client-flag ptr result result-start
1340                         ssl opts)
1341  mysql-connection?
1342  (host mysql-connection-host)
1343  (user mysql-connection-user)
1344  (passwd mysql-connection-passwd)
1345  (db mysql-connection-db)
1346  (port mysql-connection-port)
1347  (unix-socket mysql-connection-unix-socket)
1348  (client-flag mysql-connection-client-flag)
1349  (ptr mysql-connection-ptr mysql-connection-ptr-set!)
1350  (result mysql-connection-result mysql-connection-result-set!)
1351  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
1352  (ssl mysql-connection-ssl)
1353  (opts mysql-connection-options) )
1354
1355(define-record-printer (mysql-connection conn out)
1356  (let [(host (mysql-connection-host conn))
1357        (user (mysql-connection-user conn))
1358        (passwd (mysql-connection-passwd conn))
1359        (db (mysql-connection-db conn))
1360        (tcp-port (mysql-connection-port conn))
1361        (unix-socket (mysql-connection-unix-socket conn))
1362        (client-flag (mysql-connection-client-flag conn))
1363        (ssl (mysql-connection-ssl conn))
1364        (opts (mysql-connection-options conn))]
1365    (display
1366     (string-append
1367      "#<mysql-connection"
1368      (if (mysql-connection-ptr conn)
1369          (string-append
1370            (record-slot->string host         "host")
1371            (record-slot->string user         "user")
1372            (record-slot->string passwd       "passwd")
1373            (record-slot->string db           "db")
1374            (record-slot->string tcp-port     "tcp-port"    (not (zero? tcp-port)))
1375            (record-slot->string unix-socket  "unix-socket")
1376            (record-slot->string client-flag  "client-flag" (not (zero? client-flag)))
1377            (record-slot->string ssl          "ssl")
1378            (record-slot->string opts         "options") )
1379          " INVALID")
1380      ">")
1381     out) ) )
1382
1383;-----------------------------------------------------------------------
1384; The "base" MySQL/Scheme API.
1385;
1386; This part of the API provides a slightly simplified version of the full
1387; MySQL C API.
1388;
1389
1390(define (mysql-affected-rows conn)
1391  (foreign-mysql-affected-rows (mysql-connection-ptr conn)) )
1392
1393(define (mysql-change-user conn #!key (user #f) (passwd #f) (db #f))
1394  (foreign-mysql-change-user (mysql-connection-ptr conn) user passwd db) )
1395
1396(define (mysql-character-set-name conn)
1397  (foreign-mysql-character-set-name (mysql-connection-ptr conn)))
1398
1399; Closes a mysql connection and invalidates the mysql connection object.
1400; Returns (void). You should do this when you're done with the MySQL
1401; connection; however, if you don't close it manually, it will be closed
1402; upon termination.
1403(define (mysql-close conn)
1404  (mysql-free-result conn)
1405  (foreign-mysql-close (mysql-connection-ptr conn))
1406  (mysql-connection-ptr-set! conn #f) )
1407
1408; Returns a mysql connection object, or #f on failure.
1409(define (mysql-connect #!key (host #f) (user #f) (passwd #f) (db #f) (port 0)
1410                       (unix-socket #f) (client-flag 0)
1411                       (options #f) (ssl #f))
1412  (let ([mysql (foreign-mysql-init #f)])
1413    (cond
1414      [mysql
1415        (when ssl
1416          (foreign-mysql-ssl-set mysql
1417                                 (mysql-ssl-key-pathname ssl)
1418                                 (mysql-ssl-certificate-pathname ssl)
1419                                 (mysql-ssl-certificate-authority-pathname ssl)
1420                                 (mysql-ssl-trusted-certificates-pathname ssl)
1421                                 (mysql-ssl-ciphers ssl)) )
1422        (when options
1423          (for-each
1424           (lambda (optitm)
1425             (let ([opt (car optitm)]
1426                   [val (cdr optitm)])
1427               (unless (zero? (%mysql-options mysql opt val))
1428                 (signal-mysql-condition 'mysql-connect "unknown option code" opt val))))
1429           options) )
1430        (let ([mysqlptr (foreign-mysql-real-connect mysql host user passwd db
1431                                                    port unix-socket
1432                                                    client-flag)])
1433          (if mysqlptr
1434              (make-mysql-connection host user passwd db port unix-socket
1435                                     client-flag mysqlptr #f #f options ssl)
1436              (signal-mysql-condition 'mysql-connect
1437               (foreign-mysql-error mysql)
1438               host user passwd db port unix-socket client-flag options ssl options) ) ) ]
1439      [else
1440        (signal-mysql-condition 'mysql-connect "failed to initialize mysql") ] ) ) )
1441
1442(define (mysql-debug debug)
1443  (foreign-mysql-debug debug) )
1444
1445(define (mysql-dump-debug-info conn)
1446  (foreign-mysql-dump-debug-info (mysql-connection-ptr conn)) )
1447
1448(define (mysql-errno conn)
1449  (foreign-mysql-errno (mysql-connection-ptr conn)))
1450
1451; Returns a string describing the last mysql error, or #f if no error
1452; has occurred.
1453(define (mysql-error conn)
1454  (let [(errstr (foreign-mysql-error (mysql-connection-ptr conn)))]
1455    (and (not (string=? "" errstr))
1456         errstr) ) )
1457
1458(define (mysql-escape-string conn str)
1459        (let-location ([escstr c-string*])
1460    ((foreign-lambda* void ((mysql-ptr mysql) (c-pointer to) (c-string from) (unsigned-long length))
1461      "if ((*((char **) to) = ((char *) C_malloc ((2 * length) + 1)))) {\n"
1462      "    (void) mysql_real_escape_string (mysql, *((char **) to), from, length);\n"
1463      "}")
1464     (location escstr)
1465     str (string-length str))
1466    escstr ) )
1467
1468; returns a mysql-field-ptr or #f when no more fields.
1469; returns #f when no result set.
1470(define (mysql-fetch-field conn)
1471  (and-let* ([resptr (mysql-connection-result conn)])
1472    (foreign-mysql-fetch-field resptr) ) )
1473
1474; returns a mysql-field-ptr to a vector of MYSQL_FIELD or #f when no fields.
1475; returns #f when no result set.
1476(define (mysql-fetch-fields conn)
1477  (and-let* ([resptr (mysql-connection-result conn)])
1478    (foreign-mysql-fetch-fields resptr) ) )
1479
1480; returns a mysql-field-ptr or #f when no such field.
1481; returns #f when no result set.
1482(define (mysql-fetch-field-direct conn field-number)
1483  (and-let* ([resptr (mysql-connection-result conn)])
1484    (foreign-mysql-fetch-field-direct resptr field-number) ) )
1485
1486; returns a u32vector of length num-fields.
1487; returns #f when no result set.
1488(define (%mysql-fetch-lengths resptr cnt)
1489  (and-let* ([ulptr (foreign-mysql-fetch-lengths resptr)])
1490    (foreign-unsigned-long-pointer->u32vector ulptr cnt) ) )
1491
1492; returns a u32vector of length num-fields.
1493; returns #f when no result set.
1494(define (mysql-fetch-lengths conn)
1495  (and-let* ([resptr (mysql-connection-result conn)])
1496    (%mysql-fetch-lengths resptr (foreign-mysql-num-fields resptr)) ) )
1497
1498; After a mysql-query that has results, use mysql-fetch-row to retrieve
1499; results row-by-row. When no more rows are left, returns #f. When returning
1500; a "row", returns a procedure that takes exactly 1 argument, which may
1501; be either a number (in which case it is treated as the column index,
1502; starting at zero) or a symbol or string (which will be treated as the
1503; column name).
1504(define (mysql-fetch-row conn)
1505  (and-let* ([resptr (mysql-connection-result conn)]
1506             [row (foreign-mysql-fetch-row resptr)])
1507    (let* ([connptr (mysql-connection-ptr conn)]
1508           [fldcnt (foreign-mysql-num-fields resptr)]
1509           [fldlens (%mysql-fetch-lengths resptr fldcnt)])
1510      (lambda (field)
1511        (let ([fldidx (%mysql-get-field-index connptr resptr field)])
1512          (and (<= 0 fldidx) (< fldidx fldcnt)
1513               (let ([chrptr (foreign-mysqlaux-fetch-column-direct resptr fldidx)])
1514                  (if (mysql-field-binary? (foreign-mysql-fetch-field-direct resptr fldidx))
1515                      (foreign-binary-char-pointer->string
1516                       chrptr (u32vector-ref fldlens fldidx))
1517                      (foreign-char-pointer->string chrptr) ) ) ) ) ) ) ) )
1518
1519(define (mysql-field-count conn)
1520  (foreign-mysql-field-count (mysql-connection-ptr conn)))
1521
1522(define (mysql-free-result conn)
1523  (and-let* [(res (mysql-connection-result conn))]
1524    (foreign-mysql-free-result res) )
1525  (mysql-connection-result-set! conn #f)
1526  (mysql-connection-result-start-set! conn #f) )
1527
1528; returns a c-pointer to a MY_CHARSET_INFO struct.
1529; a finalizer is supplied.
1530(define (mysql-get-character-set-info conn)
1531  (let ([chrsetinfo (allocate-my-charset-info)])
1532    (foreign-mysql-get-character-set-info (mysql-connection-ptr conn) chrsetinfo)
1533    (set-finalizer! chrsetinfo free-my-charset-info)
1534    chrsetinfo ) )
1535
1536(define (mysql-get-client-info)
1537  (foreign-mysql-get-client-info) )
1538
1539(define (mysql-get-client-version)
1540  (foreign-mysql-get-client-version) )
1541
1542(define (mysql-get-host-info conn)
1543  (foreign-mysql-get-host-info (mysql-connection-ptr conn)) )
1544
1545(define (mysql-get-proto-info conn)
1546  (foreign-mysql-get-proto-info (mysql-connection-ptr conn)) )
1547
1548(define (mysql-get-server-info conn)
1549  (foreign-mysql-get-server-info (mysql-connection-ptr conn)) )
1550
1551(define (mysql-get-server-version conn)
1552  (foreign-mysql-get-server-version (mysql-connection-ptr conn)) )
1553
1554(define (mysql-info conn)
1555  (foreign-mysql-info (mysql-connection-ptr conn)) )
1556
1557(define (mysql-insert-id conn)
1558  (foreign-mysql-insert-id (mysql-connection-ptr conn)) )
1559
1560(define (mysql-kill conn pid)
1561  (foreign-mysql-kill (mysql-connection-ptr conn) pid) )
1562
1563(define (mysql-list-dbs conn like)
1564  (mysql-free-result conn)
1565  (mysql-connection-result-set! conn
1566    (foreign-mysql-list-dbs (mysql-connection-ptr conn) like)) )
1567
1568(define (mysql-list-fields conn table wild)
1569  (mysql-free-result conn)
1570  (mysql-connection-result-set! conn
1571    (foreign-mysql-list-fields (mysql-connection-ptr conn) table wild)) )
1572
1573(define (mysql-list-processes conn)
1574  (mysql-free-result conn)
1575  (mysql-connection-result-set! conn
1576    (foreign-mysql-list-processes (mysql-connection-ptr conn))) )
1577
1578(define (mysql-list-tables conn wild)
1579  (mysql-free-result conn)
1580  (mysql-connection-result-set! conn
1581    (foreign-mysql-list-tables (mysql-connection-ptr conn) wild)) )
1582
1583(define (mysql-num-fields conn)
1584  (foreign-mysql-num-fields (mysql-connection-result conn)) )
1585
1586(define (mysql-num-rows conn)
1587  (and-let* ([res (mysql-connection-result conn)])
1588    (foreign-mysql-num-rows res)) )
1589
1590(define (mysql-ping conn)
1591  (foreign-mysql-ping (mysql-connection-ptr conn)) )
1592
1593; returns #t if the query was successful, signals exception otherwise.
1594(define (mysql-query conn query)
1595  (let [(mysql-ptr (mysql-connection-ptr conn))]
1596    ; zero indicates success
1597    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
1598        (begin (mysql-store-result conn) #t)
1599        (signal-mysql-error 'mysql-query conn query) ) ) )
1600
1601; returns #t if the select was successful, signals exception otherwise.
1602(define (mysql-select-db conn db)
1603  (or (zero? (foreign-mysql-select-db (mysql-connection-ptr conn) db))
1604      (signal-mysql-error 'mysql-select-db conn db) ) )
1605
1606; returns #t if the set was successful, signals exception otherwise.
1607(define (mysql-set-character-set conn csname)
1608  (or (zero? (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
1609      (signal-mysql-condition 'mysql-set-character-set "bad character set name" csname) ) )
1610
1611(define (mysql-stat conn)
1612  (foreign-mysql-stat (mysql-connection-ptr conn)) )
1613
1614(define (mysql-store-result conn)
1615  (mysql-connection-result-set! conn
1616    (foreign-mysql-store-result (mysql-connection-ptr conn)))
1617  (mysql-connection-result-start-set! conn
1618    (and (mysql-connection-result conn)
1619         (foreign-mysql-row-tell (mysql-connection-result conn))) ) )
1620
1621(define (mysql-thread-id conn)
1622  (foreign-mysql-thread-id (mysql-connection-ptr conn)) )
1623
1624;-----------------------------------------------------------------------
1625; The "extended" MySQL/Scheme API.
1626;
1627; This API provides some additional functionality.
1628;
1629
1630; rewinds to the beginning of the result set. has no effect if there is no
1631; current result set.
1632(define (mysql-rewind conn)
1633  (and-let* ([res-st (mysql-connection-result-start conn)])
1634    (foreign-mysql-row-seek (mysql-connection-result conn) res-st) ) )
1635
1636;-----------------------------------------------------------------------
1637; The "map" MySQL/Scheme API.
1638;
1639; This API provides some additional functionality for traversing results
1640; in a Scheme-ish way.
1641;
1642
1643; calls proc on every row in the current result set. proc should take 3
1644; arguments: the row (as described for mysql-fetch-row), the row index
1645; (which starts with 1 and ends with (mysql-num-rows conn), and the
1646; current accumulated value.
1647;
1648; returns the final accumulated value.
1649;
1650; note: rewinds the result set before and after iterating over it; thus,
1651; all rows are included.
1652;
1653; you must call mysql-rewind if you later want to iterate over the result set
1654; using mysql-fetch-row.
1655(define (mysql-row-fold conn proc init)
1656  (mysql-rewind conn)
1657  (let loop ([rownum 1] [acc init])
1658    (let ([row (mysql-fetch-row conn)])
1659      (if row
1660          (loop (+ rownum 1) (proc row rownum acc))
1661          acc ) ) ) )
1662
1663; calls proc on every row in the current result set. proc should take 2
1664; arguments: the row (as described for mysql-fetch-row) and the row index
1665; (which starts with 1 and ends with (mysql-num-rows conn).
1666;
1667; note: rewinds the result set before and after iterating over it; thus,
1668; all rows are included.
1669;
1670; you must call mysql-rewind if you later want to iterate over the result set
1671; using mysql-fetch-row.
1672(define (mysql-row-for-each conn proc)
1673  (mysql-row-fold conn
1674                  (lambda (row rownum _) (proc row rownum))
1675                  #t) )
1676
1677; calls proc on every row in the current result set. proc should take 2
1678; arguments: the row (as described for mysql-fetch-row) and the row index
1679; (which starts with 1 and ends with (mysql-num-rows conn).
1680;
1681; returns a list of the results of each proc invocation.
1682;
1683; note: rewinds the result set before and after iterating over it; thus,
1684; all rows are included.
1685;
1686; you must call mysql-rewind if you later want to iterate over the result set
1687; using mysql-fetch-row.
1688(define (mysql-row-map conn proc)
1689  (reverse!
1690    (mysql-row-fold conn
1691                    (lambda (row rownum lst) (cons (proc row rownum) lst))
1692                    '())) )
1693
1694; executes query and then mysql-row-for-each with the given proc. the proc
1695; must meet the contract specified for the proc passed to mysql-row-for-each.
1696(define (mysql-query-fold conn query proc init)
1697  (mysql-query conn query)
1698  (mysql-row-fold conn proc init) )
1699
1700; executes query and then mysql-row-for-each with the given proc. the proc
1701; must meet the contract specified for the proc passed to mysql-row-for-each.
1702(define (mysql-query-for-each conn query proc)
1703  (mysql-query conn query)
1704  (mysql-row-for-each conn proc) )
1705
1706; executes query and then mysql-row-for-each with the given proc. the proc
1707; must meet the contract specified for the proc passed to mysql-row-for-each.
1708(define (mysql-query-map conn query proc)
1709  (mysql-query conn query)
1710  (mysql-row-map conn proc) )
1711
1712; synonyms
1713(define mysql-query-foreach mysql-query-for-each)
1714(define mysql-foreach-row mysql-row-for-each)
1715
1716;-----------------------------------------------------------------------
1717; The MySQL Field structure predicate API.
1718;
1719
1720(define (mysql-field-flags-test fldptr mask)
1721  (bitwise-and (mysql-field-flags fldptr) mask) )
1722
1723(define (mysql-field-flags-mask flags)
1724  (apply mysql-field-flags-value flags) )
1725
1726;;
1727
1728(define (mysql-field-flags-on? fldptr . flags)
1729  (let ([mask (mysql-field-flags-mask flags)])
1730    (= mask (mysql-field-flags-test fldptr mask)) ) )
1731
1732(define (mysql-field-flags-off? fldptr . flags)
1733  (zero? (mysql-field-flags-test fldptr (mysql-field-flags-mask flags))) )
1734
1735;;
1736
1737(define (mysql-field-type-any? fldptr types)
1738  (memv (mysql-field-type fldptr) types) )
1739
1740(define (mysql-field-type=? fldptr type)
1741  (eqv? type (mysql-field-type fldptr)) )
1742
1743;;
1744
1745(define (mysql-field-primary-key? fldptr)
1746  (mysql-field-flags-on? fldptr pri-key-flag) )
1747
1748(define (mysql-field-not-null? fldptr)
1749  (mysql-field-flags-on? fldptr not-null-flag) )
1750
1751(define (mysql-field-binary? fldptr)
1752  (= 63 (mysql-field-charsetnr fldptr)) )
1753
1754(define (mysql-field-numeric? fldptr)
1755  (mysql-field-flags-on? fldptr num-flag) )
1756
1757;;
1758
1759(define mysql-field-type-clock?
1760  (let ([numtypes (list mysql-type-timestamp mysql-type-datetime
1761                        mysql-type-date mysql-type-time
1762                        mysql-type-newdate mysql-type-year)])
1763    (lambda (fldptr)
1764      (mysql-field-type-any? fldptr numtypes) ) ) )
1765
1766; note - not the same as the "IS_NUM" macro.
1767(define mysql-field-type-number?
1768  (let ([numtypes (list mysql-type-decimal mysql-type-tiny mysql-type-short
1769                            mysql-type-long mysql-type-float mysql-type-double
1770                        mysql-type-longlong mysql-type-int24
1771                        mysql-type-newdecimal)])
1772    (lambda (fldptr)
1773      (mysql-field-type-any? fldptr numtypes) ) ) )
1774
1775(define mysql-field-type-blob?
1776  (let ([blobtypes (list mysql-type-tiny-blob mysql-type-medium-blob
1777                         mysql-type-long-blob mysql-type-blob)])
1778    (lambda (fldptr)
1779      (mysql-field-type-any? fldptr blobtypes) ) ) )
1780
1781(define mysql-field-type-string?
1782  (let ([numtypes (list mysql-type-varchar mysql-type-var-string
1783                        mysql-type-string)])
1784    (lambda (fldptr)
1785      (mysql-field-type-any? fldptr numtypes) ) ) )
1786
1787;;
1788
1789; note - the same as the "IS_NUM" macro.
1790(define mysql-field-type-magnitude?
1791  (let ([magtypes (list mysql-type-timestamp mysql-type-year mysql-type-null)])
1792    (lambda (fldptr)
1793      (or (mysql-field-type-number? fldptr)
1794          (mysql-field-type-any? fldptr magtypes) ) ) ) )
1795
1796(define (mysql-field-type-binary? fldptr)
1797  (and (mysql-field-binary? fldptr)
1798       (or (mysql-field-type-blob? fldptr)
1799           (mysql-field-type-string? fldptr) ) ) )
1800
1801(define (mysql-field-type-text? fldptr)
1802  (and (not (mysql-field-binary? fldptr))
1803       (or (mysql-field-type-blob? fldptr)
1804           (mysql-field-type-string? fldptr) ) ) )
1805
1806;-----------------------------------------------------------------------
1807; The MySQL Field structure multi-slot API.
1808;
1809
1810; returns a list of field items.
1811(define (mysql-field-slots fldptr . getters)
1812  (and fldptr
1813       (map (cut <> fldptr) getters) ) )
1814
1815; returns a list of field items for nth field.
1816(define (mysql-fetch-field-slots-direct conn nth . getters)
1817  (apply mysql-field-slots (mysql-fetch-field-direct conn nth) getters) )
1818
1819; returns a field item for nth field.
1820(define (mysql-fetch-field-slot-direct conn nth getter)
1821  (and-let* ([lst (mysql-field-slots (mysql-fetch-field-direct conn nth) getter)])
1822    (car lst) ) )
1823
1824; returns a list of field items for the next field.
1825(define (mysql-fetch-field-slots conn . getters)
1826  (apply mysql-field-slots (mysql-fetch-field conn) getters) )
1827
1828; returns a field item for the next field.
1829(define (mysql-fetch-field-slot conn getter)
1830  (and-let* ([lst (mysql-field-slots (mysql-fetch-field conn) getter)])
1831    (car lst) ) )
1832
1833; returns a field pointer or #f.
1834(define (mysql-fetch-field-specific conn field)
1835  (and-let* ([resptr (mysql-connection-result conn)])
1836    (let ([fldidx (%mysql-get-field-index (mysql-connection-ptr conn) resptr field)]
1837          [fldcnt (foreign-mysql-num-fields resptr)])
1838      (and (<= 0 fldcnt) (< fldidx fldcnt)
1839           (foreign-mysql-fetch-field-direct resptr fldidx) ) ) ) )
1840
1841#|
1842;-----------------------------------------------------------------------
1843; The MySQL row field value string form conversion
1844;
1845
1846(define (chrbuf2obj-string->number _ x) (string->number x))
1847(define (chrbuf2obj-string->blob _ x) (string->blob x))
1848(define (chrbuf2obj-identity _ x) (identity x))
1849
1850(define *character-buffer->object*
1851  `(
1852        (((,mysql-field-type=? ,mysql-type-null))
1853                  (,chrbuf2obj-identity))
1854
1855        (((,mysql-field-type=? ,mysql-type-bit))
1856                  (,chrbuf2obj-identity))
1857        (((,mysql-field-type=? ,mysql-type-enum))
1858                  (,chrbuf2obj-identity))
1859        (((,mysql-field-type=? ,mysql-type-set))
1860                  (,chrbuf2obj-identity))
1861        (((,mysql-field-type=? ,mysql-type-geometry))
1862                  (,chrbuf2obj-identity))
1863
1864        (((,mysql-field-type=? ,mysql-type-decimal))
1865                        (,chrbuf2obj-string->number))
1866        (((,mysql-field-type=? ,mysql-type-tiny))
1867                        (,chrbuf2obj-string->number))
1868        (((,mysql-field-type=? ,mysql-type-short))
1869                        (,chrbuf2obj-string->number))
1870        (((,mysql-field-type=? ,mysql-type-long))
1871                        (,chrbuf2obj-string->number))
1872        (((,mysql-field-type=? ,mysql-type-float))
1873                        (,chrbuf2obj-string->number))
1874        (((,mysql-field-type=? ,mysql-type-double))
1875                        (,chrbuf2obj-string->number))
1876        (((,mysql-field-type=? ,mysql-type-longlong))
1877                        (,chrbuf2obj-string->number))
1878        (((,mysql-field-type=? ,mysql-type-int24))
1879                        (,chrbuf2obj-string->number))
1880        (((,mysql-field-type=? ,mysql-type-newdecimal))
1881                        (,chrbuf2obj-string->number))
1882
1883        (((,mysql-field-type=? ,mysql-type-timestamp))
1884                  (,chrbuf2obj-identity))
1885        (((,mysql-field-type=? ,mysql-type-date))
1886                  (,chrbuf2obj-identity))
1887        (((,mysql-field-type=? ,mysql-type-time))
1888                  (,chrbuf2obj-identity))
1889        (((,mysql-field-type=? ,mysql-type-datetime))
1890                  (,chrbuf2obj-identity))
1891        (((,mysql-field-type=? ,mysql-type-year))
1892                  (,chrbuf2obj-identity))
1893        (((,mysql-field-type=? ,mysql-type-newdate))
1894                  (,chrbuf2obj-identity))
1895
1896        (((,mysql-field-type=? ,mysql-type-tiny-blob) (,mysql-field-binary?))
1897                  (,chrbuf2obj-string->blob))
1898        (((,mysql-field-type=? ,mysql-type-medium-blob) (,mysql-field-binary?))
1899                  (,chrbuf2obj-string->blob))
1900        (((,mysql-field-type=? ,mysql-type-long-blob) (,mysql-field-binary?))
1901                  (,chrbuf2obj-string->blob))
1902        (((,mysql-field-type=? ,mysql-type-blob) (,mysql-field-binary?))
1903                  (,chrbuf2obj-string->blob))
1904
1905        (((,mysql-field-type=? ,mysql-type-varchar) (,mysql-field-binary?))
1906                  (,chrbuf2obj-string->blob))
1907    (((,mysql-field-type=? ,mysql-type-var-string) (,mysql-field-binary?))
1908                  (,chrbuf2obj-string->blob))
1909        (((,mysql-field-type=? ,mysql-type-string) (,mysql-field-binary?))
1910                  (,chrbuf2obj-string->blob))
1911
1912        (((,mysql-field-type=? ,mysql-type-tiny-blob))
1913                        (,chrbuf2obj-identity))
1914        (((,mysql-field-type=? ,mysql-type-medium-blob))
1915                        (,chrbuf2obj-identity))
1916        (((,mysql-field-type=? ,mysql-type-long-blob))
1917                        (,chrbuf2obj-identity))
1918        (((,mysql-field-type=? ,mysql-type-blob))
1919                        (,chrbuf2obj-identity))
1920
1921        (((,mysql-field-type=? ,mysql-type-varchar))
1922                        (,chrbuf2obj-identity))
1923        (((,mysql-field-type=? ,mysql-type-var-string))
1924                        (,chrbuf2obj-identity))
1925        (((,mysql-field-type=? ,mysql-type-string))
1926                        (,chrbuf2obj-identity))
1927  ) )
1928
1929(define (call-with-template obj def)
1930  (apply (car def) obj (cdr def)) )
1931
1932(define (test-with-templates obj defs)
1933  (every (cut call-with-template obj <>) defs) )
1934
1935; returns field object value for the string form.
1936(define (mysql-field-string-form->object fldptr str)
1937  (let ([def (find (lambda (def) (test-with-templates fldptr (first def)))
1938                   *character-buffer->object*)])
1939    (if def
1940        (call-with-template fldptr (append (second def) `(,str)))
1941        (signal-mysql-condition 'mysql-field-string-form->object
1942                                "unknown field type") ) ) )
1943
1944; returns list of field object value for the specified row.
1945(define (mysql-row-string-form->object rowprc . field-ids)
1946  (map (lambda (fld-id)
1947         (let ([fldptr (mysql-fetch-field-specific conn fld-id)])
1948           (if fldptr
1949               (mysql-field-string-form->object fldptr (rowprc fld-id))
1950               (signal-mysql-condition 'mysql-row-string-form->object
1951                                       "no such field") ) ) )
1952       field-ids) )
1953|#
Note: See TracBrowser for help on using the repository browser.