;; @module postgres.lsp
;; @description PostgreSQL interface (tested on PostgreSQL 9.4, should work on all supported versions)
;; @version 1.02 - feature complete
;; @version 1.03 - doc formatting
;; @version 2.00 - replaced <tt>inc</tt> with <tt>++</tt>
;; @version 2.10 - new <tt>fnumber</tt> and <tt>fetch-value</tt>
;; @version 2.11 - new <tt>query</tt> with optional parameters
;; @version 2.12 - add MacPorts path, Fix bugs (error), (affected-rows), (fields ...), test against PostgreSQL 9.4
;; @version 3.00 - add new postgreSQL imports, use pg_config to find libpq header, improve test coverage
;; @author Jeremy Cowgar 2006, Ted Walther 2009, Lutz Mueller 2010, Unya 2012, Neil Tiffin 2015
;;
;; <h3>Requirements</h3>
;; At the beginning of the program file include a 'load' statement for the module:
;; <pre>
;; (load "/usr/share/newlisp/modules/postgres.lsp")
;; ; or
;; (module "postgres.lsp") ; loads from (env "NEWLISPDIR") / modules
;; </pre>
;;
;; A version of 'libpq' for a specific platform is required:
;;
;; on LINUX/UNIX: 'libpq.so' <br>
;; on Mac OS X: 'libpq.dylib' <br>
;; on Windows: 'libpq.dll'
;;
;; This library is installed when using the install
;; package @link http://www.postgresql.org/download/ .
;; Unix, Linux, and Mac each have package installers that can be used
;; to install the PostgreSQL client (libpq) & server.
;;
;; Libpq might be in a different location on a particular
;; installation of PostgreSQL or have a different extension.
;; This module attempts to find libpq using pg_config. If you can execute
;; pg_config at the command line and see its results then everything should just
;; work. If not, then
;; you may have to edit the manual search code below to find your specific libpq.
;;
;; If you are using PostgreSQL from a Linux distribution you will need to install the
;; development headers for libpq, usually called libpq-dev.
;;
;; The PostgreSQL server itself may reside on a different machine
;; on the network. The library 'libpq' will communicate
;; with that server. The correct connection is created using
;; the 'PgSQL:connect' call.
;;
;; At the bottom of the module file 'postgres.lsp' a test routine 'test-pgsql'
;; is included to test for correct installation of PostgreSQL. You call it
;; with the same arguments you would pass to ':connect'
;;
;; <h3>Functions available</h3>
;; <pre>
;; Connect
;; PgSQL:connect ............. connect to a database
;; PgSQL:close-db ............ close database connection
;; PgSQL:error-conn .......... get connection error message *
;;
;; Query
;; PgSQL:query ............... execute a SQL statement
;;
;; Query Results
;; PgSQL:affected-rows ....... number of affected rows from operation
;; PgSQL:data-seek ........... position in result for fetching
;; PgSQL:error ............... get query error message
;; PgSQL:fetch-all ........... get all rows from the last query
;; PgSQL:fetch-row ........... get row from the query result
;; PgSQL:fetch-value ......... get value from the query result
;; PgSQL:fnumber ............. column number of query
;; PgSQL:num-fields .......... columns in result of query
;; PgSQL:num-rows ............ rows in result of query
;;
;; Info
;; PgSQL:database ............ return all database names
;; PgSQL:fields .............. return all fields in a table
;; PgSQL:tables .............. return all tables names
;;
;; Misc
;; PgSQL:escape .............. escapes single quote in input string
;; PgSQL:escape-literal ...... escapes literal for PostgreSQL *
;; PgSQL:escape-identifier ... escapes identifier for PostgreSQL *
;;
;; * API may be specific to PostgreSQL
;; </pre>
;;
;; <h3>Differences from the MySQL module</h3>
;;
;; The function ':inserted-id' isn't supported because PostgreSQL
;; doesn't support it. Instead, use the 'RETURNING' clause in your 'INSERT'
;; statement, then use ':fetch-row' or ':fetch-all' to
;; find the value. 'INSERT RETURNING' is a PostreSQL idiom
;; documented @link http://www.postgresql.org/docs/9.4/static/sql-insert.html here.
;;
;; There is no ':init' function because it isn't needed by the underlying
;; library. Just call ':connect'.
;;
;; <h3>A typical PgSQL session</h3>
;; The following code piece outlines a typical PgSQL session:
;;
;; @example
;; (module "postgres.lsp") ; load the module file
;;
;; (PgSQL:connect "192.168.1.10" "auser" "secret" "mydb") ; logon
;; (PgSQL:query "select ...;") ; SQL query
;; (PgSQL:query "insert ...;") ; SQL query
;; ...
;; (PgSQL:close-db)
;; The database server is listening on IP 192.168.1.10. The program
;; connects with username '"auser"' password '"secret"' to a database with
;; the name '"mydb"'. After connecting SQL statements are performed and
;; finally the program disconnects from the server.
;;
;; If the database server is running locally then "localhost" may be used for
;; the host name.
;;
;; <h3>Bugs</h3>
;;
;; This module doesn't support connections through a Unix socket.
;;
;; <h3>Implementation Notes</h3>
;; As of 19 March 2015.
;; On Windows only works with x86 (32bit) PostgreSQL install.
;; pg_config must be in the path.
;; Tested on OSX 10.10.2, Linux SMP Debian 3.16.7-ckt7-1, Windows 8.1 [version 6.3.9600]
; make this module compatible with version less than 10.1.11
(when (< (sys-info -2) 10110)
(constant (global '++) inc))
(context 'PgSQL)
; get pg_config if available
(set 'pg_lib_dir (exec "pg_config --libdir"))
(if pg_lib_dir
(set 'files
(list
(append (first pg_lib_dir) "/libpq.dylib") ; shared Mac OS X libs
(append (first pg_lib_dir) "/libpq.so") ; loadable elf libs Posix Unix Linux
(append (first pg_lib_dir) "/libpq.dll") ; Windows lib
))
(set 'files '(
"/usr/local/lib/libpq.so.5.1" ; OpenBSD 4.6
"/usr/lib/libpq.so" ; CentOS or other Linux
"/usr/lib64/libpq.so" ; Linux 64bit
"/usr/lib/libpq.so.5.1" ; Debian
"/usr/local/pgsql/lib/libpq.dylib" ; Mac OS X
"c:/Program Files/PostgreSQL/8.3/bin/libpq.dll" ; Win32
)))
; find the library file
(set 'library (files (or
(find true (map file? files))
(throw-error "Cannot find libpq library!"))))
; done with these
(delete 'pg_config)
(delete 'pg_lib_dir)
(delete 'files)
; import functions and throw error if not found
(define (pg_import fun_name)
(import library fun_name "cdecl"))
; import functions and print warning if not found
(define (pg_import_warn fun_name)
(unless (catch (import library fun_name "cdecl") 'pg_load_error)
(println "libpq import WARNING: " pg_load_error)))
; import functions available in libpq for 8.4 or earlier
; These are core functions and will throw an error if not found.
(map pg_import (list
"PQcancel"
"PQclear"
"PQcmdStatus"
"PQcmdTuples"
"PQconnectdb"
;"PQconnectionNeedsPassword" ; PostgreSQL 8.3
;"PQconnectionUsedPassword" ; PostgreSQL 8.3
"PQconsumeInput"
"PQdb"
"PQdescribePortal" ; PostgreSQL 8.2
"PQdescribePrepared" ; PostgreSQL 8.2
;"PQencryptPassword" ; PostgreSQL 8.2
"PQerrorMessage"
"PQexec"
"PQexecParams"
"PQexecPrepared" ; PostgreSQL 7.4
"PQfinish"
"PQflush"
"PQfname"
"PQfnumber"
"PQfreeCancel"
"PQfreemem" ; PostgreSQL 7.4
"PQgetCancel"
"PQgetisnull"
"PQgetvalue"
"PQhost"
"PQinstanceData" ; PostgreSQL 8.4
"PQisBusy"
"PQisnonblocking"
"PQisthreadsafe" ; PostgreSQL 8.2
"PQnfields"
"PQnotifies"
"PQntuples"
"PQoptions"
"PQpass"
"PQport"
"PQprepare" ; PostgreSQL 8.0
"PQprotocolVersion"
"PQregisterEventProc" ; PostgreSQL 8.4
"PQresultErrorMessage"
"PQresultInstanceData" ; PostgreSQL 8.4
"PQresultSetInstanceData" ; PostgreSQL 8.4
"PQresultStatus"
"PQresStatus"
"PQsendQueryPrepared" ; PostgreSQL 7.4
"PQserverVersion" ; PostgreSQL 8.0
"PQsetInstanceData" ; PostgreSQL 8.4
"PQsetnonblocking"
"PQsetNoticeProcessor"
"PQsetNoticeReceiver"
"PQstatus"
"PQuser"
))
; Try to import new libpq functions and print warning (do not throw error) if not found.
; if any of these functions are used then the code in this module should verify
; that the respective function was actually loaded before use.
(map pg_import_warn (list
"PQconninfo" ; PostgreSQL 9.3
"PQescapeIdentifier" ; PostgreSQL 9.1
"PQescapeLiteral" ; PostgreSQL 9.1
"PQlibVersion" ; PostgreSQL 9.0
"PQping" ; PostgreSQL 9.0
"PQpingParams" ; PostgreSQL 9.0
"PQsetSingleRowMode" ; PostgreSQL 9.2
))
(delete 'pg_import_warn)
(delete 'pg_import)
; On some wierd platforms NULL may equal something else, we'll worry about that when we bump into it.
(define NULL 0)
(define (NULL? n) (= 0 n))
(setq
CONNECTION_OK 0
PGRES_FATAL_ERROR 7)
(set 'PQPING_STATUS '(
"PQPING_OK"
"PQPING_REJECT"
"PQPING_NO_RESPONSE"
"PQPING_NO_ATTEMPT"))
; module variables
(setq PG_CONN nil) ; pg connection structure
(setq PG_RESULT nil) ; pg query result structure
(setq PG_ROWX 0) ; current row
(setq PG_COLX 0) ; current column
;; @syntax (PgSQL:connect <str-server> <str-userID> <str-password> <str-db>)
;; @param <str-server> The host name or IP address or <tt>0</tt> for localhost.
;; @param <str-userID> The user ID for authentication.
;; @param <str-password> The password for authentication.
;; @param <str-db> The name of the database to connect to.
;; @return 'true' for success or 'nil' for failure.
;; Connects to a database on server and authenticates a user ID.
(define (connect host user passw dbname)
(connectdb (string
(if (> (length host) 0) (string "host=" host) "")
(if (> (length user) 0) (string " user=" user) "")
(if (> (length passw) 0) (string " password=" passw) "")
(if (> (length dbname) 0) (string " dbname=" dbname) "")
)) )
;; @syntax (PgSQL:connectdb <str-conninfo>)
;; @param <str-conninfo> PostgreSQL Connection Parameters, To write an empty value or a value containing spaces, surround it with single quotes, e.g., keyword = 'a value'. keyword is 'host', 'hostaddr, 'port', 'dbname', 'user', 'password', 'connect_timeout', 'client_encoding', 'options', 'application_name', 'fallback_application_name', 'keepalives', 'keepalives_idle', 'keepalives_interval', 'keepalives_count', 'tty', 'sslmode', 'sslcompression', 'sslcert', 'sslkey', 'sslrootcert', 'sslcrl', 'requirepeer', 'krbsrvname', 'gsslib', 'service' in PostgreSQL 9.4.
;; @return 'true' for success or nil on failure.
;; Connects to a database on server.
(define (connectdb conninfo)
(close-db)
(setq PG_CONN (PQconnectdb conninfo))
(if (NULL? PG_CONN)
nil
(if (= (PQstatus PG_CONN) CONNECTION_OK)
true
(PQfinish PG_CONN)
(setq PG_CONN nil))))
;; @syntax (PgSQL:query <str-sql> [<param> ...])
;; @param <str-sql> A valid SQL query string. If parameters are used, they are referred to in the command string as $1, $2, etc.
;; @param <param> Specifies the actual values of the parameters.
;; @return Returns a numeric status code
;; Sends a SQL query string to the database server for evaluation.
;; The return value will be an integer representing one of the following enumerated types: PGRES_EMPTY_QUERY,
;; PGRES_COMMAND_OK, PGRES_TUPLES_OK, PGRES_COPY_OUT, PGRES_COPY_IN,
;; PGRES_BAD_RESPONSE, PGRES_FATAL_ERROR.
;;
;; The numeric status code can be converted to a string using (PgSQL:result-str <status-code>).
;; The numeric status code should not be used directly.
;;
;; From the libpq documentation:
;; <blockquote>
;; If the result status is PGRES_TUPLES_OK, then the functions described
;; below can be used to retrieve the rows returned by the query. Note that
;; a SELECT command that happens to retrieve zero rows still shows
;; PGRES_TUPLES_OK. PGRES_COMMAND_OK is for commands that can never return
;; rows (INSERT, UPDATE, etc.). A response of PGRES_EMPTY_QUERY might
;; indicate a bug in the client software.
;; </blockquote>
;;
;; @example
;;
;; (PgSQL:query "select $1||$2" "abc" "def")
;; (PgSQL:fetch-all) ; -> (("abcdef"))
;;
;; (PgSQL:query "select $1 + $2" 10 20)
;; (PgSQL:fetch-all) ; -> (("30"))
;;
;; (PgSQL:query "select $1::timestamp + $2::interval" "2012-10-01 00:00:00" "123456 seconds")
;; (PgSQL:fetch-all) ; -> (("2012-10-02 10:17:36"))
;;
;; (PgSQL:query "create table tbl (a integer, b integer)")
;; (dotimes (i 10) (PgSQL:query "insert into tbl values ($1, $2)" i (* i 2)))
;; ; a | b
;; ; ---+----
;; ; 0 | 0
;; ; 1 | 2
;; ; 2 | 4
;; ; ...
;; ; 9 | 18
;;
;; (PgSQL:query "select * from tbl where a=$1 or a=$2" 2 9)
;; (PgSQL:fetch-all) ; -> (("2" "4") ("9" "18"))
(define (query sql)
(clear-result)
(letn ((nParams (length (args)))
(params (map (lambda (argv) (string argv)) (args)))
(ptr-fmt (if (= (& (sys-info 9) 256) 0)
"lu" "Lu"))
(paramValues (if params
(pack (dup ptr-fmt nParams) params)
0)))
(setq PG_RESULT
(PQexecParams PG_CONN sql nParams 0 paramValues 0 0 0))
(if (not (NULL? PG_RESULT))
(PQresultStatus PG_RESULT)
PGRES_FATAL_ERROR)) )
;; @syntax (PgSQL:num-rows)
;; @return Number of rows from last query.
(define (num-rows)
(PQntuples PG_RESULT))
;; @syntax (PgSQL:num-fields)
;; @return Number of columns from last query.
(define (num-fields)
(PQnfields PG_RESULT))
;; @syntax (PgSQL:fnumber <str-column>)
;; @param <str-column> The column name.
;; @return the column number associated with the given column name. return nil when not found column name.
(define (fnumber name)
(let (n (PQfnumber PG_RESULT name))
(if (< n 0)
nil
n)))
;; @syntax (PgSQL:fname <int-column>)
;; @param <int-column> The integer column number.
;; @return the column name associated with the given column number. return nil when not found column name.
(define (fname column)
(let (s1 (PQfname PG_RESULT (int column)))
(if (= s1 0)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2)))))
;; @syntax (PgSQL:fetch-value <num-row> <col>)
;; @param <num-row> row number
;; @param <col> column number or column name string.
;; @return A single value
;; Fetches the single value in the row and column specified. Used by the
;; ':fetch-row' and ':fetch-all' functions. A field containing the 'NULL'
;; value will return the symbol 'NULL'
(define (fetch-value row column)
(if (string? column)
(setq column (fnumber column)))
(when column
(let (s1 (PQgetvalue PG_RESULT row column))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= 1 (PQgetisnull PG_RESULT row column))
'NULL s2))))) )
;; @syntax (PgSQL:fetch-row)
;; @return A list of field elements.
;; Fetches a row from a previous SQL 'PgSQL:query' 'select' statement.
;; Subsequent calls fetch row by row from the result table until the
;; end of the table is reached.
(define (fetch-row)
(when (and (> (num-rows) 0) (> (num-rows) PG_ROWX))
(let (row (map (fn (x) (fetch-value PG_ROWX x)) (sequence 0 (- (num-fields) 1))))
(++ PG_ROWX)
row)))
;; @syntax (PgSQL:fetch-all)
;; @return All rows/fields from the last query, or 'nil'
;; The whole result set from the query is returned at once as a list of row lists.
(define (fetch-all)
(when (> (num-rows) 0)
(data-seek 0)
(map fetch-row (sequence 0 (- (num-rows) 1)))))
;; @syntax (PgSQL:databases)
;; @return A list of databases.
;; Performs the query 'SELECT datname FROM pg_database' which shows all the
;; database schemas hosted by the connected server.
(define (databases)
(when (= "PGRES_TUPLES_OK" (result-status-str (query {SELECT datname FROM pg_database})))
(map (fn (x) (x 0)) (fetch-all))))
;; @syntax (PgSQL:tables)
;; @return A list of tables in the database, or 'nil'
;; Performs the query 'SELECT table_name FROM information_schema.tables WHERE table_schema = 'public''
(define (tables)
(when (= "PGRES_TUPLES_OK" (result-status-str (query {SELECT table_name FROM information_schema.tables WHERE table_schema = 'public'})))
(map (fn (x) (x 0)) (fetch-all))))
;; @syntax (PgSQL:fields <str-table>)
;; @param <str-table> The name of the table.
;; @return A list of fields in the table, or 'nil'
;; Unlike the equivalent function in the MySQL module, this function only shows
;; the names of all the fields in the given table. It does not show the field
;; specification, which you would need to recreate the table.
(define (fields str-table)
(let (sql (format {SELECT column_name FROM information_schema.columns WHERE table_name = %s} (escape-literal str-table)))
(when (= "PGRES_TUPLES_OK" (result-status-str (query sql)))
(map (fn (x) (x 0)) (fetch-all)))))
;; @syntax (PgSQL:data-seek <num-offset>)
;; @param <num-offset> The '0' based offset to position inside the data set.
;; @return Always 'true'.
;; Sets a position in the result set which will be used by the next
;; 'PgSQL:fetch-row' call. If the offset is out of the allowed range for the
;; result set a subsequent fetch-row will return 'nil'.
(define (data-seek n) (setq PG_ROWX n) true)
;; @syntax (PgSQL:error)
;; @return A string containing the query result error message.
;; If there was no error, this function returns 'nil'.
(define (error)
(if (= PG_RESULT nil)
(throw-error "Results are not available.")
(let (s1 (PQresultErrorMessage PG_RESULT))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:affected-rows)
;; @return Number of rows affected by the last 'PgSQL:query' operation, or 'nil'
;; This function will only return a value following the execution of an INSERT,
;; UPDATE, DELETE, MOVE, FETCH, or COPY statement, or an EXECUTE of a prepared
;; query that contains an INSERT, UPDATE, or DELETE statement. It will return
;; 'nil' after all other queries.
(define (affected-rows)
(if (= PG_RESULT nil)
nil
(let (s1 (PQcmdTuples PG_RESULT))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
(int s2)))))))
;; @syntax (PgSQL:error-conn)
;; @return error message string
;; Returns the error message most recently generated by an operation on the connection.
(define (error-conn)
(if (= PG_CONN nil)
(throw-error "Connection is not available.")
(let (s1 (PQerrorMessage PG_CONN))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:escape <str-sql>)
;; @return escaped string
;; This function only escapes the ' character in <str-sql>, as per the SQL standard.
;; Depending on whether you
;; are using binary data or have configured Postgres to allow C escapes
;; you may need more advanced escaping than this function provides.
(define (escape)
(replace {'} (apply string (args)) {''}))
;; @syntax (PgSQL:escape-literal <str>)
;; @param <str> string to be escaped
;; @return escaped string
;; This function escapes a string for use within an SQL command. This is
;; useful when inserting data values as literal constants in SQL commands. Certain
;; characters (such as quotes and backslashes) must be escaped to prevent them from
;; being interpreted specially by the SQL parser. escape-literal performs this
;; operation. This function was added in PostgreSQL 9.1 and will throw an error if
;; you are using an older libpq.
(define (escape-literal x)
(if (primitive? PQescapeLiteral)
(if (= PG_CONN nil)
(throw-error "Must be connected to a database.")
(let (pg_raw_result (PQescapeLiteral PG_CONN x (length (get-string x))))
(if (= pg_raw_result nil)
(throw-error (error-conn))
(let (pg_result (get-string pg_raw_result))
(PQfreemem pg_raw_result)
pg_result))))
(throw-error "PQescapeLiteral not available.")))
;; @syntax (PgSQL:escape-identifier <str>)
;; @param <str> string to be escaped
;; @return escaped string
;; This function escapes a string for use as an SQL identifier, such as a
;; table, column, or function name. This is useful when a user-supplied identifier
;; might contain special characters that would otherwise not be interpreted as part
;; of the identifier by the SQL parser, or when the identifier might contain upper
;; case characters whose case should be preserved. This function was added in
;; PostgreSQL 9.1 and will throw an error if you are using an older libpq.
(define (escape-identifier x)
(if (primitive? PQescapeIdentifier)
(if (= PG_CONN nil)
(throw-error "Must be connected to a database.")
(let (pg_raw_result (PQescapeIdentifier PG_CONN x (length (get-string x))))
(if (= pg_raw_result nil)
(throw-error (error-conn))
(let (pg_result (get-string pg_raw_result))
(PQfreemem pg_raw_result)
pg_result))))
(throw-error "PQescapeIdentifier not available.")))
(define (clear-result)
(when (and PG_RESULT (not (NULL? PG_RESULT)))
(PQclear PG_RESULT))
(setq PG_RESULT nil PG_ROWX 0 PG_COLX 0))
;; @syntax (PgSQL:close-db)
;; @return Always 'true'.
;; Closes the database connection and frees associated resources.
(define (close-db)
(clear-result)
(when (and PG_CONN (not (NULL? PG_CONN)))
(PQfinish PG_CONN))
(setq PG_CONN nil)
true)
;; @syntax (PgSQL:host)
;; @return connected host name string
(define (host)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(let (s1 (PQhost PG_CONN))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:port)
;; @return connected port name string
(define (port)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(let (s1 (PQport PG_CONN))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:db)
;; @return connected database name string
(define (db)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(let (s1 (PQdb PG_CONN))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:options)
;; @return connected options string
(define (options)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(let (s1 (PQoptions PG_CONN))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:user)
;; @return connected user name string
(define (user)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(let (s1 (PQuser PG_CONN))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2))))))
;; @syntax (PgSQL:result-str <int-status-code>)
;; @param <int-status-code> An integer query result status code
;; @return string for the given integer status code
;; The return value will be one of the following strings "PGRES_EMPTY_QUERY",
;; "PGRES_COMMAND_OK", "PGRES_TUPLES_OK", "PGRES_COPY_OUT", "PGRES_COPY_IN",
;; "PGRES_BAD_RESPONSE", "PGRES_FATAL_ERROR".
(define (result-status-str status-code)
(let (s1 (PQresStatus status-code))
(if (NULL? s1)
nil
(let (s2 (get-string s1))
(if (= s2 "")
nil
s2)))))
; verify that the constant PGRES_FATAL_ERROR has the correct integer value
(if (!= "PGRES_FATAL_ERROR" (result-status-str PGRES_FATAL_ERROR) )
(throw-error
(append "PGRES_FATAL_ERROR defined as "
(string PGRES_FATAL_ERROR)
", but PostgreSQL has that defined as "
(result-status-str PGRES_FATAL_ERROR) )))
;; @syntax (PgSQL:lib-version)
;; @return libpq version as string (e.g. "9.1.1")
(define (lib-version)
(if (= PQlibVersion nil)
"Not Available - Pre 9.0"
(begin
(regex {(\d+?)(\d\d)(\d\d)$} (string (PQlibVersion)))
(append $1 "." $2 "." $3))))
;; @syntax (PgSQL:protocol-version)
;; @return protocol version "2", or "3" as string, "0" bad connection.
;; Interrogates the frontend/backend protocol being used.
(define (protocol-version)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(string (PQprotocolVersion PG_CONN))))
;; @syntax (PgSQL:server-version)
;; @return backend server version as string (e.g. "9.1.1")
(define (server-version)
(if (= PG_CONN nil)
(throw-error "Connection is not established.")
(begin
(regex {(\d+?)(\d\d)(\d\d)$} (string (PQserverVersion PG_CONN)))
(append $1 "." $2 "." $3))))
(context MAIN)
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; test data base functions
;
; Check PgSQL Test Coverage
; Function NOT Tested: PgSQL:clear-result
; Percent PgSQL Coverage: 96.9
(define (test-pgsql host user passw dbname)
(unless (PgSQL:connect host user passw dbname)
(println "PgSQL: couldn't connect 1st try.")
(exit 0))
; clean up in case the previous test failed
(PgSQL:query "DROP TABLE fruits")
(unless (PgSQL:connectdb (format {host='%s' user='%s' password='%s' dbname='%s'} (PgSQL:escape host) (PgSQL:escape user) (PgSQL:escape passw) (PgSQL:escape dbname)))
(println "PgSQL: couldn't connect 2nd try.")
(exit 0))
(if (not (PgSQL:NULL? 0))
(throw-error "NULL not valid."))
(if (PgSQL:NULL? 5)
(throw-error "NULL not valid."))
(println "\nTest Connection Info Retrieval:")
(println " database: " (PgSQL:db))
(println " user: " (PgSQL:user))
(println " host: " (PgSQL:host))
(println " port: " (PgSQL:port))
(println " options: " (PgSQL:options))
(println " libpq ver: " (PgSQL:lib-version))
(println " server ver: " (PgSQL:server-version))
(println "protocol ver: " (PgSQL:protocol-version))
(println "\nTest List Databases:")
(println (join (PgSQL:databases) ", "))
(println "\nTest Create Test Data")
(PgSQL:query "CREATE TABLE fruits (name varchar, qty int, num serial NOT NULL)")
(set 'test_data (list (list "apples" 11) (list "oranges" 22) (list "bananas" 33) (list "pears" 44)))
(println test_data)
(dolist (x test_data)
(println "Insert result: " (PgSQL:result-status-str (PgSQL:query "INSERT INTO fruits VALUES ($1, $2)" (nth 0 x) (nth 1 x))) " - " (nth 0 x) ", " (nth 1 x))
(let (myCount (PgSQL:affected-rows))
(if (or (nil? myCount) (zero? myCount))
(throw-error "Insert did not work."))))
(println "\nTest Inserted into fruits:")
(setq q "SELECT * FROM fruits ORDER BY name;")
(setq q-status (PgSQL:query q))
(println " select query: " q)
(println " select query result: " (PgSQL:result-status-str q-status))
(if (!= "PGRES_TUPLES_OK" (PgSQL:result-status-str q-status))
(throw-error "query result not ok."))
(println " rows returned: " (PgSQL:num-rows))
(if (!= 4 (PgSQL:num-rows))
(throw-error "Wrong number of rows." ))
(println " columns returned: " (PgSQL:num-fields))
(if (!= 3 (PgSQL:num-fields))
(throw-error "Wrong number of columns." ))
(println " 'qty' column number: " (PgSQL:fnumber "qty"))
(if (!= 1 (PgSQL:fnumber "qty"))
(throw-error "column number not correct."))
; gather column names from result
(set 'column_names (let (x -1)
(collect (PgSQL:fname (inc x)) (PgSQL:num-fields))))
(println "column names returned: " (join column_names ", "))
(dotimes (x (PgSQL:num-rows)) (println " row: " (PgSQL:fetch-row)))
(println " table column names: " (join (PgSQL:fields "fruits") ", "))
(println "\nTest List Tables:")
(println (join (PgSQL:tables) ", "))
(println "\nTest fetch-row and data-seek to offset 2:")
(PgSQL:query "SELECT * FROM fruits")
(PgSQL:data-seek 2)
(println (PgSQL:fetch-row))
(println "\nTest fetch-all:")
(PgSQL:query "SELECT * FROM fruits")
(println (PgSQL:fetch-all))
(println "\nTest Fetching Out of Range Values:")
(println "invalid data access (row 5, column 5): " (PgSQL:fetch-value 5 5))
; clean up after DB tests
(PgSQL:query "DROP TABLE fruits")
(println "\nTest PG Error Retrieval:")
(PgSQL:query "SELECT * FROM fruittyyyy")
(println "Should show result error on next line.\n" (PgSQL:error))
(println "Should show connection error (same as above) on next line.\n" (PgSQL:error-conn))
(println "\nTest Text Escaping:")
(println " Check escape literal: " (PgSQL:escape-literal "group's"))
(println "Check escape identifier: " (PgSQL:escape-identifier "group's"))
(println "\nTest Query PG Result Conversion to String:")
(println "result 0: " (PgSQL:result-status-str 0))
(println "result 1: " (PgSQL:result-status-str 1))
(println "result 2: " (PgSQL:result-status-str 2))
(println "result 3: " (PgSQL:result-status-str 3))
(println "result 4: " (PgSQL:result-status-str 4))
(println "result 5: " (PgSQL:result-status-str 5))
(println "result 6: " (PgSQL:result-status-str 6))
(println "result 7: " (PgSQL:result-status-str 7))
(println "result 8: " (PgSQL:result-status-str 8))
(println "result 9: " (PgSQL:result-status-str 9))
(PgSQL:close-db)
(println)
(println "Tests Completed.")
(println)
)
; eof
syntax highlighting with newLISP and newLISPdoc