@q
@program asys-approved
1 99999 d
i
( asys-approved    v1.2    Jessy@FurryMUCK    6/97, 11/99
   
   
  INSTALLATION:
  
  asys-approved uses the standard Argo installation method. Port the 
  program and set it Wizard. Type '+install asys-approved'
  
  USAGE:
    
  
  asys-approved may be freely ported. Please comment any changes.
)
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
$def thisVersion "1.2"
  
$define Tell me @ owner swap notify $enddef
 
$include $lib/argo
  
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 ourBoolean                         (* int: misc flow control var *)
 
: 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-approved" setprop
  RecOldActions
  
                    (* create and register command; set default props *)
  #0 "+approved" newexit dup scratch ! 
  prog setlink
  prog "@a/version" thisVersion setprop
  scratch @ "@a/version" thisVersion setprop
  #0 "@a/comm_list/+approved" scratch @ setprop
  #0 "@a/prog_list/" prog name strcat prog setprop
  scratch @ "@a/name" "+approved" setprop
  
  #0 "+unapproved" newexit dup scratch ! 
  prog setlink
  prog "@a/version" thisVersion setprop
  scratch @ "@a/version" thisVersion setprop
  #0 "@a/comm_list/+unapproved" scratch @ setprop
  #0 "@a/prog_list/" prog name strcat prog setprop
  scratch @ "@a/name" "+unapproved" 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/+approved"   RemoveCommand
  "@a/comm_list/+unapproved" RemoveCommand
  #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop
  RecOldActions
  
  ">>  Uninstalled. Please edit the online manual as appropriate."
  Tell
;
  
: DoHelp  (  --  )                             (* display help screen *)
  
  " " Tell
  prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell
  
  "This staff utility lists all approved and unapproved players."
  Tell " " Tell 
  
  "  $com .........................................................."
  #0 "@a/comm_list/+approved" getprop name
  dup ";" instr if
    dup ";" instr 1 - strcut pop
  then
  "$com" subst 32 strcut pop
  " List all approved players." strcat Tell
  
  "  $com .........................................................."
  #0 "@a/comm_list/+unapproved" getprop name
  dup ";" instr if
    dup ";" instr 1 - strcut pop
  then
  "$com" subst 32 strcut pop
  " List all unapproved players." strcat Tell
  " " Tell
  
  "Note: players who have never used Argo are not included in "
  "either count." strcat Tell
;
 
: DoApproved  (  --  )                   (* list all approved players *)
  
  "@a/tmp/$pid/" pid intostr "$pid" subst scratch !
  StaffCheck if
    ">>  Scanning database for approved players..." Tell
    background #0
    begin
      dup dbtop dbcmp not while
      dup player? if
        dup "@a/version" getprop if
          dup "@a/status" getpropstr "approved" smatch if
            ourDataObj @ scratch @ 
            3 pick name strcat
            3 pick name setprop
          then
        then
      then
      1 +
    repeat
    pop
    ourDataObj @ scratch @ nextprop if
      scratch @ 3-coln-prop
    else
      " " Tell
      "    <none>" Tell
    then
  else
    ">>  Permission denied." Tell
  then
  ourDataObj @ scratch @ RemoveDir
;
 
: DoUnapproved  (  --  )               (* list all unapproved players *)
  
  "@a/tmp/$pid/" pid intostr "$pid" subst scratch !
  StaffCheck if
    ">>  Scanning database for unapproved players..." Tell
    background #0
    begin
      dup dbtop dbcmp not while
      dup player? if
        dup "@a/version" getprop if
          dup "@a/status" getpropstr "na" smatch if
            ourDataObj @ scratch @ 
            3 pick name strcat
            3 pick name setprop
          then
        then
      then
      1 +
    repeat
    pop
    " " Tell
    ourDataObj @ scratch @ nextprop if
      scratch @ 3-coln-prop
    else
      "    <none>" Tell
    then
  else
    ">>  Permission denied." Tell
  then
  ourDataObj @ scratch @ RemoveDir
;
 
: 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
      "#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
      ">>  #Argument not understood." Tell
      then then then then then then
      exit
    then
  then
  
  me @ ArgoPermCheck
  
  Disabled?
  
  ourCom @ "+approved" smatch if
    DoApproved
  else
    DoUnapproved
  then
;
.
c
q
@set asys-approved=W