Mercurial > hg > xemacs-beta
annotate modules/postgresql/postgresql.c @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | b5df3737028a |
| children | 0dcd22290039 |
| 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 */ | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
93 #if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION <= 1) |
| 996 | 94 #define RUNNING_XEMACS_21_1 1 |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
95 #elif (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION <= 4) |
|
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
96 #define RUNNING_XEMACS_21_4 1 |
| 996 | 97 #endif |
| 98 | |
| 99 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */ | |
| 100 | |
| 101 #include "lisp.h" | |
| 102 | |
| 103 #include "buffer.h" | |
| 104 #include "postgresql.h" | |
| 105 #include "process.h" | |
| 1632 | 106 #ifdef HAVE_SHLIB |
| 107 # include "emodules.h" | |
| 108 #endif | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
109 #include "sysdep.h" |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
110 #include "sysfile.h" |
| 996 | 111 |
| 112 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */ | |
| 113 #define PG_OS_CODING FORMAT_FILENAME | |
| 114 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to) | |
| 115 #else | |
| 116 #ifdef MULE | |
| 117 #define PG_OS_CODING get_coding_system_for_text_file (Vpg_coding_system, 1) | |
| 118 #else | |
| 119 #define PG_OS_CODING Qnative | |
| 120 #endif | |
| 121 Lisp_Object Vpg_coding_system; | |
| 122 #endif | |
| 123 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
124 #define CHECK_LIVE_CONNECTION(P) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
125 do \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
126 { \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
127 if (!P || (PQstatus (P) != CONNECTION_OK)) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
128 { \ |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
129 Lisp_Object err; \ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
130 \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
131 if (P) \ |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
132 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
|
133 else \ |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
134 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
|
135 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
|
136 } \ |
|
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 while (0) |
|
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 #define PUKE_IF_NULL(p) \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
141 do \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
142 { \ |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
143 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
|
144 } \ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
145 while (0) |
| 996 | 146 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
147 #define SIGNAL_ERROR(p, reason) \ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
148 do \ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
149 { \ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
150 signal_error (Qprocess_error, reason, \ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
151 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
|
152 } \ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
153 while (0) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
154 |
| 996 | 155 static Lisp_Object VXPGHOST; |
| 156 static Lisp_Object VXPGUSER; | |
| 157 static Lisp_Object VXPGOPTIONS; | |
| 158 static Lisp_Object VXPGPORT; | |
| 159 static Lisp_Object VXPGTTY; /* This needs to be blanked! */ | |
| 160 static Lisp_Object VXPGDATABASE; | |
| 161 static Lisp_Object VXPGREALM; | |
| 162 #ifdef MULE | |
| 163 static Lisp_Object VXPGCLIENTENCODING; | |
| 164 #endif /* MULE */ | |
| 165 | |
| 166 /* Other variables: | |
| 167 PGAUTHTYPE -- not used after PostgreSQL 6.5 | |
| 168 PGGEQO | |
| 169 PGCOSTINDEX | |
| 170 PGCOSTHEAP | |
| 171 PGTZ | |
| 172 PGDATESTYLE | |
| 173 */ | |
| 174 #ifndef HAVE_POSTGRESQLV7 | |
| 175 static Lisp_Object VXPGAUTHTYPE; | |
| 176 #endif | |
| 177 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE; | |
| 178 | |
| 179 static Lisp_Object Qpostgresql; | |
| 180 static Lisp_Object Qpg_connection_ok, Qpg_connection_bad; | |
| 181 static Lisp_Object Qpg_connection_started, Qpg_connection_made; | |
| 182 static Lisp_Object Qpg_connection_awaiting_response, Qpg_connection_auth_ok; | |
| 183 static Lisp_Object Qpg_connection_setenv; | |
| 184 | |
| 185 static Lisp_Object Qpqdb, Qpquser, Qpqpass, Qpqhost, Qpqport, Qpqtty; | |
| 186 static Lisp_Object Qpqoptions, Qpqstatus, Qpqerrormessage, Qpqbackendpid; | |
| 187 | |
| 188 static Lisp_Object Qpgres_empty_query, Qpgres_command_ok, Qpgres_tuples_ok; | |
| 189 static Lisp_Object Qpgres_copy_out, Qpgres_copy_in, Qpgres_bad_response; | |
| 190 static Lisp_Object Qpgres_nonfatal_error, Qpgres_fatal_error; | |
| 191 | |
| 192 static Lisp_Object Qpgres_polling_failed, Qpgres_polling_reading; | |
| 193 static Lisp_Object Qpgres_polling_writing, Qpgres_polling_ok; | |
| 194 static Lisp_Object Qpgres_polling_active; | |
| 195 /****/ | |
| 196 | |
| 197 /* PGconn is an opaque object and we need to be able to store them in | |
| 198 Lisp code because libpq supports multiple connections. | |
| 199 */ | |
| 200 Lisp_Object Qpgconnp; | |
| 201 | |
| 202 static Lisp_Object | |
| 203 make_pgconn (Lisp_PGconn *pgconn) | |
| 204 { | |
| 205 return wrap_pgconn (pgconn); | |
| 206 } | |
| 207 | |
| 1204 | 208 static const struct memory_description pgconn_description [] = { |
| 996 | 209 { XD_END } |
| 210 }; | |
| 211 | |
| 212 static Lisp_Object | |
| 213 #ifdef RUNNING_XEMACS_21_1 | |
| 2286 | 214 mark_pgconn (Lisp_Object UNUSED (obj), |
| 215 void (*UNUSED_ARG (markobj)) (Lisp_Object) ATTRIBUTE_UNUSED) | |
| 996 | 216 #else |
| 2286 | 217 mark_pgconn (Lisp_Object UNUSED (obj)) |
| 996 | 218 #endif |
| 219 { | |
| 220 return Qnil; | |
| 221 } | |
| 222 | |
| 223 static void | |
| 2286 | 224 print_pgconn (Lisp_Object obj, Lisp_Object printcharfun, |
| 225 int UNUSED (escapeflag)) | |
| 996 | 226 { |
| 227 char buf[256]; | |
| 228 PGconn *P; | |
| 229 ConnStatusType cst; | |
| 4932 | 230 const char *host="", *db="", *user="", *port=""; |
| 996 | 231 |
| 232 P = (XPGCONN (obj))->pgconn; | |
| 233 | |
| 234 if (!P) /* this may happen since we allow PQfinish() to be called */ | |
| 235 strcpy (buf, "#<PGconn DEAD>"); /* evil! */ | |
| 236 else if ((cst = PQstatus (P)) == CONNECTION_OK) | |
| 237 { | |
| 238 if (!(host = PQhost (P))) | |
| 239 host = ""; | |
| 240 port = PQport (P); | |
| 241 db = PQdb (P); | |
| 242 if (!(user = PQuser (P))) | |
| 243 user = ""; | |
| 244 sprintf (buf, "#<PGconn %s:%s %s/%s>", /* evil! */ | |
| 245 !strlen (host) ? "localhost" : host, | |
| 246 port, | |
| 247 user, | |
| 248 db); | |
| 249 } | |
| 250 else if (cst == CONNECTION_BAD) | |
| 251 strcpy (buf, "#<PGconn BAD>"); /* evil! */ | |
| 252 else | |
| 253 strcpy (buf, "#<PGconn connecting>"); /* evil! */ | |
| 254 | |
| 255 if (print_readably) | |
| 256 printing_unreadable_object ("%s", buf); | |
| 257 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
258 write_cistring (printcharfun, buf); |
| 996 | 259 } |
| 260 | |
| 261 static Lisp_PGconn * | |
| 262 allocate_pgconn (void) | |
| 263 { | |
| 264 #ifdef RUNNING_XEMACS_21_1 | |
| 3024 | 265 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, |
| 996 | 266 lrecord_pgconn); |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
267 #elif defined (RUNNING_XEMACS_21_4) |
| 3024 | 268 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, |
| 996 | 269 &lrecord_pgconn); |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
270 #else |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
271 Lisp_PGconn *pgconn = XPGCONN (ALLOC_NORMAL_LISP_OBJECT (pgconn)); |
| 996 | 272 #endif |
| 273 pgconn->pgconn = (PGconn *)NULL; | |
| 274 return pgconn; | |
| 275 } | |
| 276 | |
| 5125 | 277 #ifdef RUNNING_XEMACS_21_4 |
| 278 | |
| 996 | 279 static void |
| 280 finalize_pgconn (void *header, int for_disksave) | |
| 281 { | |
| 282 Lisp_PGconn *pgconn = (Lisp_PGconn *)header; | |
| 283 | |
| 284 if (for_disksave) | |
| 285 invalid_operation ("Can't dump an emacs containing PGconn objects", | |
| 286 make_pgconn (pgconn)); | |
| 287 | |
| 288 if (pgconn->pgconn) | |
| 289 { | |
| 290 PQfinish (pgconn->pgconn); | |
| 291 pgconn->pgconn = (PGconn *)NULL; | |
| 292 } | |
| 293 } | |
| 294 | |
| 5125 | 295 #else /* not RUNNING_XEMACS_21_4 */ |
| 296 | |
| 297 static void | |
| 298 finalize_pgconn (void *header) | |
| 299 { | |
| 300 Lisp_PGconn *pgconn = (Lisp_PGconn *)header; | |
| 301 | |
| 302 if (pgconn->pgconn) | |
| 303 { | |
| 304 PQfinish (pgconn->pgconn); | |
| 305 pgconn->pgconn = (PGconn *)NULL; | |
| 306 } | |
| 307 } | |
| 308 | |
| 309 #endif /* (not) RUNNING_XEMACS_21_4 */ | |
| 310 | |
| 996 | 311 #ifdef RUNNING_XEMACS_21_1 |
| 312 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, | |
| 313 mark_pgconn, print_pgconn, finalize_pgconn, | |
| 314 NULL, NULL, | |
| 315 Lisp_PGconn); | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
316 #elif defined (RUNNING_XEMACS_21_4) |
| 996 | 317 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, |
| 318 0, /*dumpable-flag*/ | |
| 319 mark_pgconn, print_pgconn, finalize_pgconn, | |
| 320 NULL, NULL, | |
| 321 pgconn_description, | |
| 322 Lisp_PGconn); | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
323 #else |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
324 DEFINE_NODUMP_LISP_OBJECT ("pgconn", pgconn, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
325 mark_pgconn, print_pgconn, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
326 finalize_pgconn, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
327 NULL, NULL, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
328 pgconn_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
329 Lisp_PGconn); |
| 996 | 330 #endif |
| 331 /****/ | |
| 332 | |
| 333 /* PGresult is an opaque object and we need to be able to store them in | |
| 334 Lisp code. | |
| 335 */ | |
| 336 Lisp_Object Qpgresultp; | |
| 337 | |
| 338 static Lisp_Object | |
| 339 make_pgresult (Lisp_PGresult *pgresult) | |
| 340 { | |
| 341 return wrap_pgresult (pgresult); | |
| 342 } | |
| 343 | |
| 1204 | 344 static const struct memory_description pgresult_description [] = { |
| 996 | 345 { XD_END } |
| 346 }; | |
| 347 | |
| 348 | |
| 349 static Lisp_Object | |
| 350 #ifdef RUNNING_XEMACS_21_1 | |
| 2286 | 351 mark_pgresult (Lisp_Object UNUSED (obj), |
| 352 void (*UNUSED_ARG (markobj)) (Lisp_Object) ATTRIBUTE_UNUSED) | |
| 996 | 353 #else |
| 2286 | 354 mark_pgresult (Lisp_Object UNUSED (obj)) |
| 996 | 355 #endif |
| 356 { | |
| 357 return Qnil; | |
| 358 } | |
| 359 | |
| 360 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>" | |
| 361 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>" | |
| 362 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>" | |
| 363 static void | |
| 2286 | 364 print_pgresult (Lisp_Object obj, Lisp_Object printcharfun, |
| 365 int UNUSED (escapeflag)) | |
| 996 | 366 { |
| 367 char buf[1024]; | |
| 368 PGresult *res; | |
| 369 | |
| 370 res = (XPGRESULT (obj))->pgresult; | |
| 371 | |
| 372 if (res) | |
| 373 { | |
| 374 switch (PQresultStatus (res)) | |
| 375 { | |
| 376 case PGRES_TUPLES_OK: | |
| 377 /* Add number of tuples of result to output */ | |
| 378 sprintf (buf, RESULT_TUPLES_FMT, /* evil! */ | |
| 379 PQresStatus (PQresultStatus (res)), | |
| 380 PQntuples (res), | |
| 381 PQcmdStatus (res)); | |
| 382 break; | |
| 383 case PGRES_COMMAND_OK: | |
| 384 /* Add number of tuples affected by output-less command */ | |
| 385 if (!strlen (PQcmdTuples (res))) goto notuples; | |
| 386 sprintf (buf, RESULT_CMD_TUPLES_FMT, /* evil! */ | |
| 387 PQresStatus (PQresultStatus (res)), | |
| 388 PQcmdTuples (res), | |
| 389 PQcmdStatus (res)); | |
| 390 break; | |
| 391 default: | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
392 notuples: |
| 996 | 393 /* No counts to print */ |
| 394 sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */ | |
| 395 PQresStatus (PQresultStatus (res)), | |
| 396 PQcmdStatus (res)); | |
| 397 break; | |
| 398 } | |
| 399 } | |
| 400 else | |
| 401 strcpy (buf, "#<PGresult DEAD>"); /* evil! */ | |
| 402 | |
| 403 if (print_readably) | |
| 404 printing_unreadable_object ("%s", buf); | |
| 405 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
406 write_cistring (printcharfun, buf); |
| 996 | 407 } |
| 408 | |
| 409 #undef RESULT_TUPLES_FMT | |
| 410 #undef RESULT_CMD_TUPLES_FMT | |
| 411 #undef RESULT_DEFAULT_FMT | |
| 412 | |
| 413 static Lisp_PGresult * | |
| 414 allocate_pgresult (void) | |
| 415 { | |
| 416 #ifdef RUNNING_XEMACS_21_1 | |
| 3024 | 417 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, |
| 996 | 418 lrecord_pgresult); |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
419 #elif defined (RUNNING_XEMACS_21_4) |
| 3024 | 420 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, |
| 996 | 421 &lrecord_pgresult); |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
422 #else |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
423 Lisp_PGresult *pgresult = XPGRESULT (ALLOC_NORMAL_LISP_OBJECT (pgresult)); |
| 996 | 424 #endif |
| 425 pgresult->pgresult = (PGresult *)NULL; | |
| 426 return pgresult; | |
| 427 } | |
| 428 | |
| 5125 | 429 #ifdef RUNNING_XEMACS_21_4 |
| 430 | |
| 996 | 431 static void |
| 432 finalize_pgresult (void *header, int for_disksave) | |
| 433 { | |
| 434 Lisp_PGresult *pgresult = (Lisp_PGresult *)header; | |
| 435 | |
| 436 if (for_disksave) | |
| 437 invalid_operation ("Can't dump an emacs containing PGresult objects", | |
| 438 make_pgresult (pgresult)); | |
| 439 | |
| 440 if (pgresult->pgresult) | |
| 441 { | |
| 442 PQclear (pgresult->pgresult); | |
| 443 pgresult->pgresult = (PGresult *)NULL; | |
| 444 } | |
| 445 } | |
| 446 | |
| 5125 | 447 #else /* not RUNNING_XEMACS_21_4 */ |
| 448 | |
| 449 static void | |
| 450 finalize_pgresult (void *header) | |
| 451 { | |
| 452 Lisp_PGresult *pgresult = (Lisp_PGresult *)header; | |
| 453 | |
| 454 if (pgresult->pgresult) | |
| 455 { | |
| 456 PQclear (pgresult->pgresult); | |
| 457 pgresult->pgresult = (PGresult *)NULL; | |
| 458 } | |
| 459 } | |
| 460 | |
| 461 #endif /* (not) RUNNING_XEMACS_21_4 */ | |
| 462 | |
| 996 | 463 #ifdef RUNNING_XEMACS_21_1 |
| 464 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, | |
| 465 mark_pgresult, print_pgresult, finalize_pgresult, | |
| 466 NULL, NULL, | |
| 467 Lisp_PGresult); | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
468 #elif defined (RUNNING_XEMACS_21_4) |
| 996 | 469 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, |
| 470 0, /*dumpable-flag*/ | |
| 471 mark_pgresult, print_pgresult, finalize_pgresult, | |
| 472 NULL, NULL, | |
| 473 pgresult_description, | |
| 474 Lisp_PGresult); | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
475 #else |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
476 DEFINE_NODUMP_LISP_OBJECT ("pgresult", pgresult, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
477 mark_pgresult, print_pgresult, finalize_pgresult, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
478 NULL, NULL, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
479 pgresult_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
480 Lisp_PGresult); |
| 996 | 481 #endif |
| 482 | |
| 483 /***********************/ | |
| 484 | |
| 485 /* notices */ | |
| 486 static void | |
| 2286 | 487 xemacs_notice_processor (void *UNUSED (arg), const char *msg) |
| 996 | 488 { |
| 489 warn_when_safe (Qpostgresql, Qnotice, "%s", msg); | |
| 490 } | |
| 491 | |
| 492 /* There are four ways (as of PostgreSQL v7) to connect to a database. | |
| 493 Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those | |
| 494 routines take a number of positional parameters and are better done in Lisp. | |
| 495 Note that PQconnectStart does not exist prior to v7. | |
| 496 */ | |
| 497 | |
| 498 /* ###autoload */ | |
| 499 DEFUN ("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /* | |
| 500 Return a connection default structure. | |
| 501 */ | |
| 502 ()) | |
| 503 { | |
| 504 /* This function can GC */ | |
| 505 PQconninfoOption *pcio; | |
| 506 Lisp_Object temp, temp1; | |
| 507 int i; | |
| 508 | |
| 509 pcio = PQconndefaults(); | |
| 510 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
|
511 temp = |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
512 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
|
513 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
|
514 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
|
515 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
|
516 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
|
517 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
|
518 make_int (pcio[0].dispsize)))); |
| 996 | 519 |
| 520 for (i = 1; pcio[i].keyword; i++) | |
| 521 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
522 temp1 = |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
523 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
|
524 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
|
525 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
|
526 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
|
527 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
|
528 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
|
529 make_int (pcio[i].dispsize)))); |
| 996 | 530 { |
| 531 Lisp_Object args[2]; | |
| 532 args[0] = temp; | |
| 533 args[1] = temp1; | |
| 534 /* Fappend GCPROs its arguments */ | |
| 535 temp = Fappend (2, args); | |
| 536 } | |
| 537 } | |
| 538 | |
| 539 return temp; | |
| 540 } | |
| 541 | |
| 542 /* PQconnectdb Makes a new connection to a backend. | |
| 543 PGconn *PQconnectdb(const char *conninfo) | |
| 544 */ | |
| 545 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
546 #ifdef HAVE_POSTGRESQLV7 |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
547 #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
|
548 #else |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
549 #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
|
550 #endif |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
551 |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
552 static Lisp_Object |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
553 postgresql_connect (Lisp_Object conninfo, int USED_IF_V7 (async)) |
| 996 | 554 { |
| 555 PGconn *P; | |
| 556 Lisp_PGconn *lisp_pgconn; | |
| 557 | |
| 558 CHECK_STRING (conninfo); | |
| 559 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
560 P = ( |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
561 #ifdef HAVE_POSTGRESQLV7 |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
562 async ? PQconnectStart : |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
563 #endif |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
564 PQconnectdb) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
565 (LISP_STRING_TO_EXTERNAL (conninfo, PG_OS_CODING)); |
| 996 | 566 if (P && (PQstatus (P) == CONNECTION_OK)) |
| 567 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
568 (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
|
569 lisp_pgconn = allocate_pgconn (); |
| 996 | 570 lisp_pgconn->pgconn = P; |
| 571 return make_pgconn (lisp_pgconn); | |
| 572 } | |
| 573 else | |
| 574 { | |
| 575 /* 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
|
576 |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
577 Lisp_Object errmsg; |
| 996 | 578 if (P) |
| 579 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
580 errmsg = build_extstring (PQerrorMessage (P), PG_OS_CODING); |
| 996 | 581 PQfinish (P); |
| 582 } | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
583 else |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
584 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
|
585 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
|
586 errmsg); |
| 996 | 587 } |
| 588 } | |
| 589 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
590 /* ###autoload */ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
591 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
|
592 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
|
593 */ |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
594 (conninfo)) |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
595 { |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
596 return postgresql_connect (conninfo, 0); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
597 } |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
598 |
| 996 | 599 /* PQconnectStart Makes a new asynchronous connection to a backend. |
| 600 PGconn *PQconnectStart(const char *conninfo) | |
| 601 */ | |
| 602 | |
| 603 #ifdef HAVE_POSTGRESQLV7 | |
| 604 /* ###autoload */ | |
| 605 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /* | |
| 606 Make a new asynchronous connection to a PostgreSQL backend. | |
| 607 */ | |
| 608 (conninfo)) | |
| 609 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
610 return postgresql_connect (conninfo, 1); |
| 996 | 611 } |
| 612 | |
| 613 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /* | |
| 614 Poll an asynchronous connection for completion | |
| 615 */ | |
| 616 (conn)) | |
| 617 { | |
| 618 PGconn *P; | |
| 619 PostgresPollingStatusType polling_status; | |
| 620 | |
| 621 CHECK_PGCONN (conn); | |
| 622 | |
| 623 P = (XPGCONN (conn))->pgconn; | |
| 624 CHECK_LIVE_CONNECTION (P); | |
| 625 | |
| 626 polling_status = PQconnectPoll (P); | |
| 627 switch (polling_status) | |
| 628 { | |
| 629 case PGRES_POLLING_FAILED: | |
| 630 /* Something Bad has happened */ | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
631 SIGNAL_ERROR (P, "Polling asynchronous connection"); |
| 996 | 632 case PGRES_POLLING_OK: |
| 633 return Qpgres_polling_ok; | |
| 634 case PGRES_POLLING_READING: | |
| 635 return Qpgres_polling_reading; | |
| 636 case PGRES_POLLING_WRITING: | |
| 637 return Qpgres_polling_writing; | |
| 638 case PGRES_POLLING_ACTIVE: | |
| 639 return Qpgres_polling_active; | |
| 640 default: | |
| 641 /* they've added a new field we don't know about */ | |
| 642 signal_ferror (Qprocess_error, "Help! Unknown status code %08x from backend!", polling_status); | |
| 643 } | |
| 644 } | |
| 645 | |
| 646 #ifdef MULE | |
| 647 DEFUN ("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /* | |
| 648 Return client coding system. | |
| 649 */ | |
| 650 (conn)) | |
| 651 { | |
| 652 PGconn *P; | |
| 653 | |
| 654 CHECK_PGCONN (conn); | |
| 655 P = (XPGCONN (conn))->pgconn; | |
| 656 CHECK_LIVE_CONNECTION (P); | |
| 657 | |
| 658 return make_int (PQclientEncoding (P)); | |
| 659 } | |
| 660 | |
| 661 DEFUN ("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /* | |
| 662 Set client coding system. | |
| 663 */ | |
| 664 (conn, encoding)) | |
| 665 { | |
| 666 PGconn *P; | |
| 667 int rc; | |
| 668 char *c_encoding; | |
| 669 | |
| 670 CHECK_PGCONN (conn); | |
| 671 CHECK_STRING (encoding); | |
| 672 | |
| 673 P = (XPGCONN (conn))->pgconn; | |
| 674 CHECK_LIVE_CONNECTION (P); | |
| 675 | |
| 676 TO_EXTERNAL_FORMAT (LISP_STRING, encoding, | |
| 677 C_STRING_ALLOCA, c_encoding, Qnative); | |
| 678 | |
| 679 if ((rc = PQsetClientEncoding (P, c_encoding)) < 0) | |
| 680 signal_error (Qinvalid_argument, "bad encoding", Qunbound); | |
| 681 else | |
| 682 return make_int (rc); | |
| 683 } | |
| 684 | |
| 685 #endif | |
| 686 #endif /* HAVE_POSTGRESQLV7 */ | |
| 687 | |
| 688 /* PQfinish Close the connection to the backend. Also frees memory | |
| 689 used by the PGconn object. | |
| 690 void PQfinish(PGconn *conn) | |
| 691 */ | |
| 692 DEFUN ("pq-finish", Fpq_finish, 1, 1, 0, /* | |
| 693 Close the connection to the backend. | |
| 694 */ | |
| 695 (conn)) | |
| 696 { | |
| 697 PGconn *P; | |
| 698 | |
| 699 CHECK_PGCONN (conn); | |
| 700 P = (XPGCONN (conn))->pgconn; | |
| 701 PUKE_IF_NULL (P); | |
| 702 | |
| 703 PQfinish (P); | |
| 704 /* #### PQfinish deallocates the PGconn structure, so we now have a | |
| 705 dangling pointer. */ | |
| 706 /* Genocided all @'s ... */ | |
| 707 (XPGCONN (conn))->pgconn = (PGconn *)NULL; /* You feel DEAD inside */ | |
| 708 return Qnil; | |
| 709 } | |
| 710 | |
| 711 DEFUN ("pq-clear", Fpq_clear, 1, 1, 0, /* | |
| 712 Forcibly erase a PGresult object. | |
| 713 */ | |
| 714 (res)) | |
| 715 { | |
| 716 PGresult *R; | |
| 717 | |
| 718 CHECK_PGRESULT (res); | |
| 719 R = (XPGRESULT (res))->pgresult; | |
| 720 PUKE_IF_NULL (R); | |
| 721 | |
| 722 PQclear (R); | |
| 723 /* Genocided all @'s ... */ | |
| 724 (XPGRESULT (res))->pgresult = (PGresult *)NULL; /* You feel DEAD inside */ | |
| 725 | |
| 726 return Qnil; | |
| 727 } | |
| 728 | |
| 729 DEFUN ("pq-is-busy", Fpq_is_busy, 1, 1, 0, /* | |
| 730 Return t if PQgetResult would block waiting for input. | |
| 731 */ | |
| 732 (conn)) | |
| 733 { | |
| 734 PGconn *P; | |
| 735 | |
| 736 CHECK_PGCONN (conn); | |
| 737 P = (XPGCONN (conn))->pgconn; | |
| 738 CHECK_LIVE_CONNECTION (P); | |
| 739 | |
| 740 return PQisBusy (P) ? Qt : Qnil; | |
| 741 } | |
| 742 | |
| 743 DEFUN ("pq-consume-input", Fpq_consume_input, 1, 1, 0, /* | |
| 744 Consume any available input from the backend. | |
| 745 Returns nil if something bad happened. | |
| 746 */ | |
| 747 (conn)) | |
| 748 { | |
| 749 PGconn *P; | |
| 750 | |
| 751 CHECK_PGCONN (conn); | |
| 752 P = (XPGCONN (conn))->pgconn; | |
| 753 CHECK_LIVE_CONNECTION (P); | |
| 754 | |
| 755 return PQconsumeInput (P) ? Qt : Qnil; | |
| 756 } | |
| 757 | |
| 758 /* PQreset Reset the communication port with the backend. | |
| 759 void PQreset(PGconn *conn) | |
| 760 */ | |
| 761 DEFUN ("pq-reset", Fpq_reset, 1, 1, 0, /* | |
| 762 Reset the connection to the backend. | |
| 763 This function will close the connection to the backend and attempt to | |
| 764 reestablish a new connection to the same postmaster, using all the same | |
| 765 parameters previously used. This may be useful for error recovery if a | |
| 766 working connection is lost. | |
| 767 */ | |
| 768 (conn)) | |
| 769 { | |
| 770 PGconn *P; | |
| 771 | |
| 772 CHECK_PGCONN (conn); | |
| 773 P = (XPGCONN (conn))->pgconn; | |
| 774 PUKE_IF_NULL (P);/* we can resurrect a BAD connection, but not a dead one. */ | |
| 775 | |
| 776 PQreset (P); | |
| 777 | |
| 778 return Qnil; | |
| 779 } | |
| 780 | |
| 781 #ifdef HAVE_POSTGRESQLV7 | |
| 782 DEFUN ("pq-reset-start", Fpq_reset_start, 1, 1, 0, /* | |
| 783 Reset connection to the backend asynchronously. | |
| 784 */ | |
| 785 (conn)) | |
| 786 { | |
| 787 PGconn *P; | |
| 788 | |
| 789 CHECK_PGCONN (conn); | |
| 790 P = (XPGCONN (conn))->pgconn; | |
| 791 CHECK_LIVE_CONNECTION (P); | |
| 792 | |
| 793 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
|
794 SIGNAL_ERROR (P, "Resetting connection"); |
| 996 | 795 } |
| 796 | |
| 797 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /* | |
| 798 Poll an asynchronous reset for completion. | |
| 799 */ | |
| 800 (conn)) | |
| 801 { | |
| 802 PGconn *P; | |
| 803 PostgresPollingStatusType polling_status; | |
| 804 | |
| 805 CHECK_PGCONN (conn); | |
| 806 | |
| 807 P = (XPGCONN (conn))->pgconn; | |
| 808 CHECK_LIVE_CONNECTION (P); | |
| 809 | |
| 810 polling_status = PQresetPoll (P); | |
| 811 switch (polling_status) | |
| 812 { | |
| 813 case PGRES_POLLING_FAILED: | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
814 SIGNAL_ERROR (P, "Polling asynchronous reset"); |
| 996 | 815 case PGRES_POLLING_OK: |
| 816 return Qpgres_polling_ok; | |
| 817 case PGRES_POLLING_READING: | |
| 818 return Qpgres_polling_reading; | |
| 819 case PGRES_POLLING_WRITING: | |
| 820 return Qpgres_polling_writing; | |
| 821 case PGRES_POLLING_ACTIVE: | |
| 822 return Qpgres_polling_active; | |
| 823 default: | |
| 824 /* they've added a new field we don't know about */ | |
| 825 signal_ferror (Qprocess_error, "Help! Unknown status code %08x from backend!", polling_status); | |
| 826 } | |
| 827 } | |
| 828 #endif | |
| 829 | |
| 830 DEFUN ("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /* | |
| 831 Attempt to request cancellation of the current operation. | |
| 832 | |
| 833 The return value is t if the cancel request was successfully | |
| 834 dispatched, nil if not (in which case conn->errorMessage is set). | |
| 835 Note: successful dispatch is no guarantee that there will be any effect at | |
| 836 the backend. The application must read the operation result as usual. | |
| 837 */ | |
| 838 (conn)) | |
| 839 { | |
| 840 PGconn *P; | |
| 841 | |
| 842 CHECK_PGCONN (conn); | |
| 843 P = (XPGCONN (conn))->pgconn; | |
| 844 CHECK_LIVE_CONNECTION (P); | |
| 845 | |
| 846 return PQrequestCancel (P) ? Qt : Qnil; | |
| 847 } | |
| 848 | |
| 849 /* accessor function for the PGconn object */ | |
| 850 DEFUN ("pq-pgconn", Fpq_pgconn, 2, 2, 0, /* | |
| 851 Accessor function for the PGconn object. | |
| 852 Currently recognized symbols for the field: | |
| 853 pq::db Database name | |
| 854 pq::user Database user name | |
| 855 pq::pass Database user's password | |
| 856 pq::host Hostname of PostgreSQL backend connected to | |
| 857 pq::port TCP port number of connection | |
| 858 pq::tty Debugging TTY (not used in Emacs) | |
| 859 pq::options Additional backend options | |
| 860 pq::status Connection status (either OK or BAD) | |
| 861 pq::error-message Last error message from the backend | |
| 862 pq::backend-pid Process ID of backend process | |
| 863 */ | |
| 864 (conn, field)) | |
| 865 { | |
| 866 PGconn *P; | |
| 867 | |
| 868 CHECK_PGCONN (conn); | |
| 869 P = (XPGCONN (conn))->pgconn; | |
| 870 PUKE_IF_NULL (P); /* BAD connections still have state to query */ | |
| 871 | |
| 872 if (EQ(field, Qpqdb)) | |
| 873 /* PQdb Returns the database name of the connection. | |
| 874 char *PQdb(PGconn *conn) | |
| 875 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
876 return build_extstring (PQdb(P), PG_OS_CODING); |
| 996 | 877 else if (EQ (field, Qpquser)) |
| 878 /* PQuser Returns the user name of the connection. | |
| 879 char *PQuser(PGconn *conn) | |
| 880 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
881 return build_extstring (PQuser(P), PG_OS_CODING); |
| 996 | 882 else if (EQ (field, Qpqpass)) |
| 883 /* PQpass Returns the password of the connection. | |
| 884 char *PQpass(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 (PQpass(P), PG_OS_CODING); |
| 996 | 887 else if (EQ (field, Qpqhost)) |
| 888 /* PQhost Returns the server host name of the connection. | |
| 889 char *PQhost(PGconn *conn) | |
| 890 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
891 return build_extstring (PQhost(P), PG_OS_CODING); |
| 996 | 892 else if (EQ (field, Qpqport)) |
| 893 { | |
| 894 char *p; | |
| 895 /* PQport Returns the port of the connection. | |
| 896 char *PQport(PGconn *conn) | |
| 897 */ | |
| 898 if ((p = PQport(P))) | |
| 899 return make_int(atoi(p)); | |
| 900 else | |
| 901 return make_int(-1); | |
| 902 } | |
| 903 else if (EQ (field, Qpqtty)) | |
| 904 /* PQtty Returns the debug tty of the connection. | |
| 905 char *PQtty(PGconn *conn) | |
| 906 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
907 return build_extstring (PQtty(P), PG_OS_CODING); |
| 996 | 908 else if (EQ (field, Qpqoptions)) |
| 909 /* PQoptions Returns the backend options used in the connection. | |
| 910 char *PQoptions(PGconn *conn) | |
| 911 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
912 return build_extstring (PQoptions(P), PG_OS_CODING); |
| 996 | 913 else if (EQ (field, Qpqstatus)) |
| 914 { | |
| 915 ConnStatusType cst; | |
| 916 /* PQstatus Returns the status of the connection. The status can be | |
| 917 CONNECTION_OK or CONNECTION_BAD. | |
| 918 ConnStatusType PQstatus(PGconn *conn) | |
| 919 */ | |
| 920 switch ((cst = PQstatus (P))) | |
| 921 { | |
| 922 case CONNECTION_OK: return Qpg_connection_ok; | |
| 923 case CONNECTION_BAD: return Qpg_connection_bad; | |
| 924 #ifdef HAVE_POSTGRESQLV7 | |
| 925 case CONNECTION_STARTED: return Qpg_connection_started; | |
| 926 case CONNECTION_MADE: return Qpg_connection_made; | |
| 927 case CONNECTION_AWAITING_RESPONSE: return Qpg_connection_awaiting_response; | |
| 928 case CONNECTION_AUTH_OK: return Qpg_connection_auth_ok; | |
| 929 case CONNECTION_SETENV: return Qpg_connection_setenv; | |
| 930 #endif /* HAVE_POSTGRESQLV7 */ | |
| 931 default: | |
| 932 /* they've added a new field we don't know about */ | |
| 933 signal_ferror (Qprocess_error, "Help! Unknown connection status code %08x from backend!", cst); | |
| 934 } | |
| 935 } | |
| 936 else if (EQ (field, Qpqerrormessage)) | |
| 937 /* PQerrorMessage Returns the error message most recently generated | |
| 938 by an operation on the connection. | |
| 939 char *PQerrorMessage(PGconn* conn); | |
| 940 */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
941 return build_extstring (PQerrorMessage(P), PG_OS_CODING); |
| 996 | 942 else if (EQ (field, Qpqbackendpid)) |
| 943 /* PQbackendPID Returns the process ID of the backend server handling | |
| 944 this connection. | |
| 945 int PQbackendPID(PGconn *conn); | |
| 946 */ | |
| 947 return make_int (PQbackendPID(P)); | |
| 948 else | |
| 949 signal_error (Qinvalid_argument, "bad PGconn accessor", Qunbound); | |
| 950 } | |
| 951 | |
| 952 /* Query functions */ | |
| 953 DEFUN ("pq-exec", Fpq_exec, 2, 2, 0, /* | |
| 954 Submit a query to Postgres and wait for the result. | |
| 955 */ | |
| 956 (conn, query)) | |
| 957 { | |
| 958 PGconn *P; | |
| 959 Lisp_PGresult *lisp_pgresult; | |
| 960 PGresult *R; | |
| 961 char *c_query; | |
| 962 | |
| 963 CHECK_PGCONN (conn); | |
| 964 CHECK_STRING (query); | |
| 965 | |
| 966 P = (XPGCONN (conn))->pgconn; | |
| 967 CHECK_LIVE_CONNECTION (P); | |
| 968 | |
| 969 TO_EXTERNAL_FORMAT (LISP_STRING, query, | |
| 970 C_STRING_ALLOCA, c_query, Qnative); | |
| 971 | |
| 972 R = PQexec (P, c_query); | |
| 973 { | |
| 4932 | 974 const Ascbyte *tag; |
| 975 char buf[BLCKSZ]; | |
| 996 | 976 |
| 977 if (!R) out_of_memory ("query: out of memory", Qunbound); | |
| 978 else | |
| 979 switch (PQresultStatus (R)) | |
| 980 { | |
| 981 case PGRES_BAD_RESPONSE: | |
| 982 tag = "bad response [%s]"; | |
| 983 goto err; | |
| 984 case PGRES_NONFATAL_ERROR: | |
| 985 tag = "non-fatal error [%s]"; | |
| 986 goto err; | |
| 987 case PGRES_FATAL_ERROR: | |
| 988 tag = "fatal error [%s]"; | |
| 989 err: | |
| 990 strncpy (buf, PQresultErrorMessage (R), sizeof (buf)); | |
| 991 buf [sizeof (buf) - 1] = '\0'; | |
| 992 PQclear (R); | |
| 993 signal_ferror (Qprocess_error, tag, buf); | |
| 994 /*NOTREACHED*/ | |
| 995 default: | |
| 996 break; | |
| 997 } | |
| 998 } | |
| 999 | |
| 1000 lisp_pgresult = allocate_pgresult (); | |
| 1001 lisp_pgresult->pgresult = R; | |
| 1002 | |
| 1003 return make_pgresult (lisp_pgresult); | |
| 1004 } | |
| 1005 | |
| 1006 DEFUN ("pq-send-query", Fpq_send_query, 2, 2, 0, /* | |
| 1007 Submit a query to Postgres and don't wait for the result. | |
| 1008 Returns: t if successfully submitted | |
| 1009 nil if error (conn->errorMessage is set) | |
| 1010 */ | |
| 1011 (conn, query)) | |
| 1012 { | |
| 1013 PGconn *P; | |
| 1014 char *c_query; | |
| 1015 | |
| 1016 CHECK_PGCONN (conn); | |
| 1017 CHECK_STRING (query); | |
| 1018 | |
| 1019 P = (XPGCONN (conn))->pgconn; | |
| 1020 CHECK_LIVE_CONNECTION (P); | |
| 1021 | |
| 1022 TO_EXTERNAL_FORMAT (LISP_STRING, query, | |
| 1023 C_STRING_ALLOCA, c_query, Qnative); | |
| 1024 | |
| 1025 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
|
1026 else SIGNAL_ERROR (P, "Sending asynchronous query"); |
| 996 | 1027 } |
| 1028 | |
| 1029 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /* | |
| 1030 Retrieve an asynchronous result from a query. | |
| 1031 NIL is returned when no more query work remains. | |
| 1032 */ | |
| 1033 (conn)) | |
| 1034 { | |
| 1035 PGconn *P; | |
| 1036 Lisp_PGresult *lisp_pgresult; | |
| 1037 PGresult *R; | |
| 1038 | |
| 1039 CHECK_PGCONN (conn); | |
| 1040 | |
| 1041 P = (XPGCONN (conn))->pgconn; | |
| 1042 CHECK_LIVE_CONNECTION (P); | |
| 1043 | |
| 1044 R = PQgetResult (P); | |
| 1045 if (!R) return Qnil; /* not an error, there's no more data to get */ | |
| 1046 | |
| 1047 { | |
| 4932 | 1048 const Ascbyte *tag; |
| 1049 char buf[BLCKSZ]; | |
| 996 | 1050 |
| 1051 switch (PQresultStatus (R)) | |
| 1052 { | |
| 1053 case PGRES_BAD_RESPONSE: | |
| 1054 tag = "bad response [%s]"; | |
| 1055 goto err; | |
| 1056 case PGRES_NONFATAL_ERROR: | |
| 1057 tag = "non-fatal error [%s]"; | |
| 1058 goto err; | |
| 1059 case PGRES_FATAL_ERROR: | |
| 1060 tag = "fatal error [%s]"; | |
| 1061 err: | |
| 1062 strncpy (buf, PQresultErrorMessage (R), sizeof (buf)); | |
| 1063 buf[sizeof (buf) - 1] = '\0'; | |
| 1064 PQclear (R); | |
| 1065 signal_ferror (Qprocess_error, tag, buf); | |
| 1066 /*NOTREACHED*/ | |
| 1067 default: | |
| 1068 break; | |
| 1069 } | |
| 1070 } | |
| 1071 | |
| 1072 lisp_pgresult = allocate_pgresult(); | |
| 1073 lisp_pgresult->pgresult = R; | |
| 1074 | |
| 1075 return make_pgresult (lisp_pgresult); | |
| 1076 } | |
| 1077 | |
| 1078 DEFUN ("pq-result-status", Fpq_result_status, 1, 1, 0, /* | |
| 1079 Return result status of the query. | |
| 1080 */ | |
| 1081 (result)) | |
| 1082 { | |
| 1083 PGresult *R; | |
| 1084 ExecStatusType est; | |
| 1085 | |
| 1086 CHECK_PGRESULT (result); | |
| 1087 R = (XPGRESULT (result))->pgresult; | |
| 1088 PUKE_IF_NULL (R); | |
| 1089 | |
| 1090 switch ((est = PQresultStatus (R))) { | |
| 1091 case PGRES_EMPTY_QUERY: return Qpgres_empty_query; | |
| 1092 case PGRES_COMMAND_OK: return Qpgres_command_ok; | |
| 1093 case PGRES_TUPLES_OK: return Qpgres_tuples_ok; | |
| 1094 case PGRES_COPY_OUT: return Qpgres_copy_out; | |
| 1095 case PGRES_COPY_IN: return Qpgres_copy_in; | |
| 1096 case PGRES_BAD_RESPONSE: return Qpgres_bad_response; | |
| 1097 case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error; | |
| 1098 case PGRES_FATAL_ERROR: return Qpgres_fatal_error; | |
| 1099 default: | |
| 1100 /* 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
|
1101 signal_ferror (Qprocess_error, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1102 "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
|
1103 est); |
| 996 | 1104 } |
| 1105 } | |
| 1106 | |
| 1107 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /* | |
| 1108 Return stringified result status of the query. | |
| 1109 */ | |
| 1110 (result)) | |
| 1111 { | |
| 1112 PGresult *R; | |
| 1113 | |
| 1114 CHECK_PGRESULT (result); | |
| 1115 R = (XPGRESULT (result))->pgresult; | |
| 1116 PUKE_IF_NULL (R); | |
| 1117 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1118 return build_extstring (PQresStatus (PQresultStatus (R)), PG_OS_CODING); |
| 996 | 1119 } |
| 1120 | |
| 1121 /* Sundry PGresult accessor functions */ | |
| 1122 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /* | |
| 1123 Return last message associated with the query. | |
| 1124 */ | |
| 1125 (result)) | |
| 1126 { | |
| 1127 PGresult *R; | |
| 1128 | |
| 1129 CHECK_PGRESULT (result); | |
| 1130 R = (XPGRESULT (result))->pgresult; | |
| 1131 PUKE_IF_NULL (R); | |
| 1132 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1133 return build_extstring (PQresultErrorMessage (R), PG_OS_CODING); |
| 996 | 1134 } |
| 1135 | |
| 1136 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /* | |
| 1137 Return the number of tuples (instances) in the query result. | |
| 1138 */ | |
| 1139 (result)) | |
| 1140 { | |
| 1141 PGresult *R; | |
| 1142 | |
| 1143 CHECK_PGRESULT (result); | |
| 1144 R = (XPGRESULT (result))->pgresult; | |
| 1145 PUKE_IF_NULL (R); | |
| 1146 | |
| 1147 return make_int (PQntuples (R)); | |
| 1148 } | |
| 1149 | |
| 1150 DEFUN ("pq-nfields", Fpq_nfields, 1, 1, 0, /* | |
| 1151 Return the number of fields (attributes) in each tuple of the query result. | |
| 1152 */ | |
| 1153 (result)) | |
| 1154 { | |
| 1155 PGresult *R; | |
| 1156 | |
| 1157 CHECK_PGRESULT (result); | |
| 1158 R = (XPGRESULT (result))->pgresult; | |
| 1159 PUKE_IF_NULL (R); | |
| 1160 | |
| 1161 return make_int (PQnfields (R)); | |
| 1162 } | |
| 1163 | |
| 1164 DEFUN ("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /* | |
| 1165 Return t if the query result contains binary data, nil otherwise. | |
| 1166 */ | |
| 1167 (result)) | |
| 1168 { | |
| 1169 PGresult *R; | |
| 1170 | |
| 1171 CHECK_PGRESULT (result); | |
| 1172 R = (XPGRESULT (result))->pgresult; | |
| 1173 PUKE_IF_NULL (R); | |
| 1174 | |
| 1175 return (PQbinaryTuples (R)) ? Qt : Qnil; | |
| 1176 } | |
| 1177 | |
| 1178 DEFUN ("pq-fname", Fpq_fname, 2, 2, 0, /* | |
| 1179 Return the field (attribute) name associated with the given field index. | |
| 1180 Field indices start at 0. | |
| 1181 */ | |
| 1182 (result, field_index)) | |
| 1183 { | |
| 1184 PGresult *R; | |
| 1185 | |
| 1186 CHECK_PGRESULT (result); | |
| 1187 CHECK_INT (field_index); | |
| 1188 R = (XPGRESULT (result))->pgresult; | |
| 1189 PUKE_IF_NULL (R); | |
| 1190 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1191 return build_extstring (PQfname (R, XINT (field_index)), PG_OS_CODING); |
| 996 | 1192 } |
| 1193 | |
| 1194 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /* | |
| 1195 Return the number of fields (attributes) in each tuple of the query result. | |
| 1196 */ | |
| 1197 (result, field_name)) | |
| 1198 { | |
| 1199 PGresult *R; | |
| 1200 char *c_field_name; | |
| 1201 | |
| 1202 CHECK_PGRESULT (result); | |
| 1203 CHECK_STRING (field_name); | |
| 1204 R = (XPGRESULT (result))->pgresult; | |
| 1205 PUKE_IF_NULL (R); | |
| 1206 | |
| 1207 TO_EXTERNAL_FORMAT (LISP_STRING, field_name, | |
| 1208 C_STRING_ALLOCA, c_field_name, Qnative); | |
| 1209 | |
| 1210 return make_int (PQfnumber (R, c_field_name)); | |
| 1211 } | |
| 1212 | |
| 1213 DEFUN ("pq-ftype", Fpq_ftype, 2, 2, 0, /* | |
| 1214 Return the field type associated with the given field index. | |
| 1215 The integer returned is the internal coding of the type. Field indices | |
| 1216 start at 0. | |
| 1217 */ | |
| 1218 (result, field_num)) | |
| 1219 { | |
| 1220 PGresult *R; | |
| 1221 | |
| 1222 CHECK_PGRESULT (result); | |
| 1223 CHECK_INT (field_num); | |
| 1224 R = (XPGRESULT (result))->pgresult; | |
| 1225 PUKE_IF_NULL (R); | |
| 1226 | |
| 1227 return make_int (PQftype (R, XINT (field_num))); | |
| 1228 } | |
| 1229 | |
| 1230 DEFUN ("pq-fsize", Fpq_fsize, 2, 2, 0, /* | |
| 1231 Return the field size in bytes associated with the given field index. | |
| 1232 Field indices start at 0. | |
| 1233 */ | |
| 1234 (result, field_index)) | |
| 1235 { | |
| 1236 PGresult *R; | |
| 1237 | |
| 1238 CHECK_PGRESULT (result); | |
| 1239 CHECK_INT (field_index); | |
| 1240 R = (XPGRESULT (result))->pgresult; | |
| 1241 PUKE_IF_NULL (R); | |
| 1242 | |
| 1243 return make_int (PQftype (R, XINT (field_index))); | |
| 1244 } | |
| 1245 | |
| 1246 DEFUN ("pq-fmod", Fpq_fmod, 2, 2, 0, /* | |
| 1247 Return the type modifier associated with a field. | |
| 1248 Field indices start at 0. | |
| 1249 */ | |
| 1250 (result, field_index)) | |
| 1251 { | |
| 1252 PGresult *R; | |
| 1253 | |
| 1254 CHECK_PGRESULT (result); | |
| 1255 CHECK_INT (field_index); | |
| 1256 R = (XPGRESULT (result))->pgresult; | |
| 1257 PUKE_IF_NULL (R); | |
| 1258 | |
| 1259 return make_int (PQfmod (R, XINT (field_index))); | |
| 1260 } | |
| 1261 | |
| 1262 DEFUN ("pq-get-value", Fpq_get_value, 3, 3, 0, /* | |
| 1263 Return a single field (attribute) value of one tuple of a PGresult. | |
| 1264 Tuple and field indices start at 0. | |
| 1265 */ | |
| 1266 (result, tup_num, field_num)) | |
| 1267 { | |
| 1268 PGresult *R; | |
| 1269 | |
| 1270 CHECK_PGRESULT (result); | |
| 1271 CHECK_INT (tup_num); | |
| 1272 CHECK_INT (field_num); | |
| 1273 R = (XPGRESULT (result))->pgresult; | |
| 1274 PUKE_IF_NULL (R); | |
| 1275 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1276 return build_extstring (PQgetvalue (R, XINT (tup_num), XINT (field_num)), |
| 996 | 1277 PG_OS_CODING); |
| 1278 } | |
| 1279 | |
| 1280 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /* | |
| 1281 Returns the length of a field value in bytes. | |
| 1282 If result is binary, i.e. a result of a binary portal, then the | |
| 1283 length returned does NOT include the size field of the varlena. (The | |
| 1284 data returned by PQgetvalue doesn't either.) | |
| 1285 */ | |
| 1286 (result, tup_num, field_num)) | |
| 1287 { | |
| 1288 PGresult *R; | |
| 1289 | |
| 1290 CHECK_PGRESULT (result); | |
| 1291 CHECK_INT (tup_num); | |
| 1292 CHECK_INT (field_num); | |
| 1293 R = (XPGRESULT (result))->pgresult; | |
| 1294 PUKE_IF_NULL (R); | |
| 1295 | |
| 1296 return make_int (PQgetlength (R, XINT (tup_num), XINT (field_num))); | |
| 1297 } | |
| 1298 | |
| 1299 DEFUN ("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /* | |
| 1300 Returns the null status of a field value. | |
| 1301 */ | |
| 1302 (result, tup_num, field_num)) | |
| 1303 { | |
| 1304 PGresult *R; | |
| 1305 | |
| 1306 CHECK_PGRESULT (result); | |
| 1307 CHECK_INT (tup_num); | |
| 1308 CHECK_INT (field_num); | |
| 1309 R = (XPGRESULT (result))->pgresult; | |
| 1310 PUKE_IF_NULL (R); | |
| 1311 | |
| 1312 return PQgetisnull (R, XINT (tup_num), XINT (field_num)) ? Qt : Qnil; | |
| 1313 } | |
| 1314 | |
| 1315 DEFUN ("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /* | |
| 1316 Returns the command status string from the SQL command that generated the result. | |
| 1317 */ | |
| 1318 (result)) | |
| 1319 { | |
| 1320 PGresult *R; | |
| 1321 | |
| 1322 CHECK_PGRESULT (result); | |
| 1323 R = (XPGRESULT (result))->pgresult; | |
| 1324 PUKE_IF_NULL (R); | |
| 1325 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1326 return build_extstring (PQcmdStatus (R), PG_OS_CODING); |
| 996 | 1327 } |
| 1328 | |
| 1329 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /* | |
| 1330 Returns the number of rows affected by the SQL command. | |
| 1331 */ | |
| 1332 (result)) | |
| 1333 { | |
| 1334 PGresult *R; | |
| 1335 | |
| 1336 CHECK_PGRESULT (result); | |
| 1337 R = (XPGRESULT (result))->pgresult; | |
| 1338 PUKE_IF_NULL (R); | |
| 1339 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1340 return build_extstring (PQcmdTuples (R), PG_OS_CODING); |
| 996 | 1341 } |
| 1342 | |
| 1343 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /* | |
| 1344 Returns the object id of the tuple inserted. | |
| 1345 */ | |
| 1346 (result)) | |
| 1347 { | |
| 1348 PGresult *R; | |
| 1349 | |
| 1350 CHECK_PGRESULT (result); | |
| 1351 R = (XPGRESULT (result))->pgresult; | |
| 1352 PUKE_IF_NULL (R); | |
| 1353 | |
| 1354 #ifdef HAVE_POSTGRESQLV7 | |
| 1355 return make_int (PQoidValue (R)); | |
| 1356 #else | |
| 1357 /* Use the old interface */ | |
| 1358 return make_int (atoi (PQoidStatus (R))); | |
| 1359 #endif | |
| 1360 } | |
| 1361 | |
| 1362 #ifdef HAVE_POSTGRESQLV7 | |
| 1363 DEFUN ("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /* | |
| 1364 Sets the PGconn's database connection non-blocking if the arg is TRUE | |
| 1365 or makes it non-blocking if the arg is FALSE, this will not protect | |
| 1366 you from PQexec(), you'll only be safe when using the non-blocking API. | |
| 1367 | |
| 1368 Needs to be called only on a connected database connection. | |
| 1369 */ | |
| 1370 (conn, arg)) | |
| 1371 { | |
| 1372 PGconn *P; | |
| 1373 | |
| 1374 CHECK_PGCONN (conn); | |
| 1375 P = (XPGCONN (conn))->pgconn; | |
| 1376 CHECK_LIVE_CONNECTION (P); | |
| 1377 | |
| 1378 return make_int (PQsetnonblocking (P, !NILP (arg))); | |
| 1379 } | |
| 1380 | |
| 1381 DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /* | |
| 1382 Return the blocking status of the database connection. | |
| 1383 */ | |
| 1384 (conn)) | |
| 1385 { | |
| 1386 PGconn *P; | |
| 1387 | |
| 1388 CHECK_PGCONN (conn); | |
| 1389 P = (XPGCONN (conn))->pgconn; | |
| 1390 CHECK_LIVE_CONNECTION (P); | |
| 1391 | |
| 1392 return PQisnonblocking (P) ? Qt : Qnil; | |
| 1393 } | |
| 1394 | |
| 1395 DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /* | |
| 1396 Force the write buffer to be written (or at least try). | |
| 1397 */ | |
| 1398 (conn)) | |
| 1399 { | |
| 1400 PGconn *P; | |
| 1401 | |
| 1402 CHECK_PGCONN (conn); | |
| 1403 P = (XPGCONN (conn))->pgconn; | |
| 1404 CHECK_LIVE_CONNECTION (P); | |
| 1405 | |
| 1406 return make_int (PQflush (P)); | |
| 1407 } | |
| 1408 #endif | |
| 1409 | |
| 1410 DEFUN ("pq-notifies", Fpq_notifies, 1, 1, 0, /* | |
| 1411 Return the latest async notification that has not yet been handled. | |
| 1412 If there has been a notification, then a list of two elements will be returned. | |
| 1413 The first element contains the relation name being notified, the second | |
| 1414 element contains the backend process ID number. nil is returned if there | |
| 1415 aren't any notifications to process. | |
| 1416 */ | |
| 1417 (conn)) | |
| 1418 { | |
| 1419 /* This function cannot GC */ | |
| 1420 PGconn *P; | |
| 1421 PGnotify *PGN; | |
| 1422 | |
| 1423 CHECK_PGCONN (conn); | |
| 1424 P = (XPGCONN (conn))->pgconn; | |
| 1425 CHECK_LIVE_CONNECTION (P); | |
| 1426 | |
| 1427 PGN = PQnotifies (P); | |
| 1428 if (!PGN) | |
| 1429 return Qnil; | |
| 1430 else | |
| 1431 { | |
| 1432 Lisp_Object temp; | |
| 1433 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1434 temp = list2 (build_extstring (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid)); |
| 996 | 1435 free ((void *)PGN); |
| 1436 return temp; | |
| 1437 } | |
| 1438 } | |
| 1439 | |
| 1440 #if defined (HAVE_POSTGRESQLV7) && defined(MULE) | |
| 1441 /* ###autoload */ | |
| 1442 DEFUN ("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /* | |
| 1443 Get encoding id from environment variable PGCLIENTENCODING. | |
| 1444 */ | |
| 1445 ()) | |
| 1446 { | |
| 1447 return make_int (PQenv2encoding ()); | |
| 1448 } | |
| 1449 #endif /* MULE */ | |
| 1450 | |
| 1451 DEFUN ("pq-lo-import", Fpq_lo_import, 2, 2, 0, /* | |
| 1452 */ | |
| 1453 (conn, filename)) | |
| 1454 { | |
| 1455 PGconn *P; | |
| 1456 char *c_filename; | |
| 1457 | |
| 1458 CHECK_PGCONN (conn); | |
| 1459 CHECK_STRING (filename); | |
| 1460 | |
| 1461 P = (XPGCONN (conn))->pgconn; | |
| 1462 CHECK_LIVE_CONNECTION (P); | |
| 1463 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1464 LISP_PATHNAME_CONVERT_OUT (filename, c_filename); |
| 996 | 1465 |
| 1466 return make_int ((int)lo_import (P, c_filename)); | |
| 1467 } | |
| 1468 | |
| 1469 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /* | |
| 1470 */ | |
| 1471 (conn, oid, filename)) | |
| 1472 { | |
| 1473 PGconn *P; | |
| 1474 char *c_filename; | |
| 1475 | |
| 1476 CHECK_PGCONN (conn); | |
| 1477 CHECK_INT (oid); | |
| 1478 CHECK_STRING (filename); | |
| 1479 | |
| 1480 P = (XPGCONN (conn))->pgconn; | |
| 1481 CHECK_LIVE_CONNECTION (P); | |
| 1482 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1483 LISP_PATHNAME_CONVERT_OUT (filename, c_filename); |
| 996 | 1484 |
| 1485 return make_int ((int)lo_export (P, XINT (oid), c_filename)); | |
| 1486 } | |
| 1487 | |
| 1488 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /* | |
| 1489 Make an empty PGresult object with the given status. | |
| 1490 */ | |
| 1491 (conn, status)) | |
| 1492 { | |
| 1493 PGconn *P; | |
| 1494 Lisp_PGresult *lpgr; | |
| 1495 PGresult *R; | |
| 1496 ExecStatusType est; | |
| 1497 | |
| 1498 CHECK_PGCONN (conn); | |
| 1499 P = (XPGCONN (conn))->pgconn; | |
| 1500 CHECK_LIVE_CONNECTION (P); /* needed here? */ | |
| 1501 | |
| 1502 if (EQ (status, Qpgres_empty_query)) est = PGRES_EMPTY_QUERY; | |
| 1503 else if (EQ (status, Qpgres_command_ok)) est = PGRES_COMMAND_OK; | |
| 1504 else if (EQ (status, Qpgres_tuples_ok)) est = PGRES_TUPLES_OK; | |
| 1505 else if (EQ (status, Qpgres_copy_out)) est = PGRES_COPY_OUT; | |
| 1506 else if (EQ (status, Qpgres_copy_in)) est = PGRES_COPY_IN; | |
| 1507 else if (EQ (status, Qpgres_bad_response)) est = PGRES_BAD_RESPONSE; | |
| 1508 else if (EQ (status, Qpgres_nonfatal_error)) est = PGRES_NONFATAL_ERROR; | |
| 1509 else if (EQ (status, Qpgres_fatal_error)) est = PGRES_FATAL_ERROR; | |
| 1510 else invalid_constant ("bad status symbol", status); | |
| 1511 | |
| 1512 R = PQmakeEmptyPGresult (P, est); | |
| 1513 if (!R) out_of_memory (0, Qunbound); | |
| 1514 | |
| 1515 lpgr = allocate_pgresult (); | |
| 1516 lpgr->pgresult = R; | |
| 1517 | |
| 1518 return make_pgresult (lpgr); | |
| 1519 } | |
| 1520 | |
| 1521 DEFUN ("pq-get-line", Fpq_get_line, 1, 1, 0, /* | |
| 1522 Retrieve a line from server in copy in operation. | |
| 1523 The return value is a dotted pair where the cons cell is an integer code: | |
| 1524 -1: Copying is complete | |
| 1525 0: A record is complete | |
| 1526 1: A record is incomplete, it will be continued in the next `pq-get-line' | |
| 1527 operation. | |
| 1528 and the cdr cell is returned string data. | |
| 1529 | |
| 1530 The copy operation is complete when the value `\.' (backslash dot) is | |
| 1531 returned. | |
| 1532 */ | |
| 1533 (conn)) | |
| 1534 { | |
| 1535 char buffer[BLCKSZ]; /* size of a Postgres disk block */ | |
| 1536 PGconn *P; | |
| 1537 int ret; | |
| 1538 | |
| 1539 CHECK_PGCONN (conn); | |
| 1540 P = (XPGCONN (conn))->pgconn; | |
| 1541 CHECK_LIVE_CONNECTION (P); | |
| 1542 | |
| 1543 ret = PQgetline (P, buffer, sizeof (buffer)); | |
| 1544 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1545 return Fcons (make_int (ret), build_extstring (buffer, PG_OS_CODING)); |
| 996 | 1546 } |
| 1547 | |
| 1548 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /* | |
| 1549 Send a line to the server in copy out operation. | |
| 1550 | |
| 1551 Returns t if the operation succeeded, nil otherwise. | |
| 1552 */ | |
| 1553 (conn, string)) | |
| 1554 { | |
| 1555 PGconn *P; | |
| 1556 char *c_string; | |
| 1557 | |
| 1558 CHECK_PGCONN (conn); | |
| 1559 CHECK_STRING (string); | |
| 1560 | |
| 1561 P = (XPGCONN (conn))->pgconn; | |
| 1562 CHECK_LIVE_CONNECTION (P); | |
| 1563 TO_EXTERNAL_FORMAT (LISP_STRING, string, | |
| 1564 C_STRING_ALLOCA, c_string, Qnative); | |
| 1565 | |
| 1566 return !PQputline (P, c_string) ? Qt : Qnil; | |
| 1567 } | |
| 1568 | |
| 1569 DEFUN ("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /* | |
| 1570 Get a line from the server in copy in operation asynchronously. | |
| 1571 | |
| 1572 This routine is for applications that want to do "COPY <rel> to stdout" | |
| 1573 asynchronously, that is without blocking. Having issued the COPY command | |
| 1574 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput | |
| 1575 and this routine until the end-of-data signal is detected. Unlike | |
| 1576 PQgetline, this routine takes responsibility for detecting end-of-data. | |
| 1577 | |
| 1578 On each call, PQgetlineAsync will return data if a complete newline- | |
| 1579 terminated data line is available in libpq's input buffer, or if the | |
| 1580 incoming data line is too long to fit in the buffer offered by the caller. | |
| 1581 Otherwise, no data is returned until the rest of the line arrives. | |
| 1582 | |
| 1583 If -1 is returned, the end-of-data signal has been recognized (and removed | |
| 1584 from libpq's input buffer). The caller *must* next call PQendcopy and | |
| 1585 then return to normal processing. | |
| 1586 | |
| 1587 RETURNS: | |
| 1588 -1 if the end-of-copy-data marker has been recognized | |
| 1589 0 if no data is available | |
| 1590 >0 the number of bytes returned. | |
| 1591 The data returned will not extend beyond a newline character. If possible | |
| 1592 a whole line will be returned at one time. But if the buffer offered by | |
| 1593 the caller is too small to hold a line sent by the backend, then a partial | |
| 1594 data line will be returned. This can be detected by testing whether the | |
| 1595 last returned byte is '\n' or not. | |
| 1596 The returned string is *not* null-terminated. | |
| 1597 */ | |
| 1598 (conn)) | |
| 1599 { | |
| 1600 PGconn *P; | |
| 1601 char buffer[BLCKSZ]; | |
| 1602 int ret; | |
| 1603 | |
| 1604 CHECK_PGCONN (conn); | |
| 1605 | |
| 1606 P = (XPGCONN (conn))->pgconn; | |
| 1607 CHECK_LIVE_CONNECTION (P); | |
| 1608 | |
| 1609 ret = PQgetlineAsync (P, buffer, sizeof (buffer)); | |
| 1610 | |
| 1611 if (ret == -1) return Qt; /* done! */ | |
| 1612 else if (!ret) return Qnil; /* no data yet */ | |
| 1613 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
|
1614 make_extstring ((Extbyte *) buffer, ret, PG_OS_CODING)); |
| 996 | 1615 } |
| 1616 | |
| 1617 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /* | |
| 1618 Asynchronous copy out. | |
| 1619 */ | |
| 1620 (conn, data)) | |
| 1621 { | |
| 1622 /* NULs are not allowed. I don't think this matters at this time. */ | |
| 1623 PGconn *P; | |
| 1624 char *c_data; | |
| 1625 | |
| 1626 CHECK_PGCONN (conn); | |
| 1627 CHECK_STRING (data); | |
| 1628 | |
| 1629 P = (XPGCONN (conn))->pgconn; | |
| 1630 CHECK_LIVE_CONNECTION (P); | |
| 1631 TO_EXTERNAL_FORMAT (LISP_STRING, data, | |
| 1632 C_STRING_ALLOCA, c_data, Qnative); | |
| 1633 | |
| 1634 return !PQputnbytes (P, c_data, strlen (c_data)) ? Qt : Qnil; | |
| 1635 } | |
| 1636 | |
| 1637 DEFUN ("pq-end-copy", Fpq_end_copy, 1, 1, 0, /* | |
| 1638 End a copying operation. | |
| 1639 */ | |
| 1640 (conn)) | |
| 1641 { | |
| 1642 PGconn *P; | |
| 1643 | |
| 1644 CHECK_PGCONN (conn); | |
| 1645 P = (XPGCONN (conn))->pgconn; | |
| 1646 CHECK_LIVE_CONNECTION (P); | |
| 1647 | |
| 1648 return PQendcopy (P) ? Qt : Qnil; | |
| 1649 } | |
| 1650 | |
| 1651 void | |
| 1652 syms_of_postgresql(void) | |
| 1653 { | |
| 1654 #ifndef RUNNING_XEMACS_21_1 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1655 INIT_LISP_OBJECT (pgconn); |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1656 INIT_LISP_OBJECT (pgresult); |
| 996 | 1657 #endif |
| 1658 DEFSYMBOL (Qpostgresql); | |
| 1659 | |
| 1660 /* opaque exported types */ | |
| 1661 DEFSYMBOL (Qpgconnp); | |
| 1662 DEFSYMBOL (Qpgresultp); | |
| 1663 | |
| 1664 /* connection status types */ | |
| 1665 defsymbol (&Qpg_connection_ok, "pg::connection-ok"); | |
| 1666 defsymbol (&Qpg_connection_bad, "pg::connection-bad"); | |
| 1667 defsymbol (&Qpg_connection_started, "pg::connection-started"); | |
| 1668 defsymbol (&Qpg_connection_made, "pg::connection-made"); | |
| 1669 defsymbol (&Qpg_connection_awaiting_response, "pg::connection-awaiting-response"); | |
| 1670 defsymbol (&Qpg_connection_auth_ok, "pg::connection-auth-ok"); | |
| 1671 defsymbol (&Qpg_connection_setenv, "pg::connection-setenv"); | |
| 1672 | |
| 1673 /* Fields of PGconn */ | |
| 1674 defsymbol (&Qpqdb, "pq::db"); | |
| 1675 defsymbol (&Qpquser, "pq::user"); | |
| 1676 defsymbol (&Qpqpass, "pq::pass"); | |
| 1677 defsymbol (&Qpqhost, "pq::host"); | |
| 1678 defsymbol (&Qpqport, "pq::port"); | |
| 1679 defsymbol (&Qpqtty, "pq::tty"); | |
| 1680 defsymbol (&Qpqoptions, "pq::options"); | |
| 1681 defsymbol (&Qpqstatus, "pq::status"); | |
| 1682 defsymbol (&Qpqerrormessage, "pq::error-message"); | |
| 1683 defsymbol (&Qpqbackendpid, "pq::backend-pid"); | |
| 1684 | |
| 1685 /* Query status results */ | |
| 1686 defsymbol (&Qpgres_empty_query, "pgres::empty-query"); | |
| 1687 defsymbol (&Qpgres_command_ok, "pgres::command-ok"); | |
| 1688 defsymbol (&Qpgres_tuples_ok, "pgres::tuples-ok"); | |
| 1689 defsymbol (&Qpgres_copy_out, "pgres::copy-out"); | |
| 1690 defsymbol (&Qpgres_copy_in, "pgres::copy-in"); | |
| 1691 defsymbol (&Qpgres_bad_response, "pgres::bad-response"); | |
| 1692 defsymbol (&Qpgres_nonfatal_error, "pgres::nonfatal-error"); | |
| 1693 defsymbol (&Qpgres_fatal_error, "pgres::fatal-error"); | |
| 1694 | |
| 1695 /* Poll status results */ | |
| 1696 defsymbol (&Qpgres_polling_failed, "pgres::polling-failed"); | |
| 1697 defsymbol (&Qpgres_polling_reading, "pgres::polling-reading"); | |
| 1698 defsymbol (&Qpgres_polling_writing, "pgres::polling-writing"); | |
| 1699 defsymbol (&Qpgres_polling_ok, "pgres::polling-ok"); | |
| 1700 defsymbol (&Qpgres_polling_active, "pgres::polling-active"); | |
| 1701 | |
| 1702 #ifdef HAVE_POSTGRESQLV7 | |
| 1703 DEFSUBR (Fpq_connect_start); | |
| 1704 DEFSUBR (Fpq_connect_poll); | |
| 1705 #ifdef MULE | |
| 1706 DEFSUBR (Fpq_client_encoding); | |
| 1707 DEFSUBR (Fpq_set_client_encoding); | |
| 1708 #endif /* MULE */ | |
| 1709 #endif /* HAVE_POSTGRESQLV7 */ | |
| 1710 DEFSUBR (Fpq_conn_defaults); | |
| 1711 DEFSUBR (Fpq_connectdb); | |
| 1712 DEFSUBR (Fpq_finish); | |
| 1713 DEFSUBR (Fpq_clear); | |
| 1714 DEFSUBR (Fpq_is_busy); | |
| 1715 DEFSUBR (Fpq_consume_input); | |
| 1716 | |
| 1717 DEFSUBR (Fpq_reset); | |
| 1718 #ifdef HAVE_POSTGRESQLV7 | |
| 1719 DEFSUBR (Fpq_reset_start); | |
| 1720 DEFSUBR (Fpq_reset_poll); | |
| 1721 #endif | |
| 1722 DEFSUBR (Fpq_request_cancel); | |
| 1723 DEFSUBR (Fpq_pgconn); | |
| 1724 | |
| 1725 DEFSUBR (Fpq_exec); | |
| 1726 DEFSUBR (Fpq_send_query); | |
| 1727 DEFSUBR (Fpq_get_result); | |
| 1728 DEFSUBR (Fpq_result_status); | |
| 1729 DEFSUBR (Fpq_res_status); | |
| 1730 DEFSUBR (Fpq_result_error_message); | |
| 1731 DEFSUBR (Fpq_ntuples); | |
| 1732 DEFSUBR (Fpq_nfields); | |
| 1733 DEFSUBR (Fpq_binary_tuples); | |
| 1734 DEFSUBR (Fpq_fname); | |
| 1735 DEFSUBR (Fpq_fnumber); | |
| 1736 DEFSUBR (Fpq_ftype); | |
| 1737 DEFSUBR (Fpq_fsize); | |
| 1738 DEFSUBR (Fpq_fmod); | |
| 1739 /***/ | |
| 1740 DEFSUBR (Fpq_get_value); | |
| 1741 DEFSUBR (Fpq_get_length); | |
| 1742 DEFSUBR (Fpq_get_is_null); | |
| 1743 DEFSUBR (Fpq_cmd_status); | |
| 1744 DEFSUBR (Fpq_cmd_tuples); | |
| 1745 DEFSUBR (Fpq_oid_value); | |
| 1746 | |
| 1747 #ifdef HAVE_POSTGRESQLV7 | |
| 1748 DEFSUBR (Fpq_set_nonblocking); | |
| 1749 DEFSUBR (Fpq_is_nonblocking); | |
| 1750 DEFSUBR (Fpq_flush); | |
| 1751 #endif | |
| 1752 DEFSUBR (Fpq_notifies); | |
| 1753 | |
| 1754 #if defined (HAVE_POSTGRESQLV7) && defined(MULE) | |
| 1755 DEFSUBR (Fpq_env_2_encoding); | |
| 1756 #endif | |
| 1757 | |
| 1758 DEFSUBR (Fpq_lo_import); | |
| 1759 DEFSUBR (Fpq_lo_export); | |
| 1760 | |
| 1761 DEFSUBR (Fpq_make_empty_pgresult); | |
| 1762 | |
| 1763 /* copy in/out functions */ | |
| 1764 DEFSUBR (Fpq_get_line); | |
| 1765 DEFSUBR (Fpq_put_line); | |
| 1766 DEFSUBR (Fpq_get_line_async); | |
| 1767 DEFSUBR (Fpq_put_nbytes); | |
| 1768 DEFSUBR (Fpq_end_copy); | |
| 1769 } | |
| 1770 | |
| 1771 void | |
| 1772 vars_of_postgresql(void) | |
| 1773 { | |
| 1774 Fprovide (Qpostgresql); | |
| 1775 #ifdef HAVE_POSTGRESQLV7 | |
| 1776 Fprovide (intern ("postgresqlv7")); | |
| 1777 #endif | |
| 1778 #ifndef RUNNING_XEMACS_21_1 | |
| 1779 Vpg_coding_system = Qnative; | |
| 1780 DEFVAR_LISP ("pg-coding-system", &Vpg_coding_system /* | |
| 1781 Default Postgres client coding system. | |
| 1782 */ ); | |
| 1783 #endif | |
| 1784 | |
| 1785 DEFVAR_LISP ("pg:host", &VXPGHOST /* | |
| 1786 Default PostgreSQL server name. | |
| 1787 If not set, the server running on the local host is used. The | |
| 1788 initial value is set from the PGHOST environment variable. | |
| 1789 */ ); | |
| 1790 | |
| 1791 DEFVAR_LISP ("pg:user", &VXPGUSER /* | |
| 1792 Default PostgreSQL user name. | |
| 1793 This value is used when connecting to a database for authentication. | |
| 1794 The initial value is set from the PGUSER environment variable. | |
| 1795 */ ); | |
| 1796 | |
| 1797 DEFVAR_LISP ("pg:options", &VXPGOPTIONS /* | |
| 1798 Default PostgreSQL user name. | |
| 1799 This value is used when connecting to a database for authentication. | |
| 1800 The initial value is set from the PGUSER environment variable. | |
| 1801 */ ); | |
| 1802 | |
| 1803 DEFVAR_LISP ("pg:port", &VXPGPORT /* | |
| 1804 Default port to connect to PostgreSQL backend. | |
| 1805 This value is used when connecting to a database. | |
| 1806 The initial value is set from the PGPORT environment variable. | |
| 1807 */ ); | |
| 1808 | |
| 1809 DEFVAR_LISP ("pg:tty", &VXPGTTY /* | |
| 1810 Default debugging TTY. | |
| 1811 There is no useful setting of this variable in the XEmacs Lisp API. | |
| 1812 The initial value is set from the PGTTY environment variable. | |
| 1813 */ ); | |
| 1814 | |
| 1815 DEFVAR_LISP ("pg:database", &VXPGDATABASE /* | |
| 1816 Default database to connect to. | |
| 1817 The initial value is set from the PGDATABASE environment variable. | |
| 1818 */ ); | |
| 1819 | |
| 1820 DEFVAR_LISP ("pg:realm", &VXPGREALM /* | |
| 1821 Default kerberos realm to use for authentication. | |
| 1822 The initial value is set from the PGREALM environment variable. | |
| 1823 */ ); | |
| 1824 | |
| 1825 #ifdef MULE | |
| 1826 /* It's not clear whether this is any use. My intent is to | |
| 1827 autodetect the coding system from the database. */ | |
| 1828 DEFVAR_LISP ("pg:client-encoding", &VXPGCLIENTENCODING /* | |
| 1829 Default client encoding to use. | |
| 1830 The initial value is set from the PGCLIENTENCODING environment variable. | |
| 1831 */ ); | |
| 1832 #endif | |
| 1833 | |
| 1834 #if !defined(HAVE_POSTGRESQLV7) | |
| 1835 DEFVAR_LISP ("pg:authtype", &VXPGAUTHTYPE /* | |
| 1836 Default authentication to use. | |
| 1837 The initial value is set from the PGAUTHTYPE environment variable. | |
| 1838 | |
| 1839 WARNING: This variable has gone away in versions of PostgreSQL newer | |
| 1840 than 6.5. | |
| 1841 */ ); | |
| 1842 #endif | |
| 1843 | |
| 1844 DEFVAR_LISP ("pg:geqo", &VXPGGEQO /* | |
| 1845 Genetic Query Optimizer options. | |
| 1846 The initial value is set from the PGGEQO environment variable. | |
| 1847 */ ); | |
| 1848 | |
| 1849 DEFVAR_LISP ("pg:cost-index", &VXPGCOSTINDEX /* | |
| 1850 Default cost index options. | |
| 1851 The initial value is set from the PGCOSTINDEX environment variable. | |
| 1852 */ ); | |
| 1853 | |
| 1854 DEFVAR_LISP ("pg:cost-heap", &VXPGCOSTHEAP /* | |
| 1855 Default cost heap options. | |
| 1856 The initial value is set from the PGCOSTHEAP environment variable. | |
| 1857 */ ); | |
| 1858 | |
| 1859 DEFVAR_LISP ("pg:tz", &VXPGTZ /* | |
| 1860 Default timezone to use. | |
| 1861 The initial value is set from the PGTZ environment variable. | |
| 1862 */ ); | |
| 1863 | |
| 1864 DEFVAR_LISP ("pg:date-style", &VXPGDATESTYLE /* | |
| 1865 Default date style to use. | |
| 1866 The initial value is set from the PGDATESTYLE environment variable. | |
| 1867 */ ); | |
| 1868 | |
| 1869 #ifdef HAVE_SHLIB | |
| 1870 /* If we are building this as a module, we need the initializing function to | |
| 1871 run at module load time. */ | |
| 1872 init_postgresql_from_environment (); | |
| 1873 #endif | |
| 1874 } | |
| 1875 | |
| 1876 /* These initializations should not be done at dump-time. */ | |
| 1877 void | |
| 1878 init_postgresql_from_environment (void) | |
| 1879 { | |
| 1880 Ibyte *p; | |
| 1881 | |
| 1882 #define FROB(envvar, var) \ | |
| 1883 if ((p = egetenv (envvar))) \ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1884 var = build_istring (p); \ |
| 996 | 1885 else \ |
| 1886 var = Qnil | |
| 1887 | |
| 1888 if (initialized) | |
| 1889 { | |
| 1890 FROB ("PGHOST", VXPGHOST); | |
| 1891 FROB ("PGUSER", VXPGUSER); | |
| 1892 FROB ("PGOPTIONS", VXPGOPTIONS); | |
| 1893 | |
| 1894 if ((p = egetenv ("PGPORT"))) | |
| 1895 VXPGPORT = make_int (atoi ((char *) p)); | |
| 1896 else | |
| 1897 VXPGPORT = Qnil; | |
| 1898 | |
| 1899 FROB ("PGTTY", VXPGTTY); | |
| 1900 FROB ("PGDATABASE", VXPGDATABASE); | |
| 1901 FROB ("PGREALM", VXPGREALM); | |
| 1902 #ifdef MULE | |
| 1903 /* It's not clear whether this is any use. My intent is to | |
| 1904 autodetect the coding system from the database. */ | |
| 1905 FROB ("PGCLIENTENCODING", VXPGCLIENTENCODING); | |
| 1906 #endif | |
| 1907 | |
| 1908 #if !defined(HAVE_POSTGRESQLV7) | |
| 1909 FROB ("PGAUTHTYPE", VXPGAUTHTYPE); | |
| 1910 #endif | |
| 1911 | |
| 1912 FROB ("PGGEQO", VXPGGEQO); | |
| 1913 FROB ("PGCOSTINDEX", VXPGCOSTINDEX); | |
| 1914 FROB ("PGCOSTHEAP", VXPGCOSTHEAP); | |
| 1915 FROB ("PGTZ", VXPGTZ); | |
| 1916 FROB ("PGDATESTYLE", VXPGDATESTYLE); | |
| 1917 #undef FROB | |
| 1918 } | |
| 1919 } | |
| 1920 | |
| 1921 #ifdef HAVE_SHLIB | |
| 1706 | 1922 EXTERN_C void unload_postgresql (void); |
| 996 | 1923 void |
| 1924 unload_postgresql (void) | |
| 1925 { | |
| 1926 #ifndef RUNNING_XEMACS_21_1 | |
| 1927 /* Remove defined types */ | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1928 UNDEF_LISP_OBJECT (pgconn); |
|
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1929 UNDEF_LISP_OBJECT (pgresult); |
| 996 | 1930 #endif |
| 1931 | |
| 1932 /* Remove staticpro'ing of symbols */ | |
| 1933 unstaticpro_nodump (&Qpostgresql); | |
| 1934 unstaticpro_nodump (&Qpgconnp); | |
| 1935 unstaticpro_nodump (&Qpgresultp); | |
| 1936 unstaticpro_nodump (&Qpg_connection_ok); | |
| 1937 unstaticpro_nodump (&Qpg_connection_bad); | |
| 1938 unstaticpro_nodump (&Qpg_connection_started); | |
| 1939 unstaticpro_nodump (&Qpg_connection_made); | |
| 1940 unstaticpro_nodump (&Qpg_connection_awaiting_response); | |
| 1941 unstaticpro_nodump (&Qpg_connection_auth_ok); | |
| 1942 unstaticpro_nodump (&Qpg_connection_setenv); | |
| 1943 unstaticpro_nodump (&Qpqdb); | |
| 1944 unstaticpro_nodump (&Qpquser); | |
| 1945 unstaticpro_nodump (&Qpqpass); | |
| 1946 unstaticpro_nodump (&Qpqhost); | |
| 1947 unstaticpro_nodump (&Qpqport); | |
| 1948 unstaticpro_nodump (&Qpqtty); | |
| 1949 unstaticpro_nodump (&Qpqoptions); | |
| 1950 unstaticpro_nodump (&Qpqstatus); | |
| 1951 unstaticpro_nodump (&Qpqerrormessage); | |
| 1952 unstaticpro_nodump (&Qpqbackendpid); | |
| 1953 unstaticpro_nodump (&Qpgres_empty_query); | |
| 1954 unstaticpro_nodump (&Qpgres_command_ok); | |
| 1955 unstaticpro_nodump (&Qpgres_tuples_ok); | |
| 1956 unstaticpro_nodump (&Qpgres_copy_out); | |
| 1957 unstaticpro_nodump (&Qpgres_copy_in); | |
| 1958 unstaticpro_nodump (&Qpgres_bad_response); | |
| 1959 unstaticpro_nodump (&Qpgres_nonfatal_error); | |
| 1960 unstaticpro_nodump (&Qpgres_fatal_error); | |
| 1961 unstaticpro_nodump (&Qpgres_polling_failed); | |
| 1962 unstaticpro_nodump (&Qpgres_polling_reading); | |
| 1963 unstaticpro_nodump (&Qpgres_polling_writing); | |
| 1964 unstaticpro_nodump (&Qpgres_polling_ok); | |
| 1965 unstaticpro_nodump (&Qpgres_polling_active); | |
| 1966 } | |
| 1967 #endif /* HAVE_SHLIB */ |