#!/usr/bin/perl
#
# Returns the name matching the given key in the given db
# This is useful for a simple key-value pair data store for a tgi app.
# Returns 0 if found, -1 on error.
# 
# V1.1 3/31/00 - created - rsb
#

#use strict;
use lib $ENV{'SERVER_LIBEXEC'};
use TGI;
use POSIX;
use SDBM_File;

my($version) = "1.1";
my($debug_level) = 0;
my($value);
my($return);

$database = $TGI::QUERY{dbase};
$key = $TGI::QUERY{key};

#test
#$database = "/home/ivrapp/dbases/users";
#$key = '1234567890';

$return = getval($database, $key, \$value);
 
if ($return) {
  TGI::set("value", $value);
}

TGI::set("return", $return);

###############################################################################
# getval - puts into $_[2] the value matching key $_[1] in the database $_[0],
# and returns 0 if found o.k.
###############################################################################
sub getval {

    my($database) = $_[0];
    my($key) = $_[1];
    my($value) = $_[2];
    my(%hash);
    my($retval);
    
    tie(%hash, SDBM_File, $database, O_RDONLY, 0666);

    # if (exists($hash{$key})) { # perl bug - exists not implemented
    if (rbexists(\$key, \%hash)) {
	$$value = $hash{$key};
	$retval = 0;
    }
    else {
	$retval = -1;
    }

    untie %hash;
    return $retval; 
}
###############################################################################
# rbexists - return 1 if the key exists in the hash, 0 otherwise
###############################################################################
sub rbexists {
    my($testkey, $hash) = @_;
    my($currentkey);

    foreach $currentkey (keys %$hash) {
	if ($currentkey eq $$testkey) { return 1; }
    }
    
    return 0;

}

#EOF







