Changeset 14632 in project


Ignore:
Timestamp:
05/14/09 23:08:49 (10 years ago)
Author:
sjamaan
Message:

Simplify, simplify, simplify

File:
1 edited

Legend:

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

    r14631 r14632  
    5555(define PQconnectStart (foreign-lambda pgconn* PQconnectStart (const c-string)))
    5656(define PQconnectPoll (foreign-lambda pg-polling-status PQconnectPoll pgconn*))
    57 (define PQresetStart (foreign-lambda int PQresetStart pgconn*))
     57(define PQresetStart (foreign-lambda bool PQresetStart pgconn*))
    5858(define PQresetPoll (foreign-lambda pg-polling-status PQresetPoll pgconn*))
    5959(define PQfinish (foreign-lambda void PQfinish pgconn*))
     
    118118(define-foreign-int PG_DIAG_SOURCE_LINE)
    119119(define-foreign-int PG_DIAG_SOURCE_FUNCTION)
     120
    120121
    121122(define (pg:error loc message . args)
     
    139140     'source-function source-function)))
    140141
    141 (define-record pg:connection
    142   ptr)
     142(define-record pg:connection ptr)
    143143
    144144(define-record sql-null-object)
    145145(define pg:sql-null-object (make-sql-null-object))
    146 
    147146(define (pg:sql-null-object? x)
    148147  (eq? x pg:sql-null-object))
     
    152151    ((_ value place)
    153152     (set! place (cons value place)))))
    154 
    155 ;; Block the current thread until there is input available on fd, if
    156 ;; input? is true, or block until it is possible to write to fd, if
    157 ;; input? is false.  (Thanks, Felix.)
    158 (define (block-thread! fd input?)
    159   (let ([t (current-thread)])
    160     (##sys#thread-block-for-i/o! t fd input?)
    161     (##sys#call-with-current-continuation
    162      (lambda (return)
    163        (##sys#setslot t 1 (lambda () (return (void))))
    164        (##sys#schedule)))))
    165153
    166154(define (pg:poll conn-ptr poll-function)
     
    175163                                           error-message)))]
    176164            [(member result (list PGRES_POLLING_WRITING PGRES_POLLING_READING))
    177              (block-thread! conn-fd (= PGRES_POLLING_READING result))
     165             (thread-wait-for-i/o! conn-fd (if (= PGRES_POLLING_READING result)
     166                                               #:output
     167                                               #:input))
    178168             (loop (poll-function conn-ptr))]))))
     169
     170(define (alist->connection-spec alist)
     171  (string-join
     172   (map (lambda (subspec)
     173          (sprintf "~A = '~A'" (car subspec)
     174                   (string-translate* (->string (cdr subspec))
     175                                      '(("\\" . "\\\\")
     176                                        ("'" . "\\'")))))
     177        alist)))
    179178
    180179(define pg:connect
     
    199198            (pg:poll conn-ptr PQconnectPoll)])))
    200199     
    201       (define (connspec-escape s)
    202         (string-translate* (->string s) '(("\\" . "\\\\") ("'" . "\\'"))))
    203      
    204       (let ([conn (make-pg:connection
    205                    (pg-connect-nonblocking
    206                     (string-intersperse
    207                      (map (lambda (subspec)
    208                             (sprintf "~A = '~A'" (car subspec)
    209                                     (connspec-escape (cdr subspec))))
    210                           connection-spec)
    211                      " ")))])
    212 
    213         (set-finalizer! conn
    214                         (lambda (conn)
    215                           (pg:close conn)))
    216        
     200      (let* ((connspec (if (string? connection-spec)
     201                           connection-spec
     202                           (alist->connection-spec connection-spec)))
     203             (conn (make-pg:connection (pg-connect-nonblocking connspec))))
     204        (set-finalizer! conn pg:close)
    217205        ;; Retrieve type-information from PostgreSQL metadata for use by the
    218206        ;; various value-parsers.
     
    224212(define (pg:reset connection)
    225213  (let ([conn-ptr (pg:connection-ptr connection)])
    226     (case (PQresetStart conn-ptr)
    227       ((1)
    228        (pg:poll conn-ptr PQresetPoll)
    229        (void))
    230       ((0)
    231        (let ((error-message (PQerrorMessage conn-ptr)))
    232         (pg:error 'pg:reset (conc "Reset of connection failed " error-message)
    233                   connection))))))
     214    (if (PQresetStart conn-ptr)
     215        (begin (pg:poll conn-ptr PQresetPoll)
     216               (void))
     217        (let ((error-message (PQerrorMessage conn-ptr)))
     218          (pg:error 'pg:reset (conc "Reset of connection failed " error-message)
     219                    connection)))))
    234220
    235221(define (pg:close connection)
     
    258244        (if (PQconsumeInput conn-ptr)
    259245            (when (PQisBusy conn-ptr)
    260               (block-thread! conn-fd #t)
     246              (thread-wait-for-i/o! conn-fd #:input)
    261247              (loop))
    262248            (pg:error 'buffer-available-input!
Note: See TracChangeset for help on using the changeset viewer.