-/* $Header: hash.c,v 3.0.1.6 90/10/15 17:32:52 lwall Locked $
+/* $RCSfile: hash.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:11 $
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991, Larry Wall
*
- * You may distribute under the terms of the GNU General Public License
- * as specified in the README file that comes with the perl 3.0 kit.
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
*
* $Log: hash.c,v $
- * Revision 3.0.1.6 90/10/15 17:32:52 lwall
- * patch29: non-existent array values no longer cause core dumps
- * patch29: %foo = () will now clear dbm files
- * patch29: dbm files couldn't be opened read only
- * patch29: the cache array for dbm files wasn't correctly created on fetches
+ * Revision 4.0.1.1 91/06/07 11:10:11 lwall
+ * patch4: new copyright notice
*
- * Revision 3.0.1.5 90/08/13 22:18:27 lwall
- * patch28: defined(@array) and defined(%array) didn't work right
- *
- * Revision 3.0.1.4 90/08/09 03:50:22 lwall
- * patch19: dbmopen(name, 'filename', undef) now refrains from creating
- *
- * Revision 3.0.1.3 90/03/27 15:59:09 lwall
- * patch16: @dbmvalues{'foo','bar'} could use the same cache entry for both values
- *
- * Revision 3.0.1.2 89/12/21 20:03:39 lwall
- * patch7: errno may now be a macro with an lvalue
- *
- * Revision 3.0.1.1 89/11/11 04:34:18 lwall
- * patch2: CX/UX needed to set the key each time in associative iterators
- *
- * Revision 3.0 89/10/18 15:18:32 lwall
- * 3.0 baseline
+ * Revision 4.0 91/03/20 01:22:26 lwall
+ * 4.0 baseline.
*
*/
if (tb->tbl_dbm) {
dkey.dptr = key;
dkey.dsize = klen;
+#ifdef HAS_GDBM
+ dcontent = gdbm_fetch(tb->tbl_dbm,dkey);
+#else
dcontent = dbm_fetch(tb->tbl_dbm,dkey);
+#endif
if (dcontent.dptr) { /* found one */
str = Str_new(60,dcontent.dsize);
str_nset(str,dcontent.dptr,dcontent.dsize);
if (bcmp(entry->hent_key,key,klen)) /* is this it? */
continue;
*oentry = entry->hent_next;
- str = str_static(entry->hent_val);
+ str = str_mortal(entry->hent_val);
hentfree(entry);
if (i)
tb->tbl_fill--;
if (tb->tbl_dbm) {
dkey.dptr = key;
dkey.dsize = klen;
+#ifdef HAS_GDBM
+ gdbm_delete(tb->tbl_dbm,dkey);
+#else
dbm_delete(tb->tbl_dbm,dkey);
+#endif
}
#endif
return str;
{
if (!hent)
return;
- str_2static(hent->hent_val); /* free between statements */
+ str_2mortal(hent->hent_val); /* free between statements */
Safefree(hent->hent_key);
Safefree(hent);
}
#ifdef SOME_DBM
datum dkey;
datum nextdkey;
-#ifdef NDBM
+#ifdef HAS_GDBM
+ GDBM_FILE old_dbm;
+#else
+#ifdef HAS_NDBM
DBM *old_dbm;
#else
int old_dbm;
#endif
#endif
+#endif
if (!tb || !tb->tbl_array)
return;
#ifdef SOME_DBM
if ((old_dbm = tb->tbl_dbm) && dodbm) {
+#ifdef HAS_GDBM
+ while (dkey = gdbm_firstkey(tb->tbl_dbm), dkey.dptr) {
+#else
while (dkey = dbm_firstkey(tb->tbl_dbm), dkey.dptr) {
+#endif
do {
+#ifdef HAS_GDBM
+ nextdkey = gdbm_nextkey(tb->tbl_dbm, dkey);
+#else
+#ifdef HAS_NDBM
+#ifdef _CX_UX
nextdkey = dbm_nextkey(tb->tbl_dbm, dkey);
+#else
+ nextdkey = dbm_nextkey(tb->tbl_dbm);
+#endif
+#else
+ nextdkey = nextkey(dkey);
+#endif
+#endif
+#ifdef HAS_GDBM
+ gdbm_delete(tb->tbl_dbm,dkey);
+#else
dbm_delete(tb->tbl_dbm,dkey);
+#endif
dkey = nextdkey;
} while (dkey.dptr); /* one way or another, this works */
}
#ifdef SOME_DBM
if (tb->tbl_dbm) {
if (entry) {
-#ifdef NDBM
+#ifdef HAS_GDBM
+ key.dptr = entry->hent_key;
+ key.dsize = entry->hent_klen;
+ key = gdbm_nextkey(tb->tbl_dbm, key);
+#else
+#ifdef HAS_NDBM
#ifdef _CX_UX
key.dptr = entry->hent_key;
key.dsize = entry->hent_klen;
key.dsize = entry->hent_klen;
key = nextkey(key);
#endif
+#endif
}
else {
Newz(504,entry, 1, HENT);
tb->tbl_eiter = entry;
+#ifdef HAS_GDBM
+ key = gdbm_firstkey(tb->tbl_dbm);
+#else
key = dbm_firstkey(tb->tbl_dbm);
+#endif
}
entry->hent_key = key.dptr;
entry->hent_klen = key.dsize;
if (tb->tbl_dbm) {
key.dptr = entry->hent_key;
key.dsize = entry->hent_klen;
+#ifdef HAS_GDBM
+ content = gdbm_fetch(tb->tbl_dbm,key);
+#else
content = dbm_fetch(tb->tbl_dbm,key);
+#endif
if (!entry->hent_val)
entry->hent_val = Str_new(62,0);
str_nset(entry->hent_val,content.dptr,content.dsize);
}
#ifdef SOME_DBM
-#if defined(FCNTL) && ! defined(O_CREAT)
-#include <fcntl.h>
+
+#ifndef O_CREAT
+# ifdef I_FCNTL
+# include <fcntl.h>
+# endif
+# ifdef I_SYS_FILE
+# include <sys/file.h>
+# endif
#endif
#ifndef O_RDONLY
#define O_CREAT 01000
#endif
-#ifndef NDBM
+#ifdef HAS_ODBM
static int dbmrefcnt = 0;
#endif
{
if (!tb)
return FALSE;
-#ifndef NDBM
+#ifdef HAS_ODBM
if (tb->tbl_dbm) /* never really closed it */
return TRUE;
#endif
tb->tbl_dbm = 0;
}
hclear(tb, FALSE); /* clear cache */
-#ifdef NDBM
+#ifdef HAS_GDBM
+ if (mode >= 0)
+ tb->tbl_dbm = gdbm_open(fname, 0, GDBM_WRCREAT,mode, (void *) NULL);
+ if (!tb->tbl_dbm)
+ tb->tbl_dbm = gdbm_open(fname, 0, GDBM_WRITER, mode, (void *) NULL);
+ if (!tb->tbl_dbm)
+ tb->tbl_dbm = gdbm_open(fname, 0, GDBM_READER, mode, (void *) NULL);
+#else
+#ifdef HAS_NDBM
if (mode >= 0)
tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode);
if (!tb->tbl_dbm)
}
tb->tbl_dbm = dbminit(fname) >= 0;
#endif
+#endif
if (!tb->tbl_array && tb->tbl_dbm != 0)
Newz(507,tb->tbl_array, tb->tbl_max + 1, HENT*);
return tb->tbl_dbm != 0;
register HASH *tb;
{
if (tb && tb->tbl_dbm) {
-#ifdef NDBM
+#ifdef HAS_GDBM
+ gdbm_close(tb->tbl_dbm);
+ tb->tbl_dbm = 0;
+#else
+#ifdef HAS_NDBM
dbm_close(tb->tbl_dbm);
tb->tbl_dbm = 0;
#else
/* dbmrefcnt--; */ /* doesn't work, rats */
#endif
+#endif
}
else if (dowarn)
warn("Close on unopened dbm file");
dkey.dsize = klen;
dcontent.dptr = str_get(str);
dcontent.dsize = str->str_cur;
+#ifdef HAS_GDBM
+ error = gdbm_store(tb->tbl_dbm, dkey, dcontent, GDBM_REPLACE);
+#else
error = dbm_store(tb->tbl_dbm, dkey, dcontent, DBM_REPLACE);
+#endif
if (error) {
if (errno == EPERM)
fatal("No write permission to dbm file");
warn("dbm store returned %d, errno %d, key \"%s\"",error,errno,key);
-#ifdef NDBM
+#ifdef HAS_NDBM
dbm_clearerr(tb->tbl_dbm);
#endif
}
projects / p5sagit/p5-mst-13.2.git / blobdiff