#       addkey - add, delete keys & get values with known keys
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997  The TERENA Association
# Copyright (c) 1998                              RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF    
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: addkey.pl,v 2.8 2000/02/17 17:15:06 marek Exp $
#
#	$RCSfile: addkey.pl,v $
#	$Revision: 2.8 $
#	$Author: marek $
#	$Date: 2000/02/17 17:15:06 $

require "dpr.pl";

################################################################
##  sub getvalues
################################################################
##
##  FUNCTIONAL DESCRIPTION:
##      returns hash value for given key taking into account 
##      the possible overflow (additional level of indirection)
##  FORMAL PARAMETERS:
##      *db: in
##           hash to look at (normally mapped  
##           to database index file via DB_File)  
##      $key: in
##           key to look up in the *db hash
##  RETURN VALUE:
##      $db{$key} - string containing list of comma separated 
##          offsets to database data file
##  DESIGN:
##      if hash value for given key contains predefined pattern
##      the rest of the value is treated as file extension of a
##      file containing the real value to be returned
##   
################################################################

sub getvalues {
    local(*db, $key) = @_;
    local($value)=$db{$key};
    
    if ($value =~ s/^$OVERFLOWPREFIXREGULAR//o) {
	my($overflowname) = $db[1] . $OVERFLOWEXTENSION . $value;
	if (open(OVERFLOWGET, "<".$overflowname)) {
	    $value=<OVERFLOWGET>;
	    close(OVERFLOWGET);
	}
	else {
	    &fatalerror("in getvalues: cannot open for getting values" .
			"$overflowname key: $key value: " .
			"$offsets code: $!");
	}
    }
    return $value;
}

################################################################
##  sub addkey
################################################################
##
##  FUNCTIONAL DESCRIPTION:
##      adds a list of offsets to a value of hash for given key 
##      taking into account possible overflow
##  FORMAL PARAMETERS:
##      *db: in/out
##          hash to be modified (normally mapped to database 
##          index file via DB_File)
##      $key: in
##          key to change offsets at
##      $offsets: in
##          list of offsets to be added to hash value at a 
##          given key
##  RETURN VALUE:
##      1 if key didn't already existed, 0 otherwise
##  SIDE EFFECTS:
##      operations on overflow file if necessary
##  DESIGN:
##      $db{$OVERFLOWKEY} contains current maximum overflow
##      file number.
##   
################################################################

sub addkey {
    local(*db, $key, $offsets)=@_;
    local($value)=$db{$key};
    local($length)=length($offsets)+length($key)+length($value)+4;
    my($overflowname);
    my($newval) = $offsets;
    $newval = $value . "\," . $offsets if ($value); 

#    &dpr("\$db = $db, \$key = $key, \$offsets = $offsets\n");
#    &dpr("\$db{\$key} = $db{$key}\n");
#    &dpr("\$length = $length\n");
#    &dpr("\$newval = $newval\n");
    
    return 1 if ((!$value) && ($length<$OVERFLOWSIZE) && ($db{$key}=$newval));
    
    if ($value=~ s/^$OVERFLOWPREFIXREGULAR//o) {
	
	$overflowname = $db[1] . $OVERFLOWEXTENSION . $value;
#	&dpr("\$overflowname = $overflowname\n");
	if (open(OVERFLOWADD, ">>".$overflowname)) {
	    print OVERFLOWADD "\,", $offsets or 
		&fatalerror("in addkey: cannot write $overflowname".
			    " key: $key value: $offsets code: $!");
	    close(OVERFLOWADD);
	    return 0;
	}
	else {
	    &fatalerror("in addkey: cannot open for addition " . 
			"$overflowname key: $key value: " .
			"$offsets code: $!");
	}
    }

    return 0 if (($length<$OVERFLOWSIZE) && ($db{$key}=$newval));
    
    local($filenumber) = ++$db{$OVERFLOWKEY};
    $overflowname = $db[1].$OVERFLOWEXTENSION.$filenumber;

    if (open(OVERFLOWADD, ">".$overflowname)) {
       print OVERFLOWADD $newval or
	   &fatalerror("in addkey: cannot write $overflowname " .
		       "key: $key value: $offsets code: $!");
       close(OVERFLOWADD);
       $db{$key}=$OVERFLOWPREFIX.$filenumber;
       return ($value) ? 0 : 1;
    }
    else {
       &fatalerror("in addkey: cannot open new $overflowname code: $!");
    }
    &fatalerror("in addkey: could not add $key with value $offsets");   
}


################################################################
##  sub delkey
################################################################
##
##  FUNCTIONAL DESCRIPTION:
##      deletes a list of offsets from a value of hash for a given
##      key taking into account that overflow file may not be 
##      needed anymmore
##  FORMAL PARAMETERS:
##      *db: in/out
##          hash to be modified (normally mapped to database
##          index file via DB_File)
##      $key: in
##          key to change offsets at
##      $offsets: in
##          list of offsets to be deleted from a hash value
##          at a given key
##  RETURN VALUE:
##      none
##  SIDE EFFECTS:
##      operations on overflow file if necessary
##  DESIGN:
##      {@description or none@}
##   
################################################################

