Mercurial > hg > xemacs-beta
annotate modules/postgresql/postgresql.c @ 4981:4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_lo_import):
* postgresql/postgresql.c (Fpq_lo_export):
* ldap/eldap.c (Fldap_open):
* ldap/eldap.c (Fldap_search_basic):
* ldap/eldap.c (Fldap_add):
* ldap/eldap.c (Fldap_modify):
* ldap/eldap.c (Fldap_delete):
* canna/canna_api.c (Fcanna_initialize):
* canna/canna_api.c (Fcanna_store_yomi):
* canna/canna_api.c (Fcanna_parse):
* canna/canna_api.c (Fcanna_henkan_begin):
EXTERNAL_TO_C_STRING returns its argument instead of storing it
in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar
things happen to related macros. See entry in src/ChangeLog.
More Mule-izing of postgresql.c. Extract out common code
between `pq-connectdb' and `pq-connect-start'. Fix places
that signal an error string using a formatted string to instead
follow the standard and have a fixed reason followed by the
particular error message stored as one of the frobs.
src/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* console-msw.c (write_string_to_mswindows_debugging_output):
* console-msw.c (Fmswindows_message_box):
* console-x.c (x_perhaps_init_unseen_key_defaults):
* console.c:
* database.c (dbm_get):
* database.c (dbm_put):
* database.c (dbm_remove):
* database.c (berkdb_get):
* database.c (berkdb_put):
* database.c (berkdb_remove):
* database.c (Fopen_database):
* device-gtk.c (gtk_init_device):
* device-msw.c (msprinter_init_device_internal):
* device-msw.c (msprinter_default_printer):
* device-msw.c (msprinter_init_device):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (Fmsprinter_select_settings):
* device-x.c (sanity_check_geometry_resource):
* device-x.c (Dynarr_add_validified_lisp_string):
* device-x.c (x_init_device):
* device-x.c (Fx_put_resource):
* device-x.c (Fx_valid_keysym_name_p):
* device-x.c (Fx_set_font_path):
* dialog-msw.c (push_lisp_string_as_unicode):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* editfns.c (Fformat_time_string):
* editfns.c (Fencode_time):
* editfns.c (Fset_time_zone_rule):
* emacs.c (make_argc_argv):
* emacs.c (Fdump_emacs):
* emodules.c (emodules_load):
* eval.c:
* eval.c (maybe_signal_error_1):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* fileio.c (report_error_with_errno):
* fileio.c (Fsysnetunam):
* fileio.c (Fdo_auto_save):
* font-mgr.c (extract_fcapi_string):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_filename):
* frame-gtk.c (gtk_set_frame_text_value):
* frame-gtk.c (gtk_create_widgets):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_title_from_ibyte):
* frame-msw.c (msprinter_init_frame_3):
* frame-x.c (x_set_frame_text_value):
* frame-x.c (x_set_frame_properties):
* frame-x.c (start_drag_internal_1):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_create_widgets):
* glyphs-eimage.c (my_jpeg_output_message):
* glyphs-eimage.c (jpeg_instantiate):
* glyphs-eimage.c (gif_instantiate):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (xbm_instantiate_1):
* glyphs-gtk.c (gtk_xbm_instantiate):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-gtk.c (gtk_xface_instantiate):
* glyphs-gtk.c (cursor_font_instantiate):
* glyphs-gtk.c (gtk_redisplay_widget):
* glyphs-gtk.c (gtk_widget_instantiate_1):
* glyphs-gtk.c (gtk_add_tab_item):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (bmp_instantiate):
* glyphs-msw.c (mswindows_resource_instantiate):
* glyphs-msw.c (xbm_instantiate_1):
* glyphs-msw.c (mswindows_xbm_instantiate):
* glyphs-msw.c (mswindows_xface_instantiate):
* glyphs-msw.c (mswindows_redisplay_widget):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs-msw.c (add_tree_item):
* glyphs-msw.c (add_tab_item):
* glyphs-msw.c (mswindows_combo_box_instantiate):
* glyphs-msw.c (mswindows_widget_query_string_geometry):
* glyphs-x.c (x_locate_pixmap_file):
* glyphs-x.c (xbm_instantiate_1):
* glyphs-x.c (x_xbm_instantiate):
* glyphs-x.c (extract_xpm_color_names):
* glyphs-x.c (x_xpm_instantiate):
* glyphs-x.c (x_xface_instantiate):
* glyphs-x.c (autodetect_instantiate):
* glyphs-x.c (safe_XLoadFont):
* glyphs-x.c (cursor_font_instantiate):
* glyphs-x.c (x_redisplay_widget):
* glyphs-x.c (Fchange_subwindow_property):
* glyphs-x.c (x_widget_instantiate):
* glyphs-x.c (x_tab_control_redisplay):
* glyphs.c (pixmap_to_lisp_data):
* gui-x.c (menu_separator_style_and_to_external):
* gui-x.c (add_accel_and_to_external):
* gui-x.c (button_item_to_widget_value):
* hpplay.c (player_error_internal):
* hpplay.c (play_sound_file):
* hpplay.c (play_sound_data):
* intl.c (Fset_current_locale):
* lisp.h:
* menubar-gtk.c (gtk_xemacs_set_accel_keys):
* menubar-msw.c (populate_menu_add_item):
* menubar-msw.c (populate_or_checksum_helper):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c (init_user_info):
* nt.c (get_long_basename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_readdir):
* nt.c (read_unc_volume):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (mswindows_executable_type):
* nt.c (Fmswindows_short_file_name):
* ntplay.c (nt_play_sound_file):
* objects-gtk.c:
* objects-gtk.c (gtk_valid_color_name_p):
* objects-gtk.c (gtk_initialize_font_instance):
* objects-gtk.c (gtk_font_list):
* objects-msw.c (font_enum_callback_2):
* objects-msw.c (parse_font_spec):
* objects-x.c (x_parse_nearest_color):
* objects-x.c (x_valid_color_name_p):
* objects-x.c (x_initialize_font_instance):
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_font_list):
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_create_process):
* process-nt.c (get_internet_address):
* process-nt.c (nt_open_network_stream):
* process-unix.c:
* process-unix.c (allocate_pty):
* process-unix.c (get_internet_address):
* process-unix.c (unix_canonicalize_host_name):
* process-unix.c (unix_open_network_stream):
* realpath.c:
* select-common.h (lisp_data_to_selection_data):
* select-gtk.c (symbol_to_gtk_atom):
* select-gtk.c (atom_to_symbol):
* select-msw.c (symbol_to_ms_cf):
* select-msw.c (mswindows_register_selection_data_type):
* select-x.c (symbol_to_x_atom):
* select-x.c (x_atom_to_symbol):
* select-x.c (hack_motif_clipboard_selection):
* select-x.c (Fx_store_cutbuffer_internal):
* sound.c (Fplay_sound_file):
* sound.c (Fplay_sound):
* sound.h (sound_perror):
* sysdep.c:
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_execve):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_getpwnam):
* sysdep.c (qxe_ctime):
* sysdll.c (dll_open):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (search_linked_libs):
* sysdll.c (dll_error):
* sysfile.h:
* sysfile.h (PATHNAME_CONVERT_OUT_TSTR):
* sysfile.h (PATHNAME_CONVERT_OUT_UTF_8):
* sysfile.h (PATHNAME_CONVERT_OUT):
* sysfile.h (LISP_PATHNAME_CONVERT_OUT):
* syswindows.h (ITEXT_TO_TSTR):
* syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR):
* syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT):
* syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN):
* syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR):
* text.h:
* text.h (eicpy_ext_len):
* text.h (enum new_dfc_src_type):
* text.h (EXTERNAL_TO_ITEXT):
* text.h (GET_STRERROR):
* tooltalk.c (check_status):
* tooltalk.c (Fadd_tooltalk_message_arg):
* tooltalk.c (Fadd_tooltalk_pattern_attribute):
* tooltalk.c (Fadd_tooltalk_pattern_arg):
* win32.c (tstr_to_local_file_format):
* win32.c (mswindows_lisp_error_1):
* win32.c (mswindows_report_process_error):
* win32.c (Fmswindows_shell_execute):
* win32.c (mswindows_read_link_1):
Changes involving external/internal format conversion,
mostly code cleanup and renaming.
1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL
that stored its result in a parameter. The new version of
LISP_STRING_TO_EXTERNAL returns its result through the
return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL.
Use the new-style macros throughout the code.
2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL,
in keeping with overall naming rationalization involving
Itext and related types.
Macros involved in previous two:
EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT
EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC
SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT
SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC
C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL
C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC
LISP_STRING_TO_EXTERNAL
LISP_STRING_TO_EXTERNAL_MALLOC
LISP_STRING_TO_TSTR
C_STRING_TO_TSTR -> ITEXT_TO_TSTR
TSTR_TO_C_STRING -> TSTR_TO_ITEXT
The following four still return their values through parameters,
since they have more than one value to return:
C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL
LISP_STRING_TO_SIZED_EXTERNAL
C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC
LISP_STRING_TO_SIZED_EXTERNAL_MALLOC
Sometimes additional casts had to be inserted, since the old
macros played strange games and completely defeated the type system
of the store params.
3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT
occurred with calls to one of the convenience macros listed above,
or to make_extstring().
4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway)
and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT.
4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something
like LISP_STRING_TO_EXTERNAL(..., Qfile_name).
5. Eliminate some temporary variables that are no longer necessary
now that we return a value rather than storing it into a variable.
6. Some Mule-izing in database.c.
7. Error functions:
-- A bit of code cleanup in maybe_signal_error_1.
-- Eliminate report_file_type_error; it's just an alias for
signal_error_2 with params in a different order.
-- Fix some places in the hostname-handling code that directly
inserted externally-retrieved error strings into the
supposed ASCII "reason" param instead of doing the right thing
and sticking text descriptive of what was going on in "reason"
and putting the external message in a frob.
8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one
or two other places.
9. Some code cleanup in copy_in_passwd() in sysdep.c.
10. Fix a real bug due to accidental variable shadowing in
tstr_to_local_file_format() in win32.c.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Fri, 05 Feb 2010 11:02:24 -0600 |
parents | 304aebb79cd3 |
children | b5df3737028a |
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 | |
101 #include "buffer.h" | |
102 #include "postgresql.h" | |
103 #include "process.h" | |
1632 | 104 #ifdef HAVE_SHLIB |
105 # include "emodules.h" | |
106 #endif | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
107 #include "sysdep.h" |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
108 #include "sysfile.h" |
996 | 109 |
110 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */ | |
111 #define PG_OS_CODING FORMAT_FILENAME | |
112 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to) | |
113 #else | |
114 #ifdef MULE | |
115 #define PG_OS_CODING get_coding_system_for_text_file (Vpg_coding_system, 1) | |
116 #else | |
117 #define PG_OS_CODING Qnative | |
118 #endif | |
119 Lisp_Object Vpg_coding_system; | |
120 #endif | |
121 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
122 #define CHECK_LIVE_CONNECTION(P) \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
123 do \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
124 { \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
125 if (!P || (PQstatus (P) != CONNECTION_OK)) \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
126 { \ |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
127 Lisp_Object err; \ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
128 \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
129 if (P) \ |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
130 err = build_extstring (PQerrorMessage (P), PG_OS_CODING); \ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
131 else \ |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
132 err = build_msg_string ("Bad value"); \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
133 signal_error (Qprocess_error, "Dead connection", err); \ |
4952
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 } \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
136 while (0) |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
137 |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
138 #define PUKE_IF_NULL(p) \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
139 do \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
140 { \ |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
141 if (!p) signal_error (Qinvalid_argument, "Bad value", Qunbound); \ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
142 } \ |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
143 while (0) |
996 | 144 |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
145 #define SIGNAL_ERROR(p, reason) \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
146 do \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
147 { \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
148 signal_error (Qprocess_error, reason, \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
149 build_extstring (PQerrorMessage (p), PG_OS_CODING)); \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
150 } \ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
151 while (0) |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
152 |
996 | 153 static Lisp_Object VXPGHOST; |
154 static Lisp_Object VXPGUSER; | |
155 static Lisp_Object VXPGOPTIONS; | |
156 static Lisp_Object VXPGPORT; | |
157 static Lisp_Object VXPGTTY; /* This needs to be blanked! */ | |
158 static Lisp_Object VXPGDATABASE; | |
159 static Lisp_Object VXPGREALM; | |
160 #ifdef MULE | |
161 static Lisp_Object VXPGCLIENTENCODING; | |
162 #endif /* MULE */ | |
163 | |
164 /* Other variables: | |
165 PGAUTHTYPE -- not used after PostgreSQL 6.5 | |
166 PGGEQO | |
167 PGCOSTINDEX | |
168 PGCOSTHEAP | |
169 PGTZ | |
170 PGDATESTYLE | |
171 */ | |
172 #ifndef HAVE_POSTGRESQLV7 | |
173 static Lisp_Object VXPGAUTHTYPE; | |
174 #endif | |
175 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE; | |
176 | |
177 static Lisp_Object Qpostgresql; | |
178 static Lisp_Object Qpg_connection_ok, Qpg_connection_bad; | |
179 static Lisp_Object Qpg_connection_started, Qpg_connection_made; | |
180 static Lisp_Object Qpg_connection_awaiting_response, Qpg_connection_auth_ok; | |
181 static Lisp_Object Qpg_connection_setenv; | |
182 | |
183 static Lisp_Object Qpqdb, Qpquser, Qpqpass, Qpqhost, Qpqport, Qpqtty; | |
184 static Lisp_Object Qpqoptions, Qpqstatus, Qpqerrormessage, Qpqbackendpid; | |
185 | |
186 static Lisp_Object Qpgres_empty_query, Qpgres_command_ok, Qpgres_tuples_ok; | |
187 static Lisp_Object Qpgres_copy_out, Qpgres_copy_in, Qpgres_bad_response; | |
188 static Lisp_Object Qpgres_nonfatal_error, Qpgres_fatal_error; | |
189 | |
190 static Lisp_Object Qpgres_polling_failed, Qpgres_polling_reading; | |
191 static Lisp_Object Qpgres_polling_writing, Qpgres_polling_ok; | |
192 static Lisp_Object Qpgres_polling_active; | |
193 /****/ | |
194 | |
195 /* PGconn is an opaque object and we need to be able to store them in | |
196 Lisp code because libpq supports multiple connections. | |
197 */ | |
198 Lisp_Object Qpgconnp; | |
199 | |
200 static Lisp_Object | |
201 make_pgconn (Lisp_PGconn *pgconn) | |
202 { | |
203 return wrap_pgconn (pgconn); | |
204 } | |
205 | |
1204 | 206 static const struct memory_description pgconn_description [] = { |
996 | 207 { XD_END } |
208 }; | |
209 | |
210 static Lisp_Object | |
211 #ifdef RUNNING_XEMACS_21_1 | |
2286 | 212 mark_pgconn (Lisp_Object UNUSED (obj), |
213 void (*UNUSED_ARG (markobj)) (Lisp_Object) ATTRIBUTE_UNUSED) | |
996 | 214 #else |
2286 | 215 mark_pgconn (Lisp_Object UNUSED (obj)) |
996 | 216 #endif |
217 { | |
218 return Qnil; | |
219 } | |
220 | |
221 static void | |
2286 | 222 print_pgconn (Lisp_Object obj, Lisp_Object printcharfun, |
223 int UNUSED (escapeflag)) | |
996 | 224 { |
225 char buf[256]; | |
226 PGconn *P; | |
227 ConnStatusType cst; | |
4932 | 228 const char *host="", *db="", *user="", *port=""; |
996 | 229 |
230 P = (XPGCONN (obj))->pgconn; | |
231 | |
232 if (!P) /* this may happen since we allow PQfinish() to be called */ | |
233 strcpy (buf, "#<PGconn DEAD>"); /* evil! */ | |
234 else if ((cst = PQstatus (P)) == CONNECTION_OK) | |
235 { | |
236 if (!(host = PQhost (P))) | |
237 host = ""; | |
238 port = PQport (P); | |
239 db = PQdb (P); | |
240 if (!(user = PQuser (P))) | |
241 user = ""; | |
242 sprintf (buf, "#<PGconn %s:%s %s/%s>", /* evil! */ | |
243 !strlen (host) ? "localhost" : host, | |
244 port, | |
245 user, | |
246 db); | |
247 } | |
248 else if (cst == CONNECTION_BAD) | |
249 strcpy (buf, "#<PGconn BAD>"); /* evil! */ | |
250 else | |
251 strcpy (buf, "#<PGconn connecting>"); /* evil! */ | |
252 | |
253 if (print_readably) | |
254 printing_unreadable_object ("%s", buf); | |
255 else | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
256 write_cistring (printcharfun, buf); |
996 | 257 } |
258 | |
259 static Lisp_PGconn * | |
260 allocate_pgconn (void) | |
261 { | |
262 #ifdef RUNNING_XEMACS_21_1 | |
3024 | 263 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, |
996 | 264 lrecord_pgconn); |
265 #else | |
3024 | 266 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, |
996 | 267 &lrecord_pgconn); |
268 #endif | |
269 pgconn->pgconn = (PGconn *)NULL; | |
270 return pgconn; | |
271 } | |
272 | |
273 static void | |
274 finalize_pgconn (void *header, int for_disksave) | |
275 { | |
276 Lisp_PGconn *pgconn = (Lisp_PGconn *)header; | |
277 | |
278 if (for_disksave) | |
279 invalid_operation ("Can't dump an emacs containing PGconn objects", | |
280 make_pgconn (pgconn)); | |
281 | |
282 if (pgconn->pgconn) | |
283 { | |
284 PQfinish (pgconn->pgconn); | |
285 pgconn->pgconn = (PGconn *)NULL; | |
286 } | |
287 } | |
288 | |
289 #ifdef RUNNING_XEMACS_21_1 | |
290 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, | |
291 mark_pgconn, print_pgconn, finalize_pgconn, | |
292 NULL, NULL, | |
293 Lisp_PGconn); | |
294 #else | |
295 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, | |
296 0, /*dumpable-flag*/ | |
297 mark_pgconn, print_pgconn, finalize_pgconn, | |
298 NULL, NULL, | |
299 pgconn_description, | |
300 Lisp_PGconn); | |
301 #endif | |
302 /****/ | |
303 | |
304 /* PGresult is an opaque object and we need to be able to store them in | |
305 Lisp code. | |
306 */ | |
307 Lisp_Object Qpgresultp; | |
308 | |
309 static Lisp_Object | |
310 make_pgresult (Lisp_PGresult *pgresult) | |
311 { | |
312 return wrap_pgresult (pgresult); | |
313 } | |
314 | |
1204 | 315 static const struct memory_description pgresult_description [] = { |
996 | 316 { XD_END } |
317 }; | |
318 | |
319 | |
320 static Lisp_Object | |
321 #ifdef RUNNING_XEMACS_21_1 | |
2286 | 322 mark_pgresult (Lisp_Object UNUSED (obj), |
323 void (*UNUSED_ARG (markobj)) (Lisp_Object) ATTRIBUTE_UNUSED) | |
996 | 324 #else |
2286 | 325 mark_pgresult (Lisp_Object UNUSED (obj)) |
996 | 326 #endif |
327 { | |
328 return Qnil; | |
329 } | |
330 | |
331 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>" | |
332 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>" | |
333 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>" | |
334 static void | |
2286 | 335 print_pgresult (Lisp_Object obj, Lisp_Object printcharfun, |
336 int UNUSED (escapeflag)) | |
996 | 337 { |
338 char buf[1024]; | |
339 PGresult *res; | |
340 | |
341 res = (XPGRESULT (obj))->pgresult; | |
342 | |
343 if (res) | |
344 { | |
345 switch (PQresultStatus (res)) | |
346 { | |
347 case PGRES_TUPLES_OK: | |
348 /* Add number of tuples of result to output */ | |
349 sprintf (buf, RESULT_TUPLES_FMT, /* evil! */ | |
350 PQresStatus (PQresultStatus (res)), | |
351 PQntuples (res), | |
352 PQcmdStatus (res)); | |
353 break; | |
354 case PGRES_COMMAND_OK: | |
355 /* Add number of tuples affected by output-less command */ | |
356 if (!strlen (PQcmdTuples (res))) goto notuples; | |
357 sprintf (buf, RESULT_CMD_TUPLES_FMT, /* evil! */ | |
358 PQresStatus (PQresultStatus (res)), | |
359 PQcmdTuples (res), | |
360 PQcmdStatus (res)); | |
361 break; | |
362 default: | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
363 notuples: |
996 | 364 /* No counts to print */ |
365 sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */ | |
366 PQresStatus (PQresultStatus (res)), | |
367 PQcmdStatus (res)); | |
368 break; | |
369 } | |
370 } | |
371 else | |
372 strcpy (buf, "#<PGresult DEAD>"); /* evil! */ | |
373 | |
374 if (print_readably) | |
375 printing_unreadable_object ("%s", buf); | |
376 else | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
377 write_cistring (printcharfun, buf); |
996 | 378 } |
379 | |
380 #undef RESULT_TUPLES_FMT | |
381 #undef RESULT_CMD_TUPLES_FMT | |
382 #undef RESULT_DEFAULT_FMT | |
383 | |
384 static Lisp_PGresult * | |
385 allocate_pgresult (void) | |
386 { | |
387 #ifdef RUNNING_XEMACS_21_1 | |
3024 | 388 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, |
996 | 389 lrecord_pgresult); |
390 #else | |
3024 | 391 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, |
996 | 392 &lrecord_pgresult); |
393 #endif | |
394 pgresult->pgresult = (PGresult *)NULL; | |
395 return pgresult; | |
396 } | |
397 | |
398 static void | |
399 finalize_pgresult (void *header, int for_disksave) | |
400 { | |
401 Lisp_PGresult *pgresult = (Lisp_PGresult *)header; | |
402 | |
403 if (for_disksave) | |
404 invalid_operation ("Can't dump an emacs containing PGresult objects", | |
405 make_pgresult (pgresult)); | |
406 | |
407 if (pgresult->pgresult) | |
408 { | |
409 PQclear (pgresult->pgresult); | |
410 pgresult->pgresult = (PGresult *)NULL; | |
411 } | |
412 } | |
413 | |
414 #ifdef RUNNING_XEMACS_21_1 | |
415 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, | |
416 mark_pgresult, print_pgresult, finalize_pgresult, | |
417 NULL, NULL, | |
418 Lisp_PGresult); | |
419 #else | |
420 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, | |
421 0, /*dumpable-flag*/ | |
422 mark_pgresult, print_pgresult, finalize_pgresult, | |
423 NULL, NULL, | |
424 pgresult_description, | |
425 Lisp_PGresult); | |
426 #endif | |
427 | |
428 /***********************/ | |
429 | |
430 /* notices */ | |
431 static void | |
2286 | 432 xemacs_notice_processor (void *UNUSED (arg), const char *msg) |
996 | 433 { |
434 warn_when_safe (Qpostgresql, Qnotice, "%s", msg); | |
435 } | |
436 | |
437 /* There are four ways (as of PostgreSQL v7) to connect to a database. | |
438 Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those | |
439 routines take a number of positional parameters and are better done in Lisp. | |
440 Note that PQconnectStart does not exist prior to v7. | |
441 */ | |
442 | |
443 /* ###autoload */ | |
444 DEFUN ("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /* | |
445 Return a connection default structure. | |
446 */ | |
447 ()) | |
448 { | |
449 /* This function can GC */ | |
450 PQconninfoOption *pcio; | |
451 Lisp_Object temp, temp1; | |
452 int i; | |
453 | |
454 pcio = PQconndefaults(); | |
455 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
|
456 temp = |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
457 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
|
458 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
|
459 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
|
460 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
|
461 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
|
462 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
|
463 make_int (pcio[0].dispsize)))); |
996 | 464 |
465 for (i = 1; pcio[i].keyword; i++) | |
466 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
467 temp1 = |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
468 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
|
469 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
|
470 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
|
471 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
|
472 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
|
473 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
|
474 make_int (pcio[i].dispsize)))); |
996 | 475 { |
476 Lisp_Object args[2]; | |
477 args[0] = temp; | |
478 args[1] = temp1; | |
479 /* Fappend GCPROs its arguments */ | |
480 temp = Fappend (2, args); | |
481 } | |
482 } | |
483 | |
484 return temp; | |
485 } | |
486 | |
487 /* PQconnectdb Makes a new connection to a backend. | |
488 PGconn *PQconnectdb(const char *conninfo) | |
489 */ | |
490 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
491 #ifdef HAVE_POSTGRESQLV7 |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
492 #define USED_IF_V7(x) x |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
493 #else |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
494 #define USED_IF_V7(x) UNUSED (x) |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
495 #endif |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
496 |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
497 static Lisp_Object |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
498 postgresql_connect (Lisp_Object conninfo, int USED_IF_V7 (async)) |
996 | 499 { |
500 PGconn *P; | |
501 Lisp_PGconn *lisp_pgconn; | |
502 | |
503 CHECK_STRING (conninfo); | |
504 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
505 P = ( |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
506 #ifdef HAVE_POSTGRESQLV7 |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
507 async ? PQconnectStart : |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
508 #endif |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
509 PQconnectdb) |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
510 (LISP_STRING_TO_EXTERNAL (conninfo, PG_OS_CODING)); |
996 | 511 if (P && (PQstatus (P) == CONNECTION_OK)) |
512 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
513 (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
|
514 lisp_pgconn = allocate_pgconn (); |
996 | 515 lisp_pgconn->pgconn = P; |
516 return make_pgconn (lisp_pgconn); | |
517 } | |
518 else | |
519 { | |
520 /* Connection failed. Destroy the connection and signal an error. */ | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
521 |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
522 Lisp_Object errmsg; |
996 | 523 if (P) |
524 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
525 errmsg = build_extstring (PQerrorMessage (P), PG_OS_CODING); |
996 | 526 PQfinish (P); |
527 } | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
528 else |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
529 errmsg = build_msg_string ("Out of Memory?"); |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
530 signal_error (Qprocess_error, "Connecting to PostGreSQL backend", |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
531 errmsg); |
996 | 532 } |
533 } | |
534 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
535 /* ###autoload */ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
536 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /* |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
537 Make a new connection to a PostgreSQL backend. |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
538 */ |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
539 (conninfo)) |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
540 { |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
541 return postgresql_connect (conninfo, 0); |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
542 } |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
543 |
996 | 544 /* PQconnectStart Makes a new asynchronous connection to a backend. |
545 PGconn *PQconnectStart(const char *conninfo) | |
546 */ | |
547 | |
548 #ifdef HAVE_POSTGRESQLV7 | |
549 /* ###autoload */ | |
550 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /* | |
551 Make a new asynchronous connection to a PostgreSQL backend. | |
552 */ | |
553 (conninfo)) | |
554 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
555 return postgresql_connect (conninfo, 1); |
996 | 556 } |
557 | |
558 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /* | |
559 Poll an asynchronous connection for completion | |
560 */ | |
561 (conn)) | |
562 { | |
563 PGconn *P; | |
564 PostgresPollingStatusType polling_status; | |
565 | |
566 CHECK_PGCONN (conn); | |
567 | |
568 P = (XPGCONN (conn))->pgconn; | |
569 CHECK_LIVE_CONNECTION (P); | |
570 | |
571 polling_status = PQconnectPoll (P); | |
572 switch (polling_status) | |
573 { | |
574 case PGRES_POLLING_FAILED: | |
575 /* Something Bad has happened */ | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
576 SIGNAL_ERROR (P, "Polling asynchronous connection"); |
996 | 577 case PGRES_POLLING_OK: |
578 return Qpgres_polling_ok; | |
579 case PGRES_POLLING_READING: | |
580 return Qpgres_polling_reading; | |
581 case PGRES_POLLING_WRITING: | |
582 return Qpgres_polling_writing; | |
583 case PGRES_POLLING_ACTIVE: | |
584 return Qpgres_polling_active; | |
585 default: | |
586 /* they've added a new field we don't know about */ | |
587 signal_ferror (Qprocess_error, "Help! Unknown status code %08x from backend!", polling_status); | |
588 } | |
589 } | |
590 | |
591 #ifdef MULE | |
592 DEFUN ("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /* | |
593 Return client coding system. | |
594 */ | |
595 (conn)) | |
596 { | |
597 PGconn *P; | |
598 | |
599 CHECK_PGCONN (conn); | |
600 P = (XPGCONN (conn))->pgconn; | |
601 CHECK_LIVE_CONNECTION (P); | |
602 | |
603 return make_int (PQclientEncoding (P)); | |
604 } | |
605 | |
606 DEFUN ("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /* | |
607 Set client coding system. | |
608 */ | |
609 (conn, encoding)) | |
610 { | |
611 PGconn *P; | |
612 int rc; | |
613 char *c_encoding; | |
614 | |
615 CHECK_PGCONN (conn); | |
616 CHECK_STRING (encoding); | |
617 | |
618 P = (XPGCONN (conn))->pgconn; | |
619 CHECK_LIVE_CONNECTION (P); | |
620 | |
621 TO_EXTERNAL_FORMAT (LISP_STRING, encoding, | |
622 C_STRING_ALLOCA, c_encoding, Qnative); | |
623 | |
624 if ((rc = PQsetClientEncoding (P, c_encoding)) < 0) | |
625 signal_error (Qinvalid_argument, "bad encoding", Qunbound); | |
626 else | |
627 return make_int (rc); | |
628 } | |
629 | |
630 #endif | |
631 #endif /* HAVE_POSTGRESQLV7 */ | |
632 | |
633 /* PQfinish Close the connection to the backend. Also frees memory | |
634 used by the PGconn object. | |
635 void PQfinish(PGconn *conn) | |
636 */ | |
637 DEFUN ("pq-finish", Fpq_finish, 1, 1, 0, /* | |
638 Close the connection to the backend. | |
639 */ | |
640 (conn)) | |
641 { | |
642 PGconn *P; | |
643 | |
644 CHECK_PGCONN (conn); | |
645 P = (XPGCONN (conn))->pgconn; | |
646 PUKE_IF_NULL (P); | |
647 | |
648 PQfinish (P); | |
649 /* #### PQfinish deallocates the PGconn structure, so we now have a | |
650 dangling pointer. */ | |
651 /* Genocided all @'s ... */ | |
652 (XPGCONN (conn))->pgconn = (PGconn *)NULL; /* You feel DEAD inside */ | |
653 return Qnil; | |
654 } | |
655 | |
656 DEFUN ("pq-clear", Fpq_clear, 1, 1, 0, /* | |
657 Forcibly erase a PGresult object. | |
658 */ | |
659 (res)) | |
660 { | |
661 PGresult *R; | |
662 | |
663 CHECK_PGRESULT (res); | |
664 R = (XPGRESULT (res))->pgresult; | |
665 PUKE_IF_NULL (R); | |
666 | |
667 PQclear (R); | |
668 /* Genocided all @'s ... */ | |
669 (XPGRESULT (res))->pgresult = (PGresult *)NULL; /* You feel DEAD inside */ | |
670 | |
671 return Qnil; | |
672 } | |
673 | |
674 DEFUN ("pq-is-busy", Fpq_is_busy, 1, 1, 0, /* | |
675 Return t if PQgetResult would block waiting for input. | |
676 */ | |
677 (conn)) | |
678 { | |
679 PGconn *P; | |
680 | |
681 CHECK_PGCONN (conn); | |
682 P = (XPGCONN (conn))->pgconn; | |
683 CHECK_LIVE_CONNECTION (P); | |
684 | |
685 return PQisBusy (P) ? Qt : Qnil; | |
686 } | |
687 | |
688 DEFUN ("pq-consume-input", Fpq_consume_input, 1, 1, 0, /* | |
689 Consume any available input from the backend. | |
690 Returns nil if something bad happened. | |
691 */ | |
692 (conn)) | |
693 { | |
694 PGconn *P; | |
695 | |
696 CHECK_PGCONN (conn); | |
697 P = (XPGCONN (conn))->pgconn; | |
698 CHECK_LIVE_CONNECTION (P); | |
699 | |
700 return PQconsumeInput (P) ? Qt : Qnil; | |
701 } | |
702 | |
703 /* PQreset Reset the communication port with the backend. | |
704 void PQreset(PGconn *conn) | |
705 */ | |
706 DEFUN ("pq-reset", Fpq_reset, 1, 1, 0, /* | |
707 Reset the connection to the backend. | |
708 This function will close the connection to the backend and attempt to | |
709 reestablish a new connection to the same postmaster, using all the same | |
710 parameters previously used. This may be useful for error recovery if a | |
711 working connection is lost. | |
712 */ | |
713 (conn)) | |
714 { | |
715 PGconn *P; | |
716 | |
717 CHECK_PGCONN (conn); | |
718 P = (XPGCONN (conn))->pgconn; | |
719 PUKE_IF_NULL (P);/* we can resurrect a BAD connection, but not a dead one. */ | |
720 | |
721 PQreset (P); | |
722 | |
723 return Qnil; | |
724 } | |
725 | |
726 #ifdef HAVE_POSTGRESQLV7 | |
727 DEFUN ("pq-reset-start", Fpq_reset_start, 1, 1, 0, /* | |
728 Reset connection to the backend asynchronously. | |
729 */ | |
730 (conn)) | |
731 { | |
732 PGconn *P; | |
733 | |
734 CHECK_PGCONN (conn); | |
735 P = (XPGCONN (conn))->pgconn; | |
736 CHECK_LIVE_CONNECTION (P); | |
737 | |
738 if (PQresetStart (P)) return Qt; | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
739 SIGNAL_ERROR (P, "Resetting connection"); |
996 | 740 } |
741 | |
742 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /* | |
743 Poll an asynchronous reset for completion. | |
744 */ | |
745 (conn)) | |
746 { | |
747 PGconn *P; | |
748 PostgresPollingStatusType polling_status; | |
749 | |
750 CHECK_PGCONN (conn); | |
751 | |
752 P = (XPGCONN (conn))->pgconn; | |
753 CHECK_LIVE_CONNECTION (P); | |
754 | |
755 polling_status = PQresetPoll (P); | |
756 switch (polling_status) | |
757 { | |
758 case PGRES_POLLING_FAILED: | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
759 SIGNAL_ERROR (P, "Polling asynchronous reset"); |
996 | 760 case PGRES_POLLING_OK: |
761 return Qpgres_polling_ok; | |
762 case PGRES_POLLING_READING: | |
763 return Qpgres_polling_reading; | |
764 case PGRES_POLLING_WRITING: | |
765 return Qpgres_polling_writing; | |
766 case PGRES_POLLING_ACTIVE: | |
767 return Qpgres_polling_active; | |
768 default: | |
769 /* they've added a new field we don't know about */ | |
770 signal_ferror (Qprocess_error, "Help! Unknown status code %08x from backend!", polling_status); | |
771 } | |
772 } | |
773 #endif | |
774 | |
775 DEFUN ("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /* | |
776 Attempt to request cancellation of the current operation. | |
777 | |
778 The return value is t if the cancel request was successfully | |
779 dispatched, nil if not (in which case conn->errorMessage is set). | |
780 Note: successful dispatch is no guarantee that there will be any effect at | |
781 the backend. The application must read the operation result as usual. | |
782 */ | |
783 (conn)) | |
784 { | |
785 PGconn *P; | |
786 | |
787 CHECK_PGCONN (conn); | |
788 P = (XPGCONN (conn))->pgconn; | |
789 CHECK_LIVE_CONNECTION (P); | |
790 | |
791 return PQrequestCancel (P) ? Qt : Qnil; | |
792 } | |
793 | |
794 /* accessor function for the PGconn object */ | |
795 DEFUN ("pq-pgconn", Fpq_pgconn, 2, 2, 0, /* | |
796 Accessor function for the PGconn object. | |
797 Currently recognized symbols for the field: | |
798 pq::db Database name | |
799 pq::user Database user name | |
800 pq::pass Database user's password | |
801 pq::host Hostname of PostgreSQL backend connected to | |
802 pq::port TCP port number of connection | |
803 pq::tty Debugging TTY (not used in Emacs) | |
804 pq::options Additional backend options | |
805 pq::status Connection status (either OK or BAD) | |
806 pq::error-message Last error message from the backend | |
807 pq::backend-pid Process ID of backend process | |
808 */ | |
809 (conn, field)) | |
810 { | |
811 PGconn *P; | |
812 | |
813 CHECK_PGCONN (conn); | |
814 P = (XPGCONN (conn))->pgconn; | |
815 PUKE_IF_NULL (P); /* BAD connections still have state to query */ | |
816 | |
817 if (EQ(field, Qpqdb)) | |
818 /* PQdb Returns the database name of the connection. | |
819 char *PQdb(PGconn *conn) | |
820 */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
821 return build_extstring (PQdb(P), PG_OS_CODING); |
996 | 822 else if (EQ (field, Qpquser)) |
823 /* PQuser Returns the user name of the connection. | |
824 char *PQuser(PGconn *conn) | |
825 */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
826 return build_extstring (PQuser(P), PG_OS_CODING); |
996 | 827 else if (EQ (field, Qpqpass)) |
828 /* PQpass Returns the password of the connection. | |
829 char *PQpass(PGconn *conn) | |
830 */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
831 return build_extstring (PQpass(P), PG_OS_CODING); |
996 | 832 else if (EQ (field, Qpqhost)) |
833 /* PQhost Returns the server host name of the connection. | |
834 char *PQhost(PGconn *conn) | |
835 */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
836 return build_extstring (PQhost(P), PG_OS_CODING); |
996 | 837 else if (EQ (field, Qpqport)) |
838 { | |
839 char *p; | |
840 /* PQport Returns the port of the connection. | |
841 char *PQport(PGconn *conn) | |
842 */ | |
843 if ((p = PQport(P))) | |
844 return make_int(atoi(p)); | |
845 else | |
846 return make_int(-1); | |
847 } | |
848 else if (EQ (field, Qpqtty)) | |
849 /* PQtty Returns the debug tty of the connection. | |
850 char *PQtty(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 (PQtty(P), PG_OS_CODING); |
996 | 853 else if (EQ (field, Qpqoptions)) |
854 /* PQoptions Returns the backend options used in the connection. | |
855 char *PQoptions(PGconn *conn) | |
856 */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
857 return build_extstring (PQoptions(P), PG_OS_CODING); |
996 | 858 else if (EQ (field, Qpqstatus)) |
859 { | |
860 ConnStatusType cst; | |
861 /* PQstatus Returns the status of the connection. The status can be | |
862 CONNECTION_OK or CONNECTION_BAD. | |
863 ConnStatusType PQstatus(PGconn *conn) | |
864 */ | |
865 switch ((cst = PQstatus (P))) | |
866 { | |
867 case CONNECTION_OK: return Qpg_connection_ok; | |
868 case CONNECTION_BAD: return Qpg_connection_bad; | |
869 #ifdef HAVE_POSTGRESQLV7 | |
870 case CONNECTION_STARTED: return Qpg_connection_started; | |
871 case CONNECTION_MADE: return Qpg_connection_made; | |
872 case CONNECTION_AWAITING_RESPONSE: return Qpg_connection_awaiting_response; | |
873 case CONNECTION_AUTH_OK: return Qpg_connection_auth_ok; | |
874 case CONNECTION_SETENV: return Qpg_connection_setenv; | |
875 #endif /* HAVE_POSTGRESQLV7 */ | |
876 default: | |
877 /* they've added a new field we don't know about */ | |
878 signal_ferror (Qprocess_error, "Help! Unknown connection status code %08x from backend!", cst); | |
879 } | |
880 } | |
881 else if (EQ (field, Qpqerrormessage)) | |
882 /* PQerrorMessage Returns the error message most recently generated | |
883 by an operation on the connection. | |
884 char *PQerrorMessage(PGconn* conn); | |
885 */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
886 return build_extstring (PQerrorMessage(P), PG_OS_CODING); |
996 | 887 else if (EQ (field, Qpqbackendpid)) |
888 /* PQbackendPID Returns the process ID of the backend server handling | |
889 this connection. | |
890 int PQbackendPID(PGconn *conn); | |
891 */ | |
892 return make_int (PQbackendPID(P)); | |
893 else | |
894 signal_error (Qinvalid_argument, "bad PGconn accessor", Qunbound); | |
895 } | |
896 | |
897 /* Query functions */ | |
898 DEFUN ("pq-exec", Fpq_exec, 2, 2, 0, /* | |
899 Submit a query to Postgres and wait for the result. | |
900 */ | |
901 (conn, query)) | |
902 { | |
903 PGconn *P; | |
904 Lisp_PGresult *lisp_pgresult; | |
905 PGresult *R; | |
906 char *c_query; | |
907 | |
908 CHECK_PGCONN (conn); | |
909 CHECK_STRING (query); | |
910 | |
911 P = (XPGCONN (conn))->pgconn; | |
912 CHECK_LIVE_CONNECTION (P); | |
913 | |
914 TO_EXTERNAL_FORMAT (LISP_STRING, query, | |
915 C_STRING_ALLOCA, c_query, Qnative); | |
916 | |
917 R = PQexec (P, c_query); | |
918 { | |
4932 | 919 const Ascbyte *tag; |
920 char buf[BLCKSZ]; | |
996 | 921 |
922 if (!R) out_of_memory ("query: out of memory", Qunbound); | |
923 else | |
924 switch (PQresultStatus (R)) | |
925 { | |
926 case PGRES_BAD_RESPONSE: | |
927 tag = "bad response [%s]"; | |
928 goto err; | |
929 case PGRES_NONFATAL_ERROR: | |
930 tag = "non-fatal error [%s]"; | |
931 goto err; | |
932 case PGRES_FATAL_ERROR: | |
933 tag = "fatal error [%s]"; | |
934 err: | |
935 strncpy (buf, PQresultErrorMessage (R), sizeof (buf)); | |
936 buf [sizeof (buf) - 1] = '\0'; | |
937 PQclear (R); | |
938 signal_ferror (Qprocess_error, tag, buf); | |
939 /*NOTREACHED*/ | |
940 default: | |
941 break; | |
942 } | |
943 } | |
944 | |
945 lisp_pgresult = allocate_pgresult (); | |
946 lisp_pgresult->pgresult = R; | |
947 | |
948 return make_pgresult (lisp_pgresult); | |
949 } | |
950 | |
951 DEFUN ("pq-send-query", Fpq_send_query, 2, 2, 0, /* | |
952 Submit a query to Postgres and don't wait for the result. | |
953 Returns: t if successfully submitted | |
954 nil if error (conn->errorMessage is set) | |
955 */ | |
956 (conn, query)) | |
957 { | |
958 PGconn *P; | |
959 char *c_query; | |
960 | |
961 CHECK_PGCONN (conn); | |
962 CHECK_STRING (query); | |
963 | |
964 P = (XPGCONN (conn))->pgconn; | |
965 CHECK_LIVE_CONNECTION (P); | |
966 | |
967 TO_EXTERNAL_FORMAT (LISP_STRING, query, | |
968 C_STRING_ALLOCA, c_query, Qnative); | |
969 | |
970 if (PQsendQuery (P, c_query)) return Qt; | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
971 else SIGNAL_ERROR (P, "Sending asynchronous query"); |
996 | 972 } |
973 | |
974 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /* | |
975 Retrieve an asynchronous result from a query. | |
976 NIL is returned when no more query work remains. | |
977 */ | |
978 (conn)) | |
979 { | |
980 PGconn *P; | |
981 Lisp_PGresult *lisp_pgresult; | |
982 PGresult *R; | |
983 | |
984 CHECK_PGCONN (conn); | |
985 | |
986 P = (XPGCONN (conn))->pgconn; | |
987 CHECK_LIVE_CONNECTION (P); | |
988 | |
989 R = PQgetResult (P); | |
990 if (!R) return Qnil; /* not an error, there's no more data to get */ | |
991 | |
992 { | |
4932 | 993 const Ascbyte *tag; |
994 char buf[BLCKSZ]; | |
996 | 995 |
996 switch (PQresultStatus (R)) | |
997 { | |
998 case PGRES_BAD_RESPONSE: | |
999 tag = "bad response [%s]"; | |
1000 goto err; | |
1001 case PGRES_NONFATAL_ERROR: | |
1002 tag = "non-fatal error [%s]"; | |
1003 goto err; | |
1004 case PGRES_FATAL_ERROR: | |
1005 tag = "fatal error [%s]"; | |
1006 err: | |
1007 strncpy (buf, PQresultErrorMessage (R), sizeof (buf)); | |
1008 buf[sizeof (buf) - 1] = '\0'; | |
1009 PQclear (R); | |
1010 signal_ferror (Qprocess_error, tag, buf); | |
1011 /*NOTREACHED*/ | |
1012 default: | |
1013 break; | |
1014 } | |
1015 } | |
1016 | |
1017 lisp_pgresult = allocate_pgresult(); | |
1018 lisp_pgresult->pgresult = R; | |
1019 | |
1020 return make_pgresult (lisp_pgresult); | |
1021 } | |
1022 | |
1023 DEFUN ("pq-result-status", Fpq_result_status, 1, 1, 0, /* | |
1024 Return result status of the query. | |
1025 */ | |
1026 (result)) | |
1027 { | |
1028 PGresult *R; | |
1029 ExecStatusType est; | |
1030 | |
1031 CHECK_PGRESULT (result); | |
1032 R = (XPGRESULT (result))->pgresult; | |
1033 PUKE_IF_NULL (R); | |
1034 | |
1035 switch ((est = PQresultStatus (R))) { | |
1036 case PGRES_EMPTY_QUERY: return Qpgres_empty_query; | |
1037 case PGRES_COMMAND_OK: return Qpgres_command_ok; | |
1038 case PGRES_TUPLES_OK: return Qpgres_tuples_ok; | |
1039 case PGRES_COPY_OUT: return Qpgres_copy_out; | |
1040 case PGRES_COPY_IN: return Qpgres_copy_in; | |
1041 case PGRES_BAD_RESPONSE: return Qpgres_bad_response; | |
1042 case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error; | |
1043 case PGRES_FATAL_ERROR: return Qpgres_fatal_error; | |
1044 default: | |
1045 /* 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
|
1046 signal_ferror (Qprocess_error, |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1047 "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
|
1048 est); |
996 | 1049 } |
1050 } | |
1051 | |
1052 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /* | |
1053 Return stringified result status of the query. | |
1054 */ | |
1055 (result)) | |
1056 { | |
1057 PGresult *R; | |
1058 | |
1059 CHECK_PGRESULT (result); | |
1060 R = (XPGRESULT (result))->pgresult; | |
1061 PUKE_IF_NULL (R); | |
1062 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1063 return build_extstring (PQresStatus (PQresultStatus (R)), PG_OS_CODING); |
996 | 1064 } |
1065 | |
1066 /* Sundry PGresult accessor functions */ | |
1067 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /* | |
1068 Return last message associated with the query. | |
1069 */ | |
1070 (result)) | |
1071 { | |
1072 PGresult *R; | |
1073 | |
1074 CHECK_PGRESULT (result); | |
1075 R = (XPGRESULT (result))->pgresult; | |
1076 PUKE_IF_NULL (R); | |
1077 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1078 return build_extstring (PQresultErrorMessage (R), PG_OS_CODING); |
996 | 1079 } |
1080 | |
1081 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /* | |
1082 Return the number of tuples (instances) in the query result. | |
1083 */ | |
1084 (result)) | |
1085 { | |
1086 PGresult *R; | |
1087 | |
1088 CHECK_PGRESULT (result); | |
1089 R = (XPGRESULT (result))->pgresult; | |
1090 PUKE_IF_NULL (R); | |
1091 | |
1092 return make_int (PQntuples (R)); | |
1093 } | |
1094 | |
1095 DEFUN ("pq-nfields", Fpq_nfields, 1, 1, 0, /* | |
1096 Return the number of fields (attributes) in each tuple of the query result. | |
1097 */ | |
1098 (result)) | |
1099 { | |
1100 PGresult *R; | |
1101 | |
1102 CHECK_PGRESULT (result); | |
1103 R = (XPGRESULT (result))->pgresult; | |
1104 PUKE_IF_NULL (R); | |
1105 | |
1106 return make_int (PQnfields (R)); | |
1107 } | |
1108 | |
1109 DEFUN ("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /* | |
1110 Return t if the query result contains binary data, nil otherwise. | |
1111 */ | |
1112 (result)) | |
1113 { | |
1114 PGresult *R; | |
1115 | |
1116 CHECK_PGRESULT (result); | |
1117 R = (XPGRESULT (result))->pgresult; | |
1118 PUKE_IF_NULL (R); | |
1119 | |
1120 return (PQbinaryTuples (R)) ? Qt : Qnil; | |
1121 } | |
1122 | |
1123 DEFUN ("pq-fname", Fpq_fname, 2, 2, 0, /* | |
1124 Return the field (attribute) name associated with the given field index. | |
1125 Field indices start at 0. | |
1126 */ | |
1127 (result, field_index)) | |
1128 { | |
1129 PGresult *R; | |
1130 | |
1131 CHECK_PGRESULT (result); | |
1132 CHECK_INT (field_index); | |
1133 R = (XPGRESULT (result))->pgresult; | |
1134 PUKE_IF_NULL (R); | |
1135 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1136 return build_extstring (PQfname (R, XINT (field_index)), PG_OS_CODING); |
996 | 1137 } |
1138 | |
1139 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /* | |
1140 Return the number of fields (attributes) in each tuple of the query result. | |
1141 */ | |
1142 (result, field_name)) | |
1143 { | |
1144 PGresult *R; | |
1145 char *c_field_name; | |
1146 | |
1147 CHECK_PGRESULT (result); | |
1148 CHECK_STRING (field_name); | |
1149 R = (XPGRESULT (result))->pgresult; | |
1150 PUKE_IF_NULL (R); | |
1151 | |
1152 TO_EXTERNAL_FORMAT (LISP_STRING, field_name, | |
1153 C_STRING_ALLOCA, c_field_name, Qnative); | |
1154 | |
1155 return make_int (PQfnumber (R, c_field_name)); | |
1156 } | |
1157 | |
1158 DEFUN ("pq-ftype", Fpq_ftype, 2, 2, 0, /* | |
1159 Return the field type associated with the given field index. | |
1160 The integer returned is the internal coding of the type. Field indices | |
1161 start at 0. | |
1162 */ | |
1163 (result, field_num)) | |
1164 { | |
1165 PGresult *R; | |
1166 | |
1167 CHECK_PGRESULT (result); | |
1168 CHECK_INT (field_num); | |
1169 R = (XPGRESULT (result))->pgresult; | |
1170 PUKE_IF_NULL (R); | |
1171 | |
1172 return make_int (PQftype (R, XINT (field_num))); | |
1173 } | |
1174 | |
1175 DEFUN ("pq-fsize", Fpq_fsize, 2, 2, 0, /* | |
1176 Return the field size in bytes associated with the given field index. | |
1177 Field indices start at 0. | |
1178 */ | |
1179 (result, field_index)) | |
1180 { | |
1181 PGresult *R; | |
1182 | |
1183 CHECK_PGRESULT (result); | |
1184 CHECK_INT (field_index); | |
1185 R = (XPGRESULT (result))->pgresult; | |
1186 PUKE_IF_NULL (R); | |
1187 | |
1188 return make_int (PQftype (R, XINT (field_index))); | |
1189 } | |
1190 | |
1191 DEFUN ("pq-fmod", Fpq_fmod, 2, 2, 0, /* | |
1192 Return the type modifier associated with a field. | |
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 (PQfmod (R, XINT (field_index))); | |
1205 } | |
1206 | |
1207 DEFUN ("pq-get-value", Fpq_get_value, 3, 3, 0, /* | |
1208 Return a single field (attribute) value of one tuple of a PGresult. | |
1209 Tuple and field indices start at 0. | |
1210 */ | |
1211 (result, tup_num, field_num)) | |
1212 { | |
1213 PGresult *R; | |
1214 | |
1215 CHECK_PGRESULT (result); | |
1216 CHECK_INT (tup_num); | |
1217 CHECK_INT (field_num); | |
1218 R = (XPGRESULT (result))->pgresult; | |
1219 PUKE_IF_NULL (R); | |
1220 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1221 return build_extstring (PQgetvalue (R, XINT (tup_num), XINT (field_num)), |
996 | 1222 PG_OS_CODING); |
1223 } | |
1224 | |
1225 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /* | |
1226 Returns the length of a field value in bytes. | |
1227 If result is binary, i.e. a result of a binary portal, then the | |
1228 length returned does NOT include the size field of the varlena. (The | |
1229 data returned by PQgetvalue doesn't either.) | |
1230 */ | |
1231 (result, tup_num, field_num)) | |
1232 { | |
1233 PGresult *R; | |
1234 | |
1235 CHECK_PGRESULT (result); | |
1236 CHECK_INT (tup_num); | |
1237 CHECK_INT (field_num); | |
1238 R = (XPGRESULT (result))->pgresult; | |
1239 PUKE_IF_NULL (R); | |
1240 | |
1241 return make_int (PQgetlength (R, XINT (tup_num), XINT (field_num))); | |
1242 } | |
1243 | |
1244 DEFUN ("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /* | |
1245 Returns the null status of a field value. | |
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 PQgetisnull (R, XINT (tup_num), XINT (field_num)) ? Qt : Qnil; | |
1258 } | |
1259 | |
1260 DEFUN ("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /* | |
1261 Returns the command status string from the SQL command that generated the result. | |
1262 */ | |
1263 (result)) | |
1264 { | |
1265 PGresult *R; | |
1266 | |
1267 CHECK_PGRESULT (result); | |
1268 R = (XPGRESULT (result))->pgresult; | |
1269 PUKE_IF_NULL (R); | |
1270 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1271 return build_extstring (PQcmdStatus (R), PG_OS_CODING); |
996 | 1272 } |
1273 | |
1274 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /* | |
1275 Returns the number of rows affected by the SQL command. | |
1276 */ | |
1277 (result)) | |
1278 { | |
1279 PGresult *R; | |
1280 | |
1281 CHECK_PGRESULT (result); | |
1282 R = (XPGRESULT (result))->pgresult; | |
1283 PUKE_IF_NULL (R); | |
1284 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1285 return build_extstring (PQcmdTuples (R), PG_OS_CODING); |
996 | 1286 } |
1287 | |
1288 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /* | |
1289 Returns the object id of the tuple inserted. | |
1290 */ | |
1291 (result)) | |
1292 { | |
1293 PGresult *R; | |
1294 | |
1295 CHECK_PGRESULT (result); | |
1296 R = (XPGRESULT (result))->pgresult; | |
1297 PUKE_IF_NULL (R); | |
1298 | |
1299 #ifdef HAVE_POSTGRESQLV7 | |
1300 return make_int (PQoidValue (R)); | |
1301 #else | |
1302 /* Use the old interface */ | |
1303 return make_int (atoi (PQoidStatus (R))); | |
1304 #endif | |
1305 } | |
1306 | |
1307 #ifdef HAVE_POSTGRESQLV7 | |
1308 DEFUN ("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /* | |
1309 Sets the PGconn's database connection non-blocking if the arg is TRUE | |
1310 or makes it non-blocking if the arg is FALSE, this will not protect | |
1311 you from PQexec(), you'll only be safe when using the non-blocking API. | |
1312 | |
1313 Needs to be called only on a connected database connection. | |
1314 */ | |
1315 (conn, arg)) | |
1316 { | |
1317 PGconn *P; | |
1318 | |
1319 CHECK_PGCONN (conn); | |
1320 P = (XPGCONN (conn))->pgconn; | |
1321 CHECK_LIVE_CONNECTION (P); | |
1322 | |
1323 return make_int (PQsetnonblocking (P, !NILP (arg))); | |
1324 } | |
1325 | |
1326 DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /* | |
1327 Return the blocking status of the database connection. | |
1328 */ | |
1329 (conn)) | |
1330 { | |
1331 PGconn *P; | |
1332 | |
1333 CHECK_PGCONN (conn); | |
1334 P = (XPGCONN (conn))->pgconn; | |
1335 CHECK_LIVE_CONNECTION (P); | |
1336 | |
1337 return PQisnonblocking (P) ? Qt : Qnil; | |
1338 } | |
1339 | |
1340 DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /* | |
1341 Force the write buffer to be written (or at least try). | |
1342 */ | |
1343 (conn)) | |
1344 { | |
1345 PGconn *P; | |
1346 | |
1347 CHECK_PGCONN (conn); | |
1348 P = (XPGCONN (conn))->pgconn; | |
1349 CHECK_LIVE_CONNECTION (P); | |
1350 | |
1351 return make_int (PQflush (P)); | |
1352 } | |
1353 #endif | |
1354 | |
1355 DEFUN ("pq-notifies", Fpq_notifies, 1, 1, 0, /* | |
1356 Return the latest async notification that has not yet been handled. | |
1357 If there has been a notification, then a list of two elements will be returned. | |
1358 The first element contains the relation name being notified, the second | |
1359 element contains the backend process ID number. nil is returned if there | |
1360 aren't any notifications to process. | |
1361 */ | |
1362 (conn)) | |
1363 { | |
1364 /* This function cannot GC */ | |
1365 PGconn *P; | |
1366 PGnotify *PGN; | |
1367 | |
1368 CHECK_PGCONN (conn); | |
1369 P = (XPGCONN (conn))->pgconn; | |
1370 CHECK_LIVE_CONNECTION (P); | |
1371 | |
1372 PGN = PQnotifies (P); | |
1373 if (!PGN) | |
1374 return Qnil; | |
1375 else | |
1376 { | |
1377 Lisp_Object temp; | |
1378 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1379 temp = list2 (build_extstring (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid)); |
996 | 1380 free ((void *)PGN); |
1381 return temp; | |
1382 } | |
1383 } | |
1384 | |
1385 #if defined (HAVE_POSTGRESQLV7) && defined(MULE) | |
1386 /* ###autoload */ | |
1387 DEFUN ("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /* | |
1388 Get encoding id from environment variable PGCLIENTENCODING. | |
1389 */ | |
1390 ()) | |
1391 { | |
1392 return make_int (PQenv2encoding ()); | |
1393 } | |
1394 #endif /* MULE */ | |
1395 | |
1396 DEFUN ("pq-lo-import", Fpq_lo_import, 2, 2, 0, /* | |
1397 */ | |
1398 (conn, filename)) | |
1399 { | |
1400 PGconn *P; | |
1401 char *c_filename; | |
1402 | |
1403 CHECK_PGCONN (conn); | |
1404 CHECK_STRING (filename); | |
1405 | |
1406 P = (XPGCONN (conn))->pgconn; | |
1407 CHECK_LIVE_CONNECTION (P); | |
1408 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1409 LISP_PATHNAME_CONVERT_OUT (filename, c_filename); |
996 | 1410 |
1411 return make_int ((int)lo_import (P, c_filename)); | |
1412 } | |
1413 | |
1414 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /* | |
1415 */ | |
1416 (conn, oid, filename)) | |
1417 { | |
1418 PGconn *P; | |
1419 char *c_filename; | |
1420 | |
1421 CHECK_PGCONN (conn); | |
1422 CHECK_INT (oid); | |
1423 CHECK_STRING (filename); | |
1424 | |
1425 P = (XPGCONN (conn))->pgconn; | |
1426 CHECK_LIVE_CONNECTION (P); | |
1427 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1428 LISP_PATHNAME_CONVERT_OUT (filename, c_filename); |
996 | 1429 |
1430 return make_int ((int)lo_export (P, XINT (oid), c_filename)); | |
1431 } | |
1432 | |
1433 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /* | |
1434 Make an empty PGresult object with the given status. | |
1435 */ | |
1436 (conn, status)) | |
1437 { | |
1438 PGconn *P; | |
1439 Lisp_PGresult *lpgr; | |
1440 PGresult *R; | |
1441 ExecStatusType est; | |
1442 | |
1443 CHECK_PGCONN (conn); | |
1444 P = (XPGCONN (conn))->pgconn; | |
1445 CHECK_LIVE_CONNECTION (P); /* needed here? */ | |
1446 | |
1447 if (EQ (status, Qpgres_empty_query)) est = PGRES_EMPTY_QUERY; | |
1448 else if (EQ (status, Qpgres_command_ok)) est = PGRES_COMMAND_OK; | |
1449 else if (EQ (status, Qpgres_tuples_ok)) est = PGRES_TUPLES_OK; | |
1450 else if (EQ (status, Qpgres_copy_out)) est = PGRES_COPY_OUT; | |
1451 else if (EQ (status, Qpgres_copy_in)) est = PGRES_COPY_IN; | |
1452 else if (EQ (status, Qpgres_bad_response)) est = PGRES_BAD_RESPONSE; | |
1453 else if (EQ (status, Qpgres_nonfatal_error)) est = PGRES_NONFATAL_ERROR; | |
1454 else if (EQ (status, Qpgres_fatal_error)) est = PGRES_FATAL_ERROR; | |
1455 else invalid_constant ("bad status symbol", status); | |
1456 | |
1457 R = PQmakeEmptyPGresult (P, est); | |
1458 if (!R) out_of_memory (0, Qunbound); | |
1459 | |
1460 lpgr = allocate_pgresult (); | |
1461 lpgr->pgresult = R; | |
1462 | |
1463 return make_pgresult (lpgr); | |
1464 } | |
1465 | |
1466 DEFUN ("pq-get-line", Fpq_get_line, 1, 1, 0, /* | |
1467 Retrieve a line from server in copy in operation. | |
1468 The return value is a dotted pair where the cons cell is an integer code: | |
1469 -1: Copying is complete | |
1470 0: A record is complete | |
1471 1: A record is incomplete, it will be continued in the next `pq-get-line' | |
1472 operation. | |
1473 and the cdr cell is returned string data. | |
1474 | |
1475 The copy operation is complete when the value `\.' (backslash dot) is | |
1476 returned. | |
1477 */ | |
1478 (conn)) | |
1479 { | |
1480 char buffer[BLCKSZ]; /* size of a Postgres disk block */ | |
1481 PGconn *P; | |
1482 int ret; | |
1483 | |
1484 CHECK_PGCONN (conn); | |
1485 P = (XPGCONN (conn))->pgconn; | |
1486 CHECK_LIVE_CONNECTION (P); | |
1487 | |
1488 ret = PQgetline (P, buffer, sizeof (buffer)); | |
1489 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1490 return Fcons (make_int (ret), build_extstring (buffer, PG_OS_CODING)); |
996 | 1491 } |
1492 | |
1493 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /* | |
1494 Send a line to the server in copy out operation. | |
1495 | |
1496 Returns t if the operation succeeded, nil otherwise. | |
1497 */ | |
1498 (conn, string)) | |
1499 { | |
1500 PGconn *P; | |
1501 char *c_string; | |
1502 | |
1503 CHECK_PGCONN (conn); | |
1504 CHECK_STRING (string); | |
1505 | |
1506 P = (XPGCONN (conn))->pgconn; | |
1507 CHECK_LIVE_CONNECTION (P); | |
1508 TO_EXTERNAL_FORMAT (LISP_STRING, string, | |
1509 C_STRING_ALLOCA, c_string, Qnative); | |
1510 | |
1511 return !PQputline (P, c_string) ? Qt : Qnil; | |
1512 } | |
1513 | |
1514 DEFUN ("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /* | |
1515 Get a line from the server in copy in operation asynchronously. | |
1516 | |
1517 This routine is for applications that want to do "COPY <rel> to stdout" | |
1518 asynchronously, that is without blocking. Having issued the COPY command | |
1519 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput | |
1520 and this routine until the end-of-data signal is detected. Unlike | |
1521 PQgetline, this routine takes responsibility for detecting end-of-data. | |
1522 | |
1523 On each call, PQgetlineAsync will return data if a complete newline- | |
1524 terminated data line is available in libpq's input buffer, or if the | |
1525 incoming data line is too long to fit in the buffer offered by the caller. | |
1526 Otherwise, no data is returned until the rest of the line arrives. | |
1527 | |
1528 If -1 is returned, the end-of-data signal has been recognized (and removed | |
1529 from libpq's input buffer). The caller *must* next call PQendcopy and | |
1530 then return to normal processing. | |
1531 | |
1532 RETURNS: | |
1533 -1 if the end-of-copy-data marker has been recognized | |
1534 0 if no data is available | |
1535 >0 the number of bytes returned. | |
1536 The data returned will not extend beyond a newline character. If possible | |
1537 a whole line will be returned at one time. But if the buffer offered by | |
1538 the caller is too small to hold a line sent by the backend, then a partial | |
1539 data line will be returned. This can be detected by testing whether the | |
1540 last returned byte is '\n' or not. | |
1541 The returned string is *not* null-terminated. | |
1542 */ | |
1543 (conn)) | |
1544 { | |
1545 PGconn *P; | |
1546 char buffer[BLCKSZ]; | |
1547 int ret; | |
1548 | |
1549 CHECK_PGCONN (conn); | |
1550 | |
1551 P = (XPGCONN (conn))->pgconn; | |
1552 CHECK_LIVE_CONNECTION (P); | |
1553 | |
1554 ret = PQgetlineAsync (P, buffer, sizeof (buffer)); | |
1555 | |
1556 if (ret == -1) return Qt; /* done! */ | |
1557 else if (!ret) return Qnil; /* no data yet */ | |
1558 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
|
1559 make_extstring ((Extbyte *) buffer, ret, PG_OS_CODING)); |
996 | 1560 } |
1561 | |
1562 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /* | |
1563 Asynchronous copy out. | |
1564 */ | |
1565 (conn, data)) | |
1566 { | |
1567 /* NULs are not allowed. I don't think this matters at this time. */ | |
1568 PGconn *P; | |
1569 char *c_data; | |
1570 | |
1571 CHECK_PGCONN (conn); | |
1572 CHECK_STRING (data); | |
1573 | |
1574 P = (XPGCONN (conn))->pgconn; | |
1575 CHECK_LIVE_CONNECTION (P); | |
1576 TO_EXTERNAL_FORMAT (LISP_STRING, data, | |
1577 C_STRING_ALLOCA, c_data, Qnative); | |
1578 | |
1579 return !PQputnbytes (P, c_data, strlen (c_data)) ? Qt : Qnil; | |
1580 } | |
1581 | |
1582 DEFUN ("pq-end-copy", Fpq_end_copy, 1, 1, 0, /* | |
1583 End a copying operation. | |
1584 */ | |
1585 (conn)) | |
1586 { | |
1587 PGconn *P; | |
1588 | |
1589 CHECK_PGCONN (conn); | |
1590 P = (XPGCONN (conn))->pgconn; | |
1591 CHECK_LIVE_CONNECTION (P); | |
1592 | |
1593 return PQendcopy (P) ? Qt : Qnil; | |
1594 } | |
1595 | |
1596 void | |
1597 syms_of_postgresql(void) | |
1598 { | |
1599 #ifndef RUNNING_XEMACS_21_1 | |
1600 INIT_LRECORD_IMPLEMENTATION (pgconn); | |
1601 INIT_LRECORD_IMPLEMENTATION (pgresult); | |
1602 #endif | |
1603 DEFSYMBOL (Qpostgresql); | |
1604 | |
1605 /* opaque exported types */ | |
1606 DEFSYMBOL (Qpgconnp); | |
1607 DEFSYMBOL (Qpgresultp); | |
1608 | |
1609 /* connection status types */ | |
1610 defsymbol (&Qpg_connection_ok, "pg::connection-ok"); | |
1611 defsymbol (&Qpg_connection_bad, "pg::connection-bad"); | |
1612 defsymbol (&Qpg_connection_started, "pg::connection-started"); | |
1613 defsymbol (&Qpg_connection_made, "pg::connection-made"); | |
1614 defsymbol (&Qpg_connection_awaiting_response, "pg::connection-awaiting-response"); | |
1615 defsymbol (&Qpg_connection_auth_ok, "pg::connection-auth-ok"); | |
1616 defsymbol (&Qpg_connection_setenv, "pg::connection-setenv"); | |
1617 | |
1618 /* Fields of PGconn */ | |
1619 defsymbol (&Qpqdb, "pq::db"); | |
1620 defsymbol (&Qpquser, "pq::user"); | |
1621 defsymbol (&Qpqpass, "pq::pass"); | |
1622 defsymbol (&Qpqhost, "pq::host"); | |
1623 defsymbol (&Qpqport, "pq::port"); | |
1624 defsymbol (&Qpqtty, "pq::tty"); | |
1625 defsymbol (&Qpqoptions, "pq::options"); | |
1626 defsymbol (&Qpqstatus, "pq::status"); | |
1627 defsymbol (&Qpqerrormessage, "pq::error-message"); | |
1628 defsymbol (&Qpqbackendpid, "pq::backend-pid"); | |
1629 | |
1630 /* Query status results */ | |
1631 defsymbol (&Qpgres_empty_query, "pgres::empty-query"); | |
1632 defsymbol (&Qpgres_command_ok, "pgres::command-ok"); | |
1633 defsymbol (&Qpgres_tuples_ok, "pgres::tuples-ok"); | |
1634 defsymbol (&Qpgres_copy_out, "pgres::copy-out"); | |
1635 defsymbol (&Qpgres_copy_in, "pgres::copy-in"); | |
1636 defsymbol (&Qpgres_bad_response, "pgres::bad-response"); | |
1637 defsymbol (&Qpgres_nonfatal_error, "pgres::nonfatal-error"); | |
1638 defsymbol (&Qpgres_fatal_error, "pgres::fatal-error"); | |
1639 | |
1640 /* Poll status results */ | |
1641 defsymbol (&Qpgres_polling_failed, "pgres::polling-failed"); | |
1642 defsymbol (&Qpgres_polling_reading, "pgres::polling-reading"); | |
1643 defsymbol (&Qpgres_polling_writing, "pgres::polling-writing"); | |
1644 defsymbol (&Qpgres_polling_ok, "pgres::polling-ok"); | |
1645 defsymbol (&Qpgres_polling_active, "pgres::polling-active"); | |
1646 | |
1647 #ifdef HAVE_POSTGRESQLV7 | |
1648 DEFSUBR (Fpq_connect_start); | |
1649 DEFSUBR (Fpq_connect_poll); | |
1650 #ifdef MULE | |
1651 DEFSUBR (Fpq_client_encoding); | |
1652 DEFSUBR (Fpq_set_client_encoding); | |
1653 #endif /* MULE */ | |
1654 #endif /* HAVE_POSTGRESQLV7 */ | |
1655 DEFSUBR (Fpq_conn_defaults); | |
1656 DEFSUBR (Fpq_connectdb); | |
1657 DEFSUBR (Fpq_finish); | |
1658 DEFSUBR (Fpq_clear); | |
1659 DEFSUBR (Fpq_is_busy); | |
1660 DEFSUBR (Fpq_consume_input); | |
1661 | |
1662 DEFSUBR (Fpq_reset); | |
1663 #ifdef HAVE_POSTGRESQLV7 | |
1664 DEFSUBR (Fpq_reset_start); | |
1665 DEFSUBR (Fpq_reset_poll); | |
1666 #endif | |
1667 DEFSUBR (Fpq_request_cancel); | |
1668 DEFSUBR (Fpq_pgconn); | |
1669 | |
1670 DEFSUBR (Fpq_exec); | |
1671 DEFSUBR (Fpq_send_query); | |
1672 DEFSUBR (Fpq_get_result); | |
1673 DEFSUBR (Fpq_result_status); | |
1674 DEFSUBR (Fpq_res_status); | |
1675 DEFSUBR (Fpq_result_error_message); | |
1676 DEFSUBR (Fpq_ntuples); | |
1677 DEFSUBR (Fpq_nfields); | |
1678 DEFSUBR (Fpq_binary_tuples); | |
1679 DEFSUBR (Fpq_fname); | |
1680 DEFSUBR (Fpq_fnumber); | |
1681 DEFSUBR (Fpq_ftype); | |
1682 DEFSUBR (Fpq_fsize); | |
1683 DEFSUBR (Fpq_fmod); | |
1684 /***/ | |
1685 DEFSUBR (Fpq_get_value); | |
1686 DEFSUBR (Fpq_get_length); | |
1687 DEFSUBR (Fpq_get_is_null); | |
1688 DEFSUBR (Fpq_cmd_status); | |
1689 DEFSUBR (Fpq_cmd_tuples); | |
1690 DEFSUBR (Fpq_oid_value); | |
1691 | |
1692 #ifdef HAVE_POSTGRESQLV7 | |
1693 DEFSUBR (Fpq_set_nonblocking); | |
1694 DEFSUBR (Fpq_is_nonblocking); | |
1695 DEFSUBR (Fpq_flush); | |
1696 #endif | |
1697 DEFSUBR (Fpq_notifies); | |
1698 | |
1699 #if defined (HAVE_POSTGRESQLV7) && defined(MULE) | |
1700 DEFSUBR (Fpq_env_2_encoding); | |
1701 #endif | |
1702 | |
1703 DEFSUBR (Fpq_lo_import); | |
1704 DEFSUBR (Fpq_lo_export); | |
1705 | |
1706 DEFSUBR (Fpq_make_empty_pgresult); | |
1707 | |
1708 /* copy in/out functions */ | |
1709 DEFSUBR (Fpq_get_line); | |
1710 DEFSUBR (Fpq_put_line); | |
1711 DEFSUBR (Fpq_get_line_async); | |
1712 DEFSUBR (Fpq_put_nbytes); | |
1713 DEFSUBR (Fpq_end_copy); | |
1714 } | |
1715 | |
1716 void | |
1717 vars_of_postgresql(void) | |
1718 { | |
1719 Fprovide (Qpostgresql); | |
1720 #ifdef HAVE_POSTGRESQLV7 | |
1721 Fprovide (intern ("postgresqlv7")); | |
1722 #endif | |
1723 #ifndef RUNNING_XEMACS_21_1 | |
1724 Vpg_coding_system = Qnative; | |
1725 DEFVAR_LISP ("pg-coding-system", &Vpg_coding_system /* | |
1726 Default Postgres client coding system. | |
1727 */ ); | |
1728 #endif | |
1729 | |
1730 DEFVAR_LISP ("pg:host", &VXPGHOST /* | |
1731 Default PostgreSQL server name. | |
1732 If not set, the server running on the local host is used. The | |
1733 initial value is set from the PGHOST environment variable. | |
1734 */ ); | |
1735 | |
1736 DEFVAR_LISP ("pg:user", &VXPGUSER /* | |
1737 Default PostgreSQL user name. | |
1738 This value is used when connecting to a database for authentication. | |
1739 The initial value is set from the PGUSER environment variable. | |
1740 */ ); | |
1741 | |
1742 DEFVAR_LISP ("pg:options", &VXPGOPTIONS /* | |
1743 Default PostgreSQL user name. | |
1744 This value is used when connecting to a database for authentication. | |
1745 The initial value is set from the PGUSER environment variable. | |
1746 */ ); | |
1747 | |
1748 DEFVAR_LISP ("pg:port", &VXPGPORT /* | |
1749 Default port to connect to PostgreSQL backend. | |
1750 This value is used when connecting to a database. | |
1751 The initial value is set from the PGPORT environment variable. | |
1752 */ ); | |
1753 | |
1754 DEFVAR_LISP ("pg:tty", &VXPGTTY /* | |
1755 Default debugging TTY. | |
1756 There is no useful setting of this variable in the XEmacs Lisp API. | |
1757 The initial value is set from the PGTTY environment variable. | |
1758 */ ); | |
1759 | |
1760 DEFVAR_LISP ("pg:database", &VXPGDATABASE /* | |
1761 Default database to connect to. | |
1762 The initial value is set from the PGDATABASE environment variable. | |
1763 */ ); | |
1764 | |
1765 DEFVAR_LISP ("pg:realm", &VXPGREALM /* | |
1766 Default kerberos realm to use for authentication. | |
1767 The initial value is set from the PGREALM environment variable. | |
1768 */ ); | |
1769 | |
1770 #ifdef MULE | |
1771 /* It's not clear whether this is any use. My intent is to | |
1772 autodetect the coding system from the database. */ | |
1773 DEFVAR_LISP ("pg:client-encoding", &VXPGCLIENTENCODING /* | |
1774 Default client encoding to use. | |
1775 The initial value is set from the PGCLIENTENCODING environment variable. | |
1776 */ ); | |
1777 #endif | |
1778 | |
1779 #if !defined(HAVE_POSTGRESQLV7) | |
1780 DEFVAR_LISP ("pg:authtype", &VXPGAUTHTYPE /* | |
1781 Default authentication to use. | |
1782 The initial value is set from the PGAUTHTYPE environment variable. | |
1783 | |
1784 WARNING: This variable has gone away in versions of PostgreSQL newer | |
1785 than 6.5. | |
1786 */ ); | |
1787 #endif | |
1788 | |
1789 DEFVAR_LISP ("pg:geqo", &VXPGGEQO /* | |
1790 Genetic Query Optimizer options. | |
1791 The initial value is set from the PGGEQO environment variable. | |
1792 */ ); | |
1793 | |
1794 DEFVAR_LISP ("pg:cost-index", &VXPGCOSTINDEX /* | |
1795 Default cost index options. | |
1796 The initial value is set from the PGCOSTINDEX environment variable. | |
1797 */ ); | |
1798 | |
1799 DEFVAR_LISP ("pg:cost-heap", &VXPGCOSTHEAP /* | |
1800 Default cost heap options. | |
1801 The initial value is set from the PGCOSTHEAP environment variable. | |
1802 */ ); | |
1803 | |
1804 DEFVAR_LISP ("pg:tz", &VXPGTZ /* | |
1805 Default timezone to use. | |
1806 The initial value is set from the PGTZ environment variable. | |
1807 */ ); | |
1808 | |
1809 DEFVAR_LISP ("pg:date-style", &VXPGDATESTYLE /* | |
1810 Default date style to use. | |
1811 The initial value is set from the PGDATESTYLE environment variable. | |
1812 */ ); | |
1813 | |
1814 #ifdef HAVE_SHLIB | |
1815 /* If we are building this as a module, we need the initializing function to | |
1816 run at module load time. */ | |
1817 init_postgresql_from_environment (); | |
1818 #endif | |
1819 } | |
1820 | |
1821 /* These initializations should not be done at dump-time. */ | |
1822 void | |
1823 init_postgresql_from_environment (void) | |
1824 { | |
1825 Ibyte *p; | |
1826 | |
1827 #define FROB(envvar, var) \ | |
1828 if ((p = egetenv (envvar))) \ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1829 var = build_istring (p); \ |
996 | 1830 else \ |
1831 var = Qnil | |
1832 | |
1833 if (initialized) | |
1834 { | |
1835 FROB ("PGHOST", VXPGHOST); | |
1836 FROB ("PGUSER", VXPGUSER); | |
1837 FROB ("PGOPTIONS", VXPGOPTIONS); | |
1838 | |
1839 if ((p = egetenv ("PGPORT"))) | |
1840 VXPGPORT = make_int (atoi ((char *) p)); | |
1841 else | |
1842 VXPGPORT = Qnil; | |
1843 | |
1844 FROB ("PGTTY", VXPGTTY); | |
1845 FROB ("PGDATABASE", VXPGDATABASE); | |
1846 FROB ("PGREALM", VXPGREALM); | |
1847 #ifdef MULE | |
1848 /* It's not clear whether this is any use. My intent is to | |
1849 autodetect the coding system from the database. */ | |
1850 FROB ("PGCLIENTENCODING", VXPGCLIENTENCODING); | |
1851 #endif | |
1852 | |
1853 #if !defined(HAVE_POSTGRESQLV7) | |
1854 FROB ("PGAUTHTYPE", VXPGAUTHTYPE); | |
1855 #endif | |
1856 | |
1857 FROB ("PGGEQO", VXPGGEQO); | |
1858 FROB ("PGCOSTINDEX", VXPGCOSTINDEX); | |
1859 FROB ("PGCOSTHEAP", VXPGCOSTHEAP); | |
1860 FROB ("PGTZ", VXPGTZ); | |
1861 FROB ("PGDATESTYLE", VXPGDATESTYLE); | |
1862 #undef FROB | |
1863 } | |
1864 } | |
1865 | |
1866 #ifdef HAVE_SHLIB | |
1706 | 1867 EXTERN_C void unload_postgresql (void); |
996 | 1868 void |
1869 unload_postgresql (void) | |
1870 { | |
1871 #ifndef RUNNING_XEMACS_21_1 | |
1872 /* Remove defined types */ | |
1873 UNDEF_LRECORD_IMPLEMENTATION (pgconn); | |
1874 UNDEF_LRECORD_IMPLEMENTATION (pgresult); | |
1875 #endif | |
1876 | |
1877 /* Remove staticpro'ing of symbols */ | |
1878 unstaticpro_nodump (&Qpostgresql); | |
1879 unstaticpro_nodump (&Qpgconnp); | |
1880 unstaticpro_nodump (&Qpgresultp); | |
1881 unstaticpro_nodump (&Qpg_connection_ok); | |
1882 unstaticpro_nodump (&Qpg_connection_bad); | |
1883 unstaticpro_nodump (&Qpg_connection_started); | |
1884 unstaticpro_nodump (&Qpg_connection_made); | |
1885 unstaticpro_nodump (&Qpg_connection_awaiting_response); | |
1886 unstaticpro_nodump (&Qpg_connection_auth_ok); | |
1887 unstaticpro_nodump (&Qpg_connection_setenv); | |
1888 unstaticpro_nodump (&Qpqdb); | |
1889 unstaticpro_nodump (&Qpquser); | |
1890 unstaticpro_nodump (&Qpqpass); | |
1891 unstaticpro_nodump (&Qpqhost); | |
1892 unstaticpro_nodump (&Qpqport); | |
1893 unstaticpro_nodump (&Qpqtty); | |
1894 unstaticpro_nodump (&Qpqoptions); | |
1895 unstaticpro_nodump (&Qpqstatus); | |
1896 unstaticpro_nodump (&Qpqerrormessage); | |
1897 unstaticpro_nodump (&Qpqbackendpid); | |
1898 unstaticpro_nodump (&Qpgres_empty_query); | |
1899 unstaticpro_nodump (&Qpgres_command_ok); | |
1900 unstaticpro_nodump (&Qpgres_tuples_ok); | |
1901 unstaticpro_nodump (&Qpgres_copy_out); | |
1902 unstaticpro_nodump (&Qpgres_copy_in); | |
1903 unstaticpro_nodump (&Qpgres_bad_response); | |
1904 unstaticpro_nodump (&Qpgres_nonfatal_error); | |
1905 unstaticpro_nodump (&Qpgres_fatal_error); | |
1906 unstaticpro_nodump (&Qpgres_polling_failed); | |
1907 unstaticpro_nodump (&Qpgres_polling_reading); | |
1908 unstaticpro_nodump (&Qpgres_polling_writing); | |
1909 unstaticpro_nodump (&Qpgres_polling_ok); | |
1910 unstaticpro_nodump (&Qpgres_polling_active); | |
1911 } | |
1912 #endif /* HAVE_SHLIB */ |