RCD Database Basics

CREATE TABLE mydata (
mydata_id SERIAL NOT NULL PRIMARY KEY,
mydata_text TEXT)

;;; rcd-db-basics.el --- RCD Database Basics  -*- lexical-binding: t; -*-

;; Copyright (C) 2016-2020 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 1.25
;; Package-Requires: ((rcd-utilities "1.70"))
;; Keywords: applications
;; URL: https://hyperscope.link/3/7/4/9/3/RCD-Database-Basics-37493.html

;; This file is not part of GNU Emacs.

;; This program 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 3 of the
;; License, or (at your option) any later version.
;;
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; RCD Database Basics deals with PostgreSQL and `emacs-libpq' module
;;
;; This is not a general PostgreSQL database package as it will handle
;; mostly the tables that have its unique ID assigned in the following
;; form:
;;
;; CREATE TABLE mydata (
;; mydata_id SERIAL NOT NULL PRIMARY KEY,
;; mydata_anythingelse text
;; and so on)
;;
;; Thus for the RCD Database Management we always have the column
;; `TABLENAME_id' in every table as it follows the GeDaFe database
;; design.
;;
;; GeDaFe - PostgreSQL Generic Database Interface
;; http://gedafe.github.io/doc/gedafe-sql.en.html

;;
;; RCD is acronym for Reach, Connect, Deliver, my personal
;; principle and formula for Wealth.

;;; Change Log:

;;; Code:

;;;; ↝ EMACS-LIBPQ

;; TODO change the following to `require' when emacs-libpq becomes part of GNU ELPA
(add-to-list 'load-path "~/Programming/git/emacs-libpq/")

;;;; ↝ REQUIRE SECTION

(require 'pq)
(require 'rcd-utilities)

;;;; ↝ POSTGRESQL CONNECTION

(defun rcd-db-connect (database &optional port host username password)
  "Connects to PostgreSQL DATABASE with specified parameters.
Optional arguments PORT, HOST, USERNAME and PASSWORD may be specified."
  (let* ((port (if port port 5432))
	 (connection (format "dbname=%s port=%s" database port))
	 (connection (if host
			 (concat connection (format " host=%s" host))
		       connection))
	 (connection (if username
			 (concat connection (format " user=%s" username))
		       connection))
	 (connection (if password
			 (concat connection (format " password=%s" password))
		       connection))
	 (connection (or (getenv "PG_CONNINFO") connection)))
    (pq:connectdb connection)))

;;;; ↝ MAIN POSTGRESQL DISPATCH FUNCTIONS

(defun rcd-sql (sql pg)
  "Sends SQL queries to PostgreSQL database and return results.
Argument PG is database handle."
    (condition-case err
	(pq:query pg sql)
      (error
       (if (string-match "^ERROR:  syntax error" (cdr err))
	   (progn
	     (if (fboundp 'speak) (speak (cdr err)))
	     (message (cdr err)))
	 ;; re-throw
	 (signal (car err) (cdr err))))))

(defun rcd-sql-list (sql pg)
  "Return list of lists instead of vectors.
Argument SQL is supplied query.
Argument PG is database handle."
  (mapcar (lambda (item)
	    (cond ((eq (type-of item) 'vector) (append item '()))
		  (t item)))
	  (apply 'rcd-sql (list sql pg))))

(defun rcd-sql-first (sql pg)
  "Return first entry from SQL query.
Argument PG is database handle."
  (car (apply 'rcd-sql (list sql pg))))

(defun rcd-sql-list-first (sql pg)
  "Return first item of the list of lists instead of vectors.
Argument SQL is supplied query.
Argument PG is database handle."
  ;; TODO this is not verified that it works well as intended
  (let ((list (rcd-sql-first sql pg)))
    (append list '())))

(defun rcd-sql-hash-with-key (sql pg)
  "Return hash with key TEXT [ID] and value ID from SQL result.

Output is in the form ID, TEXT
Argument PG is database handle."
  (let ((hash (make-hash-table :test 'equal))
	(res (rcd-sql sql pg)))
    (while res
      (let ((item (pop res)))
	(cond ((eq (type-of item) 'vector) (puthash (format "%s [%s]" (elt item 1) (elt item 0)) (elt item 0) hash)))))
    hash))

(defun rcd-sql-hash (sql pg)
  "Return hash with by using SQL and PG database handle.

Output is in the form TEXT, ID"
  (let ((hash (make-hash-table))
	(list (rcd-sql-list sql pg)))
    (while list
      (let ((item (pop list)))
	(puthash (format "%s" (elt item 0)) (elt item 1) hash)))
    hash))

;;;; ↝ SQL QUERY CONTROL

(defun rcd-sql-begin (pg)
  "Send BEGIN query to database by using PG database handle."
  (rcd-sql "BEGIN" pg))

(defun rcd-sql-commit (pg)
  "Send COMMIT query to database by using PG database handle."
  (rcd-sql "COMMIT" pg))

(defun rcd-sql-rollback (pg)
  "Send ROLLBACK query to database by using PG database handle."
  (rcd-sql "ROLLBACK" pg))

;;;; ↝ COMPLETING READ WITH SQL

(defun rcd-completing-id-by-sql (prompt sql pg)
  "Return the ID by using SQL query.

PROMPT will be displayed to user.
PG is database handle

This function will provide entries with the ID number at
beginning, and it will cut the number from string and return it.

The SQL query has to give just one column with the number
separate by space with other column values.

Example would be: SELECT concat_ws(' ',1,'My ID') that will return `1'"
  (let* ((selection (rcd-sql-list sql pg))
	 (choice (completing-read prompt selection)))
    (string-cut-id choice)))

