;;; pg-utils.el --- PostgreSQL database access utility functions

;; Copyright (C) 2000 by Free Software Foundation, Inc.

;; Author: Steven Baur <steve@zaizen.m17n.org>
;; Keywords: data

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Sundry helper functions for internal PostgreSQL support.
;; This code will be put into an XEmacs package soon.  Some functions need
;;  rewriting before they get widely distributed.

;;; Code:
(defvar pg-utils-query-buffer-name "*Query Results*"
  "Name of buffer used for displaying query results.")

(defvar pg-utils-default-connection nil
  "Cached database connection.")
(defvar pg-utils-last-query nil
  "The results of the previous query.")

(defun pg-utils-get-max-column-size (result col)
  "Return maximum length of a result in a column."
  (let ((tup 0)
	max len)
    (setq max (string-width (pq-fname result col)))
    (while (< tup (pq-ntuples result))
      (setq len (string-width (pq-get-value result tup col)))
      (when (< max len)
	(setq max len))
      (incf tup))
    max))

(defun pg-utils-get-field-names (result)
  (let (v i)
    (setq i (1- (pq-nfields result)))
    (setq v (make-vector (pq-nfields result) nil))
    (while (>= i 0)
      (aset v i (pq-fname result i))
      (decf i))
    v))

(defun pg-utils-get-field-sizes (result)
  (let (v i)
    (setq i (1- (pq-nfields result)))
    (setq v (make-vector (pq-nfields result) nil))
    (while (>= i 0)
      (aset v i (pg-utils-get-max-column-size result i))
      (decf i))
    v))

(defun pg-utils-get-field-types (result)
  (let (v i)
    (setq i (1- (pq-nfields result)))
    (setq v (make-vector (pq-nfields result) nil))
    (while (>= i 0)
      (aset v i (pq-ftype result i))
      (decf i))
    v))

(defun center-string (s width)
  (let ((l (length s))
	n1 n2)
    (if (>= l width)
	(format "%*.*s" width width s)

      (setq n1 (/ (- width l) 2))
      (setq n2 n1)
      (when (/= (+ n1 n2 l) width)
	(incf n1))
      (format "%*s%s%*s" n1 " " s n2 " "))))

(defun right-justify (s len)
  (if (>= (string-width s) len)
      s
    (concat (make-string (- len (string-width s)) ?  ) s)))

