;"Generic Disk-Based Database Utilities"
;"Written by Martian, ArchWizard of MidgardMOO (midgard.org:1359)"
;"Current version of this file can be found at http://www.midgard.org:8080/~martian/Code/MOO/gdbdb.moo"


@create $generic_utils called Generic Disk-Based Database Utilities,GDBM,GDBDB
@describe GDBDB as "An interface for the GDBM MOO extension package. It functions very similarly to the $generic_db, with a few minor exceptions. Requires wizperms and ext-gdbm.c."
@prop GDBDB.version 1.3 ""
@prop GDBDB.trusted {} ""

@corify gdbdb as $gdbm_utils

@verb GDBDB:"find find_key" this none this
@program GDBDB:find
"find(filename, string) => datum corresponding to string, $ambiguous_match or $failed_match";
"find_key(filename, string) is like :find but returns the full string key rather than the associated datum.";
"Note that if several string keys present in the db share a common prefix, :find_key(prefix) will return $ambiguous_match, but if there is a unique datum associated with all of these strings :find(prefix) will return it rather than $ambiguous_match.";
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename, search} = args;
if(typeof(fp = `gdbm_open(filename, "read") ! ANY')==ERR)
  return fp;
endif
keys = gdbm_find_keys(fp, search);
if(!keys)
  gdbm_close(fp);
  return $failed_match;
elseif(verb=="find_key")
  gdbm_close(fp);
  return (length(keys) == 1) ? keys[1] | $ambiguous_match;
endif
r = gdbm_fetch(fp, keys[1]);
gdbm_close(fp);
return r;
.

@verb GDBDB:"find_exact" this none this
@program GDBDB:find_exact
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename, search} = args;
if(typeof(fp = `gdbm_open(filename, "read") ! ANY')==ERR)
  return fp;
endif
keys = gdbm_find_keys(fp, search);
if(!keys)
  gdbm_close(fp);
  return $failed_match;
endif
r = (length(keys) == 1) ? gdbm_fetch(fp, keys[1]) | $ambiguous_match;
gdbm_close(fp);
return r;
.

@verb GDBDB:"find_all find_all_keys" this none this
@program GDBDB:find_all
":find_all(filename, string)";
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename, search} = args;
if(typeof(fp = `gdbm_open(filename, "read") ! ANY')==ERR)
  return fp;
endif
keys = gdbm_find_keys(fp, search);
if(verb=="find_all_keys")
  gdbm_close(fp);
  return keys;
endif
r={};
for key in (keys)
  r = {@r, gdbm_fetch(fp, key)};
  $command_utils:suspend_if_needed(0);
endfor
gdbm_close(fp);
return r;
.

@verb GDBDB:"insert" this none this
@program GDBDB:insert
":insert(filename, string, datum) -- inserts <string,datum> correspondence into the database.";
"Returns {old_datum} (or 1) if there was a <string,old_datum> correspondence there before, otherwise returns 0";
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename, key, datum} = args;
if(typeof(fp = `gdbm_open(filename, "write") ! ANY')==ERR)
  return fp;
endif
r = `gdbm_fetch(fp, key) ! E_INVARG' || 0;
result = `gdbm_store(fp, key, datum) ! E_INVARG';
gdbm_close(fp);
if(typeof(result) == ERR)
  return result;
else
  return r;
endif
.

@verb GDBDB:"delete" this none this
@program GDBDB:delete
":delete(filename, string) deletes any <string,something> pair from the database.";
"Returns {something} if such a pair existed, otherwise returns 0";
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename, key} = args;
if(typeof(fp = `gdbm_open(filename, "write") ! ANY')==ERR)
  return fp;
endif
keys = gdbm_find_keys(fp, key);
if(!keys)
  gdbm_close(fp);
  return 0;
elseif(length(keys) != 1)
  gdbm_close(fp);
  return 0;
endif
r = `gdbm_fetch(fp, keys[1]) ! E_INVARG' || 0;
result = `gdbm_delete(fp, keys[1]) ! E_INVARG';
gdbm_close(fp);
if(typeof(result) == ERR)
  return result;
else
  return r;
endif
.

@verb GDBDB:"delete2" this none this
@program GDBDB:delete2
":delete2(filename, string, datum) deletes the pair <string,datum> from the database";
"Similar to :delete except that if the entry for that string has a different associated datum, it will not be removed.";
":delete2(filename,string,datum) is equivalent to ";
" ";
"  if($gdbm_utils:find_exact(filename,string)==datum) ";
"    $gdbm_utils:delete(filename,string); ";
"  endif";
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename, key, datum} = args;
if(typeof(fp = `gdbm_open(filename, "write") ! ANY')==ERR)
  return fp;
endif
r = `gdbm_fetch(fp, key) ! E_INVARG';
if(r==datum)
  result = `gdbm_delete(fp, key) ! E_INVARG';
else
  result = 0;
endif
gdbm_close(fp);
return result;
.

@verb GDBDB:"clearall*_big" this none this rxd
@program GDBDB:clearall
if(!this:trusts(caller_perms()))
  raise(E_PERM);
endif
{filename} = args;
if(typeof(fp = `gdbm_open(filename, "write") ! ANY')==ERR)
  return fp;
endif
keys = gdbm_find_keys(fp);
for key in (keys)
  gdbm_delete(fp, key);
  $command_utils:suspend_if_needed(0);
endfor
gdbm_close(fp);
.


@verb GDBDB:"trusts" this none this rxd
@program GDBDB:trusts
return !!((who=args[1]).wizard || (who in this.trusted));
.