1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
;;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding: t; -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; URL: https://github.com/skeeto/emacsql
;; Version: 1.0.0
;; Package-Requires: ((emacs "25.1") (emacsql "2.0.0"))
;;; Commentary:
;; This backend uses the standard "psql" command line program.
;; This package also includes the emacsql-pg backend, which is written
;; in in pure Emacs Lisp and requires no command line program.
;;; Code:
(require 'cl-lib)
(require 'cl-generic)
(require 'eieio)
(require 'emacsql)
(defvar emacsql-psql-executable "psql"
"Path to the psql (PostgreSQL client) executable.")
(defun emacsql-psql-unavailable-p ()
"Return a reason if the psql executable is not available.
:no-executable -- cannot find the executable
:cannot-execute -- cannot run the executable
:old-version -- sqlite3 version is too old"
(let ((psql emacsql-psql-executable))
(if (null (executable-find psql))
:no-executable
(condition-case _
(with-temp-buffer
(call-process psql nil (current-buffer) nil "--version")
(let ((version (cl-third (split-string (buffer-string)))))
(if (version< version "1.0.0")
:old-version
nil)))
(error :cannot-execute)))))
(defvar emacsql-psql-reserved
(emacsql-register-reserved
'(ALL ANALYSE ANALYZE AND ANY AS ASC AUTHORIZATION BETWEEN BINARY
BOTH CASE CAST CHECK COLLATE COLUMN CONSTRAINT CREATE CROSS
CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER DEFAULT
DEFERRABLE DESC DISTINCT DO ELSE END EXCEPT FALSE FOR FOREIGN
FREEZE FROM FULL GRANT GROUP HAVING ILIKE IN INITIALLY INNER
INTERSECT INTO IS ISNULL JOIN LEADING LEFT LIKE LIMIT LOCALTIME
LOCALTIMESTAMP NATURAL NEW NOT NOTNULL NULL OFF OFFSET OLD ON
ONLY OR ORDER OUTER OVERLAPS PLACING PRIMARY REFERENCES RIGHT
SELECT SESSION_USER SIMILAR SOME TABLE THEN TO TRAILING TRUE
UNION UNIQUE USER USING VERBOSE WHEN WHERE))
"List of all of PostgreSQL's reserved words.
http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html")
(defclass emacsql-psql-connection (emacsql-connection)
((dbname :reader emacsql-psql-dbname :initarg :dbname)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE PRECISION")
(object "TEXT")
(nil "TEXT"))))
(:documentation "A connection to a PostgreSQL database via psql."))
(cl-defun emacsql-psql (dbname &key username hostname port debug)
"Connect to a PostgreSQL server using the psql command line program."
(let ((args (list dbname)))
(when username
(push username args))
(push "-n" args)
(when port
(push "-p" args)
(push port args))
(when hostname
(push "-h" args)
(push hostname args))
(setf args (nreverse args))
(let* ((buffer (generate-new-buffer " *emacsql-psql*"))
(psql emacsql-psql-executable)
(command (mapconcat #'shell-quote-argument (cons psql args) " "))
(process (start-process-shell-command
"emacsql-psql" buffer (concat "stty raw && " command)))
(connection (make-instance 'emacsql-psql-connection
:process process
:dbname dbname)))
(setf (process-sentinel process)
(lambda (proc _) (kill-buffer (process-buffer proc))))
(when debug (emacsql-enable-debugging connection))
(mapc (apply-partially #'emacsql-send-message connection)
'("\\pset pager off"
"\\pset null nil"
"\\a"
"\\t"
"\\f ' '"
"SET client_min_messages TO ERROR;"
"\\set PROMPT1 ]"
"EMACSQL;")) ; error message flush
(emacsql-wait connection)
(emacsql connection
[:set (= default-transaction-isolation 'SERIALIZABLE)])
(emacsql-register connection))))
(cl-defmethod emacsql-close ((connection emacsql-psql-connection))
(let ((process (emacsql-process connection)))
(when (process-live-p process)
(process-send-string process "\\q\n"))))
(cl-defmethod emacsql-send-message ((connection emacsql-psql-connection) message)
(let ((process (emacsql-process connection)))
(process-send-string process message)
(process-send-string process "\n")))
(cl-defmethod emacsql-waiting-p ((connection emacsql-psql-connection))
(with-current-buffer (emacsql-buffer connection)
(cond ((= (buffer-size) 1) (string= "]" (buffer-string)))
((> (buffer-size) 1) (string= "\n]"
(buffer-substring
(- (point-max) 2) (point-max)))))))
(cl-defmethod emacsql-check-error ((connection emacsql-psql-connection))
(with-current-buffer (emacsql-buffer connection)
(let ((case-fold-search t))
(setf (point) (point-min))
(when (looking-at "error:")
(let* ((beg (line-beginning-position))
(end (line-end-position)))
(signal 'emacsql-error (list (buffer-substring beg end))))))))
(cl-defmethod emacsql-parse ((connection emacsql-psql-connection))
(emacsql-check-error connection)
(with-current-buffer (emacsql-buffer connection)
(let ((standard-input (current-buffer)))
(setf (point) (point-min))
(cl-loop until (looking-at "]")
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (progn (forward-char 1) (setf row ()))
finally (cl-return rows)))))
(provide 'emacsql-psql)
;;; emacsql-psql.el ends here
|
