#=========================================================== # # register_nc # # This proc is used to allow users to register NAMED COUNTERs. # It controls the creation of new Named Counters within the user's # NCRegistry. # # A Named Counter exists within the NCRegistry as a collection # of keyed records. There are three record types for each Named # Counter in an NCRegistry: # # 1. init-$cid - holds the initial count values for the Named Counter # with the name $cid # 1 record per Named Counter # fields: date (quoted), comments (quoted), mozilla, mosaic, # lynx, mie, other # # 2. totals-$cid - holds the current lifetime total counts for the # Named Counter # 1 record per Named Counter # fields: total (all browsers), mozilla, mosaic, # lynx, mie, other # # 3. $cid-yyyymmdd - holds the courrent counts for the day yyyymmdd # for the Named Counter with name $cid # 1 record for every day since the counter was registered # fields: mozilla, mosaic, lynx, mie, other # # Calling Sequence: # # register_nc {cid {initcounts 0} {comments ""}} # # cid - # initcounts - # comments - # proc SAFE_register_nc {cid {initcounts 0} {comments ""}} { if {![info exists cid]} { html "[Error: Named Counter not specified]" } elseif {![dbexists NCRegistry]} { html "[Error: Missing NCRegistry]" } else { if {![dbfetch NCRegistry registry rarray]} { html "[Error: Missing registry record]" } else { if {[dbfetch NCRegistry init-$cid carray]} { html "[Error: Named Counter ($cid) already exists]" } else { # only a certain number of NCs are allowed for a given user if {$rarray(nccount) >= $rarray(ncmax)} { html "[Error: Too many Named Counters in this registry]" } else { # all ok, so start by updating registry record info incr rarray(nccount) set rarray($cid) [quote_string [format [getclock]]] # now setup the specific counter init and totals records scan initcounts %d ccount set tarray(total) $ccount # total values for init count scan [expr $ccount * .85] %d tarray(mozilla) scan [expr $ccount * .07] %d tarray(other) scan [expr $ccount * .05] %d tarray(mosaic) scan [expr $ccount * .02] %d tarray(lynx) scan [expr $ccount * .01] %d tarray(mie) set carray(date) rarray($cid) set carray(comments) [quote_string $comments] set carray(mozilla) $tarray(mozilla) set carray(other) $tarray(other) set carray(mosaic) $tarray(mosaic) set carray(lynx) $tarray(lynx) set carray(mie) $tarray(mie) dbstore NCRegistry registry rarray dbstore NCRegistry init-$cid carray dbstore NCRegistry totals-$cid tarray } } } } } #=========================================================== # # incr_nc # # increments the Named Counter for the current day (appropriate browser) # and the counter's total (overall and for the appropriate browser). # # If this is the first visit of the day, then a new database record is created. # Returns, by default the total visits (all browsers all days) since the counter # was registered. The caller may request the daily total instead. The caller # may also request only a specific browser's count be returned. # # Calling Sequence: # # incr_nc {cid {show show} {browser all} {rtntype lifetime}} # # cid - is the name of the counter to be incremented # show - is an indicator to return or not resurn a count # default is show (any other value means noshow) # browser - is the browser count to be returned - default all # values: all this mozilla mosaic lynx mie other # rtntype - is the count to be returned - default lifetime # values lifetime (any other value means today only) proc SAFE_incr_nc {cid {show show} {browser all} {rtntype lifetime}} { global webenv if {![info exists cid]} { html "[Error: Named Counter not specified]" # first verify that there is such a named counter registered # and if not, then return an error } elseif {![dbfetch NCRegistry totals-$cid tarray} { html "[Error: Named Counter ($cid) is not registered]" } else { # if first count today, then create a new daily record with all values 0 set dayindex [fmtclock [getclock] %Y%m%d] if {![dbfetch NCRegistry $cid"-"$dayindex carray]} { set carray(mozilla) 0 set carray(mosaic) 0 set carray(lynx) 0 set carray(mie) 0 set carray(other) 0 } # increment the appropriate daily and total counts if {[string last "Mozilla" $webenv(HTTP_USER_AGENT)] != -1} { if {[string last "MSIE" $webenv(HTTP_USER_AGENT)] != -1} { incr carray(mie) incr tarray(mie) } else { incr carray(mozilla) incr tarray(mozilla) } } elseif {[string last "Mosaic" $webenv(HTTP_USER_AGENT)] != -1} { incr carray(mosaic) incr tarray(mosaic) } elseif {[string last "Lynx" $webenv(HTTP_USER_AGENT)] != -1} { incr carray(lynx) incr tarray(lynx) } elseif {[string last "Microsoft" $webenv(HTTP_USER_AGENT)] != -1} { incr carray(mie) incr tarray(mie) } else { incr carray(other) incr tarray(other) } incr tarray(total) # save the updated daily and totals records after incrementing the full # total count dbstore NCRegistry $cid"-"$dayindex carray dbstore NCRegistry totals-$cid tarray # get and return the appropriate value # NOTE: code from other proc is duplicated here to # avoid the overhead of a call and additional dbfetch-ing set rtnval -1 if {show == "show"} { if {$rtntype == "lifetime"} { if {$browser == "all"} {set rtnval $tarray(total)} } elseif {[info exists tarray($browser)]} {set rtnval $tarray($browser) } } else { if {$browser == "all"} { set rtnval [expr $carray(mozilla) + $carray(mosaic) + $carray(lynx) + $carray(mie) + $carray(other)] } elseif {[info exists carray($thevar)]} {set rtnval $carray($browser) } } return $rtnval } } } #=========================================================== # # get_nc # # returns the visit count since the named counter has been in use # returns -1 if the named counter does not exist # returns the total visits by default or the mizilla # or other count by request # # Calling Sequence: # # get_nc {cid {browser all} {rtntype lifetime}} # # cid - is the name of the counter to be returned # browser - is the browser count to be returned - default all # values: all this mozilla mosaic lynx mie other # rtntype - is the count to be returned - default lifetime # values: lifetime today yyymmdd (a date with leading 0 in m & d) proc SAFE_get_nc {cid {browser all} {rtntype lifetime}} { if {![info exists cid]} {return -1} set rtnval -1 if {$rtntype == "lifetime"} { if {[dbfetch NCRegistry totals-$cid tarray]} { if {$browser == "all"} {set rtnval $tarray(total) } elseif {[info exists tarray($browser)]} {set rtnval $tarray($browser) } } } else { if {$rtntype == "today"} { set dayindex [fmtclock [getclock] %Y%m%d] } else { set dayindex $rtntype } if {[dbfetch NCRegistry $cid"-"$dayindex carray]} { if {$browser == "all"} {set rtnval $carray(total) } elseif {[info exists carray($browser)]} {set rtnval $carray($browser) } } } return $rtnval } #=========================================================== # # get_init_nc # # returns the initial counts assigned to the counter # returns -1 if the named counter does not exist # returns the total visits by default or the specific # browser by request # # Calling Sequence: # # get_init_nc {cid {browser all}} # # cid - is the name of the counter to be returned # browser - is the browser count to be returned - default all # values: all this mozilla mosaic lynx mie other proc SAFE_get_init_nc {cid {browser all}} { if {![info exists cid]} {return -1} set rtnval -1 if {[dbfetch NCRegistry init-$cid carray]} { if {$browser == "all"} { set rtnval [expr $carray(mozilla) + $carray(mosaic) + $carray(lynx) + $carray(mie) + $carray(other)] } else { if {[info exists carray($browser)]} { set rtnval $carray($browser) } } } return $rtnval } #=========================================================== # # get_real_nc # # returns the "real" counts since the counter was registered - i.e. (total - init_count) # returns -1 if the named counter does not exist # returns the total visits by default or the specific # browser by request # # Calling Sequence: # # get_real_nc {cid {browser all}} # # cid - is the name of the counter to be returned # browser - is the browser count to be returned - default all # values: all this mozilla mosaic lynx mie other proc SAFE_get_real_nc {cid {browser all}} { if {![info exists cid]} {return -1} set rtnval -1 if {[dbfetch NCRegistry init-$cid carray]} { if {[set this_tot [SAFE_get_nc $cid $browser]] >= 0} { if {[set this_init [SAFE_get_init_nc $cid $browser]] >= 0} { set rtnval [expr $this_tot - $this_init] } } } return $rtnval } #=========================================================== # # get_avg_nc # # returns the "real" visit count since the named counter has been in use # AVERAGED by the number of days the counter has been in use # (i.e. a daily average) # # NOTE: the averaged value DOES NOT include initial counts # # returns -1 if the named counter does not exist # returns the total visits by default or the specific # browser by request # # Calling Sequence: # # get_avg_nc {cid {browser all}} # # cid - is the name of the counter to be returned # browser - is the browser count to be returned - default all # values: all this mozilla mosaic lynx mie other proc SAFE_get_avg_nc {cid {browser all}} { if {![info exists cid]} {return -1} set rtnval -1 if {[dbfetch NCRegistry totals-$cid tarray]} { if {[set numer [SAFE_get_real_nc $cid $browser]] >= 0} { set denom [expr [llength [SAFE_dbkeys $cid *-$cid]]] set rtnval [expr $numer /$denom] } } return $rtnval } Make NC Registry