(defun rcd-completing-id-by-sql-end (prompt sql pg)
  "Return the ID as by finding [ID:123] on the end.
Argument PROMPT will be displayed to user.
Argument SQL is supplied query.
Argument PG is database handle."
  (let* ((selection (rcd-sql-list sql pg))
	 (choice (completing-read prompt selection)))
    (rcd-get-bracketed-id-end choice)))

(defun rcd-completing-read-sql-hash (prompt sql pg &optional history initial-input)
  "Complete selection by using SQL.

First column shall be unique id, followed by text
representation.  Example SQL query:

SELECT people_id, people_firstname || ' ' || people_lastname FROM people

PG is database handle.  HISTORY is supported with INITIAL-INPUT
Argument PROMPT will be displayed to user."
  (let* ((hash (rcd-sql-hash-with-key sql pg))
	 (completion-ignore-case t)
	 (choice (completing-read prompt hash nil t initial-input history))
	 (choice (string-trim choice))
	 (id (gethash choice hash)))
    id))

;;;; ↝ DATABASE INFORMATION

(defun rcd-db-column-type (table column pg)
  "Return type of the COLUMN in the table TABLE.
PG is database handle."
  (rcd-sql-first (format "SELECT data_type FROM information_schema.columns WHERE table_name = '%s' AND column_name = '%s'" table column) pg))

