@program room-report.muf
1 99999 d
i
( room-report.muf    v1.0    Jessy @ FurryMUCK    6/01
 
  This administrative utility scans the database and reports floating
  rooms [ie, rooms with no entrances], trap rooms [rooms with no exits]
  orphan rooms [rooms without a configured parent room], hidden
  environment rooms [environment rooms that do not show up on @trace],
  and old or unused rooms.
  
  INSTALLATION:
  
  Create a global exit with a name suc as 'roomreport;rr', and link
  it to the program. Set it M3 or W.
  
  USAGE:
  
  rr .......................... Show summary report
  rr #scan .................... Scan database, updating reports
  rr #floating ................ List floating rooms
  rr #traps ................... List trap rooms
  rr #orphans ................. List rooms without configured parents
  rr #hidden .................. List hidden environment rooms
  rr #unused .................. List old and unused rooms
  rr #set <room>=floating ..... Mark <room> as floating
  rr #set <room>=!floating .... Mark <room> as not floating
  rr #set <room>=top .......... Mark <room> as a top level env room
  rr #set <room>=!top ......... Mark <room> as not a top level env room
  rr #config <option>=<value> . Configure program
  rr #help .................... Display help screen
  
  The program's #help option provides additional notes.
  
  Room-report.muf may be freely ported. Please comment any changes.
)
  
$define Tell me @ swap notify $enddef
  
