1.14. Example Programs

Example 1-1. libpq Example Program 1

;;; testlibpq.scm
;;;
;;; Test the Scheme version of libpq, the PostgreSQL frontend library.

(require (lib "libpq-fe.scm" "libpq"))

(define (exit-nicely conn)
  (PQ-finish conn)
  (exit 1))

(define (testlibpq)
  ;; Begin by setting the parameters for a backend connection.  If the
  ;; parameters are false, then the system will try to use reasonable
  ;; defaults by looking up environment variables or, failing that,
  ;; using hardwired constants
  (let ((pghost #f)        ;host name of the backend server
        (pgport #f)        ;port of the backend server
        (pgoptions #f)     ;special options to start up the backend server
        (pgtty #f)         ;debugging tty for the backend server
        (db-name "template1"))
    ;; Make a connection to the database
    (let ((conn (PQ-setdb pghost pgport pgoptions pgtty db-name)))
      ;; Check to see that the backend connection was successfully made
      (when (= (PQ-status conn) CONNECTION-BAD)
        (fprintf (current-error-port) "Connection to database '~a' failed.\n" db-name)
        (fprintf (current-error-port) "~a" (PQ-error-message conn))
        (exit-nicely conn))
      ;; Start a transaction block
      (let ((res (PQ-exec conn "BEGIN")))
        (unless (and res (= (PQ-result-status res) PGRES-COMMAND-OK)))
          (fprintf (current-error-port) "BEGIN command failed\n")
          (PQ-clear res)
          (exit-nicely conn))
        ;; Should PQ-clear PGresult whenever it is no longer needed to avoid
        ;; memory leaks
        (PQ-clear res)
        ;; Fetch instances from the pg_database, the system catalog of
        ;; databases
        (set! res
              (PQ-exec conn
                       "DECLARE mycursor CURSOR FOR select * from pg_database"))
        (unless (and res (= (PQ-result-status res) PGRES-COMMAND-OK))
          (fprintf (current-error-port) "DECLARE CURSOR command failed\n")
          (PQ-clear res)
          (exit-nicely conn))
        (PQ-clear res)
        (set! res (PQ-exec conn "FETCH ALL IN mycursor"))
        (unless (and res (= (PQ-result-status res) PGRES-TUPLES-OK))
          (fprintf (current-error-port) "FETCH ALL command didn't return tuples properly\n")
          (PQ-clear res)
          (exit-nicely conn))
        ;; First, print out the attribute names
        (let ((n-fields (PQ-nfields res)))
          (do ((i 0 (+ i 1))) ((>= i n-fields))
            (printf "~a" (PQ-fname res i)))
          (printf "\n\n")
          ;; Next, print out the rows
          (do ((i 0 (+ i 1))) ((>= i (PQ-ntuples res)))
            (do ((j 0 (+ j 1))) ((>= j n-fields))
              (printf "~a" (PQ-getvalue res i j)))
            (printf "\n")))
        (PQ-clear res)
        ;; Close the cursor
        (set! res (PQ-exec conn "CLOSE mycursor"))
        (PQ-clear res)
        ;; Commit the transaction
        (set! res (PQ-exec conn "COMMIT"))
        (PQ-clear res))
      ;; Close the connection to the database and cleanup
      (PQ-finish conn)))
  (exit 0))