@q @program asys-active 1 99999 d i (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo $include $lib/edit $include $lib/reflist lvar scratch (* workspace var *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourArg (* inital arg string, unmodified *) lvar ourCom (* string: 'official' name of command *) lvar ourTally (* int: number of players counted *) lvar ourBoolean (* int: misc flow control var *) lvar ourCount (* int: tally of players *) : DoInstall ( -- ) (* install program into Argo system *) caller program? not if (* confirm installation method *) ">> Programs must be installed via the " "+install" GetCommandName strcat " command." strcat Tell exit then prog "@a/version" getpropstr if (* confirm re-install *) ">> Reinstalling... " Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-active" setprop RecOldActions #0 "+active" newexit dup scratch ! (* create command *) prog setlink prog "@a/version" thisVersion setprop (* set version *) scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+active" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+active" setprop #0 "+inactive" newexit dup scratch ! (* create command *) prog setlink prog "@a/version" thisVersion setprop (* set version *) scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+inactive" scratch @ setprop (* register *) #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+inactive" setprop ">> Installed." Tell ; : DoUninstall (* uninstall program from Argo *) prog "@a/name" getpropstr if #0 "@a/prog_list/" prog "@a/name" getpropstr strcat getprop not if ">> " prog name strcat " is not currently installed." strcat Tell pid kill then else ">> " prog name strcat " is not currently installed." strcat Tell pid kill then ">> Please confirm: You wish to uninstall " prog name strcat "?" strcat Tell ReadYesNo not if ">> Aborted." Tell pid kill Then background "@a/comm_list/+active" RemoveCommand "@a/comm_list/+inactive" RemoveCommand RecOldActions #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoStripAliases ( s -- s' ) (* return s, stripped of alias strings *) dup ";" instr dup if 1 - strcut pop else pop then ; : DoHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat ")" strcat Tell " " Tell "The staff-only " command @ strcat " command is used to " strcat "search the database for players who have " strcat ourCom @ "+inactive" smatch if "not " strcat then "logged on within a certain number of days, and display " strcat "their names, Argo approval status, and usecount." strcat Tell " " Tell "Syntax: " Tell " " Tell " " #0 "@a/comm_list/+active" getprop name DoStripAliases strcat " ..............................." strcat 28 strcut pop " List players active in last days" strcat Tell " " #0 "@a/comm_list/+inactive" getprop name DoStripAliases strcat " ..............................." strcat 28 strcut pop " List players inactive during last days" strcat Tell " " #0 "@a/comm_list/+active" getprop name DoStripAliases strcat " #skip .............................." strcat 28 strcut pop " Exclude from activity checks" strcat Tell " " #0 "@a/comm_list/+active" getprop name DoStripAliases strcat " #noskip ............................." strcat 28 strcut pop " Include in activity checks" strcat Tell " " #0 "@a/comm_list/+active" getprop name DoStripAliases strcat " #skip ......................................." strcat 28 strcut pop " Show current information on players to be skipped." strcat Tell " " #0 "@a/comm_list/+active" getprop name DoStripAliases strcat " #noskip ....................................." strcat 28 strcut pop " Show current information on players to be skipped." strcat Tell " " Tell ; : DoDbrefsToNames ( {rng} i -- ) ( convert rng of dbrefs to names *) dup begin (* begin dbref-converting loop *) dup while dup 2 + pick name over 2 + put 1 - repeat (* end dbref-converting loop *) pop ; : DoSkipInfo ( -- ) (* show list of skipped players and syntax *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then #0 "@a/player_lists/nocheck" REF-allrefs dup if " " Tell ">> Players not included in activity checks:" Tell " " Tell DoDbrefsToNames 3-col " " Tell else ">> No players are included in the list to be skipped." Tell pop then ">> To skip a player in checks, do `" command @ strcat " #skip '" strcat Tell ">> To include a player in checks, do `" command @ strcat " #noskip '" strcat Tell ; : DoSkip ( -- ) (* edit list of excluded players *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then ourArg @ .pmatch dup not if ">> Player not found." Tell exit then dup #-2 dbcmp if ">> Ambiguous. I don't know who you mean." Tell exit then #0 "@a/player_lists/nocheck" 3 pick REF-add ">> " swap name strcat " will not be included in activity checks." strcat Tell ; : DoNoSkip ( -- ) (* edit list of excluded players *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then ourArg @ .pmatch dup not if ">> Player not found." Tell exit then dup #-2 dbcmp if ">> Ambiguous. I don't know who you mean." Tell exit then #0 "@a/player_lists/nocheck" 3 pick REF-delete ">> " swap name strcat " will be included in activity checks." strcat Tell ; : TallyLine ( -- ) (* show total number of positive results *) ">> Total: " ourTally @ intostr strcat " out of " strcat #-1 stats pop swap pop swap pop swap pop swap pop swap pop intostr strcat " players have " strcat ourBoolean @ not if "not " strcat then "logged on in the past " strcat scratch @ intostr strcat " days." strcat Tell " Players marked with an asterix* have not been approved." Tell " Numbers in parentheses indicate usecount." Tell ; : DoActivityCheck ( -- ) (* show players active in X days *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then 1 ourCounter ! ourArg @ number? not if (* check syntax *) ">> Syntax: '" command @ strcat " '" strcat Tell exit then ourArg @ atoi scratch ! 0 ourTally ! " " Tell ">> Scanning database for " ourBoolean @ if "active" else "inactive" then strcat " players..." strcat Tell " " Tell background (* get process out of the way *) begin (* go check those players! *) ourCounter @ dbref dbtop dbcmp not while ourCounter @ dbref dup player? if dup timestamps ourCount ! swap pop swap pop systime swap - 86400 / scratch @ ourBoolean @ if < else > then #0 "@a/player_lists/nocheck" 4 pick REF-inlist? not and if (* found one... put data on stack as a string *) dup name swap "@a/status" getpropstr dup if "na" smatch if "*" strcat then else pop "*" strcat then " (" strcat ourCount @ intostr strcat ")" strcat ourTally @ 1 + ourTally ! else pop then else pop then depth 500 > if "Impending stack overflow! Here's what we have up to 500... " Tell break then ourCounter @ 1 + ourCounter ! repeat depth not if (* tally what we came up with *) TallyLine exit then depth 0 0 EDITsort 3-col " " Tell TallyLine ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! Update ourArg @ if ourArg @ "#" stringpfx if "#help" ourArg @ stringpfx if DoHelp else "#skip" ourArg @ stringpfx if DoSkipInfo else "#noskip" ourArg @ stringpfx if DoSkipInfo else "#enable" ourArg @ stringpfx if DoEnable else "#disable" ourArg @ stringpfx if DoDisable else "#version" ourArg @ stringpfx if DoVersion else "#install" ourArg @ stringpfx if DoInstall else "#uninstall" ourArg @ stringpfx if DoUninstall else ourArg @ "#s" stringpfx if ourArg @ " " instr dup if ourArg @ swap strcut swap "#skip" swap strip stringpfx if strip ourArg ! DoSkip exit else ">> #Argument not understood." Tell exit then then then ourArg @ "#n" stringpfx if ourArg @ " " instr dup if ourArg @ swap strcut swap "#noskip" swap strip stringpfx if strip ourArg ! DoNoSkip exit else ">> #Argument not understood." Tell exit then then then ">> #Argument not understood." Tell then then then then then then then then exit then then me @ ArgoPermCheck Disabled? ourCom @ "+active" smatch if 1 ourBoolean ! then DoActivityCheck ; . c q @set asys-active=W