Changeset 14760 for release/4/postgresql/trunk/postgresql.scm

Timestamp:

05/24/09 21:58:38 (16 months 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.

Files:

• release/4/postgresql/trunk/postgresql.scm (modified) (12 diffs)

release/4/postgresql/trunk/postgresql.scm

@@ -30 +30 @@
   
   result? clear-result! result-row-count result-column-count
-  result-column-index result-column result-column-format
-  result-column-type result-column-type-modifier result-columns
+  result-column-index result-column-name result-column-names
+  result-column-format result-column-type result-column-type-modifier
   result-table-oid result-table-column-index
-  result-value result-values result-alist result-affected-rows
-  result-inserted-oid invalid-oid
+  result-value result-row result-row-alist result-column
+  result-affected-rows result-inserted-oid
+
+  invalid-oid
   
   escape-string escape-bytea unescape-bytea
@@ -389 +391 @@
      location (sprintf "Result row ~A out of bounds" index) result index)))
 
-(define (result-column result index)
+(define (result-column-name result index)
   (check-result-column-index! result index 'result-column)
   (string->symbol (PQfname (pg-result-ptr result) index)))
 
-(define (result-columns result)
+(define (result-column-names result)
   (let loop ((ptr (pg-result-ptr result))
              (row '())
@@ -470 +472 @@
   (result-value* result row column raw: raw))
 
-(define (result-values result row #!key raw)
+(define (result-row result row #!key raw)
   (check-result-row-index! result row 'result-list)
   (let loop ((list '())
@@ -479 +481 @@
               (sub1 column)))))
 
+(define (result-column result column #!key raw)
+  (check-result-column-index! result column 'result-list)
+  (let loop ((list '())
+             (row (result-row-count result)))
+    (if (= row 0)
+        list
+        (loop (cons (result-value* result (sub1 row) column raw: raw) list)
+              (sub1 row)))))
+
 ;; (define (result-alist result row)
-;;   (map cons (result-columns result row) (result-values result row)))
-(define (result-alist result row)
+;;   (map cons (result-columns result row) (result-row result row)))
+(define (result-row-alist result row)
   (check-result-row-index! result row 'result-alist)
   (let loop ((alist '())
@@ -542 +553 @@
            ((member (PQresultStatus result) (list PGRES_BAD_RESPONSE
                                                   PGRES_FATAL_ERROR))
-            (let* ((msg (string-trim-right (PQresultErrorMessage result)))
-                   (get-error-field (lambda (diag)
-                                      (PQresultErrorField result diag)))
+            (let* ((get-error-field (lambda (d) (PQresultErrorField result d)))
                    (sqlstate (get-error-field PG_DIAG_SQLSTATE))
                    (maybe-severity (get-error-field PG_DIAG_SEVERITY))
@@ -552 +561 @@
                     (make-pg-condition
                      'collect-results
-                     (conc "PQgetResult: " msg)
-                     args:               (list conn)
+                     (PQresultErrorMessage result)
                      severity:           (and maybe-severity
                                               (string->symbol
@@ -684 +692 @@
                      "        C_return(NULL);"
                      "}"
-                     "C_return(to);"
-                     ))
+                     "C_return(to);"))
   (or (%escape-string-conn conn str (string-length str))
       (postgresql-error 'escape-string
@@ -706 +713 @@
                      "res = C_string(&fin, tolen - 1, (char *)esc);"
                      "PQfreemem(esc);"
-                     "C_return(res);"
-                     ))
+                     "C_return(res);"))
   (or (%escape-bytea-conn conn str (string-length str))
       (postgresql-error 'escape-bytea
@@ -735 +741 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (query-fold kons knil conn query #!optional (params '()))
+(define (%query-fold kons knil conn query params)
   (let* ((result (exec-query conn query params))
          (rows (result-row-count result)))
@@ -742 +748 @@
       (if (= row rows)
           seed
-          (loop (kons (result-values result row) seed) (add1 row))))))
-
-(define (query-fold-right kons knil conn query #!optional (params '()))
+          (loop (kons (result-row result row) seed) (add1 row))))))
+
+(define (%query-fold-right kons knil conn query params)
   (let* ((result (exec-query conn query params))
          (rows (result-row-count result)))
@@ -751 +757 @@
       (if (= row rows)
           seed
-          (kons (result-values result row) (loop seed (add1 row)))))))
-
-(define (query-fold* kons knil conn query #!optional (params '()))
-  (query-fold (lambda (values seed) (apply kons (append values (list seed))))
-              knil conn query params))
-(define (query-fold-right* kons knil conn query #!optional (params '()))
-  (query-fold-right (lambda (val seed) (apply kons (append val (list seed))))
-              knil conn query params))
-
-(define (query-for-each proc conn query #!optional (params '()))
-  (query-fold (lambda (values seed) (proc values)) #f conn query params)
+          (kons (result-row result row) (loop seed (add1 row)))))))
+
+(define (query-fold kons knil conn query . params)
+  (%query-fold kons knil conn query params))
+(define (query-fold* kons knil conn query . params)
+  (%query-fold (lambda (values seed) (apply kons (append values (list seed))))
+               knil conn query params))
+(define (query-fold-right kons knil conn query . params)
+  (%query-fold-right kons knil conn query params))
+(define (query-fold-right* kons knil conn query . params)
+  (%query-fold-right (lambda (val seed) (apply kons (append val (list seed))))
+                     knil conn query params))
+
+(define (query-for-each proc conn query . params)
+  (%query-fold (lambda (values seed) (proc values)) #f conn query params)
   (void))
 
-(define (query-for-each* proc conn query #!optional (params '()))
-  (query-fold (lambda (values seed) (apply proc values)) #f conn query params)
+(define (query-for-each* proc conn query . params)
+  (%query-fold (lambda (values seed) (apply proc values)) #f conn query params)
   (void))
 
@@ -771 +781 @@
 ;; undefined.  We make good use of that by traversing the resultset from
 ;; the end back to the beginning, thereby avoiding a reverse! on the result.
-(define (query-map proc conn query #!optional (params '()))
+(define (%query-map proc conn query params)
   (let ((result (exec-query conn query params)))
-    (let loop ((output '())
+    (let loop ((ans '())
                (row (result-row-count result)))
       (if (= row 0)
-          output
-          (loop (cons (proc (result-values result (sub1 row))) output)
-                (sub1 row))))))
-
-(define (query-map* proc conn query #!optional (params '()))
-  (query-map (lambda (values seed) (apply proc values)) #f conn query params))
+          ans
+          (loop (cons (proc (result-row result (sub1 row))) ans) (sub1 row))))))
+(define (query-map proc conn query . params)
+  (%query-map proc conn query params))
+
+(define (query-map* proc conn query . params)
+  (%query-map (lambda (values seed) (apply proc values)) conn query params))
 
 )