@edit library_reader.muf
1 99999 d
1 i
( library_reader.muf 04/16/01 by BoingDragon
Log Library Reader
This action should be set up in a room that is not part of a cambot
or fst3k environment, as the commands may conflict. Link a 'reader'
action to the program and type 'reader' to initialize the action and
display the instructions.
Since multiple people can use the action to access different logs and
libraries at once, all status properties are stored on the user in a
'reader' propdir.
To set a default library to use, set a 'default' property on the action
to the db number {without the # sign} of the library.
Library permissions and ownerships work the same as with cambot.muf
)
$def ACTION_NAME "reader;logs;setlog;library;printlog;viewlog;viewlast;clearlog;copyto"
$include $lib/case
$include $lib/cp-mv2
$include $lib/sort
lvar loglib
lvar copylib
lvar logname
lvar inarg
lvar startline
lvar stopline
lvar shownumbers
lvar logowner
lvar age
lvar authlist
lvar count
lvar index
(Begin Greywolf function block)
: tell ( s -- : return message to user )
me @ swap notify
;
()
: even? ( i -- 0|1 : return 1 if even, 0 if odd )
2 % not
;
()
: extract-char ( s1 i -- s2 : return the ith character of s1 )
dup 1 = if ( handle i = 1 as special case to avoid error below )
strcut pop exit
then
over over strcut pop ( remove all characters after i )
rot pop swap ( remove input string )
(stack: s2 i )
1 - strcut swap pop ( remove all characters before i )
;
()
: split-remove ( s1 i -- s2 s3 : return strings on both sides of i )
dup 1 = if ( handle i = 1 as special case to avoid error )
strcut swap pop "" swap exit
then
over over strcut
(stack: s1 i s s3 )
swap pop ( split off characters after i )
(stack: s1 i s3 )
rot rot 1 - strcut pop ( split off characters before i )
(stack: s3 s2 )
swap
;
()
: numeric? ( s1 -- 0|1 : returns 1 if numeric, 0 if not )
dup "0" strcmp not if
pop 1 exit
then
atoi 0 > if
1
else
0
then
;
()
: last-char ( s1 -- s2 : returns last character of s1 )
dup strlen dup 2 < if
pop exit
then
1 - strcut swap pop
;
()
: html-convert ( s1 s2 s3 -- s4 : convert key codes to html)
(s1 = input string ; s4 = output string )
(s2 = key code -- example '*' )
(s3 = html code -- example 'b' )
()
(note: if this function is unable to get a 'clean' convert, it will
return the line with no changes. The reasoning is that it is better
to leave things be than to convert wrongly.)
()
rot
(stack: * b s1 )
dup 4 pick instr not if ( if no "*" at all, leave line untouched )
swap pop swap pop exit (clean stack and quit)
then
(stack: * b s1 )
0 "" 3 pick ( stack: * b s1 counter rebuild workstring )
begin
dup 7 pick instr dup not if ( no more * to process )
pop strcat
swap even? if
swap pop ( remove input string )
break
else
(if odd occurrences of *, then something is wrong)
(abort and return original string)
pop
break
then
then
(stack: * b s1 counter rebuild workstring position )
split-remove
(stack: * b s1 counter rebuild part1 workstring )
rot rot strcat swap
(stack: * b s1 counter rebuild workstring )
()
over last-char
(stack: * b s1 counter rebuild workstring last-char )
dup "<" strcmp not ( is < last character? )
(stack: * b s1 counter rebuild workstring last-char i )
swap 8 pick strcmp not or if ( is * last character? )
(stack: * b s1 counter rebuild workstring )
swap 6 pick strcat swap ( if so, don't convert this time )
continue
then
()
(stack: * b s1 counter rebuild workstring )
dup 1 strcut pop 7 pick strcmp not if ( is * next character? )
swap 6 pick strcat swap ( if so, don't convert this time )
continue
then
()
(stack: * b s1 counter rebuild workstring )
dup 1 strcut pop numeric? if ( is next character numeric? )
over last-char numeric? if ( is previous character numeric? )
swap 6 pick strcat swap ( if so, don't convert this time )
continue
then
then
()
3 pick even? if
swap "<" 6 pick ">" strcat strcat strcat swap (stick tag after 'rebuild' portion )
else
swap "" 6 pick ">" strcat strcat strcat swap (end bold html indicator )
then
rot 1 + rot rot ( increment counter, put back in stack )
repeat
;
()
: bold-convert ( s1 -- s2 : convert *bold* to bold )
"*" "b" html-convert
;
()
: italics-convert ( s1 -- s2 : convert /italics/ to italics )
"/" "i" html-convert
;
()
: underline-convert ( s1 -- s2 : convert _underline_ to underline )
"_" "u" html-convert
;
(End Greywolf function block)
: get-logname
ME @ "reader/logname" getpropstr logname ! ( get the name of the current log )
;
: log-prop
"logs/" logname @ strcat
;
: log-propdir
log-prop "/" strcat
;
: get-line
loglib @ log-prop getpropval
;
: auth-user?
loglib @ log-propdir "owner" strcat getpropval dbref logowner !
logowner @ ME @ dbcmp loglib @ owner ME @ dbcmp or ME @ "W" flag? or if
1
else
0 index !
loglib @ "_auth_users" getpropstr authlist !
authlist @ strlen if
authlist @ " " explode count !
begin
count @ 0 > while
atoi dbref ME @ dbcmp if 1 index ! then
count @ 1 - count !
repeat
then
index @
then
;
: auth-copy?
copylib @ owner ME @ dbcmp ME @ "W" flag? or if
1
else
0 index !
copylib @ "_auth_users" getpropstr authlist !
authlist @ strlen if
authlist @ " " explode count !
begin
count @ 0 > while
atoi dbref ME @ dbcmp if 1 index ! then
count @ 1 - count !
repeat
then
index @
then
;
: logs
0 count !
">> Available logs: + = campaign, - = archived, * = recording" tell
inarg @ strlen 0 > if
loglib @ "logs/" inarg @ strcat "/" strcat nextprop logname !
else
loglib @ "logs/" nextprop logname !
then
begin
logname @ strlen 0 > while
loglib @ logname @ getpropval 0 > if
systime loglib @ logname @ "/time" strcat getpropval - age !
1000000 age @ age @ 86400 % - 86400 / + intostr "|" strcat
loglib @ logname @ "/status" strcat getpropstr "recording" strcmp if
"- \"" strcat
else
"* \"" strcat
then
logname @ 5 strcut swap pop strcat
"\"" strcat
dup strlen 48 > if
" (" strcat
else
" " strcat
48 strcut pop "(" strcat
then
age @ age @ 86400 % - 86400 / intostr strcat " days/" strcat
loglib @ logname @ getpropval intostr strcat " lines)" strcat
count @ 1 + count !
else
"+ " logname @ 5 strcut swap pop strcat " (" strcat
loglib @ logname @ getprop strcat ")" strcat tell
then
loglib @ logname @ nextprop logname !
repeat
count @ 0 = if
" None" tell
else
inarg @ strlen 0 > if
">> Displaying/sorting " count @ intostr strcat " logs for \"" strcat
loglib @ "logs/" inarg @ strcat getprop strcat "\":" strcat tell
else
">> Displaying/sorting " count @ intostr strcat " logs:" strcat tell
then
count @ sort
begin
count @ 0 > while
8 strcut swap pop tell
count @ 1 - count !
repeat
then
">> Done." tell
;
: setlog
inarg @ strlen not if
">> You must specify a log name. Type 'logs' to list existing logs." tell
exit
then
loglib @ "logs/" inarg @ strcat getprop if
ME @ "reader/logname" inarg @ setprop
">> Current log set to '" inarg @ strcat "' <<" strcat tell
else
">> Log '" inarg @ strcat "' not found. Type 'logs' to list existing logs. <<" strcat tell
then
;
: viewrange
get-line not if
">> There are no recorded lines in this log." tell
exit
then
begin
startline @ stopline @ <= while
loglib @ log-propdir startline @ intostr strcat getpropstr inarg !
inarg @ "||" instring if inarg @ "||" explode pop pop inarg ! then
inarg @ strlen if
shownumbers @ if
" " 4 startline @ intostr strlen - strcut pop
startline @ intostr strcat ": " strcat inarg @ strcat tell
else
inarg @
"
" "
" subst
"I>" "i>" subst
"B>" "b>" subst
"U>" "u>" subst
"" "" subst
" ]" "
" subst
inarg !
inarg @ "