1;;; pg.el --- Emacs Lisp interface to the PostgreSQL RDBMS 2;;; 3;;; Author: Eric Marsden <emarsden@laas.fr> 4;;; Maintainer: Helmut Eller <heller@common-lisp.net> 5;;; Version: 0.13+ (sorta) 6;;; Keywords: data comm database postgresql 7;;; 8;;; Copyright: (C) 1999-2005 Eric Marsden 9;;; Copyright: (C) 2005-2006 Eric Marsden, Helmut Eller 10;; 11;; This program is free software; you can redistribute it and/or 12;; modify it under the terms of the GNU General Public License as 13;; published by the Free Software Foundation; either version 2 of 14;; the License, or (at your option) any later version. 15;; 16;; This program is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20;; 21;; You should have received a copy of the GNU General Public 22;; License along with this program; if not, write to the Free 23;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 24;; MA 02111-1307, USA. 25;; 26 27 28;;; Commentary: 29 30;;; Overview ========================================================== 31;; 32;; This module lets you access the PostgreSQL object-relational DBMS 33;; from Emacs, using its socket-level frontend/backend protocol. The 34;; module is capable of automatic type coercions from a range of SQL 35;; types to the equivalent Emacs Lisp type. This is a low level API, 36;; and won't be useful to end users. Should work with GNU Emacs 19.34 37;; and up, and XEmacs 20 and up. Performance is very poor when not 38;; byte-compiled. 39 40;;; Entry points ======================================================= 41;; 42;; (with-pg-connection con (dbname user [password host port]) &body body) 43;; A macro which opens a connection to database DBNAME, executes the 44;; BODY forms then disconnects. See function `pg:connect' for details 45;; of the connection arguments. 46;; 47;; (with-pg-transaction con &body body) 48;; A macro which executes the BODY forms wrapped in an SQL transaction. 49;; CON is a connection to the database. If an error occurs during the 50;; execution of the forms, a ROLLBACK instruction is executed. 51;; 52;; (pg:connect dbname user [password host port]) -> connection 53;; Connect to the database DBNAME on HOST (defaults to localhost) 54;; at PORT (defaults to 5432) via TCP/IP and log in as USER. If 55;; the database requires a password, send PASSWORD as clear text. 56;; Set the output date type to 'ISO', and initialize our type 57;; parser tables. 58;; 59;; (pg:exec connection &rest sql) -> pgresult 60;; Concatenate the SQL strings and send to the backend. Retrieve 61;; all the information returned by the database and return it in 62;; an opaque record PGRESULT. 63;; 64;; (pg:result pgresult what &rest args) -> info 65;; Extract information from the PGRESULT. The WHAT keyword can be 66;; one of 67;; * :connection 68;; * :status 69;; * :attributes 70;; * :tuples 71;; * :tuple tupleNumber 72;; * :oid 73;; `:connection' allows you to retrieve the database connection. 74;; `:status' is a string returned by the backend to indicate the 75;; status of the command; it is something like "SELECT" for a 76;; select command, "DELETE 1" if the deletion affected a single 77;; row, etc. `:attributes' is a list of tuples providing metadata: 78;; the first component of each tuple is the attribute's name as a 79;; string, the second an integer representing its PostgreSQL type, 80;; and the third an integer representing the size of that type. 81;; `:tuples' returns all the data retrieved from the database, as a 82;; list of lists, each list corresponding to one row of data 83;; returned by the backend. `:tuple num' can be used to extract a 84;; specific tuple (numbering starts at 0). `:oid' allows you to 85;; retrieve the OID returned by the backend if the command was an 86;; insertion; the OID is a unique identifier for that row in the 87;; database (this is PostgreSQL-specific, please refer to the 88;; documentation for more details). 89;; 90;; (pg:disconnect connection) -> nil 91;; Close the database connection. 92;; 93;; (pg:for-each connection select-form callback) 94;; Calls CALLBACK on each tuple returned by SELECT-FORM. Declares 95;; a cursor for SELECT-FORM, then fetches tuples using repeated 96;; executions of FETCH 1, until no results are left. The cursor is 97;; then closed. The work is performed within a transaction. When 98;; you have a large amount of data to handle, this usage is more 99;; efficient than fetching all the tuples in one go. 100;; 101;; If you wish to browse the results, each one in a separate 102;; buffer, you could have the callback insert each tuple into a 103;; buffer created with (generate-new-buffer "myprefix"), then use 104;; ibuffer's "/ n" to list/visit/delete all buffers whose names 105;; match myprefix. 106;; 107;; (pg:databases connection) -> list of strings 108;; Return a list of the databases available at this site (a 109;; database is a set of tables; in a virgin PostgreSQL 110;; installation there is a single database named "template1"). 111;; 112;; (pg:tables connection) -> list of strings 113;; Return a list of the tables present in the database to which we 114;; are currently connected. Only include user tables: system 115;; tables are excluded. 116;; 117;; (pg:columns connection table) -> list of strings 118;; Return a list of the columns (or attributes) in TABLE, which 119;; must be a table in the database to which we are currently 120;; connected. We only include the column names; if you want more 121;; detailed information (attribute types, for example), it can be 122;; obtained from `pg:result' on a SELECT statement for that table. 123;; 124;; (pg:lo-create conn . args) -> oid 125;; Create a new large object (BLOB, or binary large object in 126;; other DBMSes parlance) in the database to which we are 127;; connected via CONN. Returns an OID (which is represented as an 128;; elisp integer) which will allow you to use the large object. 129;; Optional ARGS are a Unix-style mode string which determines the 130;; permissions of the newly created large object, one of "r" for 131;; read-only permission, "w" for write-only, "rw" for read+write. 132;; Default is "r". 133;; 134;; Large-object functions MUST be used within a transaction (see 135;; the macro `with-pg-transaction'). 136;; 137;; (pg:lo-open conn oid . args) -> fd 138;; Open a large object whose unique identifier is OID (an elisp 139;; integer) in the database to which we are connected via CONN. 140;; Optional ARGS is a Unix-style mode string as for pg:lo-create; 141;; which defaults to "r" read-only permissions. Returns a file 142;; descriptor (an elisp integer) which can be used in other 143;; large-object functions. 144;; 145;; (pg:lo-close conn fd) 146;; Close the file descriptor FD which was associated with a large 147;; object. Note that this does not delete the large object; use 148;; `pg:lo-unlink' for that. 149;; 150;; (pg:lo-read conn fd bytes) -> string 151;; Read BYTES from the file descriptor FD which is associated with 152;; a large object. Return an elisp string which should be BYTES 153;; characters long. 154;; 155;; (pg:lo-write connection fd buf) 156;; Write the bytes contained in the elisp string BUF to the 157;; large object associated with the file descriptor FD. 158;; 159;; (pg:lo-lseek conn fd offset whence) 160;; Do the equivalent of a lseek(2) on the file descriptor FD which 161;; is associated with a large object; ie reposition the read/write 162;; file offset for that large object to OFFSET (an elisp 163;; integer). WHENCE has the same significance as in lseek(); it 164;; should be one of SEEK_SET (set the offset to the absolute 165;; position), SEEK_CUR (set the offset relative to the current 166;; offset) or SEEK_END (set the offset relative to the end of the 167;; file). WHENCE should be an elisp integer whose values can be 168;; obtained from the header file <unistd.h> (probably 0, 1 and 2 169;; respectively). 170;; 171;; (pg:lo-tell conn oid) -> integer 172;; Do the equivalent of an ftell(3) on the file associated with 173;; the large object whose unique identifier is OID. Returns the 174;; current position of the file offset for the object's associated 175;; file descriptor, as an elisp integer. 176;; 177;; (pg:lo-unlink conn oid) 178;; Remove the large object whose unique identifier is OID from the 179;; system (in the current implementation of large objects in 180;; PostgreSQL, each large object is associated with an object in 181;; the filesystem). 182;; 183;; (pg:lo-import conn filename) -> oid 184;; Create a new large object and initialize it to the data 185;; contained in the file whose name is FILENAME. Returns an OID 186;; (as an elisp integer). Note that is operation is only syntactic 187;; sugar around the basic large-object operations listed above. 188;; 189;; (pg:lo-export conn oid filename) 190;; Create a new file named FILENAME and fill it with the contents 191;; of the large object whose unique identifier is OID. This 192;; operation is also syntactic sugar. 193;; 194;; 195;; Boolean variable `pg:disable-type-coercion' which can be set to 196;; non-nil (before initiating a connection) to disable the library's 197;; type coercion facility. Default is t. 198;; 199;; 200;; The interface is pretty slow (byte compiling helps a lot). Maybe 201;; someone can suggest a better way of reading input from the network 202;; stream. Please note that your postmaster has to be started with the 203;; `-i' option in order to accept TCP/IP connections (this is not the 204;; default). For more information about PostgreSQL see 205;; <URL:http://www.PostgreSQL.org/>. 206;; 207;; Thanks to Eric Ludlam <zappo@gnu.org> for discovering a bug in the 208;; date parsing routines, to Hartmut Pilch and Yoshio Katayama for 209;; adding multibyte support, and to Doug McNaught and Pavel Janik for 210;; bug fixes. 211 212 213;; SECURITY NOTE: setting up PostgreSQL to accept TCP/IP connections 214;; has security implications; please consult the documentation for 215;; details. pg.el supports neither the crypt authentication method, 216;; nor Kerberos (support for these can't be added to Emacs due to 217;; silly US crypto export regulations). However, it is possible to use 218;; the port forwarding capabilities of ssh to establish a connection 219;; to the backend over TCP/IP, which provides both a secure 220;; authentication mechanism and encryption (and optionally 221;; compression) of data passing through the tunnel. Here's how to do 222;; it (thanks to Gene Selkov, Jr. <selkovjr@mcs.anl.gov> for the 223;; description): 224;; 225;; 1. Establish a tunnel to the backend machine, like this: 226;; 227;; ssh -L 3333:backend.dom:5432 postgres@backend.dom 228;; 229;; The first number in the -L argument, 3333, is the port number of 230;; your end of the tunnel. The second number, 5432, is the remote 231;; end of the tunnel -- the port number your backend is using. The 232;; name or the address in between the port numbers belongs to the 233;; server machine, as does the last argument to ssh that also includes 234;; the optional user name. Without the user name, ssh will try the 235;; name you are currently logged on as on the client machine. You can 236;; use any user name the server machine will accept, not necessarily 237;; those related to postgres. 238;; 239;; 2. Now that you have a running ssh session, you can point pg.el to 240;; the local host at the port number which you specified in step 1. 241;; For example, 242;; 243;; (pg:connect "dbname" "user" "password" "localhost" 3333) 244;; 245;; You can omit the port argument if you chose 5432 as the local 246;; end of the tunnel, since pg.el defaults to this value. 247 248 249;;; INSTALL ========================================================= 250;; 251;; Place this file in a directory somewhere in the load-path, then 252;; byte-compile it (do a `B' on it in dired, for example). Place a 253;; line such as `(require 'pg)' in your emacs initialization file. 254 255 256;;; TODO ============================================================ 257;; 258;; * add a mechanism for parsing user-defined types. The user should 259;; be able to define a parse function and a type-name; we query 260;; pg_type to get the type's OID and add the information to 261;; pg:parsers. 262;; 263;; * in a future release I will probably modify the numeric conversion 264;; routines to return elisp floating point values instead of elisp 265;; integers, in order to work around possible overflow problems. 266 267 268;;; Code: 269 270(eval-and-compile 271 (require 'cl)) 272 273(defvar pg:disable-type-coercion nil 274 "*Non-nil disables the type coercion mechanism. 275The default is nil, which means that data recovered from the database 276is coerced to the corresponding Emacs Lisp type before being returned; 277for example numeric data is transformed to Emacs Lisp numbers, and 278booleans to booleans. 279 280The coercion mechanism requires an initialization query to the 281database, in order to build a table mapping type names to OIDs. This 282option is provided mainly in case you wish to avoid the overhead of 283this initial query. The overhead is only incurred once per Emacs 284session (not per connection to the backend).") 285 286;;(defvar pg:coding-system nil 287;; "*The coding system that PostgreSQL was compiled to use. Should be 288;;nil if PostgreSQL wasn't compiled with multibyte support, or for 289;;example the symbol `utf-8' if your PostgreSQL was compiled with 290;;`--enable-multibyte=UNICODE' and you are using a MULE-UCS-enabled 291;;Emacs.") 292 293(defconst pg:NAMEDATALEN 32) ; postgres_ext.h 294(defconst pg:PG_PROTOCOL_LATEST_MAJOR 2) ; libpq/pgcomm.h 295(defconst pg:PG_PROTOCOL_63_MAJOR 1) 296(defconst pg:PG_PROTOCOL_LATEST_MINOR 0) 297(defconst pg:SM_DATABASE 64) 298(defconst pg:SM_USER 32) 299(defconst pg:SM_OPTIONS 64) 300(defconst pg:SM_UNUSED 64) 301(defconst pg:SM_TTY 64) 302 303(defconst pg:AUTH_REQ_OK 0) 304(defconst pg:AUTH_REQ_KRB4 1) 305(defconst pg:AUTH_REQ_KRB5 2) 306(defconst pg:AUTH_REQ_PASSWORD 3) 307(defconst pg:AUTH_REQ_CRYPT 4) 308(defconst pg:AUTH_REQ_MD5 5) 309 310(defconst pg:STARTUP_MSG 7) 311(defconst pg:STARTUP_KRB4_MSG 10) 312(defconst pg:STARTUP_KRB5_MSG 11) 313(defconst pg:STARTUP_PASSWORD_MSG 14) 314 315(defconst pg:StartupPacketSize 316 (+ 4 4 pg:SM_DATABASE pg:SM_USER pg:SM_OPTIONS pg:SM_UNUSED pg:SM_TTY)) 317 318(defconst pg:MAX_MESSAGE_LEN 8192) ; libpq-fe.h 319 320(defconst pg:INV_ARCHIVE 65536) ; fe-lobj.c 321(defconst pg:INV_WRITE 131072) 322(defconst pg:INV_READ 262144) 323(defconst pg:LO_BUFIZE 1024) 324 325;; this regular expression works in Emacs 21 and XEmacs, but not Emacs 326;; 20.x (no match-exactly-n-times facility) 327;; (defconst pg:ISODATE_REGEX (concat 328;; "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) " ; Y-M-D 329;; "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\):\\([.0-9]+\\)" ; H:M:S.S 330;; "\\([-+][0-9]+\\)")) ; TZ 331 332(defconst pg:ISODATE_REGEX 333 (concat "\\([0-9]+\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\) " ; Y-M-D 334 "\\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([.0-9]+\\)" ; H:M:S.S 335 "\\([-+][0-9]+\\)?")) ; TZ 336 337;; alist of (oid . parser) pairs. This is built dynamically at 338;; initialization of the connection with the database (once generated, 339;; the information is shared between connections). 340(defvar pg:parsers '()) 341 342(defstruct pgcon process pid secret (binaryp nil) encoding) 343(defstruct pgresult connection status attributes tuples portal) 344 345(defun pg:flush (connection) 346 ;;(accept-process-output (pgcon-process connection)) 347 ) 348 349;; this is ugly because lambda lists don't do destructuring 350(defmacro with-pg-connection (con open-args &rest body) 351 "Bindspec is of the form (connection open-args), where OPEN-ARGS are 352as for PG:CONNECT. The database connection is bound to the variable 353CONNECTION. If the connection is unsuccessful, the forms are not 354evaluated. Otherwise, the BODY forms are executed, and upon 355termination, normal or otherwise, the database connection is closed." 356 (declare 357 (debug (sexp sexp &rest form)) 358 (indent 2)) 359 (let ((open-argsv (make-symbol "open-argsv"))) 360 `(let* ((,open-argsv ,open-args) 361 (,con (apply 'pg:connect ,open-argsv))) 362 (unwind-protect 363 (progn ,@body) 364 (when ,con (pg:disconnect ,con)))))) 365 366(defmacro with-pg-transaction (con &rest body) 367 "Execute BODY forms in a BEGIN..END block. 368If a PostgreSQL error occurs during execution of the forms, execute 369a ROLLBACK command. 370Large-object manipulations _must_ occur within a transaction, since 371the large object descriptors are only valid within the context of a 372transaction." 373 (declare 374 (debug (sexp &rest form)) 375 (indent 1)) 376 (let ((exc-sym (gensym))) 377 `(progn 378 (pg:exec ,con "BEGIN WORK") 379 (condition-case ,exc-sym 380 (prog1 (progn ,@body) 381 (pg:exec ,con "COMMIT WORK")) 382 (error 383 (message "PostgreSQL error %s" ,exc-sym) 384 (pg:exec ,con "ROLLBACK WORK")))))) 385 386(defun pg:for-each (conn select-form callback) 387 "Create a cursor for SELECT-FORM, and call CALLBACK for each result. 388Uses the PostgreSQL database connection CONN. SELECT-FORM must be an 389SQL SELECT statement. The cursor is created using an SQL DECLARE 390CURSOR command, then results are fetched successively until no results 391are left. The cursor is then closed. 392 393The work is performed within a transaction. The work can be 394interrupted before all tuples have been handled by THROWing to a tag 395called 'pg-finished." 396 (let ((cursor (symbol-name (gensym "pgelcursor")))) 397 (catch 'pg-finished 398 (with-pg-transaction conn 399 (pg:exec conn "DECLARE " cursor " CURSOR FOR " select-form) 400 (unwind-protect 401 (loop for res = (pg:result (pg:exec conn "FETCH 1 FROM " cursor) :tuples) 402 until (zerop (length res)) 403 do (funcall callback res)) 404 (pg:exec conn "CLOSE " cursor)))))) 405 406 407(defun* pg:connect (dbname user 408 &optional (password "") (host "localhost") (port 5432) 409 (encoding 'latin-1)) 410 "Initiate a connection with the PostgreSQL backend. 411Connect to the database DBNAME with the username USER, on PORT of 412HOST, providing PASSWORD if necessary. Return a connection to the 413database (as an opaque type). PORT defaults to 5432, HOST to 414\"localhost\", and PASSWORD to an empty string." 415 (let* ((buf (generate-new-buffer " *PostgreSQL*")) 416 process connection 417 (user-packet-length (+ pg:SM_USER pg:SM_OPTIONS pg:SM_UNUSED pg:SM_TTY))) 418 (with-current-buffer buf 419 (set-buffer-multibyte nil)) 420 ;;(message "open-network...") 421 (setq process (open-network-stream "postgres" buf host port)) 422 ;;(message "open-network... done.") 423 (set-process-coding-system process 'binary 'binary) 424 (setq connection (make-pgcon :process process :encoding encoding)) 425 ;; send the startup packet 426 (pg:send-int connection pg:StartupPacketSize 4) 427 (pg:send-int connection pg:PG_PROTOCOL_63_MAJOR 2) 428 (pg:send-int connection pg:PG_PROTOCOL_LATEST_MINOR 2) 429 (pg:send connection dbname pg:SM_DATABASE) 430 (pg:send connection user user-packet-length) 431 (pg:flush connection) 432 (loop for c = (pg:read-char connection) do 433 (cond ((eq ?E c) 434 (error "Backend error: %s" (pg:read-string connection 4096))) 435 ((eq ?R c) 436 (let ((areq (pg:read-net-int connection 4))) 437 (cond 438 ((= areq pg:AUTH_REQ_OK) 439 (and (not pg:disable-type-coercion) 440 (null pg:parsers) 441 (pg:initialize-parsers connection)) 442 (let ((enc (ecase encoding 443 (latin-1 "LATIN-1") 444 (utf-8 "UTF-8")))) 445 (pg:exec connection 446 (format "SET client_encoding = '%s';" enc))) 447 (pg:exec connection "SET datestyle = 'ISO';") 448 (return-from pg:connect connection)) 449 ((= areq pg:AUTH_REQ_PASSWORD) 450 (pg:send-int connection (+ 5 (length password)) 4) 451 (pg:send connection password) 452 (pg:send-int connection 0 1) 453 (pg:flush connection)) 454 ((= areq pg:AUTH_REQ_CRYPT) 455 (error "Crypt authentication not supported")) 456 ((= areq pg:AUTH_REQ_KRB4) 457 (error "Kerberos4 authentication not supported")) 458 ((= areq pg:AUTH_REQ_KRB5) 459 (error "Kerberos5 authentication not supported")) 460 ((= areq pg:AUTH_REQ_MD5) 461 (let* ((salt (pg:read-chars connection 4)) 462 (crypted (pg:md5-encode user password salt))) 463 ;;(message "md5 %S %S %S => %S\n" 464 ;; user password salt crypted) 465 (pg:send-int connection (+ 5 (length crypted)) 4) 466 (pg:send connection crypted) 467 (pg:send-int connection 0 1) 468 (pg:flush connection))) 469 (t 470 (error "Can't do that type of authentication: %s" areq))))) 471 (t 472 (error "Problem connecting: expected an authentication response")))))) 473 474(defun* pg:exec (connection &rest args) 475 "Execute the SQL command given by the concatenation of ARGS 476on the database to which we are connected via CONNECTION. Return 477a result structure which can be decoded using `pg:result'." 478 (let ((sql (apply #'concat args)) 479 (tuples '()) 480 (attributes '()) 481 (result (make-pgresult :connection connection))) 482 (if (> (length sql) pg:MAX_MESSAGE_LEN) 483 (error "SQL statement too long: %s" sql)) 484 (let ((str (encode-coding-string (format "%c%s%c" ?Q sql 0) 485 (pgcon-encoding connection)))) 486 ;;;(debug nil str) 487 (pg:send connection str)) 488 (pg:flush connection) 489 (loop for c = (pg:read-char connection) do 490 (case c 491 ;; AsynchronousNotify 492 (?A 493 (let ((pid (pg:read-int connection 4)) 494 (msg (pg:read-string connection pg:MAX_MESSAGE_LEN))) 495 (message "Asynchronous notify %s" msg))) 496 497 ;; BinaryRow 498 (?B 499 (setf (pgcon-binaryp connection) t) 500 (or attributes (error "Tuple received before metadata")) 501 (push (pg:read-tuple connection attributes) tuples)) 502 503 ;; CompletedResponse 504 (?C 505 (let* ((status (pg:read-string connection pg:MAX_MESSAGE_LEN))) 506 (setf (pgresult-status result) status) 507 (setf (pgresult-tuples result) (nreverse tuples)) 508 (setf (pgresult-attributes result) attributes) 509 (return-from pg:exec result))) 510 511 ;; TextDataTransfer 512 (?D 513 (setf (pgcon-binaryp connection) nil) 514 (or attributes (error "Tuple received before metadata")) 515 (push (pg:read-tuple connection attributes) tuples)) 516 517 ;; ErrorResponse 518 (?E 519 (let ((msg (pg:read-string connection pg:MAX_MESSAGE_LEN))) 520 (error "Backend error: %s" msg))) 521 522 ;; EmptyQueryResponse 523 (?I 524 (let ((c (pg:read-char connection))) 525 )) 526 527 ;; BackendKeyData 528 (?K 529 (setf (pgcon-pid connection) (pg:read-net-int connection 4)) 530 (setf (pgcon-secret connection) (pg:read-net-int connection 4))) 531 532 533 ;; NoticeResponse 534 (?N 535 (let ((notice (pg:read-string connection pg:MAX_MESSAGE_LEN))) 536 (message "NOTICE: %s" notice) 537 ;;(debug nil notice) 538 )) 539 540 ;; CursorResponse 541 (?P 542 (let ((portal (pg:read-string connection pg:MAX_MESSAGE_LEN))) 543 (setf (pgresult-portal result) portal))) 544 545 ;; RowDescription 546 (?T 547 (and attributes (error "Cannot handle multiple result group")) 548 (setq attributes (pg:read-attributes connection))) 549 550 ;; ReadyForQuery 551 (?Z t) 552 553 (t (error "Unknown response type from backend: %s" c)))))) 554 555(defun pg:result (result what &rest arg) 556 "Extract WHAT component of RESULT. 557RESULT should be a structure obtained from a call to `pg:exec', 558and the keyword WHAT should be one of 559 :connection -> return the connection object 560 :status -> return the status string provided by the database 561 :attributes -> return the metadata, as a list of lists 562 :tuples -> return the data, as a list of lists 563 :tuple n -> return the nth component of the data 564 :oid -> return the OID (a unique identifier generated by PostgreSQL 565 for each row resulting from an insertion)" 566 (cond ((eq :connection what) (pgresult-connection result)) 567 ((eq :status what) (pgresult-status result)) 568 ((eq :attributes what) (pgresult-attributes result)) 569 ((eq :tuples what) (pgresult-tuples result)) 570 ((eq :tuple what) 571 (let ((which (if (integerp (car arg)) (car arg) 572 (error "%s is not an integer" arg))) 573 (tuples (pgresult-tuples result))) 574 (nth which tuples))) 575 ((eq :oid what) 576 (let ((status (pgresult-status result))) 577 (if (string= "INSERT" (substring status 0 6)) 578 (string-to-number (substring status 7 (position ? status :start 7))) 579 (error "Only INSERT commands generate an oid: %s" status)))) 580 (t 581 (error "Unknown result request %s" what)))) 582 583(defun pg:disconnect (connection) 584 "Close the database connection. 585This command should be used when you have finished with the database. 586It will release memory used to buffer the data transfered between 587PostgreSQL and Emacs. CONNECTION should no longer be used." 588 (pg:send connection "X") 589 (pg:flush connection) 590 (delete-process (pgcon-process connection)) 591 (kill-buffer (process-buffer (pgcon-process connection)))) 592 593 594;; type coercion support ============================================== 595;; 596;; When returning data from a SELECT statement, PostgreSQL starts by 597;; sending some metadata describing the attributes. This information 598;; is read by `pg:read-attributes', and consists of each attribute's 599;; name (as a string), its size (in bytes), and its type (as an oid 600;; which identifies a row in the PostgreSQL system table pg_type). Each 601;; row in pg_type includes the type's name (as a string). 602;; 603;; We are able to parse a certain number of the PostgreSQL types (for 604;; example, numeric data is converted to a numeric Emacs Lisp type, 605;; dates are converted to the Emacs date representation, booleans to 606;; Emacs Lisp booleans). However, there isn't a fixed mapping from a 607;; type to its OID which is guaranteed to be stable across database 608;; installations, so we need to build a table mapping OIDs to parser 609;; functions. 610;; 611;; This is done by the procedure `pg:initialize-parsers', which is run 612;; the first time a connection is initiated with the database from 613;; this invocation of Emacs, and which issues a SELECT statement to 614;; extract the required information from pg_type. This initialization 615;; imposes a slight overhead on the first request, which you can avoid 616;; by setting `pg:disable-type-coercion' to non-nil if it bothers you. 617;; ==================================================================== 618 619 620;; this is a var not a const to allow user-defined types (a PostgreSQL 621;; feature not present in ANSI SQL). The user can add a (type-name . 622;; type-parser) pair and call `pg:initialize-parsers', after which the 623;; user-defined type should be returned parsed from `pg:result'. 624;; Untested. 625(defvar pg:type-parsers 626 `(("bool" . ,'pg:bool-parser) 627 ("char" . ,'pg:text-parser) 628 ("char2" . ,'pg:text-parser) 629 ("char4" . ,'pg:text-parser) 630 ("char8" . ,'pg:text-parser) 631 ("char16" . ,'pg:text-parser) 632 ("text" . ,'pg:text-parser) 633 ("varchar" . ,'pg:text-parser) 634 ("numeric" . ,'pg:number-parser) 635 ("int2" . ,'pg:number-parser) 636 ("int28" . ,'pg:number-parser) 637 ("int4" . ,'pg:number-parser) 638 ("oid" . ,'pg:number-parser) 639 ("float4" . ,'pg:number-parser) 640 ("float8" . ,'pg:number-parser) 641 ("money" . ,'pg:number-parser) 642 ("abstime" . ,'pg:isodate-parser) 643 ("date" . ,'pg:date-parser) 644 ("timestamp" . ,'pg:isodate-parser) 645 ("datetime" . ,'pg:isodate-parser) 646 ("time" . ,'pg:text-parser) ; preparsed "15:32:45" 647 ("reltime" . ,'pg:text-parser) ; don't know how to parse these 648 ("timespan" . ,'pg:text-parser) 649 ("tinterval" . ,'pg:text-parser))) 650 651;; see `man pgbuiltin' for details on PostgreSQL builtin types 652(defun pg:number-parser (str) (string-to-number str)) 653 654;; bound in pg:read-tuple 655(defvar pg::text-encoding nil) 656(defsubst pg:text-parser (str) 657 (assert pg::text-encoding) 658 (decode-coding-string str pg::text-encoding)) 659 660(defun pg:bool-parser (str) 661 (cond ((string= "t" str) t) 662 ((string= "f" str) nil) 663 (t (error "Badly formed boolean from backend: %s" str)))) 664 665;; format for ISO dates is "1999-10-24" 666(defun pg:date-parser (str) 667 (let ((year (string-to-number (substring str 0 4))) 668 (month (string-to-number (substring str 5 7))) 669 (day (string-to-number (substring str 8 10)))) 670 (encode-time 0 0 0 day month year))) 671 672;; format for abstime/timestamp etc with ISO output syntax is 673;;; "1999-01-02 14:32:53+01" 674;; which we convert to the internal Emacs date/time representation 675;; (there may be a fractional seconds quantity as well, which the regex 676;; handles) 677(defun pg:isodate-parser (str) 678 (if (string-match pg:ISODATE_REGEX str) ; is non-null 679 (let ((year (string-to-number (match-string 1 str))) 680 (month (string-to-number (match-string 2 str))) 681 (day (string-to-number (match-string 3 str))) 682 (hours (string-to-number (match-string 4 str))) 683 (minutes (string-to-number (match-string 5 str))) 684 (seconds (round (string-to-number (match-string 6 str)))) 685 (tzs (when (match-string 7 str) 686 (* 3600 (string-to-number (match-string 7 str)))))) 687 (encode-time seconds minutes hours day month year tzs)) 688 (error "Badly formed ISO timestamp from backend: %s" str))) 689 690 691(defun pg:initialize-parsers (connection) 692 (let* ((pgtypes (pg:exec connection "SELECT typname,oid FROM pg_type")) 693 (tuples (pg:result pgtypes :tuples))) 694 (setq pg:parsers '()) 695 (mapcar 696 #'(lambda (tuple) 697 (let* ((typname (first tuple)) 698 (oid (string-to-number (second tuple))) 699 (type (assoc* typname pg:type-parsers :test #'string=))) 700 (if (consp type) 701 (push (cons oid (cdr type)) pg:parsers)))) 702 tuples))) 703 704(defun pg:parse (str oid) 705 (let ((parser (assoc* oid pg:parsers :test #'eq))) 706 (if (consp parser) 707 (funcall (cdr parser) str) 708 str))) 709 710 711;; md5 auth 712 713(defun pg:md5-encode (user password salt) 714 (format "md5%s" (pg:md5-key-salt (pg:md5-key-salt password user) salt))) 715 716(defun pg:md5-key-salt (key salt) 717 (let ((d (pg:md5-hex-digest (concat key salt)))) 718 (assert (= (length d) 32)) 719 d)) 720 721(defun pg:md5-hex-digest (string) 722 (cond ((fboundp 'md5) (md5 string)) 723 (t 724 (let ((tmpfile (make-temp-name "/tmp/md5-hex"))) 725 (with-temp-file tmpfile (insert string)) 726 (unwind-protect 727 (with-temp-buffer 728 (let ((c (call-process "md5sum" tmpfile (current-buffer)))) 729 (assert (zerop c)) 730 (goto-char (point-min)) 731 (search-forward " ") 732 (buffer-substring 1 (1- (point))))) 733 (delete-file tmpfile)))))) 734 735;; large object support ================================================ 736;; 737;; Humphrey: Who is Large and to what does he object? 738;; 739;; Large objects are the PostgreSQL way of doing what most databases 740;; call BLOBs (binary large objects). In addition to being able to 741;; stream data to and from large objects, PostgreSQL's 742;; object-relational capabilities allow the user to provide functions 743;; which act on the objects. 744;; 745;; For example, the user can define a new type called "circle", and 746;; define a C or Tcl function called `circumference' which will act on 747;; circles. There is also an inheritance mechanism in PostgreSQL. 748;; 749;;====================================================================== 750(defvar pg:lo-initialized nil) 751(defvar pg:lo-functions '()) 752 753(defun pg:lo-init (connection) 754 (let* ((res (pg:exec connection 755 "SELECT proname, oid from pg_proc WHERE " 756 "proname = 'lo_open' OR " 757 "proname = 'lo_close' OR " 758 "proname = 'lo_creat' OR " 759 "proname = 'lo_unlink' OR " 760 "proname = 'lo_lseek' OR " 761 "proname = 'lo_tell' OR " 762 "proname = 'loread' OR " 763 "proname = 'lowrite'"))) 764 (setq pg:lo-functions '()) 765 (mapc 766 #'(lambda (tuple) 767 (push (cons (car tuple) (cadr tuple)) pg:lo-functions)) 768 (pg:result res :tuples)) 769 (setq pg:lo-initialized t))) 770 771;; fn is either an integer, in which case it is the OID of an element 772;; in the pg_proc table, and otherwise it is a string which we look up 773;; in the alist `pg:lo-functions' to find the corresponding OID. 774(defun pg:fn (connection fn integer-result &rest args) 775 (or pg:lo-initialized (pg:lo-init connection)) 776 (let ((fnid (cond ((integerp fn) fn) 777 ((not (stringp fn)) 778 (error "Expecting a string or an integer")) 779 ((assoc fn pg:lo-functions) ; blech 780 (cdr (assoc fn pg:lo-functions))) 781 (t 782 (error "Unknown builtin function: %S" fn))))) 783 (pg:send-char connection ?F) 784 (pg:send-char connection 0) 785 (pg:send-int connection fnid 4) 786 (pg:send-int connection (length args) 4) 787 (mapc #'(lambda (arg) 788 (cond ((integerp arg) 789 (pg:send-int connection 4 4) 790 (pg:send-int connection arg 4)) 791 ((stringp arg) 792 (pg:send-int connection (length arg) 4) 793 (pg:send connection arg)) 794 (t 795 (error "Unknown fastpath type: %S" arg)))) 796 args) 797 (pg:flush connection) 798 (loop with result = '() 799 for c = (pg:read-char connection) do 800 (case c 801 ;; ErrorResponse 802 (?E (error (pg:read-string connection 4096))) 803 804 ;; FunctionResultResponse 805 (?V (setq result t)) 806 807 ;; Nonempty response 808 (?G 809 (let* ((len (pg:read-net-int connection 4)) 810 (res (if integer-result 811 (pg:read-net-int connection len) 812 (pg:read-chars connection len)))) 813 (setq result res))) 814 815 ;; NoticeResponse 816 (?N 817 (let ((notice (pg:read-string connection pg:MAX_MESSAGE_LEN))) 818 (message "NOTICE: %s" notice)) 819 (unix-sync)) 820 821 ;; ReadyForQuery 822 (?Z t) 823 824 ;; end of FunctionResult 825 (?0 (return result)) 826 827 (t (error "Unexpected character in pg:fn: ?%c" c)))))) 828 829;; returns an OID 830(defun pg:lo-create (connection &optional args) 831 (let* ((modestr (or args "r")) 832 (mode (cond ((integerp modestr) modestr) 833 ((string= "r" modestr) pg:INV_READ) 834 ((string= "w" modestr) pg:INV_WRITE) 835 ((string= "rw" modestr) 836 (logior pg:INV_READ pg:INV_WRITE)) 837 (t (error "pg:lo-create: bad mode %s" modestr)))) 838 (oid (pg:fn connection "lo_creat" t mode))) 839 (cond ((not (integerp oid)) 840 (error "Didn't return an OID: %S" oid)) 841 ((zerop oid) 842 (error "Can't create large object")) 843 (t oid)))) 844 845;; args = modestring (default "r", or "w" or "rw") 846;; returns a file descriptor for use in later pg:lo-* procedures 847(defun pg:lo-open (connection oid &optional args) 848 (let* ((modestr (or args "r")) 849 (mode (cond ((integerp modestr) modestr) 850 ((string= "r" modestr) pg:INV_READ) 851 ((string= "w" modestr) pg:INV_WRITE) 852 ((string= "rw" modestr) 853 (logior pg:INV_READ pg:INV_WRITE)) 854 (t (error "pg:lo-open: bad mode %s" modestr)))) 855 (fd (pg:fn connection "lo_open" t oid mode))) 856 (unless (integerp fd) 857 (error "Couldn't open large object")) 858 fd)) 859 860(defsubst pg:lo-close (connection fd) 861 (pg:fn connection "lo_close" t fd)) 862 863(defsubst pg:lo-read (connection fd bytes) 864 (pg:fn connection "loread" nil fd bytes)) 865 866(defsubst pg:lo-write (connection fd buf) 867 (pg:fn connection "lowrite" t fd buf)) 868 869(defsubst pg:lo-lseek (connection fd offset whence) 870 (pg:fn connection "lo_lseek" t fd offset whence)) 871 872(defsubst pg:lo-tell (connection oid) 873 (pg:fn connection "lo_tell" t oid)) 874 875(defsubst pg:lo-unlink (connection oid) 876 (pg:fn connection "lo_unlink" t oid)) 877 878;; returns an OID 879;; FIXME should use unwind-protect here 880(defun pg:lo-import (connection filename) 881 (let* ((buf (get-buffer-create (format " *pg-%s" filename))) 882 (oid (pg:lo-create connection "rw")) 883 (fdout (pg:lo-open connection oid "w")) 884 (pos (point-min))) 885 (save-excursion 886 (set-buffer buf) 887 (insert-file-contents-literally filename) 888 (while (< pos (point-max)) 889 (pg:lo-write 890 connection fdout 891 (buffer-substring-no-properties pos (min (point-max) (incf pos 1024))))) 892 (pg:lo-close connection fdout) 893 (kill-buffer buf) 894 oid))) 895 896(defun pg:lo-export (connection oid filename) 897 (let* ((buf (get-buffer-create (format " *pg-%d" oid))) 898 (fdin (pg:lo-open connection oid "r"))) 899 (save-excursion 900 (set-buffer buf) 901 (do ((str (pg:lo-read connection fdin 1024) 902 (pg:lo-read connection fdin 1024))) 903 ((or (not str) 904 (zerop (length str)))) 905 (insert str)) 906 (pg:lo-close connection fdin) 907 (write-file filename) 908 (kill-buffer buf)))) 909 910 911 912;; DBMS metainformation ================================================ 913;; 914;; Metainformation such as the list of databases present in the 915;; database management system, list of tables, attributes per table. 916;; This information is not available directly, but can be deduced by 917;; querying the system tables. 918;; 919;; Based on the queries issued by psql in response to user commands 920;; `\d' and `\d tablename'; see file 921;; /usr/local/src/pgsql/src/bin/psql/psql.c 922;; ===================================================================== 923(defun pg:databases (conn) 924 "Return a list of the databases available at this site." 925 (let ((res (pg:exec conn "SELECT datname FROM pg_database"))) 926 (apply #'append (pg:result res :tuples)))) 927 928(defun pg:tables (conn) 929 "Return a list of the tables present in this database." 930 (let ((res (pg:exec conn "SELECT relname FROM pg_class, pg_user WHERE " 931 "(relkind = 'r' OR relkind = 'i' OR relkind = 'S') AND " 932 "relname !~ '^pg_' AND usesysid = relowner ORDER BY relname"))) 933 (apply #'append (pg:result res :tuples)))) 934 935(defun pg:columns (conn table) 936 "Return a list of the columns present in TABLE." 937 (let* ((sql (format "SELECT * FROM %s WHERE 0 = 1" table)) 938 (res (pg:exec conn sql))) 939 (mapcar #'car (pg:result res :attributes)))) 940 941(defun pg:backend-version (conn) 942 "Version an operating environment of the backend as a string." 943 (let ((res (pg:exec conn "SELECT version()"))) 944 (first (pg:result res :tuple 0)))) 945 946 947;; support routines ============================================================ 948 949;; Attribute information is as follows 950;; attribute-name (string) 951;; attribute-type as an oid from table pg_type 952;; attribute-size (in bytes?) 953(defun pg:read-attributes (connection) 954 (let ((attribute-count (pg:read-net-int connection 2)) 955 (attributes '())) 956 (do ((i attribute-count (- i 1))) 957 ((zerop i) (nreverse attributes)) 958 (let ((type-name (pg:read-string connection pg:MAX_MESSAGE_LEN)) 959 (type-id (pg:read-net-int connection 4)) 960 (type-len (pg:read-net-int connection 2))) 961 (push (list type-name type-id type-len) attributes))))) 962 963;; a bitmap is a string, which we interpret as a sequence of bytes 964(defun pg:bitmap-ref (bitmap ref) 965;; (multiple-value-bind (char-ref bit-ref) 966;; (floor* ref 8) 967 (let ((int (aref bitmap (floor ref 8)))) 968 (logand 128 (ash int (mod ref 8))))) 969 970;; the backend starts by sending a bitmap indicating which tuples are 971;; NULL 972(defun pg:read-tuple (connection attributes) 973 (let* ((num-attributes (length attributes)) 974 ;; (num-bytes (car (ceiling* num-attributes 8))) 975 (num-bytes (ceiling num-attributes 8)) 976 (bitmap (pg:read-chars connection num-bytes)) 977 (correction (if (pgcon-binaryp connection) 0 -4)) 978 (tuples '())) 979 (do ((i 0 (+ i 1)) 980 (type-ids (mapcar #'second attributes) (cdr type-ids))) 981 ((= i num-attributes) (nreverse tuples)) 982 (cond ((zerop (pg:bitmap-ref bitmap i)) 983 (push nil tuples)) 984 (t 985 (let* ((len (+ (pg:read-net-int connection 4) correction)) 986 (raw (pg:read-chars connection (max 0 len))) 987 (pg::text-encoding (pgcon-encoding connection)) 988 (parsed (pg:parse raw (car type-ids)))) 989 (push parsed tuples))))))) 990 991(defun pg:read-char (connection) 992 ;;(message "read-char: %d %d" (point) (buffer-size)) 993 (let ((process (pgcon-process connection))) 994 (with-current-buffer (process-buffer process) 995 (unless (char-after 1) 996 (pg::accept-process-output process 0.001) 997 (while (not (char-after 1)) 998 (pg::accept-process-output process 0.1))) 999 (prog1 (char-after 1) 1000 ;;(message "read-char: %d %d => %c" 1001 ;; (point) (buffer-size) (char-after 1)) 1002 (delete-region 1 2))))) 1003 1004;; FIXME should be more careful here; the integer could overflow. 1005(defun pg:read-net-int (connection bytes) 1006 (do ((i bytes (- i 1)) 1007 (accum 0)) 1008 ((zerop i) accum) 1009 (setq accum (+ (* 256 accum) (pg:read-char connection))))) 1010 1011(defun pg:read-int (connection bytes) 1012 (do ((i bytes (- i 1)) 1013 (multiplier 1 (* multiplier 256)) 1014 (accum 0)) 1015 ((zerop i) accum) 1016 (incf accum (* multiplier (pg:read-char connection))))) 1017 1018(defun pg:read-chars (connection howmany) 1019 (let* ((process (pgcon-process connection))) 1020 (with-current-buffer (process-buffer process) 1021 (when (< (buffer-size) howmany) 1022 (pg::accept-process-output process 0.002) 1023 (while (< (buffer-size) howmany) 1024 (pg::accept-process-output process 0.2))) 1025 (prog1 (buffer-substring-no-properties 1 (1+ howmany)) 1026 (delete-region 1 (1+ howmany)))))) 1027 1028(defvar pg::accept-process-output-supports-floats 1029 (ignore-errors (accept-process-output nil 0.0) t)) 1030 1031(defvar pg::inside-accept-process-output nil) 1032 1033(defun pg::accept-process-output (&optional process timeout) 1034 "Like `accept-process-output' but the TIMEOUT argument can be a float." 1035 (when pg::inside-accept-process-output 1036 (error "pg::accept-process-output called recursively")) 1037 (let ((pg::inside-accept-process-output t)) 1038 (cond (pg::accept-process-output-supports-floats 1039 (accept-process-output process timeout nil 1)) 1040 (t 1041 (accept-process-output 1042 process 1043 (if timeout (truncate timeout)) 1044 ;; Emacs21 uses microsecs; Emacs22 millisecs 1045 (if timeout (truncate (* timeout 1000000)))))))) 1046 1047(defun pg::process-send (process string) 1048 "Wrapper aroud process-send-string." 1049 (assert (not pg::inside-accept-process-output)) 1050 (process-send-string process string)) 1051 1052;; read a null-terminated string 1053(defun pg:read-string (connection maxbytes) 1054 (loop for i from 1 to maxbytes 1055 for ch = (pg:read-char connection) 1056 until (= ch ?\0) 1057 concat (char-to-string ch))) 1058 1059;; higher order bits first 1060(defun pg:send-int (connection num bytes) 1061 (let ((process (pgcon-process connection)) 1062 (str (make-string bytes 0)) 1063 (i (- bytes 1))) 1064 (while (>= i 0) 1065 (aset str i (% num 256)) 1066 (setq num (floor num 256)) 1067 (decf i)) 1068 (pg::process-send process str))) 1069 1070(defun pg:send-char (connection char) 1071 (let ((process (pgcon-process connection))) 1072 (pg::process-send process (char-to-string char)))) 1073 1074(defun pg:send (connection str &optional bytes) 1075 (let ((process (pgcon-process connection)) 1076 (data (if (and (numberp bytes) (> bytes (length str))) 1077 (concat str (make-string (- bytes (length str)) 0)) 1078 str))) 1079 (pg::process-send process data))) 1080 1081;; This (limited) testing code assumes you have a database user 1082;; "postgres" with no password accessible from the localhost, and 1083;; a database named "template1". It should clean up after itself. 1084;; 1085;; * is the postmaster running? 1086;; * was the postmaster started with the `-i' commandline option? 1087;; 1088;; This code has been tested with GNU Emacs 19.34, 20.3 and 20.6, and 1089;; XEmacs 20.4, on Solaris and linuxppc. It should work with 1090;; PostgreSQL 6.x, 7.0, 7.1.2. 1091 1092;; (defmacro with-pgtest-connection (&rest body) 1093;; `(with-pg-connection conn ("template1" "postgres") 1094;; ,@body)) 1095 1096;; (defun pg:test () 1097;; (with-pgtest-connection 1098;; (message "Running pg.el tests against backend %s" 1099;; (pg:backend-version conn)) 1100;; (let ((databases (pg:databases conn))) 1101;; (if (member "pgeltest" databases) 1102;; (pg:exec conn "DROP DATABASE pgeltest")) 1103;; (pg:exec conn "CREATE DATABASE pgeltest")) 1104;; (message "Testing insertions...") 1105;; (pg:test-insert) 1106;; (message "Testing date routines...") 1107;; (pg:test-date) 1108;; (message "Testing field extraction routines...") 1109;; (pg:test-result) 1110;; (message "Testing large-object routines...") 1111;; (pg:test-lo-read) 1112;; (pg:test-lo-import) 1113;; (pg:exec conn "DROP DATABASE pgeltest") 1114;; (message "Tests passed ok"))) 1115;; 1116;; ;; this will be *real* slow unless byte-compiled 1117;; (defun pg:test-insert () 1118;; (with-pgtest-connection 1119;; (let (res) 1120;; (pg:exec conn "CREATE TABLE count_test(key int, val int)") 1121;; (loop for i from 1 to 100 1122;; for sql = (format "INSERT INTO count_test VALUES(%s, %s)" 1123;; i (* i i)) 1124;; do (pg:exec conn sql)) 1125;; (setq res (pg:exec conn "SELECT count(val) FROM count_test")) 1126;; (assert (= 100 (first (pg:result res :tuple 0)))) 1127;; (setq res (pg:exec conn "SELECT sum(key) FROM count_test")) 1128;; (assert (= 5050 (first (pg:result res :tuple 0)))) 1129;; (pg:exec conn "DROP TABLE count_test")))) 1130;; 1131;; ;; Testing for the time handling routines. Expected output is 1132;; ;; something like (in buffer *Messages*) 1133;; ;; 1134;; ;; timestamp = (14189 17420) 1135;; ;; abstime = (14189 17420) 1136;; ;; time = 19:42:06 1137;; (defun pg:test-date () 1138;; (with-pgtest-connection 1139;; (let (res) 1140;; (pg:exec conn "CREATE TABLE date_test(a timestamp, b abstime, c time)") 1141;; (pg:exec conn "INSERT INTO date_test VALUES " 1142;; "(current_timestamp, 'now', 'now')") 1143;; (setq res (pg:exec conn "SELECT * FROM date_test")) 1144;; (setq res (pg:result res :tuple 0)) 1145;; (message "timestamp = %s" (first res)) 1146;; (message "abstime = %s" (second res)) 1147;; (message "time = %s" (third res))) 1148;; (pg:exec conn "DROP TABLE date_test"))) 1149;; 1150;; ;; Testing for the data access functions. Expected output is something 1151;; ;; like 1152;; ;; 1153;; ;; ============================================== 1154;; ;; status of CREATE is CREATE 1155;; ;; status of INSERT is INSERT 22506 1 1156;; ;; oid of INSERT is 22506 1157;; ;; status of SELECT is SELECT 1158;; ;; attributes of SELECT are ((a 23 4) (b 1043 65535)) 1159;; ;; tuples of SELECT are ((3 zae) (66 poiu)) 1160;; ;; second tuple of SELECT is (66 poiu) 1161;; ;; status of DROP is DROP 1162;; ;; ============================================== 1163;; (defun pg:test-result () 1164;; (with-pgtest-connection 1165;; (let ((r1 (pg:exec conn "CREATE TABLE resulttest (a int, b VARCHAR(4))")) 1166;; (r2 (pg:exec conn "INSERT INTO resulttest VALUES (3, 'zae')")) 1167;; (r3 (pg:exec conn "INSERT INTO resulttest VALUES (66, 'poiu')")) 1168;; (r4 (pg:exec conn "SELECT * FROM resulttest")) 1169;; (r5 (pg:exec conn "DROP TABLE resulttest"))) 1170;; (message "==============================================") 1171;; (message "status of CREATE is %s" (pg:result r1 :status)) 1172;; (message "status of INSERT is %s" (pg:result r2 :status)) 1173;; (message "oid of INSERT is %s" (pg:result r2 :oid)) 1174;; (message "status of SELECT is %s" (pg:result r4 :status)) 1175;; (message "attributes of SELECT are %s" (pg:result r4 :attributes)) 1176;; (message "tuples of SELECT are %s" (pg:result r4 :tuples)) 1177;; (message "second tuple of SELECT is %s" (pg:result r4 :tuple 1)) 1178;; (message "status of DROP is %s" (pg:result r5 :status)) 1179;; (message "==============================================")))) 1180;; 1181;; ;; test of large-object interface. Note the use of with-pg-transaction 1182;; ;; to wrap the requests in a BEGIN..END transaction which is necessary 1183;; ;; when working with large objects. 1184;; (defun pg:test-lo-read () 1185;; (with-pgtest-connection 1186;; (with-pg-transaction conn 1187;; (let* ((oid (pg:lo-create conn "rw")) 1188;; (fd (pg:lo-open conn oid "rw"))) 1189;; (message "==================================================") 1190;; (pg:lo-write conn fd "Hi there mate") 1191;; (pg:lo-lseek conn fd 3 0) ; SEEK_SET = 0 1192;; (unless (= 3 (pg:lo-tell conn fd)) 1193;; (error "lo-tell test failed!")) 1194;; (message "Read %s from lo" (pg:lo-read conn fd 7)) 1195;; (message "==================================================") 1196;; (pg:lo-close conn fd) 1197;; (pg:lo-unlink conn oid))))) 1198;; 1199;; (defun pg:test-lo-import () 1200;; (with-pgtest-connection 1201;; (with-pg-transaction conn 1202;; (let ((oid (pg:lo-import conn "/etc/group"))) 1203;; (pg:lo-export conn oid "/tmp/group") 1204;; (cond ((zerop (call-process "diff" nil nil nil "/tmp/group" "/etc/group")) 1205;; (message "lo-import test succeeded") 1206;; (delete-file "/tmp/group")) 1207;; (t 1208;; (message "lo-import test failed: check differences") 1209;; (message "between files /etc/group and /tmp/group"))) 1210;; (pg:lo-unlink conn oid))))) 1211;; 1212;; (defun pg:cleanup () 1213;; (interactive) 1214;; (loop for b in (buffer-list) do 1215;; (if (string-match " \\*PostgreSQL\\*" (buffer-name b)) 1216;; (kill-buffer b)))) 1217 1218 1219(provide 'pg) 1220 1221;;; pg.el ends here 1222