Mercurial > hg > xemacs-beta
annotate src/database.c @ 4981:4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_lo_import):
* postgresql/postgresql.c (Fpq_lo_export):
* ldap/eldap.c (Fldap_open):
* ldap/eldap.c (Fldap_search_basic):
* ldap/eldap.c (Fldap_add):
* ldap/eldap.c (Fldap_modify):
* ldap/eldap.c (Fldap_delete):
* canna/canna_api.c (Fcanna_initialize):
* canna/canna_api.c (Fcanna_store_yomi):
* canna/canna_api.c (Fcanna_parse):
* canna/canna_api.c (Fcanna_henkan_begin):
EXTERNAL_TO_C_STRING returns its argument instead of storing it
in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar
things happen to related macros. See entry in src/ChangeLog.
More Mule-izing of postgresql.c. Extract out common code
between `pq-connectdb' and `pq-connect-start'. Fix places
that signal an error string using a formatted string to instead
follow the standard and have a fixed reason followed by the
particular error message stored as one of the frobs.
src/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* console-msw.c (write_string_to_mswindows_debugging_output):
* console-msw.c (Fmswindows_message_box):
* console-x.c (x_perhaps_init_unseen_key_defaults):
* console.c:
* database.c (dbm_get):
* database.c (dbm_put):
* database.c (dbm_remove):
* database.c (berkdb_get):
* database.c (berkdb_put):
* database.c (berkdb_remove):
* database.c (Fopen_database):
* device-gtk.c (gtk_init_device):
* device-msw.c (msprinter_init_device_internal):
* device-msw.c (msprinter_default_printer):
* device-msw.c (msprinter_init_device):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (Fmsprinter_select_settings):
* device-x.c (sanity_check_geometry_resource):
* device-x.c (Dynarr_add_validified_lisp_string):
* device-x.c (x_init_device):
* device-x.c (Fx_put_resource):
* device-x.c (Fx_valid_keysym_name_p):
* device-x.c (Fx_set_font_path):
* dialog-msw.c (push_lisp_string_as_unicode):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* editfns.c (Fformat_time_string):
* editfns.c (Fencode_time):
* editfns.c (Fset_time_zone_rule):
* emacs.c (make_argc_argv):
* emacs.c (Fdump_emacs):
* emodules.c (emodules_load):
* eval.c:
* eval.c (maybe_signal_error_1):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* fileio.c (report_error_with_errno):
* fileio.c (Fsysnetunam):
* fileio.c (Fdo_auto_save):
* font-mgr.c (extract_fcapi_string):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_filename):
* frame-gtk.c (gtk_set_frame_text_value):
* frame-gtk.c (gtk_create_widgets):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_title_from_ibyte):
* frame-msw.c (msprinter_init_frame_3):
* frame-x.c (x_set_frame_text_value):
* frame-x.c (x_set_frame_properties):
* frame-x.c (start_drag_internal_1):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_create_widgets):
* glyphs-eimage.c (my_jpeg_output_message):
* glyphs-eimage.c (jpeg_instantiate):
* glyphs-eimage.c (gif_instantiate):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (xbm_instantiate_1):
* glyphs-gtk.c (gtk_xbm_instantiate):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-gtk.c (gtk_xface_instantiate):
* glyphs-gtk.c (cursor_font_instantiate):
* glyphs-gtk.c (gtk_redisplay_widget):
* glyphs-gtk.c (gtk_widget_instantiate_1):
* glyphs-gtk.c (gtk_add_tab_item):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (bmp_instantiate):
* glyphs-msw.c (mswindows_resource_instantiate):
* glyphs-msw.c (xbm_instantiate_1):
* glyphs-msw.c (mswindows_xbm_instantiate):
* glyphs-msw.c (mswindows_xface_instantiate):
* glyphs-msw.c (mswindows_redisplay_widget):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs-msw.c (add_tree_item):
* glyphs-msw.c (add_tab_item):
* glyphs-msw.c (mswindows_combo_box_instantiate):
* glyphs-msw.c (mswindows_widget_query_string_geometry):
* glyphs-x.c (x_locate_pixmap_file):
* glyphs-x.c (xbm_instantiate_1):
* glyphs-x.c (x_xbm_instantiate):
* glyphs-x.c (extract_xpm_color_names):
* glyphs-x.c (x_xpm_instantiate):
* glyphs-x.c (x_xface_instantiate):
* glyphs-x.c (autodetect_instantiate):
* glyphs-x.c (safe_XLoadFont):
* glyphs-x.c (cursor_font_instantiate):
* glyphs-x.c (x_redisplay_widget):
* glyphs-x.c (Fchange_subwindow_property):
* glyphs-x.c (x_widget_instantiate):
* glyphs-x.c (x_tab_control_redisplay):
* glyphs.c (pixmap_to_lisp_data):
* gui-x.c (menu_separator_style_and_to_external):
* gui-x.c (add_accel_and_to_external):
* gui-x.c (button_item_to_widget_value):
* hpplay.c (player_error_internal):
* hpplay.c (play_sound_file):
* hpplay.c (play_sound_data):
* intl.c (Fset_current_locale):
* lisp.h:
* menubar-gtk.c (gtk_xemacs_set_accel_keys):
* menubar-msw.c (populate_menu_add_item):
* menubar-msw.c (populate_or_checksum_helper):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c (init_user_info):
* nt.c (get_long_basename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_readdir):
* nt.c (read_unc_volume):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (mswindows_executable_type):
* nt.c (Fmswindows_short_file_name):
* ntplay.c (nt_play_sound_file):
* objects-gtk.c:
* objects-gtk.c (gtk_valid_color_name_p):
* objects-gtk.c (gtk_initialize_font_instance):
* objects-gtk.c (gtk_font_list):
* objects-msw.c (font_enum_callback_2):
* objects-msw.c (parse_font_spec):
* objects-x.c (x_parse_nearest_color):
* objects-x.c (x_valid_color_name_p):
* objects-x.c (x_initialize_font_instance):
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_font_list):
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_create_process):
* process-nt.c (get_internet_address):
* process-nt.c (nt_open_network_stream):
* process-unix.c:
* process-unix.c (allocate_pty):
* process-unix.c (get_internet_address):
* process-unix.c (unix_canonicalize_host_name):
* process-unix.c (unix_open_network_stream):
* realpath.c:
* select-common.h (lisp_data_to_selection_data):
* select-gtk.c (symbol_to_gtk_atom):
* select-gtk.c (atom_to_symbol):
* select-msw.c (symbol_to_ms_cf):
* select-msw.c (mswindows_register_selection_data_type):
* select-x.c (symbol_to_x_atom):
* select-x.c (x_atom_to_symbol):
* select-x.c (hack_motif_clipboard_selection):
* select-x.c (Fx_store_cutbuffer_internal):
* sound.c (Fplay_sound_file):
* sound.c (Fplay_sound):
* sound.h (sound_perror):
* sysdep.c:
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_execve):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_getpwnam):
* sysdep.c (qxe_ctime):
* sysdll.c (dll_open):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (search_linked_libs):
* sysdll.c (dll_error):
* sysfile.h:
* sysfile.h (PATHNAME_CONVERT_OUT_TSTR):
* sysfile.h (PATHNAME_CONVERT_OUT_UTF_8):
* sysfile.h (PATHNAME_CONVERT_OUT):
* sysfile.h (LISP_PATHNAME_CONVERT_OUT):
* syswindows.h (ITEXT_TO_TSTR):
* syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR):
* syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT):
* syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN):
* syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR):
* text.h:
* text.h (eicpy_ext_len):
* text.h (enum new_dfc_src_type):
* text.h (EXTERNAL_TO_ITEXT):
* text.h (GET_STRERROR):
* tooltalk.c (check_status):
* tooltalk.c (Fadd_tooltalk_message_arg):
* tooltalk.c (Fadd_tooltalk_pattern_attribute):
* tooltalk.c (Fadd_tooltalk_pattern_arg):
* win32.c (tstr_to_local_file_format):
* win32.c (mswindows_lisp_error_1):
* win32.c (mswindows_report_process_error):
* win32.c (Fmswindows_shell_execute):
* win32.c (mswindows_read_link_1):
Changes involving external/internal format conversion,
mostly code cleanup and renaming.
1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL
that stored its result in a parameter. The new version of
LISP_STRING_TO_EXTERNAL returns its result through the
return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL.
Use the new-style macros throughout the code.
2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL,
in keeping with overall naming rationalization involving
Itext and related types.
Macros involved in previous two:
EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT
EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC
SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT
SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC
C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL
C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC
LISP_STRING_TO_EXTERNAL
LISP_STRING_TO_EXTERNAL_MALLOC
LISP_STRING_TO_TSTR
C_STRING_TO_TSTR -> ITEXT_TO_TSTR
TSTR_TO_C_STRING -> TSTR_TO_ITEXT
The following four still return their values through parameters,
since they have more than one value to return:
C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL
LISP_STRING_TO_SIZED_EXTERNAL
C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC
LISP_STRING_TO_SIZED_EXTERNAL_MALLOC
Sometimes additional casts had to be inserted, since the old
macros played strange games and completely defeated the type system
of the store params.
3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT
occurred with calls to one of the convenience macros listed above,
or to make_extstring().
4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway)
and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT.
4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something
like LISP_STRING_TO_EXTERNAL(..., Qfile_name).
5. Eliminate some temporary variables that are no longer necessary
now that we return a value rather than storing it into a variable.
6. Some Mule-izing in database.c.
7. Error functions:
-- A bit of code cleanup in maybe_signal_error_1.
-- Eliminate report_file_type_error; it's just an alias for
signal_error_2 with params in a different order.
-- Fix some places in the hostname-handling code that directly
inserted externally-retrieved error strings into the
supposed ASCII "reason" param instead of doing the right thing
and sticking text descriptive of what was going on in "reason"
and putting the external message in a frob.
8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one
or two other places.
9. Some code cleanup in copy_in_passwd() in sysdep.c.
10. Fix a real bug due to accidental variable shadowing in
tstr_to_local_file_format() in win32.c.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Feb 2010 11:02:24 -0600 |
| parents | 304aebb79cd3 |
| children | 97c45e3ad810 |
| rev | line source |
|---|---|
| 428 | 1 /* Database access routines |
| 2 Copyright (C) 1996, William M. Perry | |
| 3025 | 3 Copyright (C) 2001, 2002, 2005 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 /* Written by Bill Perry */ | |
| 25 /* Substantially rewritten by Martin Buchholz */ | |
| 26 /* db 2.x support added by Andreas Jaeger */ | |
| 771 | 27 /* Mule-ized 6-22-00 Ben Wing */ |
| 428 | 28 |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 771 | 31 |
| 428 | 32 #include "sysfile.h" |
| 33 #include "buffer.h" | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
34 #include "file-coding.h" |
| 428 | 35 |
| 36 #ifndef HAVE_DATABASE | |
| 37 #error HAVE_DATABASE not defined!! | |
| 38 #endif | |
| 39 | |
| 40 #include "database.h" /* Our include file */ | |
| 41 | |
| 42 #ifdef HAVE_BERKELEY_DB | |
| 43 /* Work around Berkeley DB's use of int types which are defined | |
| 44 slightly differently in the not quite yet standard <inttypes.h>. | |
| 45 See db.h for details of why we're resorting to this... */ | |
| 46 /* glibc 2.1 doesn't have this problem with DB 2.x */ | |
| 47 #if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) | |
| 48 #ifdef HAVE_INTTYPES_H | |
| 3739 | 49 #ifndef __BIT_TYPES_DEFINED__ |
| 428 | 50 #define __BIT_TYPES_DEFINED__ |
| 3739 | 51 #endif |
| 428 | 52 #include <inttypes.h> |
| 3739 | 53 #if !HAVE_U_INT8_T |
| 428 | 54 typedef uint8_t u_int8_t; |
| 3739 | 55 #endif |
| 56 #if !HAVE_U_INT16_T | |
| 428 | 57 typedef uint16_t u_int16_t; |
| 3739 | 58 #endif |
| 59 #if !HAVE_U_INT32_T | |
| 428 | 60 typedef uint32_t u_int32_t; |
| 3739 | 61 #endif |
| 428 | 62 #ifdef WE_DONT_NEED_QUADS |
| 3739 | 63 #if !HAVE_U_INT64_T |
| 428 | 64 typedef uint64_t u_int64_t; |
| 3739 | 65 #endif |
| 428 | 66 #endif /* WE_DONT_NEED_QUADS */ |
| 67 #endif /* HAVE_INTTYPES_H */ | |
| 68 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */ | |
| 1460 | 69 /* Berkeley DB wants __STDC__ to be defined; else if does `#define const' */ |
| 70 #if ! defined (__STDC__) && ! defined(__cplusplus) | |
| 71 #define __STDC__ 0 | |
| 72 #endif | |
| 442 | 73 #include DB_H_FILE /* Berkeley db's header file */ |
| 428 | 74 #ifndef DB_VERSION_MAJOR |
| 75 # define DB_VERSION_MAJOR 1 | |
| 76 #endif /* DB_VERSION_MAJOR */ | |
| 1141 | 77 #ifndef DB_VERSION_MINOR |
| 78 # define DB_VERSION_MINOR 0 | |
| 79 #endif /* DB_VERSION_MINOR */ | |
| 428 | 80 Lisp_Object Qberkeley_db; |
| 81 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown; | |
| 448 | 82 #if DB_VERSION_MAJOR > 2 |
| 83 Lisp_Object Qqueue; | |
| 84 #endif | |
| 428 | 85 #endif /* HAVE_BERKELEY_DB */ |
| 86 | |
| 87 #ifdef HAVE_DBM | |
|
4837
493e2aa349fd
imported patch cygwin-headers-cosmetic-1-11-10
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
88 #ifdef CYGWIN_HEADERS |
|
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
89 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
90 #if defined(__cplusplus) || defined(c_plusplus) |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
91 extern "C" { |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
92 #endif |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
93 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
94 /* As of Cygwin 1.7.0, the prototypes in ndbm.h are broken when compiling |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
95 using C++, since they are of the form `datum dbm_firstkey()', without any |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
96 args given. */ |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
97 /* Parameters to dbm_store for simple insertion or replacement. */ |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
98 #define DBM_INSERT 0 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
99 #define DBM_REPLACE 1 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
100 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
101 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
102 /* The data and key structure. This structure is defined for compatibility. */ |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
103 typedef struct { |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
104 char *dptr; |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
105 int dsize; |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
106 } datum; |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
107 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
108 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
109 /* The file information header. This is good enough for most applications. */ |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
110 typedef struct {int dummy[10];} DBM; |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
111 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
112 int dbm_clearerr(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
113 void dbm_close(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
114 int dbm_delete(DBM *, datum); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
115 int dbm_error(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
116 datum dbm_fetch(DBM *, datum); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
117 datum dbm_firstkey(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
118 datum dbm_nextkey(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
119 DBM *dbm_open(const char *, int, mode_t); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
120 int dbm_store(DBM *, datum, datum, int); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
121 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
122 #if defined(__cplusplus) || defined(c_plusplus) |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
123 } |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
124 #endif |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
125 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
126 #else |
|
4699
0e1461b592ce
Check for gdbm/ndbm.h, too.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4351
diff
changeset
|
127 #include NDBM_H_FILE |
|
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
128 #endif |
| 428 | 129 Lisp_Object Qdbm; |
| 130 #endif /* HAVE_DBM */ | |
| 131 | |
| 132 Lisp_Object Vdatabase_coding_system; | |
| 133 | |
| 134 Lisp_Object Qdatabasep; | |
| 135 | |
| 136 typedef struct | |
| 137 { | |
| 138 Lisp_Object (*get_subtype) (Lisp_Database *); | |
| 139 Lisp_Object (*get_type) (Lisp_Database *); | |
| 140 Lisp_Object (*get) (Lisp_Database *, Lisp_Object); | |
| 141 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object); | |
| 142 int (*rem) (Lisp_Database *, Lisp_Object); | |
| 143 void (*map) (Lisp_Database *, Lisp_Object); | |
| 144 void (*close) (Lisp_Database *); | |
| 145 Lisp_Object (*last_error) (Lisp_Database *); | |
| 146 } DB_FUNCS; | |
| 147 | |
| 148 struct Lisp_Database | |
| 149 { | |
| 3017 | 150 struct LCRECORD_HEADER header; |
| 428 | 151 Lisp_Object fname; |
| 152 int mode; | |
| 153 int access_; | |
| 154 int dberrno; | |
| 155 int live_p; | |
| 156 #ifdef HAVE_DBM | |
| 157 DBM *dbm_handle; | |
| 158 #endif | |
| 159 #ifdef HAVE_BERKELEY_DB | |
| 160 DB *db_handle; | |
| 161 #endif | |
| 162 DB_FUNCS *funcs; | |
| 163 Lisp_Object coding_system; | |
| 164 }; | |
| 165 | |
| 166 #define XDATABASE(x) XRECORD (x, database, Lisp_Database) | |
| 617 | 167 #define wrap_database(p) wrap_record (p, database) |
| 428 | 168 #define DATABASEP(x) RECORDP (x, database) |
| 169 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) | |
| 170 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) | |
| 171 #define DATABASE_LIVE_P(x) (x->live_p) | |
| 172 | |
| 173 #define CHECK_LIVE_DATABASE(db) do { \ | |
| 174 CHECK_DATABASE (db); \ | |
| 175 if (!DATABASE_LIVE_P (XDATABASE(db))) \ | |
| 563 | 176 invalid_operation ("Attempting to access closed database", db); \ |
| 428 | 177 } while (0) |
| 178 | |
| 179 | |
| 180 static Lisp_Database * | |
| 181 allocate_database (void) | |
| 182 { | |
| 3017 | 183 Lisp_Database *db = ALLOC_LCRECORD_TYPE (Lisp_Database, &lrecord_database); |
| 428 | 184 |
| 185 db->fname = Qnil; | |
| 186 db->live_p = 0; | |
| 187 #ifdef HAVE_BERKELEY_DB | |
| 188 db->db_handle = NULL; | |
| 189 #endif | |
| 190 #ifdef HAVE_DBM | |
| 191 db->dbm_handle = NULL; | |
| 192 #endif | |
| 193 db->access_ = 0; | |
| 194 db->mode = 0; | |
| 195 db->dberrno = 0; | |
| 771 | 196 db->coding_system = Qnil; |
| 428 | 197 return db; |
| 198 } | |
| 199 | |
| 1204 | 200 static const struct memory_description database_description[] = { |
| 934 | 201 { XD_LISP_OBJECT, offsetof (struct Lisp_Database, fname) }, |
| 202 { XD_END} | |
| 203 }; | |
| 204 | |
| 428 | 205 static Lisp_Object |
| 444 | 206 mark_database (Lisp_Object object) |
| 428 | 207 { |
| 444 | 208 Lisp_Database *db = XDATABASE (object); |
| 428 | 209 return db->fname; |
| 210 } | |
| 211 | |
| 212 static void | |
| 2286 | 213 print_database (Lisp_Object obj, Lisp_Object printcharfun, |
| 214 int UNUSED (escapeflag)) | |
| 428 | 215 { |
| 216 Lisp_Database *db = XDATABASE (obj); | |
| 217 | |
| 218 if (print_readably) | |
| 4846 | 219 printing_unreadable_lcrecord (obj, 0); |
| 428 | 220 |
| 793 | 221 write_fmt_string_lisp (printcharfun, "#<database \"%s\" (%s/%s/", |
| 222 3, db->fname, db->funcs->get_type (db), | |
| 223 db->funcs->get_subtype (db)); | |
| 224 | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
225 write_fmt_string (printcharfun, "%s) ", |
| 793 | 226 (!DATABASE_LIVE_P (db) ? "closed" : |
| 227 (db->access_ & O_WRONLY) ? "writeonly" : | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
228 (db->access_ & O_RDWR) ? "readwrite" : "readonly")); |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
229 |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
230 write_fmt_string_lisp (printcharfun, "coding: %s ", 1, |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
231 XSYMBOL_NAME (XCODING_SYSTEM_NAME |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
232 (db->coding_system))); |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
233 |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
234 write_fmt_string (printcharfun, "0x%x>", db->header.uid); |
| 428 | 235 } |
| 236 | |
| 237 static void | |
| 238 finalize_database (void *header, int for_disksave) | |
| 239 { | |
| 240 Lisp_Database *db = (Lisp_Database *) header; | |
| 241 | |
| 242 if (for_disksave) | |
| 243 { | |
| 563 | 244 invalid_operation |
| 793 | 245 ("Can't dump an emacs containing database objects", |
| 246 wrap_database (db)); | |
| 428 | 247 } |
| 248 db->funcs->close (db); | |
| 249 } | |
| 250 | |
| 934 | 251 DEFINE_LRECORD_IMPLEMENTATION ("database", database, |
| 252 0, /*dumpable-flag*/ | |
| 253 mark_database, print_database, | |
| 254 finalize_database, 0, 0, | |
| 255 database_description, | |
| 256 Lisp_Database); | |
| 428 | 257 |
| 258 DEFUN ("close-database", Fclose_database, 1, 1, 0, /* | |
| 259 Close database DATABASE. | |
| 260 */ | |
| 261 (database)) | |
| 262 { | |
| 263 Lisp_Database *db; | |
| 264 CHECK_LIVE_DATABASE (database); | |
| 265 db = XDATABASE (database); | |
| 266 db->funcs->close (db); | |
| 267 db->live_p = 0; | |
| 268 return Qnil; | |
| 269 } | |
| 270 | |
| 271 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /* | |
| 272 Return the type of database DATABASE. | |
| 273 */ | |
| 274 (database)) | |
| 275 { | |
| 276 CHECK_DATABASE (database); | |
| 277 | |
| 278 return XDATABASE (database)->funcs->get_type (XDATABASE (database)); | |
| 279 } | |
| 280 | |
| 281 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* | |
| 282 Return the subtype of database DATABASE, if any. | |
| 283 */ | |
| 284 (database)) | |
| 285 { | |
| 286 CHECK_DATABASE (database); | |
| 287 | |
| 288 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database)); | |
| 289 } | |
| 290 | |
| 291 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* | |
| 444 | 292 Return t if OBJECT is an active database. |
| 428 | 293 */ |
| 444 | 294 (object)) |
| 428 | 295 { |
| 444 | 296 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ? |
| 297 Qt : Qnil; | |
| 428 | 298 } |
| 299 | |
| 300 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* | |
| 301 Return the filename associated with the database DATABASE. | |
| 302 */ | |
| 303 (database)) | |
| 304 { | |
| 305 CHECK_DATABASE (database); | |
| 306 | |
| 307 return XDATABASE (database)->fname; | |
| 308 } | |
| 309 | |
| 310 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* | |
| 444 | 311 Return t if OBJECT is a database. |
| 428 | 312 */ |
| 444 | 313 (object)) |
| 428 | 314 { |
| 444 | 315 return DATABASEP (object) ? Qt : Qnil; |
| 428 | 316 } |
| 317 | |
| 318 #ifdef HAVE_DBM | |
| 319 static void | |
| 320 dbm_map (Lisp_Database *db, Lisp_Object func) | |
| 321 { | |
| 322 datum keydatum, valdatum; | |
| 323 Lisp_Object key, val; | |
| 324 | |
| 325 for (keydatum = dbm_firstkey (db->dbm_handle); | |
| 326 keydatum.dptr != NULL; | |
| 327 keydatum = dbm_nextkey (db->dbm_handle)) | |
| 328 { | |
| 329 valdatum = dbm_fetch (db->dbm_handle, keydatum); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
330 key = make_extstring ((Extbyte *) keydatum.dptr, keydatum.dsize, |
| 771 | 331 db->coding_system); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
332 val = make_extstring ((Extbyte *) valdatum.dptr, valdatum.dsize, |
| 771 | 333 db->coding_system); |
| 428 | 334 call2 (func, key, val); |
| 335 } | |
| 336 } | |
| 337 | |
| 338 static Lisp_Object | |
| 339 dbm_get (Lisp_Database *db, Lisp_Object key) | |
| 340 { | |
| 341 datum keydatum, valdatum; | |
| 342 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
343 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
344 db->coding_system); |
| 428 | 345 valdatum = dbm_fetch (db->dbm_handle, keydatum); |
| 346 | |
| 347 return (valdatum.dptr | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
348 ? make_extstring ((Extbyte *) valdatum.dptr, valdatum.dsize, |
| 771 | 349 db->coding_system) |
| 428 | 350 : Qnil); |
| 351 } | |
| 352 | |
| 353 static int | |
| 354 dbm_put (Lisp_Database *db, | |
| 355 Lisp_Object key, Lisp_Object val, Lisp_Object replace) | |
| 356 { | |
| 357 datum keydatum, valdatum; | |
| 358 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
359 LISP_STRING_TO_SIZED_EXTERNAL (val, valdatum.dptr, valdatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
360 db->coding_system); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
361 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
362 db->coding_system); |
| 428 | 363 |
| 364 return !dbm_store (db->dbm_handle, keydatum, valdatum, | |
| 365 NILP (replace) ? DBM_INSERT : DBM_REPLACE); | |
| 366 } | |
| 367 | |
| 368 static int | |
| 369 dbm_remove (Lisp_Database *db, Lisp_Object key) | |
| 370 { | |
| 371 datum keydatum; | |
| 372 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
373 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
374 db->coding_system); |
| 428 | 375 |
| 376 return dbm_delete (db->dbm_handle, keydatum); | |
| 377 } | |
| 378 | |
| 379 static Lisp_Object | |
| 2494 | 380 dbm_type (Lisp_Database *UNUSED (db)) |
| 428 | 381 { |
| 382 return Qdbm; | |
| 383 } | |
| 384 | |
| 385 static Lisp_Object | |
| 2494 | 386 dbm_subtype (Lisp_Database *UNUSED (db)) |
| 428 | 387 { |
| 388 return Qnil; | |
| 389 } | |
| 390 | |
| 391 static Lisp_Object | |
| 392 dbm_lasterr (Lisp_Database *db) | |
| 393 { | |
| 394 return lisp_strerror (db->dberrno); | |
| 395 } | |
| 396 | |
| 397 static void | |
| 398 dbm_closeit (Lisp_Database *db) | |
| 399 { | |
| 400 if (db->dbm_handle) | |
| 401 { | |
| 402 dbm_close (db->dbm_handle); | |
| 403 db->dbm_handle = NULL; | |
| 404 } | |
| 405 } | |
| 406 | |
| 407 static DB_FUNCS ndbm_func_block = | |
| 408 { | |
| 409 dbm_subtype, | |
| 410 dbm_type, | |
| 411 dbm_get, | |
| 412 dbm_put, | |
| 413 dbm_remove, | |
| 414 dbm_map, | |
| 415 dbm_closeit, | |
| 416 dbm_lasterr | |
| 417 }; | |
| 418 #endif /* HAVE_DBM */ | |
| 419 | |
| 420 #ifdef HAVE_BERKELEY_DB | |
| 421 static Lisp_Object | |
| 2286 | 422 berkdb_type (Lisp_Database *UNUSED (db)) |
| 428 | 423 { |
| 424 return Qberkeley_db; | |
| 425 } | |
| 426 | |
| 427 static Lisp_Object | |
| 428 berkdb_subtype (Lisp_Database *db) | |
| 429 { | |
| 430 if (!db->db_handle) | |
| 431 return Qnil; | |
| 432 | |
| 433 switch (db->db_handle->type) | |
| 434 { | |
| 435 case DB_BTREE: return Qbtree; | |
| 436 case DB_HASH: return Qhash; | |
| 437 case DB_RECNO: return Qrecno; | |
| 448 | 438 #if DB_VERSION_MAJOR > 2 |
| 439 case DB_QUEUE: return Qqueue; | |
| 440 #endif | |
| 428 | 441 default: return Qunknown; |
| 442 } | |
| 443 } | |
| 444 | |
| 445 static Lisp_Object | |
| 446 berkdb_lasterr (Lisp_Database *db) | |
| 447 { | |
| 448 return lisp_strerror (db->dberrno); | |
| 449 } | |
| 450 | |
| 451 static Lisp_Object | |
| 452 berkdb_get (Lisp_Database *db, Lisp_Object key) | |
| 453 { | |
| 454 DBT keydatum, valdatum; | |
| 455 int status = 0; | |
| 456 | |
| 457 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
| 458 xzero (keydatum); | |
| 459 xzero (valdatum); | |
| 460 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
461 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
462 db->coding_system); |
| 428 | 463 |
| 464 #if DB_VERSION_MAJOR == 1 | |
| 465 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0); | |
| 466 #else | |
| 467 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); | |
| 468 #endif /* DB_VERSION_MAJOR */ | |
| 469 | |
| 470 if (!status) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
471 return make_extstring ((const Extbyte *) valdatum.data, valdatum.size, |
| 771 | 472 db->coding_system); |
| 428 | 473 |
| 474 #if DB_VERSION_MAJOR == 1 | |
| 475 db->dberrno = (status == 1) ? -1 : errno; | |
| 476 #else | |
| 477 db->dberrno = (status < 0) ? -1 : errno; | |
| 478 #endif /* DB_VERSION_MAJOR */ | |
| 479 | |
| 480 return Qnil; | |
| 481 } | |
| 482 | |
| 483 static int | |
| 484 berkdb_put (Lisp_Database *db, | |
| 485 Lisp_Object key, | |
| 486 Lisp_Object val, | |
| 487 Lisp_Object replace) | |
| 488 { | |
| 489 DBT keydatum, valdatum; | |
| 490 int status = 0; | |
| 491 | |
| 492 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
| 493 xzero (keydatum); | |
| 494 xzero (valdatum); | |
| 495 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
496 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
497 db->coding_system); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
498 LISP_STRING_TO_SIZED_EXTERNAL (val, valdatum.data, valdatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
499 db->coding_system); |
| 428 | 500 #if DB_VERSION_MAJOR == 1 |
| 501 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum, | |
| 502 NILP (replace) ? R_NOOVERWRITE : 0); | |
| 503 db->dberrno = (status == 1) ? -1 : errno; | |
| 504 #else | |
| 505 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum, | |
| 506 NILP (replace) ? DB_NOOVERWRITE : 0); | |
| 507 db->dberrno = (status < 0) ? -1 : errno; | |
| 508 #endif/* DV_VERSION_MAJOR = 2 */ | |
| 509 | |
| 510 return status; | |
| 511 } | |
| 512 | |
| 513 static int | |
| 514 berkdb_remove (Lisp_Database *db, Lisp_Object key) | |
| 515 { | |
| 516 DBT keydatum; | |
| 517 int status; | |
| 518 | |
| 519 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
| 520 xzero (keydatum); | |
| 521 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
522 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
523 db->coding_system); |
| 428 | 524 |
| 525 #if DB_VERSION_MAJOR == 1 | |
| 526 status = db->db_handle->del (db->db_handle, &keydatum, 0); | |
| 527 #else | |
| 528 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0); | |
| 529 #endif /* DB_VERSION_MAJOR */ | |
| 530 | |
| 531 if (!status) | |
| 532 return 0; | |
| 533 | |
| 534 #if DB_VERSION_MAJOR == 1 | |
| 535 db->dberrno = (status == 1) ? -1 : errno; | |
| 536 #else | |
| 537 db->dberrno = (status < 0) ? -1 : errno; | |
| 538 #endif /* DB_VERSION_MAJOR */ | |
| 539 | |
| 540 return 1; | |
| 541 } | |
| 542 | |
| 543 static void | |
| 544 berkdb_map (Lisp_Database *db, Lisp_Object func) | |
| 545 { | |
| 546 DBT keydatum, valdatum; | |
| 547 Lisp_Object key, val; | |
| 548 DB *dbp = db->db_handle; | |
| 549 int status; | |
| 550 | |
| 551 xzero (keydatum); | |
| 552 xzero (valdatum); | |
| 553 | |
| 554 #if DB_VERSION_MAJOR == 1 | |
| 555 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); | |
| 556 status == 0; | |
| 557 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) | |
| 558 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
559 key = make_extstring ((const Extbyte *) keydatum.data, keydatum.size, |
| 771 | 560 db->coding_system); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
561 val = make_extstring ((const Extbyte *) valdatum.data, valdatum.size, |
| 771 | 562 db->coding_system); |
| 428 | 563 call2 (func, key, val); |
| 564 } | |
| 565 #else | |
| 566 { | |
| 567 DBC *dbcp; | |
| 568 | |
| 569 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6 | |
| 570 status = dbp->cursor (dbp, NULL, &dbcp, 0); | |
| 571 #else | |
| 572 status = dbp->cursor (dbp, NULL, &dbcp); | |
| 440 | 573 #endif |
| 428 | 574 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); |
| 575 status == 0; | |
| 576 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) | |
| 577 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
578 key = make_extstring ((const Extbyte *) keydatum.data, keydatum.size, |
| 771 | 579 db->coding_system); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
580 val = make_extstring ((const Extbyte *) valdatum.data, valdatum.size, |
| 771 | 581 db->coding_system); |
| 428 | 582 call2 (func, key, val); |
| 583 } | |
| 584 dbcp->c_close (dbcp); | |
| 585 } | |
| 586 #endif /* DB_VERSION_MAJOR */ | |
| 587 } | |
| 588 | |
| 589 static void | |
| 590 berkdb_close (Lisp_Database *db) | |
| 591 { | |
| 592 if (db->db_handle) | |
| 593 { | |
| 594 #if DB_VERSION_MAJOR == 1 | |
| 595 db->db_handle->sync (db->db_handle, 0); | |
| 596 db->db_handle->close (db->db_handle); | |
| 597 #else | |
| 598 db->db_handle->sync (db->db_handle, 0); | |
| 599 db->db_handle->close (db->db_handle, 0); | |
| 600 #endif /* DB_VERSION_MAJOR */ | |
| 601 db->db_handle = NULL; | |
| 602 } | |
| 603 } | |
| 604 | |
| 605 static DB_FUNCS berk_func_block = | |
| 606 { | |
| 607 berkdb_subtype, | |
| 608 berkdb_type, | |
| 609 berkdb_get, | |
| 610 berkdb_put, | |
| 611 berkdb_remove, | |
| 612 berkdb_map, | |
| 613 berkdb_close, | |
| 614 berkdb_lasterr | |
| 615 }; | |
| 616 #endif /* HAVE_BERKELEY_DB */ | |
| 617 | |
| 618 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /* | |
| 619 Return the last error associated with DATABASE. | |
| 620 */ | |
| 621 (database)) | |
| 622 { | |
| 623 if (NILP (database)) | |
| 624 return lisp_strerror (errno); | |
| 625 | |
| 626 CHECK_DATABASE (database); | |
| 627 | |
| 628 return XDATABASE (database)->funcs->last_error (XDATABASE (database)); | |
| 629 } | |
| 630 | |
| 771 | 631 DEFUN ("open-database", Fopen_database, 1, 6, 0, /* |
| 428 | 632 Return a new database object opened on FILE. |
| 633 Optional arguments TYPE and SUBTYPE specify the database type. | |
| 634 Optional argument ACCESS specifies the access rights, which may be any | |
| 635 combination of 'r' 'w' and '+', for read, write, and creation flags. | |
| 636 Optional argument MODE gives the permissions to use when opening FILE, | |
| 637 and defaults to 0755. | |
| 771 | 638 Optional argument CODESYS specifies the coding system used to encode/decode |
| 639 data passed to/from the database, and defaults to the value of the | |
| 640 variable `database-coding-system'. | |
| 428 | 641 */ |
| 771 | 642 (file, type, subtype, access_, mode, codesys)) |
| 428 | 643 { |
| 644 /* This function can GC */ | |
| 645 int modemask; | |
| 646 int accessmask = 0; | |
| 647 Lisp_Database *db = NULL; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
648 Extbyte *filename; |
| 428 | 649 struct gcpro gcpro1, gcpro2; |
| 650 | |
| 651 CHECK_STRING (file); | |
| 652 GCPRO2 (file, access_); | |
| 653 file = Fexpand_file_name (file, Qnil); | |
| 654 UNGCPRO; | |
| 655 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
656 LISP_PATHNAME_CONVERT_OUT (file, filename); |
| 428 | 657 |
| 658 if (NILP (access_)) | |
| 659 { | |
| 660 accessmask = O_RDWR | O_CREAT; | |
| 661 } | |
| 662 else | |
| 663 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
664 Ibyte *acc; |
| 428 | 665 CHECK_STRING (access_); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
666 acc = XSTRING_DATA (access_); |
| 428 | 667 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
668 if (qxestrchr (acc, '+')) |
| 428 | 669 accessmask |= O_CREAT; |
| 670 | |
| 671 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
672 int rp = !!qxestrchr (acc, 'r'); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
673 int wp = !!qxestrchr (acc, 'w'); |
| 428 | 674 if (rp && wp) accessmask |= O_RDWR; |
| 675 else if (wp) accessmask |= O_WRONLY; | |
| 676 else accessmask |= O_RDONLY; | |
| 677 } | |
| 678 } | |
| 679 | |
| 680 if (NILP (mode)) | |
| 681 { | |
| 682 modemask = 0755; /* rwxr-xr-x */ | |
| 683 } | |
| 684 else | |
| 685 { | |
| 686 CHECK_INT (mode); | |
| 687 modemask = XINT (mode); | |
| 688 } | |
| 689 | |
| 771 | 690 if (NILP (codesys)) |
| 691 codesys = Vdatabase_coding_system; | |
| 692 | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
693 codesys = get_coding_system_for_text_file (codesys, 0); |
| 771 | 694 |
| 428 | 695 #ifdef HAVE_DBM |
| 696 if (NILP (type) || EQ (type, Qdbm)) | |
| 697 { | |
| 698 DBM *dbase = dbm_open (filename, accessmask, modemask); | |
| 699 if (!dbase) | |
| 700 return Qnil; | |
| 701 | |
| 702 db = allocate_database (); | |
| 703 db->dbm_handle = dbase; | |
| 704 db->funcs = &ndbm_func_block; | |
| 771 | 705 db->coding_system = codesys; |
| 428 | 706 goto db_done; |
| 707 } | |
| 708 #endif /* HAVE_DBM */ | |
| 709 | |
| 710 #ifdef HAVE_BERKELEY_DB | |
| 711 if (NILP (type) || EQ (type, Qberkeley_db)) | |
| 712 { | |
| 713 DBTYPE real_subtype; | |
| 714 DB *dbase; | |
| 715 #if DB_VERSION_MAJOR != 1 | |
| 716 int status; | |
| 717 #endif | |
| 718 | |
| 719 if (EQ (subtype, Qhash) || NILP (subtype)) | |
| 720 real_subtype = DB_HASH; | |
| 721 else if (EQ (subtype, Qbtree)) | |
| 722 real_subtype = DB_BTREE; | |
| 723 else if (EQ (subtype, Qrecno)) | |
| 724 real_subtype = DB_RECNO; | |
| 448 | 725 #if DB_VERSION_MAJOR > 2 |
| 726 else if (EQ (subtype, Qqueue)) | |
| 727 real_subtype = DB_QUEUE; | |
| 728 #endif | |
| 428 | 729 else |
| 563 | 730 invalid_constant ("Unsupported subtype", subtype); |
| 428 | 731 |
| 732 #if DB_VERSION_MAJOR == 1 | |
| 733 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL); | |
| 734 if (!dbase) | |
| 735 return Qnil; | |
| 736 #else | |
| 737 /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY, | |
| 738 other flags shouldn't be set */ | |
| 739 if (NILP (access_)) | |
| 740 accessmask = DB_CREATE; | |
| 741 else | |
| 742 { | |
| 743 char *acc; | |
| 744 CHECK_STRING (access_); | |
| 745 acc = (char *) XSTRING_DATA (access_); | |
| 746 accessmask = 0; | |
| 747 | |
| 748 if (strchr (acc, '+')) | |
| 749 accessmask |= DB_CREATE; | |
| 750 | |
| 751 if (strchr (acc, 'r') && !strchr (acc, 'w')) | |
| 752 accessmask |= DB_RDONLY; | |
| 753 } | |
| 448 | 754 #if DB_VERSION_MAJOR == 2 |
| 428 | 755 status = db_open (filename, real_subtype, accessmask, |
| 756 modemask, NULL , NULL, &dbase); | |
| 757 if (status) | |
| 758 return Qnil; | |
| 448 | 759 #else |
| 760 status = db_create (&dbase, NULL, 0); | |
| 761 if (status) | |
| 762 return Qnil; | |
| 1141 | 763 #if DB_VERSION_MAJOR < 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR < 1) |
| 448 | 764 status = dbase->open (dbase, filename, NULL, |
| 765 real_subtype, accessmask, modemask); | |
| 1141 | 766 #else /* DB_VERSION >= 4.1 */ |
| 1377 | 767 /* You can't use DB_AUTO_COMMIT unless you have a txn environment. */ |
| 1141 | 768 status = dbase->open (dbase, NULL, filename, NULL, real_subtype, |
| 1377 | 769 accessmask, modemask); |
| 1141 | 770 #endif /* DB_VERSION < 4.1 */ |
| 448 | 771 if (status) |
| 772 { | |
| 773 dbase->close (dbase, 0); | |
| 774 return Qnil; | |
| 775 } | |
| 776 #endif /* DB_VERSION_MAJOR > 2 */ | |
| 777 /* Normalize into system specific file modes. Only for printing */ | |
| 778 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR; | |
| 428 | 779 #endif /* DB_VERSION_MAJOR */ |
| 780 | |
| 781 db = allocate_database (); | |
| 782 db->db_handle = dbase; | |
| 783 db->funcs = &berk_func_block; | |
| 771 | 784 db->coding_system = codesys; |
| 428 | 785 goto db_done; |
| 786 } | |
| 787 #endif /* HAVE_BERKELEY_DB */ | |
| 788 | |
| 563 | 789 invalid_constant ("Unsupported database type", type); |
| 428 | 790 return Qnil; |
| 791 | |
| 792 db_done: | |
| 793 db->live_p = 1; | |
| 794 db->fname = file; | |
| 795 db->mode = modemask; | |
| 796 db->access_ = accessmask; | |
| 797 | |
| 793 | 798 return wrap_database (db); |
| 428 | 799 } |
| 800 | |
| 801 DEFUN ("put-database", Fput_database, 3, 4, 0, /* | |
| 802 Store KEY and VALUE in DATABASE. | |
| 803 If optional fourth arg REPLACE is non-nil, | |
| 804 replace any existing entry in the database. | |
| 805 */ | |
| 806 (key, value, database, replace)) | |
| 807 { | |
| 808 CHECK_LIVE_DATABASE (database); | |
| 809 CHECK_STRING (key); | |
| 810 CHECK_STRING (value); | |
| 811 { | |
| 812 Lisp_Database *db = XDATABASE (database); | |
| 813 int status = db->funcs->put (db, key, value, replace); | |
| 814 return status ? Qt : Qnil; | |
| 815 } | |
| 816 } | |
| 817 | |
| 818 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /* | |
| 819 Remove KEY from DATABASE. | |
| 820 */ | |
| 821 (key, database)) | |
| 822 { | |
| 823 CHECK_LIVE_DATABASE (database); | |
| 824 CHECK_STRING (key); | |
| 825 { | |
| 826 Lisp_Database *db = XDATABASE (database); | |
| 827 int status = db->funcs->rem (db, key); | |
| 828 return status ? Qt : Qnil; | |
| 829 } | |
| 830 } | |
| 831 | |
| 832 DEFUN ("get-database", Fget_database, 2, 3, 0, /* | |
| 833 Return value for KEY in DATABASE. | |
| 834 If there is no corresponding value, return DEFAULT (defaults to nil). | |
| 835 */ | |
| 836 (key, database, default_)) | |
| 837 { | |
| 838 CHECK_LIVE_DATABASE (database); | |
| 839 CHECK_STRING (key); | |
| 840 { | |
| 841 Lisp_Database *db = XDATABASE (database); | |
| 842 Lisp_Object retval = db->funcs->get (db, key); | |
| 843 return NILP (retval) ? default_ : retval; | |
| 844 } | |
| 845 } | |
| 846 | |
| 847 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* | |
| 848 Map FUNCTION over entries in DATABASE, calling it with two args, | |
| 849 each key and value in the database. | |
| 850 */ | |
| 851 (function, database)) | |
| 852 { | |
| 853 CHECK_LIVE_DATABASE (database); | |
| 854 | |
| 855 XDATABASE (database)->funcs->map (XDATABASE (database), function); | |
| 856 | |
| 857 return Qnil; | |
| 858 } | |
| 859 | |
| 860 void | |
| 861 syms_of_database (void) | |
| 862 { | |
| 442 | 863 INIT_LRECORD_IMPLEMENTATION (database); |
| 864 | |
| 563 | 865 DEFSYMBOL (Qdatabasep); |
| 428 | 866 #ifdef HAVE_DBM |
| 563 | 867 DEFSYMBOL (Qdbm); |
| 428 | 868 #endif |
| 869 #ifdef HAVE_BERKELEY_DB | |
| 563 | 870 DEFSYMBOL (Qberkeley_db); |
| 871 DEFSYMBOL (Qhash); | |
| 872 DEFSYMBOL (Qbtree); | |
| 873 DEFSYMBOL (Qrecno); | |
| 448 | 874 #if DB_VERSION_MAJOR > 2 |
| 563 | 875 DEFSYMBOL (Qqueue); |
| 448 | 876 #endif |
| 563 | 877 DEFSYMBOL (Qunknown); |
| 428 | 878 #endif |
| 879 | |
| 880 DEFSUBR (Fopen_database); | |
| 881 DEFSUBR (Fdatabasep); | |
| 882 DEFSUBR (Fmapdatabase); | |
| 883 DEFSUBR (Fput_database); | |
| 884 DEFSUBR (Fget_database); | |
| 885 DEFSUBR (Fremove_database); | |
| 886 DEFSUBR (Fdatabase_type); | |
| 887 DEFSUBR (Fdatabase_subtype); | |
| 888 DEFSUBR (Fdatabase_last_error); | |
| 889 DEFSUBR (Fdatabase_live_p); | |
| 890 DEFSUBR (Fdatabase_file_name); | |
| 891 DEFSUBR (Fclose_database); | |
| 892 } | |
| 893 | |
| 894 void | |
| 895 vars_of_database (void) | |
| 896 { | |
| 897 #ifdef HAVE_DBM | |
| 898 Fprovide (Qdbm); | |
| 899 #endif | |
| 900 #ifdef HAVE_BERKELEY_DB | |
| 901 Fprovide (Qberkeley_db); | |
| 902 #endif | |
| 903 | |
| 904 DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /* | |
| 771 | 905 Default coding system used to convert data in database files. |
| 428 | 906 */ ); |
| 771 | 907 Vdatabase_coding_system = Qnative; |
| 428 | 908 } |