@q
@program top10.muf
1 99999 d
i
( top10.muf    v1.0    Jessy @ FurryMUCK    11/99
  
  A program with a very low usefulness to processor tics ratio: it
  outputs a list of the top 10 most often used Programs, Commands,
  and Players.
  
  INSTALLATION:
  
  Link a global action with a name such as 'top10' to this program.
  Top10.muf must be set at least M3. On a very large MUCK -- where it
  might not be a good idea to have it in the first place -- it may
  need to be set Wizard, to avoid max-instruction-count-exceeded errors.
  Top10.muf requires lib-sort.
  
  USE:
  
  Typing the command name lists the ten Programs, Commands, and Players
  with the highest usecount.
  
  Player objects set guest_player?:yes or _prefs/top10:no are not included 
  in the count.
  
  Top10.muf may be freely ported. Please comment any changes.
)
 
$include $lib/sort
 
lvar ourCounter !
 
lvar ourPrograms
lvar ourExits
lvar ourPlayers
  
: DoTops  ( s --  )    (* show top 10 programs, commands, and players *)
  
  ">>  Scanning dbase for Top $count..." 
  ourCounter @ intostr "$count" subst .tell
  background                     (* go background... may take a while *)
  begin depth while pop repeat                         (* clear stack *)
  0                                         (* put a counter on stack *)
  begin                                 (* begin object scanning loop *)
    dup dbref
    dup dbtop dbcmp not while        (* check: more objects to check? *)
    dup ok? if
      dup "_prefs/top10" getprop if
        pop 1 + continue
      then
      dup program? if                           (* record program use *)
        dup timestamps swap pop swap pop swap pop 
        2140000000 over -
        intostr "0000000000000000000" swap strcat 
        dup strlen 12 - strcut swap pop
        prog "_programs/" rot strcat 
        4 pick name "(" strcat
        4 rotate intostr strcat ")" strcat setprop
      else
      dup exit? if                              (* record command use *)
        dup timestamps swap pop swap pop swap pop 
        2140000000 over -
        intostr "0000000000000000000" swap strcat 
        dup strlen 12 - strcut swap pop
        prog "_exits/" rot strcat 
        4 pick name 
        dup ";" instr if
          dup ";" instr 1 - strcut pop
        then
        "(" strcat
        4 rotate intostr strcat ")" strcat setprop
      else          
      dup player? if                             (* record player use *)
        dup "guest_player?" getprop not if             (* skip guests *)
          dup timestamps swap pop swap pop swap pop 
          2140000000 over -
          intostr "0000000000000000000" swap strcat 
          dup strlen 12 - strcut swap pop
          prog "_players/" rot strcat 
          4 pick name "(" strcat
          4 rotate intostr strcat ")"  strcat setprop
        then
      then then then
    then
    pop 1 +
  repeat
  pop pop
                      (* initialize a prop counter for each category *)
  prog "_programs/" nextprop ourPrograms !
  prog "_exits/"    nextprop ourExits    !
  prog "_players/"  nextprop ourPlayers  !
  1
  me @                                                (* show header *)
  "    Programs                Commands            Players" notify
  me @
  "    --------------------------------------------------" notify
  begin                              (* show top 10 of each category *)
    dup ourCounter @ <= while
    dup intostr ")      " strcat 4 strcut pop
    ourPrograms @ "   " smatch if
      "   "
    else
      prog ourPrograms @ getpropstr strcat
      "                                  " 
    then
    strcat 28 strcut pop 
    ourExits @ "   " smatch if
      "   "
    else
      prog ourExits    @ getpropstr strcat
      "                                  " 
    then
    strcat 48 strcut pop 
    ourPlayers @ "   " smatch if
      "   "
    else
      prog ourPlayers  @ getpropstr 
    then
    strcat
    me @ swap notify
    prog ourPrograms @ nextprop dup if
      ourPrograms !
    else
      pop "   " ourPrograms !
    then
    prog ourExits @ nextprop dup if
      ourExits !
    else
      pop "   " ourExits !
    then
    prog ourPlayers @ nextprop dup if
      ourPlayers !
    else
      pop "   " ourPlayers !
    then
    1 +
  repeat
  pop 
                                              (* clear record props *)
  prog "_programs/" nextprop
  begin
    dup while
    prog over nextprop
    prog rot remove_prop
  repeat
  pop
  prog "_exits/" nextprop
  begin
    dup while
    prog over nextprop
    prog rot remove_prop
  repeat
  pop
  prog "_players/" nextprop
  begin
    dup while
    prog over nextprop
    prog rot remove_prop
  repeat
  pop
  
  ">>  Done." .tell
;
  
: main
  
  dup if 
    atoi dup not if 
      pop 10 
    then 
  else
    10
  then ourCounter !
  "me" match me !
  DoTops
;
.
c
q