@program #151
1 1000 d
i
(*
   Web-Userlist v1.6
   Author: Chris Brine [Moose/Van]
   v1.6: [By Akari]
    - Reformatted to be 80 column friendly for Web PubProgs listing and removed
      Hellmouth dependency code.
   hm:
    - Modified for features for Hellmouth
   v1.5: [By Moose]
    - Modified to show if player is online or not.
    - Changed so that it does not have to be set as /_/www/userlist anymore
   For ProtoMUCK servers only.
*)

$author Moose
$version 1.6

$include $lib/standard
$include $lib/cgiparse
$include $web/login
INCLUDE_WEBVARS

: dotell ( s -- )
   descr swap notify_descriptor
;

: HTMLunparse ( s -- s )
   "&" "&" subst
   """ "&" subst
   ">" ">" subst
   "&lt;" "<" subst
;

: getname ( d -- s )
var! target
var url
target @ "_/www#" getprop target @ "_/www" getprop or if
 { "<a href='/~" target @ name tolower "/'>" target @ name "</a>" }cat
else
 target @ "_info/url" getpropstr dup url ! if
  url @ "http://*" smatch not if "http://" url @ strcat url ! then
  { "<a href='" url @ "'>" target @ name "</a>" }cat
 else
  target @ name
 then
then
;

: do-counter ( -- )
   prog "count" getpropval 1 +
   prog "count" 3 pick setprop
   "<CENTER><H5>This page has been visited %d times.</H5></CENTER>"
   swap intostr "%d" subst dotell
;

: array_get_propvals[ ref:ref str:STRpropdir -- dict:DICTprops ]
   { }dict STRpropdir @
   BEGIN
      ref @ swap NEXTPROP dup WHILE
      dup STRpropdir @ strlen strcut swap pop ref @ 3 pick getprop 4 rotate rot
      array_setitem swap
   REPEAT
   pop
;

: GRAB_USERS ( -- dict:DICTusers )
   #-1 #-1 "" "P!G" FIND_ARRAY SORTTYPE_NOCASE_ASCEND \array_sort
;

: main ( s -- )
PARSE_HEADERS
{ "$var/www" match "_/www/header" mpilist }w
var target
   "|" explode pop atoi pop pop pop
   7 strcut swap pop strip var! searchstr
   "<B><H1>ProtoMUCK.org - User Directory</H1></B>" dotell
   "<B>For a smaller list, enter a search string below "
   "(or nothing for all users):</B>" strcat dotell
   "<FORM method=get action=\"\"><INPUT type=\"TEXT\" name=\"search\""
   " value=\"%1\" maxlength=25 size=25>" strcat searchstr @ "%1" subst dotell
   "<INPUT type=\"SUBMIT\" value=\"Search\"></FORM>" dotell
   "<center><table border=2 width=70%><tr><th><font color=green><B>[O]"
   "</B></font></th><th><B>User</B></th><th><B>Tagline</B></th></tr>"
   strcat dotell
   searchstr @ strip dup not if "*" searchstr ! then
   searchstr @ dup "*" instr not if "*" swap over strcat strcat then searchstr !
   GRAB_USERS
   FOREACH swap pop target ! 
   {
      
      target @ name searchstr @ smatch not if continue then
      target @ "G" flag? if continue then
      target @ "player_prototype" sysparm stod dbcmp if continue then
      target @ "www_surfer" sysparm stod dbcmp if continue then
      target @ "@Ignore?" getpropstr "y" stringpfx if pop continue then
      "$Cmd/UserList" match dup dbref? if
         "@IgnoreList" target @ reflist_find if continue then
      then
      #0 "@IgnoreList" target @ reflist_find IF continue THEN
      "<tr><td align=center><TT>"
      "<a href='javascript:void(null);' onClick=\"document.open('/details?" target @ name tolower "','detailWin','width=600,height=400,screenX=50,screenY=50,scrollbars');\">Info</a>"
      "</TT></td><td><B>"
      target @ getname
      "</B></td><td width=\"75%\"><I>"
      target @ "_info/tagline" getpropstr
      dup not if pop "<None Set>" then 
      HTMLunparse 
      "</I></td></tr>"
      }cat dotell
   REPEAT
   "</table></center>" dotell
   ( 10 sleep descr descrboot 1 sleep )
{ "$var/www" match "_/www/footer" mpilist }w
;
.
c
q