1 /*-------------------------------------------------------------------------
2  *
3  * pgtcl.c
4  *
5  *	libpgtcl is a tcl package for front-ends to interface with PostgreSQL.
6  *	It's a Tcl wrapper for libpq.
7  *
8  * Portions Copyright (c) 1996-2004, PostgreSQL Global Development Group
9  * Portions Copyright (c) 1994, Regents of the University of California
10  *
11  *
12  * IDENTIFICATION
13  *	  $Id: pgtcl.c 334 2013-10-04 15:04:44Z lbayuk $
14  *
15  *-------------------------------------------------------------------------
16  */
17 
18 #include "libpgtcl.h"
19 #include "pgtclCmds.h"
20 #include "pgtclId.h"
21 
22 /* Runtime Tcl version, set below */
23 double pgtcl_tcl_version;
24 
25 /*
26  * Pgtcl_Init
27  *	  initialization package for the PGTCL Tcl package
28  *
29  */
30 
31 DLLEXPORT int
Pgtcl_Init(Tcl_Interp * interp)32 Pgtcl_Init(Tcl_Interp *interp)
33 {
34 
35 	/*
36 	 * The version required really should be TCL_VERSION, but this
37 	 * can be compiled under 8.5 with stubs and still mostly works
38 	 * with a Tcl 8.4 interpreter, so let 8.4 be the minimum version.
39 	 */
40 #ifdef USE_TCL_STUBS
41 	if (Tcl_InitStubs(interp, "8.4", 0) == NULL)
42 		return TCL_ERROR;
43 #endif
44 
45 	/*
46 	 * Get the Tcl version at runtime, which may differ from the compile-time
47 	 * version due to use of Tcl stubs. This is used in some commands to
48 	 * prevent crashes due to missing stubs functions.
49 	 */
50 	if (Tcl_GetDouble(interp,
51 				Tcl_GetVar(interp, "tcl_version", TCL_GLOBAL_ONLY),
52 				&pgtcl_tcl_version) != TCL_OK)
53 		pgtcl_tcl_version = 8.4;  /* A reasonable fallback */
54 
55 	/*
56 	 * Note: Removed code to set PGCLIENTENCODING=UNICODE if tcl_version >= 8.1.
57 	 * That did not work for Windows because the libpq DLL didn't see the
58 	 * environment change. So now this is done when connecting to the database.
59 	 */
60 
61 	/* register all pgtcl commands */
62 	Tcl_CreateObjCommand(interp,
63 						 "pg_conndefaults",
64 						 Pg_conndefaults,
65 						 (ClientData)NULL,
66 						 (Tcl_CmdDeleteProc *)NULL);
67 
68 	Tcl_CreateObjCommand(interp,
69 						 "pg_connect",
70 						 Pg_connect,
71 						 (ClientData)NULL,
72 						 (Tcl_CmdDeleteProc *)NULL);
73 
74 	Tcl_CreateObjCommand(interp,
75 						 "pg_disconnect",
76 						 Pg_disconnect,
77 						 (ClientData)NULL,
78 						 (Tcl_CmdDeleteProc *)NULL);
79 
80 	Tcl_CreateObjCommand(interp,
81 						 "pg_exec",
82 						 Pg_exec,
83 						 (ClientData)NULL,
84 						 (Tcl_CmdDeleteProc *)NULL);
85 
86 	Tcl_CreateObjCommand(interp,
87 						 "pg_select",
88 						 Pg_select,
89 						 (ClientData)NULL,
90 						 (Tcl_CmdDeleteProc *)NULL);
91 
92 	Tcl_CreateObjCommand(interp,
93 						 "pg_result",
94 						 Pg_result,
95 						 (ClientData)NULL,
96 						 (Tcl_CmdDeleteProc *)NULL);
97 
98 	Tcl_CreateObjCommand(interp,
99 						 "pg_execute",
100 						 Pg_execute,
101 						 (ClientData)NULL,
102 						 (Tcl_CmdDeleteProc *)NULL);
103 
104 	Tcl_CreateObjCommand(interp,
105 						 "pg_lo_open",
106 						 Pg_lo_open,
107 						 (ClientData)NULL,
108 						 (Tcl_CmdDeleteProc *)NULL);
109 
110 	Tcl_CreateObjCommand(interp,
111 						 "pg_lo_close",
112 						 Pg_lo_close,
113 						 (ClientData)NULL,
114 						 (Tcl_CmdDeleteProc *)NULL);
115 
116 	Tcl_CreateObjCommand(interp,
117 						 "pg_lo_read",
118 						 Pg_lo_read,
119 						 (ClientData)NULL,
120 						 (Tcl_CmdDeleteProc *)NULL);
121 
122 	Tcl_CreateObjCommand(interp,
123 						 "pg_lo_write",
124 						 Pg_lo_write,
125 						 (ClientData)NULL,
126 						 (Tcl_CmdDeleteProc *)NULL);
127 
128 	Tcl_CreateObjCommand(interp,
129 						 "pg_lo_lseek",
130 						 Pg_lo_lseek,
131 						 (ClientData)NULL,
132 						 (Tcl_CmdDeleteProc *)NULL);
133 
134 	Tcl_CreateObjCommand(interp,
135 						 "pg_lo_creat",
136 						 Pg_lo_creat,
137 						 (ClientData)NULL,
138 						 (Tcl_CmdDeleteProc *)NULL);
139 
140 	Tcl_CreateObjCommand(interp,
141 						 "pg_lo_tell",
142 						 Pg_lo_tell,
143 						 (ClientData)NULL,
144 						 (Tcl_CmdDeleteProc *)NULL);
145 
146 	Tcl_CreateObjCommand(interp,
147 						 "pg_lo_unlink",
148 						 Pg_lo_unlink,
149 						 (ClientData)NULL,
150 						 (Tcl_CmdDeleteProc *)NULL);
151 
152 	Tcl_CreateObjCommand(interp,
153 						 "pg_lo_import",
154 						 Pg_lo_import,
155 						 (ClientData)NULL,
156 						 (Tcl_CmdDeleteProc *)NULL);
157 
158 	Tcl_CreateObjCommand(interp,
159 						 "pg_lo_export",
160 						 Pg_lo_export,
161 						 (ClientData)NULL,
162 						 (Tcl_CmdDeleteProc *)NULL);
163 
164 	Tcl_CreateObjCommand(interp,
165 						 "pg_listen",
166 						 Pg_listen,
167 						 (ClientData)NULL,
168 						 (Tcl_CmdDeleteProc *)NULL);
169 
170 	Tcl_CreateObjCommand(interp,
171 						 "pg_sendquery",
172 						 Pg_sendquery,
173 						 (ClientData)NULL,
174 						 (Tcl_CmdDeleteProc *)NULL);
175 
176 	Tcl_CreateObjCommand(interp,
177 						 "pg_sendquery_prepared",
178 						 Pg_sendquery_prepared,
179 						 (ClientData)NULL,
180 						 (Tcl_CmdDeleteProc *)NULL);
181 
182 	Tcl_CreateObjCommand(interp,
183 						 "pg_sendquery_params",
184 						 Pg_sendquery_params,
185 						 (ClientData)NULL,
186 						 (Tcl_CmdDeleteProc *)NULL);
187 
188 	Tcl_CreateObjCommand(interp,
189 						 "pg_getresult",
190 						 Pg_getresult,
191 						 (ClientData)NULL,
192 						 (Tcl_CmdDeleteProc *)NULL);
193 
194 	Tcl_CreateObjCommand(interp,
195 						 "pg_isbusy",
196 						 Pg_isbusy,
197 						 (ClientData)NULL,
198 						 (Tcl_CmdDeleteProc *)NULL);
199 
200 	Tcl_CreateObjCommand(interp,
201 						 "pg_blocking",
202 						 Pg_blocking,
203 						 (ClientData)NULL,
204 						 (Tcl_CmdDeleteProc *)NULL);
205 
206 	Tcl_CreateObjCommand(interp,
207 						 "pg_cancelrequest",
208 						 Pg_cancelrequest,
209 						 (ClientData)NULL,
210 						 (Tcl_CmdDeleteProc *)NULL);
211 
212 	Tcl_CreateObjCommand(interp,
213 						  "pg_on_connection_loss",
214 						  Pg_on_connection_loss,
215 						  (ClientData) NULL,
216 						  (Tcl_CmdDeleteProc *) NULL);
217 
218 	Tcl_CreateObjCommand(interp,
219 						  "pg_escape_string",
220 						  Pg_escape_string,
221 						  (ClientData) NULL,
222 						  (Tcl_CmdDeleteProc *) NULL);
223 
224 	Tcl_CreateObjCommand(interp,
225 						  "pg_quote",
226 						  Pg_quote,
227 						  (ClientData) NULL,
228 						  (Tcl_CmdDeleteProc *) NULL);
229 
230 	Tcl_CreateObjCommand(interp,
231 						  "pg_escape_bytea",
232 						  Pg_escape_bytea,
233 						  (ClientData) NULL,
234 						  (Tcl_CmdDeleteProc *) NULL);
235 
236 	Tcl_CreateObjCommand(interp,
237 						  "pg_unescape_bytea",
238 						  Pg_unescape_bytea,
239 						  (ClientData) NULL,
240 						  (Tcl_CmdDeleteProc *) NULL);
241 
242 	Tcl_CreateObjCommand(interp,
243 						  "pg_transaction_status",
244 						  Pg_transaction_status,
245 						  (ClientData) NULL,
246 						  (Tcl_CmdDeleteProc *) NULL);
247 
248 	Tcl_CreateObjCommand(interp,
249 						  "pg_parameter_status",
250 						  Pg_parameter_status,
251 						  (ClientData) NULL,
252 						  (Tcl_CmdDeleteProc *) NULL);
253 
254 	Tcl_CreateObjCommand(interp,
255 						  "pg_exec_prepared",
256 						  Pg_exec_prepared,
257 						  (ClientData) NULL,
258 						  (Tcl_CmdDeleteProc *) NULL);
259 
260 	Tcl_CreateObjCommand(interp,
261 						  "pg_exec_params",
262 						  Pg_exec_params,
263 						  (ClientData) NULL,
264 						  (Tcl_CmdDeleteProc *) NULL);
265 
266 	Tcl_CreateObjCommand(interp,
267 						  "pg_notice_handler",
268 						  Pg_notice_handler,
269 						  (ClientData) NULL,
270 						  (Tcl_CmdDeleteProc *) NULL);
271 
272 	Tcl_CreateObjCommand(interp,
273 						  "pg_result_callback",
274 						  Pg_result_callback,
275 						  (ClientData) NULL,
276 						  (Tcl_CmdDeleteProc *) NULL);
277 
278 #ifdef HAVE_PQENCRYPTPASSWORD /* PostgreSQL >= 8.2.0 */
279 	Tcl_CreateObjCommand(interp,
280 						  "pg_encrypt_password",
281 						  Pg_encrypt_password,
282 						  (ClientData) NULL,
283 						  (Tcl_CmdDeleteProc *) NULL);
284 #endif
285 
286 #ifdef HAVE_LO_TRUNCATE /* PostgreSQL >= 8.3.0 */
287 	Tcl_CreateObjCommand(interp,
288 						  "pg_lo_truncate",
289 						  Pg_lo_truncate,
290 						  (ClientData) NULL,
291 						  (Tcl_CmdDeleteProc *) NULL);
292 #endif
293 
294 #ifdef HAVE_PQDESCRIBEPREPARED /* PostgreSQL >= 8.2.0 */
295 	Tcl_CreateObjCommand(interp,
296 						  "pg_describe_cursor",
297 						  Pg_describe_cursor,
298 						  (ClientData) NULL,
299 						  (Tcl_CmdDeleteProc *) NULL);
300 
301 	Tcl_CreateObjCommand(interp,
302 						  "pg_describe_prepared",
303 						  Pg_describe_prepared,
304 						  (ClientData) NULL,
305 						  (Tcl_CmdDeleteProc *) NULL);
306 #endif
307 
308 	Tcl_CreateObjCommand(interp,
309 						  "pg_backend_pid",
310 						  Pg_backend_pid,
311 						  (ClientData) NULL,
312 						  (Tcl_CmdDeleteProc *) NULL);
313 
314 	Tcl_CreateObjCommand(interp,
315 						  "pg_server_version",
316 						  Pg_server_version,
317 						  (ClientData) NULL,
318 						  (Tcl_CmdDeleteProc *) NULL);
319 
320 #ifdef HAVE_LO_TELL64  /* PostgreSQL >= 9.3.0 */
321 	Tcl_CreateObjCommand(interp,
322 						  "pg_lo_tell64",
323 						  Pg_lo_tell64,
324 						  (ClientData) NULL,
325 						  (Tcl_CmdDeleteProc *) NULL);
326 
327 	Tcl_CreateObjCommand(interp,
328 						  "pg_lo_lseek64",
329 						  Pg_lo_lseek64,
330 						  (ClientData) NULL,
331 						  (Tcl_CmdDeleteProc *) NULL);
332 
333 	Tcl_CreateObjCommand(interp,
334 						  "pg_lo_truncate64",
335 						  Pg_lo_truncate64,
336 						  (ClientData) NULL,
337 						  (Tcl_CmdDeleteProc *) NULL);
338 #endif
339 
340 #ifdef HAVE_PQESCAPELITERAL /* PostgreSQL >= 9.0 */
341 	Tcl_CreateObjCommand(interp,
342 						  "pg_escape_literal",
343 						  Pg_escape_l_i,
344 						  (ClientData) 1,
345 						  (Tcl_CmdDeleteProc *) NULL);
346 
347 	Tcl_CreateObjCommand(interp,
348 						  "pg_escape_identifier",
349 						  Pg_escape_l_i,
350 						  (ClientData) 2,
351 						  (Tcl_CmdDeleteProc *) NULL);
352 #endif
353 
354 	/* Note PACKAGE_VERSION (or VERSION) is provided by the TEA Makefile */
355 #ifndef PACKAGE_VERSION
356 #ifdef VERSION
357 #define PACKAGE_VERSION VERSION
358 #else
359 #define PACKAGE_VERSION "0.0"
360 #endif
361 #endif
362 	Tcl_PkgProvide(interp, "Pgtcl", PACKAGE_VERSION);
363 
364 	return TCL_OK;
365 }
366 
367 DLLEXPORT int
Pgtcl_SafeInit(Tcl_Interp * interp)368 Pgtcl_SafeInit(Tcl_Interp *interp)
369 {
370 	return Pgtcl_Init(interp);
371 }
372