Changeset 7969 in project


Ignore:
Timestamp:
01/28/08 03:06:22 (12 years ago)
Author:
Kon Lovett
Message:

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

Location:
release/3/mysql
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/mysql/tags/1.31/mysql.scm

    r7948 r7969  
    119119  (bound-to-procedure
    120120    mysql-error
    121     mysql-field-type-binary? )
     121    mysql-errno
     122    #;%mysql-stmt-close )
    122123  (export
    123124    ;; direct api
     
    395396        mysql-type-short
    396397        mysql-type-long
     398        mysql-type-int24
    397399        mysql-type-float
    398400        mysql-type-double
     
    537539  MYSQL_SET_CLIENT_IP
    538540  MYSQL_SECURE_AUTH
    539   MYSQL_REPORT_DATA_TRUNCATION)
     541  MYSQL_REPORT_DATA_TRUNCATION )
    540542
    541543(define-foreign-enum (mysql-type (enum "enum_field_types"))
     
    545547  MYSQL_TYPE_SHORT
    546548  MYSQL_TYPE_LONG
     549  MYSQL_TYPE_INT24
    547550  MYSQL_TYPE_FLOAT
    548551  MYSQL_TYPE_DOUBLE
     
    573576  MYSQL_TYPE_SHORT
    574577  MYSQL_TYPE_LONG
     578  MYSQL_TYPE_INT24
    575579  MYSQL_TYPE_FLOAT
    576580  MYSQL_TYPE_DOUBLE
     
    594598  MYSQL_TYPE_VAR_STRING
    595599  MYSQL_TYPE_STRING
    596   MYSQL_TYPE_GEOMETRY)
     600  MYSQL_TYPE_GEOMETRY )
    597601
    598602(define-foreign-enum (mysql-field-flags unsigned-int)
     
    629633  SET_FLAG
    630634  BLOB_FLAG
    631   TIMESTAMP_FLAG)
     635  TIMESTAMP_FLAG )
    632636
    633637(define-foreign-enum (mysql-client-flags unsigned-int)
     
    693697  CLIENT_NO_SCHEMA
    694698  CLIENT_ODBC
    695   CLIENT_SSL)
     699  CLIENT_SSL )
    696700
    697701;-----------------------------------------------------------------------
     
    741745(define-constant UNSIGNED-LONG-SIZE 4)
    742746
    743 
    744747;-----------------------------------------------------------------------
    745748; Foreign function definitions for the MySQL C API using the
     
    753756#>
    754757static double
    755 C_mysql_affected_rows (MYSQL *mysql)
     758mysqlaux_mysql_affected_rows (MYSQL *mysql)
    756759{
    757760  return ((double) mysql_affected_rows (mysql));
     
    759762
    760763static double
    761 C_mysql_insert_id (MYSQL *mysql)
     764mysqlaux_mysql_insert_id (MYSQL *mysql)
    762765{
    763766  return ((double) mysql_insert_id (mysql));
     
    765768
    766769static double
    767 C_mysql_num_rows (MYSQL_RES *result)
     770mysqlaux_mysql_num_rows (MYSQL_RES *result)
    768771{
    769772  return ((double) mysql_num_rows (result));
     
    771774
    772775static void
    773 C_mysql_data_seek (MYSQL_RES *result, double offset)
     776mysqlaux_mysql_data_seek (MYSQL_RES *result, double offset)
    774777{
    775778  mysql_data_seek (result, (my_ulonglong) offset);
     
    780783; my_ulonglong mysql_affected_rows(MYSQL *mysql)
    781784(define foreign-mysql-affected-rows
    782   (foreign-lambda my-ulonglong "C_mysql_affected_rows" mysql-ptr))
     785  (foreign-lambda my-ulonglong "mysqlaux_mysql_affected_rows" mysql-ptr))
    783786
    784787; 24.2.3.34. mysql_insert_id()
    785788; my_ulonglong mysql_insert_id(MYSQL *mysql)
    786789(define foreign-mysql-insert-id
    787   (foreign-lambda my-ulonglong "C_mysql_insert_id" mysql-ptr))
     790  (foreign-lambda my-ulonglong "mysqlaux_mysql_insert_id" mysql-ptr))
    788791
    789792; 24.2.3.43. mysql_num_rows()
    790793; my_ulonglong mysql_num_rows(MYSQL_RES *result)
    791794(define foreign-mysql-num-rows
    792   (foreign-lambda my-ulonglong "C_mysql_num_rows" mysql-res-ptr))
     795  (foreign-lambda my-ulonglong "mysqlaux_mysql_num_rows" mysql-res-ptr))
    793796
    794797; 24.2.3.7. mysql_data_seek()
    795798; void mysql_data_seek(MYSQL_RES *result, my_ulonglong offset)
    796799(define foreign-mysql-data-seek
    797   (foreign-lambda void "C_mysql_data_seek" mysql-res-ptr my-ulonglong))
     800  (foreign-lambda void "mysqlaux_mysql_data_seek" mysql-res-ptr my-ulonglong))
    798801
    799802;-----------------------------------------------------------------------
     
    803806#>
    804807static int
    805 C_mysql_options_none (MYSQL *mysql, enum mysql_option option)
     808mysqlaux_mysql_options_none (MYSQL *mysql, enum mysql_option opt)
    806809{
    807   return (mysql_options (mysql, option, NULL));
     810  return (mysql_options (mysql, opt, NULL));
    808811}
    809812
    810813static int
    811 C_mysql_options_string (MYSQL *mysql, enum mysql_option option, char *value)
     814mysqlaux_mysql_options_string (MYSQL *mysql, enum mysql_option opt, char *value)
    812815{
    813   return (mysql_options (mysql, option, value));
     816  return (mysql_options (mysql, opt, value));
    814817}
    815818
    816819static int
    817 C_mysql_options_ulong (MYSQL *mysql, enum mysql_option option, unsigned long value)
     820mysqlaux_mysql_options_ulong (MYSQL *mysql, enum mysql_option opt, unsigned long value)
    818821{
    819   return (mysql_options (mysql, option, &value));
     822  return (mysql_options (mysql, opt, &value));
    820823}
    821824<#
    822825
    823 (define (%mysql-options mysqlptr option value)
    824   (cond
    825     [(null? value)
    826       ((foreign-lambda int "C_mysql_options_none" mysql-ptr mysql-option)
    827        mysqlptr option)]
    828     [(string? value)
    829       ((foreign-lambda int "C_mysql_options_string" mysql-ptr mysql-option c-string)
    830         mysqlptr option value)]
    831     [(number? value)
    832       ((foreign-lambda int "C_mysql_options_ulong" mysql-ptr mysql-option unsigned-long)
    833         mysqlptr option value)]) )
     826(define foreign-mysqlaux-options-none
     827  (foreign-lambda int "mysqlaux_mysql_options_none" mysql-ptr mysql-option) )
     828
     829(define foreign-mysqlaux-options-string
     830  (foreign-lambda int "mysqlaux_mysql_options_string" mysql-ptr mysql-option c-string) )
     831
     832(define foreign-mysqlaux-options-ulong
     833  (foreign-lambda int "mysqlaux_mysql_options_ulong" mysql-ptr mysql-option unsigned-long) )
    834834
    835835;-----------------------------------------------------------------------
     
    853853}
    854854
    855 static char *
    856 mysqlaux_fetch_column_data_direct (MYSQL_RES *result, MYSQL_ROW row, unsigned int fldidx, int *binflg)
     855static int
     856mysqlaux_is_binary_field (MYSQL_RES *result, unsigned int fldidx)
    857857{
    858858  MYSQL_FIELD *fields = mysql_fetch_fields (result);
     
    866866    case MYSQL_TYPE_VAR_STRING:
    867867    case MYSQL_TYPE_STRING:
    868       *binflg = 1;
    869       break;
     868      return (63 == fields[fldidx].charsetnr);
    870869    default:
    871       *binflg = 0;
    872       break;
     870     break;
    873871  }
    874   *binflg &= (63 == fields[fldidx].charsetnr);
    875 
    876   return (((MYSQL_ROW)row)[fldidx]);
     872
     873  return (0);
     874}
     875
     876static char *
     877mysqlaux_fetch_column_data_direct (MYSQL_ROW row, unsigned int fldidx)
     878{
     879  return (row[fldidx]);
    877880}
    878881<#
    879882
    880883(define foreign-mysqlaux-field-index
    881   (foreign-lambda int "mysqlaux_field_index" mysql-res-ptr nonnull-c-string unsigned-integer) )
     884  (foreign-lambda int "mysqlaux_field_index" mysql-res-ptr
     885                                             nonnull-c-string unsigned-integer))
     886
     887(define foreign-mysqlaux-is-binary-field
     888  (foreign-lambda bool "mysqlaux_is_binary_field"
     889                        mysql-res-ptr unsigned-integer))
     890
     891(define foreign-mysqlaux-fetch-column-string-direct
     892  (foreign-lambda c-string "mysqlaux_fetch_column_data_direct"
     893                            mysql-row unsigned-integer))
    882894
    883895(define foreign-mysqlaux-fetch-column-data-direct
    884896  (foreign-lambda c-pointer "mysqlaux_fetch_column_data_direct"
    885                             mysql-res-ptr mysql-row
    886                             unsigned-integer
    887                             (nonnull-c-pointer int)) )
     897                             mysql-row unsigned-integer))
    888898
    889899;-----------------------------------------------------------------------
     
    12291239      "") )
    12301240
    1231 (define (foreign-unsigned-long-pointer->u32vector ulptr cnt)
     1241(define (unsigned-long-array->u32vector ulptr cnt)
    12321242  (let* ([siz (* cnt UNSIGNED-LONG-SIZE)]
    12331243         [store (make-blob siz)])
     
    12351245    (blob->u32vector/shared store) ) )
    12361246
     1247#; ; UNUSED
    12371248(define char-pointer->string
    12381249  (foreign-lambda* c-string ((c-pointer chrptr))
     
    12491260                    (foreign-mysqlaux-field-index resptr
    12501261                                                  (->string field) fldcnt))])
    1251     (and (<= 0 fldidx) (< fldidx fldcnt) 
     1262    (and (<= 0 fldidx) (< fldidx fldcnt)
    12521263         fldidx ) ) )
     1264
     1265(define (%mysql-options mysqlptr opt val)
     1266  (cond [(null? val)
     1267          (foreign-mysqlaux-options-none mysqlptr opt)]
     1268        [(string? val)
     1269          (foreign-mysqlaux-options-string mysqlptr opt val)]
     1270        [(number? val)
     1271          (foreign-mysqlaux-options-ulong mysqlptr opt val)]
     1272        [else
     1273          1 ] ) )
    12531274
    12541275;-----------------------------------------------------------------------
     
    12711292
    12721293(define (signal-mysql-error loc conn . args)
    1273   (apply signal-mysql-condition loc (mysql-error conn) args) )
     1294  (let ([msg (or (mysql-error conn)
     1295                 (mysql-errno conn))])
     1296    (apply signal-mysql-condition loc msg args) ) )
    12741297
    12751298;-----------------------------------------------------------------------
     
    13541377(define-record-type mysql-connection
    13551378  (make-mysql-connection host user passwd db port unix-socket
    1356                          client-flag ptr result result-start
    1357                          ssl opts)
     1379                         client-flag ptr result result-start ssl opts
     1380                         #;stmt #;bind)
    13581381  mysql-connection?
    13591382  (host mysql-connection-host)
     
    13681391  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
    13691392  (ssl mysql-connection-ssl)
    1370   (opts mysql-connection-options) )
     1393  (opts mysql-connection-options)
     1394  #;(stmt mysql-connection-statement mysql-connection-statement-set!)
     1395  #;(bind mysql-connection-binding mysql-connection-binding-set!) )
    13711396
    13721397(define-record-printer (mysql-connection conn out)
    1373   (let [(host (mysql-connection-host conn))
    1374         (user (mysql-connection-user conn))
    1375         (passwd (mysql-connection-passwd conn))
    1376         (db (mysql-connection-db conn))
    1377         (tcp-port (mysql-connection-port conn))
    1378         (unix-socket (mysql-connection-unix-socket conn))
    1379         (client-flag (mysql-connection-client-flag conn))
    1380         (ssl (mysql-connection-ssl conn))
    1381         (opts (mysql-connection-options conn))]
     1398  (let ([host (mysql-connection-host conn)]
     1399        [user (mysql-connection-user conn)]
     1400        [passwd (mysql-connection-passwd conn)]
     1401        [db (mysql-connection-db conn)]
     1402        [tcp-port (mysql-connection-port conn)]
     1403        [unix-socket (mysql-connection-unix-socket conn)]
     1404        [client-flag (mysql-connection-client-flag conn)]
     1405        [ssl (mysql-connection-ssl conn)]
     1406        [opts (mysql-connection-options conn)]
     1407        #;[stmt (mysql-connection-statement conn)]
     1408        #;[bind (mysql-connection-binding conn)])
    13821409    (display
    13831410     (string-append
     
    13931420            (record-slot->string client-flag  "client-flag" (not (zero? client-flag)))
    13941421            (record-slot->string ssl          "ssl")
    1395             (record-slot->string opts         "options") )
     1422            (record-slot->string opts         "options")
     1423            #;(record-slot->string stmt         "statement")
     1424            #;(record-slot->string bind         "binding") )
    13961425          " INVALID")
    13971426      ">")
     
    14061435
    14071436(define (mysql-affected-rows conn)
    1408   (foreign-mysql-affected-rows (mysql-connection-ptr conn)) )
     1437  (let ([cnt (foreign-mysql-affected-rows (mysql-connection-ptr conn))])
     1438    (and (not (= -1 cnt))
     1439         cnt ) ) )
    14091440
    14101441(define (mysql-change-user conn #!key (user #f) (passwd #f) (db #f))
     
    14191450; upon termination.
    14201451(define (mysql-close conn)
     1452  #;(%mysql-stmt-close conn)
    14211453  (mysql-free-result conn)
    14221454  (foreign-mysql-close (mysql-connection-ptr conn))
     
    14431475                   [val (cdr optitm)])
    14441476               (unless (zero? (%mysql-options mysql opt val))
    1445                  (signal-mysql-condition 'mysql-connect "unknown option code" opt val))))
     1477                 (signal-mysql-condition 'mysql-connect "unknown option" opt val))))
    14461478           options) )
    1447         (let ([mysqlptr (foreign-mysql-real-connect mysql host user passwd db
     1479        (let ([mysqlptr (foreign-mysql-real-connect mysql
     1480                                                    host user passwd
     1481                                                    db
    14481482                                                    port unix-socket
    14491483                                                    client-flag)])
    14501484          (if mysqlptr
    14511485              (make-mysql-connection host user passwd db port unix-socket
    1452                                      client-flag mysqlptr #f #f options ssl)
     1486                                     client-flag mysqlptr #f #f options ssl
     1487                                     #;#f #;#f)
    14531488              (signal-mysql-condition 'mysql-connect
    14541489               (foreign-mysql-error mysql)
     
    14691504; has occurred.
    14701505(define (mysql-error conn)
    1471   (let [(errstr (foreign-mysql-error (mysql-connection-ptr conn)))]
     1506  (let ([errstr (foreign-mysql-error (mysql-connection-ptr conn))])
    14721507    (and (not (string=? "" errstr))
    14731508         errstr) ) )
     
    15051540(define (%mysql-fetch-lengths resptr cnt)
    15061541  (and-let* ([ulptr (foreign-mysql-fetch-lengths resptr)])
    1507     (foreign-unsigned-long-pointer->u32vector ulptr cnt) ) )
     1542    (unsigned-long-array->u32vector ulptr cnt) ) )
    15081543
    15091544; returns a u32vector of length num-fields.
     
    15221557  (and-let* ([resptr (mysql-connection-result conn)]
    15231558             [row (foreign-mysql-fetch-row resptr)])
    1524     (let* ([connptr (mysql-connection-ptr conn)]
    1525            [fldcnt (foreign-mysql-num-fields resptr)]
    1526            [fldlens (%mysql-fetch-lengths resptr fldcnt)])
     1559    (let ([fldcnt (foreign-mysql-num-fields resptr)]
     1560          [fldlens #f])
    15271561      (lambda (field)
    15281562        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
    1529           (let-location ([binary-flag bool])
    1530             (and-let* ([datptr (foreign-mysqlaux-fetch-column-data-direct resptr row fldidx #$binary-flag)])
    1531               (if binary-flag
    1532                   (binary-char-pointer->string datptr (u32vector-ref fldlens fldidx))
    1533                   (char-pointer->string datptr) ) ) ) ) ) ) ) )
     1563          (if (foreign-mysqlaux-is-binary-field resptr fldidx)
     1564              (binary-char-pointer->string
     1565               (foreign-mysqlaux-fetch-column-data-direct row fldidx)
     1566               (u32vector-ref
     1567                (or fldlens
     1568                    (begin
     1569                      (set! fldlens (%mysql-fetch-lengths resptr fldcnt))
     1570                      fldlens ) )
     1571                fldidx))
     1572              (foreign-mysqlaux-fetch-column-string-direct row fldidx) ) ) ) ) ) )
    15341573
    15351574(define (mysql-field-count conn)
    1536   (foreign-mysql-field-count (mysql-connection-ptr conn)))
     1575  (foreign-mysql-field-count (mysql-connection-ptr conn)) )
    15371576
    15381577(define (mysql-free-result conn)
    1539   (and-let* [(res (mysql-connection-result conn))]
     1578  (and-let* ([res (mysql-connection-result conn)])
    15401579    (foreign-mysql-free-result res) )
    15411580  (mysql-connection-result-set! conn #f)
     
    16091648; returns #t if the query was successful, signals exception otherwise.
    16101649(define (mysql-query conn query)
    1611   (let [(mysql-ptr (mysql-connection-ptr conn))]
     1650  (let ([mysql-ptr (mysql-connection-ptr conn)])
    16121651    ; zero indicates success
    16131652    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
     
    16471686; current result set.
    16481687(define (mysql-rewind conn)
    1649   (and-let* ([res-st (mysql-connection-result-start conn)])
    1650     (foreign-mysql-row-seek (mysql-connection-result conn) res-st) ) )
     1688  (and-let* ([resptr (mysql-connection-result-start conn)])
     1689    (foreign-mysql-row-seek (mysql-connection-result conn) resptr) ) )
    16511690
    16521691;-----------------------------------------------------------------------
     
    16591698; calls proc on every row in the current result set. proc should take 3
    16601699; arguments: the row (as described for mysql-fetch-row), the row index
    1661 ; (which starts with 1 and ends with (mysql-num-rows conn), and the
     1700; (which starts with 1 and ends with (mysql-num-rows conn)), and the
    16621701; current accumulated value.
    16631702;
     
    16791718; calls proc on every row in the current result set. proc should take 2
    16801719; arguments: the row (as described for mysql-fetch-row) and the row index
    1681 ; (which starts with 1 and ends with (mysql-num-rows conn).
     1720; (which starts with 1 and ends with (mysql-num-rows conn)).
    16821721;
    16831722; note: rewinds the result set before and after iterating over it; thus,
     
    16931732; calls proc on every row in the current result set. proc should take 2
    16941733; arguments: the row (as described for mysql-fetch-row) and the row index
    1695 ; (which starts with 1 and ends with (mysql-num-rows conn).
     1734; (which starts with 1 and ends with (mysql-num-rows conn)).
    16961735;
    16971736; returns a list of the results of each proc invocation.
     
    18531892             [fldidx (%mysql-get-field-index resptr field (foreign-mysql-num-fields resptr))])
    18541893    (foreign-mysql-fetch-field-direct resptr fldidx) ) )
     1894
     1895#|
     1896;=======================================================================
     1897; The MYSQL_TIME API.
     1898;
     1899
     1900(declare
     1901  (export
     1902    ;; enum enum_mysql_timestamp_type
     1903    mysql-timestamp-date
     1904    mysql-timestamp-datetime
     1905    mysql-timestamp-error
     1906    mysql-timestamp-none
     1907    mysql-timestamp-time
     1908    ;
     1909    mysql-timestamp-type-symbol
     1910    mysql-timestamp-type-value
     1911    ;; MYSQL_TIME
     1912    mysql-time-day-set!
     1913    mysql-time-hour-set!
     1914    mysql-time-minute-set!
     1915    mysql-time-month-set!
     1916    mysql-time-neg-set!
     1917    mysql-time-second-part-set!
     1918    mysql-time-second-set!
     1919    mysql-time-time-type-set!
     1920    mysql-time-year-set!
     1921    ;
     1922    mysql-time-day
     1923    mysql-time-hour
     1924    mysql-time-minute
     1925    mysql-time-month
     1926    mysql-time-neg
     1927    mysql-time-second
     1928    mysql-time-second-part
     1929    mysql-time-time-type
     1930    mysql-time-year
     1931    ;
     1932    make-mysql-time
     1933    allocate-myysql-time
     1934    free-mysql-time ) )
     1935
     1936;;
     1937
     1938(define-foreign-type mysql-time-ptr (c-pointer "MYSQL_TIME"))
     1939
     1940;;
     1941
     1942(define-foreign-enum (mysql-timestamp-type (enum "enum_mysql_timestamp_type"))
     1943  #f  ; No aliases!
     1944  MYSQL_TIMESTAMP_NONE
     1945  MYSQL_TIMESTAMP_ERROR
     1946  MYSQL_TIMESTAMP_DATE
     1947  MYSQL_TIMESTAMP_DATETIME
     1948  MYSQL_TIMESTAMP_TIME )
     1949
     1950(gen-public-enum mysql-timestamp-type
     1951  MYSQL_TIMESTAMP_NONE
     1952  MYSQL_TIMESTAMP_ERROR
     1953  MYSQL_TIMESTAMP_DATE
     1954  MYSQL_TIMESTAMP_DATETIME
     1955  MYSQL_TIMESTAMP_TIME )
     1956;;
     1957
     1958(define-foreign-record (mysql-time "MYSQL_TIME")
     1959  (rename: c-name->scheme-name)
     1960  (constructor: allocate-myysql-time)
     1961  (destructor: free-mysql-time)
     1962  (unsigned-int year)
     1963  (unsigned-int month)
     1964  (unsigned-int day)
     1965  (unsigned-int hour)
     1966  (unsigned-int minute)
     1967  (unsigned-int second)
     1968  (unsigned-long second_part)
     1969  (my-bool neg)
     1970  (mysql-timestamp-type time_type) )
     1971
     1972(define (make-mysql-time type #!key (year 0) (month 0) (day 0)
     1973                                    (hour 0) (minute 0) (second 0)
     1974                                    (second-part 0)
     1975                                    is-negative)
     1976  (let ([timptr (allocate-myysql-time)])
     1977    (mysql-time-time-type-set! timptr type)
     1978    (mysql-time-year-set! timptr year)
     1979    (mysql-time-month-set! timptr month)
     1980    (mysql-time-day-set! timptr day)
     1981    (mysql-time-hour-set! timptr hour)
     1982    (mysql-time-minute-set! timptr minute)
     1983    (mysql-time-second-set! timptr second)
     1984    (mysql-time-second-part-set! timptr second-part)
     1985    (mysql-time-neg-set! timptr is-negative)
     1986    (set-finalizer! timptr free-mysql-time)
     1987    timptr ) )
     1988
     1989;=======================================================================
     1990; The MySQL prepared statement API.
     1991;
     1992
     1993(declare
     1994  (bound-to-procedure
     1995    mysql-stmt-errno
     1996    mysql-stmt-error
     1997    mysql-stmt-sqlstate )
     1998  (export
     1999    ;;
     2000    stmt-attr-cursor-type
     2001    stmt-attr-prefetch-rows
     2002    stmt-attr-update-max-length
     2003    ;
     2004    mysql-stmt-attr-type-symbol
     2005    mysql-stmt-attr-type-value
     2006    ;;
     2007    mysql-stmt-init-done
     2008    mysql-stmt-execute-done
     2009    mysql-stmt-prepare-done
     2010    mysql-stmt-fetch-done
     2011    ;
     2012    mysql-stmt-state-symbol
     2013    mysql-stmt-state-value
     2014    ;;
     2015    mysql-no-data
     2016    mysql-data-truncated
     2017    ;
     2018    mysql-status-return-code-symbol
     2019    mysql-status-return-code-value
     2020    ;;
     2021    foreign-mysql-stmt-affected-rows
     2022    foreign-mysql-stmt-attr-get
     2023    foreign-mysql-stmt-attr-set
     2024    foreign-mysql-stmt-bind-param
     2025    foreign-mysql-stmt-bind-result
     2026    foreign-mysql-stmt-close
     2027    foreign-mysql-stmt-data-seek
     2028    foreign-mysql-stmt-errno
     2029    foreign-mysql-stmt-error
     2030    foreign-mysql-stmt-execute
     2031    foreign-mysql-stmt-fetch
     2032    foreign-mysql-stmt-fetch-column
     2033    foreign-mysql-stmt-field-count
     2034    foreign-mysql-stmt-free-result
     2035    foreign-mysql-stmt-init
     2036    foreign-mysql-stmt-insert-id
     2037    foreign-mysql-stmt-num-rows
     2038    foreign-mysql-stmt-param-count
     2039    foreign-mysql-stmt-param-metadata
     2040    foreign-mysql-stmt-prepare
     2041    foreign-mysql-stmt-reset
     2042    foreign-mysql-stmt-result-metadata
     2043    foreign-mysql-stmt-row-seek
     2044    foreign-mysql-stmt-row-tell
     2045    foreign-mysql-stmt-send-long-data
     2046    foreign-mysql-stmt-sqlstate
     2047    foreign-mysql-stmt-store-result
     2048    ;; basic
     2049                mysql-stmt-errno
     2050                mysql-stmt-error
     2051                mysql-stmt-sqlstate
     2052                mysql-stmt-init ; custom
     2053                #;mysql-stmt-close ; called by custom mysql-stmt-init
     2054                mysql-stmt-prepare
     2055                mysql-stmt-param-count
     2056                mysql-stmt-bind-param
     2057                mysql-stmt-execute
     2058                mysql-stmt-affected-rows
     2059                mysql-stmt-bind-result
     2060                mysql-stmt-fetch
     2061                mysql-stmt-store-result
     2062                mysql-stmt-result-metadata
     2063                mysql-stmt-attr-set
     2064                mysql-stmt-attr-get
     2065    ;; extended
     2066                mysql-stmt-rewind
     2067                mysql-stmt-row-fetch
     2068                mysql-stmt-query
     2069    ;; mapping
     2070                mysql-stmt-row-fold
     2071                mysql-stmt-row-for-each
     2072                mysql-stmt-row-map
     2073                mysql-stmt-query-fold
     2074                mysql-stmt-query-for-each
     2075                mysql-stmt-query-map
     2076    ;; MYSQL_BIND
     2077    allocate-mysql-bind
     2078    free-mysql-bind
     2079    mysql-bind-ref
     2080    mysql-bind-clear!
     2081    mysql-bind-param-init
     2082    mysql-bind-result-init
     2083    ;
     2084    mysql-bind-buffer-set!
     2085    mysql-bind-buffer-length-set!
     2086    mysql-bind-buffer-type-set!
     2087    mysql-bind-error-set!
     2088    mysql-bind-error-value-set!
     2089    mysql-bind-is-null-set!
     2090    mysql-bind-is-null-value-set!
     2091    mysql-bind-is-unsigned-set!
     2092    mysql-bind-length-set!
     2093    ;
     2094    mysql-bind-buffer
     2095    mysql-bind-buffer-length
     2096    mysql-bind-buffer-type
     2097    mysql-bind-error
     2098    mysql-bind-error-value
     2099    mysql-bind-is-null
     2100    mysql-bind-is-null-value
     2101    mysql-bind-is-unsigned
     2102    mysql-bind-length ) )
     2103
     2104;;
     2105
     2106(define-foreign-type mysql-row-offset mysql-rows-ptr)
     2107
     2108(define-foreign-type mysql-bind-ptr (c-pointer "MYSQL_BIND"))
     2109
     2110(define-foreign-type mysql-stmt-ptr (c-pointer "MYSQL_STMT"))
     2111
     2112;;
     2113
     2114(define-foreign-enum (mysql-stmt-state (enum "enum_mysql_stmt_state"))
     2115  #f  ; No aliases!
     2116  MYSQL_STMT_INIT_DONE
     2117  MYSQL_STMT_PREPARE_DONE
     2118  MYSQL_STMT_EXECUTE_DONE
     2119  MYSQL_STMT_FETCH_DONE )
     2120
     2121(gen-public-enum mysql-stmt-state
     2122  MYSQL_STMT_INIT_DONE
     2123  MYSQL_STMT_PREPARE_DONE
     2124  MYSQL_STMT_EXECUTE_DONE
     2125  MYSQL_STMT_FETCH_DONE )
     2126
     2127(define-foreign-enum (mysql-stmt-attr-type (enum "enum_stmt_attr_type"))
     2128  #f  ; No aliases!
     2129  STMT_ATTR_UPDATE_MAX_LENGTH
     2130  STMT_ATTR_CURSOR_TYPE
     2131  STMT_ATTR_PREFETCH_ROWS )
     2132
     2133(gen-public-enum mysql-stmt-attr-type
     2134  STMT_ATTR_UPDATE_MAX_LENGTH
     2135  STMT_ATTR_CURSOR_TYPE
     2136  STMT_ATTR_PREFETCH_ROWS )
     2137
     2138(define-foreign-enum (mysql-status-return-code unsigned-int)
     2139  #f  ; No aliases!
     2140  MYSQL_NO_DATA
     2141  MYSQL_DATA_TRUNCATED )
     2142
     2143(gen-public-enum mysql-status-return-code
     2144  MYSQL_NO_DATA
     2145  MYSQL_DATA_TRUNCATED )
     2146
     2147;;
     2148
     2149;MYSQL_STMT *mysql_stmt_init(MYSQL *mysql)
     2150(define foreign-mysql-stmt-init
     2151  (foreign-lambda mysql-stmt-ptr "mysql_stmt_init" mysql-ptr))
     2152
     2153;my_bool mysql_stmt_close(MYSQL_STMT *mysql)
     2154(define foreign-mysql-stmt-close
     2155        (foreign-lambda my-bool "mysql_stmt_close" mysql-stmt-ptr))
     2156
     2157;my_bool mysql_stmt_bind_param(MYSQL_STMT *stmt, MYSQL_BIND *bind)
     2158(define foreign-mysql-stmt-bind-param
     2159        (foreign-lambda my-bool "mysql_stmt_bind_param" mysql-stmt-ptr mysql-bind-ptr))
     2160
     2161;my_bool mysql_stmt_bind_result(MYSQL_STMT *stmt, MYSQL_BIND *bind)
     2162(define foreign-mysql-stmt-bind-result
     2163        (foreign-lambda my-bool "mysql_stmt_bind_result" mysql-stmt-ptr mysql-bind-ptr))
     2164
     2165;int mysql_stmt_execute(MYSQL_STMT *stmt)
     2166(define foreign-mysql-stmt-execute
     2167        (foreign-lambda int "mysql_stmt_execute" mysql-stmt-ptr))
     2168
     2169;int mysql_stmt_fetch(MYSQL_STMT *stmt)
     2170(define foreign-mysql-stmt-fetch
     2171        (foreign-lambda int "mysql_stmt_fetch" mysql-stmt-ptr))
     2172
     2173;int mysql_stmt_prepare(MYSQL_STMT *stmt, const char *query, unsigned long length)
     2174(define foreign-mysql-stmt-prepare
     2175        (foreign-lambda int "mysql_stmt_prepare" mysql-stmt-ptr c-string unsigned-long))
     2176
     2177;int mysql_stmt_fetch_column(MYSQL_STMT *stmt, MYSQL_BIND *bind_arg, unsigned int column, unsigned long offset)
     2178(define foreign-mysql-stmt-fetch-column
     2179        (foreign-lambda int "mysql_stmt_fetch_column" mysql-stmt-ptr mysql-bind-ptr unsigned-int unsigned-long))
     2180
     2181;int mysql_stmt_store_result(MYSQL_STMT *stmt)
     2182(define foreign-mysql-stmt-store-result
     2183        (foreign-lambda int "mysql_stmt_store_result" mysql-stmt-ptr))
     2184
     2185;unsigned long mysql_stmt_param_count(MYSQL_STMT * stmt)
     2186(define foreign-mysql-stmt-param-count
     2187        (foreign-lambda unsigned-long "mysql_stmt_param_count" mysql-stmt-ptr))
     2188
     2189;my_bool mysql_stmt_attr_set(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, const void *attr)
     2190(define foreign-mysql-stmt-attr-set
     2191        (foreign-lambda my-bool "mysql_stmt_attr_set" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
     2192
     2193;my_bool mysql_stmt_attr_get(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, void *attr)
     2194(define foreign-mysql-stmt-attr-get
     2195        (foreign-lambda my-bool "mysql_stmt_attr_get" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
     2196
     2197#>
     2198static my_bool
     2199mysqlaux_stmt_attr_set_bool (MYSQL_STMT *stmt, enum enum_stmt_attr_type attr, my_bool value)
     2200{
     2201  return (mysql_stmt_attr_set (stmt, attr, &value));
     2202}
     2203
     2204static my_bool
     2205mysqlaux_stmt_attr_set_ulong (MYSQL_STMT *stmt, enum enum_stmt_attr_type attr, unsigned long value)
     2206{
     2207  return (mysql_stmt_attr_set (stmt, attr, &value));
     2208}
     2209<#
     2210
     2211(define foreign-mysqlaux-stmt-attr-set-bool
     2212  (foreign-lambda int "mysqlaux_stmt_attr_set_bool"
     2213                      mysql-stmt-ptr mysql-stmt-attr-type my-bool) )
     2214
     2215(define foreign-mysqlaux-stmt-attr-set-ulong
     2216  (foreign-lambda int "mysqlaux_stmt_attr_set_ulong"
     2217                      mysql-stmt-ptr mysql-stmt-attr-type unsigned-long) )
     2218
     2219;my_bool mysql_stmt_reset(MYSQL_STMT * stmt)
     2220(define foreign-mysql-stmt-reset
     2221        (foreign-lambda my-bool "mysql_stmt_reset" mysql-stmt-ptr))
     2222
     2223;my_bool mysql_stmt_free_result(MYSQL_STMT *stmt)
     2224(define foreign-mysql-stmt-free-result
     2225        (foreign-lambda my-bool "mysql_stmt_free_result" mysql-stmt-ptr))
     2226
     2227;my_bool mysql_stmt_send_long_data(MYSQL_STMT *stmt, unsigned-int param_number, const char *data, unsigned long length)
     2228(define foreign-mysql-stmt-send-long-data
     2229        (foreign-lambda my-bool "mysql_stmt_send_long_data" mysql-stmt-ptr unsigned-int c-pointer unsigned-long))
     2230
     2231;MYSQL_RES *mysql_stmt_result_metadata(MYSQL_STMT *stmt)
     2232(define foreign-mysql-stmt-result-metadata
     2233        (foreign-lambda mysql-res-ptr "mysql_stmt_result_metadata" mysql-stmt-ptr))
     2234
     2235;MYSQL_RES *mysql_stmt_param_metadata(MYSQL_STMT *stmt)
     2236(define foreign-mysql-stmt-param-metadata
     2237        (foreign-lambda mysql-res-ptr "mysql_stmt_param_metadata" mysql-stmt-ptr))
     2238
     2239;unsigned int mysql_stmt_errno(MYSQL_STMT * stmt)
     2240(define foreign-mysql-stmt-errno
     2241        (foreign-lambda unsigned-int "mysql_stmt_errno" mysql-stmt-ptr))
     2242
     2243;const char *mysql_stmt_error(MYSQL_STMT * stmt)
     2244(define foreign-mysql-stmt-error
     2245        (foreign-lambda c-string "mysql_stmt_error" mysql-stmt-ptr))
     2246
     2247;const char *mysql_stmt_sqlstate(MYSQL_STMT * stmt)
     2248(define foreign-mysql-stmt-sqlstate
     2249        (foreign-lambda c-string "mysql_stmt_sqlstate" mysql-stmt-ptr))
     2250
     2251;MYSQL_ROW_OFFSET mysql_stmt_row_seek(MYSQL_STMT *stmt, MYSQL_ROW_OFFSET offset)
     2252(define foreign-mysql-stmt-row-seek
     2253        (foreign-lambda mysql-row-offset "mysql_stmt_row_seek" mysql-stmt-ptr mysql-row-offset))
     2254
     2255;MYSQL_ROW_OFFSET mysql_stmt_row_tell(MYSQL_STMT *stmt)
     2256(define foreign-mysql-stmt-row-tell
     2257        (foreign-lambda mysql-row-offset "mysql_stmt_row_tell" mysql-stmt-ptr))
     2258
     2259#>
     2260static void
     2261mysqlaux_stmt_data_seek (MYSQL_STMT *stmt, double offset)
     2262{
     2263  mysql_stmt_data_seek (stmt, (my_ulonglong) offset);
     2264}
     2265
     2266static double
     2267mysqlaux_stmt_num_rows (MYSQL_STMT *stmt)
     2268{
     2269  return ((double) mysql_stmt_num_rows (stmt));
     2270}
     2271
     2272static double
     2273mysqlaux_stmt_affected_rows (MYSQL_STMT *stmt)
     2274{
     2275  return ((double) mysql_stmt_affected_rows (stmt));
     2276}
     2277
     2278static double
     2279mysqlaux_stmt_insert_id (MYSQL_STMT *stmt)
     2280{
     2281  return ((double) mysql_stmt_insert_id (stmt));
     2282}
     2283<#
     2284
     2285;void mysql_stmt_data_seek(MYSQL_STMT *stmt, my_ulonglong offset)
     2286(define foreign-mysql-stmt-data-seek
     2287        (foreign-lambda void "mysqlaux_stmt_data_seek" mysql-stmt-ptr my-ulonglong))
     2288
     2289;my_ulonglong mysql_stmt_num_rows(MYSQL_STMT *stmt)
     2290(define foreign-mysql-stmt-num-rows
     2291        (foreign-lambda my-ulonglong "mysqlaux_stmt_num_rows" mysql-stmt-ptr))
     2292
     2293;my_ulonglong mysql_stmt_affected_rows(MYSQL_STMT *stmt)
     2294(define foreign-mysql-stmt-affected-rows
     2295        (foreign-lambda my-ulonglong "mysqlaux_stmt_affected_rows" mysql-stmt-ptr))
     2296
     2297;my_ulonglong mysql_stmt_insert_id(MYSQL_STMT *stmt)
     2298(define foreign-mysql-stmt-insert-id
     2299        (foreign-lambda my-ulonglong "mysqlaux_stmt_insert_id" mysql-stmt-ptr))
     2300
     2301;unsigned int mysql_stmt_field_count(MYSQL_STMT *stmt)
     2302(define foreign-mysql-stmt-field-count
     2303        (foreign-lambda unsigned-int "mysql_stmt_field_count" mysql-stmt-ptr))
     2304
     2305;;
     2306
     2307(define-foreign-record (mysql-bind "MYSQL_BIND")
     2308  (rename: c-name->scheme-name)
     2309  ; special ctor
     2310  (destructor: free-mysql-bind)
     2311  ((c-pointer "unsigned long") length)    ; output length pointer
     2312  ((c-pointer "my_bool") is_null)                   ; Pointer to null indicator
     2313  (c-pointer buffer)                      ; buffer to get/put data
     2314  ((c-pointer "my_bool") error)                 ; set this if you want to track data truncations happened during fetch
     2315  (unsigned-long buffer_length)           ; output buffer length, must be set when fetching str/binary
     2316  (mysql-type buffer_type)                          ; buffer type
     2317  (my-bool error_value)                         ; used if error is 0
     2318  (my-bool is_unsigned)                         ; set if integer type is unsigned
     2319  (my-bool is_null_value) )               ; Used if is_null is 0
     2320
     2321(define (allocate-mysql-bind cnt)
     2322  ((foreign-lambda* mysql-bind-ptr ((unsigned-integer cnt))
     2323   "return ((1 <= cnt) ? ((MYSQL_BIND *) calloc (cnt, sizeof(MYSQL_BIND))) : NULL);")
     2324  cnt) )
     2325
     2326(define (mysql-bind-ref bindptr idx)
     2327  ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
     2328   "return (&(ptr[idx]));")
     2329   bindptr idx) )
     2330
     2331(define (mysql-bind-clear! bindptr idx)
     2332  ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
     2333   "memset (&(ptr[idx]), 0, sizeof(MYSQL_BIND));")
     2334   bindptr idx) )
     2335
     2336(define (allocate-mysql-bind-slots bindptr len is-null error)
     2337  ((foreign-lambda* void ((mysql-bind-ptr bind) (unsigned-integer len)
     2338                          (my-bool is_null) (my-bool error))
     2339#<<END
     2340    typedef struct {
     2341      unsigned long length;
     2342      my_bool is_null;
     2343      my_bool error;
     2344      C_word buffer[1];
     2345    } bind_slots;
     2346    size_t siz = (sizeof(bind_slots) - sizeof(((bind_slots *)0)->buffer))
     2347                  + (((len / sizeof (C_word)) + (len % sizeof (C_word))) * sizeof (C_word));
     2348    bind_slots * ptr = ((bind_slots *) malloc (siz));
     2349    memset (ptr, 0, siz);
     2350    bind->buffer = (char *) &(ptr->buffer);
     2351    bind->buffer_length = len;
     2352    ptr->is_null = is_null;
     2353    bind->is_null = &(ptr->is_null);
     2354    ptr->length = len;
     2355    bind->length = &(ptr->length);
     2356    ptr->error = error;
     2357    bind->error = &(ptr->error);
     2358END
     2359   )
     2360     bindptr len is-null error) )
     2361
     2362(define (%mysql-foreign-type-length foreign-type #!optional (obj (void)))
     2363 (void) )
     2364
     2365(define (%mysql-determine-type obj is-unsigned is-null)
     2366 (void) )
     2367
     2368(define (%mysql-determine-foreign-type type is-unsigned is-null)
     2369 (void) )
     2370
     2371(define (mysql-bind-param-init-direct bindptr idx obj #!key type is-unsigned is-null error)
     2372  (mysql-bind-clear! bindptr idx)
     2373  (unless type
     2374    (let-values ([(typ uflg nflg) (%mysql-determine-type obj is-unsigned is-null)])
     2375      (set! type typ)
     2376      (set! is-unsigned uflg)
     2377      (set! is-null nflg) ) )
     2378  (when (and (mysql-null-object? obj) (not (eqv? mysql-type-null type)))
     2379    (warning "null object implies null type")
     2380    (set! type mysql-type-null) )
     2381  (mysql-bind-buffer-type-set! bindptr type)
     2382  (unless (eqv? mysql-type-null type)
     2383    (mysql-bind-is-unsigned-set! bindptr is-unsigned)
     2384    (let* ([foreign-type (%mysql-determine-foreign-type type is-unsigned is-null)]
     2385           [len (%mysql-foreign-type-length foreign-type obj)])
     2386      (allocate-mysql-bind-slots bindptr len is-null error) ) ) )
     2387
     2388(define (mysql-bind-result-init-direct bindptr idx type #!optional len)
     2389  (mysql-bind-clear! bindptr idx)
     2390  (mysql-bind-buffer-type-set! bindptr type)
     2391  (unless (eqv? mysql-type-null type)
     2392    (let* ([foreign-type (%mysql-determine-foreign-type type #f #f)]
     2393           [len (or len
     2394                    (%mysql-foreign-type-length foreign-type))])
     2395      (allocate-mysql-bind-slots bindptr len #f #f) ) ) )
     2396
     2397;;
     2398
     2399; (mysql-bind-param-init
     2400;   (list obj #:key T #:is-unsigned B #:is-null B #:error B)
     2401;   ...
     2402;   (list obj #:key T #:is-unsigned B #:is-null B #:error B))
     2403
     2404(define (mysql-bind-param-init . inits)
     2405  (let ([bindptr (allocate-mysql-bind (length inits))])
     2406    (let loop ([inits inits] [idx 0])
     2407      (if (null? inits)
     2408          bindptr
     2409          (begin
     2410            (apply mysql-bind-param-init-direct bindptr idx (car inits))
     2411            (loop (cdr inits) (+ idx 1)) ) ) ) ) )
     2412
     2413; (mysql-bind-result-init
     2414;   (list T #:len I)
     2415;   ...
     2416;   (list T #:len I))
     2417
     2418(define (mysql-bind-result-init conn . inits)
     2419  (let ([bindptr (allocate-mysql-bind (length inits))])
     2420    (let loop ([inits inits] [idx 0])
     2421      (if (null? inits)
     2422          bindptr
     2423          (begin
     2424            (apply mysql-bind-result-init-direct bindptr idx (car inits))
     2425            (loop (cdr inits) (+ idx 1)) ) ) ) ) )
     2426
     2427;;
     2428
     2429#;
     2430(define (mysql-bind-result->object bindptr)
     2431  (void) )
     2432
     2433;;
     2434
     2435(define (%mysql-stmt-attr-set stmtptr attr val)
     2436  (cond [(boolean? val)
     2437          (foreign-mysqlaux-stmt-attr-set-bool stmtptr attr val)]
     2438        [(number? val)
     2439          (foreign-mysqlaux-stmt-attr-set-ulong stmtptr attr val)]
     2440        [else
     2441          #t ] ) )
     2442
     2443(define (%mysql-stmt-attr-get stmtptr attr)
     2444  (select attr
     2445    [(stmt-attr-cursor-type stmt-attr-prefetch-rows)
     2446      (let-location ([val unsigned-long])
     2447        (foreign-mysql-stmt-attr-get stmtptr attr #$val)
     2448        val ) ]
     2449    [(stmt-attr-update-max-length)
     2450      (let-location ([val my-bool])
     2451        (foreign-mysql-stmt-attr-get stmtptr attr #$val)
     2452        val ) ]
     2453    [else
     2454      (void) ] ) )
     2455
     2456(define (%mysql-free-bind conn)
     2457  (and-let* ([bindptr (mysql-connection-binding conn)])
     2458    (free-mysql-bind bindptr)
     2459    (mysql-connection-binding-set! conn #f) ) )
     2460
     2461(define (%mysql-stmt-close conn)
     2462  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2463    (mysql-connection-statement-set! conn #f)
     2464    (%mysql-free-bind conn) ; free any result/param binding
     2465    (when (foreign-mysql-stmt-close stmtptr)
     2466      (signal-mysql-stmt-error 'mysql-stmt-close conn) ) ) )
     2467
     2468;;
     2469
     2470(define (mysql-null-object? obj)
     2471  (void) )
     2472
     2473;;
     2474
     2475(define (signal-mysql-stmt-error loc conn . args)
     2476  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2477    (let ([err (or (mysql-stmt-error stmtptr)
     2478                   (mysql-stmt-errno stmtptr))]
     2479          [sta (mysql-stmt-sqlstate conn)])
     2480      (apply signal-mysql-condition loc
     2481                                    (string-append err
     2482                                                   (if sta
     2483                                                      (string-append " - " sta)
     2484                                                      ""))
     2485                                    conn args) ) ) )
     2486
     2487;-----------------------------------------------------------------------
     2488; The statement MySQL/Scheme API.
     2489;
     2490; This API provides some additional functionality.
     2491;
     2492
     2493(define (mysql-stmt-errno conn)
     2494  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2495    (foreign-mysql-stmt-errno stmtptr) ) )
     2496
     2497; Returns a string describing the last mysql stmt error, or #f if no error
     2498; has occurred.
     2499(define (mysql-stmt-error conn)
     2500  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2501    (let ([errstr (foreign-mysql-stmt-error stmtptr)])
     2502      (and (not (string=? "" errstr))
     2503           errstr ) ) ) )
     2504
     2505; Returns a string describing the last mysql stmt state error, or #f if no error
     2506; has occurred.
     2507(define (mysql-stmt-sqlstate conn)
     2508  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2509    (let ([errstr (foreign-mysql-stmt-sqlstate stmtptr)])
     2510      (and (not (or (string=? "00000" errstr)
     2511                    (string=? "HY000" errstr)))
     2512           errstr ) ) ) )
     2513
     2514(define (mysql-stmt-init conn)
     2515  (%mysql-stmt-close conn)
     2516  (let ([stmtptr (foreign-mysql-stmt-init (mysql-connection-ptr conn))])
     2517    (if stmtptr
     2518        (mysql-connection-statement-set! conn stmtptr)
     2519        (signal-mysql-condition 'mysql-stmt-init "out of memory") ) ) )
     2520
     2521(define (mysql-stmt-prepare conn sql)
     2522  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2523    (unless (zero? (foreign-mysql-stmt-prepare stmtptr sql (string-length sql)))
     2524      (signal-mysql-stmt-error 'mysql-stmt-prepare stmtptr) ) ) )
     2525
     2526(define (mysql-stmt-param-count conn)
     2527  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2528    (foreign-mysql-stmt-param-count stmtptr) ) )
     2529
     2530(define (mysql-stmt-bind-param conn bindptr)
     2531  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2532    #; ;This souldn't be necessary
     2533    (%mysql-free-bind conn)
     2534    (if (foreign-mysql-stmt-bind-param stmtptr bindptr)
     2535        (signal-mysql-stmt-error 'mysql-stmt-bind-param stmtptr)
     2536        (mysql-connection-binding-set! conn bindptr) ) ) )
     2537
     2538(define (mysql-stmt-execute conn)
     2539  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2540    (unless (zero? (foreign-mysql-stmt-execute stmtptr))
     2541      (signal-mysql-stmt-error 'mysql-stmt-execute stmtptr) ) ) )
     2542
     2543(define (mysql-stmt-affected-rows conn)
     2544  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2545    (let ([cnt (foreign-mysql-stmt-affected-rows stmtptr)])
     2546      (and (not (= -1 cnt))
     2547           cnt ) ) ) )
     2548
     2549(define (mysql-stmt-bind-result conn bindptr)
     2550  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2551    (%mysql-free-bind conn) ; free the param bindings
     2552    (if (foreign-mysql-stmt-bind-result stmtptr bindptr)
     2553        (signal-mysql-stmt-error 'mysql-stmt-bind-result stmtptr)
     2554        (mysql-connection-binding-set! conn bindptr) ) ) )
     2555
     2556; returns boolean for success, mysql-data-truncated, or signals
     2557; an exception.
     2558(define (mysql-stmt-fetch conn)
     2559  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2560    (let ([val (foreign-mysql-stmt-fetch stmtptr)])
     2561      (cond [(zero? val)
     2562              #t]
     2563            [(= mysql-no-data val)
     2564              #f]
     2565            [(= mysql-data-truncated val)
     2566              mysql-data-truncated]
     2567            [(= 1 val)
     2568              (signal-mysql-stmt-error 'mysql-stmt-fetch stmtptr) ] ) ) ) )
     2569
     2570; causes the result to be buffered. does not touch the connection
     2571; result!
     2572(define (mysql-stmt-store-result conn)
     2573  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2574    (when (zero? (foreign-mysql-stmt-store-result stmtptr))
     2575      (signal-mysql-stmt-error 'mysql-stmt-store-result stmtptr) ) ) )
     2576
     2577; can only be invoked after a stmt-store-result and stmt-fetch.
     2578(define (mysql-stmt-result-metadata conn)
     2579  (mysql-free-result conn)
     2580  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2581    (let ([resptr (foreign-mysql-stmt-result-metadata stmtptr)])
     2582      (if resptr
     2583          (begin
     2584            (mysql-connection-result-set! conn resptr)
     2585            (mysql-connection-result-start-set! conn
     2586              (foreign-mysql-stmt-row-tell (mysql-connection-result conn))) )
     2587          (signal-mysql-stmt-error 'mysql-stmt-result-metadata stmtptr) ) ) ) )
     2588
     2589(define (mysql-stmt-attr-set conn attr val)
     2590  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2591    (when (%mysql-stmt-attr-set stmtptr attr val)
     2592      (signal-mysql-condition 'stmt-attr-set
     2593                              "unknown statement attribute" attr val) ) ) )
     2594
     2595(define (mysql-stmt-attr-get conn attr)
     2596  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2597    (let ([val (%mysql-stmt-attr-get stmtptr attr)])
     2598      (if (eq? (void) val)
     2599          (signal-mysql-condition 'stmt-attr-get
     2600                                   "unknown statement attribute" attr)
     2601          val ) ) ) )
     2602
     2603;-----------------------------------------------------------------------
     2604; The statement "extended" MySQL/Scheme API.
     2605;
     2606; This API provides some additional functionality.
     2607;
     2608
     2609; rewinds to the beginning of the result set. has no effect if there is no
     2610; current result set.
     2611(define (mysql-stmt-rewind conn)
     2612  (and-let* ([stmtptr (mysql-connection-statement conn)]
     2613             [resptr (mysql-connection-result-start conn)])
     2614    (foreign-mysql-stmt-row-seek stmtptr resptr) ) )
     2615
     2616; returns a procedure, or #f when no connection.
     2617; the procedure takes a parameter index and returns the
     2618; the mysql-bind-ptr of the mysql-bind record, of #f
     2619; when no more rows to fetch.
     2620(define (mysql-stmt-row-fetch conn)
     2621  (and-let* ([resptr (mysql-connection-result conn)]
     2622             [bindptr (mysql-connection-binding conn)]
     2623             [(mysql-stmt-fetch conn)])
     2624    (let ([fldcnt (mysql-num-fields conn)])
     2625      (lambda (field)
     2626        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
     2627          (mysql-bind-ref bindptr fldidx) ) ) ) ) )
     2628
     2629;
     2630(define (mysql-stmt-query conn query params #!optional results)
     2631  (mysql-stmt-prepare conn query)
     2632  (mysql-stmt-bind-param conn params)
     2633  (mysql-stmt-execute conn)
     2634  (when results
     2635    (mysql-stmt-result-metadata conn)
     2636    (mysql-stmt-bind-result conn results) ) )
     2637
     2638;-----------------------------------------------------------------------
     2639; The statement "map" MySQL/Scheme API.
     2640;
     2641; This API provides some additional functionality for traversing results
     2642; in a Scheme-ish way.
     2643;
     2644
     2645; calls proc on every row in the current result set. proc should take 3
     2646; arguments: the row (as described for mysql-stmt-row-fetch), the row index
     2647; (which starts with 1 and ends with (mysql-stmt-num-rows conn)), and the
     2648; current accumulated value.
     2649;
     2650; returns the final accumulated value.
     2651;
     2652; note: rewinds the result set before and after iterating over it; thus,
     2653; all rows are included.
     2654;
     2655; you must call mysql-stmt-rewind if you later want to iterate over the result set
     2656; using mysql-stmt-row-fetch.
     2657(define (mysql-stmt-row-fold conn proc init)
     2658  (mysql-stmt-rewind conn)
     2659  (let loop ([rownum 1] [acc init])
     2660    (let ([row (mysql-stmt-row-fetch conn)])
     2661      (if row
     2662          (loop (+ rownum 1) (proc row rownum acc))
     2663          acc ) ) ) )
     2664
     2665; calls proc on every row in the current result set. proc should take 2
     2666; arguments: the row (as described for mysql-stmt-row-fetch) and the row index
     2667; (which starts with 1 and ends with (mysql-stmt-num-rows conn)).
     2668;
     2669; note: rewinds the result set before and after iterating over it; thus,
     2670; all rows are included.
     2671;
     2672; you must call mysql-stmt-rewind if you later want to iterate over the result set
     2673; using mysql-stmt-row-fetch.
     2674(define (mysql-stmt-row-for-each conn proc)
     2675  (mysql-stmt-row-fold conn
     2676                       (lambda (row rownum _) (proc row rownum))
     2677                       #t) )
     2678
     2679; calls proc on every row in the current result set. proc should take 2
     2680; arguments: the row (as described for mysql-stmt-row-fetch) and the row index
     2681; (which starts with 1 and ends with (mysql-stmt-num-rows conn)).
     2682;
     2683; returns a list of the results of each proc invocation.
     2684;
     2685; note: rewinds the result set before and after iterating over it; thus,
     2686; all rows are included.
     2687;
     2688; you must call mysql-stmt-rewind if you later want to iterate over the result set
     2689; using mysql-stmt-row-fetch.
     2690(define (mysql-stmt-row-map conn proc)
     2691  (reverse!
     2692    (mysql-stmt-row-fold conn
     2693                         (lambda (row rownum lst) (cons (proc row rownum) lst))
     2694                         '())) )
     2695
     2696; executes query and then mysql-row-for-each with the given proc. the proc
     2697; must meet the contract specified for the proc passed to mysql-stmt-row-fold.
     2698(define (mysql-stmt-query-fold conn query proc init params #!optional results)
     2699  (mysql-stmt-query conn query params results)
     2700  (mysql-stmt-row-fold conn proc init) )
     2701
     2702; executes query and then mysql-row-for-each with the given proc. the proc
     2703; must meet the contract specified for the proc passed to mysql-stmt-row-for-each.
     2704(define (mysql-stmt-query-for-each conn query proc params #!optional results)
     2705  (mysql-stmt-query conn query params results)
     2706  (mysql-stmt-row-for-each conn proc) )
     2707
     2708; executes query and then mysql-row-for-each with the given proc. the proc
     2709; must meet the contract specified for the proc passed to mysql-stmt-row-map.
     2710(define (mysql-stmt-query-map conn query proc params #!optional results)
     2711  (mysql-stmt-query conn query params results)
     2712  (mysql-stmt-row-map conn proc) )
     2713|#
     2714
     2715
  • release/3/mysql/trunk/mysql.scm

    r7949 r7969  
    119119  (bound-to-procedure
    120120    mysql-error
    121     mysql-field-type-binary? )
     121    mysql-errno
     122    #;%mysql-stmt-close )
    122123  (export
    123124    ;; direct api
     
    395396        mysql-type-short
    396397        mysql-type-long
     398        mysql-type-int24
    397399        mysql-type-float
    398400        mysql-type-double
     
    545547  MYSQL_TYPE_SHORT
    546548  MYSQL_TYPE_LONG
     549  MYSQL_TYPE_INT24
    547550  MYSQL_TYPE_FLOAT
    548551  MYSQL_TYPE_DOUBLE
     
    573576  MYSQL_TYPE_SHORT
    574577  MYSQL_TYPE_LONG
     578  MYSQL_TYPE_INT24
    575579  MYSQL_TYPE_FLOAT
    576580  MYSQL_TYPE_DOUBLE
     
    741745(define-constant UNSIGNED-LONG-SIZE 4)
    742746
    743 
    744747;-----------------------------------------------------------------------
    745748; Foreign function definitions for the MySQL C API using the
     
    753756#>
    754757static double
    755 C_mysql_affected_rows (MYSQL *mysql)
     758mysqlaux_mysql_affected_rows (MYSQL *mysql)
    756759{
    757760  return ((double) mysql_affected_rows (mysql));
     
    759762
    760763static double
    761 C_mysql_insert_id (MYSQL *mysql)
     764mysqlaux_mysql_insert_id (MYSQL *mysql)
    762765{
    763766  return ((double) mysql_insert_id (mysql));
     
    765768
    766769static double
    767 C_mysql_num_rows (MYSQL_RES *result)
     770mysqlaux_mysql_num_rows (MYSQL_RES *result)
    768771{
    769772  return ((double) mysql_num_rows (result));
     
    771774
    772775static void
    773 C_mysql_data_seek (MYSQL_RES *result, double offset)
     776mysqlaux_mysql_data_seek (MYSQL_RES *result, double offset)
    774777{
    775778  mysql_data_seek (result, (my_ulonglong) offset);
     
    780783; my_ulonglong mysql_affected_rows(MYSQL *mysql)
    781784(define foreign-mysql-affected-rows
    782   (foreign-lambda my-ulonglong "C_mysql_affected_rows" mysql-ptr))
     785  (foreign-lambda my-ulonglong "mysqlaux_mysql_affected_rows" mysql-ptr))
    783786
    784787; 24.2.3.34. mysql_insert_id()
    785788; my_ulonglong mysql_insert_id(MYSQL *mysql)
    786789(define foreign-mysql-insert-id
    787   (foreign-lambda my-ulonglong "C_mysql_insert_id" mysql-ptr))
     790  (foreign-lambda my-ulonglong "mysqlaux_mysql_insert_id" mysql-ptr))
    788791
    789792; 24.2.3.43. mysql_num_rows()
    790793; my_ulonglong mysql_num_rows(MYSQL_RES *result)
    791794(define foreign-mysql-num-rows
    792   (foreign-lambda my-ulonglong "C_mysql_num_rows" mysql-res-ptr))
     795  (foreign-lambda my-ulonglong "mysqlaux_mysql_num_rows" mysql-res-ptr))
    793796
    794797; 24.2.3.7. mysql_data_seek()
    795798; void mysql_data_seek(MYSQL_RES *result, my_ulonglong offset)
    796799(define foreign-mysql-data-seek
    797   (foreign-lambda void "C_mysql_data_seek" mysql-res-ptr my-ulonglong))
     800  (foreign-lambda void "mysqlaux_mysql_data_seek" mysql-res-ptr my-ulonglong))
    798801
    799802;-----------------------------------------------------------------------
     
    803806#>
    804807static int
    805 C_mysql_options_none (MYSQL *mysql, enum mysql_option option)
     808mysqlaux_mysql_options_none (MYSQL *mysql, enum mysql_option opt)
    806809{
    807   return (mysql_options (mysql, option, NULL));
     810  return (mysql_options (mysql, opt, NULL));
    808811}
    809812
    810813static int
    811 C_mysql_options_string (MYSQL *mysql, enum mysql_option option, char *value)
     814mysqlaux_mysql_options_string (MYSQL *mysql, enum mysql_option opt, char *value)
    812815{
    813   return (mysql_options (mysql, option, value));
     816  return (mysql_options (mysql, opt, value));
    814817}
    815818
    816819static int
    817 C_mysql_options_ulong (MYSQL *mysql, enum mysql_option option, unsigned long value)
     820mysqlaux_mysql_options_ulong (MYSQL *mysql, enum mysql_option opt, unsigned long value)
    818821{
    819   return (mysql_options (mysql, option, &value));
     822  return (mysql_options (mysql, opt, &value));
    820823}
    821824<#
    822825
    823 (define (%mysql-options mysqlptr option value)
    824   (cond
    825     [(null? value)
    826       ((foreign-lambda int "C_mysql_options_none" mysql-ptr mysql-option)
    827        mysqlptr option)]
    828     [(string? value)
    829       ((foreign-lambda int "C_mysql_options_string" mysql-ptr mysql-option c-string)
    830         mysqlptr option value)]
    831     [(number? value)
    832       ((foreign-lambda int "C_mysql_options_ulong" mysql-ptr mysql-option unsigned-long)
    833         mysqlptr option value)]) )
     826(define foreign-mysqlaux-options-none
     827  (foreign-lambda int "mysqlaux_mysql_options_none" mysql-ptr mysql-option) )
     828
     829(define foreign-mysqlaux-options-string
     830  (foreign-lambda int "mysqlaux_mysql_options_string" mysql-ptr mysql-option c-string) )
     831
     832(define foreign-mysqlaux-options-ulong
     833  (foreign-lambda int "mysqlaux_mysql_options_ulong" mysql-ptr mysql-option unsigned-long) )
    834834
    835835;-----------------------------------------------------------------------
     
    853853}
    854854
    855 static char *
    856 mysqlaux_fetch_column_data_direct (MYSQL_RES *result, MYSQL_ROW row, unsigned int fldidx, int *binflg)
     855static int
     856mysqlaux_is_binary_field (MYSQL_RES *result, unsigned int fldidx)
    857857{
    858858  MYSQL_FIELD *fields = mysql_fetch_fields (result);
     
    866866    case MYSQL_TYPE_VAR_STRING:
    867867    case MYSQL_TYPE_STRING:
    868       *binflg = 1;
    869       break;
     868      return (63 == fields[fldidx].charsetnr);
    870869    default:
    871       *binflg = 0;
    872       break;
     870     break;
    873871  }
    874   *binflg &= (63 == fields[fldidx].charsetnr);
    875 
    876   return (((MYSQL_ROW)row)[fldidx]);
     872
     873  return (0);
     874}
     875
     876static char *
     877mysqlaux_fetch_column_data_direct (MYSQL_ROW row, unsigned int fldidx)
     878{
     879  return (row[fldidx]);
    877880}
    878881<#
     
    882885                                             nonnull-c-string unsigned-integer))
    883886
     887(define foreign-mysqlaux-is-binary-field
     888  (foreign-lambda bool "mysqlaux_is_binary_field"
     889                        mysql-res-ptr unsigned-integer))
     890
     891(define foreign-mysqlaux-fetch-column-string-direct
     892  (foreign-lambda c-string "mysqlaux_fetch_column_data_direct"
     893                            mysql-row unsigned-integer))
     894
    884895(define foreign-mysqlaux-fetch-column-data-direct
    885896  (foreign-lambda c-pointer "mysqlaux_fetch_column_data_direct"
    886                             mysql-res-ptr mysql-row
    887                             unsigned-integer
    888                             (nonnull-c-pointer int)))
     897                             mysql-row unsigned-integer))
    889898
    890899;-----------------------------------------------------------------------
     
    12301239      "") )
    12311240
    1232 (define (foreign-unsigned-long-pointer->u32vector ulptr cnt)
     1241(define (unsigned-long-array->u32vector ulptr cnt)
    12331242  (let* ([siz (* cnt UNSIGNED-LONG-SIZE)]
    12341243         [store (make-blob siz)])
     
    12361245    (blob->u32vector/shared store) ) )
    12371246
     1247#; ; UNUSED
    12381248(define char-pointer->string
    12391249  (foreign-lambda* c-string ((c-pointer chrptr))
     
    12531263         fldidx ) ) )
    12541264
     1265(define (%mysql-options mysqlptr opt val)
     1266  (cond [(null? val)
     1267          (foreign-mysqlaux-options-none mysqlptr opt)]
     1268        [(string? val)
     1269          (foreign-mysqlaux-options-string mysqlptr opt val)]
     1270        [(number? val)
     1271          (foreign-mysqlaux-options-ulong mysqlptr opt val)]
     1272        [else
     1273          1 ] ) )
     1274
    12551275;-----------------------------------------------------------------------
    12561276; MySQL exceptions
     
    12721292
    12731293(define (signal-mysql-error loc conn . args)
    1274   (apply signal-mysql-condition loc (mysql-error conn) args) )
     1294  (let ([msg (or (mysql-error conn)
     1295                 (mysql-errno conn))])
     1296    (apply signal-mysql-condition loc msg args) ) )
    12751297
    12761298;-----------------------------------------------------------------------
     
    13551377(define-record-type mysql-connection
    13561378  (make-mysql-connection host user passwd db port unix-socket
    1357                          client-flag ptr result result-start
    1358                          ssl opts)
     1379                         client-flag ptr result result-start ssl opts
     1380                         #;stmt #;bind)
    13591381  mysql-connection?
    13601382  (host mysql-connection-host)
     
    13691391  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
    13701392  (ssl mysql-connection-ssl)
    1371   (opts mysql-connection-options) )
     1393  (opts mysql-connection-options)
     1394  #;(stmt mysql-connection-statement mysql-connection-statement-set!)
     1395  #;(bind mysql-connection-binding mysql-connection-binding-set!) )
    13721396
    13731397(define-record-printer (mysql-connection conn out)
    1374   (let [(host (mysql-connection-host conn))
    1375         (user (mysql-connection-user conn))
    1376         (passwd (mysql-connection-passwd conn))
    1377         (db (mysql-connection-db conn))
    1378         (tcp-port (mysql-connection-port conn))
    1379         (unix-socket (mysql-connection-unix-socket conn))
    1380         (client-flag (mysql-connection-client-flag conn))
    1381         (ssl (mysql-connection-ssl conn))
    1382         (opts (mysql-connection-options conn))]
     1398  (let ([host (mysql-connection-host conn)]
     1399        [user (mysql-connection-user conn)]
     1400        [passwd (mysql-connection-passwd conn)]
     1401        [db (mysql-connection-db conn)]
     1402        [tcp-port (mysql-connection-port conn)]
     1403        [unix-socket (mysql-connection-unix-socket conn)]
     1404        [client-flag (mysql-connection-client-flag conn)]
     1405        [ssl (mysql-connection-ssl conn)]
     1406        [opts (mysql-connection-options conn)]
     1407        #;[stmt (mysql-connection-statement conn)]
     1408        #;[bind (mysql-connection-binding conn)])
    13831409    (display
    13841410     (string-append
     
    13941420            (record-slot->string client-flag  "client-flag" (not (zero? client-flag)))
    13951421            (record-slot->string ssl          "ssl")
    1396             (record-slot->string opts         "options") )
     1422            (record-slot->string opts         "options")
     1423            #;(record-slot->string stmt         "statement")
     1424            #;(record-slot->string bind         "binding") )
    13971425          " INVALID")
    13981426      ">")
     
    14071435
    14081436(define (mysql-affected-rows conn)
    1409   (foreign-mysql-affected-rows (mysql-connection-ptr conn)) )
     1437  (let ([cnt (foreign-mysql-affected-rows (mysql-connection-ptr conn))])
     1438    (and (not (= -1 cnt))
     1439         cnt ) ) )
    14101440
    14111441(define (mysql-change-user conn #!key (user #f) (passwd #f) (db #f))
     
    14201450; upon termination.
    14211451(define (mysql-close conn)
     1452  #;(%mysql-stmt-close conn)
    14221453  (mysql-free-result conn)
    14231454  (foreign-mysql-close (mysql-connection-ptr conn))
     
    14441475                   [val (cdr optitm)])
    14451476               (unless (zero? (%mysql-options mysql opt val))
    1446                  (signal-mysql-condition 'mysql-connect "unknown option code" opt val))))
     1477                 (signal-mysql-condition 'mysql-connect "unknown option" opt val))))
    14471478           options) )
    1448         (let ([mysqlptr (foreign-mysql-real-connect mysql host user passwd db
     1479        (let ([mysqlptr (foreign-mysql-real-connect mysql
     1480                                                    host user passwd
     1481                                                    db
    14491482                                                    port unix-socket
    14501483                                                    client-flag)])
    14511484          (if mysqlptr
    14521485              (make-mysql-connection host user passwd db port unix-socket
    1453                                      client-flag mysqlptr #f #f options ssl)
     1486                                     client-flag mysqlptr #f #f options ssl
     1487                                     #;#f #;#f)
    14541488              (signal-mysql-condition 'mysql-connect
    14551489               (foreign-mysql-error mysql)
     
    14701504; has occurred.
    14711505(define (mysql-error conn)
    1472   (let [(errstr (foreign-mysql-error (mysql-connection-ptr conn)))]
     1506  (let ([errstr (foreign-mysql-error (mysql-connection-ptr conn))])
    14731507    (and (not (string=? "" errstr))
    14741508         errstr) ) )
     
    15061540(define (%mysql-fetch-lengths resptr cnt)
    15071541  (and-let* ([ulptr (foreign-mysql-fetch-lengths resptr)])
    1508     (foreign-unsigned-long-pointer->u32vector ulptr cnt) ) )
     1542    (unsigned-long-array->u32vector ulptr cnt) ) )
    15091543
    15101544; returns a u32vector of length num-fields.
     
    15231557  (and-let* ([resptr (mysql-connection-result conn)]
    15241558             [row (foreign-mysql-fetch-row resptr)])
    1525     (let* ([connptr (mysql-connection-ptr conn)]
    1526            [fldcnt (foreign-mysql-num-fields resptr)]
    1527            [fldlens (%mysql-fetch-lengths resptr fldcnt)])
     1559    (let ([fldcnt (foreign-mysql-num-fields resptr)]
     1560          [fldlens #f])
    15281561      (lambda (field)
    15291562        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
    1530           (let-location ([binary-flag bool])
    1531             (and-let* ([datptr (foreign-mysqlaux-fetch-column-data-direct resptr row fldidx #$binary-flag)])
    1532               (if binary-flag
    1533                   (binary-char-pointer->string datptr (u32vector-ref fldlens fldidx))
    1534                   (char-pointer->string datptr) ) ) ) ) ) ) ) )
     1563          (if (foreign-mysqlaux-is-binary-field resptr fldidx)
     1564              (binary-char-pointer->string
     1565               (foreign-mysqlaux-fetch-column-data-direct row fldidx)
     1566               (u32vector-ref
     1567                (or fldlens
     1568                    (begin
     1569                      (set! fldlens (%mysql-fetch-lengths resptr fldcnt))
     1570                      fldlens ) )
     1571                fldidx))
     1572              (foreign-mysqlaux-fetch-column-string-direct row fldidx) ) ) ) ) ) )
    15351573
    15361574(define (mysql-field-count conn)
    1537   (foreign-mysql-field-count (mysql-connection-ptr conn)))
     1575  (foreign-mysql-field-count (mysql-connection-ptr conn)) )
    15381576
    15391577(define (mysql-free-result conn)
    1540   (and-let* [(res (mysql-connection-result conn))]
     1578  (and-let* ([res (mysql-connection-result conn)])
    15411579    (foreign-mysql-free-result res) )
    15421580  (mysql-connection-result-set! conn #f)
     
    16101648; returns #t if the query was successful, signals exception otherwise.
    16111649(define (mysql-query conn query)
    1612   (let [(mysql-ptr (mysql-connection-ptr conn))]
     1650  (let ([mysql-ptr (mysql-connection-ptr conn)])
    16131651    ; zero indicates success
    16141652    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
     
    16481686; current result set.
    16491687(define (mysql-rewind conn)
    1650   (and-let* ([res-st (mysql-connection-result-start conn)])
    1651     (foreign-mysql-row-seek (mysql-connection-result conn) res-st) ) )
     1688  (and-let* ([resptr (mysql-connection-result-start conn)])
     1689    (foreign-mysql-row-seek (mysql-connection-result conn) resptr) ) )
    16521690
    16531691;-----------------------------------------------------------------------
     
    16601698; calls proc on every row in the current result set. proc should take 3
    16611699; arguments: the row (as described for mysql-fetch-row), the row index
    1662 ; (which starts with 1 and ends with (mysql-num-rows conn), and the
     1700; (which starts with 1 and ends with (mysql-num-rows conn)), and the
    16631701; current accumulated value.
    16641702;
     
    16801718; calls proc on every row in the current result set. proc should take 2
    16811719; arguments: the row (as described for mysql-fetch-row) and the row index
    1682 ; (which starts with 1 and ends with (mysql-num-rows conn).
     1720; (which starts with 1 and ends with (mysql-num-rows conn)).
    16831721;
    16841722; note: rewinds the result set before and after iterating over it; thus,
     
    16941732; calls proc on every row in the current result set. proc should take 2
    16951733; arguments: the row (as described for mysql-fetch-row) and the row index
    1696 ; (which starts with 1 and ends with (mysql-num-rows conn).
     1734; (which starts with 1 and ends with (mysql-num-rows conn)).
    16971735;
    16981736; returns a list of the results of each proc invocation.
     
    18561894
    18571895#|
    1858 ;-----------------------------------------------------------------------
    1859 ; The MySQL prepared statement API.
    1860 ;
     1896;=======================================================================
     1897; The MYSQL_TIME API.
     1898;
     1899
     1900(declare
     1901  (export
     1902    ;; enum enum_mysql_timestamp_type
     1903    mysql-timestamp-date
     1904    mysql-timestamp-datetime
     1905    mysql-timestamp-error
     1906    mysql-timestamp-none
     1907    mysql-timestamp-time
     1908    ;
     1909    mysql-timestamp-type-symbol
     1910    mysql-timestamp-type-value
     1911    ;; MYSQL_TIME
     1912    mysql-time-day-set!
     1913    mysql-time-hour-set!
     1914    mysql-time-minute-set!
     1915    mysql-time-month-set!
     1916    mysql-time-neg-set!
     1917    mysql-time-second-part-set!
     1918    mysql-time-second-set!
     1919    mysql-time-time-type-set!
     1920    mysql-time-year-set!
     1921    ;
     1922    mysql-time-day
     1923    mysql-time-hour
     1924    mysql-time-minute
     1925    mysql-time-month
     1926    mysql-time-neg
     1927    mysql-time-second
     1928    mysql-time-second-part
     1929    mysql-time-time-type
     1930    mysql-time-year
     1931    ;
     1932    make-mysql-time
     1933    allocate-myysql-time
     1934    free-mysql-time ) )
    18611935
    18621936;;
    18631937
    1864 (define-foreign-type mysql-row-offset mysql-rows-ptr)
    1865 
    1866 (define-foreign-type mysql-bind-ptr (c-pointer "MYSQL_BIND"))
    1867 
    1868 (define-foreign-type mysql-stmt-ptr (c-pointer "MYSQL_STMT"))
     1938(define-foreign-type mysql-time-ptr (c-pointer "MYSQL_TIME"))
    18691939
    18701940;;
     
    18841954  MYSQL_TIMESTAMP_DATETIME
    18851955  MYSQL_TIMESTAMP_TIME )
    1886 
    1887 (define-foreign-enum (mysql-stmt-state (enum "enum_mysql_stmt_state"))
    1888   #f  ; No aliases!
    1889   MYSQL_STMT_INIT_DONE
    1890   MYSQL_STMT_PREPARE_DONE
    1891   MYSQL_STMT_EXECUTE_DONE
    1892   MYSQL_STMT_FETCH_DONE )
    1893 
    1894 (gen-public-enum mysql-stmt-state
    1895   MYSQL_STMT_INIT_DONE
    1896   MYSQL_STMT_PREPARE_DONE
    1897   MYSQL_STMT_EXECUTE_DONE
    1898   MYSQL_STMT_FETCH_DONE )
    1899 
    1900 (define-foreign-enum (mysql-stmt-attr-type (enum "enum_stmt_attr_type"))
    1901   #f  ; No aliases!
    1902   STMT_ATTR_UPDATE_MAX_LENGTH
    1903   STMT_ATTR_CURSOR_TYPE
    1904   STMT_ATTR_PREFETCH_ROWS )
    1905 
    1906 (gen-public-enum mysql-stmt-attr-type
    1907   STMT_ATTR_UPDATE_MAX_LENGTH
    1908   STMT_ATTR_CURSOR_TYPE
    1909   STMT_ATTR_PREFETCH_ROWS )
    1910 
    19111956;;
    1912 
    1913 ;errors - NULL return
    1914 ;MYSQL_STMT *mysql_stmt_init(MYSQL *mysql)
    1915 (define foreign-mysql-stmt-init
    1916   (foreign-lambda mysql-stmt-ptr "mysql_stmt_init" mysql-ptr))
    1917 
    1918 ;errors - non-zero return
    1919 ;my_bool mysql_stmt_close(MYSQL_STMT *mysql)
    1920 (define foreign-mysql-stmt-close
    1921         (foreign-lambda my-bool "mysql_stmt_close" mysql-stmt-ptr))
    1922 
    1923 ;errors - non-zero return
    1924 ;my_bool mysql_stmt_bind_param(MYSQL_STMT *stmt, MYSQL_BIND *bind)
    1925 (define foreign-mysql-stmt-bind-param
    1926         (foreign-lambda my-bool "mysql_stmt_bind_param" mysql-stmt-ptr mysql-bind-ptr))
    1927 
    1928 ;errors - non-zero return
    1929 ;my_bool mysql_stmt_bind_result(MYSQL_STMT *stmt, MYSQL_BIND *bind)
    1930 (define foreign-mysql-stmt-bind-result
    1931         (foreign-lambda my-bool "mysql_stmt_bind_result" mysql-stmt-ptr mysql-bind-ptr))
    1932 
    1933 ;errors - non-zero return
    1934 ;int mysql_stmt_execute(MYSQL_STMT *stmt)
    1935 (define foreign-mysql-stmt-execute
    1936         (foreign-lambda int "mysql_stmt_execute" mysql-stmt-ptr))
    1937 
    1938 ;errors - 1 return
    1939 ;MYSQL_NO_DATA return
    1940 ;MYSQL_DATA_TRUNCATED return
    1941 ;int mysql_stmt_fetch(MYSQL_STMT *stmt)
    1942 (define foreign-mysql-stmt-fetch
    1943         (foreign-lambda int "mysql_stmt_fetch" mysql-stmt-ptr))
    1944 
    1945 ;int mysql_stmt_prepare(MYSQL_STMT *stmt, const char *query, unsigned long length)
    1946 (define foreign-mysql-stmt-prepare
    1947         (foreign-lambda int "mysql_stmt_prepare" mysql-stmt-ptr c-string unsigned-long))
    1948 
    1949 ;int mysql_stmt_fetch_column(MYSQL_STMT *stmt, MYSQL_BIND *bind_arg, unsigned int column, unsigned long offset)
    1950 (define foreign-mysql-stmt-fetch-column
    1951         (foreign-lambda int "mysql_stmt_fetch_column" mysql-stmt-ptr mysql-bind-ptr unsigned-int unsigned-long))
    1952 
    1953 ;int mysql_stmt_store_result(MYSQL_STMT *stmt)
    1954 (define foreign-mysql-stmt-store-result
    1955         (foreign-lambda int "mysql_stmt_store_result" mysql-stmt-ptr))
    1956 
    1957 ;unsigned long mysql_stmt_param_count(MYSQL_STMT * stmt)
    1958 (define foreign-mysql-stmt-param-count
    1959         (foreign-lambda unsigned-long "mysql_stmt_param_count" mysql-stmt-ptr))
    1960 
    1961 ;my_bool mysql_stmt_attr_set(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, const void *attr)
    1962 (define foreign-mysql-stmt-attr-set
    1963         (foreign-lambda my-bool "mysql_stmt_attr_set" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
    1964 
    1965 ;my_bool mysql_stmt_attr_get(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, void *attr)
    1966 (define foreign-mysql-stmt-attr-get
    1967         (foreign-lambda my-bool "mysql_stmt_attr_get" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
    1968 
    1969 ;my_bool mysql_stmt_reset(MYSQL_STMT * stmt)
    1970 (define foreign-mysql-stmt-reset
    1971         (foreign-lambda my-bool "mysql_stmt_reset" mysql-stmt-ptr))
    1972 
    1973 ;my_bool mysql_stmt_free_result(MYSQL_STMT *stmt)
    1974 (define foreign-mysql-stmt-free-result
    1975         (foreign-lambda my-bool "mysql_stmt_free_result" mysql-stmt-ptr))
    1976 
    1977 ;my_bool mysql_stmt_send_long_data(MYSQL_STMT *stmt, unsigned-int param_number, const char *data, unsigned long length)
    1978 (define foreign-mysql-stmt-send-long-data
    1979         (foreign-lambda my-bool "mysql_stmt_send_long_data" mysql-stmt-ptr unsigned-int c-pointer unsigned-long))
    1980 
    1981 ;MYSQL_RES *mysql_stmt_result_metadata(MYSQL_STMT *stmt)
    1982 (define foreign-mysql-stmt-result-metadata
    1983         (foreign-lambda mysql-res-ptr "mysql_stmt_result_metadata" mysql-stmt-ptr))
    1984 
    1985 ;MYSQL_RES *mysql_stmt_param_metadata(MYSQL_STMT *stmt)
    1986 (define foreign-mysql-stmt-param-metadata
    1987         (foreign-lambda mysql-res-ptr "mysql_stmt_param_metadata" mysql-stmt-ptr))
    1988 
    1989 ;unsigned int mysql_stmt_errno(MYSQL_STMT * stmt)
    1990 (define foreign-mysql-stmt-errno
    1991         (foreign-lambda unsigned-int "mysql_stmt_errno" mysql-stmt-ptr))
    1992 
    1993 ;const char *mysql_stmt_error(MYSQL_STMT * stmt)
    1994 (define foreign-mysql-stmt-error
    1995         (foreign-lambda c-string "mysql_stmt_error" mysql-stmt-ptr))
    1996 
    1997 ;const char *mysql_stmt_sqlstate(MYSQL_STMT * stmt)
    1998 (define foreign-mysql-stmt-sqlstate
    1999         (foreign-lambda c-string "mysql_stmt_sqlstate" mysql-stmt-ptr))
    2000 
    2001 ;MYSQL_ROW_OFFSET mysql_stmt_row_seek(MYSQL_STMT *stmt, MYSQL_ROW_OFFSET offset)
    2002 (define foreign-mysql-stmt-row-seek
    2003         (foreign-lambda mysql-row-offset "mysql_stmt_row_seek" mysql-stmt-ptr mysql-row-offset))
    2004 
    2005 ;MYSQL_ROW_OFFSET mysql_stmt_row_tell(MYSQL_STMT *stmt)
    2006 (define foreign-mysql-stmt-row-tell
    2007         (foreign-lambda mysql-row-offset "mysql_stmt_row_tell" mysql-stmt-ptr))
    2008 
    2009 #>
    2010 static void
    2011 C_mysql_stmt_data_seek (MYSQL_STMT *stmt, double offset)
    2012 {
    2013   mysql_stmt_data_seek (stmt, (my_ulonglong) offset);
    2014 }
    2015 
    2016 static double
    2017 C_mysql_stmt_num_rows (MYSQL_STMT *stmt)
    2018 {
    2019   return ((double) mysql_stmt_num_rows (stmt));
    2020 }
    2021 
    2022 static double
    2023 C_mysql_stmt_affected_rows (MYSQL_STMT *stmt)
    2024 {
    2025   return ((double) mysql_stmt_affected_rows (stmt));
    2026 }
    2027 
    2028 static double
    2029 C_mysql_stmt_insert_id (MYSQL_STMT *)
    2030 {
    2031   return ((double) mysql_stmt_insert_id (stmt));
    2032 }
    2033 <#
    2034 
    2035 ;void mysql_stmt_data_seek(MYSQL_STMT *stmt, my_ulonglong offset)
    2036 (define foreign-mysql-stmt-data-seek
    2037         (foreign-lambda void "C_mysql_stmt_data_seek" mysql-stmt-ptr my-ulonglong))
    2038 
    2039 ;my_ulonglong mysql_stmt_num_rows(MYSQL_STMT *stmt)
    2040 (define foreign-mysql-stmt-num-rows
    2041         (foreign-lambda my-ulonglong "C_mysql_stmt_num_rows" mysql-stmt-ptr))
    2042 
    2043 ;my_ulonglong mysql_stmt_affected_rows(MYSQL_STMT *stmt)
    2044 (define foreign-mysql-stmt-affected-rows
    2045         (foreign-lambda my-ulonglong "C_mysql_stmt_affected_rows" mysql-stmt-ptr))
    2046 
    2047 ;my_ulonglong mysql_stmt_insert_id(MYSQL_STMT *stmt)
    2048 (define foreign-mysql-stmt-insert-id
    2049         (foreign-lambda my-ulonglong "C_mysql_stmt_insert_id" mysql-stmt-ptr))
    2050 
    2051 ;unsigned int mysql_stmt_field_count(MYSQL_STMT *stmt)
    2052 (define foreign-mysql-stmt-field-count
    2053         (foreign-lambda unsigned-int "mysql_stmt_field_count" mysql-stmt-ptr))
    2054 
    2055 ;;
    2056 
    2057 (define-foreign-record (mysql-bind "MYSQL_BIND")
    2058   (rename: c-name->scheme-name)
    2059   ; special ctor
    2060   (destructor: free-myysql-bind)
    2061   ((c-pointer "unsigned long") length)    ; output length pointer
    2062   ((c-pointer "my_bool") is_null)                   ; Pointer to null indicator
    2063   (c-pointer buffer)                      ; buffer to get/put data
    2064   ((c-pointer "my_bool") error)                 ; set this if you want to track data truncations happened during fetch
    2065   (unsigned-long buffer_length)           ; output buffer length, must be set when fetching str/binary
    2066   (mysql-type buffer_type)                          ; buffer type
    2067   (my-bool error_value)                         ; used if error is 0
    2068   (my-bool is_unsigned)                         ; set if integer type is unsigned
    2069   (my-bool is_null_value) )               ; Used if is_null is 0
    2070 
    2071 (define (allocate-myysql-bind cnt)
    2072   ((foreign-lambda* mysql-bind-ptr ((unsigned-integer cnt))
    2073    "return ((1 <= cnt) ? ((MYSQL_BIND *) calloc (cnt, sizeof(MYSQL_BIND))) : NULL);")
    2074   cnt) )
    2075 
    2076 (define (mysql-bind-vector-ref ptr idx)
    2077   ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
    2078    "return ((0 <= idx) ? (&(ptr[idx])) : NULL);")
    2079    ptr idx) )
    20801957
    20811958(define-foreign-record (mysql-time "MYSQL_TIME")
     
    20921969  (my-bool neg)
    20931970  (mysql-timestamp-type time_type) )
     1971
     1972(define (make-mysql-time type #!key (year 0) (month 0) (day 0)
     1973                                    (hour 0) (minute 0) (second 0)
     1974                                    (second-part 0)
     1975                                    is-negative)
     1976  (let ([timptr (allocate-myysql-time)])
     1977    (mysql-time-time-type-set! timptr type)
     1978    (mysql-time-year-set! timptr year)
     1979    (mysql-time-month-set! timptr month)
     1980    (mysql-time-day-set! timptr day)
     1981    (mysql-time-hour-set! timptr hour)
     1982    (mysql-time-minute-set! timptr minute)
     1983    (mysql-time-second-set! timptr second)
     1984    (mysql-time-second-part-set! timptr second-part)
     1985    (mysql-time-neg-set! timptr is-negative)
     1986    (set-finalizer! timptr free-mysql-time)
     1987    timptr ) )
     1988
     1989;=======================================================================
     1990; The MySQL prepared statement API.
     1991;
     1992
     1993(declare
     1994  (bound-to-procedure
     1995    mysql-stmt-errno
     1996    mysql-stmt-error
     1997    mysql-stmt-sqlstate )
     1998  (export
     1999    ;;
     2000    stmt-attr-cursor-type
     2001    stmt-attr-prefetch-rows
     2002    stmt-attr-update-max-length
     2003    ;
     2004    mysql-stmt-attr-type-symbol
     2005    mysql-stmt-attr-type-value
     2006    ;;
     2007    mysql-stmt-init-done
     2008    mysql-stmt-execute-done
     2009    mysql-stmt-prepare-done
     2010    mysql-stmt-fetch-done
     2011    ;
     2012    mysql-stmt-state-symbol
     2013    mysql-stmt-state-value
     2014    ;;
     2015    mysql-no-data
     2016    mysql-data-truncated
     2017    ;
     2018    mysql-status-return-code-symbol
     2019    mysql-status-return-code-value
     2020    ;;
     2021    foreign-mysql-stmt-affected-rows
     2022    foreign-mysql-stmt-attr-get
     2023    foreign-mysql-stmt-attr-set
     2024    foreign-mysql-stmt-bind-param
     2025    foreign-mysql-stmt-bind-result
     2026    foreign-mysql-stmt-close
     2027    foreign-mysql-stmt-data-seek
     2028    foreign-mysql-stmt-errno
     2029    foreign-mysql-stmt-error
     2030    foreign-mysql-stmt-execute
     2031    foreign-mysql-stmt-fetch
     2032    foreign-mysql-stmt-fetch-column
     2033    foreign-mysql-stmt-field-count
     2034    foreign-mysql-stmt-free-result
     2035    foreign-mysql-stmt-init
     2036    foreign-mysql-stmt-insert-id
     2037    foreign-mysql-stmt-num-rows
     2038    foreign-mysql-stmt-param-count
     2039    foreign-mysql-stmt-param-metadata
     2040    foreign-mysql-stmt-prepare
     2041    foreign-mysql-stmt-reset
     2042    foreign-mysql-stmt-result-metadata
     2043    foreign-mysql-stmt-row-seek
     2044    foreign-mysql-stmt-row-tell
     2045    foreign-mysql-stmt-send-long-data
     2046    foreign-mysql-stmt-sqlstate
     2047    foreign-mysql-stmt-store-result
     2048    ;; basic
     2049                mysql-stmt-errno
     2050                mysql-stmt-error
     2051                mysql-stmt-sqlstate
     2052                mysql-stmt-init ; custom
     2053                #;mysql-stmt-close ; called by custom mysql-stmt-init
     2054                mysql-stmt-prepare
     2055                mysql-stmt-param-count
     2056                mysql-stmt-bind-param
     2057                mysql-stmt-execute
     2058                mysql-stmt-affected-rows
     2059                mysql-stmt-bind-result
     2060                mysql-stmt-fetch
     2061                mysql-stmt-store-result
     2062                mysql-stmt-result-metadata
     2063                mysql-stmt-attr-set
     2064                mysql-stmt-attr-get
     2065    ;; extended
     2066                mysql-stmt-rewind
     2067                mysql-stmt-row-fetch
     2068                mysql-stmt-query
     2069    ;; mapping
     2070                mysql-stmt-row-fold
     2071                mysql-stmt-row-for-each
     2072                mysql-stmt-row-map
     2073                mysql-stmt-query-fold
     2074                mysql-stmt-query-for-each
     2075                mysql-stmt-query-map
     2076    ;; MYSQL_BIND
     2077    allocate-mysql-bind
     2078    free-mysql-bind
     2079    mysql-bind-ref
     2080    mysql-bind-clear!
     2081    mysql-bind-param-init
     2082    mysql-bind-result-init
     2083    ;
     2084    mysql-bind-buffer-set!
     2085    mysql-bind-buffer-length-set!
     2086    mysql-bind-buffer-type-set!
     2087    mysql-bind-error-set!
     2088    mysql-bind-error-value-set!
     2089    mysql-bind-is-null-set!
     2090    mysql-bind-is-null-value-set!
     2091    mysql-bind-is-unsigned-set!
     2092    mysql-bind-length-set!
     2093    ;
     2094    mysql-bind-buffer
     2095    mysql-bind-buffer-length
     2096    mysql-bind-buffer-type
     2097    mysql-bind-error
     2098    mysql-bind-error-value
     2099    mysql-bind-is-null
     2100    mysql-bind-is-null-value
     2101    mysql-bind-is-unsigned
     2102    mysql-bind-length ) )
     2103
     2104;;
     2105
     2106(define-foreign-type mysql-row-offset mysql-rows-ptr)
     2107
     2108(define-foreign-type mysql-bind-ptr (c-pointer "MYSQL_BIND"))
     2109
     2110(define-foreign-type mysql-stmt-ptr (c-pointer "MYSQL_STMT"))
     2111
     2112;;
     2113
     2114(define-foreign-enum (mysql-stmt-state (enum "enum_mysql_stmt_state"))
     2115  #f  ; No aliases!
     2116  MYSQL_STMT_INIT_DONE
     2117  MYSQL_STMT_PREPARE_DONE
     2118  MYSQL_STMT_EXECUTE_DONE
     2119  MYSQL_STMT_FETCH_DONE )
     2120
     2121(gen-public-enum mysql-stmt-state
     2122  MYSQL_STMT_INIT_DONE
     2123  MYSQL_STMT_PREPARE_DONE
     2124  MYSQL_STMT_EXECUTE_DONE
     2125  MYSQL_STMT_FETCH_DONE )
     2126
     2127(define-foreign-enum (mysql-stmt-attr-type (enum "enum_stmt_attr_type"))
     2128  #f  ; No aliases!
     2129  STMT_ATTR_UPDATE_MAX_LENGTH
     2130  STMT_ATTR_CURSOR_TYPE
     2131  STMT_ATTR_PREFETCH_ROWS )
     2132
     2133(gen-public-enum mysql-stmt-attr-type
     2134  STMT_ATTR_UPDATE_MAX_LENGTH
     2135  STMT_ATTR_CURSOR_TYPE
     2136  STMT_ATTR_PREFETCH_ROWS )
     2137
     2138(define-foreign-enum (mysql-status-return-code unsigned-int)
     2139  #f  ; No aliases!
     2140  MYSQL_NO_DATA
     2141  MYSQL_DATA_TRUNCATED )
     2142
     2143(gen-public-enum mysql-status-return-code
     2144  MYSQL_NO_DATA
     2145  MYSQL_DATA_TRUNCATED )
     2146
     2147;;
     2148
     2149;MYSQL_STMT *mysql_stmt_init(MYSQL *mysql)
     2150(define foreign-mysql-stmt-init
     2151  (foreign-lambda mysql-stmt-ptr "mysql_stmt_init" mysql-ptr))
     2152
     2153;my_bool mysql_stmt_close(MYSQL_STMT *mysql)
     2154(define foreign-mysql-stmt-close
     2155        (foreign-lambda my-bool "mysql_stmt_close" mysql-stmt-ptr))
     2156
     2157;my_bool mysql_stmt_bind_param(MYSQL_STMT *stmt, MYSQL_BIND *bind)
     2158(define foreign-mysql-stmt-bind-param
     2159        (foreign-lambda my-bool "mysql_stmt_bind_param" mysql-stmt-ptr mysql-bind-ptr))
     2160
     2161;my_bool mysql_stmt_bind_result(MYSQL_STMT *stmt, MYSQL_BIND *bind)
     2162(define foreign-mysql-stmt-bind-result
     2163        (foreign-lambda my-bool "mysql_stmt_bind_result" mysql-stmt-ptr mysql-bind-ptr))
     2164
     2165;int mysql_stmt_execute(MYSQL_STMT *stmt)
     2166(define foreign-mysql-stmt-execute
     2167        (foreign-lambda int "mysql_stmt_execute" mysql-stmt-ptr))
     2168
     2169;int mysql_stmt_fetch(MYSQL_STMT *stmt)
     2170(define foreign-mysql-stmt-fetch
     2171        (foreign-lambda int "mysql_stmt_fetch" mysql-stmt-ptr))
     2172
     2173;int mysql_stmt_prepare(MYSQL_STMT *stmt, const char *query, unsigned long length)
     2174(define foreign-mysql-stmt-prepare
     2175        (foreign-lambda int "mysql_stmt_prepare" mysql-stmt-ptr c-string unsigned-long))
     2176
     2177;int mysql_stmt_fetch_column(MYSQL_STMT *stmt, MYSQL_BIND *bind_arg, unsigned int column, unsigned long offset)
     2178(define foreign-mysql-stmt-fetch-column
     2179        (foreign-lambda int "mysql_stmt_fetch_column" mysql-stmt-ptr mysql-bind-ptr unsigned-int unsigned-long))
     2180
     2181;int mysql_stmt_store_result(MYSQL_STMT *stmt)
     2182(define foreign-mysql-stmt-store-result
     2183        (foreign-lambda int "mysql_stmt_store_result" mysql-stmt-ptr))
     2184
     2185;unsigned long mysql_stmt_param_count(MYSQL_STMT * stmt)
     2186(define foreign-mysql-stmt-param-count
     2187        (foreign-lambda unsigned-long "mysql_stmt_param_count" mysql-stmt-ptr))
     2188
     2189;my_bool mysql_stmt_attr_set(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, const void *attr)
     2190(define foreign-mysql-stmt-attr-set
     2191        (foreign-lambda my-bool "mysql_stmt_attr_set" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
     2192
     2193;my_bool mysql_stmt_attr_get(MYSQL_STMT *stmt, enum enum_stmt_attr_type attr_type, void *attr)
     2194(define foreign-mysql-stmt-attr-get
     2195        (foreign-lambda my-bool "mysql_stmt_attr_get" mysql-stmt-ptr mysql-stmt-attr-type c-pointer))
     2196
     2197#>
     2198static my_bool
     2199mysqlaux_stmt_attr_set_bool (MYSQL_STMT *stmt, enum enum_stmt_attr_type attr, my_bool value)
     2200{
     2201  return (mysql_stmt_attr_set (stmt, attr, &value));
     2202}
     2203
     2204static my_bool
     2205mysqlaux_stmt_attr_set_ulong (MYSQL_STMT *stmt, enum enum_stmt_attr_type attr, unsigned long value)
     2206{
     2207  return (mysql_stmt_attr_set (stmt, attr, &value));
     2208}
     2209<#
     2210
     2211(define foreign-mysqlaux-stmt-attr-set-bool
     2212  (foreign-lambda int "mysqlaux_stmt_attr_set_bool"
     2213                      mysql-stmt-ptr mysql-stmt-attr-type my-bool) )
     2214
     2215(define foreign-mysqlaux-stmt-attr-set-ulong
     2216  (foreign-lambda int "mysqlaux_stmt_attr_set_ulong"
     2217                      mysql-stmt-ptr mysql-stmt-attr-type unsigned-long) )
     2218
     2219;my_bool mysql_stmt_reset(MYSQL_STMT * stmt)
     2220(define foreign-mysql-stmt-reset
     2221        (foreign-lambda my-bool "mysql_stmt_reset" mysql-stmt-ptr))
     2222
     2223;my_bool mysql_stmt_free_result(MYSQL_STMT *stmt)
     2224(define foreign-mysql-stmt-free-result
     2225        (foreign-lambda my-bool "mysql_stmt_free_result" mysql-stmt-ptr))
     2226
     2227;my_bool mysql_stmt_send_long_data(MYSQL_STMT *stmt, unsigned-int param_number, const char *data, unsigned long length)
     2228(define foreign-mysql-stmt-send-long-data
     2229        (foreign-lambda my-bool "mysql_stmt_send_long_data" mysql-stmt-ptr unsigned-int c-pointer unsigned-long))
     2230
     2231;MYSQL_RES *mysql_stmt_result_metadata(MYSQL_STMT *stmt)
     2232(define foreign-mysql-stmt-result-metadata
     2233        (foreign-lambda mysql-res-ptr "mysql_stmt_result_metadata" mysql-stmt-ptr))
     2234
     2235;MYSQL_RES *mysql_stmt_param_metadata(MYSQL_STMT *stmt)
     2236(define foreign-mysql-stmt-param-metadata
     2237        (foreign-lambda mysql-res-ptr "mysql_stmt_param_metadata" mysql-stmt-ptr))
     2238
     2239;unsigned int mysql_stmt_errno(MYSQL_STMT * stmt)
     2240(define foreign-mysql-stmt-errno
     2241        (foreign-lambda unsigned-int "mysql_stmt_errno" mysql-stmt-ptr))
     2242
     2243;const char *mysql_stmt_error(MYSQL_STMT * stmt)
     2244(define foreign-mysql-stmt-error
     2245        (foreign-lambda c-string "mysql_stmt_error" mysql-stmt-ptr))
     2246
     2247;const char *mysql_stmt_sqlstate(MYSQL_STMT * stmt)
     2248(define foreign-mysql-stmt-sqlstate
     2249        (foreign-lambda c-string "mysql_stmt_sqlstate" mysql-stmt-ptr))
     2250
     2251;MYSQL_ROW_OFFSET mysql_stmt_row_seek(MYSQL_STMT *stmt, MYSQL_ROW_OFFSET offset)
     2252(define foreign-mysql-stmt-row-seek
     2253        (foreign-lambda mysql-row-offset "mysql_stmt_row_seek" mysql-stmt-ptr mysql-row-offset))
     2254
     2255;MYSQL_ROW_OFFSET mysql_stmt_row_tell(MYSQL_STMT *stmt)
     2256(define foreign-mysql-stmt-row-tell
     2257        (foreign-lambda mysql-row-offset "mysql_stmt_row_tell" mysql-stmt-ptr))
     2258
     2259#>
     2260static void
     2261mysqlaux_stmt_data_seek (MYSQL_STMT *stmt, double offset)
     2262{
     2263  mysql_stmt_data_seek (stmt, (my_ulonglong) offset);
     2264}
     2265
     2266static double
     2267mysqlaux_stmt_num_rows (MYSQL_STMT *stmt)
     2268{
     2269  return ((double) mysql_stmt_num_rows (stmt));
     2270}
     2271
     2272static double
     2273mysqlaux_stmt_affected_rows (MYSQL_STMT *stmt)
     2274{
     2275  return ((double) mysql_stmt_affected_rows (stmt));
     2276}
     2277
     2278static double
     2279mysqlaux_stmt_insert_id (MYSQL_STMT *stmt)
     2280{
     2281  return ((double) mysql_stmt_insert_id (stmt));
     2282}
     2283<#
     2284
     2285;void mysql_stmt_data_seek(MYSQL_STMT *stmt, my_ulonglong offset)
     2286(define foreign-mysql-stmt-data-seek
     2287        (foreign-lambda void "mysqlaux_stmt_data_seek" mysql-stmt-ptr my-ulonglong))
     2288
     2289;my_ulonglong mysql_stmt_num_rows(MYSQL_STMT *stmt)
     2290(define foreign-mysql-stmt-num-rows
     2291        (foreign-lambda my-ulonglong "mysqlaux_stmt_num_rows" mysql-stmt-ptr))
     2292
     2293;my_ulonglong mysql_stmt_affected_rows(MYSQL_STMT *stmt)
     2294(define foreign-mysql-stmt-affected-rows
     2295        (foreign-lambda my-ulonglong "mysqlaux_stmt_affected_rows" mysql-stmt-ptr))
     2296
     2297;my_ulonglong mysql_stmt_insert_id(MYSQL_STMT *stmt)
     2298(define foreign-mysql-stmt-insert-id
     2299        (foreign-lambda my-ulonglong "mysqlaux_stmt_insert_id" mysql-stmt-ptr))
     2300
     2301;unsigned int mysql_stmt_field_count(MYSQL_STMT *stmt)
     2302(define foreign-mysql-stmt-field-count
     2303        (foreign-lambda unsigned-int "mysql_stmt_field_count" mysql-stmt-ptr))
     2304
     2305;;
     2306
     2307(define-foreign-record (mysql-bind "MYSQL_BIND")
     2308  (rename: c-name->scheme-name)
     2309  ; special ctor
     2310  (destructor: free-mysql-bind)
     2311  ((c-pointer "unsigned long") length)    ; output length pointer
     2312  ((c-pointer "my_bool") is_null)                   ; Pointer to null indicator
     2313  (c-pointer buffer)                      ; buffer to get/put data
     2314  ((c-pointer "my_bool") error)                 ; set this if you want to track data truncations happened during fetch
     2315  (unsigned-long buffer_length)           ; output buffer length, must be set when fetching str/binary
     2316  (mysql-type buffer_type)                          ; buffer type
     2317  (my-bool error_value)                         ; used if error is 0
     2318  (my-bool is_unsigned)                         ; set if integer type is unsigned
     2319  (my-bool is_null_value) )               ; Used if is_null is 0
     2320
     2321(define (allocate-mysql-bind cnt)
     2322  ((foreign-lambda* mysql-bind-ptr ((unsigned-integer cnt))
     2323   "return ((1 <= cnt) ? ((MYSQL_BIND *) calloc (cnt, sizeof(MYSQL_BIND))) : NULL);")
     2324  cnt) )
     2325
     2326(define (mysql-bind-ref bindptr idx)
     2327  ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
     2328   "return (&(ptr[idx]));")
     2329   bindptr idx) )
     2330
     2331(define (mysql-bind-clear! bindptr idx)
     2332  ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
     2333   "memset (&(ptr[idx]), 0, sizeof(MYSQL_BIND));")
     2334   bindptr idx) )
     2335
     2336(define (allocate-mysql-bind-slots bindptr len is-null error)
     2337  ((foreign-lambda* void ((mysql-bind-ptr bind) (unsigned-integer len)
     2338                          (my-bool is_null) (my-bool error))
     2339#<<END
     2340    typedef struct {
     2341      unsigned long length;
     2342      my_bool is_null;
     2343      my_bool error;
     2344      C_word buffer[1];
     2345    } bind_slots;
     2346    size_t siz = (sizeof(bind_slots) - sizeof(((bind_slots *)0)->buffer))
     2347                  + (((len / sizeof (C_word)) + (len % sizeof (C_word))) * sizeof (C_word));
     2348    bind_slots * ptr = ((bind_slots *) malloc (siz));
     2349    memset (ptr, 0, siz);
     2350    bind->buffer = (char *) &(ptr->buffer);
     2351    bind->buffer_length = len;
     2352    ptr->is_null = is_null;
     2353    bind->is_null = &(ptr->is_null);
     2354    ptr->length = len;
     2355    bind->length = &(ptr->length);
     2356    ptr->error = error;
     2357    bind->error = &(ptr->error);
     2358END
     2359   )
     2360     bindptr len is-null error) )
     2361
     2362(define (%mysql-foreign-type-length foreign-type #!optional (obj (void)))
     2363 (void) )
     2364
     2365(define (%mysql-determine-type obj is-unsigned is-null)
     2366 (void) )
     2367
     2368(define (%mysql-determine-foreign-type type is-unsigned is-null)
     2369 (void) )
     2370
     2371(define (mysql-bind-param-init-direct bindptr idx obj #!key type is-unsigned is-null error)
     2372  (mysql-bind-clear! bindptr idx)
     2373  (unless type
     2374    (let-values ([(typ uflg nflg) (%mysql-determine-type obj is-unsigned is-null)])
     2375      (set! type typ)
     2376      (set! is-unsigned uflg)
     2377      (set! is-null nflg) ) )
     2378  (when (and (mysql-null-object? obj) (not (eqv? mysql-type-null type)))
     2379    (warning "null object implies null type")
     2380    (set! type mysql-type-null) )
     2381  (mysql-bind-buffer-type-set! bindptr type)
     2382  (unless (eqv? mysql-type-null type)
     2383    (mysql-bind-is-unsigned-set! bindptr is-unsigned)
     2384    (let* ([foreign-type (%mysql-determine-foreign-type type is-unsigned is-null)]
     2385           [len (%mysql-foreign-type-length foreign-type obj)])
     2386      (allocate-mysql-bind-slots bindptr len is-null error) ) ) )
     2387
     2388(define (mysql-bind-result-init-direct bindptr idx type #!optional len)
     2389  (mysql-bind-clear! bindptr idx)
     2390  (mysql-bind-buffer-type-set! bindptr type)
     2391  (unless (eqv? mysql-type-null type)
     2392    (let* ([foreign-type (%mysql-determine-foreign-type type #f #f)]
     2393           [len (or len
     2394                    (%mysql-foreign-type-length foreign-type))])
     2395      (allocate-mysql-bind-slots bindptr len #f #f) ) ) )
     2396
     2397;;
     2398
     2399; (mysql-bind-param-init
     2400;   (list obj #:key T #:is-unsigned B #:is-null B #:error B)
     2401;   ...
     2402;   (list obj #:key T #:is-unsigned B #:is-null B #:error B))
     2403
     2404(define (mysql-bind-param-init . inits)
     2405  (let ([bindptr (allocate-mysql-bind (length inits))])
     2406    (let loop ([inits inits] [idx 0])
     2407      (if (null? inits)
     2408          bindptr
     2409          (begin
     2410            (apply mysql-bind-param-init-direct bindptr idx (car inits))
     2411            (loop (cdr inits) (+ idx 1)) ) ) ) ) )
     2412
     2413; (mysql-bind-result-init
     2414;   (list T #:len I)
     2415;   ...
     2416;   (list T #:len I))
     2417
     2418(define (mysql-bind-result-init conn . inits)
     2419  (let ([bindptr (allocate-mysql-bind (length inits))])
     2420    (let loop ([inits inits] [idx 0])
     2421      (if (null? inits)
     2422          bindptr
     2423          (begin
     2424            (apply mysql-bind-result-init-direct bindptr idx (car inits))
     2425            (loop (cdr inits) (+ idx 1)) ) ) ) ) )
     2426
     2427;;
     2428
     2429#;
     2430(define (mysql-bind-result->object bindptr)
     2431  (void) )
     2432
     2433;;
     2434
     2435(define (%mysql-stmt-attr-set stmtptr attr val)
     2436  (cond [(boolean? val)
     2437          (foreign-mysqlaux-stmt-attr-set-bool stmtptr attr val)]
     2438        [(number? val)
     2439          (foreign-mysqlaux-stmt-attr-set-ulong stmtptr attr val)]
     2440        [else
     2441          #t ] ) )
     2442
     2443(define (%mysql-stmt-attr-get stmtptr attr)
     2444  (select attr
     2445    [(stmt-attr-cursor-type stmt-attr-prefetch-rows)
     2446      (let-location ([val unsigned-long])
     2447        (foreign-mysql-stmt-attr-get stmtptr attr #$val)
     2448        val ) ]
     2449    [(stmt-attr-update-max-length)
     2450      (let-location ([val my-bool])
     2451        (foreign-mysql-stmt-attr-get stmtptr attr #$val)
     2452        val ) ]
     2453    [else
     2454      (void) ] ) )
     2455
     2456(define (%mysql-free-bind conn)
     2457  (and-let* ([bindptr (mysql-connection-binding conn)])
     2458    (free-mysql-bind bindptr)
     2459    (mysql-connection-binding-set! conn #f) ) )
     2460
     2461(define (%mysql-stmt-close conn)
     2462  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2463    (mysql-connection-statement-set! conn #f)
     2464    (%mysql-free-bind conn) ; free any result/param binding
     2465    (when (foreign-mysql-stmt-close stmtptr)
     2466      (signal-mysql-stmt-error 'mysql-stmt-close conn) ) ) )
     2467
     2468;;
     2469
     2470(define (mysql-null-object? obj)
     2471  (void) )
     2472
     2473;;
     2474
     2475(define (signal-mysql-stmt-error loc conn . args)
     2476  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2477    (let ([err (or (mysql-stmt-error stmtptr)
     2478                   (mysql-stmt-errno stmtptr))]
     2479          [sta (mysql-stmt-sqlstate conn)])
     2480      (apply signal-mysql-condition loc
     2481                                    (string-append err
     2482                                                   (if sta
     2483                                                      (string-append " - " sta)
     2484                                                      ""))
     2485                                    conn args) ) ) )
     2486
     2487;-----------------------------------------------------------------------
     2488; The statement MySQL/Scheme API.
     2489;
     2490; This API provides some additional functionality.
     2491;
     2492
     2493(define (mysql-stmt-errno conn)
     2494  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2495    (foreign-mysql-stmt-errno stmtptr) ) )
     2496
     2497; Returns a string describing the last mysql stmt error, or #f if no error
     2498; has occurred.
     2499(define (mysql-stmt-error conn)
     2500  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2501    (let ([errstr (foreign-mysql-stmt-error stmtptr)])
     2502      (and (not (string=? "" errstr))
     2503           errstr ) ) ) )
     2504
     2505; Returns a string describing the last mysql stmt state error, or #f if no error
     2506; has occurred.
     2507(define (mysql-stmt-sqlstate conn)
     2508  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2509    (let ([errstr (foreign-mysql-stmt-sqlstate stmtptr)])
     2510      (and (not (or (string=? "00000" errstr)
     2511                    (string=? "HY000" errstr)))
     2512           errstr ) ) ) )
     2513
     2514(define (mysql-stmt-init conn)
     2515  (%mysql-stmt-close conn)
     2516  (let ([stmtptr (foreign-mysql-stmt-init (mysql-connection-ptr conn))])
     2517    (if stmtptr
     2518        (mysql-connection-statement-set! conn stmtptr)
     2519        (signal-mysql-condition 'mysql-stmt-init "out of memory") ) ) )
     2520
     2521(define (mysql-stmt-prepare conn sql)
     2522  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2523    (unless (zero? (foreign-mysql-stmt-prepare stmtptr sql (string-length sql)))
     2524      (signal-mysql-stmt-error 'mysql-stmt-prepare stmtptr) ) ) )
     2525
     2526(define (mysql-stmt-param-count conn)
     2527  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2528    (foreign-mysql-stmt-param-count stmtptr) ) )
     2529
     2530(define (mysql-stmt-bind-param conn bindptr)
     2531  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2532    #; ;This souldn't be necessary
     2533    (%mysql-free-bind conn)
     2534    (if (foreign-mysql-stmt-bind-param stmtptr bindptr)
     2535        (signal-mysql-stmt-error 'mysql-stmt-bind-param stmtptr)
     2536        (mysql-connection-binding-set! conn bindptr) ) ) )
     2537
     2538(define (mysql-stmt-execute conn)
     2539  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2540    (unless (zero? (foreign-mysql-stmt-execute stmtptr))
     2541      (signal-mysql-stmt-error 'mysql-stmt-execute stmtptr) ) ) )
     2542
     2543(define (mysql-stmt-affected-rows conn)
     2544  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2545    (let ([cnt (foreign-mysql-stmt-affected-rows stmtptr)])
     2546      (and (not (= -1 cnt))
     2547           cnt ) ) ) )
     2548
     2549(define (mysql-stmt-bind-result conn bindptr)
     2550  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2551    (%mysql-free-bind conn) ; free the param bindings
     2552    (if (foreign-mysql-stmt-bind-result stmtptr bindptr)
     2553        (signal-mysql-stmt-error 'mysql-stmt-bind-result stmtptr)
     2554        (mysql-connection-binding-set! conn bindptr) ) ) )
     2555
     2556; returns boolean for success, mysql-data-truncated, or signals
     2557; an exception.
     2558(define (mysql-stmt-fetch conn)
     2559  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2560    (let ([val (foreign-mysql-stmt-fetch stmtptr)])
     2561      (cond [(zero? val)
     2562              #t]
     2563            [(= mysql-no-data val)
     2564              #f]
     2565            [(= mysql-data-truncated val)
     2566              mysql-data-truncated]
     2567            [(= 1 val)
     2568              (signal-mysql-stmt-error 'mysql-stmt-fetch stmtptr) ] ) ) ) )
     2569
     2570; causes the result to be buffered. does not touch the connection
     2571; result!
     2572(define (mysql-stmt-store-result conn)
     2573  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2574    (when (zero? (foreign-mysql-stmt-store-result stmtptr))
     2575      (signal-mysql-stmt-error 'mysql-stmt-store-result stmtptr) ) ) )
     2576
     2577; can only be invoked after a stmt-store-result and stmt-fetch.
     2578(define (mysql-stmt-result-metadata conn)
     2579  (mysql-free-result conn)
     2580  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2581    (let ([resptr (foreign-mysql-stmt-result-metadata stmtptr)])
     2582      (if resptr
     2583          (begin
     2584            (mysql-connection-result-set! conn resptr)
     2585            (mysql-connection-result-start-set! conn
     2586              (foreign-mysql-stmt-row-tell (mysql-connection-result conn))) )
     2587          (signal-mysql-stmt-error 'mysql-stmt-result-metadata stmtptr) ) ) ) )
     2588
     2589(define (mysql-stmt-attr-set conn attr val)
     2590  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2591    (when (%mysql-stmt-attr-set stmtptr attr val)
     2592      (signal-mysql-condition 'stmt-attr-set
     2593                              "unknown statement attribute" attr val) ) ) )
     2594
     2595(define (mysql-stmt-attr-get conn attr)
     2596  (and-let* ([stmtptr (mysql-connection-statement conn)])
     2597    (let ([val (%mysql-stmt-attr-get stmtptr attr)])
     2598      (if (eq? (void) val)
     2599          (signal-mysql-condition 'stmt-attr-get
     2600                                   "unknown statement attribute" attr)
     2601          val ) ) ) )
     2602
     2603;-----------------------------------------------------------------------
     2604; The statement "extended" MySQL/Scheme API.
     2605;
     2606; This API provides some additional functionality.
     2607;
     2608
     2609; rewinds to the beginning of the result set. has no effect if there is no
     2610; current result set.
     2611(define (mysql-stmt-rewind conn)
     2612  (and-let* ([stmtptr (mysql-connection-statement conn)]
     2613             [resptr (mysql-connection-result-start conn)])
     2614    (foreign-mysql-stmt-row-seek stmtptr resptr) ) )
     2615
     2616; returns a procedure, or #f when no connection.
     2617; the procedure takes a parameter index and returns the
     2618; the mysql-bind-ptr of the mysql-bind record, of #f
     2619; when no more rows to fetch.
     2620(define (mysql-stmt-row-fetch conn)
     2621  (and-let* ([resptr (mysql-connection-result conn)]
     2622             [bindptr (mysql-connection-binding conn)]
     2623             [(mysql-stmt-fetch conn)])
     2624    (let ([fldcnt (mysql-num-fields conn)])
     2625      (lambda (field)
     2626        (and-let* ([fldidx (%mysql-get-field-index resptr field fldcnt)])
     2627          (mysql-bind-ref bindptr fldidx) ) ) ) ) )
     2628
     2629;
     2630(define (mysql-stmt-query conn query params #!optional results)
     2631  (mysql-stmt-prepare conn query)
     2632  (mysql-stmt-bind-param conn params)
     2633  (mysql-stmt-execute conn)
     2634  (when results
     2635    (mysql-stmt-result-metadata conn)
     2636    (mysql-stmt-bind-result conn results) ) )
     2637
     2638;-----------------------------------------------------------------------
     2639; The statement "map" MySQL/Scheme API.
     2640;
     2641; This API provides some additional functionality for traversing results
     2642; in a Scheme-ish way.
     2643;
     2644
     2645; calls proc on every row in the current result set. proc should take 3
     2646; arguments: the row (as described for mysql-stmt-row-fetch), the row index
     2647; (which starts with 1 and ends with (mysql-stmt-num-rows conn)), and the
     2648; current accumulated value.
     2649;
     2650; returns the final accumulated value.
     2651;
     2652; note: rewinds the result set before and after iterating over it; thus,
     2653; all rows are included.
     2654;
     2655; you must call mysql-stmt-rewind if you later want to iterate over the result set
     2656; using mysql-stmt-row-fetch.
     2657(define (mysql-stmt-row-fold conn proc init)
     2658  (mysql-stmt-rewind conn)
     2659  (let loop ([rownum 1] [acc init])
     2660    (let ([row (mysql-stmt-row-fetch conn)])
     2661      (if row
     2662          (loop (+ rownum 1) (proc row rownum acc))
     2663          acc ) ) ) )
     2664
     2665; calls proc on every row in the current result set. proc should take 2
     2666; arguments: the row (as described for mysql-stmt-row-fetch) and the row index
     2667; (which starts with 1 and ends with (mysql-stmt-num-rows conn)).
     2668;
     2669; note: rewinds the result set before and after iterating over it; thus,
     2670; all rows are included.
     2671;
     2672; you must call mysql-stmt-rewind if you later want to iterate over the result set
     2673; using mysql-stmt-row-fetch.
     2674(define (mysql-stmt-row-for-each conn proc)
     2675  (mysql-stmt-row-fold conn
     2676                       (lambda (row rownum _) (proc row rownum))
     2677                       #t) )
     2678
     2679; calls proc on every row in the current result set. proc should take 2
     2680; arguments: the row (as described for mysql-stmt-row-fetch) and the row index
     2681; (which starts with 1 and ends with (mysql-stmt-num-rows conn)).
     2682;
     2683; returns a list of the results of each proc invocation.
     2684;
     2685; note: rewinds the result set before and after iterating over it; thus,
     2686; all rows are included.
     2687;
     2688; you must call mysql-stmt-rewind if you later want to iterate over the result set
     2689; using mysql-stmt-row-fetch.
     2690(define (mysql-stmt-row-map conn proc)
     2691  (reverse!
     2692    (mysql-stmt-row-fold conn
     2693                         (lambda (row rownum lst) (cons (proc row rownum) lst))
     2694                         '())) )
     2695
     2696; executes query and then mysql-row-for-each with the given proc. the proc
     2697; must meet the contract specified for the proc passed to mysql-stmt-row-fold.
     2698(define (mysql-stmt-query-fold conn query proc init params #!optional results)
     2699  (mysql-stmt-query conn query params results)
     2700  (mysql-stmt-row-fold conn proc init) )
     2701
     2702; executes query and then mysql-row-for-each with the given proc. the proc
     2703; must meet the contract specified for the proc passed to mysql-stmt-row-for-each.
     2704(define (mysql-stmt-query-for-each conn query proc params #!optional results)
     2705  (mysql-stmt-query conn query params results)
     2706  (mysql-stmt-row-for-each conn proc) )
     2707
     2708; executes query and then mysql-row-for-each with the given proc. the proc
     2709; must meet the contract specified for the proc passed to mysql-stmt-row-map.
     2710(define (mysql-stmt-query-map conn query proc params #!optional results)
     2711  (mysql-stmt-query conn query params results)
     2712  (mysql-stmt-row-map conn proc) )
    20942713|#
    20952714
    2096 #|
    2097 ;allocate-myysql-bind
    2098 ;allocate-myysql-stmt
    2099 ;allocate-myysql-time
    2100 ;free-mysql-bind
    2101 ;free-mysql-stmt
    2102 ;free-mysql-time
    2103 
    2104 ;;
    2105 stmt-attr-cursor-type
    2106 stmt-attr-prefetch-rows
    2107 stmt-attr-update-max-length
    2108 ;
    2109 mysql-stmt-attr-type-symbol
    2110 mysql-stmt-attr-type-value
    2111 
    2112 ;;
    2113 mysql-timestamp-date
    2114 mysql-timestamp-datetime
    2115 mysql-timestamp-error
    2116 mysql-timestamp-none
    2117 mysql-timestamp-time
    2118 ;
    2119 mysql-timestamp-type-symbol
    2120 mysql-timestamp-type-value
    2121 
    2122 ;;
    2123 mysql-stmt-init-done
    2124 mysql-stmt-execute-done
    2125 mysql-stmt-prepare-done
    2126 mysql-stmt-fetch-done
    2127 ;
    2128 mysql-stmt-state-symbol
    2129 mysql-stmt-state-value
    2130 
    2131 ;;
    2132 foreign-mysql-stmt-affected-rows
    2133 foreign-mysql-stmt-attr-get
    2134 foreign-mysql-stmt-attr-set
    2135 foreign-mysql-stmt-bind-param
    2136 foreign-mysql-stmt-bind-result
    2137 foreign-mysql-stmt-close
    2138 foreign-mysql-stmt-data-seek
    2139 foreign-mysql-stmt-errno
    2140 foreign-mysql-stmt-error
    2141 foreign-mysql-stmt-execute
    2142 foreign-mysql-stmt-fetch
    2143 foreign-mysql-stmt-fetch-column
    2144 foreign-mysql-stmt-field-count
    2145 foreign-mysql-stmt-free-result
    2146 foreign-mysql-stmt-init
    2147 foreign-mysql-stmt-insert-id
    2148 foreign-mysql-stmt-num-rows
    2149 foreign-mysql-stmt-param-count
    2150 foreign-mysql-stmt-param-metadata
    2151 foreign-mysql-stmt-prepare
    2152 foreign-mysql-stmt-reset
    2153 foreign-mysql-stmt-result-metadata
    2154 foreign-mysql-stmt-row-seek
    2155 foreign-mysql-stmt-row-tell
    2156 foreign-mysql-stmt-send-long-data
    2157 foreign-mysql-stmt-sqlstate
    2158 foreign-mysql-stmt-store-result
    2159 
    2160 ;;
    2161 mysql-bind-buffer-set!
    2162 mysql-bind-buffer-length-set!
    2163 mysql-bind-buffer-type-set!
    2164 mysql-bind-error-set!
    2165 mysql-bind-error-value-set!
    2166 mysql-bind-is-null-set!
    2167 mysql-bind-is-null-value-set!
    2168 mysql-bind-is-unsigned-set!
    2169 mysql-bind-length-set!
    2170 ;
    2171 mysql-bind-buffer
    2172 mysql-bind-buffer-length
    2173 mysql-bind-buffer-type
    2174 mysql-bind-error
    2175 mysql-bind-error-value
    2176 mysql-bind-is-null
    2177 mysql-bind-is-null-value
    2178 mysql-bind-is-unsigned
    2179 mysql-bind-length
    2180 
    2181 ;;
    2182 mysql-time-day-set!
    2183 mysql-time-hour-set!
    2184 mysql-time-minute-set!
    2185 mysql-time-month-set!
    2186 mysql-time-neg-set!
    2187 mysql-time-second-part-set!
    2188 mysql-time-second-set!
    2189 mysql-time-time-type-set!
    2190 mysql-time-year-set!
    2191 ;
    2192 mysql-time-day
    2193 mysql-time-hour
    2194 mysql-time-minute
    2195 mysql-time-month
    2196 mysql-time-neg
    2197 mysql-time-second
    2198 mysql-time-second-part
    2199 mysql-time-time-type
    2200 mysql-time-year
    2201 |#
     2715
Note: See TracChangeset for help on using the changeset viewer.