Mercurial > hg > xemacs-beta
annotate modules/postgresql/postgresql.c @ 4967:0d4c9d0f6a8d
rewrite dynarr code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-03 Ben Wing <ben@xemacs.org>
* device-x.c (x_get_resource_prefix):
* device-x.c (Fx_get_resource):
* device-x.c (Fx_get_resource_prefix):
* device-x.c (Fx_put_resource):
* dialog-msw.c:
* dialog-msw.c (handle_question_dialog_box):
* dired-msw.c (mswindows_sort_files):
* dired-msw.c (mswindows_get_files):
* extents.c (extent_fragment_sort_by_priority):
* extents.c (Fset_extent_parent):
* file-coding.c (coding_reader):
* file-coding.c (coding_writer):
* file-coding.c (gzip_convert):
* frame.c (generate_title_string):
* gutter.c (calculate_gutter_size_from_display_lines):
* indent.c (vmotion_1):
* lread.c (read_bit_vector):
* mule-coding.c (iso2022_decode):
* rangetab.c:
* rangetab.c (Fcopy_range_table):
* rangetab.c (Fget_range_table):
* rangetab.c (unified_range_table_copy_data):
* redisplay-msw.c (mswindows_output_string):
* redisplay-output.c (output_display_line):
* redisplay-output.c (redisplay_move_cursor):
* redisplay-output.c (redisplay_clear_bottom_of_window):
* redisplay-tty.c (tty_output_ichar_dynarr):
* redisplay-tty.c (set_foreground_to):
* redisplay-tty.c (set_background_to):
* redisplay-xlike-inc.c (XLIKE_output_string):
* redisplay.c (redisplay_window_text_width_string):
* redisplay.c (redisplay_text_width_string):
* redisplay.c (create_text_block):
* redisplay.c (SET_CURRENT_MODE_CHARS_PIXSIZE):
* redisplay.c (generate_fstring_runes):
* redisplay.c (regenerate_modeline):
* redisplay.c (ensure_modeline_generated):
* redisplay.c (real_current_modeline_height):
* redisplay.c (create_string_text_block):
* redisplay.c (regenerate_window):
* redisplay.c (REGEN_INC_FIND_START_END):
* redisplay.c (point_visible):
* redisplay.c (redisplay_window):
* redisplay.c (mark_glyph_block_dynarr):
* redisplay.c (line_start_cache_start):
* redisplay.c (start_with_line_at_pixpos):
* redisplay.c (update_line_start_cache):
* redisplay.c (glyph_to_pixel_translation):
* redisplay.c (pixel_to_glyph_translation):
* sysdep.c (qxe_readdir):
* text.c (dfc_convert_to_external_format):
* text.c (dfc_convert_to_internal_format):
* toolbar-common.c (common_output_toolbar_button):
* window.c (window_modeline_height):
* window.c (Fwindow_last_line_visible_height):
* window.c (window_displayed_height):
* window.c (window_scroll):
* window.c (get_current_pixel_pos):
Use Dynarr_begin() in place of Dynarr_atp (foo, 0).
* dynarr.c (Dynarr_realloc):
* dynarr.c (Dynarr_lisp_realloc):
* dynarr.c (Dynarr_resize):
* dynarr.c (Dynarr_insert_many):
* dynarr.c (Dynarr_delete_many):
* dynarr.c (Dynarr_memory_usage):
* dynarr.c (stack_like_malloc):
* dynarr.c (stack_like_free):
* lisp.h:
* lisp.h (DECLARE_DYNARR_LISP_IMP):
* lisp.h (XD_DYNARR_DESC):
* lisp.h (Dynarr_pop):
* gutter.c (output_gutter):
* redisplay-output.c (sync_rune_structs):
* redisplay-output.c (redisplay_output_window):
Redo the dynarr code, add greater checks.
Rename the `len', `largest' and `max' members to `len_',
`largest_' and `max_' to try and catch existing places that might
directly modify these values. Make new accessors Dynarr_largest()
and Dynarr_max() and make them and existing Dynarr_length() be
non-lvalues by adding '+ 0' to them; fix a couple of places in the
redisplay code that tried to modify the length directly by setting
Dynarr_length(). Use the accessors whenever possible even in the
dynarr code itself. The accessors also verify that 0 <= len <=
largest <= max. Rename settor function Dynarr_set_size() to
Dynarr_set_length() and use it more consistently; also create
lower-level Dynarr_set_length_1(). This latter function should be
the only function that directly modifies the `len_' member of a
Dynarr, and in the process makes sure that the `largest' value is
kept correct.
Consistently use ERROR_CHECK_STRUCTURES instead of
ERROR_CHECK_TYPES for error-checking code. Reintroduce the
temporarily disabled verification code on the positions of
Dynarr_at(), Dynarr_atp() and Dynarr_atp_past_end().
Also create Dynarr_resize_if() in place of a repeated
code fragment. Clean up all the functions that modify Dynarrs to
use the new macros and functions and verify the correctness of the
Dynarr both before and after the change.
Note that there are two kinds of verification -- one for accessing
and one for modifying. The difference is that the modify
verification additionally checks to make sure that the Dynarr
isn't locked. (This is used in redisplay to check for problems
with reentrancy.)
* lrecord.h: Move XD_DYNARR_DESC to lisp.h, grouping with the dynarr code.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 03 Feb 2010 20:51:18 -0600 |
| parents | 304aebb79cd3 |
| children | 4aebb0131297 |
| rev | line source |
|---|---|
| 996 | 1 /* |
| 2 postgresql.c -- Emacs Lisp binding to libpq.so | |
| 3 Copyright (C) 2000 Electrotechnical Laboratory, JAPAN. | |
| 4 Licensed to the Free Software Foundation. | |
| 5 | |
| 3820 | 6 Author: SL Baur <steve@xemacs.org> |
| 7 Maintainer: SL Baur <steve@xemacs.org> | |
| 996 | 8 |
| 9 Please send patches to this file to me first before submitting them to | |
| 10 xemacs-patches. | |
| 11 | |
| 12 | |
| 13 KNOWN PROBLEMS (Last update 15-March-2000) | |
| 14 + None. | |
| 15 | |
| 16 Implementation notes: | |
| 17 0. Supported PostgreSQL versions | |
| 18 This code was developed against libpq-6.5.3 and libpq-7.0-beta1. Earlier | |
| 19 versions may work. V7 support is more complete than V6.5 support. | |
| 20 1. Mule | |
| 21 Non-ASCII databases have been tested on both 6.5 and 7.0. | |
| 22 2. Asynchronous Operation | |
| 23 Starting with libpq-7.0, an asynchronous interface is offered. This | |
| 24 binding supports the asynchronous calls to a limited extent. Since the | |
| 25 XEmacs 21.2 core does not support a sensible interface to add managed but | |
| 26 unreadable (by XEmacs) file descriptors to the main select code, polling | |
| 27 is required to drive the asynchronous calls. XtAppAddInput would work | |
| 28 fine, but we want to be able to use the database when running strictly in | |
| 29 tty mode. | |
| 30 3. Completeness | |
| 31 Various calls have been deliberately not exported to Lisp. The | |
| 32 unexported calls are either left-over backwards compatibility code that | |
| 33 aren't needed, calls that cannot be implemented sensibly, or calls that | |
| 34 cannot be implemented safely. A list of all global functions in libpq | |
| 35 but not exported to Lisp is below. | |
| 36 4. Policy | |
| 37 This interface tries very hard to not set any policy towards how database | |
| 38 code in Emacs Lisp will be written. | |
| 39 5. Documentation | |
| 40 For full lisp programming documentation, see the XEmacs Lisp Reference | |
| 41 Manual. For PostgreSQL documentation, see the PostgreSQL distribution. | |
| 42 | |
| 43 TODO (in rough order of priority): | |
| 44 1. Asynchronous notifies need to be implemented to the extent they can be. | |
| 45 2. The large object interface needs work with Emacs buffers in addition | |
| 46 to files. Need two functions buffer->large_object, and large_object-> | |
| 47 buffer. | |
| 48 */ | |
| 49 | |
| 50 /* | |
| 51 Unimplemented functions: [TODO] | |
| 52 PQsetNoticeProcessor | |
| 53 | |
| 54 Implemented, but undocumented functions: [TODO] | |
| 55 PQgetline (copy in/out) | |
| 56 PQputline (copy in/out) | |
| 57 PQgetlineAsync (copy in/out Asynch.) | |
| 58 PQputnbytes (copy in/out Asynch.) | |
| 59 PQendcopy (copy in/out) | |
| 60 | |
| 61 Unsupported functions: | |
| 62 PQsetdbLogin -- This function is deprecated, has a subset of the | |
| 63 functionality of PQconnectdb, and is better done in Lisp. | |
| 64 PQsetdb -- Same as for PQsetdbLogin | |
| 65 PQsocket -- Abstraction error, file descriptors should not be leaked | |
| 66 into Lisp code | |
| 67 PQprint -- print to a file descriptor, deprecated, better done in Lisp | |
| 68 PQdisplayTuples -- deprecated | |
| 69 PQprintTuples -- really, really deprecated | |
| 70 PQmblen -- Returns the length in bytes of multibyte character encoded | |
| 71 string. | |
| 72 PQtrace -- controls debug print tracing to a tty. | |
| 73 PQuntrace -- Ditto. I don't see any way to do this sensibly. | |
| 74 PQoidStatus -- deprecated and nearly identical to PQoidValue | |
| 75 PQfn -- "Fast path" interface | |
| 76 lo_open (large object) [*] | |
| 77 lo_close (large object) [*] | |
| 78 lo_read (large object) [*] | |
| 79 lo_write (large object) [*] | |
| 80 lo_lseek (large object) [*] | |
| 81 lo_creat (large object) [*] | |
| 82 lo_tell (large object) [*] | |
| 83 lo_unlink (large object) [*] | |
| 84 */ | |
| 85 | |
| 86 #include <config.h> | |
| 87 | |
| 88 /* This must be portable with XEmacs 21.1 so long as it is the official | |
| 89 released version of XEmacs and provides the basis of InfoDock. The | |
| 90 interface to lcrecord handling has changed with 21.2, so unfortunately | |
| 91 we will need a few snippets of backwards compatibility code. | |
| 92 */ | |
| 93 #if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION < 2) | |
| 94 #define RUNNING_XEMACS_21_1 1 | |
| 95 #endif | |
| 96 | |
| 97 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */ | |
| 98 | |
| 99 #include "lisp.h" | |
| 100 #include "sysdep.h" | |
| 101 | |
| 102 #include "buffer.h" | |
| 103 #include "postgresql.h" | |
| 104 #include "process.h" | |
| 1632 | 105 #ifdef HAVE_SHLIB |
| 106 # include "emodules.h" | |
| 107 #endif | |
| 996 | 108 |
| 109 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */ | |
| 110 #define PG_OS_CODING FORMAT_FILENAME | |
| 111 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to) | |
| 112 #else | |
| 113 #ifdef MULE | |
| 114 #define PG_OS_CODING get_coding_system_for_text_file (Vpg_coding_system, 1) | |
| 115 #else | |
| 116 #define PG_OS_CODING Qnative | |
| 117 #endif | |
| 118 Lisp_Object Vpg_coding_system; | |
| 119 #endif | |
| 120 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
121 #define CHECK_LIVE_CONNECTION(P) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
122 do \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
123 { \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
124 if (!P || (PQstatus (P) != CONNECTION_OK)) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
125 { \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
126 const Ibyte *err; \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
127 \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
128 if (P) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
129 err = NEW_EXTERNAL_TO_C_STRING (PQerrorMessage (P), PG_OS_CODING); \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
130 else \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
131 err = (const Ibyte *) "bad value"; \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
132 signal_ferror (Qprocess_error, "dead connection [%s]", err); \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
133 } \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
134 } \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
135 while (0) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
136 |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
137 #define PUKE_IF_NULL(p) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
138 do \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
139 { \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
140 if (!p) signal_error (Qinvalid_argument, "bad value", Qunbound); \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
141 } \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
142 while (0) |
| 996 | 143 |
| 144 static Lisp_Object VXPGHOST; | |
| 145 static Lisp_Object VXPGUSER; | |
| 146 static Lisp_Object VXPGOPTIONS; | |
| 147 static Lisp_Object VXPGPORT; | |
| 148 static Lisp_Object VXPGTTY; /* This needs to be blanked! */ | |
| 149 static Lisp_Object VXPGDATABASE; | |
| 150 static Lisp_Object VXPGREALM; | |
| 151 #ifdef MULE | |
| 152 static Lisp_Object VXPGCLIENTENCODING; | |
| 153 #endif /* MULE */ | |
| 154 | |
| 155 /* Other variables: | |
| 156 PGAUTHTYPE -- not used after PostgreSQL 6.5 | |
| 157 PGGEQO | |
| 158 PGCOSTINDEX | |
| 159 PGCOSTHEAP | |
| 160 PGTZ | |
| 161 PGDATESTYLE | |
| 162 */ | |
| 163 #ifndef HAVE_POSTGRESQLV7 | |
| 164 static Lisp_Object VXPGAUTHTYPE; | |
| 165 #endif | |
| 166 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE; | |
| 167 | |
| 168 static Lisp_Object Qpostgresql; | |
| 169 static Lisp_Object Qpg_connection_ok, Qpg_connection_bad; | |
| 170 static Lisp_Object Qpg_connection_started, Qpg_connection_made; | |
| 171 static Lisp_Object Qpg_connection_awaiting_response, Qpg_connection_auth_ok; | |
| 172 static Lisp_Object Qpg_connection_setenv; | |
| 173 | |
| 174 static Lisp_Object Qpqdb, Qpquser, Qpqpass, Qpqhost, Qpqport, Qpqtty; | |
| 175 static Lisp_Object Qpqoptions, Qpqstatus, Qpqerrormessage, Qpqbackendpid; | |
| 176 | |
| 177 static Lisp_Object Qpgres_empty_query, Qpgres_command_ok, Qpgres_tuples_ok; | |
| 178 static Lisp_Object Qpgres_copy_out, Qpgres_copy_in, Qpgres_bad_response; | |
| 179 static Lisp_Object Qpgres_nonfatal_error, Qpgres_fatal_error; | |
| 180 | |
| 181 static Lisp_Object Qpgres_polling_failed, Qpgres_polling_reading; | |
| 182 static Lisp_Object Qpgres_polling_writing, Qpgres_polling_ok; | |
| 183 static Lisp_Object Qpgres_polling_active; | |
| 184 /****/ | |
| 185 | |
| 186 /* PGconn is an opaque object and we need to be able to store them in | |
| 187 Lisp code because libpq supports multiple connections. | |
| 188 */ | |
| 189 Lisp_Object Qpgconnp; | |
| 190 | |
| 191 static Lisp_Object | |
| 192 make_pgconn (Lisp_PGconn *pgconn) | |
| 193 { | |
| 194 return wrap_pgconn (pgconn); | |
| 195 } | |
| 196 | |
| 1204 | 197 static const struct memory_description pgconn_description [] = { |
| 996 | 198 { XD_END } |
| 199 }; | |
| 200 | |
| 201 static Lisp_Object | |
| 202 #ifdef RUNNING_XEMACS_21_1 | |
| 2286 | 203 mark_pgconn (Lisp_Object UNUSED (obj), |
| 204 void (*UNUSED_ARG (markobj)) (Lisp_Object) ATTRIBUTE_UNUSED) | |
| 996 | 205 #else |
| 2286 | 206 mark_pgconn (Lisp_Object UNUSED (obj)) |
| 996 | 207 #endif |
| 208 { | |
| 209 return Qnil; | |
| 210 } | |
| 211 | |
| 212 static void | |
| 2286 | 213 print_pgconn (Lisp_Object obj, Lisp_Object printcharfun, |
| 214 int UNUSED (escapeflag)) | |
| 996 | 215 { |
| 216 char buf[256]; | |
| 217 PGconn *P; | |
| 218 ConnStatusType cst; | |
| 4932 | 219 const char *host="", *db="", *user="", *port=""; |
| 996 | 220 |
| 221 P = (XPGCONN (obj))->pgconn; | |
| 222 | |
| 223 if (!P) /* this may happen since we allow PQfinish() to be called */ | |
| 224 strcpy (buf, "#<PGconn DEAD>"); /* evil! */ | |
| 225 else if ((cst = PQstatus (P)) == CONNECTION_OK) | |
| 226 { | |
| 227 if (!(host = PQhost (P))) | |
| 228 host = ""; | |
| 229 port = PQport (P); | |
| 230 db = PQdb (P); | |
| 231 if (!(user = PQuser (P))) | |
| 232 user = ""; | |
| 233 sprintf (buf, "#<PGconn %s:%s %s/%s>", /* evil! */ | |
| 234 !strlen (host) ? "localhost" : host, | |
| 235 port, | |
| 236 user, | |
| 237 db); | |
| 238 } | |
| 239 else if (cst == CONNECTION_BAD) | |
| 240 strcpy (buf, "#<PGconn BAD>"); /* evil! */ | |
| 241 else | |
| 242 strcpy (buf, "#<PGconn connecting>"); /* evil! */ | |
| 243 | |
| 244 if (print_readably) | |
| 245 printing_unreadable_object ("%s", buf); | |
| 246 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
247 write_cistring (printcharfun, buf); |
| 996 | 248 } |
| 249 | |
| 250 static Lisp_PGconn * | |
| 251 allocate_pgconn (void) | |
| 252 { | |
| 253 #ifdef RUNNING_XEMACS_21_1 | |
| 3024 | 254 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, |
| 996 | 255 lrecord_pgconn); |
| 256 #else | |
| 3024 | 257 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, |
| 996 | 258 &lrecord_pgconn); |
| 259 #endif | |
| 260 pgconn->pgconn = (PGconn *)NULL; | |
| 261 return pgconn; | |
| 262 } | |
| 263 | |
| 264 static void | |
| 265 finalize_pgconn (void *header, int for_disksave) | |
| 266 { | |
| 267 Lisp_PGconn *pgconn = (Lisp_PGconn *)header; | |
| 268 | |
| 269 if (for_disksave) | |
| 270 invalid_operation ("Can't dump an emacs containing PGconn objects", | |
| 271 make_pgconn (pgconn)); | |
| 272 | |
| 273 if (pgconn->pgconn) | |
| 274 { | |
| 275 PQfinish (pgconn->pgconn); | |
| 276 pgconn->pgconn = (PGconn *)NULL; | |
| 277 } | |
| 278 } | |
| 279 | |
| 280 #ifdef RUNNING_XEMACS_21_1 | |
| 281 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, | |
| 282 mark_pgconn, print_pgconn, finalize_pgconn, | |
| 283 NULL, NULL, | |
| 284 Lisp_PGconn); | |
| 285 #else | |
| 286 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, | |
| 287 0, /*dumpable-flag*/ | |
| 288 mark_pgconn, print_pgconn, finalize_pgconn, | |
| 289 NULL, NULL, | |
| 290 pgconn_description, | |
| 291 Lisp_PGconn); | |
| 292 #endif | |
| 293 /****/ | |
| 294 | |
| 295 /* PGresult is an opaque object and we need to be able to store them in | |
| 296 Lisp code. | |
| 297 */ | |
| 298 Lisp_Object Qpgresultp; | |
| 299 | |
| 300 static Lisp_Object | |
| 301 make_pgresult (Lisp_PGresult *pgresult) | |
| 302 { | |
| 303 return wrap_pgresult (pgresult); | |
| 304 } | |
| 305 | |
| 1204 | 306 static const struct memory_description pgresult_description [] = { |
| 996 | 307 { XD_END } |
| 308 }; | |
| 309 | |
| 310 | |
| 311 static Lisp_Object | |
| 312 #ifdef RUNNING_XEMACS_21_1 | |
| 2286 | 313 mark_pgresult (Lisp_Object UNUSED (obj), |
| 314 void (*UNUSED_ARG (markobj)) (Lisp_Object) ATTRIBUTE_UNUSED) | |
| 996 | 315 #else |
| 2286 | 316 mark_pgresult (Lisp_Object UNUSED (obj)) |
| 996 | 317 #endif |
| 318 { | |
| 319 return Qnil; | |
| 320 } | |
| 321 | |
| 322 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>" | |
| 323 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>" | |
| 324 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>" | |
| 325 static void | |
| 2286 | 326 print_pgresult (Lisp_Object obj, Lisp_Object printcharfun, |
| 327 int UNUSED (escapeflag)) | |
| 996 | 328 { |
| 329 char buf[1024]; | |
| 330 PGresult *res; | |
| 331 | |
| 332 res = (XPGRESULT (obj))->pgresult; | |
| 333 | |
| 334 if (res) | |
| 335 { | |
| 336 switch (PQresultStatus (res)) | |
| 337 { | |
| 338 case PGRES_TUPLES_OK: | |
| 339 /* Add number of tuples of result to output */ | |
| 340 sprintf (buf, RESULT_TUPLES_FMT, /* evil! */ | |
| 341 PQresStatus (PQresultStatus (res)), | |
| 342 PQntuples (res), | |
| 343 PQcmdStatus (res)); | |
| 344 break; | |
| 345 case PGRES_COMMAND_OK: | |
| 346 /* Add number of tuples affected by output-less command */ | |
| 347 if (!strlen (PQcmdTuples (res))) goto notuples; | |
| 348 sprintf (buf, RESULT_CMD_TUPLES_FMT, /* evil! */ | |
| 349 PQresStatus (PQresultStatus (res)), | |
| 350 PQcmdTuples (res), | |
| 351 PQcmdStatus (res)); | |
| 352 break; | |
| 353 default: | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
354 notuples: |
| 996 | 355 /* No counts to print */ |
| 356 sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */ | |
| 357 PQresStatus (PQresultStatus (res)), | |
| 358 PQcmdStatus (res)); | |
| 359 break; | |
| 360 } | |
| 361 } | |
| 362 else | |
| 363 strcpy (buf, "#<PGresult DEAD>"); /* evil! */ | |
| 364 | |
| 365 if (print_readably) | |
| 366 printing_unreadable_object ("%s", buf); | |
| 367 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
368 write_cistring (printcharfun, buf); |
| 996 | 369 } |
| 370 | |
| 371 #undef RESULT_TUPLES_FMT | |
| 372 #undef RESULT_CMD_TUPLES_FMT | |
| 373 #undef RESULT_DEFAULT_FMT | |
| 374 | |
| 375 static Lisp_PGresult * | |
| 376 allocate_pgresult (void) | |
| 377 { | |
| 378 #ifdef RUNNING_XEMACS_21_1 | |
| 3024 | 379 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, |
| 996 | 380 lrecord_pgresult); |
| 381 #else | |
| 3024 | 382 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, |
| 996 | 383 &lrecord_pgresult); |
| 384 #endif | |
| 385 pgresult->pgresult = (PGresult *)NULL; | |
| 386 return pgresult; | |
| 387 } | |
| 388 | |
| 389 static void | |
| 390 finalize_pgresult (void *header, int for_disksave) | |
| 391 { | |
| 392 Lisp_PGresult *pgresult = (Lisp_PGresult *)header; | |
| 393 | |
| 394 if (for_disksave) | |
| 395 invalid_operation ("Can't dump an emacs containing PGresult objects", | |
| 396 make_pgresult (pgresult)); | |
| 397 | |
| 398 if (pgresult->pgresult) | |
| 399 { | |
| 400 PQclear (pgresult->pgresult); | |
| 401 pgresult->pgresult = (PGresult *)NULL; | |
| 402 } | |
| 403 } | |
| 404 | |
| 405 #ifdef RUNNING_XEMACS_21_1 | |
| 406 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, | |
| 407 mark_pgresult, print_pgresult, finalize_pgresult, | |
| 408 NULL, NULL, | |
| 409 Lisp_PGresult); | |
| 410 #else | |
| 411 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, | |
| 412 0, /*dumpable-flag*/ | |
| 413 mark_pgresult, print_pgresult, finalize_pgresult, | |
| 414 NULL, NULL, | |
| 415 pgresult_description, | |
| 416 Lisp_PGresult); | |
| 417 #endif | |
| 418 | |
| 419 /***********************/ | |
| 420 | |
| 421 /* notices */ | |
| 422 static void | |
| 2286 | 423 xemacs_notice_processor (void *UNUSED (arg), const char *msg) |
| 996 | 424 { |
| 425 warn_when_safe (Qpostgresql, Qnotice, "%s", msg); | |
| 426 } | |
| 427 | |
| 428 /* There are four ways (as of PostgreSQL v7) to connect to a database. | |
| 429 Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those | |
| 430 routines take a number of positional parameters and are better done in Lisp. | |
| 431 Note that PQconnectStart does not exist prior to v7. | |
| 432 */ | |
| 433 | |
| 434 /* ###autoload */ | |
| 435 DEFUN ("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /* | |
| 436 Return a connection default structure. | |
| 437 */ | |
| 438 ()) | |
| 439 { | |
| 440 /* This function can GC */ | |
| 441 PQconninfoOption *pcio; | |
| 442 Lisp_Object temp, temp1; | |
| 443 int i; | |
| 444 | |
| 445 pcio = PQconndefaults(); | |
| 446 if (!pcio) return Qnil; /* can never happen in libpq-7.0 */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
447 temp = |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
448 list1 (nconc2 (list4 (build_extstring (pcio[0].keyword, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
449 build_extstring (pcio[0].envvar, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
450 build_extstring (pcio[0].compiled, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
451 build_extstring (pcio[0].val, PG_OS_CODING)), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
452 list3 (build_extstring (pcio[0].label, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
453 build_extstring (pcio[0].dispchar, PG_OS_CODING), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
454 make_int (pcio[0].dispsize)))); |
| 996 | 455 |
| 456 for (i = 1; pcio[i].keyword; i++) | |
| 457 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
458 temp1 = |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
459 list1 (nconc2 (list4 (build_extstring (pcio[i].keyword, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
460 build_extstring (pcio[i].envvar, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
461 build_extstring (pcio[i].compiled, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
462 build_extstring (pcio[i].val, PG_OS_CODING)), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
463 list3 (build_extstring (pcio[i].label, PG_OS_CODING), |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
464 build_extstring (pcio[i].dispchar, PG_OS_CODING), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
465 make_int (pcio[i].dispsize)))); |
| 996 | 466 { |
| 467 Lisp_Object args[2]; | |
| 468 args[0] = temp; | |
| 469 args[1] = temp1; | |
| 470 /* Fappend GCPROs its arguments */ | |
| 471 temp = Fappend (2, args); | |
| 472 } | |
| 473 } | |
| 474 | |
| 475 return temp; | |
| 476 } | |
| 477 | |
| 478 /* PQconnectdb Makes a new connection to a backend. | |
| 479 PGconn *PQconnectdb(const char *conninfo) | |
| 480 */ | |
| 481 | |
| 482 /* ###autoload */ | |
| 483 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /* | |
| 484 Make a new connection to a PostgreSQL backend. | |
| 485 */ | |
| 486 (conninfo)) | |
| 487 { | |
| 488 PGconn *P; | |
| 489 Lisp_PGconn *lisp_pgconn; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
490 const Ascbyte *error_message = "Out of Memory?"; |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
491 Extbyte *c_conninfo; |
| 996 | 492 |
| 493 CHECK_STRING (conninfo); | |
| 494 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
495 LISP_STRING_TO_EXTERNAL (conninfo, c_conninfo, PG_OS_CODING); |
| 996 | 496 P = PQconnectdb (c_conninfo); |
| 497 if (P && (PQstatus (P) == CONNECTION_OK)) | |
| 498 { | |
| 499 (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
500 lisp_pgconn = allocate_pgconn (); |
| 996 | 501 lisp_pgconn->pgconn = P; |
| 502 return make_pgconn (lisp_pgconn); | |
| 503 } | |
| 504 else | |
| 505 { | |
| 506 /* Connection failed. Destroy the connection and signal an error. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
507 Ibyte *errmsg = (Ibyte *) error_message; |
| 996 | 508 if (P) |
| 509 { | |
| 510 /* storage for the error message gets erased when call PQfinish */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
511 /* so we must temporarily stash it somewhere -- make alloca() copy */ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
512 errmsg = NEW_EXTERNAL_TO_C_STRING (PQerrorMessage (P), PG_OS_CODING); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
513 IBYTE_STRING_TO_ALLOCA (errmsg, errmsg); |
| 996 | 514 PQfinish (P); |
| 515 } | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
516 signal_ferror (Qprocess_error, "libpq: %s", errmsg); |
| 996 | 517 } |
| 518 } | |
| 519 | |
| 520 /* PQconnectStart Makes a new asynchronous connection to a backend. | |
| 521 PGconn *PQconnectStart(const char *conninfo) | |
| 522 */ | |
| 523 | |
| 524 #ifdef HAVE_POSTGRESQLV7 | |
| 525 /* ###autoload */ | |
| 526 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /* | |
| 527 Make a new asynchronous connection to a PostgreSQL backend. | |
| 528 */ | |
| 529 (conninfo)) | |
| 530 { | |
| 531 PGconn *P; | |
| 532 Lisp_PGconn *lisp_pgconn; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
533 const Ascbyte *error_message = "Out of Memory?"; |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
534 Extbyte *c_conninfo; |
| 996 | 535 |
| 536 CHECK_STRING (conninfo); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
537 |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
538 LISP_STRING_TO_EXTERNAL (conninfo, c_conninfo, PG_OS_CODING); |
| 996 | 539 P = PQconnectStart (c_conninfo); |
| 540 | |
| 541 if (P && (PQstatus (P) != CONNECTION_BAD)) | |
| 542 { | |
| 543 (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
544 lisp_pgconn = allocate_pgconn (); |
| 996 | 545 lisp_pgconn->pgconn = P; |
| 546 | |
| 547 return make_pgconn (lisp_pgconn); | |
| 548 } | |
| 549 else | |
| 550 { | |
| 551 /* capture the error message before destroying the object */ | |
| 552 char buf[BLCKSZ]; | |
| 553 strcpy (buf, error_message); | |
| 554 if (P) | |
| 555 { | |
| 556 strncpy (buf, PQerrorMessage (P), sizeof (buf)); | |
| 557 buf[sizeof (buf) - 1] = '\0'; | |
| 558 PQfinish (P); | |
| 559 } | |
| 560 signal_ferror (Qprocess_error, "libpq: %s", buf); | |
| 561 } | |
| 562 } | |
| 563 | |
| 564 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /* | |
| 565 Poll an asynchronous connection for completion | |
| 566 */ | |
| 567 (conn)) | |
| 568 { | |
| 569 PGconn *P; | |
| 570 PostgresPollingStatusType polling_status; | |
| 571 | |
| 572 CHECK_PGCONN (conn); | |
| 573 | |
| 574 P = (XPGCONN (conn))->pgconn; | |
| 575 CHECK_LIVE_CONNECTION (P); | |
| 576 | |
| 577 polling_status = PQconnectPoll (P); | |
| 578 switch (polling_status) | |
| 579 { | |
| 580 case PGRES_POLLING_FAILED: | |
| 581 /* Something Bad has happened */ | |
| 582 { | |
| 583 char *e = PQerrorMessage (P); | |
| 584 signal_ferror (Qprocess_error, "libpq: %s", e); | |
| 585 } | |
| 586 case PGRES_POLLING_OK: | |
| 587 return Qpgres_polling_ok; | |
| 588 case PGRES_POLLING_READING: | |
| 589 return Qpgres_polling_reading; | |
| 590 case PGRES_POLLING_WRITING: | |
| 591 return Qpgres_polling_writing; | |
| 592 case PGRES_POLLING_ACTIVE: | |
| 593 return Qpgres_polling_active; | |
| 594 default: | |
| 595 /* they've added a new field we don't know about */ | |
| 596 signal_ferror (Qprocess_error, "Help! Unknown status code %08x from backend!", polling_status); | |
| 597 } | |
| 598 } | |
| 599 | |
| 600 #ifdef MULE | |
| 601 DEFUN ("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /* | |
| 602 Return client coding system. | |
| 603 */ | |
| 604 (conn)) | |
| 605 { | |
| 606 PGconn *P; | |
| 607 | |
| 608 CHECK_PGCONN (conn); | |
| 609 P = (XPGCONN (conn))->pgconn; | |
| 610 CHECK_LIVE_CONNECTION (P); | |
| 611 | |
| 612 return make_int (PQclientEncoding (P)); | |
| 613 } | |
| 614 | |
| 615 DEFUN ("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /* | |
| 616 Set client coding system. | |
| 617 */ | |
| 618 (conn, encoding)) | |
| 619 { | |
| 620 PGconn *P; | |
| 621 int rc; | |
| 622 char *c_encoding; | |
| 623 | |
| 624 CHECK_PGCONN (conn); | |
| 625 CHECK_STRING (encoding); | |
| 626 | |
| 627 P = (XPGCONN (conn))->pgconn; | |
| 628 CHECK_LIVE_CONNECTION (P); | |
| 629 | |
| 630 TO_EXTERNAL_FORMAT (LISP_STRING, encoding, | |
| 631 C_STRING_ALLOCA, c_encoding, Qnative); | |
| 632 | |
| 633 if ((rc = PQsetClientEncoding (P, c_encoding)) < 0) | |
| 634 signal_error (Qinvalid_argument, "bad encoding", Qunbound); | |
| 635 else | |
| 636 return make_int (rc); | |
| 637 } | |
| 638 | |
| 639 #endif | |
| 640 #endif /* HAVE_POSTGRESQLV7 */ | |
| 641 | |
| 642 /* PQfinish Close the connection to the backend. Also frees memory | |
| 643 used by the PGconn object. | |
| 644 void PQfinish(PGconn *conn) | |
| 645 */ | |
| 646 DEFUN ("pq-finish", Fpq_finish, 1, 1, 0, /* | |
| 647 Close the connection to the backend. | |
| 648 */ | |
| 649 (conn)) | |
| 650 { | |
| 651 PGconn *P; | |
| 652 | |
| 653 CHECK_PGCONN (conn); | |
| 654 P = (XPGCONN (conn))->pgconn; | |
| 655 PUKE_IF_NULL (P); | |
| 656 | |
| 657 PQfinish (P); | |
| 658 /* #### PQfinish deallocates the PGconn structure, so we now have a | |
| 659 dangling pointer. */ | |
| 660 /* Genocided all @'s ... */ | |
| 661 (XPGCONN (conn))->pgconn = (PGconn *)NULL; /* You feel DEAD inside */ | |
| 662 return Qnil; | |
| 663 } | |
| 664 | |
| 665 DEFUN ("pq-clear", Fpq_clear, 1, 1, 0, /* | |
| 666 Forcibly erase a PGresult object. | |
| 667 */ | |
| 668 (res)) | |
| 669 { | |
| 670 PGresult *R; | |
| 671 | |
| 672 CHECK_PGRESULT (res); | |
| 673 R = (XPGRESULT (res))->pgresult; | |
| 674 PUKE_IF_NULL (R); | |
| 675 | |
| 676 PQclear (R); | |
| 677 /* Genocided all @'s ... */ | |
| 678 (XPGRESULT (res))->pgresult = (PGresult *)NULL; /* You feel DEAD inside */ | |
| 679 | |
| 680 return Qnil; | |
| 681 } | |
| 682 | |
| 683 DEFUN ("pq-is-busy", Fpq_is_busy, 1, 1, 0, /* | |
| 684 Return t if PQgetResult would block waiting for input. | |
| 685 */ | |
| 686 (conn)) | |
| 687 { | |
| 688 PGconn *P; | |
| 689 | |
| 690 CHECK_PGCONN (conn); | |
| 691 P = (XPGCONN (conn))->pgconn; | |
| 692 CHECK_LIVE_CONNECTION (P); | |
| 693 | |
| 694 return PQisBusy (P) ? Qt : Qnil; | |
| 695 } | |
| 696 | |
| 697 DEFUN ("pq-consume-input", Fpq_consume_input, 1, 1, 0, /* | |
| 698 Consume any available input from the backend. | |
| 699 Returns nil if something bad happened. | |
| 700 */ | |
| 701 (conn)) | |
| 702 { | |
| 703 PGconn *P; | |
| 704 | |
| 705 CHECK_PGCONN (conn); | |
| 706 P = (XPGCONN (conn))->pgconn; | |
| 707 CHECK_LIVE_CONNECTION (P); | |
| 708 | |
| 709 return PQconsumeInput (P) ? Qt : Qnil; | |
| 710 } | |
| 711 | |
| 712 /* PQreset Reset the communication port with the backend. | |
| 713 void PQreset(PGconn *conn) | |
| 714 */ | |
| 715 DEFUN ("pq-reset", Fpq_reset, 1, 1, 0, /* | |
| 716 Reset the connection to the backend. | |
| 717 This function will close the connection to the backend and attempt to | |
| 718 reestablish a new connection to the same postmaster, using all the same | |
| 719 parameters previously used. This may be useful for error recovery if a | |
| 720 working connection is lost. | |
| 721 */ | |
| 722 (conn)) | |
| 723 { | |
| 724 PGconn *P; | |
| 725 | |
| 726 CHECK_PGCONN (conn); | |
| 727 P = (XPGCONN (conn))->pgconn; | |
| 728 PUKE_IF_NULL (P);/* we can resurrect a BAD connection, but not a dead one. */ | |
| 729 | |
| 730 PQreset (P); | |
| 731 | |
| 732 return Qnil; | |
| 733 } | |
| 734 | |
| 735 #ifdef HAVE_POSTGRESQLV7 | |
| 736 DEFUN ("pq-reset-start", Fpq_reset_start, 1, 1, 0, /* | |
| 737 Reset connection to the backend asynchronously. | |
| 738 */ | |
| 739 (conn)) | |
| 740 { | |
| 741 PGconn *P; | |
| 742 | |
| 743 CHECK_PGCONN (conn); | |
| 744 P = (XPGCONN (conn))->pgconn; | |
| 745 CHECK_LIVE_CONNECTION (P); | |
| 746 | |
| 747 if (PQresetStart (P)) return Qt; | |
| 748 { | |
| 749 char *e = PQerrorMessage (P); | |
| 750 signal_ferror (Qprocess_error, "libpq: %s", e); | |
| 751 } | |
| 752 } | |
| 753 | |
| 754 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /* | |
| 755 Poll an asynchronous reset for completion. | |
| 756 */ | |
| 757 (conn)) | |
| 758 { | |
| 759 PGconn *P; | |
| 760 PostgresPollingStatusType polling_status; | |
| 761 | |
| 762 CHECK_PGCONN (conn); | |
| 763 | |
| 764 P = (XPGCONN (conn))->pgconn; | |
| 765 CHECK_LIVE_CONNECTION (P); | |
| 766 | |
| 767 polling_status = PQresetPoll (P); | |
| 768 switch (polling_status) | |
| 769 { | |
| 770 case PGRES_POLLING_FAILED: | |
| 771 /* Something Bad has happened */ | |
| 772 { | |
| 773 char *e = PQerrorMessage (P); | |
| 774 signal_ferror (Qprocess_error, "libpq: %s", e); | |
| 775 } | |
| 776 case PGRES_POLLING_OK: | |
| 777 return Qpgres_polling_ok; | |
| 778 case PGRES_POLLING_READING: | |
| 779 return Qpgres_polling_reading; | |
| 780 case PGRES_POLLING_WRITING: | |
| 781 return Qpgres_polling_writing; | |
| 782 case PGRES_POLLING_ACTIVE: | |
| 783 return Qpgres_polling_active; | |
| 784 default: | |
| 785 /* they've added a new field we don't know about */ | |
| 786 signal_ferror (Qprocess_error, "Help! Unknown status code %08x from backend!", polling_status); | |
| 787 } | |
| 788 } | |
| 789 #endif | |
| 790 | |
| 791 DEFUN ("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /* | |
| 792 Attempt to request cancellation of the current operation. | |
| 793 | |
| 794 The return value is t if the cancel request was successfully | |
| 795 dispatched, nil if not (in which case conn->errorMessage is set). | |
| 796 Note: successful dispatch is no guarantee that there will be any effect at | |
| 797 the backend. The application must read the operation result as usual. | |
| 798 */ | |
| 799 (conn)) | |
| 800 { | |
| 801 PGconn *P; | |
| 802 | |
| 803 CHECK_PGCONN (conn); | |
| 804 P = (XPGCONN (conn))->pgconn; | |
| 805 CHECK_LIVE_CONNECTION (P); | |
| 806 | |
| 807 return PQrequestCancel (P) ? Qt : Qnil; | |
| 808 } | |
| 809 | |
| 810 /* accessor function for the PGconn object */ | |
| 811 DEFUN ("pq-pgconn", Fpq_pgconn, 2, 2, 0, /* | |
| 812 Accessor function for the PGconn object. | |
| 813 Currently recognized symbols for the field: | |
| 814 pq::db Database name | |
| 815 pq::user Database user name | |
| 816 pq::pass Database user's password | |
| 817 pq::host Hostname of PostgreSQL backend connected to | |
| 818 pq::port TCP port number of connection | |
| 819 pq::tty Debugging TTY (not used in Emacs) | |
| 820 pq::options Additional backend options | |
| 821 pq::status Connection status (either OK or BAD) | |
| 822 pq::error-message Last error message from the backend | |
| 823 pq::backend-pid Process ID of backend process | |
| 824 */ | |
| 825 (conn, field)) | |
| 826 { | |
| 827 PGconn *P; | |
| 828 | |
| 829 CHECK_PGCONN (conn); | |
| 830 P = (XPGCONN (conn))->pgconn; | |
| 831 PUKE_IF_NULL (P); /* BAD connections still have state to query */ | |
| 832 | |
| 833 if (EQ(field, Qpqdb)) | |
| 834 /* PQdb Returns the database name of the connection. | |
| 835 char *PQdb(PGconn *conn) | |
| 836 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
837 return build_extstring (PQdb(P), PG_OS_CODING); |
| 996 | 838 else if (EQ (field, Qpquser)) |
| 839 /* PQuser Returns the user name of the connection. | |
| 840 char *PQuser(PGconn *conn) | |
| 841 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
842 return build_extstring (PQuser(P), PG_OS_CODING); |
| 996 | 843 else if (EQ (field, Qpqpass)) |
| 844 /* PQpass Returns the password of the connection. | |
| 845 char *PQpass(PGconn *conn) | |
| 846 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
847 return build_extstring (PQpass(P), PG_OS_CODING); |
| 996 | 848 else if (EQ (field, Qpqhost)) |
| 849 /* PQhost Returns the server host name of the connection. | |
| 850 char *PQhost(PGconn *conn) | |
| 851 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
852 return build_extstring (PQhost(P), PG_OS_CODING); |
| 996 | 853 else if (EQ (field, Qpqport)) |
| 854 { | |
| 855 char *p; | |
| 856 /* PQport Returns the port of the connection. | |
| 857 char *PQport(PGconn *conn) | |
| 858 */ | |
| 859 if ((p = PQport(P))) | |
| 860 return make_int(atoi(p)); | |
| 861 else | |
| 862 return make_int(-1); | |
| 863 } | |
| 864 else if (EQ (field, Qpqtty)) | |
| 865 /* PQtty Returns the debug tty of the connection. | |
| 866 char *PQtty(PGconn *conn) | |
| 867 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
868 return build_extstring (PQtty(P), PG_OS_CODING); |
| 996 | 869 else if (EQ (field, Qpqoptions)) |
| 870 /* PQoptions Returns the backend options used in the connection. | |
| 871 char *PQoptions(PGconn *conn) | |
| 872 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
873 return build_extstring (PQoptions(P), PG_OS_CODING); |
| 996 | 874 else if (EQ (field, Qpqstatus)) |
| 875 { | |
| 876 ConnStatusType cst; | |
| 877 /* PQstatus Returns the status of the connection. The status can be | |
| 878 CONNECTION_OK or CONNECTION_BAD. | |
| 879 ConnStatusType PQstatus(PGconn *conn) | |
| 880 */ | |
| 881 switch ((cst = PQstatus (P))) | |
| 882 { | |
| 883 case CONNECTION_OK: return Qpg_connection_ok; | |
| 884 case CONNECTION_BAD: return Qpg_connection_bad; | |
| 885 #ifdef HAVE_POSTGRESQLV7 | |
| 886 case CONNECTION_STARTED: return Qpg_connection_started; | |
| 887 case CONNECTION_MADE: return Qpg_connection_made; | |
| 888 case CONNECTION_AWAITING_RESPONSE: return Qpg_connection_awaiting_response; | |
| 889 case CONNECTION_AUTH_OK: return Qpg_connection_auth_ok; | |
| 890 case CONNECTION_SETENV: return Qpg_connection_setenv; | |
| 891 #endif /* HAVE_POSTGRESQLV7 */ | |
| 892 default: | |
| 893 /* they've added a new field we don't know about */ | |
| 894 signal_ferror (Qprocess_error, "Help! Unknown connection status code %08x from backend!", cst); | |
| 895 } | |
| 896 } | |
| 897 else if (EQ (field, Qpqerrormessage)) | |
| 898 /* PQerrorMessage Returns the error message most recently generated | |
| 899 by an operation on the connection. | |
| 900 char *PQerrorMessage(PGconn* conn); | |
| 901 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
902 return build_extstring (PQerrorMessage(P), PG_OS_CODING); |
| 996 | 903 else if (EQ (field, Qpqbackendpid)) |
| 904 /* PQbackendPID Returns the process ID of the backend server handling | |
| 905 this connection. | |
| 906 int PQbackendPID(PGconn *conn); | |
| 907 */ | |
| 908 return make_int (PQbackendPID(P)); | |
| 909 else | |
| 910 signal_error (Qinvalid_argument, "bad PGconn accessor", Qunbound); | |
| 911 } | |
| 912 | |
| 913 /* Query functions */ | |
| 914 DEFUN ("pq-exec", Fpq_exec, 2, 2, 0, /* | |
| 915 Submit a query to Postgres and wait for the result. | |
| 916 */ | |
| 917 (conn, query)) | |
| 918 { | |
| 919 PGconn *P; | |
| 920 Lisp_PGresult *lisp_pgresult; | |
| 921 PGresult *R; | |
| 922 char *c_query; | |
| 923 | |
| 924 CHECK_PGCONN (conn); | |
| 925 CHECK_STRING (query); | |
| 926 | |
| 927 P = (XPGCONN (conn))->pgconn; | |
| 928 CHECK_LIVE_CONNECTION (P); | |
| 929 | |
| 930 TO_EXTERNAL_FORMAT (LISP_STRING, query, | |
| 931 C_STRING_ALLOCA, c_query, Qnative); | |
| 932 | |
| 933 R = PQexec (P, c_query); | |
| 934 { | |
| 4932 | 935 const Ascbyte *tag; |
| 936 char buf[BLCKSZ]; | |
| 996 | 937 |
| 938 if (!R) out_of_memory ("query: out of memory", Qunbound); | |
| 939 else | |
| 940 switch (PQresultStatus (R)) | |
| 941 { | |
| 942 case PGRES_BAD_RESPONSE: | |
| 943 tag = "bad response [%s]"; | |
| 944 goto err; | |
| 945 case PGRES_NONFATAL_ERROR: | |
| 946 tag = "non-fatal error [%s]"; | |
| 947 goto err; | |
| 948 case PGRES_FATAL_ERROR: | |
| 949 tag = "fatal error [%s]"; | |
| 950 err: | |
| 951 strncpy (buf, PQresultErrorMessage (R), sizeof (buf)); | |
| 952 buf [sizeof (buf) - 1] = '\0'; | |
| 953 PQclear (R); | |
| 954 signal_ferror (Qprocess_error, tag, buf); | |
| 955 /*NOTREACHED*/ | |
| 956 default: | |
| 957 break; | |
| 958 } | |
| 959 } | |
| 960 | |
| 961 lisp_pgresult = allocate_pgresult (); | |
| 962 lisp_pgresult->pgresult = R; | |
| 963 | |
| 964 return make_pgresult (lisp_pgresult); | |
| 965 } | |
| 966 | |
| 967 DEFUN ("pq-send-query", Fpq_send_query, 2, 2, 0, /* | |
| 968 Submit a query to Postgres and don't wait for the result. | |
| 969 Returns: t if successfully submitted | |
| 970 nil if error (conn->errorMessage is set) | |
| 971 */ | |
| 972 (conn, query)) | |
| 973 { | |
| 974 PGconn *P; | |
| 975 char *c_query; | |
| 976 | |
| 977 CHECK_PGCONN (conn); | |
| 978 CHECK_STRING (query); | |
| 979 | |
| 980 P = (XPGCONN (conn))->pgconn; | |
| 981 CHECK_LIVE_CONNECTION (P); | |
| 982 | |
| 983 TO_EXTERNAL_FORMAT (LISP_STRING, query, | |
| 984 C_STRING_ALLOCA, c_query, Qnative); | |
| 985 | |
| 986 if (PQsendQuery (P, c_query)) return Qt; | |
| 987 else signal_ferror (Qprocess_error, "async query: %s", PQerrorMessage (P)); | |
| 988 } | |
| 989 | |
| 990 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /* | |
| 991 Retrieve an asynchronous result from a query. | |
| 992 NIL is returned when no more query work remains. | |
| 993 */ | |
| 994 (conn)) | |
| 995 { | |
| 996 PGconn *P; | |
| 997 Lisp_PGresult *lisp_pgresult; | |
| 998 PGresult *R; | |
| 999 | |
| 1000 CHECK_PGCONN (conn); | |
| 1001 | |
| 1002 P = (XPGCONN (conn))->pgconn; | |
| 1003 CHECK_LIVE_CONNECTION (P); | |
| 1004 | |
| 1005 R = PQgetResult (P); | |
| 1006 if (!R) return Qnil; /* not an error, there's no more data to get */ | |
| 1007 | |
| 1008 { | |
| 4932 | 1009 const Ascbyte *tag; |
| 1010 char buf[BLCKSZ]; | |
| 996 | 1011 |
| 1012 switch (PQresultStatus (R)) | |
| 1013 { | |
| 1014 case PGRES_BAD_RESPONSE: | |
| 1015 tag = "bad response [%s]"; | |
| 1016 goto err; | |
| 1017 case PGRES_NONFATAL_ERROR: | |
| 1018 tag = "non-fatal error [%s]"; | |
| 1019 goto err; | |
| 1020 case PGRES_FATAL_ERROR: | |
| 1021 tag = "fatal error [%s]"; | |
| 1022 err: | |
| 1023 strncpy (buf, PQresultErrorMessage (R), sizeof (buf)); | |
| 1024 buf[sizeof (buf) - 1] = '\0'; | |
| 1025 PQclear (R); | |
| 1026 signal_ferror (Qprocess_error, tag, buf); | |
| 1027 /*NOTREACHED*/ | |
| 1028 default: | |
| 1029 break; | |
| 1030 } | |
| 1031 } | |
| 1032 | |
| 1033 lisp_pgresult = allocate_pgresult(); | |
| 1034 lisp_pgresult->pgresult = R; | |
| 1035 | |
| 1036 return make_pgresult (lisp_pgresult); | |
| 1037 } | |
| 1038 | |
| 1039 DEFUN ("pq-result-status", Fpq_result_status, 1, 1, 0, /* | |
| 1040 Return result status of the query. | |
| 1041 */ | |
| 1042 (result)) | |
| 1043 { | |
| 1044 PGresult *R; | |
| 1045 ExecStatusType est; | |
| 1046 | |
| 1047 CHECK_PGRESULT (result); | |
| 1048 R = (XPGRESULT (result))->pgresult; | |
| 1049 PUKE_IF_NULL (R); | |
| 1050 | |
| 1051 switch ((est = PQresultStatus (R))) { | |
| 1052 case PGRES_EMPTY_QUERY: return Qpgres_empty_query; | |
| 1053 case PGRES_COMMAND_OK: return Qpgres_command_ok; | |
| 1054 case PGRES_TUPLES_OK: return Qpgres_tuples_ok; | |
| 1055 case PGRES_COPY_OUT: return Qpgres_copy_out; | |
| 1056 case PGRES_COPY_IN: return Qpgres_copy_in; | |
| 1057 case PGRES_BAD_RESPONSE: return Qpgres_bad_response; | |
| 1058 case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error; | |
| 1059 case PGRES_FATAL_ERROR: return Qpgres_fatal_error; | |
| 1060 default: | |
| 1061 /* they've added a new field we don't know about */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1062 signal_ferror (Qprocess_error, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1063 "Help! Unknown exec status code %08x from backend!", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1064 est); |
| 996 | 1065 } |
| 1066 } | |
| 1067 | |
| 1068 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /* | |
| 1069 Return stringified result status of the query. | |
| 1070 */ | |
| 1071 (result)) | |
| 1072 { | |
| 1073 PGresult *R; | |
| 1074 | |
| 1075 CHECK_PGRESULT (result); | |
| 1076 R = (XPGRESULT (result))->pgresult; | |
| 1077 PUKE_IF_NULL (R); | |
| 1078 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1079 return build_extstring (PQresStatus (PQresultStatus (R)), PG_OS_CODING); |
| 996 | 1080 } |
| 1081 | |
| 1082 /* Sundry PGresult accessor functions */ | |
| 1083 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /* | |
| 1084 Return last message associated with the query. | |
| 1085 */ | |
| 1086 (result)) | |
| 1087 { | |
| 1088 PGresult *R; | |
| 1089 | |
| 1090 CHECK_PGRESULT (result); | |
| 1091 R = (XPGRESULT (result))->pgresult; | |
| 1092 PUKE_IF_NULL (R); | |
| 1093 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1094 return build_extstring (PQresultErrorMessage (R), PG_OS_CODING); |
| 996 | 1095 } |
| 1096 | |
| 1097 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /* | |
| 1098 Return the number of tuples (instances) in the query result. | |
| 1099 */ | |
| 1100 (result)) | |
| 1101 { | |
| 1102 PGresult *R; | |
| 1103 | |
| 1104 CHECK_PGRESULT (result); | |
| 1105 R = (XPGRESULT (result))->pgresult; | |
| 1106 PUKE_IF_NULL (R); | |
| 1107 | |
| 1108 return make_int (PQntuples (R)); | |
| 1109 } | |
| 1110 | |
| 1111 DEFUN ("pq-nfields", Fpq_nfields, 1, 1, 0, /* | |
| 1112 Return the number of fields (attributes) in each tuple of the query result. | |
| 1113 */ | |
| 1114 (result)) | |
| 1115 { | |
| 1116 PGresult *R; | |
| 1117 | |
| 1118 CHECK_PGRESULT (result); | |
| 1119 R = (XPGRESULT (result))->pgresult; | |
| 1120 PUKE_IF_NULL (R); | |
| 1121 | |
| 1122 return make_int (PQnfields (R)); | |
| 1123 } | |
| 1124 | |
| 1125 DEFUN ("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /* | |
| 1126 Return t if the query result contains binary data, nil otherwise. | |
| 1127 */ | |
| 1128 (result)) | |
| 1129 { | |
| 1130 PGresult *R; | |
| 1131 | |
| 1132 CHECK_PGRESULT (result); | |
| 1133 R = (XPGRESULT (result))->pgresult; | |
| 1134 PUKE_IF_NULL (R); | |
| 1135 | |
| 1136 return (PQbinaryTuples (R)) ? Qt : Qnil; | |
| 1137 } | |
| 1138 | |
| 1139 DEFUN ("pq-fname", Fpq_fname, 2, 2, 0, /* | |
| 1140 Return the field (attribute) name associated with the given field index. | |
| 1141 Field indices start at 0. | |
| 1142 */ | |
| 1143 (result, field_index)) | |
| 1144 { | |
| 1145 PGresult *R; | |
| 1146 | |
| 1147 CHECK_PGRESULT (result); | |
| 1148 CHECK_INT (field_index); | |
| 1149 R = (XPGRESULT (result))->pgresult; | |
| 1150 PUKE_IF_NULL (R); | |
| 1151 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1152 return build_extstring (PQfname (R, XINT (field_index)), PG_OS_CODING); |
| 996 | 1153 } |
| 1154 | |
| 1155 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /* | |
| 1156 Return the number of fields (attributes) in each tuple of the query result. | |
| 1157 */ | |
| 1158 (result, field_name)) | |
| 1159 { | |
| 1160 PGresult *R; | |
| 1161 char *c_field_name; | |
| 1162 | |
| 1163 CHECK_PGRESULT (result); | |
| 1164 CHECK_STRING (field_name); | |
| 1165 R = (XPGRESULT (result))->pgresult; | |
| 1166 PUKE_IF_NULL (R); | |
| 1167 | |
| 1168 TO_EXTERNAL_FORMAT (LISP_STRING, field_name, | |
| 1169 C_STRING_ALLOCA, c_field_name, Qnative); | |
| 1170 | |
| 1171 return make_int (PQfnumber (R, c_field_name)); | |
| 1172 } | |
| 1173 | |
| 1174 DEFUN ("pq-ftype", Fpq_ftype, 2, 2, 0, /* | |
| 1175 Return the field type associated with the given field index. | |
| 1176 The integer returned is the internal coding of the type. Field indices | |
| 1177 start at 0. | |
| 1178 */ | |
| 1179 (result, field_num)) | |
| 1180 { | |
| 1181 PGresult *R; | |
| 1182 | |
| 1183 CHECK_PGRESULT (result); | |
| 1184 CHECK_INT (field_num); | |
| 1185 R = (XPGRESULT (result))->pgresult; | |
| 1186 PUKE_IF_NULL (R); | |
| 1187 | |
| 1188 return make_int (PQftype (R, XINT (field_num))); | |
| 1189 } | |
| 1190 | |
| 1191 DEFUN ("pq-fsize", Fpq_fsize, 2, 2, 0, /* | |
| 1192 Return the field size in bytes associated with the given field index. | |
| 1193 Field indices start at 0. | |
| 1194 */ | |
| 1195 (result, field_index)) | |
| 1196 { | |
| 1197 PGresult *R; | |
| 1198 | |
| 1199 CHECK_PGRESULT (result); | |
| 1200 CHECK_INT (field_index); | |
| 1201 R = (XPGRESULT (result))->pgresult; | |
| 1202 PUKE_IF_NULL (R); | |
| 1203 | |
| 1204 return make_int (PQftype (R, XINT (field_index))); | |
| 1205 } | |
| 1206 | |
| 1207 DEFUN ("pq-fmod", Fpq_fmod, 2, 2, 0, /* | |
| 1208 Return the type modifier associated with a field. | |
| 1209 Field indices start at 0. | |
| 1210 */ | |
| 1211 (result, field_index)) | |
| 1212 { | |
| 1213 PGresult *R; | |
| 1214 | |
| 1215 CHECK_PGRESULT (result); | |
| 1216 CHECK_INT (field_index); | |
| 1217 R = (XPGRESULT (result))->pgresult; | |
| 1218 PUKE_IF_NULL (R); | |
| 1219 | |
| 1220 return make_int (PQfmod (R, XINT (field_index))); | |
| 1221 } | |
| 1222 | |
| 1223 DEFUN ("pq-get-value", Fpq_get_value, 3, 3, 0, /* | |
| 1224 Return a single field (attribute) value of one tuple of a PGresult. | |
| 1225 Tuple and field indices start at 0. | |
| 1226 */ | |
| 1227 (result, tup_num, field_num)) | |
| 1228 { | |
| 1229 PGresult *R; | |
| 1230 | |
| 1231 CHECK_PGRESULT (result); | |
| 1232 CHECK_INT (tup_num); | |
| 1233 CHECK_INT (field_num); | |
| 1234 R = (XPGRESULT (result))->pgresult; | |
| 1235 PUKE_IF_NULL (R); | |
| 1236 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1237 return build_extstring (PQgetvalue (R, XINT (tup_num), XINT (field_num)), |
| 996 | 1238 PG_OS_CODING); |
| 1239 } | |
| 1240 | |
| 1241 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /* | |
| 1242 Returns the length of a field value in bytes. | |
| 1243 If result is binary, i.e. a result of a binary portal, then the | |
| 1244 length returned does NOT include the size field of the varlena. (The | |
| 1245 data returned by PQgetvalue doesn't either.) | |
| 1246 */ | |
| 1247 (result, tup_num, field_num)) | |
| 1248 { | |
| 1249 PGresult *R; | |
| 1250 | |
| 1251 CHECK_PGRESULT (result); | |
| 1252 CHECK_INT (tup_num); | |
| 1253 CHECK_INT (field_num); | |
| 1254 R = (XPGRESULT (result))->pgresult; | |
| 1255 PUKE_IF_NULL (R); | |
| 1256 | |
| 1257 return make_int (PQgetlength (R, XINT (tup_num), XINT (field_num))); | |
| 1258 } | |
| 1259 | |
| 1260 DEFUN ("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /* | |
| 1261 Returns the null status of a field value. | |
| 1262 */ | |
| 1263 (result, tup_num, field_num)) | |
| 1264 { | |
| 1265 PGresult *R; | |
| 1266 | |
| 1267 CHECK_PGRESULT (result); | |
| 1268 CHECK_INT (tup_num); | |
| 1269 CHECK_INT (field_num); | |
| 1270 R = (XPGRESULT (result))->pgresult; | |
| 1271 PUKE_IF_NULL (R); | |
| 1272 | |
| 1273 return PQgetisnull (R, XINT (tup_num), XINT (field_num)) ? Qt : Qnil; | |
| 1274 } | |
| 1275 | |
| 1276 DEFUN ("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /* | |
| 1277 Returns the command status string from the SQL command that generated the result. | |
| 1278 */ | |
| 1279 (result)) | |
| 1280 { | |
| 1281 PGresult *R; | |
| 1282 | |
| 1283 CHECK_PGRESULT (result); | |
| 1284 R = (XPGRESULT (result))->pgresult; | |
| 1285 PUKE_IF_NULL (R); | |
| 1286 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1287 return build_extstring (PQcmdStatus (R), PG_OS_CODING); |
| 996 | 1288 } |
| 1289 | |
| 1290 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /* | |
| 1291 Returns the number of rows affected by the SQL command. | |
| 1292 */ | |
| 1293 (result)) | |
| 1294 { | |
| 1295 PGresult *R; | |
| 1296 | |
| 1297 CHECK_PGRESULT (result); | |
| 1298 R = (XPGRESULT (result))->pgresult; | |
| 1299 PUKE_IF_NULL (R); | |
| 1300 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1301 return build_extstring (PQcmdTuples (R), PG_OS_CODING); |
| 996 | 1302 } |
| 1303 | |
| 1304 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /* | |
| 1305 Returns the object id of the tuple inserted. | |
| 1306 */ | |
| 1307 (result)) | |
| 1308 { | |
| 1309 PGresult *R; | |
| 1310 | |
| 1311 CHECK_PGRESULT (result); | |
| 1312 R = (XPGRESULT (result))->pgresult; | |
| 1313 PUKE_IF_NULL (R); | |
| 1314 | |
| 1315 #ifdef HAVE_POSTGRESQLV7 | |
| 1316 return make_int (PQoidValue (R)); | |
| 1317 #else | |
| 1318 /* Use the old interface */ | |
| 1319 return make_int (atoi (PQoidStatus (R))); | |
| 1320 #endif | |
| 1321 } | |
| 1322 | |
| 1323 #ifdef HAVE_POSTGRESQLV7 | |
| 1324 DEFUN ("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /* | |
| 1325 Sets the PGconn's database connection non-blocking if the arg is TRUE | |
| 1326 or makes it non-blocking if the arg is FALSE, this will not protect | |
| 1327 you from PQexec(), you'll only be safe when using the non-blocking API. | |
| 1328 | |
| 1329 Needs to be called only on a connected database connection. | |
| 1330 */ | |
| 1331 (conn, arg)) | |
| 1332 { | |
| 1333 PGconn *P; | |
| 1334 | |
| 1335 CHECK_PGCONN (conn); | |
| 1336 P = (XPGCONN (conn))->pgconn; | |
| 1337 CHECK_LIVE_CONNECTION (P); | |
| 1338 | |
| 1339 return make_int (PQsetnonblocking (P, !NILP (arg))); | |
| 1340 } | |
| 1341 | |
| 1342 DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /* | |
| 1343 Return the blocking status of the database connection. | |
| 1344 */ | |
| 1345 (conn)) | |
| 1346 { | |
| 1347 PGconn *P; | |
| 1348 | |
| 1349 CHECK_PGCONN (conn); | |
| 1350 P = (XPGCONN (conn))->pgconn; | |
| 1351 CHECK_LIVE_CONNECTION (P); | |
| 1352 | |
| 1353 return PQisnonblocking (P) ? Qt : Qnil; | |
| 1354 } | |
| 1355 | |
| 1356 DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /* | |
| 1357 Force the write buffer to be written (or at least try). | |
| 1358 */ | |
| 1359 (conn)) | |
| 1360 { | |
| 1361 PGconn *P; | |
| 1362 | |
| 1363 CHECK_PGCONN (conn); | |
| 1364 P = (XPGCONN (conn))->pgconn; | |
| 1365 CHECK_LIVE_CONNECTION (P); | |
| 1366 | |
| 1367 return make_int (PQflush (P)); | |
| 1368 } | |
| 1369 #endif | |
| 1370 | |
| 1371 DEFUN ("pq-notifies", Fpq_notifies, 1, 1, 0, /* | |
| 1372 Return the latest async notification that has not yet been handled. | |
| 1373 If there has been a notification, then a list of two elements will be returned. | |
| 1374 The first element contains the relation name being notified, the second | |
| 1375 element contains the backend process ID number. nil is returned if there | |
| 1376 aren't any notifications to process. | |
| 1377 */ | |
| 1378 (conn)) | |
| 1379 { | |
| 1380 /* This function cannot GC */ | |
| 1381 PGconn *P; | |
| 1382 PGnotify *PGN; | |
| 1383 | |
| 1384 CHECK_PGCONN (conn); | |
| 1385 P = (XPGCONN (conn))->pgconn; | |
| 1386 CHECK_LIVE_CONNECTION (P); | |
| 1387 | |
| 1388 PGN = PQnotifies (P); | |
| 1389 if (!PGN) | |
| 1390 return Qnil; | |
| 1391 else | |
| 1392 { | |
| 1393 Lisp_Object temp; | |
| 1394 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1395 temp = list2 (build_extstring (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid)); |
| 996 | 1396 free ((void *)PGN); |
| 1397 return temp; | |
| 1398 } | |
| 1399 } | |
| 1400 | |
| 1401 #if defined (HAVE_POSTGRESQLV7) && defined(MULE) | |
| 1402 /* ###autoload */ | |
| 1403 DEFUN ("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /* | |
| 1404 Get encoding id from environment variable PGCLIENTENCODING. | |
| 1405 */ | |
| 1406 ()) | |
| 1407 { | |
| 1408 return make_int (PQenv2encoding ()); | |
| 1409 } | |
| 1410 #endif /* MULE */ | |
| 1411 | |
| 1412 DEFUN ("pq-lo-import", Fpq_lo_import, 2, 2, 0, /* | |
| 1413 */ | |
| 1414 (conn, filename)) | |
| 1415 { | |
| 1416 PGconn *P; | |
| 1417 char *c_filename; | |
| 1418 | |
| 1419 CHECK_PGCONN (conn); | |
| 1420 CHECK_STRING (filename); | |
| 1421 | |
| 1422 P = (XPGCONN (conn))->pgconn; | |
| 1423 CHECK_LIVE_CONNECTION (P); | |
| 1424 | |
| 1425 TO_EXTERNAL_FORMAT (LISP_STRING, filename, | |
| 1426 C_STRING_ALLOCA, c_filename, | |
| 1427 Qfile_name); | |
| 1428 | |
| 1429 return make_int ((int)lo_import (P, c_filename)); | |
| 1430 } | |
| 1431 | |
| 1432 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /* | |
| 1433 */ | |
| 1434 (conn, oid, filename)) | |
| 1435 { | |
| 1436 PGconn *P; | |
| 1437 char *c_filename; | |
| 1438 | |
| 1439 CHECK_PGCONN (conn); | |
| 1440 CHECK_INT (oid); | |
| 1441 CHECK_STRING (filename); | |
| 1442 | |
| 1443 P = (XPGCONN (conn))->pgconn; | |
| 1444 CHECK_LIVE_CONNECTION (P); | |
| 1445 | |
| 1446 TO_EXTERNAL_FORMAT (LISP_STRING, filename, | |
| 1447 C_STRING_ALLOCA, c_filename, Qfile_name); | |
| 1448 | |
| 1449 return make_int ((int)lo_export (P, XINT (oid), c_filename)); | |
| 1450 } | |
| 1451 | |
| 1452 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /* | |
| 1453 Make an empty PGresult object with the given status. | |
| 1454 */ | |
| 1455 (conn, status)) | |
| 1456 { | |
| 1457 PGconn *P; | |
| 1458 Lisp_PGresult *lpgr; | |
| 1459 PGresult *R; | |
| 1460 ExecStatusType est; | |
| 1461 | |
| 1462 CHECK_PGCONN (conn); | |
| 1463 P = (XPGCONN (conn))->pgconn; | |
| 1464 CHECK_LIVE_CONNECTION (P); /* needed here? */ | |
| 1465 | |
| 1466 if (EQ (status, Qpgres_empty_query)) est = PGRES_EMPTY_QUERY; | |
| 1467 else if (EQ (status, Qpgres_command_ok)) est = PGRES_COMMAND_OK; | |
| 1468 else if (EQ (status, Qpgres_tuples_ok)) est = PGRES_TUPLES_OK; | |
| 1469 else if (EQ (status, Qpgres_copy_out)) est = PGRES_COPY_OUT; | |
| 1470 else if (EQ (status, Qpgres_copy_in)) est = PGRES_COPY_IN; | |
| 1471 else if (EQ (status, Qpgres_bad_response)) est = PGRES_BAD_RESPONSE; | |
| 1472 else if (EQ (status, Qpgres_nonfatal_error)) est = PGRES_NONFATAL_ERROR; | |
| 1473 else if (EQ (status, Qpgres_fatal_error)) est = PGRES_FATAL_ERROR; | |
| 1474 else invalid_constant ("bad status symbol", status); | |
| 1475 | |
| 1476 R = PQmakeEmptyPGresult (P, est); | |
| 1477 if (!R) out_of_memory (0, Qunbound); | |
| 1478 | |
| 1479 lpgr = allocate_pgresult (); | |
| 1480 lpgr->pgresult = R; | |
| 1481 | |
| 1482 return make_pgresult (lpgr); | |
| 1483 } | |
| 1484 | |
| 1485 DEFUN ("pq-get-line", Fpq_get_line, 1, 1, 0, /* | |
| 1486 Retrieve a line from server in copy in operation. | |
| 1487 The return value is a dotted pair where the cons cell is an integer code: | |
| 1488 -1: Copying is complete | |
| 1489 0: A record is complete | |
| 1490 1: A record is incomplete, it will be continued in the next `pq-get-line' | |
| 1491 operation. | |
| 1492 and the cdr cell is returned string data. | |
| 1493 | |
| 1494 The copy operation is complete when the value `\.' (backslash dot) is | |
| 1495 returned. | |
| 1496 */ | |
| 1497 (conn)) | |
| 1498 { | |
| 1499 char buffer[BLCKSZ]; /* size of a Postgres disk block */ | |
| 1500 PGconn *P; | |
| 1501 int ret; | |
| 1502 | |
| 1503 CHECK_PGCONN (conn); | |
| 1504 P = (XPGCONN (conn))->pgconn; | |
| 1505 CHECK_LIVE_CONNECTION (P); | |
| 1506 | |
| 1507 ret = PQgetline (P, buffer, sizeof (buffer)); | |
| 1508 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1509 return Fcons (make_int (ret), build_extstring (buffer, PG_OS_CODING)); |
| 996 | 1510 } |
| 1511 | |
| 1512 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /* | |
| 1513 Send a line to the server in copy out operation. | |
| 1514 | |
| 1515 Returns t if the operation succeeded, nil otherwise. | |
| 1516 */ | |
| 1517 (conn, string)) | |
| 1518 { | |
| 1519 PGconn *P; | |
| 1520 char *c_string; | |
| 1521 | |
| 1522 CHECK_PGCONN (conn); | |
| 1523 CHECK_STRING (string); | |
| 1524 | |
| 1525 P = (XPGCONN (conn))->pgconn; | |
| 1526 CHECK_LIVE_CONNECTION (P); | |
| 1527 TO_EXTERNAL_FORMAT (LISP_STRING, string, | |
| 1528 C_STRING_ALLOCA, c_string, Qnative); | |
| 1529 | |
| 1530 return !PQputline (P, c_string) ? Qt : Qnil; | |
| 1531 } | |
| 1532 | |
| 1533 DEFUN ("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /* | |
| 1534 Get a line from the server in copy in operation asynchronously. | |
| 1535 | |
| 1536 This routine is for applications that want to do "COPY <rel> to stdout" | |
| 1537 asynchronously, that is without blocking. Having issued the COPY command | |
| 1538 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput | |
| 1539 and this routine until the end-of-data signal is detected. Unlike | |
| 1540 PQgetline, this routine takes responsibility for detecting end-of-data. | |
| 1541 | |
| 1542 On each call, PQgetlineAsync will return data if a complete newline- | |
| 1543 terminated data line is available in libpq's input buffer, or if the | |
| 1544 incoming data line is too long to fit in the buffer offered by the caller. | |
| 1545 Otherwise, no data is returned until the rest of the line arrives. | |
| 1546 | |
| 1547 If -1 is returned, the end-of-data signal has been recognized (and removed | |
| 1548 from libpq's input buffer). The caller *must* next call PQendcopy and | |
| 1549 then return to normal processing. | |
| 1550 | |
| 1551 RETURNS: | |
| 1552 -1 if the end-of-copy-data marker has been recognized | |
| 1553 0 if no data is available | |
| 1554 >0 the number of bytes returned. | |
| 1555 The data returned will not extend beyond a newline character. If possible | |
| 1556 a whole line will be returned at one time. But if the buffer offered by | |
| 1557 the caller is too small to hold a line sent by the backend, then a partial | |
| 1558 data line will be returned. This can be detected by testing whether the | |
| 1559 last returned byte is '\n' or not. | |
| 1560 The returned string is *not* null-terminated. | |
| 1561 */ | |
| 1562 (conn)) | |
| 1563 { | |
| 1564 PGconn *P; | |
| 1565 char buffer[BLCKSZ]; | |
| 1566 int ret; | |
| 1567 | |
| 1568 CHECK_PGCONN (conn); | |
| 1569 | |
| 1570 P = (XPGCONN (conn))->pgconn; | |
| 1571 CHECK_LIVE_CONNECTION (P); | |
| 1572 | |
| 1573 ret = PQgetlineAsync (P, buffer, sizeof (buffer)); | |
| 1574 | |
| 1575 if (ret == -1) return Qt; /* done! */ | |
| 1576 else if (!ret) return Qnil; /* no data yet */ | |
| 1577 else return Fcons (make_int (ret), | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1578 make_extstring ((Extbyte *) buffer, ret, PG_OS_CODING)); |
| 996 | 1579 } |
| 1580 | |
| 1581 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /* | |
| 1582 Asynchronous copy out. | |
| 1583 */ | |
| 1584 (conn, data)) | |
| 1585 { | |
| 1586 /* NULs are not allowed. I don't think this matters at this time. */ | |
| 1587 PGconn *P; | |
| 1588 char *c_data; | |
| 1589 | |
| 1590 CHECK_PGCONN (conn); | |
| 1591 CHECK_STRING (data); | |
| 1592 | |
| 1593 P = (XPGCONN (conn))->pgconn; | |
| 1594 CHECK_LIVE_CONNECTION (P); | |
| 1595 TO_EXTERNAL_FORMAT (LISP_STRING, data, | |
| 1596 C_STRING_ALLOCA, c_data, Qnative); | |
| 1597 | |
| 1598 return !PQputnbytes (P, c_data, strlen (c_data)) ? Qt : Qnil; | |
| 1599 } | |
| 1600 | |
| 1601 DEFUN ("pq-end-copy", Fpq_end_copy, 1, 1, 0, /* | |
| 1602 End a copying operation. | |
| 1603 */ | |
| 1604 (conn)) | |
| 1605 { | |
| 1606 PGconn *P; | |
| 1607 | |
| 1608 CHECK_PGCONN (conn); | |
| 1609 P = (XPGCONN (conn))->pgconn; | |
| 1610 CHECK_LIVE_CONNECTION (P); | |
| 1611 | |
| 1612 return PQendcopy (P) ? Qt : Qnil; | |
| 1613 } | |
| 1614 | |
| 1615 void | |
| 1616 syms_of_postgresql(void) | |
| 1617 { | |
| 1618 #ifndef RUNNING_XEMACS_21_1 | |
| 1619 INIT_LRECORD_IMPLEMENTATION (pgconn); | |
| 1620 INIT_LRECORD_IMPLEMENTATION (pgresult); | |
| 1621 #endif | |
| 1622 DEFSYMBOL (Qpostgresql); | |
| 1623 | |
| 1624 /* opaque exported types */ | |
| 1625 DEFSYMBOL (Qpgconnp); | |
| 1626 DEFSYMBOL (Qpgresultp); | |
| 1627 | |
| 1628 /* connection status types */ | |
| 1629 defsymbol (&Qpg_connection_ok, "pg::connection-ok"); | |
| 1630 defsymbol (&Qpg_connection_bad, "pg::connection-bad"); | |
| 1631 defsymbol (&Qpg_connection_started, "pg::connection-started"); | |
| 1632 defsymbol (&Qpg_connection_made, "pg::connection-made"); | |
| 1633 defsymbol (&Qpg_connection_awaiting_response, "pg::connection-awaiting-response"); | |
| 1634 defsymbol (&Qpg_connection_auth_ok, "pg::connection-auth-ok"); | |
| 1635 defsymbol (&Qpg_connection_setenv, "pg::connection-setenv"); | |
| 1636 | |
| 1637 /* Fields of PGconn */ | |
| 1638 defsymbol (&Qpqdb, "pq::db"); | |
| 1639 defsymbol (&Qpquser, "pq::user"); | |
| 1640 defsymbol (&Qpqpass, "pq::pass"); | |
| 1641 defsymbol (&Qpqhost, "pq::host"); | |
| 1642 defsymbol (&Qpqport, "pq::port"); | |
| 1643 defsymbol (&Qpqtty, "pq::tty"); | |
| 1644 defsymbol (&Qpqoptions, "pq::options"); | |
| 1645 defsymbol (&Qpqstatus, "pq::status"); | |
| 1646 defsymbol (&Qpqerrormessage, "pq::error-message"); | |
| 1647 defsymbol (&Qpqbackendpid, "pq::backend-pid"); | |
| 1648 | |
| 1649 /* Query status results */ | |
| 1650 defsymbol (&Qpgres_empty_query, "pgres::empty-query"); | |
| 1651 defsymbol (&Qpgres_command_ok, "pgres::command-ok"); | |
| 1652 defsymbol (&Qpgres_tuples_ok, "pgres::tuples-ok"); | |
| 1653 defsymbol (&Qpgres_copy_out, "pgres::copy-out"); | |
| 1654 defsymbol (&Qpgres_copy_in, "pgres::copy-in"); | |
| 1655 defsymbol (&Qpgres_bad_response, "pgres::bad-response"); | |
| 1656 defsymbol (&Qpgres_nonfatal_error, "pgres::nonfatal-error"); | |
| 1657 defsymbol (&Qpgres_fatal_error, "pgres::fatal-error"); | |
| 1658 | |
| 1659 /* Poll status results */ | |
| 1660 defsymbol (&Qpgres_polling_failed, "pgres::polling-failed"); | |
| 1661 defsymbol (&Qpgres_polling_reading, "pgres::polling-reading"); | |
| 1662 defsymbol (&Qpgres_polling_writing, "pgres::polling-writing"); | |
| 1663 defsymbol (&Qpgres_polling_ok, "pgres::polling-ok"); | |
| 1664 defsymbol (&Qpgres_polling_active, "pgres::polling-active"); | |
| 1665 | |
| 1666 #ifdef HAVE_POSTGRESQLV7 | |
| 1667 DEFSUBR (Fpq_connect_start); | |
| 1668 DEFSUBR (Fpq_connect_poll); | |
| 1669 #ifdef MULE | |
| 1670 DEFSUBR (Fpq_client_encoding); | |
| 1671 DEFSUBR (Fpq_set_client_encoding); | |
| 1672 #endif /* MULE */ | |
| 1673 #endif /* HAVE_POSTGRESQLV7 */ | |
| 1674 DEFSUBR (Fpq_conn_defaults); | |
| 1675 DEFSUBR (Fpq_connectdb); | |
| 1676 DEFSUBR (Fpq_finish); | |
| 1677 DEFSUBR (Fpq_clear); | |
| 1678 DEFSUBR (Fpq_is_busy); | |
| 1679 DEFSUBR (Fpq_consume_input); | |
| 1680 | |
| 1681 DEFSUBR (Fpq_reset); | |
| 1682 #ifdef HAVE_POSTGRESQLV7 | |
| 1683 DEFSUBR (Fpq_reset_start); | |
| 1684 DEFSUBR (Fpq_reset_poll); | |
| 1685 #endif | |
| 1686 DEFSUBR (Fpq_request_cancel); | |
| 1687 DEFSUBR (Fpq_pgconn); | |
| 1688 | |
| 1689 DEFSUBR (Fpq_exec); | |
| 1690 DEFSUBR (Fpq_send_query); | |
| 1691 DEFSUBR (Fpq_get_result); | |
| 1692 DEFSUBR (Fpq_result_status); | |
| 1693 DEFSUBR (Fpq_res_status); | |
| 1694 DEFSUBR (Fpq_result_error_message); | |
| 1695 DEFSUBR (Fpq_ntuples); | |
| 1696 DEFSUBR (Fpq_nfields); | |
| 1697 DEFSUBR (Fpq_binary_tuples); | |
| 1698 DEFSUBR (Fpq_fname); | |
| 1699 DEFSUBR (Fpq_fnumber); | |
| 1700 DEFSUBR (Fpq_ftype); | |
| 1701 DEFSUBR (Fpq_fsize); | |
| 1702 DEFSUBR (Fpq_fmod); | |
| 1703 /***/ | |
| 1704 DEFSUBR (Fpq_get_value); | |
| 1705 DEFSUBR (Fpq_get_length); | |
| 1706 DEFSUBR (Fpq_get_is_null); | |
| 1707 DEFSUBR (Fpq_cmd_status); | |
| 1708 DEFSUBR (Fpq_cmd_tuples); | |
| 1709 DEFSUBR (Fpq_oid_value); | |
| 1710 | |
| 1711 #ifdef HAVE_POSTGRESQLV7 | |
| 1712 DEFSUBR (Fpq_set_nonblocking); | |
| 1713 DEFSUBR (Fpq_is_nonblocking); | |
| 1714 DEFSUBR (Fpq_flush); | |
| 1715 #endif | |
| 1716 DEFSUBR (Fpq_notifies); | |
| 1717 | |
| 1718 #if defined (HAVE_POSTGRESQLV7) && defined(MULE) | |
| 1719 DEFSUBR (Fpq_env_2_encoding); | |
| 1720 #endif | |
| 1721 | |
| 1722 DEFSUBR (Fpq_lo_import); | |
| 1723 DEFSUBR (Fpq_lo_export); | |
| 1724 | |
| 1725 DEFSUBR (Fpq_make_empty_pgresult); | |
| 1726 | |
| 1727 /* copy in/out functions */ | |
| 1728 DEFSUBR (Fpq_get_line); | |
| 1729 DEFSUBR (Fpq_put_line); | |
| 1730 DEFSUBR (Fpq_get_line_async); | |
| 1731 DEFSUBR (Fpq_put_nbytes); | |
| 1732 DEFSUBR (Fpq_end_copy); | |
| 1733 } | |
| 1734 | |
| 1735 void | |
| 1736 vars_of_postgresql(void) | |
| 1737 { | |
| 1738 Fprovide (Qpostgresql); | |
| 1739 #ifdef HAVE_POSTGRESQLV7 | |
| 1740 Fprovide (intern ("postgresqlv7")); | |
| 1741 #endif | |
| 1742 #ifndef RUNNING_XEMACS_21_1 | |
| 1743 Vpg_coding_system = Qnative; | |
| 1744 DEFVAR_LISP ("pg-coding-system", &Vpg_coding_system /* | |
| 1745 Default Postgres client coding system. | |
| 1746 */ ); | |
| 1747 #endif | |
| 1748 | |
| 1749 DEFVAR_LISP ("pg:host", &VXPGHOST /* | |
| 1750 Default PostgreSQL server name. | |
| 1751 If not set, the server running on the local host is used. The | |
| 1752 initial value is set from the PGHOST environment variable. | |
| 1753 */ ); | |
| 1754 | |
| 1755 DEFVAR_LISP ("pg:user", &VXPGUSER /* | |
| 1756 Default PostgreSQL user name. | |
| 1757 This value is used when connecting to a database for authentication. | |
| 1758 The initial value is set from the PGUSER environment variable. | |
| 1759 */ ); | |
| 1760 | |
| 1761 DEFVAR_LISP ("pg:options", &VXPGOPTIONS /* | |
| 1762 Default PostgreSQL user name. | |
| 1763 This value is used when connecting to a database for authentication. | |
| 1764 The initial value is set from the PGUSER environment variable. | |
| 1765 */ ); | |
| 1766 | |
| 1767 DEFVAR_LISP ("pg:port", &VXPGPORT /* | |
| 1768 Default port to connect to PostgreSQL backend. | |
| 1769 This value is used when connecting to a database. | |
| 1770 The initial value is set from the PGPORT environment variable. | |
| 1771 */ ); | |
| 1772 | |
| 1773 DEFVAR_LISP ("pg:tty", &VXPGTTY /* | |
| 1774 Default debugging TTY. | |
| 1775 There is no useful setting of this variable in the XEmacs Lisp API. | |
| 1776 The initial value is set from the PGTTY environment variable. | |
| 1777 */ ); | |
| 1778 | |
| 1779 DEFVAR_LISP ("pg:database", &VXPGDATABASE /* | |
| 1780 Default database to connect to. | |
| 1781 The initial value is set from the PGDATABASE environment variable. | |
| 1782 */ ); | |
| 1783 | |
| 1784 DEFVAR_LISP ("pg:realm", &VXPGREALM /* | |
| 1785 Default kerberos realm to use for authentication. | |
| 1786 The initial value is set from the PGREALM environment variable. | |
| 1787 */ ); | |
| 1788 | |
| 1789 #ifdef MULE | |
| 1790 /* It's not clear whether this is any use. My intent is to | |
| 1791 autodetect the coding system from the database. */ | |
| 1792 DEFVAR_LISP ("pg:client-encoding", &VXPGCLIENTENCODING /* | |
| 1793 Default client encoding to use. | |
| 1794 The initial value is set from the PGCLIENTENCODING environment variable. | |
| 1795 */ ); | |
| 1796 #endif | |
| 1797 | |
| 1798 #if !defined(HAVE_POSTGRESQLV7) | |
| 1799 DEFVAR_LISP ("pg:authtype", &VXPGAUTHTYPE /* | |
| 1800 Default authentication to use. | |
| 1801 The initial value is set from the PGAUTHTYPE environment variable. | |
| 1802 | |
| 1803 WARNING: This variable has gone away in versions of PostgreSQL newer | |
| 1804 than 6.5. | |
| 1805 */ ); | |
| 1806 #endif | |
| 1807 | |
| 1808 DEFVAR_LISP ("pg:geqo", &VXPGGEQO /* | |
| 1809 Genetic Query Optimizer options. | |
| 1810 The initial value is set from the PGGEQO environment variable. | |
| 1811 */ ); | |
| 1812 | |
| 1813 DEFVAR_LISP ("pg:cost-index", &VXPGCOSTINDEX /* | |
| 1814 Default cost index options. | |
| 1815 The initial value is set from the PGCOSTINDEX environment variable. | |
| 1816 */ ); | |
| 1817 | |
| 1818 DEFVAR_LISP ("pg:cost-heap", &VXPGCOSTHEAP /* | |
| 1819 Default cost heap options. | |
| 1820 The initial value is set from the PGCOSTHEAP environment variable. | |
| 1821 */ ); | |
| 1822 | |
| 1823 DEFVAR_LISP ("pg:tz", &VXPGTZ /* | |
| 1824 Default timezone to use. | |
| 1825 The initial value is set from the PGTZ environment variable. | |
| 1826 */ ); | |
| 1827 | |
| 1828 DEFVAR_LISP ("pg:date-style", &VXPGDATESTYLE /* | |
| 1829 Default date style to use. | |
| 1830 The initial value is set from the PGDATESTYLE environment variable. | |
| 1831 */ ); | |
| 1832 | |
| 1833 #ifdef HAVE_SHLIB | |
| 1834 /* If we are building this as a module, we need the initializing function to | |
| 1835 run at module load time. */ | |
| 1836 init_postgresql_from_environment (); | |
| 1837 #endif | |
| 1838 } | |
| 1839 | |
| 1840 /* These initializations should not be done at dump-time. */ | |
| 1841 void | |
| 1842 init_postgresql_from_environment (void) | |
| 1843 { | |
| 1844 Ibyte *p; | |
| 1845 | |
| 1846 #define FROB(envvar, var) \ | |
| 1847 if ((p = egetenv (envvar))) \ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1848 var = build_istring (p); \ |
| 996 | 1849 else \ |
| 1850 var = Qnil | |
| 1851 | |
| 1852 if (initialized) | |
| 1853 { | |
| 1854 FROB ("PGHOST", VXPGHOST); | |
| 1855 FROB ("PGUSER", VXPGUSER); | |
| 1856 FROB ("PGOPTIONS", VXPGOPTIONS); | |
| 1857 | |
| 1858 if ((p = egetenv ("PGPORT"))) | |
| 1859 VXPGPORT = make_int (atoi ((char *) p)); | |
| 1860 else | |
| 1861 VXPGPORT = Qnil; | |
| 1862 | |
| 1863 FROB ("PGTTY", VXPGTTY); | |
| 1864 FROB ("PGDATABASE", VXPGDATABASE); | |
| 1865 FROB ("PGREALM", VXPGREALM); | |
| 1866 #ifdef MULE | |
| 1867 /* It's not clear whether this is any use. My intent is to | |
| 1868 autodetect the coding system from the database. */ | |
| 1869 FROB ("PGCLIENTENCODING", VXPGCLIENTENCODING); | |
| 1870 #endif | |
| 1871 | |
| 1872 #if !defined(HAVE_POSTGRESQLV7) | |
| 1873 FROB ("PGAUTHTYPE", VXPGAUTHTYPE); | |
| 1874 #endif | |
| 1875 | |
| 1876 FROB ("PGGEQO", VXPGGEQO); | |
| 1877 FROB ("PGCOSTINDEX", VXPGCOSTINDEX); | |
| 1878 FROB ("PGCOSTHEAP", VXPGCOSTHEAP); | |
| 1879 FROB ("PGTZ", VXPGTZ); | |
| 1880 FROB ("PGDATESTYLE", VXPGDATESTYLE); | |
| 1881 #undef FROB | |
| 1882 } | |
| 1883 } | |
| 1884 | |
| 1885 #ifdef HAVE_SHLIB | |
| 1706 | 1886 EXTERN_C void unload_postgresql (void); |
| 996 | 1887 void |
| 1888 unload_postgresql (void) | |
| 1889 { | |
| 1890 #ifndef RUNNING_XEMACS_21_1 | |
| 1891 /* Remove defined types */ | |
| 1892 UNDEF_LRECORD_IMPLEMENTATION (pgconn); | |
| 1893 UNDEF_LRECORD_IMPLEMENTATION (pgresult); | |
| 1894 #endif | |
| 1895 | |
| 1896 /* Remove staticpro'ing of symbols */ | |
| 1897 unstaticpro_nodump (&Qpostgresql); | |
| 1898 unstaticpro_nodump (&Qpgconnp); | |
| 1899 unstaticpro_nodump (&Qpgresultp); | |
| 1900 unstaticpro_nodump (&Qpg_connection_ok); | |
| 1901 unstaticpro_nodump (&Qpg_connection_bad); | |
| 1902 unstaticpro_nodump (&Qpg_connection_started); | |
| 1903 unstaticpro_nodump (&Qpg_connection_made); | |
| 1904 unstaticpro_nodump (&Qpg_connection_awaiting_response); | |
| 1905 unstaticpro_nodump (&Qpg_connection_auth_ok); | |
| 1906 unstaticpro_nodump (&Qpg_connection_setenv); | |
| 1907 unstaticpro_nodump (&Qpqdb); | |
| 1908 unstaticpro_nodump (&Qpquser); | |
| 1909 unstaticpro_nodump (&Qpqpass); | |
| 1910 unstaticpro_nodump (&Qpqhost); | |
| 1911 unstaticpro_nodump (&Qpqport); | |
| 1912 unstaticpro_nodump (&Qpqtty); | |
| 1913 unstaticpro_nodump (&Qpqoptions); | |
| 1914 unstaticpro_nodump (&Qpqstatus); | |
| 1915 unstaticpro_nodump (&Qpqerrormessage); | |
| 1916 unstaticpro_nodump (&Qpqbackendpid); | |
| 1917 unstaticpro_nodump (&Qpgres_empty_query); | |
| 1918 unstaticpro_nodump (&Qpgres_command_ok); | |
| 1919 unstaticpro_nodump (&Qpgres_tuples_ok); | |
| 1920 unstaticpro_nodump (&Qpgres_copy_out); | |
| 1921 unstaticpro_nodump (&Qpgres_copy_in); | |
| 1922 unstaticpro_nodump (&Qpgres_bad_response); | |
| 1923 unstaticpro_nodump (&Qpgres_nonfatal_error); | |
| 1924 unstaticpro_nodump (&Qpgres_fatal_error); | |
| 1925 unstaticpro_nodump (&Qpgres_polling_failed); | |
| 1926 unstaticpro_nodump (&Qpgres_polling_reading); | |
| 1927 unstaticpro_nodump (&Qpgres_polling_writing); | |
| 1928 unstaticpro_nodump (&Qpgres_polling_ok); | |
| 1929 unstaticpro_nodump (&Qpgres_polling_active); | |
| 1930 } | |
| 1931 #endif /* HAVE_SHLIB */ |