Changeset 9012 in project


Ignore:
Timestamp:
02/26/08 02:40:10 (12 years ago)
Author:
Kon Lovett
Message:

Save

Location:
release/3/mysql/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/mysql/trunk/mysql-eggdoc.scm

    r8191 r9012  
    5555    (description (p "MySQL bindings for Chicken."))
    5656    (author (url "mailto:toby@butzon.com" "Toby Butzon"))
    57     (history
    58       (version "1.31" "Additional functions & special handling of binary column. [Kon Lovett]")
    59       (version "1.3" "Additional functions. [Kon Lovett]")
    60       (version "1.2" "Fix for ticket #297. [Mario Domenech Goulart]")
    61       (version "1.1" "Cross-platform compilation fixes, et al.")
    62       (version "1.0" "Initial release") )
    6357    (requires (span "MySQL client library (" (tt "-lmysqlclient") ")"))
    6458    (usage)
     
    854848    ) ; section "Bugs"
    855849
     850    (history
     851      (version "1.31" "Additional functions & special handling of binary column. [Kon Lovett]")
     852      (version "1.3" "Additional functions. [Kon Lovett]")
     853      (version "1.2" "Fix for ticket #297. [Mario Domenech Goulart]")
     854      (version "1.1" "Cross-platform compilation fixes, et al.")
     855      (version "1.0" "Initial release") )
     856
    856857    (license ,license-text)
    857858  ) ; eggdoc:begin
  • release/3/mysql/trunk/mysql.scm

    r8194 r9012  
    727727;
    728728
    729 #>
    730 static int
    731 mysqlaux_field_index (MYSQL_RES *result, const char *name, unsigned int num_fields)
    732 {
    733         MYSQL_FIELD *fields = mysql_fetch_fields (result);
     729(define foreign-mysqlaux-field-index
     730        (foreign-lambda* int ((mysql-res-ptr result) (nonnull-c-string name)
     731                              (unsigned-integer num_fields))
     732#<<EOS
     733        MYSQL_FIELD *fields = mysql_fetch_fields(result);
    734734        unsigned int i;
    735735
    736736        for (i = 0; i < num_fields; i++) {
    737                 if (0 == strcasecmp (name, fields[i].name)) {
     737                if (0 == strcasecmp(name, fields[i].name)) {
    738738                        return (i);
    739739                }
     
    741741
    742742        return (-1);
    743 }
    744 
    745 static int
    746 mysqlaux_is_binary_field (MYSQL_RES *result, unsigned int fldidx)
    747 {
    748         MYSQL_FIELD *fields = mysql_fetch_fields (result);
     743EOS
     744  ) )
     745
     746(define foreign-mysqlaux-is-binary-field
     747        (foreign-lambda* bool ((mysql-res-ptr result) (unsigned-integer fldidx))
     748#<<EOS
     749        MYSQL_FIELD *fields = mysql_fetch_fields(result);
    749750
    750751        switch (fields[fldidx].type) {
     
    758759                        return (63 == fields[fldidx].charsetnr);
    759760                default:
    760                  break;
     761                  break;
    761762        }
    762763
    763764        return (0);
    764 }
    765 
    766 static char *
    767 mysqlaux_fetch_column_data_direct (MYSQL_ROW row, unsigned int fldidx)
    768 {
    769         return (row[fldidx]);
    770 }
    771 <#
    772 
    773 (define foreign-mysqlaux-field-index
    774         (foreign-lambda int "mysqlaux_field_index" mysql-res-ptr
    775                                                                                                                                                                                  nonnull-c-string unsigned-integer))
    776 
    777 (define foreign-mysqlaux-is-binary-field
    778         (foreign-lambda bool "mysqlaux_is_binary_field"
    779                                                                                                 mysql-res-ptr unsigned-integer))
     765EOS
     766  ) )
    780767
    781768(define foreign-mysqlaux-fetch-column-string-direct
    782         (foreign-lambda c-string "mysqlaux_fetch_column_data_direct"
    783                                                                                                                 mysql-row unsigned-integer))
     769        (foreign-lambda* c-string ((mysql-row row) (unsigned-integer fldidx))
     770         "return (row[fldidx]);" ) )
    784771
    785772(define foreign-mysqlaux-fetch-column-data-direct
    786         (foreign-lambda c-pointer "mysqlaux_fetch_column_data_direct"
    787                                                                                                                  mysql-row unsigned-integer))
     773        (foreign-lambda* c-pointer ((mysql-row row) (unsigned-integer fldidx))
     774         "return (row[fldidx]);" ) )
    788775
    789776;-----------------------------------------------------------------------
     
    11301117
    11311118(define (unsigned-long-array->u32vector ulptr cnt)
    1132         (let* ([siz (* cnt UNSIGNED-LONG-SIZE)]
     1119        (let* ([siz (fx* cnt UNSIGNED-LONG-SIZE)]
    11331120                                 [store (make-blob siz)])
    11341121                (move-memory! ulptr store siz)
     
    12681255        (make-mysql-connection host user passwd db port unix-socket
    12691256                                                                                                 client-flag ptr result result-start ssl opts
    1270                                                                                                  #;stmt #;bind)
     1257                                                                                                 #;stmt #;bind #;slots)
    12711258        mysql-connection?
    12721259        (host mysql-connection-host)
     
    12831270        (opts mysql-connection-options)
    12841271        #;(stmt mysql-connection-statement mysql-connection-statement-set!)
    1285         #;(bind mysql-connection-binding mysql-connection-binding-set!) )
     1272        #;(bind mysql-connection-binding mysql-connection-binding-set!)
     1273        #;(slots mysql-connection-slots mysql-connection-slots-set!) )
    12861274
    12871275(define-record-printer (mysql-connection conn out)
     
    13061294                                                (record-slot->string passwd                             "passwd")
    13071295                                                (record-slot->string db                                         "db")
    1308                                                 (record-slot->string tcp-port                   "tcp-port"              (not (zero? tcp-port)))
     1296                                                (record-slot->string tcp-port                   "tcp-port"              (not (fx= 0 tcp-port)))
    13091297                                                (record-slot->string unix-socket        "unix-socket")
    1310                                                 (record-slot->string client-flag        "client-flag" (not (zero? client-flag)))
     1298                                                (record-slot->string client-flag        "client-flag" (not (fx= 0 client-flag)))
    13111299                                                (record-slot->string ssl                                        "ssl")
    13121300                                                (record-slot->string opts                                       "options")
     
    13641352                                                 (let ([opt (car optitm)]
    13651353                                                                         [val (cdr optitm)])
    1366                                                          (unless (zero? (%mysql-options mysql opt val))
     1354                                                         (unless (fx= 0 (%mysql-options mysql opt val))
    13671355                                                                 (signal-mysql-condition 'mysql-connect "unknown option" opt val))))
    13681356                                         options) )
     
    15401528        (let ([mysql-ptr (mysql-connection-ptr conn)])
    15411529                ; zero indicates success
    1542                 (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
     1530                (if (fx= 0 (foreign-mysql-real-query mysql-ptr query (string-length query)))
    15431531                                (begin (mysql-store-result conn) #t)
    15441532                                (signal-mysql-error 'mysql-query conn query) ) ) )
     
    15461534; returns #t if the select was successful, signals exception otherwise.
    15471535(define (mysql-select-db conn db)
    1548         (or (zero? (foreign-mysql-select-db (mysql-connection-ptr conn) db))
     1536        (or (fx= 0 (foreign-mysql-select-db (mysql-connection-ptr conn) db))
    15491537                        (signal-mysql-error 'mysql-select-db conn db) ) )
    15501538
    15511539; returns #t if the set was successful, signals exception otherwise.
    15521540(define (mysql-set-character-set conn csname)
    1553         (or (zero? (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
     1541        (or (fx= 0 (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
    15541542                        (signal-mysql-condition 'mysql-set-character-set "bad character set name" csname) ) )
    15551543
     
    16031591                (let ([row (mysql-fetch-row conn)])
    16041592                        (if row
    1605                                         (loop (+ rownum 1) (proc row rownum acc))
     1593                                        (loop (fx+ rownum 1) (proc row rownum acc))
    16061594                                        acc ) ) ) )
    16071595
     
    16761664
    16771665(define (mysql-field-flags-off? fldptr . flags)
    1678         (zero? (mysql-field-flags-test fldptr (mysql-field-flags-mask flags))) )
     1666        (fx= 0 (mysql-field-flags-test fldptr (mysql-field-flags-mask flags))) )
    16791667
    16801668;;
     
    19631951                mysql-bind-ref
    19641952                mysql-bind-clear!
     1953                mysql-bind-param-init-direct
     1954                mysql-bind-result-init-direct
    19651955                mysql-bind-param-init
    19661956                mysql-bind-result-init
     
    20662056(define foreign-mysqlaux-stmt-attr-set-bool
    20672057        (foreign-lambda* my-bool ((mysql-stmt-ptr stmt) (mysql-stmt-attr-type attrr) (my-bool value))
    2068    "return (mysql_stmt_attr_set (stmt, attr, &value));"))
     2058   "return (mysql_stmt_attr_set(stmt, attr, &value));"))
    20692059
    20702060(define foreign-mysqlaux-stmt-attr-set-ulong
    20712061        (foreign-lambda* my-bool ((mysql-stmt-ptr stmt) (mysql-stmt-attr-type attrr) (unsigned-long value))
    2072    "return (mysql_stmt_attr_set (stmt, attr, &value));"))
     2062   "return (mysql_stmt_attr_set(stmt, attr, &value));"))
    20732063
    20742064;my_bool mysql_stmt_reset(MYSQL_STMT * stmt)
     
    21152105(define foreign-mysql-stmt-data-seek
    21162106        (foreign-lambda* void ((mysql-stmt-ptr stmt) (my-ulonglong offset))
    2117    "mysql_stmt_data_seek (stmt, offset);"))
     2107   "mysql_stmt_data_seek(stmt, offset);"))
    21182108
    21192109;my_ulonglong mysql_stmt_num_rows(MYSQL_STMT *stmt)
    21202110(define foreign-mysql-stmt-num-rows
    21212111        (foreign-lambda* my-ulonglong ((mysql-stmt-ptr stmt))
    2122    "return ((double) mysql_stmt_num_rows (stmt));"))
     2112   "return ((double) mysql_stmt_num_rows(stmt));"))
    21232113
    21242114;my_ulonglong mysql_stmt_affected_rows(MYSQL_STMT *stmt)
    21252115(define foreign-mysql-stmt-affected-rows
    21262116        (foreign-lambda* my-ulonglong ((mysql-stmt-ptr stmt))
    2127    "return ((double) mysql_stmt_affected_rows (stmt));"))
     2117   "return ((double) mysql_stmt_affected_rows(stmt));"))
    21282118
    21292119;my_ulonglong mysql_stmt_insert_id(MYSQL_STMT *stmt)
    21302120(define foreign-mysql-stmt-insert-id
    2131         (foreign-lambda my-ulonglong ((mysql-stmt-ptr stmt))
    2132    "return ((double) mysql_stmt_insert_id (stmt));"))
     2121        (foreign-lambda* my-ulonglong ((mysql-stmt-ptr stmt))
     2122   "return ((double) mysql_stmt_insert_id(stmt));"))
    21332123
    21342124;unsigned int mysql_stmt_field_count(MYSQL_STMT *stmt)
     
    21582148(define (allocate-mysql-bind #!optional (cnt 1))
    21592149        ((foreign-lambda* mysql-bind-ptr ((unsigned-integer cnt))
    2160          "return ((1 <= cnt) ? ((MYSQL_BIND *) calloc (cnt, sizeof(MYSQL_BIND))) : NULL);")
     2150         "return ((1 <= cnt) ? ((MYSQL_BIND *) calloc(cnt, sizeof(MYSQL_BIND))) : NULL);")
    21612151        cnt) )
    21622152
    2163 ;; Zeros MYSQL_BIND at index in a c-vector or MYSQL_BIND
    2164 ;; No range checks!
    2165 
    2166 (define (mysql-bind-clear! bindptr idx)
     2153;; Zeros MYSQL_BIND
     2154
     2155(define (mysql-bind-clear! bindptr)
    21672156        ((foreign-lambda* mysql-bind-ptr ((mysql-bind-ptr ptr) (unsigned-integer idx))
    2168          "memset (&(ptr[idx]), 0, sizeof(MYSQL_BIND));")
     2157         "memset(ptr, 0, sizeof(MYSQL_BIND));")
    21692158         bindptr idx) )
    21702159
     
    21772166         bindptr idx) )
    21782167
    2179 ;; Allocates a memory block for a MYSQL_BIND value slots
     2168;; Allocates a memory block for a MYSQL_BIND & initilizes.
    21802169;; The length is byte count of the actual value representation!
    21812170
    21822171(define (allocate-mysql-bind-variables bindptr len is-null error)
    2183         ((foreign-lambda* void ((mysql-bind-ptr bind) (unsigned-integer len)
    2184                                                                                                         (my-bool is_null) (my-bool error))
    2185 #<<END
    2186                 /* Contiguous variable allocation template */
    2187                 typedef struct {
    2188                         unsigned long length;
    2189                         my_bool is_null;
    2190                         my_bool error;
    2191                         C_word buffer[1]; /* len is size of the C storage type */
    2192                 } bind_slots;
    2193 
    2194                 /* Allocate variables in contiguous, zero filled, memory */
    2195                 size_t siz = (sizeof(bind_slots) - sizeof(((bind_slots *)0)->buffer))
    2196                                                                         + (((len / sizeof (C_word)) + (len % sizeof (C_word))) * sizeof (C_word));
    2197                 bind_slots * ptr = ((bind_slots *) calloc (siz, sizeof (char)));
    2198 
    2199                 ptr->is_null = is_null;
    2200                 ptr->length = len;
    2201                 ptr->error = error;
    2202 
    2203                 bind->buffer_length = len;
    2204                 bind->buffer = (char *) &(ptr->buffer);
    2205                 bind->is_null = &(ptr->is_null);
    2206                 bind->length = &(ptr->length);
    2207                 bind->error = &(ptr->error);
    2208 END
     2172        ((foreign-lambda* c-pointer ((mysql-bind-ptr bind) (unsigned-integer len)
     2173                                                                                                             (my-bool is_null) (my-bool error))
     2174#<<EOS
     2175    /* Contiguous variable allocation template */
     2176    typedef struct {
     2177      unsigned long length;
     2178      my_bool is_null;
     2179      my_bool error;
     2180      C_word buffer[1]; /* len is size of the C storage type */
     2181    } bind_slots;
     2182   
     2183    /* Allocate variables in contiguous, zero filled, memory */
     2184    size_t siz = (sizeof(bind_slots) - sizeof(((bind_slots *)0)->buffer))
     2185                    + (((len / sizeof(C_word)) + ((len % sizeof(C_word)) ? 1 : 0))
     2186                        * sizeof(C_word));
     2187    bind_slots * ptr = (bind_slots *) calloc(siz, sizeof(char));
     2188   
     2189    ptr->is_null = is_null;
     2190    ptr->length = len;
     2191    ptr->error = error;
     2192   
     2193    bind->buffer_length = len;
     2194    bind->buffer = (char *) &(ptr->buffer);
     2195    bind->is_null = &(ptr->is_null);
     2196    bind->length = &(ptr->length);
     2197    bind->error = &(ptr->error);
     2198
     2199    return (ptr);
     2200EOS
    22092201         )
    22102202         bindptr len is-null error) )
     
    22192211 (void) )
    22202212
    2221 (define (mysql-bind-param-init-direct bindptr idx obj #!key type is-unsigned is-null error)
    2222         (mysql-bind-clear! bindptr idx)
    2223         (unless type
    2224                 (let-values ([(typ uflg nflg) (%mysql-determine-type obj is-unsigned is-null)])
    2225                         (set! type typ)
    2226                         (set! is-unsigned uflg)
    2227                         (set! is-null nflg) ) )
    2228         (when (and (mysql-null-object? obj) (not (eqv? mysql-type-null type)))
    2229                 (warning "null object implies null type")
    2230                 (set! type mysql-type-null) )
    2231         (mysql-bind-buffer-type-set! bindptr type)
    2232         (unless (eqv? mysql-type-null type)
    2233                 (mysql-bind-is-unsigned-set! bindptr is-unsigned)
    2234                 (let* ([foreign-type (%mysql-determine-foreign-type type is-unsigned is-null)]
    2235                                          [len (%mysql-foreign-type-length foreign-type obj)])
    2236                         (allocate-mysql-bind-variables bindptr len is-null error) ) ) )
    2237 
    2238 (define (mysql-bind-result-init-direct bindptr idx type #!optional len)
    2239         (mysql-bind-clear! bindptr idx)
    2240         (mysql-bind-buffer-type-set! bindptr type)
    2241         (unless (eqv? mysql-type-null type)
    2242                 (let* ([foreign-type (%mysql-determine-foreign-type type #f #f)]
    2243                                          [len (or len
    2244                                                                                 (%mysql-foreign-type-length foreign-type))])
    2245                         (allocate-mysql-bind-variables bindptr len #f #f) ) ) )
     2213(define (mysql-bind-param-init-direct conn idx obj #!key type is-unsigned is-null error)
     2214  (let ([bindptr (mysql-bind-ref (mysql-connection-binding conn) idx)])
     2215    (mysql-bind-clear! bindptr)
     2216    (unless type
     2217      (let-values ([(typ uflg nflg) (%mysql-determine-type obj is-unsigned is-null)])
     2218        (set! type typ)
     2219        (set! is-unsigned uflg)
     2220        (set! is-null nflg) ) )
     2221    (when (and (mysql-null-object? obj) (not (eqv? mysql-type-null type)))
     2222      (warning "null object implies null type")
     2223      (set! type mysql-type-null) )
     2224    (mysql-bind-buffer-type-set! bindptr type)
     2225    (unless (eqv? mysql-type-null type)
     2226      (mysql-bind-is-unsigned-set! bindptr is-unsigned)
     2227      (let* ([foreign-type (%mysql-determine-foreign-type type is-unsigned is-null)]
     2228             [len (%mysql-foreign-type-length foreign-type obj)])
     2229        (mysql-connection-slots-set!
     2230         conn
     2231         (cons (allocate-mysql-bind-variables bindptr len is-null error)
     2232               (or (mysql-connection-slots conn) '()))) ) ) ) )
     2233
     2234(define (mysql-bind-result-init-direct conn idx type #!optional len)
     2235  (let ([bindptr (mysql-bind-ref (mysql-connection-binding conn) idx)])
     2236    (mysql-bind-clear! bindptr)
     2237    (mysql-bind-buffer-type-set! bindptr type)
     2238    (unless (eqv? mysql-type-null type)
     2239      (let* ([foreign-type (%mysql-determine-foreign-type type #f #f)]
     2240             [len (or len
     2241                      (%mysql-foreign-type-length foreign-type))])
     2242        (mysql-connection-slots-set!
     2243         conn
     2244         (cons (allocate-mysql-bind-variables bindptr len #f #f)
     2245               (or (mysql-connection-slots conn) '()))) ) ) ) )
    22462246
    22472247;;
    22482248
    22492249; (mysql-bind-param-init
    2250 ;               (list obj #:key T #:is-unsigned B #:is-null B #:error B)
     2250;               (list obj #:key T #:is-unsigned B #:is-null B #:error B) ; param 0
    22512251;               ...
    22522252;               (list obj #:key T #:is-unsigned B #:is-null B #:error B))
    22532253
    2254 (define (mysql-bind-param-init . inits)
     2254(define (mysql-bind-param-init conn . inits)
    22552255        (let ([bindptr (allocate-mysql-bind (length inits))])
     2256    (mysql-connection-binding-set! conn bindptr)
    22562257                (let loop ([inits inits] [idx 0])
    2257                         (if (null? inits)
    2258                                         bindptr
    2259                                         (begin
    2260                                                 (apply mysql-bind-param-init-direct bindptr idx (car inits))
    2261                                                 (loop (cdr inits) (+ idx 1)) ) ) ) ) )
     2258                        (unless (null? inits)
     2259        (apply mysql-bind-param-init-direct conn idx (car inits))
     2260        (loop (cdr inits) (fx+ idx 1)) ) ) ) )
    22622261
    22632262; (mysql-bind-result-init
    2264 ;               (list T #:len I)
     2263;               (list T #:len I) ; result 0
    22652264;               ...
    22662265;               (list T #:len I))
     
    22682267(define (mysql-bind-result-init conn . inits)
    22692268        (let ([bindptr (allocate-mysql-bind (length inits))])
    2270                 (let loop ([inits inits] [idx 0])
    2271                         (if (null? inits)
    2272                                         bindptr
    2273                                         (begin
    2274                                                 (apply mysql-bind-result-init-direct bindptr idx (car inits))
    2275                                                 (loop (cdr inits) (+ idx 1)) ) ) ) ) )
    2276 
    2277 ;;
    2278 
    2279 #;
     2269    (mysql-connection-binding-set! conn bindptr)
     2270          (let loop ([inits inits] [idx 0])
     2271                        (unless (null? inits)
     2272                            (apply mysql-bind-result-init-direct conn idx (car inits))
     2273                                        (loop (cdr inits) (fx+ idx 1)) ) ) ) )
     2274
     2275;;
     2276
    22802277(define (mysql-bind-result->object bindptr)
    22812278        (void) )
     
    23052302
    23062303(define (%mysql-free-bind conn)
     2304  (and-let* ([slots (mysql-connection-slots conn)])
     2305    (for-each free slots)
     2306    (mysql-connection-slots-set! conn #f) )
    23072307        (and-let* ([bindptr (mysql-connection-binding conn)])
    23082308                (free-mysql-bind bindptr)
     
    23312331                                                                                                                                                (string-append err
    23322332                                                                                                                                                                                                         (if sta
    2333                                                                                                                                                                                                                         (string-append " - " sta)
    2334                                                                                                                                                                                                                         ""))
     2333                                                                                                                                                                                                                         (string-append " - " sta)
     2334                                                                                                                                                                                                                         ""))
    23352335                                                                                                                                                conn args) ) ) )
    23362336
     
    23712371(define (mysql-stmt-prepare conn sql)
    23722372        (and-let* ([stmtptr (mysql-connection-statement conn)])
    2373                 (unless (zero? (foreign-mysql-stmt-prepare stmtptr sql (string-length sql)))
     2373                (unless (fx= 0 (foreign-mysql-stmt-prepare stmtptr sql (string-length sql)))
    23742374                        (signal-mysql-stmt-error 'mysql-stmt-prepare stmtptr) ) ) )
    23752375
     
    23882388(define (mysql-stmt-execute conn)
    23892389        (and-let* ([stmtptr (mysql-connection-statement conn)])
    2390                 (unless (zero? (foreign-mysql-stmt-execute stmtptr))
     2390                (unless (fx= 0 (foreign-mysql-stmt-execute stmtptr))
    23912391                        (signal-mysql-stmt-error 'mysql-stmt-execute stmtptr) ) ) )
    23922392
     
    24092409        (and-let* ([stmtptr (mysql-connection-statement conn)])
    24102410                (let ([val (foreign-mysql-stmt-fetch stmtptr)])
    2411                         (cond [(zero? val)
     2411                        (cond [(fx= 0 val)
    24122412                                                        #t]
    24132413                                                [(= mysql-no-data val)
     
    24222422(define (mysql-stmt-store-result conn)
    24232423        (and-let* ([stmtptr (mysql-connection-statement conn)])
    2424                 (when (zero? (foreign-mysql-stmt-store-result stmtptr))
     2424                (when (fx= 0 (foreign-mysql-stmt-store-result stmtptr))
    24252425                        (signal-mysql-stmt-error 'mysql-stmt-store-result stmtptr) ) ) )
    24262426
     
    25102510                (let ([row (mysql-stmt-row-fetch conn)])
    25112511                        (if row
    2512                                         (loop (+ rownum 1) (proc row rownum acc))
     2512                                        (loop (fx+ rownum 1) (proc row rownum acc))
    25132513                                        acc ) ) ) )
    25142514
Note: See TracChangeset for help on using the changeset viewer.