
###########################################################################
# Copyright (c) 1998, Jeffrey Glen Rennie
# All rights reserved.
###########################################################################

namespace eval urlbase {
    array set blacklist {}
    set dataFileName "database.tcl"
    set sizeMax 1000
    set cropRatio .20
    set sizeCrop [expr { $sizeMax - ($sizeMax * $cropRatio) } ]
    set purgeInterval 300000 ;# every 5 minutes
    set modified 0

    set dataFileTemplate {
	####################################################################
	# urlbase.tcl
	# Do not modify!
	####################################################################
	array set urlbase::blacklist { % }
    }
}

proc urlbase::GetNthSmallestValue { arrayVar n } {
    upvar $arrayVar theArray
    set w " \r\n\t"
    regsub -all "(\[^$w]+\[$w]+)(\[^$w]+\[$w]*)" [join [array get theArray]] \
	    \\2 values
    lindex [lsort -integer [split $values]] $n
}

proc urlbase::RemoveSmallValues { arrayVar cropValue } {
    upvar $arrayVar theArray
    set indices [array names theArray]
    foreach index $indices {
	if { $theArray($index) < $cropValue } {
	    unset theArray($index)
	}
    }
}

proc urlbase::PurgeIfNecessary { } {
    variable sizeCrop
    variable sizeMax
    variable blacklist

    if { [array size blacklist] > $sizeMax } {
	set countKill [expr { [array size blacklist] - $sizeCrop }]
	set cropValue [GetNthSmallestValue blacklist $countKill]
	RemoveSmallValues blacklist $cropValue
    }
}

proc urlbase::AddBadURL { url } {
    variable blacklist
    variable modified
    set blacklist($url) [clock seconds]
    set modified 1
}

proc urlbase::IsBadURL { url } {
    variable blacklist
    info exists blacklist($url)
}

proc urlbase::LoadBadURLs { } {
    variable dataFileName
    if [ catch {
	source $dataFileName
    } errMessage ] {
	dbg::puts urlbase "Error sourcing $dataFileName: $errMessage"
    }
}

proc urlbase::SaveBadURLs { } {
    variable blacklist
    variable dataFileName
    variable dataFileTemplate
    #make it more readable
    set w " \r\n\t"
    regsub -all "(\[^$w]+\[$w]+\[^$w]+\[$w]*)" [array get blacklist] \
	    \\1\n data
    regsub % $dataFileTemplate $data dataFileContents
    if [ catch {
	set dataFileHandle [open $dataFileName w]
	puts $dataFileHandle $dataFileContents
	close $dataFileHandle
    } errMessage ] {
	dbg::puts urlbase "Error saving $dataFileName: $errMessage"
    }
}
    
proc urlbase::PurgeAndSaveSoon { } {
    variable eventId
    set eventId [after idle urlbase::PurgeAndSave]
}

proc urlbase::PurgeAndSave { } {
    variable purgeInterval
    variable eventId
    variable modified
    if $modified {
	dbg::puts urlbase "Purging blacklist and saving. . ."
	PurgeIfNecessary
	SaveBadURLs
	set modified 0
    } else {
	dbg::puts urlbase "blacklist has not been modified.  Not saving."
    }
    # do it again
    set eventId [after $purgeInterval urlbase::PurgeAndSaveSoon]
}       

proc urlbase::LaunchAutoSave { } {
    variable purgeInterval
    variable eventId
    # cancel any pre-existing event, so we don't get this thing running 
    # twice every interval.  This way, we don't have to worry about
    # sourcing this file twice
    catch { after cancel $eventId }
    set eventId [after $purgeInterval urlbase::PurgeAndSaveSoon]
}

urlbase::LaunchAutoSave


###########################################################################
# Copyright (c) 1998, Jeffrey Glen Rennie
# All rights reserved.
###########################################################################
