Lock (frob class)

    This is a frob class for locks.

    Constructor methods:

        true_lock()                     A lock which always succeeds
        false_lock()                    A lock which always fails
        object_lock(obj)                A lock which matches against obj
        and_lock(left, right)           Boolean and of two locks
        or_lock(left, right)            Boolean or of two locks
        not_lock(lock)                  Boolean not of a lock

        parse(s, env)                   Parse a lock from a string s

    Frob methods:

        try(obj)                        Check lock against obj

parent frob_class
object true_lock_class

.eval
    .initialize();
    .set_name("True lock class");
.

method new
    return <this(), []>;
.

method try
    arg lock, obj;

    return 1;
.

parent frob_class
object false_lock_class

.eval
    .initialize();
    .set_name("False lock class");
.

method new
    return <this(), []>;
.

method try
    arg lock, obj;

    return 0;
.

parent frob_class
object object_lock_class

.eval
    .initialize();
    .set_name("Object lock class");
.

method new
    arg obj;

    if (type(obj) != 'dbref)
        throw(~perm, "Argument is not a dbref.");
    return <this(), [obj]>;
.

method try
    arg lock, obj;

    return lock[1] == obj;
.

parent frob_class
object and_lock_class

.eval
    .initialize();
    .set_name("And lock class");
.

method new
    arg lhs, rhs;

    if (type(lhs) != 'frob || type(rhs) != 'frob)
        throw(~perm, "Arguments are not both frobs.");
    return <this(), [lhs, rhs]>;
.

method try
    arg lock, obj;

    return lock[1].try(obj) && lock[2].try(obj);
.

parent frob_class
object or_lock_class

.eval
    .initialize();
    .set_name("Or lock class");
.

method new
    arg lhs, rhs;

    if (type(lhs) != 'frob || type(rhs) != 'frob)
        throw(~perm, "Arguments are not both frobs.");
    return <this(), [lhs, rhs]>;
.

method try
    arg lock, obj;

    return lock[1].try(obj) || lock[2].try(obj);
.

parent frob_class
object not_lock_class

.eval
    .initialize();
    .set_name("Not lock class");
.

method new
    arg lock;

    if (type(lock) != 'frob)
        throw(~perm, "Argument is not a lock.");
    return <this(), [lock]>;
.

method try
    arg lock;

    return !lock[1].try(obj);
.

parent root
object lock_parser

eval
    .initialize();
    .set_name("Lock parser");
.

method parse
    arg s, env;
    var stack, lock, n, m, obj, len;

    stack = [];
    while (1) {
        // Look for valid prefixes.
        while (1) {
            while (s && s[1] == " ")
                s = substr(s, 2);
            if (!s)
                throw(~parse, "String ends unexpectedly.");
            if (s[1] == "(") {
                stack = stack + ['open];
                s = substr(s, 2);
            } else if (s[1] == "!") {
                stack = stack + ['not];
                s = substr(s, 2);
            } else {
                break;
            }
        }

        // Look for an object name.
        for n in [1..strlen(s)] {
            if (s[n] in ")&|") {
                n = n - 1;
                break;
            }
        }
        m = n;
        while (m && s[m] == " ")
            m = m - 1;
        if (!m)
            throw(~parse, "Null object name.");

        obj = (> env.match_environment(substr(s, 1, m)) <);
        lock = $object_lock_class.new(obj);
        stack = stack + [lock];
        s = substr(s, n + 1);

        // Loop until no more reduction to be done.
        while (1) {
            // Process negations, ands, ors.
            while (1) {
                len = listlen(stack);
                if (len < 2)
                    break;
                if (stack[len - 1] == 'not) {
                    lock = $not_lock_class.new(stack[len]);
                    stack = sublist(stack, 1, len - 2) + [lock];
                } else if (stack[len - 1] == 'and) {
                    lock = $and_lock_class.new(stack[len - 2], stack[len]);
                    stack = sublist(stack, 1, len - 3) + [lock];
                } else if (stack[len - 1] == 'or) {
                    lock = $or_lock_class.new(stack[len - 2], stack[len]);
                    stack = sublist(stack, 1, len - 3) + [lock];
                } else {
                    break;
                }
            }

            // Close parens, if necessary; otherwise stop.
            if (!s || s[1] != ")")
                break;
            while (s && s[1] == ")") {
                len = listlen(stack);
                if (len < 2 || stack[len - 1] != 'open)
                    throw(~parse, "Misplaced right parenthesis.");
                stack = sublist(stack, 1, len - 2) + [stack[len]];
                s = substr(s, 2);
                while (s && s[1] == " ")
                    s = substr(s, 2);
            }
        }

        // Are we done?
        if (!s) {
            if (listlen(stack) > 1)
                throw(~parse, "Unmatched left parentheses.");
            return stack[1];
        }

        // No, we're at a conjunction.
        if (s[1] == "&") {
            stack = stack + ['and];
            s = substr(s, 2);
        } else if (s[1] == "|") {
            stack = stack + ['or];
            s = substr(s, 2);
        } else {
            throw(~parse, "Illegal character following right parenthesis.");
        }
    }
.