#!/usr/bin/perl -w 

# This file is part of the Online Negative Database (NDB),
#   Copyright (C) 2003-2004 elena s ackley and the Regents of the University of New Mexico
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


use Time::Local;
use File::Temp;
use strict;


# Figure out where we were executed from and add that directory to the
# include path.  This is unwise in that it opens the possibility of
# sucking in anything included in the directory we're in, not just the
# stuff we want to allow sucking in..

sub BEGIN {
    # Seal us up a bit for living la vida tainted
    $ENV{'PATH'} = "/bin:/usr/bin";
    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

    my $dir = ($0 =~ m!^(.*)/!);
    if ($dir !~ m!^/!) {my $tmp = `pwd`; chop($tmp);}
    @INC=($dir, @INC) unless $INC[0] eq $dir;
}

my $version = "0.43";
my $BINFLAG = 0;
my $USE_PERMUTE = 1;
my $debug = 0;   
my $debug1 = 0;  # online query
my $debug2 = 0;  # online add
my $debug3 = 0;  # query rndb
my $debug4 = 0;  # online delete
my $debug5 = 0;  # c_key and npg
my $debug6 = 0;  # rndb
my $debug7 = 0;  # add/del rndb records
my $debug8 = 0;  # bootstrap empty rndb
my $debug10 = 0;   # debug permute ndb
my $debug11 = 0;   # cleanup
my $debug12 = 0;   # cleanup detail

my $debugcmd = 0;
my $configfilepath = "./";
my $N = 0;      # at most size of DB and updates 
my $RN = 0;
my $LEN = 0;
my %RNDB;
my %ndb_add_cache;
my %ndb_delete_cache;
my $TAU = 2;              # minimum cleanup size
my $MAXREADLEN = 0;
my $DEFAULTLEN = 16;
my $UPDRNDBFLAG = 1;      # permits initial rewrite into dimacs format
my $FENUM = 3;            # to satisfy 3SAT requirement
my $STEP6 = 0;            # default is LEN. use -g 1 
my $seed = 0;
my $randcalls = 0;
my $ln2 = log(2);         # natural log of 2 constant
my $RESETWINI = 0;
my $WINIRESETFLAG = 1;    # if 0, don't use reset wini, o.w. at least log(LEN) +1;
my $MAX_KEY = 0;          # based on read rndb or resetwini val if empty TEMPORARY.
my $MAX_REC_SIZE = 0;     # v.43
my $K2 = 0;               # number of bits to prune initial empty rndb (MAX_KEY default)
my @RSTATS;               # max, totrecsz, totspecifiedbits, 
                          # array sumrecsz, array sumspecifiedbits
my $WEBDEMO = 0;
my $input;                # input from web
my $webcmd = 'N';         # A,R,Q,C,Null
my $CLEANTESTS = 0;       # number of times through the cleanup loop v.36
my ($n,$a,$d) = (0..2);   # enum for cleanup results v.36
my ($pdb,$pi,$pir) = (0..2); # enum for @PERMREFS: v.38
                          # prndb ref, permute order ref, reverse permute ord ref

&main(@ARGV);

sub usage_abort{
    die "Usage: % perl updatedb10.pl [-a <record> add web record][-b for binary mode][-c <minimum records> to cleanup (TAU)][-d demo on web][-f <num> extra bits to add for 3SAT complexity (default, FENUM is 3)][-g <num> max records to insert (STEP6)][-k <num> prune empty to num bits][-l <num> default record bit length][-m <num> maximum specified bits in record][-p don't permute][-q <record> query for web record][-r <record> remove web record][-s <seed>][-t <number> cleanup tests][-w don't reset wini]\n";
}


sub command_args{
    my $cmdlineflag = @_;  #number of args
    my @args = @_;
    $debugcmd && print "got <$cmdlineflag> args\n";
    
    my $i = 0;
    
    while($i < $cmdlineflag) {
	$debugcmd && print "find this arg <$args[$i]>\n";
	
	if ( $args[$i] =~ /\-([AaBbCcDdFfGgKkLlMmPpQqRrSsTtWw\?])$/ ) {
	    my $c = uc $1;
	    
	    $debugcmd && print "arg is <$c>\n";
	    
	    if  ($c =~ /A/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for L is <$args[$i+1]>\n";
		    $input = $args[$i+1];
		    $webcmd = $c;
		    Print( "Add <$webcmd> record <$input>\n");
		    $i+=2;
		}
	    }elsif ($c =~ /B/ ) {
		Print("Expecting Binary input..\n");
		$BINFLAG = 1;
		$i++;
	    } elsif ($c =~ /C/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    $webcmd = $c;
		    Print( "Cleanup <$webcmd> minimum $TAU records\n");
		    $i++;
		} else {              # here parse tau
		    $debugcmd && print "2nd arg for C is <$args[$i+1]>\n";
		    $webcmd = $c;
		    $TAU = $args[$i+1];
		    Print( "Cleanup <$webcmd> minimum $TAU records\n");
		    $i+=2;
		}
	    } elsif ($c =~ /D/ ) {
		$WEBDEMO = 1;
		Print( "WEBBASED DEMO.\n");
		$i++;
	    } elsif  ($c =~ /F/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for F is <$args[$i+1]>\n";
		    $FENUM = $args[$i+1];
		    Print( " Generating \"at most\" $FENUM pattern combination(s) for RNDB records\n");
		    $i+=2;
		}
	    } elsif  ($c =~ /G/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for G is <$args[$i+1]>\n";
		    $STEP6 = $args[$i+1];
		    Print( "Generating <$STEP6> records for RNDB at step 6\n");
		    $i+=2;
		}
	    } elsif  ($c =~ /K/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for K is <$args[$i+1]>\n";
		    $K2 = $args[$i+1];
		    $K2 && print("Prune initial empty DB to <$K2> bits per record\n");
		    &PrintBR();
		    $i+=2;
		}
	    } elsif  ($c =~ /L/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for L is <$args[$i+1]>\n";
		    $DEFAULTLEN = $args[$i+1];
		    Print( "Default record length is <$DEFAULTLEN> bits per record\n");
		    $i+=2;
		}
	    } elsif  ($c =~ /M/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for M is <$args[$i+1]>\n";
		    $MAX_REC_SIZE = $args[$i+1];
		    if ($MAX_REC_SIZE < 3) {
			$MAX_REC_SIZE = 3;
			Print( "Minimum max record size is <$MAX_REC_SIZE> specified bits per record\n");
		    } else {
			Print( "Maximum record size is <$MAX_REC_SIZE> specified bits per record\n");
		    }
		    $i+=2;
		}
	    } elsif ($c =~ /P/ ) {
		$USE_PERMUTE = 0;
		Print( "Permutations disabled.\n");
		$i++;

	    } elsif  ($c =~ /Q/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for L is <$args[$i+1]>\n";
		    $input = $args[$i+1];
		    $webcmd = $c;
		    Print( "Query <$webcmd> record <$input>\n");
		    $i+=2;
		}
	    } elsif  ($c =~ /R/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse bit length
		    $debugcmd && print "2nd arg for L is <$args[$i+1]>\n";
		    $input = $args[$i+1];
		    $webcmd = $c;
		    Print( "Remove <$webcmd> record <$input>\n");
		    $i+=2;
		}
	    } elsif ($c =~ /S/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse seed
		    $debugcmd && print "2nd arg for S is <$args[$i+1]>\n";
		    $seed = $args[$i+1];
		    $i+=2;
		}

	    } elsif ($c =~ /T/ ) {
		if( ($i+1 >= $cmdlineflag) || ($args[$i+1] =~ /^-/ )) {
		    &usage_abort;
		    $i++;
		} else {              # here parse tau
		    $debugcmd && print "2nd arg for T is <$args[$i+1]>\n";
		    $CLEANTESTS = $args[$i+1];
		    Print( "$CLEANTESTS Cleanup Tests\n");
		    $i+=2;
		}
	    } elsif ($c =~ /W/ ) {
		$WINIRESETFLAG = 0;
		Print( "WINI RESET DISABLED.\n");
		$i++;
	    } else {
		&usage_abort;
	    }
	} else {
	    &usage_abort;
	}
    } # end while
    return;
}


sub info_rndb {
    my $sz = scalar keys %RNDB;
    my $explicits = 0;
    my $y;

    foreach $y (keys %RNDB) {
	my $l = length $y;

	if (&explicitp_rndb_rec($y)) {
	    $explicits++;
	    if ($l != $RNDB{$y} ) {
		print "Warning: inconsistency for explicit record <$y> length <$l> doesn't match value <$RNDB{$y}>\n";
	    }
	}
    }

    Print( "RNDB size is $sz -- $explicits explicit records -- record length $LEN.\n");

    if ( &guess_rndb_size() < $sz) {
	Print("RNDB is larger than expected ($sz)!!\n");
    }

    $sz != $RN && print "but added  <$RN> records to RNDB";
    &PrintBR();
    print("DB size is unknown (guessed at ~$N), maximum read record length $MAXREADLEN.");
    &PrintBR();
    if ( $BINFLAG ) {
	print("DB was originally in BINARY MODE --- only binary input accepted for updates and queries.");
	&PrintBR();
    }

    if ($UPDRNDBFLAG) {
	&PrintBR();
	print "RNDB has been changed since it was last saved.";
	&PrintBR();
    }

    return 0;
}