lvar ourArg                                       (* str: command arg *)
lvar ourBoolean                          (* int: flow control boolean *)
lvar ourCounter                   (* str, int, or dbref: loop counter *)
lvar ourDir                                  (* str: data storage dir *)
lvar ourOpt                                   (* str: command #option *)
lvar ourRoom                            (* dbref: room being examined *)
  
(2345678901234567890123456789012345678901234567890123456789012345678901)
  
: DoScan
  
  background
  ">>  Scanning database..." Tell
  me @ "_prefs/rr/tmp" remove_prop
  #2
  begin
    dup dbtop dbcmp not while
    dup ok? if
      dup room? if
        dup "_rrexclude?" getpropstr tolower "yes" stringcmp 0 = if
          1 + continue
        then
        dup "_floating?" getpropstr tolower "yes" stringcmp 0 = if
          1 + continue
        then
        me @ "_prefs/rr/tmp/rooms/"
        3 pick intostr strcat
        3 pick setprop
        dup contents
        begin
          dup while
          dup room? if
            break
          then
          next
        repeat
        if
          me @ "_prefs/rr/tmp/parents/" 
          3 pick intostr strcat
          3 pick setprop
          dup "A" flag? not if
            me @ "_prefs/rr/tmp/hidden/"
            3 pick intostr strcat
            3 pick setprop
          then
        then
        dup timestamps pop swap pop swap pop
        "aging_time" sysparm atoi + systime < if
          me @ "_prefs/rr/tmp/old/"
          3 pick intostr strcat
          3 pick setprop
        then
        dup "_envtop?" getpropstr tolower "yes" stringcmp 0 = not
        over location #0 dbcmp and if
          me @ "_prefs/rr/tmp/orphans/"
          3 pick intostr strcat
          3 pick setprop
        then
      else
        dup exit? if
          dup location 
          dup ok? if
            dup room? if
              me @ "_prefs/rr/tmp/hasexits/" 
              3 pick intostr strcat
              rot setprop
            else
              pop
            then
          else
            pop 
          then
          dup getlink 
          dup ok? if
            dup room? if
              me @ "_prefs/rr/tmp/hasents/" 
              3 pick intostr strcat
              rot setprop
            else
              pop
            then
          else
            pop 
          then
        then
      then
    then
    1 +
  repeat
  pop
  
  me @ "_prefs/rr/tmp/rooms/" nextprop
  begin
    dup while
    me @ over getprop ourRoom !
    me @ "_prefs/rr/tmp/hasexits/%room"
    ourRoom @ intostr "%room" subst getprop not if
      me @ "_prefs/rr/tmp/noexits/"
      ourRoom @ intostr strcat ourRoom @ setprop
    then
    me @ "_prefs/rr/tmp/hasents/%room"
    ourRoom @ intostr "%room" subst getprop not if
      me @ "_prefs/rr/tmp/noents/"
      ourRoom @ intostr strcat ourRoom @ setprop
    then
    me @ swap nextprop
  repeat
  pop
  
  prog "_data" remove_prop
  
  me @ "_prefs/rr/tmp/hidden/" nextprop
  begin
    dup while
    me @ over getprop
    prog "_data/hidden/" 3 pick intostr strcat rot setprop
    me @ swap nextprop
  repeat
  pop
  
  me @ "_prefs/rr/tmp/old/" nextprop
  begin
    dup while
    me @ over getprop
    prog "_data/old/" 3 pick intostr strcat rot setprop
    me @ swap nextprop
  repeat
  pop
  
  me @ "_prefs/rr/tmp/orphans/" nextprop
  begin
    dup while
    me @ over getprop
    prog "_data/orphans/" 3 pick intostr strcat rot setprop
    me @ swap nextprop
  repeat
  pop
  
  me @ "_prefs/rr/tmp/noents/" nextprop
  begin
    dup while
    me @ over getprop
    prog "_data/noents/" 3 pick intostr strcat rot setprop
    me @ swap nextprop
  repeat
  pop
  
  me @ "_prefs/rr/tmp/noexits/" nextprop
  begin
    dup while
    me @ over getprop
    prog "_data/noexits/" 3 pick intostr strcat rot setprop
    me @ swap nextprop
  repeat
  pop
  
  prog "_data/time" systime setprop
  me @ "_prefs/rr/tmp" remove_prop
  
  ">>  Scan complete." Tell
;
  
: DoHelp
  
  "Room-Report.muf" Tell " " Tell
  
  "This administrative utility scans the database and reports floating "
  "rooms (i.e. rooms with no entrances), trap rooms (rooms with no exits), "
  "orphan rooms (rooms without a configured parent room), hidden env"
  "ironment rooms (environment rooms that do not show up on @trace), "
  "and old or unused rooms." strcat strcat strcat strcat Tell " " Tell
  
  "  %cmd .......................... Show summary report"
  command @ "%cmd" subst Tell
  "  %cmd #scan .................... Scan database, updating reports"
  command @ "%cmd" subst Tell
  "  %cmd #floating ................ List floating rooms"
  command @ "%cmd" subst Tell
  "  %cmd #traps ................... List trap rooms"
  command @ "%cmd" subst Tell
  "  %cmd #orphans ................. List rooms without configured parents"
  command @ "%cmd" subst Tell
  "  %cmd #hidden .................. List hidden environment rooms"
  command @ "%cmd" subst Tell
  "  %cmd #unused .................. List old and unused rooms"
  command @ "%cmd" subst Tell
  "  %cmd #set <room>=floating ..... Mark <room> as floating"
  command @ "%cmd" subst Tell
  "  %cmd #set <room>=!floating .... Mark <room> as not floating"
  command @ "%cmd" subst Tell
  "  %cmd #set <room>=top .......... Mark <room> as a top-level env room"
  command @ "%cmd" subst Tell
  "  %cmd #set <room>=!top ......... Mark <room> as not a top-level env room"
  command @ "%cmd" subst Tell
  "  %cmd #config <option>=<value> . Configure program"
  command @ "%cmd" subst Tell " " Tell
  
  "Since scanning the database can be a lengthy process, the program "
  "does not scan every time it is used. Use the #scan option to "
  "force a database scan." strcat strcat Tell " " Tell
  
  "You may exclude categories from the summary report with the #config "
  "option. <Option> may be 'floating', 'traps', 'orphans', 'hidden' or "
  "'unused'. <Value> may be 'yes' or 'no'." strcat strcat Tell " " Tell
  
  "If a room is not supposed to have entrances and/or exits (an environment "
  "room, for example), mark it 'floating' to prevent it from being "
  "listed as a room that needs entrances and/or exits. If a room is "
  "supposed to be located immediately under room #0, mark it as a "
  "top-level environment room to prevent it being listed as an orphan."
  strcat strcat strcat strcat Tell " " Tell
  
  "Note: Soft-coded look programs usually cause all rooms older than "
  "90 days to be reported as old and unused." strcat Tell
;
 
: DoReport
  
  prog "_data/time" getprop not if
    DoScan
  then
  
  "ROOM REPORT SUMMARY (%r, %C)" 
  prog "_data/time" getprop timefmt 
  " " "  " subst ">>  " swap strcat Tell
  
  prog "_config/nonoents" getprop not if
    0 ourCounter !
    prog "_data/noents/" nextprop
    begin
      dup while
      ourCounter @ 1 + ourCounter !
      prog swap nextprop
    repeat
    pop
    ">>  There are %num rooms without entrances."
    ourCounter @ 1 = if 
      "is"   "are"   subst 
      "room" "rooms" subst 
    then
    ourCounter @ intostr "%num" subst Tell
  then
  
  prog "_config/nonoexits" getprop not if
    0 ourCounter !
    prog "_data/noexits/" nextprop
    begin
      dup while
      ourCounter @ 1 + ourCounter !
      prog swap nextprop
    repeat
    pop
    ">>  There are %num rooms without exits."
    ourCounter @ 1 = if 
      "is"   "are"   subst 
      "room" "rooms" subst 
    then
    ourCounter @ intostr "%num" subst Tell
  then
  
  prog "_config/noorphans" getprop not if
    0 ourCounter !
    prog "_data/orphans/" nextprop
    begin
      dup while
      ourCounter @ 1 + ourCounter !
      prog swap nextprop
    repeat
    pop
    ">>  There are %num rooms without parent rooms."
    ourCounter @ 1 = if 
      "is"   "are"   subst 
      "room" "rooms" subst 
    then
    ourCounter @ intostr "%num" subst Tell
  then
  
  prog "_config/nohidden" getprop not if
    0 ourCounter !
    prog "_data/hidden/" nextprop
    begin
      dup while
      ourCounter @ 1 + ourCounter !
      prog swap nextprop
    repeat
    pop
    ">>  There are %num hidden environment rooms."
    ourCounter @ 1 = if 
      "is"   "are"   subst 
      "room" "rooms" subst 
    then
    ourCounter @ intostr "%num" subst Tell
  then
  
  prog "_config/noold" getprop not if
    0 ourCounter !
    prog "_data/old/" nextprop
    begin
      dup while
      ourCounter @ 1 + ourCounter !
      prog swap nextprop
    repeat
    pop
    ">>  There are %num rooms reported as old and unused."
    ourCounter @ 1 = if 
      "is"   "are"   subst 
      "room" "rooms" subst 
    then
    ourCounter @ intostr "%num" subst Tell
  then
;
  
: DoShowFloating
  
  prog "_data/time" getprop not if
    DoScan
  then
  
  "FLOATING ROOMS (%r, %C)" 
  prog "_data/time" getprop timefmt 
  " " "  " subst ">>  " swap strcat Tell
  
  0 ourCounter !
  prog "_data/noents/" nextprop
  begin
    dup while
    ourCounter @ 1 + dup ourCounter !
    intostr ")  " strcat
    prog 3 pick getprop unparseobj strcat Tell
    prog swap nextprop
  repeat
  pop
;
  
: DoShowTraps
  
  prog "_data/time" getprop not if
    DoScan
  then
  
  "TRAP ROOMS (%r, %C)" 
  prog "_data/time" getprop timefmt 
  " " "  " subst ">>  " swap strcat Tell
  
  0 ourCounter !
  prog "_data/noexits/" nextprop
  begin
    dup while
    ourCounter @ 1 + dup ourCounter !
    intostr ")  " strcat
    prog 3 pick getprop unparseobj strcat Tell
    prog swap nextprop
  repeat
  pop
;
  
: DoShowOrphans
  
  prog "_data/time" getprop not if
    DoScan
  then
  
  "ORPHAN ROOMS (%r, %C)" 
  prog "_data/time" getprop timefmt 
  " " "  " subst ">>  " swap strcat Tell
  
  0 ourCounter !
  prog "_data/orphans/" nextprop
  begin
    dup while
    ourCounter @ 1 + dup ourCounter !
    intostr ")  " strcat
    prog 3 pick getprop unparseobj strcat Tell
    prog swap nextprop
  repeat
  pop
;
  
: DoShowUnused
  
  prog "_data/time" getprop not if
    DoScan
  then
  
  "UNUSED ROOMS (%r, %C)" 
  prog "_data/time" getprop timefmt 
  " " "  " subst ">>  " swap strcat Tell
  
  0 ourCounter !
  prog "_data/old/" nextprop
  begin
    dup while
    ourCounter @ 1 + dup ourCounter !
    intostr ")  " strcat
    prog 3 pick getprop unparseobj strcat Tell
    prog swap nextprop
  repeat
  pop
;
  
: DoShowHidden
  
  prog "_data/time" getprop not if
    DoScan
  then
  
  "HIDDEN ENVIRONMENT ROOMS (%r, %C)" 
  prog "_data/time" getprop timefmt 
  " " "  " subst ">>  " swap strcat Tell
  
  0 ourCounter !
  prog "_data/hidden/" nextprop
  begin
    dup while
    ourCounter @ 1 + dup ourCounter !
    intostr ")  " strcat
    prog 3 pick getprop unparseobj strcat Tell
    prog swap nextprop
  repeat
  pop
;
 
: DoShowConfigSyntax
  
  ">>  Syntax: %com #config <option>=<yes|no>"
  command @ "%com" subst Tell
  ">>  'hidden', and 'unused'."
  ">>  Valid values for <option> are 'floating', 'traps', 'orphans',"
  Tell Tell
;
 
: DoConfigure  
  
  ourArg @ if
    ourArg @ "=" instr if
      ourArg @ dup "=" instr strcut strip
      swap dup strlen 1 - strcut pop strip
      dup "{floating|traps|orphans|hidden|unused}" smatch not if
        ">>  Invalid option value." Tell
        DoShowConfigSyntax exit
      then
      over "{yes|ye|y|no|n}" smatch not if
        ">>  Option values must be set to 'yes' or 'no'." Tell exit
      then
      dup "floating" smatch if
        pop prog "_config/nonoents" 
        rot "{yes|ye|y}" smatch if
          remove_prop
          ">>  Set. Floating rooms will be included in reports."
        else
          "yes" setprop
          ">>  Set. Floating rooms will not be included in reports."
        then
        Tell exit
      then
      dup "traps" smatch if
        pop prog "_config/nonoexits" 
        rot "{yes|ye|y}" smatch if
          remove_prop
          ">>  Set. Trap rooms will be included in reports." 
        else
          "yes" setprop
          ">>  Set. Trap rooms will not be included in reports."
        then
        Tell exit
      then
      dup "orphans" smatch if
        pop prog "_config/noorphans" 
        rot "{yes|ye|y}" smatch if
          remove_prop
          ">>  Set. Orphan rooms will be included in reports." 
        else
          "yes" setprop
          ">>  Set. Orphan rooms will not be included in reports."
        then
        Tell exit
      then
      dup "hidden" smatch if
        pop prog "_config/nohidden" 
        rot "{yes|ye|y}" smatch if
          remove_prop
          ">>  Set. Hidden environment rooms will be included in reports." 
        else
          "yes" setprop
          ">>  Set. Hidden environment rooms will not be included in reports."
        then
        Tell exit
      then
      dup "unused" smatch if
        pop prog "_config/noold" 
        rot "{yes|ye|y}" smatch if
          remove_prop
          ">>  Set. Old and unused rooms will be included in reports." 
        else
          "yes" setprop
          ">>  Set. Old and unused rooms will not be included in reports."
        then
        Tell exit
      then
    else
      DoShowConfigSyntax
    then
  else
    DoShowConfigSyntax
  then
;
  
: DoShowSetSyntax
  
  ">>  Syntax: %com #set <room>=<floating|!floating|top|!top>"
  command @ "%com" subst Tell
;
 
: DoSet
  
  ourArg @ if
    ourArg @ "=" instr if
      ourArg @ dup "=" instr strcut strip
      swap dup strlen 1 - strcut pop strip
      match dup if
        dup room? not if
          ">>  Room not found." Tell pop pop exit
        then
      else
        ">>  Room not found." Tell pop pop exit
      then
      swap
      "floating" over  stringpfx if
        ">>  Set. %name is marked as a floating room."
        over unparseobj "%name" subst Tell
        pop "_floating?" "yes" setprop
      else
      "!floating" over stringpfx if
        ">>  Set. %name is not marked as a floating room."
        over unparseobj "%name" subst Tell
        pop "_floating?" remove_prop
      else
      "top" over  stringpfx if
        ">>  Set. %name is marked as a top-level environment room."
        over unparseobj "%name" subst Tell
        pop "_envtop?" "yes" setprop
      else
      "!top" over stringpfx if
        ">>  Set. %name is marked as not a top-level environment room."
        over unparseobj "%name" subst Tell
        pop "_envtop?" remove_prop
      else
        ">>  Invalid entry." Tell
        ">>  Valid room settings are 'floating', '!floating', 'top' and "
        "'!top'" strcat Tell pop pop exit
      then then then then
    else
      DoShowSetSyntax
    then
  else
    DoShowSetSyntax
  then
;
 
: main
  
  "me" match me !
  me @ "W" flag? if
    dup if
      dup "#*" smatch if
        dup " " instr if
          dup " " instr strcut
          strip ourArg !
          strip ourOpt !
        else
          strip ourOpt !
        then
        "#help"      ourOpt @ stringpfx if DoHelp            else
        "#scan"      ourOpt @ stringpfx if DoScan            else
        "#configure" ourOpt @ stringpfx if DoConfigure       else
        "#set"       ourOpt @ stringpfx if DoSet             else
        "#floating"  ourOpt @ stringpfx if DoShowFloating    else
        "#traps"     ourOpt @ stringpfx if DoShowTraps       else
        "#orphans"   ourOpt @ stringpfx if DoShowOrphans     else
        "#unused"    ourOpt @ stringpfx if DoShowUnused      else
        "#old"       ourOpt @ stringpfx if DoShowUnused      else
        "#hidden"    ourOpt @ stringpfx if DoShowHidden      else
        then then then then then then then then then then
      else
        ">>  #Option not found." Tell
      then
    else
      DoReport
    then
  else
    "Permission denied." Tell
  then
;
.
c
q