Changeset 17901 in project


Ignore:
Timestamp:
04/25/10 12:09:56 (9 years ago)
Author:
sjamaan
Message:

Get rid of the current-type-unparsers parameter, pass the connection to each parser instead

Location:
release/4/postgresql/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/postgresql/trunk/postgresql.scm

    r17783 r17901  
    2222 (type-parsers update-type-parsers! default-type-parsers
    2323  char-parser bool-parser bytea-parser numeric-parser make-array-parser
    24   current-type-unparsers scheme-value->db-value
    25   type-unparsers update-type-unparsers! default-type-unparsers
    26   bool-unparser vector-unparser list-unparser
     24  scheme-value->db-value type-unparsers update-type-unparsers!
     25  default-type-unparsers bool-unparser vector-unparser list-unparser
    2726 
    2827  connect reset-connection disconnect connection?
     
    305304;;;;;;;;;;;;;;;;;;;;;;;
    306305
    307 (define current-type-unparsers (make-parameter #f))
    308 
    309 (define (scheme-value->db-value value)
     306(define (scheme-value->db-value conn value)
    310307  (cond ((find (lambda (parse?)
    311308                 ((car parse?) value))
    312                (current-type-unparsers)) => (lambda (parse)
    313                                               ((cdr parse) value)))
     309               (pg-connection-type-unparsers conn)) =>
     310               (lambda (parse)
     311                 ((cdr parse) conn value)))
    314312        (else value)))
    315313
    316 (define (bool-unparser b)
     314(define (bool-unparser conn b)
    317315  (if b "TRUE" "FALSE"))
    318316
    319 (define (vector-unparser v)
     317(define (vector-unparser conn v)
    320318  (let loop ((result (list))
    321319             (pos 0)
     
    324322        (string-append "{" (string-intersperse (reverse! result) ",") "}")
    325323        (let* ((value (vector-ref v pos))
    326                (unparsed-value (scheme-value->db-value value))
     324               (unparsed-value (scheme-value->db-value conn value))
    327325               (serialized (cond
    328326                            ((sql-null? unparsed-value) "NULL")
     
    340338          (loop (cons serialized result) (add1 pos) len)))))
    341339
    342 (define (list-unparser l)
     340(define (list-unparser conn l)
    343341  (let loop ((result (list))
    344342             (items l))
    345343    (if (null? items)
    346344        (string-append "(" (string-intersperse (reverse! result) ",") ")")
    347         (let* ((unparsed-value (scheme-value->db-value (car items)))
     345        (let* ((unparsed-value (scheme-value->db-value conn (car items)))
    348346               (serialized (cond
    349347                            ((sql-null? unparsed-value) "")
     
    362360(define default-type-unparsers
    363361  (make-parameter
    364    `((,string? . ,identity)
    365      (,u8vector? . ,u8vector->blob/shared)
    366      (,char? . ,string)
     362   `((,string? . ,(lambda (conn s) s))
     363     (,u8vector? . ,(lambda (conn v) (u8vector->blob/shared v)))
     364     (,char? . ,(lambda (conn c) (string c)))
    367365     (,boolean? . ,bool-unparser)
    368      (,number? . ,number->string)
     366     (,number? . ,(lambda (conn n) (number->string n)))
    369367     (,vector? . ,vector-unparser)
    370368     (,pair? . ,list-unparser))))
     
    848846(define (query* conn query #!optional (params '()) #!key (format 'text) raw)
    849847  (let* ((params ;; Check all params and ensure they are proper pairs
    850           (parameterize ((current-type-unparsers
    851                           (pg-connection-type-unparsers conn)))
    852             (map ;; See if this can be moved into C
    853              (lambda (p)
    854                (let ((obj (if raw p (scheme-value->db-value p))))
    855                  (when (and (not (string? obj))
    856                             (not (blob? obj))
    857                             (not (sql-null? obj)))
    858                    (postgresql-error
    859                     'query*
    860                     (sprintf "Param value is not string, sql-null or blob: ~S" p)
    861                     conn query params format))
    862                  (if (sql-null? obj) #f obj))) params)))
     848          (map ;; See if this can be moved into C
     849           (lambda (p)
     850             (let ((obj (if raw p (scheme-value->db-value conn p))))
     851               (when (and (not (string? obj))
     852                          (not (blob? obj))
     853                          (not (sql-null? obj)))
     854                 (postgresql-error
     855                  'query*
     856                  (sprintf "Param value is not string, sql-null or blob: ~S" p)
     857                  conn query params format))
     858               (if (sql-null? obj) #f obj))) params))
    863859         (send-query
    864860          (foreign-lambda*
  • release/4/postgresql/trunk/tests/run.scm

    r17783 r17901  
    446446  (test "Boolean true unparsed correctly"
    447447        "TRUE"
    448         (bool-unparser #t))
     448        (bool-unparser conn #t))
    449449  (test "Boolean false unparsed correctly"
    450450        "FALSE"
    451         (bool-unparser #f)))
     451        (bool-unparser conn #f)))
    452452
    453453(test-group "high-level interface"
Note: See TracChangeset for help on using the changeset viewer.