sub read_rndb {
    my $l = 0;
    my $n = 0;
    my $explicits = 0;
    my $fn = "$configfilepath/RNDB.txt";
    stat($fn);

    if (! -e _) {   # no RNDB exists, start with default rndb
	Print("RNDB.txt does not exist\n\n");
	return 0;
    }

    open IRNDB,$fn;
    while(<IRNDB>){
	if( /([01\*]+)/ ){
	    my $rec = $1;
	    $debug && print "read record <$rec>\n";
	    $n++;
	    my $l = length $rec;
	    if (!$LEN) {$LEN = $l;}   # set rndb rec length once
	    $LEN && $l != $LEN && die "not all same length records ($n)\n";
	    $rec = &substitute_dontcares_and_dots($rec);
#	    print "here's rec <$n> <$rec>\n";
	    &new_rndb_rec($rec);
	    if (&explicitp_rndb_rec($rec)) { $explicits++; }
	    $debug && print "$rec\n";
	}
    }

    close IRNDB;

    if ($n) {
	&set_max_lengths();
	Print( "\nread $n records in RNDB, max read length $MAXREADLEN\n\n");
    } else {
	print "\nNO records found in RNDB\n\n";
    }

    return &guess_db_size($n);    
}


sub set_max_lengths {
    my $loglen = &logbase2($LEN);    

    if ($BINFLAG) {
	$MAXREADLEN = $LEN;
    } else {
	$MAXREADLEN = $LEN/8;
    }

    # if not divisible by 8 then most likely binary mode.
    if ( int($MAXREADLEN) != $MAXREADLEN) {
	print "fyi: continuing in binary mode...";
	&PrintBR();
	&PrintBR();
	$BINFLAG = 1;
	$MAXREADLEN = $LEN;
    }

    # use max number of combinations, unless reset by command line arg
    if (!$STEP6 || $STEP6 > $LEN) { $STEP6 = $LEN; }

    # reset wini
    if ($WINIRESETFLAG) {
	$RESETWINI = $loglen;
	Print( "RESET Wini is <$RESETWINI>\n");
    }

    # set max_key
    if (!$MAX_KEY) {
#	print "HERE I AM: set max_key\n";
	$MAX_KEY = $loglen;  # + $FENUM + 2 ??

	my $small = $LEN - $MAX_KEY;

	if ($small < $FENUM) {
	    $MAX_KEY += ($FENUM - $small);
	} else {
	    $MAX_KEY += $FENUM;
	}

 	print( "MAX KEY size is <$MAX_KEY>\n");
	&PrintBR();
    } 
    
    if ($MAX_KEY < 3) { 
	$MAX_KEY = 3; 
 	print( "MAX KEY size is now the minimum <$MAX_KEY> for 3SAT\n");
	&PrintBR();
    }  # for 3-SAT insurance

# v.43 if command line arg (-m) specifies the max rec size, USE IT.
    if ($MAX_REC_SIZE && ($MAX_KEY < $MAX_REC_SIZE || $MAX_KEY > $MAX_REC_SIZE) ) {
	$MAX_KEY = $MAX_REC_SIZE;
 	print( "MAX KEY size is reset to <$MAX_KEY>, the MAX REC SIZE\n");
	&PrintBR();
    }
    return;
}


# start with only one random bit position; try to stop peaks in bit distribution.
sub no_rndb_2 {
    my $n = 0;
    $LEN = $DEFAULTLEN;
    &set_max_lengths();

    # set pruning value for empty DB
    if (!$K2) {
	print( "Prune initial empty DB to default <$MAX_KEY> bits per record\n");
	&PrintBR();
    }

    my %prndb = ();
    my ($piref,$pirref) = &setup_permute_order();        # need it here for make_rndb
    my @permrefs = (\%prndb,$piref,$pirref);

    my $bitval= 1;

    # select one bit position at random
    my $rbp = int(rander($LEN));
    my $pc = $bitval << $rbp;
#    print "($rbp) initial random bit position for empty rndb pc is $pc\n";

    my $v = sprintf("%b",$pc);               # binary form
#    print "HERE! $v from $pc\n";
    $v = &pad_left_length($v,"0",$LEN);
#    print "padded HERE! $v from $pc\n";
    $v =~ (s/0/\./g);
#    print "HERE! $v from $pc\n";

    my $pi = $bitval + 1;                      # twice thru is essential

    while($pi) {
#	my $pv = &permute_record($v,$piref);   # don't think this is necessary.
	my $pv = $v;
#	print "HERE!! <$pv> from <$v>\n";
	&make_rndb_rec($pv,\@permrefs,0);      # no neg pattern generate.    
	$n += &prune_rndb_add_cache($K2);
	$v =~ (s/1/0/g);
	$pi--;
    }

    Print( "\n$n records in RNDB, max read length $MAXREADLEN\n\n");
    $UPDRNDBFLAG++;
    return &guess_db_size($n);
}


sub print_rndb {
    my $y;
    my $explicits=0;

    open OUTRNDB,">$configfilepath/RNDB.txt";

    foreach $y (sort keys %RNDB) {
	my $z = &substitute_dots_and_dontcares($y);
	&explicitp_rndb_rec($y) && $explicits++;
	print OUTRNDB "$z\n";
    }
    
    close OUTRNDB;
    $UPDRNDBFLAG = 0;
    my $sz = scalar keys %RNDB;
    &print_db_summary("RNDB",$sz,$explicits,$RN);
    &print_rndb_dimacs($sz);
    @RSTATS = &stats(\%RNDB,"RNDB");
    &print_stats("RNDB",\@RSTATS,0);
    return;
}

# output file for zChaff SAT solver
sub print_rndb_dimacs {
    my $cl = $_[0];
    my $va = $LEN;
    my $gl = $cl/$va;
    my $y;

    if (! -e "$configfilepath/SAT" ) {
	mkdir "$configfilepath/SAT" || die("can't create SAT directory");
	-w "$configfilepath/SAT" || die("can't write to SAT directory");
    }

    open OUTRNDB,">$configfilepath/SAT/RNDB.dimacs";

    print OUTRNDB "c  cnf \#var \#clause\nc \#var is RN, \#clauses is DB reclength\n";
    print OUTRNDB "c guideline ratio is around 4.3: <$gl>\n";
    print OUTRNDB "p cnf $va $cl\n";

    foreach $y (sort keys %RNDB) {
	my $i = 0;
	while ($i < $LEN ) { 
	    my $z = $i+1;
	    my $c = substr($y,$i,1);
	    if ( $c =~ /1/) {         # complement the output v.23
		print OUTRNDB "-$z ";
	    } elsif ( $c =~ /0/ ) {
		print OUTRNDB "$z ";
	    }
	    $i++;
	}
	print OUTRNDB "0 \n";  # each line ends with a "0"
    }
    
    close OUTRNDB;
    
    return;
}


# args are name, size, and number of explicit records
# depends on globals for length of record and size of DB.
sub print_db_summary{
    my $name = $_[0];
    my $sz = $_[1];
    my $explicits = $_[2];
    my $n = $N;
    if (!$N) { $n = 1; }
    my $exp = ($explicits/$n) * 100;
    print "$name size is $sz -- $explicits explicit records ($exp%) -- record length $LEN";
    &PrintBR();
    my $size = $LEN * $n;
    my $uppersize = $size ** 2;  # quadratic in the case of RNDB

    if ( $uppersize < $sz) {
	Print( "$name is larger than expected ($sz)!!\n");
    }

    my $np = ($sz/$size) * 100;
    my $np2 = ($sz/$n) * 100;
    $np = int($np * 100) / 100;
    $np2 = int($np2 * 100) / 100;
    Print( "$name is $np% of upper bound -- $np2% of DB size\n");
    return;
}


# approx guess as RNDB is quadratic in size of DB
sub guess_db_size {
    my $n = $_[0];
    my $guess = sqrt $n;
    $guess = int $guess;
    return $guess;
}


sub guess_rndb_size {
    my $guess =  ($N * $LEN) ** 2;
    return $guess;
}


sub count_dontcares_rec {
    my $rec = $_[0];
    my $dc = $rec =~ s/([\.\*])/$1/g;
    return $dc;
}


# assumes input is not permuted and that record exists in RNDB
sub explicitp_rndb_rec {
    my $rec = $_[0];
    my $l = length $rec;
    my $explicit = 0;

    if ( $l == $RNDB{$rec} ) {
	$explicit = 1;
	$debug6 && print "Explicit <$rec>\n";
    }
    return $explicit;
}


sub substitute_dots_and_dontcares {
    my $s = $_[0];
    $debug1 && $debug6 && print " sub dots and dontcares in <$s>, now ";
    $s =~ (s/\./\*/g);
    $debug1 && $debug6 && print "<$s>\n";
    return $s;
}


sub substitute_dontcares_and_dots {
    my $s = $_[0];
    $debug1 && $debug6 && print " sub dots and dontcares in <$s>, now ";
    $s =~ (s/\*/\./g);
    $debug1 && $debug6 && print "<$s>\n";
    return $s;
}


sub pad_right_length {
    my $s = $_[0];
    my $c = $_[1];
    my $l = $_[2];
    my $sl = length $s;
    my $ns = $s . ($c x ($l - $sl));   # pad with blanks right
    return $ns;
}


sub pad_right {
    my $s = $_[0];
    my $c = $_[1];
    my $ns = &pad_right_length($s,$c,$LEN);
    return $ns;
}


sub pad_left_length {
    my $s = $_[0];
    my $c = $_[1];
    my $l = $_[2];
    my $sl = length $s;
    my $ns = ($c x ($l - $sl)) . $s;    # pad binary input with zeros left
    return $ns;
}


sub pad_left {
    my $s = $_[0];
    my $c = $_[1];
    my $ns = &pad_left_length($s,$c,$LEN);
    return $ns;
}


sub prep_query {
    my $query = $_[0];
    my $q2 = $query;
    my $ql = length $q2;
    my $q = substr($q2,0,$MAXREADLEN);
    
    if ($ql > $MAXREADLEN ) {
	$debug2 && print "Max length record is $MAXREADLEN, using [$q] instead of [$query]\n";
	if ($WEBDEMO) {
	    print("<B>[$query]</B> is not in the database.<br><br>");
	} else {
	    print("[$query] is not in the database.\n\n");
	}
	$q2 = "";
    } else {
	if ($BINFLAG){
	    $q2 = &pad_left($q,"0");
	} else {
	    $q = lc $q;              # lower case everything
	    $q2 = &pad_right_length($q," ",$MAXREADLEN);
	}
	$debug2 && print "Fixed length record is $MAXREADLEN, padding <$query> to <$q2>\n";
    }
    return $q2;
}


# for ascii input, return converted ord value
sub prep2_query {
    my $q2=$_[0];

    if (!$BINFLAG) {
	my $ordq = &convert_to_ord($q2);
	$debug1 && print "ready to query <$q2> as <$ordq>\n";
	$q2 = $ordq;
    }
    return $q2;
}


# converts each ascii letter to its 8-bit binary value
sub convert_to_ord {
    my $rec = $_[0];
    my $reclen = length $rec;
    my $i = $reclen;
    my $r = reverse $rec;
    my $nr;

    $debug && print "here's <$rec>..\n";

    while ($i > 0) {
	my $c = chop($r);
	$debug && print "here's <$c>\n";
	$c = sprintf("%08b",ord($c));
	$debug && print "here's <$c> as ord\n";
	$nr = $nr.$c;
	$i--;
    }
    $debug && print "here's <$rec> converted <$nr>\n";   
    return $nr;
}


# terribly slow for now - linear in size of RNDB times length of record
# returns zero if not found; o.w. true
sub query_ndb {
    my $p = $_[0];
    my $dbref = $_[1];
    my $rtn = 0;
    my $k;

#    study $p;

    foreach $k (keys %$dbref) {
	my $hatk = "^"."$k";
#	$debug6 && print "does <$p> match <$hatk>?\n";
	if ( $p =~ /$hatk/ ) {
	    $debug6 && print "YIKES!! RNDB FOUND <$p> in <$k>\n";
	    $rtn = 1;
	    last;
	}
    }
    return $rtn;  
}


# as specified in -t command line arg, this function executes repeated
# cleanup_rndb calls, outputs net result of each call to clean.dat
# file, and checkpoints RNDB after those calls that have a nonzero net effect
sub clean_tests {
    my $i = 0;
    open CTESTS,">$configfilepath/CleanTests/clean.dat";
    print CTESTS "# TAU is $TAU\n";
    print CTESTS "#iterate added deleted net\n";

    while($i < $CLEANTESTS) {
	my @cleanresults = &cleanup_rndb();
	print CTESTS "$i $cleanresults[$a] $cleanresults[$d] $cleanresults[$n]\n";
	print "#$i/$CLEANTESTS NET CLEANUP $cleanresults[$n] records\n"; 
	$cleanresults[$n] && &print_rndb();
	$i++;
    }
    close CTESTS;
    &print_rndb();   # save post cleanups results (assumes you saved the initial results) 
    return;
}


# randomly select a string; let Dk be all the strings that have the
# same c_key, K; if the number of Dk is greater than Tau, remove them
# from NDB.  insert K.
sub cleanup_rndb {
    my $rndbref = \%RNDB;
    my $x = &select_random_record($rndbref);
    my ($key,$kivref) = &c_key_negative($x,$rndbref); # NO assumes prndb exists for querying

    $debug11 && print "cleanup with unpermuted key $key for random rec $x w key $key\n";
    my $deleted = &find_delete_all_subsumed($key,0);
    my $added = 0;
    $debug11 && print "deleted cleanup cache size is $deleted - tau is $TAU.\n";

    if ($deleted < $TAU) {

	&clear_rndb_delete_cache();         # housekeeping cache
	$deleted = 0;

    }  else {
	my $pkey;

	&empty_rndb_delete_cache();

	# real permute for the add
	my @permrefs = &setup_prndb(\%RNDB);
	$pkey = &permute_record($key,$permrefs[$pi]);

	$added = &make_rndb_rec($pkey,\@permrefs);
	my $chkadded = &empty_rndb_add_cache();  
	$debug11 && print "added cleanup cache size is $added\n";
	if($added != $chkadded) {
	    $debug11 && print("added mismatch $added not eq $chkadded\n");
	    $added = $chkadded;
	}
	$UPDRNDBFLAG++;
    }
    return ($added-$deleted,$added,$deleted);
}


# doesn't care if permuted or not;
sub select_random_record {
    my $dbref = $_[0];
    my @rarray = keys %$dbref;
    my $sz = @rarray;
    my $pick = int(&rander($sz));
    my $x = $rarray[$pick];
    return $x;
}


# returns count and hashref of all records in db arg that p MATCH 
sub query_ndb_all {
    my $p = $_[0];
    my $dbref = $_[1];
    my $rtn = 0;
    my %allfound = ();
    my $k;

#    study $p;

    foreach $k (keys %$dbref) {
	my $hatk = "^"."$k";
#	$debug6 && print "does <$p> match <$hatk>?\n";
	if ( $p =~ /$hatk/ ) {
	    $debug6 && print "YIKES!! RNDB FOUND <$p> in <$k>\n";
	    $rtn++;
	    $allfound{$k} = 1;
	}
    }
    return ($rtn,\%allfound);  # returns zero if not found; o.w. count and keys
}


# returns count and hashref of all records in db arg that are subsumed
# by arg y
sub subsumed_query_all {
    my $y = $_[0];
    my $dbref = $_[1];
    my $rtn = 0;
    my %allfound = ();
    my $haty = "^"."$y";
    my $x;
    
    $debug6 && print "subsumed_query_all subsumed by <$y>..\n";

    foreach $x (keys %$dbref) {
#	$debug6 && print "does <$x> match <$haty>?\n";
	if ( $x =~ /$haty/ ) {
	    $debug12 && print "YIKES!! RNDB FOUND <$y> in <$x>\n";
	    $rtn++;
	    $allfound{$x} = 1;
	}
    }

    return ($rtn,\%allfound);  # returns zero if not found; o.w. count and keys
}


# a string x is subsumed by a string y, if for every specified bit ai
# in y the corresponding bit bi in x is also specified, and ai == bi;
# return 1 if such a string x is found, o.w. 0
sub subsumed_query {
    my $y = $_[0];
    my $dbref = $_[1];
    my $rtn = 0;
    my $haty = "^"."$y";
    my $x;
    
    $debug6 && print "subsumed_query subsumed by <$y>..\n";

    foreach $x (keys %$dbref) {
#	$debug6 && print "does <$x> match <$haty>?\n";
	if ( $x =~ /$haty/ ) {
	    $debug6 && print "YIKES!! RNDB FOUND <$y> in <$x>\n";
	    $rtn = 1;
	    last;
	}
    }
    return $rtn;        # returns zero if not found; o.w. true
}


sub setup_prndb {
    my $dbref = $_[0];
    my ($piref,$pirref) = &setup_permute_order();
    my $pndbref = &permute_rndb($dbref,$piref,$pirref);
    return ($pndbref,$piref,$pirref);
}


sub permute_rndb {
    my $dbref = $_[0];
    my $piref = $_[1];
    my $pirref = $_[2];
    my %pidb;
    my $r;

    if (!$USE_PERMUTE) { return $dbref;}

    foreach $r (keys %$dbref) {
	my $s = &permute_record($r,$piref);
	$pidb{$s} = $r;
	$debug10 && print "PIDB of <$r> is <$s>, $pidb{$s}\n";
    }

# built-in sanity check
    if ($debug10) {
	my $s;
	foreach $s (keys %pidb) {
	    my $t = &reverse_permute_record($s,$pirref);
	    if ( $pidb{$s} !~ /$t/ ) {
		die "BUG <$s>, <$pidb{$s}> not back again to <$t>\n";
	    }
	}
    }
    return \%pidb;
}


# permute a record here 
sub permute_record {
    my $r = $_[0];
    my $piref = $_[1];
    my $l = length $r;
    my $p;
    my $s = "";

    if (!$USE_PERMUTE) { return $r;}

    $debug10 && print "permuting record <$r>..\n";

    # permute each record here 
    for ($p = 0; $p < $LEN; $p++) {
	my $tmp;
	$debug10 && print "take <$p>th <$$piref[$p]> ";
	if ( $l <= $$piref[$p] ) {
	    $tmp = ".";
	} else {
	    $tmp = substr($r,$$piref[$p],1);
	}
	$s = $s . $tmp;
	$debug10 && print " got <$tmp> now s is <$s> \n";
    }
    return $s;
}


# un-permute a record here
sub reverse_permute_record {
    my $r = $_[0];
    my $pirref = $_[1];
    my $l = length $r;
    my $p;
    my $s = "";
	
    if (!$USE_PERMUTE) { return $r;}

    for ($p = 0; $p < $LEN; $p++) {
	my $tmp;
	if ($l <= $$pirref[$p]) { 
	    $tmp = ".";         # for ndb case
	} else {
	    $tmp = substr($r,$$pirref[$p],1);
	}
	$s = $s . $tmp;
    }
    return $s;
}


# take a map of bit indexes and their values, and un-permute the bit index
# returning the same value.
sub reverse_permute_index_value_map {
    my $ivref = $_[0];
    my $pirref = $_[1];
    my %riv; 
    my $i;
	
    if (!$USE_PERMUTE) { return $ivref;}

    foreach $i (keys %$ivref) { 
	my $r = $$pirref[$i];
	$riv{$r} = $$ivref{$i};
    }
    return \%riv;
}


sub setup_permute_order {
    my $argcount = @_;
    my $r;
    my $piref;
    my @pir = ();   # reverse permute indexes
    my @pi;         # permute order
    my $l = (!$LEN ? $DEFAULTLEN: $LEN);  # if starting w empty rndb

    if ($argcount > 0) {
	$piref = $_[0];
    } else {
	$piref = &shuffle_bits($LEN,$LEN,0,$USE_PERMUTE);
    }

    @pi = @$piref;

    $debug10 && Print( "permute order now: ");
    for ($r = 0; $r < $LEN; $r++) {
	my $u = $pi[$r];
	$pir[$u] = $r;
	$debug10 && Print( "$u ");
#	$debug10 && print "$r/$pi[$r] $u/$pir[$u], ";
    }
    $debug10 && Print( "\n");
    
    if ($debug10 ) {
	my $v;
	print "reverse permute order now: ";
	for ($v = 0; $v < $LEN; $v++) {
	    print "$pir[$v] ";
	}
	print "\n";
    }
    return (\@pi,\@pir);
}


# randomly switch all the 'dc' indexes and the pick the first 'num' 
sub shuffle_bits {
    my $num = $_[0];
    my $dc = $_[1];
    my $l = $_[2];
    my $pflag = $_[3];
    my $ref;
    my $i;
    my @holder;

    for ($i = 0; $i < $dc; $i++) {
	$holder[$i] = $i + $l;   # init to the indexes
    }

    if (!$pflag) {
	$dc = 0;                 # won't permute
    }

#    print "call shufflelist #1\n";
    $ref = &shuffle_list($num,\@holder,$dc);
    return $ref;
}


# general function that picks num elements of alist at random
# returns a list of the alist values (not keys) selected.
sub shuffle_list {
    my $num = $_[0];
    my $alistref = $_[1];
    my $sz = $_[2];   # size of arraylist
    my @r;
    my $i;

#    $debug6 = 1;
    $debug6 && print "Shuffle_list: pick <$num> from <$sz>\n";
    $num <= 0 && die("shuffle list can't pick <$num> from list\n"); 

    for ($i = 0; $i < $sz; $i++) {
	my $x = int(&rander($sz));
	my $tmp = $$alistref[$i];
	$$alistref[$i] = $$alistref[$x];
	$$alistref[$x] = $tmp;
#	$debug6 && print "swap $$alistref[$x] at <$x> with $$alistref[$i] at <$i>\n";
    }

    $debug6 && print "shuffle_list returns <$num> out of <$sz> selections : ";
    for ($i = 0; $i < $num; $i++) {
	my $pick = $$alistref[$i];
	$r[$i] = $pick;                 # changed v.27 did it break? 
	$debug6 && print "$pick ";
    }
    $debug6 && print "\n";
#    $debug6 = 0;
    return \@r;
}


# lucky bits returns a distinct, random num-out-of-dc indexes as
# values in a array
sub lucky_bits {
    my $num = $_[0];
    my $dc = $_[1];
    my $l = $_[2];
    my $ref;
    my $i;
    my @holder;

    for ($i = 0; $i < $dc; $i++) {
	$holder[$i] = $i + $l;   # init to the indexes
    }

    $ref = &lucky_bits_list($num,\@holder,$dc);
    return $ref;
}


# lucky bits list returns a distinct, random num-out-of-dc indexes as
# values in a list, from alist of possibilites
sub lucky_bits_list {
    my $num = $_[0];
    my $alistref = $_[1];
    my $dc = $_[2];
    my %f = ();
    my @r = ();
    my $c = 0;
    my $y = $dc;
    my $chk = 0;

    $debug6 && print "lucky_bits_list returns <$num> out of <$dc> bits : ";

    while ($c < $num && $y > 0) {
	my $d = 0;
	my $x = int(&rander($dc));
	$chk++;
	while (defined $f{$x}) {
	    $x = int(&rander($dc));
	    $chk++;             # how many times MUST we do this?
	}
	$r[$c] = $$alistref[$x];       # value is the index of record
	$f{$x} = $r[$c];
	$debug6 && print "$r[$c] ";
	$c++;
	$y--;
    }
    $debug6 && print "--- <$chk> times calls to rand.\n";
    return \@r;
}


# Insert: args are record to insert, permutation
# refs, negative pattern generate flag (0 is none for empty db);
# result is add2cache is propagated ready to be emptied into the RNDB;
# count of these new records is returned. 
sub make_rndb_rec {
    my $rec = $_[0];
    my $permrefs = $_[1];
    my $npgflag = $_[2];
    my $l = length $rec;
    my $dc = &count_dontcares_rec($rec);
    $l = $l - $dc;
    my $count = 0;
    my $bn = $MAX_KEY - $l;
    if ($bn < 0) { $bn = 0; }
    Print( "bn is $bn, l is $l, "); 

    ($debug12 || $debug6) && print "make_rndb_rec...record <$rec> with <$dc> don't cares\n";

    if (!$dc || !$bn) {
	my $newrec = $rec;
	if ($npgflag) { 
	    $newrec = &negative_pattern_generate($rec,$permrefs);
	}
	$debug6 && print "\nMAKING 1 RNDB RECORD for <$rec>, <$newrec> length <$l>\n";
	$count += &add_rndb_rec2cache($newrec,$permrefs);

    } else {  # dc and bn are at least one, if here.

	my $j = &determine_minimum_records2add($STEP6);
	my $k = 0;

	$debug6 && print "\nMAKING at most <$j> RNDB RECORDS for <$rec>, length <$l>\n";
	$debug6 && print "$RN";

	while ($k < $j) {              # at least once though
	    my $ref = &random_distinct_bits($bn,$dc,$rec);
	    my $dbits = scalar @$ref;       # number of indexes  
	    $count += &addallbitcombos($rec,$ref,$dbits,$npgflag,$permrefs);
	    $k++;
	}
	$debug6 && print "\n";
    }
    return $count;
}


sub determine_minimum_records2add {
    my $step6 = $_[0];
    my $j;
    if ($step6 == 1) {
	$j = 1;
    } else {
	$j = int(&rander($step6));  # step 6
	if (!$j) { $j = 1; }        # minimum one time
    }
    return $j;
}


sub addallbitcombos {
    my $rec = $_[0];
    my $dcixref = $_[1];
    my $dbits = $_[2];
    my $npgflag = $_[3];
    my $permrefs = $_[4];
    my $pc = 2**$dbits;   # every possible combination 2**$dbits
    my $i = 0;
    my $count = 0;

#    print "add all bit combos ($pc) records\n";

    while($i < $pc) {
	my $x;
	my %replaceset;
	my $newrec = $rec;
	my $v = sprintf("%b",$i);           # binary form
	$v = pad_left_length($v,"0",$dbits); # pad left w zeros only to dbits
	$v = reverse $v;
	$debug6 && print " for <$i>, a string of <$dbits> is <$v>\n";

	# sort the indexes in ascending order
	# replaces don't care in newrec with val.
	# from right to left.
	for ($x = 0; $x < $dbits; $x++) {
	    my $y = $$dcixref[$x];
	    my $val = chop($v);             # get the now "last" bit
#	    $debug6 && print "splice set #9: <$newrec> at <$y> with <$val>\n";
	    $replaceset{$y} = $val;
	}
	$newrec = &splice_string_set($newrec,\%replaceset);
	$debug6 && print "ss returns <$newrec>\n";
	if ($npgflag) {
	    $newrec = &negative_pattern_generate($newrec,$permrefs);
	    $debug12 && print "npg returns <$newrec>\n";
	}
	$count += &add_rndb_rec2cache($newrec,$permrefs);
	$i++;
    }
    return $count;
}


# the output of NPG is a string that matches only itself and strings
# in RNDB.  NPG outputs a string y that subsumes arg x and matches no
# other string outside of RNDB;
sub negative_pattern_generate {
    my $x = $_[0];
    my $permrefs = $_[1];
    my $dbref = \%RNDB;
#    print "neg patt gen permrsef is $permrefs\n";
    if ($permrefs) {
	$dbref = $$permrefs[$pdb];
#	print "neg patt gen new dbref is $dbref\n";
    }

    $debug5 && print "\nnegative_pattern_generate: consider NDB record: <$x>\n";
#	print "call c_key from pg\n";
    my ($s,$sivref) = &c_key_negative($x,$dbref); # does it own extra permute.
    my $l = length $s;
    my $dc = &count_dontcares_rec($s);
    $l -= $dc;

    my @alist = keys %$sivref;
    my $sz = @alist;
#    my $t = int(&rander($sz+1));     # between zero and |SIV| inclusive
    my $t = $MAX_KEY - $l;            # keep the size fixed, if possible
    my $y;
    $debug6 && print "in npg: t is <$t> and size of siv is <$sz>\n";

    if ($t <= 0 || !$sz) {
	$y = $s;
    } elsif ($t >= $sz) {
	$y = $x;
    } else {
#	print "call shufflelist #2 from npg \n";
	my $rixref = &shuffle_list($t,\@alist,$sz);
	my $x;
	$y = $s;
	my %replaceset;
	for($x = 0; $x < $t; $x++) {
	    my $k = $$rixref[$x];
	    my $v  = $$sivref{$k};
#	    print "splice set #2 with <$k> at <$v>\n";
	    $replaceset{$k} = $v;
	}
	$y = &splice_string_set($y,\%replaceset);
    }
    $debug6 && print "done: returning <$y>\n\n";
    return $y;
}


# refine r to its essential bits by flipping the last bit and
# replacing it with 'dontcare' if it is subsumed by some string in prndb;
# return the c_key, and a hash of the eliminated bits and their values.
sub c_key_negative {
    my $r = $_[0];
    my $dbref = $_[1];
    my $l = length $r;
    $l > $LEN && die "ckey: string <$r> is length <$l>\n";
    my $v = 0;
    my %siv;
    my @permrefs = &setup_prndb($dbref);
    my $s = &permute_record($r,$permrefs[$pi]);

    $debug5 && print "\nc_key: consider NDB record: <$r>\n";
    while ($v < $l) {
	my $c1;
	my $c = substr($s,$v,1);               # save for later
	if ($c =~ /\./) { 
	    $debug5 && print "skipping bit <$v>, is already <$c>\n";
	    $v++;
	    next; 
	}                    # nothing to do if already don't care

	$c1 = 1 - $c;                          # flip the last bit
	my $f = &splice_string($s,$v,$c1);     
#	print "splice call #3 returns $f\n";

	my $fndpatt = &query_ndb($f,$permrefs[$pdb]); # nop if bootstrap rndb

	if ($fndpatt) {      # remove bit if in prndb
	    $debug5 && print "c_key: bit index <$v> value <$c>  in prndb\n";
	    $s = &splice_string($s,$v,"."); 
#	    print "splice call #5 returns $s\n";  
	    $siv{$v} = $c;    # save index and value
	}
	$v++;
    }
    $s = &pad_right($s,".");    # pad right with don't care's
    $debug5 && print "negative_c_key is <$s>\n";

    my $srev = &reverse_permute_record($s,$permrefs[$pir]);
    my $sivrevref = &reverse_permute_index_value_map(\%siv,$permrefs[$pir]);
    $debug10 && print "rev permuted negative_c_key is <$srev>\n";

    return ($srev,$sivrevref);
}


# takes hash set of replacements with keys as position v and values as
# r, then inserts r at position v of string s, returns new string ns.
sub splice_string_set {
    my $s = $_[0];
    my $repref = $_[1];
    my $v;
    my @chars = split(//,$s);
    foreach $v (keys %$repref) {
	my $r = $$repref{$v};
#    print "splice_string_set: <$s> at <$v> with <$r>\n"; 
	$chars[$v]=$r;
    }

    my $ns = join("",@chars); 
#    print "splice_string_set: new string is <$ns>\n"; 
    return $ns;
}


# inserts r at position v of string s, returns new string ns.
# join/split version is no faster on single character call (see
# splice_string_set for more than one splice)
sub splice_string {
    my $s = $_[0];
    my $v = $_[1];
    my $r = $_[2];
    my $l = length $s;
    
    $l > $LEN && die "length of <$s> is <$l> not $LEN\n";
    $v > $l && die "Bogus splicing position <$v> for string <$s> length <$l>\n";

    $debug && $debug6 &&  print "splice_string: <$s> at <$v> with <$r> length <$l>\n"; 
    my $ns = substr($s,0,$v) . $r;
    if ($v < $l) {
	$ns = $ns .  substr($s,$v+1,$l-$v-1);
    }
    $debug1 && $debug6 && print "splice_string: newstring is <$ns>\n"; 
    my $lns = length $ns ;
    $lns > $LEN && die "splice: newstring <$ns> is too big <$lns>\n";
    return $ns;
}


# given the number of distinct indexes to select "at most", the range of
# choices (i.e. number of don't cares), and the record;
# return a reference to array of size of the first arg, with that
# number of distinct (dc) indexes as its VALUES.
sub random_distinct_bits {
    my $num = $_[0];
    my $dc = $_[1];
    my $rec = $_[2];
    my $ref;
    my $choicesref = &list_of_choices($rec);
    my $sz = scalar @$choicesref;

#    print "IN RANDOM DISTINCT BITS..select at most <$num>\n";

    $sz > $dc && die "random distinct choices <$sz> impossible <$dc>\n";
    $num <=0 && die "rnadom distinct bits: num <$num> is impossible\n";

    if ($dc <= $num) {              # done if not enough to choose from
#	print "rdbits: not enough to choose from\n";
	$ref = $choicesref;             # of %choices;
    } elsif ($dc < (2 ** $num)) {              # rhs is a guess
#	print "rdbits: do the shuffle with num <$num>, choicesref is <$choicesref> and sz <$sz>\n";
#	print "call shufflelist #3\n";
	$ref = &shuffle_list($num,$choicesref,$sz);  # l rand calls
    } else {
#	print "rdbits: luckybitslist!!\n";
	$ref = &lucky_bits_list($num,$choicesref,$sz);    # undetermined rand calls
    }
    return $ref;
}


sub list_of_choices {
    my $x = $_[0];
    my @c = ();
    my $i = 0;
    my $l = length $x;
    my $n = 0;

    while ($i < $l) {
	my $s = substr($x,$i,1);
	if ( $s =~ /\./ ) {
	    $c[$n] = $i;
	    $n++;
	}
	$i++;
    }
    return \@c;
}

    
# assumes xndb is unpermuted.
# return maximum c_key record size (in specified bits); setup
# two sum.. arrays of distributions to print later.
sub stats {
    my $dbref = $_[0];
    my $dbname = $_[1];
    my $y;
    my $l;
    my $max = 0;
    my @sumrecsz;
    my @sumspecifiedbits;
    my $totrecsz = 0;
    my $totspecifiedbits = 0;
    my $numrecs = scalar keys %$dbref;

    for ($l = 0; $l <= $LEN; $l++) {   # init arrays
	$sumrecsz[$l] = 0;
	$sumspecifiedbits[$l] = 0;
    } 

    foreach $y (keys %$dbref) {
	my $v = $$dbref{$y};
#	print "rec is <$y>, val is <$v>\n";
	$sumrecsz[$v]++;
	$totrecsz += $v;

	if ( $v > $max ) {
	    $max = $v;
	}

	for ($l = 0; $l < $LEN; $l++) {
	    my $c = substr($y,$l,1);
	    if ( $c =~ /[10]/ ) {
		$sumspecifiedbits[$l]++;
		$totspecifiedbits++;
	    }
	}
    }
    $debug5 && print "HERE YA GO: <$totrecsz>\n";
    return ($max,$totrecsz,$totspecifiedbits,\@sumrecsz,\@sumspecifiedbits,$numrecs);
}


sub print_stats {
    my $dbname = $_[0];
    my $statref = $_[1];
    my $permuteflag = $_[2];
    my $totrecsz = $$statref[1];
    my $totspecifiedbits = $$statref[2];
    my $sumrecsz = $$statref[3];
    my $sumspecifiedbits = $$statref[4];
    my $sz = $$statref[5];
    my $z = $sz;
    my $l;
    my $avg;
    my $a;
    my $max=0;

    !$z && die "$dbname couldn't really be empty, now could it?\n";

#    print "<$totrecsz> is this nonzero?\n";
    Print("Distribution of sizes (i.e. specified bits) across $dbname $LEN-bit records:\n");
    Print("SIZE\tCOUNT\tPERCENTAGE\n");
    for ($l = 0; $l <= $LEN; $l++) {
	if ( ! $$sumrecsz[$l]) { next; }
	$a = ($$sumrecsz[$l] / $z) * 100;
	$a = &round_up($a,100);
	Print( "$l\t$$sumrecsz[$l]\t$a%\n");
	if ($l > $max) { $max = $l; } 
    }
    $avg = $totrecsz/$z;
    $avg = &round_up($avg,100);

    if(!$permuteflag){  # print once only
	Print("Average record length is <$avg>; Max is <$max>\n");
	&PrintBR();
	&PrintBR();
    }

    open GPLOT,">$configfilepath/distrib7-$dbname-0.dat";
    print GPLOT "#Distribution of Specified Bits Across $dbname: $LEN-bit records\n";
    print GPLOT "#AVGRECSIZE=$avg;NUMRECORDS=$sz;MOSTSPECIFIEDBITS=$max;MAXKEY=$max;FENUM=$FENUM;STEP6=$STEP6;RESETWINI=$RESETWINI\n";
    print GPLOT "#bit count percentage\n";

    if($WEBDEMO){
	my $permstring = "after reverse";
	if($permuteflag) {
	    $permstring = "in";
	}

	print GPLOT "set terminal pbm small color\n";
	print GPLOT "set ylabel \"Number of Specified Appearances in Negative Records\\n(not the don't cares) \"\n";
	print GPLOT "set xlabel \"Bit Location in Negative Record\"\n";
	print GPLOT "set title \"Distribution of Specified Bits Across $dbname\\n Positive DB ? $LEN-bit records\\n($dbname $permstring permutation)\"\n";
	print GPLOT "plot '-' using 1:2 title \"$dbname\" with linespoints lt 3\n";
    }

    Print("Distribution of Specified Bits Across $dbname $LEN-bit records:\n");
    Print("BIT\tCOUNT\tPERCENTAGE\n");
    for ($l = 0; $l < $LEN; $l++) {
	$a = ($$sumspecifiedbits[$l] / $z) * 100;
	$a = &round_up($a,100);
	Print( "$l\t$$sumspecifiedbits[$l]\t$a%\n");
	print GPLOT "$l $$sumspecifiedbits[$l] $a\n";
    }
    $a = $totspecifiedbits/$z;
    $a = &round_up($a,100);
    Print( "Average number of specified bits per record (i.e. \"record size\"): <$a>\n\n");
    print GPLOT "\n";
    close GPLOT;

    if ($a != $avg ) {
	Print( "$dbname: STATS WEIRDNESS!! the average record size ($avg) and the average number of bits per record ($a) should be the same.\n");
    }
    return;
}


# a delete from DB, increases RNDB's scope reverse order from rear to
# front, until remaining bits of "ndb" record (up to resetwini) is not
# found, and then it is added with randomization
sub online_delete {
    my $query = $_[0];
    my $p = $_[1];
    my $plen = $_[2];  # is 0  or resetwini
    my $q = substr($p,0,$LEN);
    my $count = 0;
    my $l = $LEN;
    my $p2;

    $debug4 && print "args to online delete: query is <$query>, p is <$p>, ans is <$plen>\n";
    
    my @permrefs = &setup_prndb(\%RNDB);
    $p2 = &permute_record($p,$permrefs[$pi]);

    &make_rndb_rec($p2,\@permrefs,1);
    &empty_rndb_add_cache();  # here or right after the make?

    if (&query_ndb($p,\%RNDB)) {
	print "Confirmed deletion of <$query> from DB";
	$UPDRNDBFLAG++;
	$N--;
    } else {
	print "UNCONFIRMED deletion of <$query> from DB!!";
    }
    print " --- <$count> records added.\n";
    return;
}


# propagate the delete cache with all the records that input arg s matches;
# returns the number of records in the cache to be emptied.
sub find_delete_all {
    my $s = $_[0];
    my $permrefs = $_[1];
    my $del = 0;
    my $dbref = \%RNDB;
#    print "find delete all is $permrefs\n";
    if ($permrefs) {
	$dbref = $$permrefs[$pdb];
    }

    my ($q,$qlistref) = &query_ndb_all($s,$dbref);

    if ($q) {
	my $r;
	foreach $r (keys %$qlistref) {
	    $del += &delete_rndb_rec2cache($r,$permrefs);  # rid of both permuted and normal
	}
    }
    if ($q != $del) {
	print "weird! in find_delete_all: found <$q>, deleted <$del>\n";
    }
    return $del;
}


# propagate the delete cache with all the records that are subsumed by input arg s;
# returns the number of records in the cache to be emptied.
sub find_delete_all_subsumed {
    my $p = $_[0];
    my $permrefs = $_[1];
    my $del = 0;
    my $dbref = \%RNDB;
#    print "find delete all subsumed is $permrefs\n";
    if ($permrefs) {
	$dbref = $$permrefs[$pdb];
    }
    my ($q,$qlistref) = &subsumed_query_all($p,$dbref);
    
    $debug12 && print "found ($q) in delete all subsumed\n";
    if ($q) {
	my $r;
	foreach $r (keys %$qlistref) {
	    $debug12 && print "delete to cache rec <$r>\n";
	    $del += &delete_rndb_rec2cache($r,$permrefs);  # rid of both permuted and normal
	}
    }
    if ($q != $del) {
	print "weird! in find_delete_all_subsumed: found <$q>, deleted <$del>\n";
    }
    return $del;
}


# adds a new arg record to rndb with its size (specified bits) if it
# doesn't already exist; resets MAX_KEY to the max number of bits
# specified in a record so far.  warns when rec sizes are different
# (DISABLED TEMPORARILY); note: there is no explicit permutation at
# this point.
sub new_rndb_rec {
    my $rec = $_[0];
    my $l = $LEN;
    my $dc = &count_dontcares_rec($rec);
    $l = $l - $dc;
    my $rtn = 0;
    if (! exists $RNDB{$rec} ) {
	$RNDB{$rec} = $l;
	!defined $RNDB{$rec} && die "record <$rec> not added to RNDB";

#	if (!$K2 && !$CLEANTESTS && $RNDB{$rec} != $MAX_KEY ) {
#	    Print("WARNING!! rec <$rec> length is <$RNDB{$rec}> not $MAX_KEY\n");
#	}

	if ($RNDB{$rec} > $MAX_KEY) {
	    $MAX_KEY = $l;        
	    Print("MAX_KEY is now <$MAX_KEY>\n");
	}

	$debug8 && print "Successfully ADDED NEW rec to RNDB <$rec>, specified length <$RNDB{$rec}>\n";
	$RN++;
	$rtn = 1;
    }
    return $rtn;
}


sub add_rndb_rec2cache {
    my $rec = $_[0];
    my $permrefs = $_[1];
    my $rtn = 0;
    if (!(exists $ndb_add_cache{$rec})) {
	$ndb_add_cache{$rec} = $permrefs;
	$rtn = 1;
    }
    return $rtn;
}


sub empty_rndb_add_cache {
    my $r;
    my $c = 0;
    foreach $r ( keys %ndb_add_cache) {  # sort keys not needed for rerun, no rand nums here
#	print "EMPTY ADD <$r> into db\n";
	$c += &add_rndb_rec($r,$ndb_add_cache{$r});
	delete $ndb_add_cache{$r};
    }

    ($debug11 || $debug7) && print "Added <$c> total records\n";

# sanity check
    my $sz = scalar keys %ndb_delete_cache;
    $sz > 0 && die "empty prndb add cache now <$sz> not empty\n";

    return $c;
}


sub prune_rndb_add_cache {
    my $k2 = $_[0];
    my $r;
    my $count = 0;
    
    if(!$k2) { 
	$k2 = $MAX_KEY;
    }

    foreach $r ( keys %ndb_add_cache) {
#	print "GAH! <$r>\n";
	my $cref = &list_of_choices_specified($r);
	my $sz = @$cref;
	if ($sz < $k2) {
	    Print( "shuffling <$sz> choices\n");
	    Print( "<$r>\n");
	}
#	print "call shufflelist #4\n";
	my $crivref = &shuffle_list($k2,$cref,$sz);
	my $k;
	my $y = &pad_right("",".");    # all dots
	my $n = scalar @$crivref;
	if (! $n || !$sz) {
	    print "not enough <$sz> to choose from\n";
	}
#	print "GOT <$n> to sort\n";
	my $i;
	my %replaceset;
	for($i=0; $i < $k2; $i++) {
	    $k = $$crivref[$i];
	    if ($k >= $LEN) {
		Print("splice call #7 at <$k>\n");
		}
	    my $v = substr($r,$k,1);
#	    print "splice set #7 <$v> at <$k>\n";
	    $replaceset{$k} = $v;
	}
	$y = &splice_string_set($y,\%replaceset);

#	print "pruned <$r> is <$y>\n";
	delete $ndb_add_cache{$r};
	$count += &new_rndb_rec($y);
    }
    return $count;
}


sub list_of_choices_specified {
    my $x = $_[0];
    my @c = ();
    my $i = 0;
    my $l = length $x;
    my $n = 0;

    while ($i < $l) {
	my $s = substr($x,$i,1);
	if ( $s =~ /[01]/ ) {
	    $c[$n] = $i;
	    $n++;
	}
	$i++;
    }
    return \@c;
}


sub add_rndb_rec {
    my $rec = $_[0];
    my $permrefs = $_[1];
    my $p = $rec;
#    print "add rndb rec is $permrefs\n";
    if ($permrefs) {
	$p = &reverse_permute_record($rec,$$permrefs[$pir]);
	$debug10 && print "add rndb rec reverse <$rec> is <$p>\n";
    }
    if (exists $RNDB{$p} ) {
	($debug12 || $debug7) && print "SKIPPED ADDED rec to RNDB <$p>, exists already!!\n";
#	return 0;
    }
    my $l = length $rec;
    my $dc = &count_dontcares_rec($rec);

    $RNDB{$p} = $l - $dc;
    !defined $RNDB{$p} && die "record <$rec> not added to RNDB";
    if( $permrefs ) {
	my $prndb = $$permrefs[$pdb];
	$$prndb{$rec} = $p;
	!defined $$prndb{$rec} && die "record <$rec> not added to prndb";
    }
    ($debug12 || $debug7) && print "Successfully ADDED rec to RNDB <$p>, specified length <$RNDB{$p}>\n";
    $RN++;
#    if (!$CLEANTESTS && $RNDB{$p} != $MAX_KEY ) {
#	Print( "WARNING: rec <$rec> length is <$RNDB{$p}> not $MAX_KEY\n");
#    }
    return 1;
}


sub delete_rndb_rec2cache {
    my $rec = $_[0];
    my $permrefs = $_[1];
    my $rtn = 0;
    if (!exists $ndb_delete_cache{$rec}) {
	$ndb_delete_cache{$rec} = $permrefs;
	$rtn = 1;
    }
    return $rtn;
}


sub empty_rndb_delete_cache {
    my $r;
    my $c = 0;
    foreach $r (keys %ndb_delete_cache) {
#	print "EMPTY DEL <$r> into db\n";
	$c += &delete_rndb_rec($r,$ndb_delete_cache{$r});
	delete $ndb_delete_cache{$r};
    }

    ($debug11 || $debug7) && print "Deleted <$c> total records\n";

# sanity check
    my $sz = scalar keys %ndb_delete_cache;
    $sz > 0 && die "empty prndb delete cache now <$sz> not empty\n";

    return $c;
}


sub delete_rndb_rec {
    my $rec = $_[0];
    my $permrefs = $_[1];
    my $p = $rec;
#    print "delete rndb rec is $permrefs\n";
    if ($permrefs) {
	$p = &reverse_permute_record($rec,$$permrefs[$pir]);
    } 
    if(! exists $RNDB{$p}) {
	return 0;
    }
    delete $RNDB{$p};
    defined $RNDB{$p} && die "record <$p> not removed from RNDB";

    if ($permrefs) {
	my $prndb = $$permrefs[$pdb];
	delete $$prndb{$rec};
	defined $$prndb{$rec} && die "record <$rec> not removed from prndb";
    }
    ($debug12 || $debug7) && print "Successfully DELETED rec from RNDB <$rec>\n";
    $RN--;
    return 1;
}


sub clear_rndb_delete_cache {
    %ndb_delete_cache = ();
    return;
}


# reversed from rear to front
sub online_add {
    my $query = $_[0];
    my $p = $_[1];
    my $plen = $_[2];   # resetwini or 0
    my $count = 0;
    my $deleted = 0;
    my $p2;
    my $y;
    my %cache;
    my $n = 0;

    $debug2 && print "args to online add: query is <$query>, p is <$p>, ans is <$plen>\n";
    
    my @permrefs = &setup_prndb(\%RNDB);
    $p2 = &permute_record($p,$permrefs[$pi]);

    $debug2 && print "permuted p is <$p2>\n";

    $deleted = &find_delete_all($p2,\@permrefs);
    %cache = %ndb_delete_cache;
    &empty_rndb_delete_cache();
 
    if ($debug2) {
	my $z = scalar keys %cache;
	print "deleted cache size is $z\n";
    }

    foreach $y (sort keys %cache) {
	my $l = $LEN;
	$n++;
	$debug2 && print "considering #$n <$y>\n";

	while ($l > $plen) {
	    my $s1;
	    my $c1;
	    my $added = 0;
	    my $c = substr($y,$l-1,1);   
	    if ($c !~ /\./ ) { 
		$debug2 && print "skipping specified bit <$l> <$c>\n";
		$l--;
		next; 
	    }
	    
	    # foreach unspecified bit of y
	    $c1 = substr($p2,$l-1,1);   
	    $c = 1 - $c1; 
	    $debug2 && print "flipped bit $l <$c1> into <$c>\n";
	    $s1 = &splice_string($y,$l-1,$c);
	    $debug2 && print "my new s is <$s1>\n";
	    $added = &make_rndb_rec($s1,\@permrefs,1);
	    &empty_rndb_add_cache();
	    $count += $added;
	    $debug2 && print "added <$added> recs <$s1> length <$l> to RNDB\n";
	    $l--;
	}
    }
    
    if ($n != $deleted ) {
	Print("are we missing some??  <$n> $deleted\n");
    }

    if (!&query_ndb($p,\%RNDB)) {
	print "Confirmed addition of <$query> to DB";
	$UPDRNDBFLAG++;
	$N++;
    } else {
	print "UNCONFIRMED addition of <$query> to DB!!";
    }
    print " --- <$count> records added ($deleted deleted).\n";
    return;
}


sub check_for_binary_mode {
    my $q = $_[0];
    if (!$BINFLAG && $q =~ /^[01]+/){
	print "RESET BINFLAG to TRUE";
	$BINFLAG = 1;
	$MAXREADLEN = $MAXREADLEN * 8;
    }
    return;
} 


sub one_shot {
    if ($webcmd =~ /C/) {
	my @cleanresults = &cleanup_rndb();
	&print_rndb();
	&info_rndb();
#	print("This entire process required $randcalls random numbers.");
	print "Added $cleanresults[$a], Deleted $cleanresults[$d] ";
	print "NET cleanup is $cleanresults[$n]";
	&PrintBR();
    } else {
	my $query = $input;
#    &check_for_binary_mode($input);
	my $q = &prep_query($input);
	if ($q !~ /./) { return; }  # BOLT
	my $q2 = &prep2_query($q);
	my $ans = &query_ndb($q2,\%RNDB);
	$debug1 && print "args to online update: query is <$query>, q is <$q>, q2 is <$q2>, ans is <$ans>\n";
	
	if ($ans) {
	    if ($webcmd =~ /A/) {
		&online_add($q,$q2,0);
	    } elsif ($webcmd =~ /D/) {
		print "[<B>$query</B>] is not in the database (in RNDB) and cannot be Deleted.";
	} else {
	    print "[<B>$query</B>] is not in the database (in RNDB).";
	}
	} else {
	    if ($webcmd =~ /A/) {
		print "[<B>$q</B>] is in the database (not in RNDB) -- and cannot be ADDED again.";
	    } elsif ($webcmd =~ /D/) {
		&online_delete($q,$q2,0);
	    } else {
		print "[<B>$q</B>] is in the database (not in RNDB)";
	    }
	}
    }
    return;
}


sub online_update_rndb {
    my $query = $_[0];
    my $t = $_[1];
    my $q = $_[2];
    my $ans;
    my $q2;

    if ($q !~ /\w+/) {
	print "Enter the record you wish to ";
	if ($t =~ /A/) {
	    print "add: ";
	} elsif ($t =~ /D/) {
	    print "delete: ";
	} else {
	    print "find: ";
	}
	
	$q = <STDIN>;
	chop $q;
	$debug && print "just entered <$q>\n";
    }
    
    if ($BINFLAG && $q !~ /^[01]+/){
	print "INVALID ENTRY \"$query\"; Please use a binary digit 0 or 1\n";
	return 0;
    } 

    if (!$BINFLAG && $q !~ /^\w+/){
	print "INVALID ENTRY \"$query\"; Please use a letter A to Z and/or digit 0 thru 9\n";
	return 0;
    }

    $q2 = &prep_query($q);  # pad with blanks or zeros or truncate to fixed record size
                            # convert ascii to ord, if not already in binary form.

    if ($q2 !~ /./) { return -1; }  # BOLT

    $q2 = &prep2_query($q2);

    $ans = &query_ndb($q2,\%RNDB);

    $debug1 && print "args to online update: query is <$q>, q2 is <$q2>, ans is <$ans>\n";

    if ($ans) {
	if ($t =~ /A/) {
	    &online_add($q,$q2,0);
	} elsif ($t =~ /D/) {
	    print "<$q> is not in the database (in RNDB) and cannot be Deleted.\n";
	} else {
	    print "<$q> is not in the database (in RNDB).\n";
	}
    } else {
	if ($t =~ /A/) {
	    print "<$q> is in the database (not in RNDB) -- and cannot be ADDED again.\n";
	} elsif ($t =~ /D/) {
	    &online_delete($q,$q2,0);
	} else {
	    print "<$q> is in the database (not in RNDB)\n";
	}
    }
    return $ans;
}


sub get_next {
   my $query;
   my $t;
   my $q = "";
   my $rtn = 0;

   print "\nAdding, deleting, or finding a DB record? [A<dd>|D<elete>|F<ind>|S<ave>|Q<uit>|I<nfo>|C<leanup>] ";
   $query = <STDIN>;
   chop $query;
 
   $debug && print "just entered <$query>\n";

   if ($query !~ /^([AaCcDdQqFfSsIi]) ?([\w]*)$/ ) {
       print "At this time the only valid choices are Add, Delete, Find, Save, Quit, Info or Cleanup--- please enter A or D or F or S or Q or I or C\n";
   } else {
       $t = $1;
       $q = $2;
   
       $t = uc $t;

       if ($t =~ /S/) {
	   if ($UPDRNDBFLAG) {
	       print "saving RNDB..\n";
	       &print_rndb();
	   } else {
	       print "RNDB unchanged.\n";
	   }
       } elsif ($t =~ /Q/) {
	   $rtn = -1;
	   if ($UPDRNDBFLAG) {
	       print "\nSave changes to RNDB? [Y<es>|N<o>] ";
	       my $v = <STDIN>;
	       chop $v;
	       $debug && print "just entered <$v>\n";
	       $v = uc $v;
	       if ($v =~ /Y/) {
		   print "saving RNDB..\n";
		   &print_rndb();
	       } else {
		   print "RNDB unchanged.\n";
	       }
	   }
       } elsif ($t =~ /I/) {
	   $rtn = &info_rndb();
       } elsif ($t =~ /C/) {
	   my @cleanresults = &cleanup_rndb();
	   print "Added $cleanresults[$a], Deleted $cleanresults[$d] ";
	   print "NET cleanup is $cleanresults[$n] \n";
	   $rtn = &info_rndb();
       } else {
	   $rtn = &online_update_rndb($query,$t,$q);
       }
   }
   return $rtn;
}


sub round_up {
    my $n = $_[0];
    my $v = $_[1];
    !$v && die "round up death <$n> <$v>\n";
    return int($n*$v + .5)/$v;
}


sub logbase2 {
    my $x = $_[0];
    my $y = log($x)/$ln2;
    my $yint = int($y);
    
    $debug && print "The  base-2 log of <$x> is <$y>";
    
    if ($yint < $y) { 
	$yint++;
	$debug && print ", and the next highest int is <$yint>";
    }
    $debug && print "\n";
    return $yint;
}


# RANDOM NUMBER STUFF

use integer;

# /* a ub4 is an unsigned 4-byte quantity */

# /* external results */
my (@randrsl, $randcnt);

# /* internal state */
my (@mm);
my ($aa, $bb, $cc) = (0, 0, 0);

sub isaac()
{
    my ($i, $x, $y);

    $cc++;       # /* cc just gets incremented once per 256 results */
    $bb += $cc;  # /* then combined with bb */

    for ($i=0; $i<256; $i++)
    {
	$x = $mm[$i];
	$aa                = $mm[($i+128)&255] + ($aa^($aa << 13));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;
	$i++;

	$x = $mm[$i];
     $aa                = $mm[($i+128)&255] + ($aa^(0x03ffffff & ($aa >>
								  6)));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;
	$i++;

	$x = $mm[$i];
	$aa                = $mm[($i+128)&255] + ($aa^($aa << 2));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;
	$i++;

	$x = $mm[$i];
     $aa                = $mm[($i+128)&255] + ($aa^(0x0000ffff & ($aa >>
								  16)));
	$mm[$i]      = $y  = $mm[($x>>2)&255]  + $aa + $bb;
	$randrsl[$i] = $bb = $mm[($y>>10)&255] + $x;

   }
}


# if (flag==TRUE), then use the contents of randrsl[] to initialize mm[].
sub randinit
{
    my ($flag) = @_;
    my $i;
    my ($a, $b, $c, $d, $e, $f, $g, $h);
    $aa = $bb = $cc = 0;
    $a = $b = $c = $d = $e = $f = $g = $h = 0x9e3779b9;  # /* the golden
                                                         # ratio */

    for ($i=0; $i<4; ++$i)          # /* scramble it */
    {
	                            # "mix"
	$a^=$b<<11; $d+=$a; $b+=$c;
	$b^=0x3fffffff & ($c>>2);  $e+=$b; $c+=$d;
	$c^=$d<<8;  $f+=$c; $d+=$e;
	$d^=0x0000ffff & ($e>>16); $g+=$d; $e+=$f;
	$e^=$f<<10; $h+=$e; $f+=$g;
	$f^=0x0fffffff & ($g>>4);  $a+=$f; $g+=$h;
	$g^=$h<<8;  $b+=$g; $h+=$a;
	$h^=0x007fffff & ($a>>9);  $c+=$h; $a+=$b;
    }

    for ($i=0; $i<256; $i+=8)   # /* fill in mm[] with messy stuff */
    {
     if ($flag)                # /* use all the information in the seed */
     {
	 $a+=$randrsl[$i  ]; $b+=$randrsl[$i+1];
	 $c+=$randrsl[$i+2]; $d+=$randrsl[$i+3];
	 $e+=$randrsl[$i+4]; $f+=$randrsl[$i+5];
	 $g+=$randrsl[$i+6]; $h+=$randrsl[$i+7];
     }
     # "mix"
     $a^=$b<<11; $d+=$a; $b+=$c;
     $b^=0x3fffffff & ($c>>2);  $e+=$b; $c+=$d;
     $c^=$d<<8;  $f+=$c; $d+=$e;
     $d^=0x0000ffff & ($e>>16); $g+=$d; $e+=$f;
     $e^=$f<<10; $h+=$e; $f+=$g;
     $f^=0x0fffffff & ($g>>4);  $a+=$f; $g+=$h;
     $g^=$h<<8;  $b+=$g; $h+=$a;
     $h^=0x007fffff & ($a>>9);  $c+=$h; $a+=$b;
     $mm[$i  ]=$a; $mm[$i+1]=$b; $mm[$i+2]=$c; $mm[$i+3]=$d;
     $mm[$i+4]=$e; $mm[$i+5]=$f; $mm[$i+6]=$g; $mm[$i+7]=$h;
 }

   if ($flag)
   {        # /* do a second pass to make all of the seed affect all of mm
       
    for ($i=0; $i<256; $i+=8)
    {
	$a+=$mm[$i  ]; $b+=$mm[$i+1]; $c+=$mm[$i+2]; $d+=$mm[$i+3];
	$e+=$mm[$i+4]; $f+=$mm[$i+5]; $g+=$mm[$i+6]; $h+=$mm[$i+7];
       # "mix"
	$a^=$b<<11; $d+=$a; $b+=$c;
	$b^=0x3fffffff & ($c>>2);  $e+=$b; $c+=$d;
	$c^=$d<<8;  $f+=$c; $d+=$e;
	$d^=0x0000ffff & ($e>>16); $g+=$d; $e+=$f;
	$e^=$f<<10; $h+=$e; $f+=$g;
	$f^=0x0fffffff & ($g>>4);  $a+=$f; $g+=$h;
	$g^=$h<<8;  $b+=$g; $h+=$a;
	$h^=0x007fffff & ($a>>9);  $c+=$h; $a+=$b;
	$mm[$i  ]=$a; $mm[$i+1]=$b; $mm[$i+2]=$c; $mm[$i+3]=$d;
	$mm[$i+4]=$e; $mm[$i+5]=$f; $mm[$i+6]=$g; $mm[$i+7]=$h;
    }
}

    isaac();               # /* fill in the first set of results */
    $randcnt=256;        # /* prepare to use the first set of results */
}


sub seedrand_new {
    my $tmp = $_[0];
    if (!$tmp) {
	open DEVR,"/dev/urandom" || die "no urandom file in slash dev\n";
	read DEVR,$seed,1024;
	close DEVR;
	open RS,">$configfilepath/lastseed";
	print RS "$seed\n";
	close RS;
    } else {
	Print( "reading seed from lastseed file\n");
	open RS,"$configfilepath/lastseed";
	read RS,$seed,1024;
	close RS;
    }
#    print "seed is <$seed>\n"; # its huge.
    &convert_string_to_seed();
    &randinit(1);
}


sub convert_string_to_seed {
    my $rcnt = 0;
    my $i;
    for ($i = 0; $i < 1024; $i+=4) {
	my $j;
	my $n = 0;
	for ($j = 0; $j < 4; $j++) {
	    my $c = substr($seed, $i+$j, 1);
	    $c = ord($c);
	    $n = $n + $c<<$j*8;
	}
	$n = $n & 0x7fffffff;
#	Print( "seed <$rcnt> is <$n>\n");
	$randrsl[$rcnt++] = $n;
    }
    return;
}

sub seedrand {
    my $tmp = $_[0];
    if (!$tmp) {
	$seed = (time ^ $$ ^ unpack "%L*", `ps axwwww | gzip`);
	} 
    Print( "seed is <$seed>\n");
    srand($seed);
}


# count rand calls
sub rander {
    my $x = $_[0];
    my $r = rand($x);
    $randcalls++;
    return $r;
}


# count rand calls
sub rander_new {
    my $x = $_[0];
    $randcalls++;
    return &irand($x);
}


sub irand {
    my $mod = $_[0];
    $randcnt--;
#    print "randcnt is <$randcnt>; randcalls is <$randcalls>;";  
    if ($randcnt < 0) {
	&isaac();
	$randcnt = 255;
    }
    my $rnum = $randrsl[$randcnt];
    $rnum = $rnum & 0x7fffffff;      # mask out negative sign bit
#    print "rnum is $rnum; MOD IS $mod\n";
    $rnum = $rnum % $mod;
    return $rnum;
}


sub Print {
    my $s = $_[0];
    if(!$WEBDEMO)
    {
	print $s;
    }
    return;
}

sub PrintBR {
    if(!$WEBDEMO)
    {
	print "\n";
    }
    else
    {
	print "<BR>";
    }
    return;
}

sub main{
    my $r;
#    print "updateDB: $version\n";

    &command_args(@_);
    &seedrand($seed);

#    print "Using RNDB..\n";
    $N = &read_rndb();

    if (!$N) {
	$N = &no_rndb_2();           # initial permute implicit
    }

    if($CLEANTESTS) {
	&clean_tests();
    } elsif($WEBDEMO) {
	if( $webcmd !~ /N/) {
	    &one_shot();
	} else {
	    &print_rndb();
	    &info_rndb();
	    print("This entire process required $randcalls random numbers.");
	    &PrintBR();
	}
    } else {
	while (1) {
	    $r = &get_next();
	    $r < 0 && last;
	}
	print "bye!\n\n";
    }
    return;
}