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

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

1.3 release. Moved aux C code into .scm file. Added mysql-options conn arg helper.

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