(defun pg-utils-show-query (result &optional sep)
  "Pretty print the results of a query."
  (cond ((eq (pq-result-status result) 'pgres::tuples-ok)
	 (pg-utils-pretty-print-tuples result sep))
	((eq (pq-result-status result) 'pgres::command-ok)
	 (pg-utils-print-command result))
	(t
	 (pg-utils-print-error result))))

(defun pg-utils-print-error (result)
  "Print an error result."
  (with-output-to-temp-buffer pg-utils-query-buffer-name
    (princ (pq-result-error-message result))))

(defun pg-utils-print-command (result)
  "Print results of a command query."
  (with-output-to-temp-buffer pg-utils-query-buffer-name
    (princ (pq-cmd-status result))
    (terpri)))

(defun pg-utils-pretty-print-tuples (result sep)
  "Pretty print the results of a query that returned tuples."
  (unless sep
    (setq sep "|"))
  (let (i j fields sizes names)
    (setq names (pg-utils-get-field-names result))
    (setq sizes (pg-utils-get-field-sizes result))
    (with-output-to-temp-buffer pg-utils-query-buffer-name

      ;; First print out column names
      (setq i 0)
      (while (< i (pq-nfields result))
	(if (= i 0)
	    (princ " ")
	  (princ (concat " " sep " ")))
	(princ (center-string (aref names i) (aref sizes i)))
	(incf i))
      (terpri)

      ;; Next print a separator line
      (setq i 0)
      (while (< i (pq-nfields result))
	(if (= i 0)
	    (princ " ")
	  (princ "-+-"))
	(princ (make-string (aref sizes i) ?-))
	(incf i))
      (terpri)

      ;; Lastly, print out the data
      (setq j 0)
      (while (< j (pq-ntuples result))
	(setq i 0)
	(while (< i (pq-nfields result))
	  (if (= i 0)
	      (princ " ")
	    (princ (concat " " sep " ")))
	  (princ (right-justify (pq-get-value result j i) (aref sizes i)))
	  (incf i))
	(terpri)
	(incf j))

      ;; Finish off by printing the number of affected rows
      (if (= 1 (pq-ntuples result))
	  (princ "(1 row)")
	(princ (format "(%d rows)" (pq-ntuples result))))
      (terpri))))

(defun pg-utils-table-fields (table)
  "Show field names for specified table."
  (interactive "sTable: ")
  (require 'postgresql)
  (let (result)
    (pq-exec pg-utils-default-connection "BEGIN;")
    (pq-exec pg-utils-default-connection
	     (concat "DECLARE k_cursor CURSOR FOR SELECT * FROM "
		     table
		     ";"))
    (setq result (pq-exec pg-utils-default-connection "FETCH k_cursor;"))
    (pq-exec pg-utils-default-connection "END;")
    (pg-utils-get-field-names result)))

(defun pg-utils-table-types (table)
  "Show field types for specified table."
  (interactive "sTable: ")
  (require 'postgresql)
  (let (result)
    (pq-exec pg-utils-default-connection "BEGIN;")
    (pq-exec pg-utils-default-connection
	     (concat "DECLARE k_cursor CURSOR FOR SELECT * FROM "
		     table
		     ";"))
    (setq result (pq-exec pg-utils-default-connection "FETCH k_cursor;"))
    (pq-exec pg-utils-default-connection "END;")
    (pg-utils-get-field-types result)))

(defun pg-utils-describe-type (typid)
  "Identify a type from its ID (as returned by `pq-ftype')."
  (let (result)
    (setq result
	  (pq-exec pg-utils-default-connection
		   (concat "SELECT typname as \"Name\", "
			   "obj_description(oid) as \"Description\" "
			   "FROM pg_type WHERE oid = "
			   (int-to-string typid)
			   ";")))
    (cons (pq-get-value result 0 0) (pq-get-value result 0 1))))

;; A very simple psql replacement
(defun pg-utils-do-query (query)
  "Interactively run a query, and display the results into a temp buffer."
  (interactive "sQuery: ")
  (require 'postgresql)
  (setq pg-utils-last-query (pq-exec pg-utils-default-connection query))
  (pg-utils-show-query pg-utils-last-query))

(defun pg-utils-do-copy-out (table buffname)
  (interactive "sTable: \nsBuffer: ")
  (require 'postgresql)
  (setq pg-utils-last-query
	(pq-exec pg-utils-default-connection (concat "COPY "
						     table
						     " TO stdout;")))
  (with-current-buffer (get-buffer-create buffname)
    (let ((not-done t)
	  l res)
      (while not-done
	(setq l (pq-get-line pg-utils-default-connection))
	(if (and (= (car l) 0)
		 (string= (cdr l) "\\."))
	    (setq not-done nil)
	  (insert (cdr l))
	  (when (= (car l) 0)
	    (insert "\n")))))
    (pq-end-copy pg-utils-default-connection)
    (current-buffer)))

(defun pg-utils-do-copy-in (table buffname &optional delimiters nullvalue)
  (interactive "sTable: \nbBuffer: ")
  (require 'postgresql)
  (setq pg-utils-last-query
	(pq-exec pg-utils-default-connection
		 (concat "COPY "
			 table
			 " FROM stdin"
			 (if delimiters
			     (format " USING DELIMITERS '%s'" delimiters)
			   "")
			 (if nullvalue
			     (format " WITH NULL AS '%s'" nullvalue)
			   "")
			 ";")))
  (with-current-buffer (get-buffer-create buffname)
    (goto-char (point-min))
    (let ((i 1))
      (while (< (point) (point-max))
	(when (= 0 (% i 10))
	  (message "processing line %d" i))
	(unless (pq-put-line pg-utils-default-connection
			     (buffer-substring (point-at-bol)
					       (1+ (point-at-eol))))
	  (message "error at line %d [%s]" i
		   (pq-pgconn pg-utils-default-connection 'pq::error-message))
	  (error "Error line %d" i))
	(incf i)
	(forward-line 1))))
  (pq-put-line pg-utils-default-connection "\\.\n")
  (pq-end-copy pg-utils-default-connection))

(provide 'pg-utils)

;;; pg-utils.el ends here