Generic Large-Capacity Mail Recipient (#16)

(an instance of Generic Mail Recipient made by Hacker)

     Generic Large Capacity Mail Recipient
     -------------------------------------
     Since any modifications to large lists entail copying the entire list
     over, operations on ordinary mail recipients having large numbers of
     messages, that actually change the content of .messages will take
     inordinately long. Thus we have this version which makes use of the
     $biglist package, scattering the messages onto numerous properties so
     that write operations involving only a few messages will not require
     recopying of the entire list.
     
     In nearly all respects it behaves as the ordinary Mail Recipient,
     except that it is faster for certain kinds of operations.
     
     Certain unimplemented verbs, like :date_sort(), and :messages()
     currently return E_VERBNF.
     
     To convert an existing $mail_recipient-child (call it #MR) into a
     $big_mail_recipient-child the basic procedure is
     
      ;;something.foo= #MR:messages();
      @rmm 1-$ from #MR
      @unrmm expunge
      @chparent #MR to $big_mail_recipient
      ;#MR:receive_batch(@something.foo);



VERB SOURCE CODE:

_genprop:
gp = this._genprop;
ngp = "";
for i in [1..length(gp)]
    if (gp[i] != "z")
        ngp = (ngp + "bcdefghijklmnopqrstuvwxyz"[index("abcdefghijklmnopqrstuvwxy", 
gp[i])]) + gp[i + 1..length(gp)];
        return " " + (this._genprop = ngp);
    endif
    ngp = ngp + "a";
endfor
return " " + (this._genprop = ngp + "a");
.


_make:
":_make(...) => new node with value {...}";
if (!(caller in {this._mgr, this}))
    return E_PERM;
endif
prop = this:_genprop();
add_property(this, prop, args, {this.mowner, ""});
return prop;
.


_kill:
":_kill(node) destroys the given node.";
if (!(caller in {this, this._mgr}))
    return E_PERM;
endif
delete_property(this, args[1]);
.


_get:
return (caller == this._mgr) ? this.(args[1]) | E_PERM;
.


_put:
return (caller == this._mgr) ? this.(args[1]) = listdelete(args, 1) | E_PERM;
.


_ord:
return args[1][2..3];
.


_makemsg:
":_makemsg(ord,msg) => leafnode for msg";
"msg = $mail_agent:__convert_new(@args[2])";
msg = args[2];
if (caller != this)
    return E_PERM;
elseif (h = "" in msg)
    return {this:_make(@msg[h + 1..length(msg)]), args[1], @msg[1..h - 1]};
else
    return {0, args[1], @msg};
endif
.


_killmsg:
if (caller != this._mgr)
    return E_PERM;
elseif (node = args[1][1])
    this:_kill(node);
endif
.


_message_num:
return args[2];
.


_message_date:
return args[3];
.


_message_hdr:
return args[3..length(args)];
.


_message_text:
return {@args[3..length(args)], @args[1] ? {"", @this.(args[1])} | {}};
.


_lt_msgnum:
return args[1] < args[2][1];
.


_lt_msgdate:
return args[1] < args[2][2];
.


receive_batch:
if (!this:is_writable_by(caller_perms()))
    return E_PERM;
else
    new = this:new_message_num();
    msgtree = this.messages;
    for m in (args)
        msgtree = this._mgr:insert_last(msgtree, this:_makemsg(new, m[2]));
        new = new + 1;
        if ($command_utils:running_out_of_time())
            this.messages = msgtree;
            player:tell("... ", new);
            suspend(0);
            msgtree = this.messages;
            new = this:new_message_num();
        endif
    endfor
    this.messages = msgtree;
    this.last_used_time = time();
    return 1;
endif
.


receive_message:
if (!this:is_writable_by(caller_perms()))
    return E_PERM;
else
    this.messages = this._mgr:insert_last(this.messages, msg = this:_makemsg(new 
= this:new_message_num(), args[1]));
    this.last_msg_date = this:_message_date(@msg);
    this.last_used_time = time();
    return new;
endif
.


messages_in_seq:
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (typeof(seq = args[1]) != LIST)
    x = this._mgr:find_nth(this.messages, seq);
    return {this:_message_num(@x), this:_message_text(@x)};
else
    msgs = {};
    while (seq)
        handle = this._mgr:start(this.messages, seq[1], seq[2] - 1);
        while (handle)
            for x in (handle[1])
                msgs = {@msgs, {this:_message_num(@x), this:_message_text(@x)}};
            endfor
            handle = this._mgr:next(@listdelete(handle, 1));
            $command_utils:suspend_if_needed(0);
        endwhile
        seq = seq[3..length(seq)];
    endwhile
    return msgs;
endif
.


display_seq_headers:
":display_seq_headers(msg_seq[,cur[,last_read_date]])";
"This is the default header display routine.";
"Prints a list of headers of messages on this to player.  msg_seq is the handle returned 
by this:parse_message_seq(...).  cur is the player's current message.  last_read_date 
is the date of the last of the already-read messages.";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
endif
getmsg = this.summary_uses_body ? "_message_text" | "_message_hdr";
seq = args[1];
cur = {@args, 0}[2];
last_old = {@args, $maxint, $maxint}[3];
keep_seq = {@$seq_utils:contract(this:kept_msg_seq(), $seq_utils:complement(seq, 
1, this:length_all_msgs())), $maxint};
k = 1;
mcount = 0;
width = player:linelen();
while (seq)
    handle = this._mgr:start(this.messages, seq[1], seq[2] - 1);
    while (handle)
        for x in (handle[1])
            $command_utils:suspend_if_needed(0);
            if (keep_seq[k] <= (mcount = mcount + 1))
                k = k + 1;
            endif
            annot = (x[3] > last_old) ? "+" | ((k % 2) ? " " | "=");
            line = tostr($string_utils:right(x[2], 5, (cur == x[2]) ? ">" | " "), 
":", annot, " ", this:msg_summary_line(@this:(getmsg)(@x)));
            player:tell(line[1..min(width, length(line))]);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
    seq = seq[3..length(seq)];
endwhile
player:tell("-----+");
.


display_seq_full:
":display_seq_full(msg_seq[,preamble]) => {cur}";
"This is the default message display routine.";
"Prints the indicated messages on folder to player.  msg_seq is the handle returned 
by folder:parse_message_seq(...).  Returns the number of the final message in the 
sequence (to be the new current message number).";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
endif
seq = args[1];
preamble = {@args, ""}[2];
cur = date = 0;
while (seq)
    handle = this._mgr:start(this.messages, seq[1], seq[2] - 1);
    while (handle)
        for x in (handle[1])
            cur = this:_message_num(@x);
            date = this:_message_date(@x);
            player:display_message(preamble ? strsub(preamble, "%d", tostr(cur)) 
| {}, player:msg_text(@this:_message_text(@x)));
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
        $command_utils:suspend_if_needed(0);
    endwhile
    seq = seq[3..length(seq)];
endwhile
return {cur, date};
.


list_rmm:
if (!this:ok(caller, caller_perms()))
    return E_PERM;
endif
len = 0;
getmsg = this.summary_uses_body ? "_message_text" | "_message_hdr";
going = this.messages_going;
if (going && ((!going[1]) || (typeof(going[1][2]) == NUM)))
    kept = {@going[1], $maxint};
    going = going[2];
else
    kept = {$maxint};
endif
k = 1;
mcount = 0;
for s in (going)
    if (kept[k] <= (mcount = mcount + s[1]))
        k = k + 1;
    endif
    len = len + s[2][2];
    handle = this._mgr:start(s[2], 1, s[2][2]);
    while (handle)
        for x in (handle[1])
            if (kept[k] <= (mcount = mcount + 1))
                k = k + 1;
            endif
            player:tell($string_utils:right(this:_message_num(@x), 4), (k % 2) ? 
":  " | ":= ", this:msg_summary_line(@this:(getmsg)(@x)));
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
if (len)
    player:tell("----+");
endif
return len;
.


undo_rmm:
if (!this:ok_write(caller, caller_perms()))
    return E_PERM;
endif
msgtree = this.messages;
seq = {};
last = 0;
"there are two possible formats here:";
"OLD: {{n,msgs},{n,msgs},...}";
"NEW: {kept_seq, {{n,msgs},{n,msgs},...}}";
going = this.messages_going;
if (going && ((!going[1]) || (typeof(going[1][2]) == NUM)))
    kept = going[1];
    going = going[2];
else
    kept = {};
endif
for s in (going)
    msgtree = this._mgr:insert_after(msgtree, s[2], last + s[1]);
    seq = {@seq, (last + s[1]) + 1, (last = (last + s[1]) + s[2][2]) + 1};
endfor
this.messages = msgtree;
this.messages_going = {};
this.messages_kept = $seq_utils:union(kept, $seq_utils:expand(this.messages_kept, 
seq));
this:_fix_last_msg_date();
return seq;
.


expunge_rmm:
if (!this:ok_write(caller, caller_perms()))
    return E_PERM;
endif
len = 0;
going = this.messages_going;
if (going && ((!going[1]) || (typeof(going[1][2]) == NUM)))
    going = going[2];
endif
for s in (going)
    len = len + s[2][2];
    this._mgr:kill(s[2], "_killmsg");
endfor
this.messages_going = {};
return len;
.


rm_message_seq:
seq = args[1];
if (!(this:ok_write(caller, caller_perms()) || (this:ok(caller, caller_perms()) && 
(seq = this:own_messages_filter(caller_perms(), @args)))))
    return E_PERM;
endif
msgtree = this.messages;
save = nums = {};
onext = 1;
rmmed = 0;
for i in [1..length(seq) / 2]
    if ($command_utils:suspend_if_needed(0))
        player:tell("... rmm ", onext);
        suspend(0);
    endif
    start = seq[(2 * i) - 1];
    next = seq[2 * i];
    x = this._mgr:extract_range(msgtree, start - rmmed, (next - 1) - rmmed);
    msgtree = x[1];
    zmsgs = x[2];
    save = {@save, {start - onext, zmsgs}};
    nums = {@nums, this:_message_num(@this._mgr:find_nth(zmsgs, 1)), this:_message_num(@this._mgr:find_nth(zmsgs, 
zmsgs[2])) + 1};
    onext = next;
    rmmed = (rmmed + next) - start;
endfor
tmg = this.messages_going;
save_kept = $seq_utils:intersection(this.messages_kept, seq);
this.messages_kept = $seq_utils:contract(this.messages_kept, seq);
this.messages_going = save_kept ? {save_kept, save} | save;
fork (0)
    for s in (tmg)
        this._mgr:kill(s[2], "_killmsg");
    endfor
endfork
this.messages = msgtree;
this:_fix_last_msg_date();
return $seq_utils:tostr(nums);
.


renumber:
":renumber([cur]) renumbers caller.messages, doing a suspend() if necessary.";
"  => {number of messages,new cur}.";
if (!this:ok_write(caller, caller_perms()))
    return E_PERM;
endif
cur = {@args, 0}[1];
this:expunge_rmm();
"... blow away @rmm'ed messages since there's no way to tell what their new numbers 
should be...";
if (!(msgtree = this.messages))
    return {0, 0};
endif
if (cur)
    cur = this._mgr:find_ord(msgtree, cur - 1, "_lt_msgnum") + 1;
endif
while (1)
    "...find first out-of-sequence message...";
    n = 1;
    subtree = msgtree;
    if (msgtree[3][1] == 1)
        while ((node = this.(subtree[1]))[1])
            "...subtree[3][1]==n...";
            kids = node[2];
            n = n + subtree[2];
            i = length(kids);
            while ((n = n - kids[i][2]) != kids[i][3][1])
                i = i - 1;
            endwhile
            subtree = kids[i];
        endwhile
        leaves = node[2];
        n = ((firstn = n) + length(leaves)) - 1;
        while (n != leaves[(n - firstn) + 1][2])
            n = n - 1;
        endwhile
        n = n + 1;
    endif
    "... n == first out-of-sequence ...";
    "...renumber as many messages as we have time for...";
    while ((n <= msgtree[2]) && (!$command_utils:running_out_of_time()))
        msg = this._mgr:find_nth(msgtree, n);
        msgtree = this._mgr:set_nth(msgtree, n, listset(msg, n, 2));
        n = n + 1;
    endwhile
    this.messages = msgtree;
    if (n > msgtree[2])
        return {n - 1, cur};
    endif
    player:tell("...(renumbering to ", n - 1, ")");
    suspend(0);
    "...start over... may have received new mail, rmm'ed stuff, etc...";
    "...so who knows what's there now?...";
    if (this.messages_going)
        player:tell("Renumber aborted.");
        return;
    endif
    msgtree = this.messages;
endwhile
.


length_all_msgs:
return this:ok(caller, caller_perms()) ? this.messages ? this.messages[2] | 0 | E_PERM;
.


length_num_le:
return this:ok(caller, caller_perms()) ? this._mgr:find_ord(this.messages, args[1], 
"_lt_msgnum") | E_PERM;
.


length_date_le:
return this:ok(caller, caller_perms()) ? this._mgr:find_ord(this.messages, args[1], 
"_lt_msgdate") | E_PERM;
.


exists_num_eq:
return this:ok(caller, caller_perms()) ? (i = this._mgr:find_ord(this.messages, args[1], 
"_lt_msgnum")) && ((this:_message_num(@this._mgr:find_nth(this.messages, i)) == args[1]) 
&& i) | E_PERM;
.


new_message_num:
new = (msgtree = this.messages) ? this:_message_num(@this._mgr:find_nth(msgtree, 
msgtree[2])) + 1 | 1;
if (rmsgs = this.messages_going)
    lbrm = rmsgs[length(rmsgs)][2];
    return max(new, this:_message_num(@this._mgr:find_nth(lbrm, lbrm[2])) + 1);
else
    return new;
endif
.


from_msg_seq:
":from_msg_seq(object or list)";
" => msg_seq of messages from any of these senders";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (!this.messages)
    return {};
endif
if (typeof(plist = args[1]) != LIST)
    plist = {plist};
endif
mask = {@args, {1, this.messages[2] + 1}}[2];
fseq = {};
for m in [1..length(mask) / 2]
    handle = this._mgr:start(this.messages, i = mask[(2 * m) - 1], mask[2 * m] - 
1);
    while (handle)
        for msg in (handle[1])
            fromline = msg[4];
            if (toobj(fromline[rindex(fromline, "(") + 1..rindex(fromline, ")") - 
1]) in plist)
                fseq = $seq_utils:add(fseq, i, i);
            endif
            i = i + 1;
            $command_utils:suspend_if_needed(0);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
return fseq || ("%f % no messages from " + $string_utils:english_list($list_utils:map_arg(2, 
$string_utils, "pronoun_sub", "%n (%#)", plist), "no one", " or "));
.


%from_msg_seq:
":%from_msg_seq(string or list of strings)";
" => msg_seq of messages with one of these strings in the from line";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (!this.messages)
    return {};
endif
if (typeof(nlist = args[1]) != LIST)
    nlist = {nlist};
endif
fseq = {};
mask = {@args, {1, this.messages[2] + 1}}[2];
for m in [1..length(mask) / 2]
    handle = this._mgr:start(this.messages, i = mask[(2 * m) - 1], mask[2 * m] - 
1);
    while (handle)
        for msg in (handle[1])
            fromline = " " + msg[4];
            for n in (nlist)
                if (index(fromline, n))
                    fseq = $seq_utils:add(fseq, i, i);
                endif
            endfor
            i = i + 1;
            $command_utils:suspend_if_needed(0);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
return fseq || ("%f % no messages from " + $string_utils:english_list($list_utils:map_arg($string_utils, 
"print", nlist), "no one", " or "));
.


to_msg_seq:
":to_msg_seq(object or list) => msg_seq of messages to those people";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (!this.messages)
    return {};
endif
if (typeof(plist = args[1]) != LIST)
    plist = {plist};
endif
seq = {};
mask = {@args, {1, this.messages[2] + 1}}[2];
for m in [1..length(mask) / 2]
    handle = this._mgr:start(this.messages, i = mask[(2 * m) - 1], mask[2 * m] - 
1);
    while (handle)
        for msg in (handle[1])
            toline = msg[5];
            for r in ($mail_agent:parse_address_field(toline))
                if (r in plist)
                    seq = $seq_utils:add(seq, i, i);
                endif
            endfor
            i = i + 1;
            $command_utils:suspend_if_needed(0);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
return seq || ("%f % no messages to " + $string_utils:english_list($list_utils:map_arg(2, 
$string_utils, "pronoun_sub", "%n (%#)", plist), "no one", " or "));
.


%to_msg_seq:
":%to_msg_seq(string or list of strings)";
" => msg_seq of messages containing one of strings in the to line";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (!this.messages)
    return {};
endif
if (typeof(nlist = args[1]) != LIST)
    nlist = {nlist};
endif
seq = {};
mask = {@args, {1, this.messages[2] + 1}}[2];
for m in [1..length(mask) / 2]
    handle = this._mgr:start(this.messages, i = mask[(2 * m) - 1], mask[2 * m] - 
1);
    while (handle)
        for msg in (handle[1])
            toline = " " + msg[5];
            for n in (nlist)
                if (index(toline, n))
                    seq = $seq_utils:add(seq, i, i);
                endif
            endfor
            i = i + 1;
            $command_utils:suspend_if_needed(0);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
return seq || ("%f % no messages to " + $string_utils:english_list($list_utils:map_arg($string_utils, 
"print", nlist), "no one", " or "));
.


subject_msg_seq:
":subject_msg_seq(target) => msg_seq of messages with target in the Subject:";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (!this.messages)
    return {};
endif
target = args[1];
seq = {};
mask = {@args, {1, this.messages[2] + 1}}[2];
for m in [1..length(mask) / 2]
    handle = this._mgr:start(this.messages, i = mask[(2 * m) - 1], mask[2 * m] - 
1);
    while (handle)
        for msg in (handle[1])
            if (((subject = msg[6]) != " ") && index(subject, target))
                seq = $seq_utils:add(seq, i, i);
            endif
            i = i + 1;
            $command_utils:suspend_if_needed(0);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
return seq || (("%f % no messages with subjects containing `" + target) + "'");
.


body_msg_seq:
":body_msg_seq(target) => msg_seq of messages with target in the body";
if (!this:ok(caller, caller_perms()))
    return E_PERM;
elseif (!this.messages)
    return {};
endif
target = args[1];
seq = {};
mask = {@args, {1, this.messages[2] + 1}}[2];
for m in [1..length(mask) / 2]
    handle = this._mgr:start(this.messages, i = mask[(2 * m) - 1], mask[2 * m] - 
1);
    while (handle)
        for msg in (handle[1])
            if (msg[1] && (body = this.(msg[1])))
                l = length(body);
                while ((!index(body[l], target)) && (l = l - 1))
                    $command_utils:suspend_if_needed(0);
                endwhile
                if (l)
                    seq = $seq_utils:add(seq, i, i);
                endif
            endif
            i = i + 1;
            $command_utils:suspend_if_needed(0);
        endfor
        handle = this._mgr:next(@listdelete(handle, 1));
    endwhile
endfor
return seq || tostr("%f % no messages containing `", target, "' in the body.");
.


date_sort:
return E_VERBNF;
.


_fix_last_msg_date:
msgtree = this.messages;
this.last_msg_date = (msgtree && this:_message_hdr(@this._mgr:find_nth(msgtree, msgtree[2]))[1]) 
|| 0;
.


__fix:
if (!this:ok_write(caller, caller_perms()))
    return E_PERM;
endif
doit = args && args[1];
msgtree = this.messages;
for n in [1..msgtree[2]]
    msg = this._mgr:find_nth(msgtree, n);
    msg = {@msg[1..2], @$mail_agent:__convert_new(@msg[3..length(msg)])};
    if (doit)
        msgtree = this._mgr:set_nth(msgtree, n, msg);
    endif
    if ($command_utils:running_out_of_time())
        suspend(0);
        if (this.messages != msgtree)
            player:notify("urk.  someone played with this folder.");
            return 0;
        endif
    endif
endfor
return 1;
.


init_for_core:
if (caller_perms().wizard)
    pass();
    this._mgr = $biglist;
    this.mowner = $mail_recipient.owner;
endif
.


length_date_gt:
if (this:ok(caller, caller_perms()))
    date = args[1];
    return (this.last_msg_date <= date) ? 0 | (this.messages[2] - this._mgr:find_ord(this.messages, 
args[1], "_lt_msgdate"));
else
    return E_PERM;
endif
.



PROPERTY DATA:
      summary_uses_body
      _mgr
      mowner
      _genprop

CHILDREN:
Player-Creation-Log Player-Requests