@prog player-report.muf
1 999 d
1 i
: say me @ swap notify ;
: remove-foo.muf-props
	"[clearing props]" say
	begin
		0 me @ propfirst begin
			not if 0 break then
			dup "@foo.muf " 9 strncmp not if
				dup 4 rotate 1 + 4 2 roll
				3 pick 200 > if pop pop 1 break then
			then
			pop propnext
		loop
		dup if "[chunk]" say then
		over 2 + -1 * rotate
		begin dup 0 > while me @ rot remove_prop 1 - loop
		pop
	while loop
	"[props cleared]" say
;
: scan-db
	"[scanning db]" say
	0 db_top 1 - 1 for
		dup 1000 % not if
			"[" over intostr "]" strcat strcat say
		then
		dbref
		dup ok? not if pop continue then
		dup player? if
			int intostr "<" swap ">" strcat strcat
			me @ "@foo.muf players" getpropstr strcat
			me @ "@foo.muf players" rot addprop
		else
			     dup thing?    if "t"
			else dup room?    eif "r"
			else dup exit?    eif "x"
			else dup program? eif "p"
			else                  ""
			then
			dup if
				"@foo.muf " rot owner int intostr strcat
				" " strcat swap strcat
				me @ over getpropstr atoi 1 + intostr
				me @ rot rot addprop
			then
		then
	loop
	"[db scan done]" say
;
: get-count (infix-str x x x tag -- infix-str x x x n)
	"@foo.muf " 6 pick strcat " " strcat swap strcat
	me @ swap over over getpropstr rot rot remove_prop atoi
;
: add-to-total (tot x n -- tot x n)
	rot over + rot rot
;
: append-report-count (so-far n -- so-far)
	dup if intostr else pop "" then
	begin dup strlen 6 < while " " swap strcat loop
	strcat
;
: monthvec "JanFebMarAprMayJunJulAugSepOctNovDec" ;
: fancy-ctime
	ctime 4 strcut 3 strcut monthvec rot instr 3 /
	dup 1 + intostr dup strlen 2 < if "0" swap strcat then "-" strcat swap
	3 * monthvec swap strcut 3 strcut pop swap pop strcat
	swap strcat strcat
;
: produce-report-for-player
	dup atoi dbref dup name "                " strcat 16 strcut pop 0 swap
	"r" get-count add-to-total append-report-count
	"x" get-count add-to-total append-report-count
	"t" get-count add-to-total append-report-count
	"p" get-count add-to-total append-report-count
	swap append-report-count
	over time_used fancy-ctime "  " swap strcat strcat
	say pop pop
;
: produce-report
	"Player        #: rooms exits thngs progs total  Last used" say
	me @ "@foo.muf players" getpropstr
	me @ "@foo.muf players" remove_prop
	begin dup while
		dup ">" instr dup if strcut else pop "" then
		swap "" "<" subst "" ">" subst produce-report-for-player
	loop
;
: main
	dup "-clear" strcmp not if
		pop remove-foo.muf-props
	else dup not eif
		remove-foo.muf-props
		scan-db
		produce-report
		remove-foo.muf-props
		"Done." say
	else
		"?" strcat say
	then
;
.
c
q