@q
@program lib-quota
1 99999 d
i
( lib-quota v1.0 Jessy @ FurryMUCK 3/00
Lib-quota is the library for a set of soft-coded building commands:
cmd-@quota cmd-@action, cmd-@open, cmd-@create, cmd-@dig, and
cmd-@xdig. It is backwards compatible with the standard quota program
used on FurryMUCK and elsewhere, but is -- in my opinion at least --
easier to set up and administer and differs in design philosophy.
Instead of one large do-everything program, softcoded emulations of
the standard building commands are provided, each sharing code from
lib-quota and incorporating quota control. Although this approach
leads to some duplication of code and uses a few more dbrefs, I
believe that this separation pays off in ease-of-use and administrative
flexibility.
INSTALLATION:
Port lib-quota. Set it Link_OK and Wizard. Register it as $lib/quota.
Set the _def/ and _docs props, as follows:
@reg lib-quota=lib/quota
@set lib-quota=L
@set lib-quota=W
@set lib-quota=_defs/CheckCost:"$lib/quota" match "CheckCost" call
@set lib-quota=_defs/CheckName:"$lib/quota" match "CheckName" call
@set lib-quota=_defs/CheckQuota:"$lib/quota" match "CheckQuota" call
@set lib-quota=_defs/Exempt?:"$lib/quota" match "Exempt?" call
@set lib-quota=_defs/ExitsAllowed:"$lib/quota" match "ExitsAllowed" call
@set lib-quota=_defs/ExitsOwned:"$lib/quota" match "ExitsOwned" call
@set lib-quota=_defs/GetQuota:"$lib/quota" match "GetQuota" call
@set lib-quota=_defs/ProgramsOwned:"$lib/quota" match "ProgramsOwned" call
@set lib-quota=_defs/RegisterObject:"$lib/quota" match "RegisterObject" call
@set lib-quota=_defs/RoomsAllowed:"$lib/quota" match "RoomsAllowed" call
@set lib-quota=_defs/RoomsOwned:"$lib/quota" match "RoomsOwned" call
@set lib-quota=_defs/ThingsAllowed:"$lib/quota" match "ThingsAllowed" call
@set lib-quota=_defs/ThingsOwned:"$lib/quota" match "ThingsOwned" call
@set lib-quota=_docs:@list $lib/quota=1-90
Lib-quota requires lib-reflist, which should be installed on any
established MUCK.
Once lib-quota is installed, the emulated building commands --
cmd-@dig, cmd-@open, cmd-@action, and cmd-@create -- as well as the
non-standard cmd-@xdig and quota management program, cmd-@quota, may
be installed.
PUBLIC FUNCTIONS:
CheckCost [ d s -- i ] Returns true if d has enough pennies for object
of type s. Because @create allows custom costs, and because programs
have no cost, the only valid values for s are 'room' and 'exit'.
CheckName [ s -- i ] Returns true if s is a valid object name.
CheckQuota [ d s -- i ] Returns true if user d has additional quota
available for an object of type s, where is is 'rooms', 'exits',
'things', or 'programs'.
Exempt? [ d -- i ] Returns true if user d is exempt from quota checks,
either because she is a non-quelled Wizard, or has been added to
the exempt list via cmd-@quota.
ExitsAllowed [ d -- i ] Returns the number of exits d can make.
ExitsOwned [ d -- i ] Returns the number of exits owned by d.
GetQuota [ d s -- i ] Returns d's quota for objects of type s. If
quota for type s is unlimited, i will be -1.
ProgramsOwned [ d -- i ] Returns the number of programs owned by d.
RegisterObject [ d s -- ] Sets personal regname s for object d.
RoomsAllowed [ d -- i ] Returns the number of rooms d can make.
RoomsOwned [ d -- i ] Returns the number of rooms owned by d.
ThingsAllowed [ d -- i ] Returns the number of things d can make.
ThingsOwned [ d -- i ] Returns the number of things owned by d.
All public functions must be called from a program set M3 or W.
Although program-related functions such as ProgramsOwned are provided
here and in cmd-@quota, the programs in their current state do not
restrict the number of programs a user can own or create.
Lib-quota may be freely ported. Please comment any changes.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
$include $lib/reflist
: CheckMuckerPerm ( -- ) (* kill process if not called by M3 *)
caller mlevel 3 < if
pop me @ "Permission denied." notify pid kill
then
;
: Exempt? ( d -- i ) (* return true if d is exempt from quota checks *)
CheckMuckerPerm
dup "W" flag?
#0 "@quota/include_wizzes" getprop not and
#0 "@quota/exempt" 4 rotate REF-inlist? or
;
public Exempt?
: ExitsOwned ( d -- i ) (* return number of exits owned by d *)
CheckMuckerPerm
dup ok? not if pop 0 then
dup player? if
stats pop pop pop pop swap pop swap pop
else
pop 0
then
;
public ExitsOwned
: ProgramsOwned ( d -- i ) (* return number of rooms owned by d *)
CheckMuckerPerm
dup ok? not if pop 0 then
dup player? if
stats pop pop swap pop swap pop swap pop swap pop
else
pop 0
then
;
public ProgramsOwned
: RoomsOwned ( d -- i ) (* return number of rooms owned by d *)
CheckMuckerPerm
dup ok? not if pop 0 then
dup player? if
stats pop pop pop pop pop swap pop
else
pop 0
then
;
public RoomsOwned
: ThingsOwned ( d -- i ) (* return number of rooms owned by d *)
CheckMuckerPerm
dup ok? not if pop 0 then
dup player? if
stats pop pop pop swap pop swap pop swap pop
else
pop 0
then
;
public ThingsOwned
: GetQuota ( d s -- i ) (* return d's quota for type s *)
(* return -1 if quota for type is unlimited *)
CheckMuckerPerm
over "@quota/" 3 pick strcat getpropstr dup if
swap pop
else
pop
#0 "@quota/" 3 pick strcat getpropstr
then
dup if
swap pop atoi
else
pop pop -1
then
;
public GetQuota
: ExitsAllowed ( d -- i ) (* return number of exits d may make *)
dup "exits" GetQuota swap ExitsOwned -
dup 0 < if pop 0 then
;
public ExitsAllowed
: RoomsAllowed ( d -- i ) (* return number of rooms d may make *)
dup "rooms" GetQuota swap RoomsOwned -
dup 0 < if pop 0 then
;
public RoomsAllowed
: ThingsAllowed ( d -- i ) (* return number of things d may make *)
dup "things" GetQuota swap ThingsOwned -
dup 0 < if pop 0 then
;
public ThingsAllowed
: CheckQuota ( d s -- i )
(* return true if user has additional quota for type s available *)
over Exempt? if
pop pop 1 exit
then
dup "rooms" smatch if pop RoomsAllowed else
dup "exits" smatch if pop ExitsAllowed else
pop ThingsAllowed
then then
dup 0 <= if
dup 0 = not if
pop -1
then
else
pop 1
then
;
public CheckQuota
: CheckCost ( d s -- i )
(* return true if d has enough pennies for object of type s *)
over Exempt? if pop pop 1 exit then
"exits" over smatch if
pop pennies 1 < if
0
else
1
then exit
else
"rooms" over smatch if
pop pennies 10 < if
0
else
1
then exit
then then
pop pop 1
;
public CheckCost
: CheckName ( s -- i ) (* return true if s is a valid object name *)
dup "#" stringpfx if pop 0 exit then
dup "=" instr if pop 0 exit then
dup "&" instr if pop 0 exit then
dup "here" smatch if pop 0 exit then
dup "me" smatch if pop 0 exit then
dup "home" smatch if pop 0 exit then
pop 1
;
public CheckName
: RegisterObject ( d s -- ) (* set personal regname for d *)
me @ "_reg/" 3 pick strcat getprop dup if
"Used to be registered as $prop: $object"
swap unparseobj "$object" subst
over "$prop" subst me @ swap notify
else
pop
then
me @ "_reg/" 3 pick strcat 4 pick setprop
"Now registered as $prop: $object"
swap "$prop" subst
swap unparseobj "$object" subst me @ swap notify
;
public RegisterObject
.
c
q
@reg lib-quota=lib/quota
@set lib-quota=L
@set lib-quota=W
@set lib-quota=_defs/CheckCost:"$lib/quota" match "CheckCost" call
@set lib-quota=_defs/CheckName:"$lib/quota" match "CheckName" call
@set lib-quota=_defs/CheckQuota:"$lib/quota" match "CheckQuota" call
@set lib-quota=_defs/Exempt?:"$lib/quota" match "Exempt?" call
@set lib-quota=_defs/ExitsAllowed:"$lib/quota" match "ExitsAllowed" call
@set lib-quota=_defs/ExitsOwned:"$lib/quota" match "ExitsOwned" call
@set lib-quota=_defs/GetQuota:"$lib/quota" match "GetQuota" call
@set lib-quota=_defs/ProgramsOwned:"$lib/quota" match "ProgramsOwned" call
@set lib-quota=_defs/RegisterObject:"$lib/quota" match "RegisterObject" call
@set lib-quota=_defs/RoomsAllowed:"$lib/quota" match "RoomsAllowed" call
@set lib-quota=_defs/RoomsOwned:"$lib/quota" match "RoomsOwned" call
@set lib-quota=_defs/ThingsAllowed:"$lib/quota" match "ThingsAllowed" call
@set lib-quota=_defs/ThingsOwned:"$lib/quota" match "ThingsOwned" call
@set lib-quota=_docs:@list $lib/quota=1-90