OpenACS

gustafn
committed
oacs-5-10:gustafn:20200206191036
on 06 Feb 20
reduce string operations slightly
/tcl/throttle_mod-procs.tcl (+22 -16)
1332 1332     if {[file readable ${:file}]} {
1333 1333       # in case of disk-full, the file might be damaged, so make sure,
1334 1334       # we can continue
1335 1335       if {[catch {source ${:file}} errorMsg]} {
1336 1336         ns_log error "during source of ${:file}:\n$errorMsg"
1337 1337       }
1338 1338     }
1339 1339     # The dump file data is merged with maybe preexisting data
1340 1340     # make sure to adjust the counters and timings.
1341 1341     Users time_window_cleanup
1342 1342     Users compute_nr_users_per_day
1343 1343     #
1344 1344     # When old data is restored, don't trust user-info unless it is
1345 1345     # very recent (e.g. younger than 3 munutes)
1346 1346     #
1347 1347     if {[file readable ${:file}] && ([clock seconds] - [file mtime ${:file}] > 180)} {
1348 1348       Users array unset user_in_community
1349 1349     }
1350 1350   }
1351 1351   dump proc collect {} {
1352       set cmd ""
1353       # dump all variables of the object ::Users
  1352     set cmds {}
  1353     #
  1354     # Dump all variables of the object ::Users
  1355     #
1354 1356     set o ::Users
1355 1357     foreach var [$o info vars] {
  1358       #
1356 1359       # last_mkey is just for internal purposes
1357 1360       if {$var eq "last_mkey"} continue
1358         # the remainder are primarily runtime statistics
  1361
  1362       #
  1363       # The remainder are primarily runtime statistics
  1364       #
1359 1365       if {[$o array exists $var]} {
1360           append cmd [list $o array set $var [$o array get $var]] \n
  1366         lappend cmds [list $o array set $var [$o array get $var]]
1361 1367       } else {
1362           append cmd [list $o set $var [$o set $var]] \n
  1368         lappend cmds [list $o set $var [$o set $var]]
1363 1369       }
1364 1370     }
1365       return $cmd
  1371     return $cmds
1366 1372   }
1367 1373
1368 1374   dump proc write {{-sync false}} {
1369       set cmd [:collect]
  1375     set cmds [:collect]
1370 1376     if {$sync} {
1371 1377       set dumpFile [open ${:file} w]
1372         puts -nonewline $dumpFile $cmd
  1378       puts -nonewline $dumpFile [join $cmds \n]\n
1373 1379       close $dumpFile
1374 1380     } else {
1375 1381       file delete -force ${:file}
1376 1382       set dumpFile [AsyncLogFile new -filename ${:file}]
1377         # Split the cmd to avoid sanitizer without the need to check, if
1378         # the server has support
1379         foreach l [split $cmd \n] {
1380           $dumpFile write $l
  1383       #
  1384       # Write the content in smaller chunks.
  1385       #
  1386       foreach cmd $cmds {
  1387         $dumpFile write $cmd
1381 1388       }
1382 1389       $dumpFile destroy
1383 1390     }
1384 1391   }
1385 1392
1386  
1387 1393   # dump proc write {{-sync false}} {
1388 1394   #   # -sync is currently ignored
1389 1395   #   ns_job queue -detached async-cmd [subst {
1390 1396   #     set dumpFile \[open ${:file} w\]
1391     #     puts -nonewline \$dumpFile [list [:collect]]
  1397   #     puts \$dumpFile [list [join [:collect] \n]]
1392 1398   #     close \$dumpFile
1393 1399   #   }]
1394 1400   # }
1395 1401
1396 1402   # initialization of Users class object
1397 1403   #Users perDayCleanup
1398 1404   Object create Users::users
1399 1405   Users set last_mkey ""
1400 1406
1401 1407   # for debugging purposes: return all running timers
1402 1408   proc showTimers {} {
1403 1409     set _ ""
1404 1410     foreach t [after info] { append _ "$t [after info $t]\n" }
1405 1411     return $_
1406 1412   }
1407 1413
1408 1414   #
1409 1415   # define a class value, which refreshes itself all "refresh" ms.
1410 1416   #
1411 1417   Class create Value -parameter {{value ""} {refresh 10000}}