sub delkey {
    local(*db, $key, $offsets)=@_;
    local($value)=$db{$key};
    local(%mark)=();

    grep($mark{$_}++, split(/\,/, $offsets));

    if ($value=~ s/^$OVERFLOWPREFIXREGULAR//o) {
	my($overflowname) = $db[1] . $OVERFLOWEXTENSION . $value;
	my($overflownew)  = $overflowname . ".delkey";
	my($oversize);

	if (open(OVERFLOWDEL, $overflowname) and
	    open(OVERFLOWNEW, ">$overflownew")) {

	  #local($/)=",";	# set field delimiter

	  my($start) = time();
 	  my($rinval) = '';
	  my($rinrest) = '';
	  my($bytes);
	    
	  do {
		$bytes=read(OVERFLOWDEL, $rinval, 1048576, length($rinval));

		# here's what it does:
		#    $rinval =~ s/(,\d*)$//o;
		#    $rinrest=$1;
	#&dpr("got $bytes bytes; rinval: >$rinval< \n");

		# and here's how - namely, faster...

	    my($beginrange)='';
	    my($endrange)='';
	    my($norange)=0;

	    if( ($junkcomma = rindex($rinval, "," )) > 0 ) {
		$rinrest=substr( $rinval, $junkcomma );
		# chopping strings: Camel p. 150
		substr($rinval,$junkcomma-length($rinval)) = "";

		if(   ($firstcomma = index($rinval, "," )) >= 0 
		   && ($lastcomma  =rindex($rinval, "," )) >= 0 ) {

		   $beginrange = substr($rinval,0,$firstcomma);
		   $endrange   = substr($rinval, $lastcomma+1);

		  # the element is non-numerical, search always
		  if( $beginrange =~ /\D/ || $endrange =~ /\D/ ) {
			$norange = 1;
		  }
	        }
	    } else {
		$rinrest = '';
		$norange = 1;
	    }

	    #&dpr("processing >$rinval<\n");
	    #&dpr("range: from >$beginrange< to >$endrange<\n");

	    foreach $delval (keys %mark) {

	    # use the sequential property: search only if 
	    # range non-numeric (for example in classless idx or last entry)
	    # or if in range when range defined
	    if( ( $delval >= $beginrange && $delval <= $endrange)
		|| $norange ) {

	        if(  $rinval =~ s/\,$delval\,/,/ or
		   $rinval =~ s/^$delval\,// or
		   $rinval=~ s/\,$delval$// or
		   $rinval=~ s/^$delval$// ) {

                   delete $mark{$delval};
		}
              }
	    } 

	    #&dpr("after processing >$rinval<\n");

	    if( length($rinval) > 0 ) {
	        $rinval .=  ",";
	        print OVERFLOWNEW $rinval
		   or &fatalerror("in delkey: cannot write $overflownew, code: $!");
	    }

	    # now, instead of seeking...
	    # $seekback = length($rinrest) - ($rinrest =~ /,/);
	    # seek(OVERFLOWDEL,  - $seekback, 1);
	    $rinval = substr( $rinrest, 1);
	    #&dpr("rest=>$rinrest< ; seekback=$seekback; rinvalnow=>$rinval<\n");

	  } while( $bytes > 0 || length($rinval) > 0 );

	  close(OVERFLOWNEW);
	  close(OVERFLOWDEL); # but not delete

	    # if any offset not found yet - error
	  if (scalar keys %mark) {
		&fatalerror("in delkey: cannot find offsets " 
			. join(' ',keys %mark) 
			. " in $overflowname");
	  }

	    # chk if any values left, rename the file if non-empty,
	    # delete it otherwise
	  $oversize = -s $overflownew;
#	  &dpr("size of $overflownew from -s = $oversize");
	  if ( $oversize ) {
		# delete last comma:
		truncate($overflownew, $oversize-1 ) or
			&fatalerror("in delkey: cannot truncate $overflownew");
		# move
		rename( $overflownew, $overflowname ) or
			&fatalerror("in delkey: cannot rename $overflownew to $overflowname ");
	    }
	    else {
		delete $db{$key};
		unlink($overflowname);
		unlink($overflownew);
	    }

	    my($elapsed) = time() - $start;
	    my($msg) = "Overflow file $overflowname processed for $elapsed seconds";
	    &syslog("AUDITLOG", $msg) if ($elapsed > 5);

	    return;
	}
	else {
	    &fatalerror("in delkey: cannot open for deletion $overflowname " .
			"key: $key value: $offsets code: $!");
	}
    }   

    #&dpr("removing $offsets from $value \n");

    foreach $delval (keys %mark) {
	$value =~ s/\,$delval\,/,/ or
	$value =~ s/^$delval\,// or
	$value =~ s/\,$delval$// or
	$value =~ s/^$delval$// or
		&fatalerror("in delkey: cannot find offset $delval in the db (key=$key)");
    }

    if ( $value ne '' ) {
	&dpr("writing db{$key} = $value\n");
	$db{$key}=$value;
    }
    else {
	delete($db{$key});
    }
    return;
}

1;
