;;;
;;; gdbm.stub - gdbm interface
;;;  
;;;   Copyright (c) 2000-2007  Shiro Kawai  <shiro@acm.org>
;;;   
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;   
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;  
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;  
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;  
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;  
;;;  $Id: gdbm.stub,v 1.24 2007/03/22 11:20:15 shirok Exp $
;;;

"
 #include <gdbm.h>
 #include <stdlib.h>
 #include <gauche/extend.h>

 SCM_CLASS_DECL(Scm_GdbmClass);
 static void gdbm_print(ScmObj, ScmPort *, ScmWriteContext*);
 SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_GdbmClass, gdbm_print);

 #define SCM_CLASS_GDBM       (&Scm_GdbmClass)
 #define SCM_GDBM(obj)        ((ScmGdbm*)obj)
 #define SCM_GDBMP(obj)       SCM_XTYPEP(obj, SCM_CLASS_GDBM)

 typedef struct ScmGdbmRec {
    SCM_HEADER;
    ScmObj name;
    GDBM_FILE dbf;              /* NULL if closed */
 } ScmGdbm;

 static void gdbm_print(ScmObj obj, ScmPort *out, ScmWriteContext *ctx)
 {
    Scm_Printf(out, \"#<gdbm-file %S>\", SCM_GDBM(obj)->name);
 }

 #define TO_DATUM(datum_, scm_)                     \\
   do {                                             \\
     const ScmStringBody *b = SCM_STRING_BODY(scm_);\\
     datum_.dptr = (char*)SCM_STRING_BODY_START(b); \\
     datum_.dsize = SCM_STRING_BODY_SIZE(b);        \\
   } while (0)
 #define FROM_DATUM(scm_, datum_)           \\
   do {                                     \\
     if (datum_.dptr) {                     \\
       scm_ = Scm_MakeString(datum_.dptr, datum_.dsize, -1, SCM_STRING_COPYING); \\
       free(datum_.dptr);                   \\
     } else {                               \\
       scm_ = SCM_FALSE;                    \\
     }                                      \\
   } while (0)

 #define CHECK_GDBM(g)    if (!g->dbf) Scm_Error(\"gdbm file already closed: %S\", g)

 /* Those symbols may not be defined in the older gdbm */
 #ifndef GDBM_SYNC
 #define GDBM_SYNC 0
 #endif
 #ifndef GDBM_NOLOCK
 #define GDBM_NOLOCK 0
 #endif
 #ifndef GDBM_SYNCMODE
 #define GDBM_SYNCMODE 0
 #endif
 #ifndef GDBM_CENTFREE
 #define GDBM_CENTFREE 0
 #endif
 #ifndef GDBM_COALESCEBLKS
 #define GDBM_COALESCEBLKS 0
 #endif

 /* Hack for initialization stub */
 static void Scm_gdbm_internal_init(ScmModule*);
 void Scm_Init_gdbm(void)
 {
    ScmModule *mod;
    SCM_INIT_EXTENSION(gdbm);
    mod = SCM_FIND_MODULE(\"dbm.gdbm\", SCM_FIND_MODULE_CREATE);
    Scm_InitStaticClass(&Scm_GdbmClass, \"<gdbm-file>\", mod, NULL, 0);
    Scm_gdbm_internal_init(mod);
 }
 #define Scm_Init_gdbm  Scm_gdbm_internal_init
"

(define-type <gdbm> "ScmGdbm*")

;; finalization
"static void gdbm_finalize(ScmObj obj, void *data)
 {
    ScmGdbm *g = SCM_GDBM(obj);
    if (g->dbf) { gdbm_close(g->dbf); g->dbf = NULL; }
 }
"


(define-cproc gdbm-open (name::<string>
                         &optional (size::<fixnum> 0)
                                   (rwmode::<fixnum> (c "SCM_MAKE_INT(GDBM_READER)"))
                                   (fmode::<fixnum> (c "SCM_MAKE_INT(0666)")))
  "ScmGdbm *z = SCM_NEW(ScmGdbm);
  SCM_SET_CLASS(z, SCM_CLASS_GDBM);
  Scm_RegisterFinalizer(SCM_OBJ(z), gdbm_finalize, NULL);
  z->name = SCM_OBJ(name);
  z->dbf = gdbm_open(Scm_GetString(name), size, rwmode, fmode, NULL);
  if (z->dbf == NULL) Scm_Error(\"couldn't open gdbm file %S (gdbm_errno=%d)\", name, gdbm_errno);
  SCM_RETURN(SCM_OBJ(z));")

(define-cproc gdbm-close (gdbm::<gdbm>)
  (body <void>
        "CHECK_GDBM(gdbm);"
        "if (gdbm->dbf) {"
        "  gdbm_close(gdbm->dbf);"
        "  gdbm->dbf = NULL;"
        "}"))

(define-cproc gdbm-closed? (gdbm::<gdbm>)
  (expr <boolean> "gdbm->dbf == NULL"))

(define-cproc gdbm-store (gdbm::<gdbm> key::<string> val::<string>
                                       &optional (flags::<fixnum> 0))
  (body <int>
        "datum dkey, dval;"
        "CHECK_GDBM(gdbm);"
        "TO_DATUM(dkey, key);"
        "TO_DATUM(dval, val);"
        "SCM_RESULT = gdbm_store(gdbm->dbf, dkey, dval, flags);"))

(define-cproc gdbm-fetch (gdbm::<gdbm> key::<string>)
  (body "datum dkey, dval;"
        "CHECK_GDBM(gdbm);"
        "TO_DATUM(dkey, key);"
        "dval = gdbm_fetch(gdbm->dbf, dkey);"
        "FROM_DATUM(SCM_RESULT, dval);"))

(define-cproc gdbm-delete (gdbm::<gdbm> key::<string>)
  (body <int>
        "datum dkey;"
        "CHECK_GDBM(gdbm);"
        "TO_DATUM(dkey, key);"
        "SCM_RESULT = gdbm_delete(gdbm->dbf, dkey);"))

(define-cproc gdbm-firstkey (gdbm::<gdbm>)
  (body "datum dkey = gdbm_firstkey(gdbm->dbf);"
        "FROM_DATUM(SCM_RESULT, dkey);"))

(define-cproc gdbm-nextkey (gdbm::<gdbm> key::<string>)
  (body "datum dkey, dnkey;"
        "CHECK_GDBM(gdbm);"
        "TO_DATUM(dkey, key);"
        "dnkey = gdbm_nextkey(gdbm->dbf, dkey);"
        "FROM_DATUM(SCM_RESULT, dnkey);"))

(define-cproc gdbm-reorganize (gdbm::<gdbm>)
  (body <int>
        "CHECK_GDBM(gdbm);"
        "SCM_RESULT = gdbm_reorganize(gdbm->dbf);"))

(define-cproc gdbm-sync (gdbm::<gdbm>)
  (body <void>
        "CHECK_GDBM(gdbm);"
        "gdbm_sync(gdbm->dbf);"))

(define-cproc gdbm-exists? (gdbm::<gdbm> key::<string>)
  (body <boolean>
        "datum dkey;"
        "CHECK_GDBM(gdbm);"
        "TO_DATUM(dkey, key);"
        "SCM_RESULT = gdbm_exists(gdbm->dbf, dkey);"))

(define-cproc gdbm-strerror (errno::<fixnum>)
  (expr "SCM_MAKE_STR_IMMUTABLE(gdbm_strerror(errno))"))

(define-cproc gdbm-setopt (gdbm::<gdbm> option::<fixnum> val)
  (body <int>
        "int ival;"
        "CHECK_GDBM(gdbm);"
        "if (SCM_EXACTP(val)) ival = Scm_GetUInteger(val);"
        "else ival = !SCM_FALSEP(val);"
        "SCM_RESULT = gdbm_setopt(gdbm->dbf, option, &ival, sizeof(int));"))

(define-cproc gdbm-version ()
  (expr "SCM_MAKE_STR_IMMUTABLE(gdbm_version)"))

(define-cproc gdbm-errno ()
  (body <int>
        "SCM_RESULT = gdbm_errno;"
        "gdbm_errno = 0;"))

(define-enum GDBM_READER)
(define-enum GDBM_WRITER)
(define-enum GDBM_WRCREAT)
(define-enum GDBM_NEWDB)
(define-enum GDBM_FAST)
(define-enum GDBM_SYNC)
(define-enum GDBM_NOLOCK)
(define-enum GDBM_INSERT)
(define-enum GDBM_REPLACE)
(define-enum GDBM_CACHESIZE)
(define-enum GDBM_FASTMODE)
(define-enum GDBM_SYNCMODE)
(define-enum GDBM_CENTFREE)
(define-enum GDBM_COALESCEBLKS)

;; Local variables:
;; mode: scheme
;; end: