multiple originators bug

Where a few weeks ago I fixed a bug that caused route objects for the
same prefix but different origins to be properly indexed and looked
up, it appeared that in a different bit of code an error based on the
same principle was still present. A new version of donetdbm.pl below
will fix this.

drop the module below in src/donetdbm.pl
run "make" in the dbase top level directory

Cheers,

-Marten

#	$RCSfile: donetdbm.pl,v $
#	$Revision: 1.5 $
#	$Author: marten $
#	$Date: 1995/01/03 15:12:01 $

require "enread.pl";
require "addkey.pl";
require "enkeys.pl";
require "enukey.pl";

if ($opt_c) {
    require "cldb.pl";
}

sub donetdbm {

    local(*db) = @_;
    local($unikey);
    local(%en);
    local($i);
    local($objseen) = 0;

    while (%en = &enread(db)) {
	if ($opt_V) {
	    $objseen++;
	    if ($objseen % 100 == 0) {
		print STDERR "donetdbm - indexed $objseen\n";
	    }
	}
	$unikey = &enukey(*en);
	&addkey(*db, $unikey, $en{"offset"});
	
	foreach $i (&enkeys(*en)) {
	    next if $i =~ /\d+\.\d+\.\d+\.\d+\/\d+/;
	    &addkey(*db, "$i", $en{"offset"}) unless $i eq $unikey;
	}
	undef %en;
    }
}

sub docldbm {
    local(*db) = @_;
    local($unikey);
    local(%en);
    local($i, $j, $k);
    local($objseen) = 0;
    local($dupl) = 0;

    while (%en = &enread(db)) {

	if ($opt_V) {
	    $objseen++;
	    if ($objseen % 100 == 0) {
		print STDERR "docldbm - read $objseen\n";
	    }
	}

	# Now, the bit with $dupl may look kind of weird but is needed
	# because the same prefixes can occur with different objects.
	# Then one needs to keep them apart. Just add something unique
	# like a counter ($dupl) will do. Just make sure to remove it
	# before inserting the actual prefix.

	$type = &entype(*en);

	foreach $k (split(/\s+/, $KEYS{$type})) {
	    foreach $j (split(/\n/, $en{$k})) {
		if ($j =~ /^(\d+\.\d+\.\d+\.\d+[\- \d\.]*)$/) {
		    foreach $i (&old_to_new($1)) {
			local($pref, $len) = split(/\//, $i);
			local($netint) = &quad2int($pref);
			if ($uniqkey{"$netint/$len"}) {
			    $uniqkey{"$netint/$len.$dupl"} = &enukey(*en);
			    $clalist[$len] .= ":$netint/$len.$dupl";
			    $dupl++;
			} else {
			    $uniqkey{"$netint/$len"} = &enukey(*en);
			    $clalist[$len] .= ":$netint/$len";
			}
		    }
		} else {
		    if ($j =~ /^(\d+\.\d+\.\d+\.\d+\/\d+)$/) {
			local($pref, $len) = split(/\//, $1);
			local($netint) = &quad2int($pref);
			if ($uniqkey{"$netint/$len"}) {
			    $uniqkey{"$netint/$len.$dupl"} = &enukey(*en);
			    $clalist[$len] .= ":$netint/$len.$dupl";
			    $dupl++;
			} else {
			    $uniqkey{"$netint/$len"} = &enukey(*en);
			    $clalist[$len] .= ":$netint/$len";
			}
		    }
		}
	    }
	}
    }
    # Kludge, but what can you do?
    $CUROBJTYPE = $type;

    # This is the priming bit. It basically means that in a flat
    # tree, we will fill in some of the wellknown knots. Mind
    # you, it will add some 5000 knots to the tree. It will def
    # speed up more specific lookups, but may be slower on indexing.
    # Indexing for large flat type database will likely improve in
    # speed.

    # For now: *NEVER* run priming on database you need to update
    # using dbupdate !!!!! Only for index once database!!!

    local($primecount) = 0;

    if ($opt_p) {
	$const1 = 256**3;
	$const2 = 256**2;
	print STDERR "docldbm - priming database\n" if $opt_V;
	for $i (128..210) {
            local($netint) = $i*$const1;
            next if $uniqkey{"$netint/8"};
            $uniqkey{"$netint/8"} = "DUMMY";
            $clalist[8] .= ":$netint/8";
	    $primecount++;
        }
        for $i (192..210) {
            for $j (0..255) {
                local($netint) = $i*$const1+$j*$const2;
                next if $uniqkey{"$netint/16"};
                $uniqkey{"$netint/16"} = "DUMMY";
                $clalist[16] .= ":$netint/16";
		$primecount++;
            }
        }
	print STDERR "docldbm - inserted $primecount prime entries\n";
    }

	

    print STDERR "docldbm - start inserting prefixes\n" if $opt_V;

    $objseen = 0;
    
    for ($i=0; $i<=32; $i++) {
	foreach (split(/:/, $clalist[$i])) {
	    next if !$_;

	    # Make sure to remove the counter if it exists. See above
	    # with the explanation of $dupl.

	    if (/\.\d+/) {
		local($save) = $_;
		s/\.\d+//;
		&inscla($_, $uniqkey{$save});
	    } else {
		&inscla($_, $uniqkey{$_});
	    }
	    if ($opt_V) {
		$objseen++;
		if ($objseen % 100 == 0) {
		    printf STDERR "docldbm - inserted $objseen\n";
		}
	    }
	}
    }
}

1;



-------- Logged at  Wed Jan 4 00:24:24 MET 1995  ---------