(defun rcd-db-column-foreign-table (table column pg)
  "Return the foreign table referenced by COLUMN in the TABLE.
PG is database handle."
  (rcd-sql-first (format "SELECT a.confrelid::regclass FROM pg_constraint a JOIN pg_attribute b
                          ON a.conrelid = b.attrelid
                          AND b.attnum = any (a.conkey)
                          WHERE a.conrelid = '%s'::regclass
                          AND a.contype = 'f'
                          AND b.attname = '%s'" table column) pg))

(defun rcd-db-comment (database pg)
  "Returns the database comment"
  (let* ((sql (format "SELECT description FROM pg_shdescription JOIN pg_database ON objoid = pg_database.oid WHERE datname = '%s'" database))
	 (comment (rcd-sql-first sql pg)))
    comment))

(defun rcd-db-column-comment (table column pg)
  (let ((sql (format "SELECT pgd.description FROM pg_catalog.pg_statio_all_tables AS st INNER JOIN pg_catalog.pg_description pgd ON (pgd.objoid=st.relid) INNER JOIN information_schema.columns c ON (pgd.objsubid=c.ordinal_position AND c.table_schema=st.schemaname AND c.table_name=st.relname AND c.table_name = '%s' AND c.table_schema = 'public' AND c.column_name = '%s')" table column)))
    (rcd-sql-first sql pg)))

;;;; ↝ DATABASE MANAGEMENT

(defun rcd-db-get-entry (table column id pg)
  "Return value for the COLUMN from the RCD Database by using the entry ID.
Argument TABLE is database table."
  (if id
      (let* ((sql (format "SELECT %s FROM %s WHERE %s_id = %s" column table table id))
	     (value (rcd-sql-first sql pg)))
      value)
    (error "ID not conveyed")))

(defun rcd-db-get-entry-where (table column where pg)
  "Return value from database COLUMN in TABLE by using WHERE.
PG is database handle."
  (let ((sql (format "SELECT %s FROM %s WHERE %s" column table where)))
    (rcd-sql-first sql pg)))

;;;; ↝ ENCRYPTION AND DECRYPTION

(defun rcd-db-get-encrypted-entry (table column id symmetric pg)
  "Return decrypted value for TABLE and COLUMN with its ID.
SYMMETRIC is provided password.
Argument PG is database handle."
  (let ((sql (format "SELECT pgp_sym_decrypt(%s::bytea,'%s') FROM %s WHERE %s_id = %d" column symmetric table table id)))
    (rcd-sql-first sql pg)))

(defun rcd-db-update-encrypted-entry (table column value id symmetric pg)
  "Update TABLE, COLUMN by its ID, with VALUE and SYMMETRIC password.
PG is database handle."
  (let* ((value (sql-escape-string value))
	 (sql (format "UPDATE %s SET %s = pgp_sym_encrypt(%s,'%s') WHERE %s_id = %d" table column value symmetric table id)))
    (rcd-sql-first sql pg)))

;;;; ↝ FANCY SQL FUNCTIONS

(defun rcd-sql-age (iso-date pg)
  "Return age from PostgreSQL by providing ISO-DATE and PG database handle."
  (let* ((sql (format "SELECT age(date('%s'))" iso-date))
	 (age (rcd-sql-first sql pg))
	 (age (replace-regexp-in-string "mon" "month" age)))
    age))

;;;; ↝ SQL SKELETONS


(define-skeleton cf-sql-table
    "Prepare the SQL table for Central Files database design."
  nil
  "
-- ------------------------------------------
-- ------------ Table " (setq table (skeleton-read "Table name: ")) "
-- ------------------------------------------
DROP SEQUENCE " table "_id_seq;

CREATE TABLE " table " (
" table "_id SERIAL NOT NULL PRIMARY KEY,
" table "_datecreated TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL,
" table "_datemodified TIMESTAMP,
" table "_usercreated TEXT NOT NULL DEFAULT current_user,
" table "_usermodified TEXT NOT NULL DEFAULT current_user,
" table "_name TEXT,
" table "_title TEXT,
" table "_description TEXT,
" table "_ TEXT
);
GRANT ALL ON " table " TO PUBLIC;
DROP VIEW " table "_combo;
CREATE OR REPLACE VIEW " table "_combo AS
SELECT " table "_id AS id,
" table "_name AS TEXT
FROM " table ";
GRANT SELECT ON " table "_combo TO PUBLIC;

DROP VIEW " table "_rcd;
CREATE OR REPLACE VIEW " table "_rcd AS
SELECT concat(" table "_id, ' '," table "_name) AS id
FROM " table ";
GRANT SELECT ON " table "_rcd TO PUBLIC;

COMMENT ON TABLE " table " IS '" (capitalize table) "';
COMMENT ON COLUMN " table "." table "_id IS 'ID';
COMMENT ON COLUMN " table "." table "_datecreated IS 'Date created';
COMMENT ON COLUMN " table "." table "_datemodified IS 'Date modified';
COMMENT ON COLUMN " table "." table "_usercreated IS 'User created';
COMMENT ON COLUMN " table "." table "_usermodified IS 'User modified';
COMMENT ON COLUMN " table "." table "_hid IS 'HID';
COMMENT ON COLUMN " table "." table "_name IS 'Name';
COMMENT ON COLUMN " table "." table "_title IS 'Title';
COMMENT ON COLUMN " table "." table "_description IS 'Description';
COMMENT ON COLUMN " table "." table "_IS '';

CREATE UNIQUE INDEX " table "_index ON " table " ( " table "_weekend );

INSERT INTO meta_fields VALUES ('" table "','" table "_description','widget','area(rows=10,cols=60)');
INSERT INTO meta_fields VALUES ('" table "','" table "_datecreated','widget','readonly');
INSERT INTO meta_fields VALUES ('" table "','" table "_datemodified','widget','readonly');
INSERT INTO meta_fields VALUES ('" table "','" table "_usercreated','widget','readonly');
INSERT INTO meta_fields VALUES ('" table "','" table "_usermodified','widget','readonly');
INSERT INTO meta_fields VALUES ('" table "','" table "_','hide_list','1');
-- INSERT INTO " table " (" table "_name) VALUES ('');
-- INSERT INTO meta_tables VALUES ('" table "', 'hide', '1');

-- Triggers
-- For Date Modified
CREATE TRIGGER " table "_moddatetime
BEFORE UPDATE ON " table "
FOR EACH ROW
EXECUTE PROCEDURE moddatetime(" table "_datemodified);

-- For User Modified
CREATE TRIGGER insert_username_" table "
BEFORE INSERT OR UPDATE ON " table "
FOR EACH ROW
EXECUTE PROCEDURE insert_username(" table "_usermodified);


-- List view
/*
DROP VIEW " table "_list;
CREATE OR REPLACE VIEW " table "_list AS
SELECT " table "_id, " table "_name
FROM " table " ORDER BY " table "_id DESC;
COMMENT ON VIEW " table "_list IS '" (capitalize table) "';
COMMENT ON COLUMN " table "_list." table "_id IS 'ID';
COMMENT ON COLUMN " table "_list." table "_name IS 'Name';
*/
}
);")

;;;; ↝ PACKAGE FOOTER

(provide 'rcd-db-basics)

;;; rcd-db-basics.el ends here

;; Local Variables:
;; rcd-vc-ask-for-revision: t
;; rcd-vc-ask-for-description: nil
;; outline-heading-alist: '((";;;; ↝" . 2))
;; End: