;;;
;;; ndbm.stub - ndbm 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: ndbm.stub,v 1.26 2007/03/22 11:20:15 shirok Exp $
;;

"
 #include <fcntl.h>
 #include <gauche/extend.h>
 #include \"dbmconf.h\"

 #if HAVE_NDBM_H
 #include <ndbm.h>
 #elif HAVE_GDBM_SLASH_NDBM_H
 #include <gdbm/ndbm.h>
 #elif HAVE_GDBM_MINUS_NDBM_H
 #include <gdbm-ndbm.h>
 #endif

 SCM_CLASS_DECL(Scm_NdbmClass); 
 static void ndbm_print(ScmObj, ScmPort *, ScmWriteContext*);
 SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_NdbmClass, ndbm_print);

 #define SCM_CLASS_NDBM       (&Scm_NdbmClass)
 #define SCM_NDBM(obj)        ((ScmNdbm*)obj)
 #define SCM_NDBMP(obj)       SCM_XTYPEP(obj, SCM_CLASS_NDBM)

 typedef struct ScmNdbmRec {
    SCM_HEADER;
    ScmObj name;
    DBM *dbf;                   /* NULL if closed */
 } ScmNdbm;

 static void ndbm_print(ScmObj obj, ScmPort *out, ScmWriteContext *ctx)
 {
    Scm_Printf(out, \"#<ndbm-file %S>\", SCM_NDBM(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); \\
     } else {                               \\
       scm_ = SCM_FALSE;                    \\
     }                                      \\
   } while (0)

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

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

(define-type <ndbm> "ScmNdbm*")

;; finalization
"static void ndbm_finalize(ScmObj obj, void *data)
 {
    ScmNdbm *n = SCM_NDBM(obj);
    if (n->dbf) { dbm_close(n->dbf); n->dbf = NULL; }
 }
"

(define-cproc ndbm-open (name::<string> flags::<fixnum> mode::<fixnum>)
  " ScmNdbm *z = SCM_NEW(ScmNdbm);
  SCM_SET_CLASS(z, SCM_CLASS_NDBM);
  Scm_RegisterFinalizer(SCM_OBJ(z), ndbm_finalize, NULL);
  z->name = SCM_OBJ(name);
  z->dbf = dbm_open(Scm_GetString(name), flags, mode);
  if (z->dbf == NULL) Scm_SysError(\"couldn't open ndbm file %S\", name);
  SCM_RETURN(SCM_OBJ(z));")

(define-cproc ndbm-close (ndbm::<ndbm>)
  (body <void>
        "if (ndbm->dbf) {"
        "  dbm_close(ndbm->dbf);"
        "  ndbm->dbf = NULL;"
        "}"))

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

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

(define-cproc ndbm-fetch (ndbm::<ndbm> key::<string>)
  (body "datum dkey, dval;"
        "CHECK_NDBM(ndbm);"
        "TO_DATUM(dkey, key);"
        "dval = dbm_fetch(ndbm->dbf, dkey);"
        "FROM_DATUM(SCM_RESULT, dval);"))

(define-cproc ndbm-exists? (ndbm::<ndbm> key::<string>)
  (body <boolean>
        "datum dkey, dval;"
        "CHECK_NDBM(ndbm);"
        "TO_DATUM(dkey, key);"
        "dval = dbm_fetch(ndbm->dbf, dkey);"
        "SCM_RESULT = (dval.dptr != NULL);"))

(define-cproc ndbm-delete (ndbm::<ndbm> key::<string>)
  (body <int>
        "datum dkey;"
        "CHECK_NDBM(ndbm);"
        "TO_DATUM(dkey, key);"
        "SCM_RESULT = dbm_delete(ndbm->dbf, dkey);"))

(define-cproc ndbm-firstkey (ndbm::<ndbm>)
  (body "datum dkey;"
        "CHECK_NDBM(ndbm);"
        "dkey = dbm_firstkey(ndbm->dbf);"
        "FROM_DATUM(SCM_RESULT, dkey);"))

(define-cproc ndbm-nextkey (ndbm::<ndbm>)
  (body "datum dkey;"
        "CHECK_NDBM(ndbm);"
        "dkey = dbm_nextkey(ndbm->dbf);"
        "FROM_DATUM(SCM_RESULT, dkey);"))

(define-cproc ndbm-error (ndbm::<ndbm>)
  (body <int>
        "CHECK_NDBM(ndbm);"
        "SCM_RESULT = dbm_error(ndbm->dbf);"))

(define-cproc ndbm-clearerror (ndbm::<ndbm>)
  (body <void>
        "CHECK_NDBM(ndbm);"
        "dbm_clearerr(ndbm->dbf);"))

(define-enum DBM_INSERT)
(define-enum DBM_REPLACE)
(define-enum O_RDONLY)
(define-enum O_WRONLY)
(define-enum O_RDWR)
(define-enum O_CREAT)
(define-enum O_TRUNC)

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