Changeset 14760 in project


Ignore:
Timestamp:
05/24/09 14:58:38 (10 years ago)
Author:
sjamaan
Message:

Rename result-values to result-row, and add result-column to the API
Make args rest-lists in the high-level API. I decided that the keywords "raw" and "format" are exclusive to the low-level API. You won't need them usually anyway.

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

Legend:

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

    r14759 r14760  
    3030 
    3131  result? clear-result! result-row-count result-column-count
    32   result-column-index result-column result-column-format
    33   result-column-type result-column-type-modifier result-columns
     32  result-column-index result-column-name result-column-names
     33  result-column-format result-column-type result-column-type-modifier
    3434  result-table-oid result-table-column-index
    35   result-value result-values result-alist result-affected-rows
    36   result-inserted-oid invalid-oid
     35  result-value result-row result-row-alist result-column
     36  result-affected-rows result-inserted-oid
     37
     38  invalid-oid
    3739 
    3840  escape-string escape-bytea unescape-bytea
     
    389391     location (sprintf "Result row ~A out of bounds" index) result index)))
    390392
    391 (define (result-column result index)
     393(define (result-column-name result index)
    392394  (check-result-column-index! result index 'result-column)
    393395  (string->symbol (PQfname (pg-result-ptr result) index)))
    394396
    395 (define (result-columns result)
     397(define (result-column-names result)
    396398  (let loop ((ptr (pg-result-ptr result))
    397399             (row '())
     
    470472  (result-value* result row column raw: raw))
    471473
    472 (define (result-values result row #!key raw)
     474(define (result-row result row #!key raw)
    473475  (check-result-row-index! result row 'result-list)
    474476  (let loop ((list '())
     
    479481              (sub1 column)))))
    480482
     483(define (result-column result column #!key raw)
     484  (check-result-column-index! result column 'result-list)
     485  (let loop ((list '())
     486             (row (result-row-count result)))
     487    (if (= row 0)
     488        list
     489        (loop (cons (result-value* result (sub1 row) column raw: raw) list)
     490              (sub1 row)))))
     491
    481492;; (define (result-alist result row)
    482 ;;   (map cons (result-columns result row) (result-values result row)))
    483 (define (result-alist result row)
     493;;   (map cons (result-columns result row) (result-row result row)))
     494(define (result-row-alist result row)
    484495  (check-result-row-index! result row 'result-alist)
    485496  (let loop ((alist '())
     
    542553           ((member (PQresultStatus result) (list PGRES_BAD_RESPONSE
    543554                                                  PGRES_FATAL_ERROR))
    544             (let* ((msg (string-trim-right (PQresultErrorMessage result)))
    545                    (get-error-field (lambda (diag)
    546                                       (PQresultErrorField result diag)))
     555            (let* ((get-error-field (lambda (d) (PQresultErrorField result d)))
    547556                   (sqlstate (get-error-field PG_DIAG_SQLSTATE))
    548557                   (maybe-severity (get-error-field PG_DIAG_SEVERITY))
     
    552561                    (make-pg-condition
    553562                     'collect-results
    554                      (conc "PQgetResult: " msg)
    555                      args:               (list conn)
     563                     (PQresultErrorMessage result)
    556564                     severity:           (and maybe-severity
    557565                                              (string->symbol
     
    684692                     "        C_return(NULL);"
    685693                     "}"
    686                      "C_return(to);"
    687                      ))
     694                     "C_return(to);"))
    688695  (or (%escape-string-conn conn str (string-length str))
    689696      (postgresql-error 'escape-string
     
    706713                     "res = C_string(&fin, tolen - 1, (char *)esc);"
    707714                     "PQfreemem(esc);"
    708                      "C_return(res);"
    709                      ))
     715                     "C_return(res);"))
    710716  (or (%escape-bytea-conn conn str (string-length str))
    711717      (postgresql-error 'escape-bytea
     
    735741;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    736742
    737 (define (query-fold kons knil conn query #!optional (params '()))
     743(define (%query-fold kons knil conn query params)
    738744  (let* ((result (exec-query conn query params))
    739745         (rows (result-row-count result)))
     
    742748      (if (= row rows)
    743749          seed
    744           (loop (kons (result-values result row) seed) (add1 row))))))
    745 
    746 (define (query-fold-right kons knil conn query #!optional (params '()))
     750          (loop (kons (result-row result row) seed) (add1 row))))))
     751
     752(define (%query-fold-right kons knil conn query params)
    747753  (let* ((result (exec-query conn query params))
    748754         (rows (result-row-count result)))
     
    751757      (if (= row rows)
    752758          seed
    753           (kons (result-values result row) (loop seed (add1 row)))))))
    754 
    755 (define (query-fold* kons knil conn query #!optional (params '()))
    756   (query-fold (lambda (values seed) (apply kons (append values (list seed))))
    757               knil conn query params))
    758 (define (query-fold-right* kons knil conn query #!optional (params '()))
    759   (query-fold-right (lambda (val seed) (apply kons (append val (list seed))))
    760               knil conn query params))
    761 
    762 (define (query-for-each proc conn query #!optional (params '()))
    763   (query-fold (lambda (values seed) (proc values)) #f conn query params)
     759          (kons (result-row result row) (loop seed (add1 row)))))))
     760
     761(define (query-fold kons knil conn query . params)
     762  (%query-fold kons knil conn query params))
     763(define (query-fold* kons knil conn query . params)
     764  (%query-fold (lambda (values seed) (apply kons (append values (list seed))))
     765               knil conn query params))
     766(define (query-fold-right kons knil conn query . params)
     767  (%query-fold-right kons knil conn query params))
     768(define (query-fold-right* kons knil conn query . params)
     769  (%query-fold-right (lambda (val seed) (apply kons (append val (list seed))))
     770                     knil conn query params))
     771
     772(define (query-for-each proc conn query . params)
     773  (%query-fold (lambda (values seed) (proc values)) #f conn query params)
    764774  (void))
    765775
    766 (define (query-for-each* proc conn query #!optional (params '()))
    767   (query-fold (lambda (values seed) (apply proc values)) #f conn query params)
     776(define (query-for-each* proc conn query . params)
     777  (%query-fold (lambda (values seed) (apply proc values)) #f conn query params)
    768778  (void))
    769779
     
    771781;; undefined.  We make good use of that by traversing the resultset from
    772782;; the end back to the beginning, thereby avoiding a reverse! on the result.
    773 (define (query-map proc conn query #!optional (params '()))
     783(define (%query-map proc conn query params)
    774784  (let ((result (exec-query conn query params)))
    775     (let loop ((output '())
     785    (let loop ((ans '())
    776786               (row (result-row-count result)))
    777787      (if (= row 0)
    778           output
    779           (loop (cons (proc (result-values result (sub1 row))) output)
    780                 (sub1 row))))))
    781 
    782 (define (query-map* proc conn query #!optional (params '()))
    783   (query-map (lambda (values seed) (apply proc values)) #f conn query params))
     788          ans
     789          (loop (cons (proc (result-row result (sub1 row))) ans) (sub1 row))))))
     790(define (query-map proc conn query . params)
     791  (%query-map proc conn query params))
     792
     793(define (query-map* proc conn query . params)
     794  (%query-map (lambda (values seed) (apply proc values)) conn query params))
    784795
    785796)
  • release/4/postgresql/trunk/tests/run.scm

    r14759 r14760  
    4343        (result-column-count (exec-query conn "SELECT 1, 2, 3, 4")))
    4444  (test "Correct column name"
    45         one
    46         (result-column
     45        'one
     46        (result-column-name
    4747         (exec-query conn "SELECT 1 AS one, 2 AS two") 0))
    4848  (test "Correct column names"
    4949        '(one two)
    50         (result-columns
     50        (result-column-names
    5151         (exec-query conn "SELECT 1 AS one, 2 AS two")))
    5252  (test-error "Condition for nonexistant column index"
     
    5555  (test "Not false for nameless column"
    5656        #f ;; Could check for ?column?, but that's a bit too specific
    57         (not (result-column
     57        (not (result-column-name
    5858              (exec-query conn "SELECT 1, 2") 0)))
    5959  ;; Maybe add a few tests here for case folding/noncase folding variants?
     
    110110        (result-value
    111111         (exec-query conn "SELECT 'test'") 0 0))
    112   (test "Result values"
    113         '("one" "two" "three")
    114         (result-values
    115          (exec-query conn "SELECT 'one', 'two', 'three'") 0))
     112  (test "Result row values"
     113        '("one" "two")
     114        (result-row
     115         (exec-query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
     116  (test "Result column values"
     117        '("one" "three")
     118        (result-column
     119         (exec-query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
    116120  (test "Result value number for numbers"
    117121        1
     
    210214  (test "boolean parameters"
    211215        '(#t #f)
    212         (result-values (exec-query conn "SELECT $1::bool, $2::bool" '(#t #f)) 0 0)))
     216        (result-row (exec-query conn "SELECT $1::bool, $2::bool" '(#t #f)) 0 0)))
    213217
    214218(test-group "value escaping"
     
    257261(test-group "high-level interface"
    258262  (test "query-fold"
    259         '(("one" "two")
    260           ("three" "four"))
     263        '(("one" 2)
     264          ("three" 4))
    261265        (reverse
    262266         (query-fold
    263           cons '() conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'")))
     267          cons '() conn
     268          "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
     269          "one" 2)))
    264270  (test "query-fold-right"
    265         '(("one" "two")
    266           ("three" "four"))
     271        '(("one" 2)
     272          ("three" 4))
    267273        (query-fold-right
    268          cons '() conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'"))
     274         cons '() conn
     275         "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
     276         "one" 2))
    269277  (test "query-for-each"
    270         '(("one" "two")
    271           ("three" "four"))
     278        '(("one" 2)
     279          ("three" 4))
    272280        (let ((res '()))
    273281          (query-for-each
    274282           (lambda (row) (set! res (cons row res)))
    275            conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'")
     283           conn
     284           "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2)
    276285          (reverse res)))
    277286  (test "query-map"
    278         '(("one" "two")
    279           ("three" "four"))
     287        '(("one" 2)
     288          ("three" 4))
    280289        (query-map
    281          identity conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'")))
     290         identity conn
     291         "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2)))
Note: See TracChangeset for help on using the changeset viewer.