BEGIN
OPEN WalnutQuery;
Time: TYPE = BasicTime.GMT;
MessageConsumer: TYPE = PROC [Message];
TestList: TYPE = LIST OF Test;
TextMatch: TYPE = REF TextMatchRep;
TextMatchRep:
TYPE =
RECORD [
where: ROPE --NIL means body--,
finder: TextFind.Finder];
TestTextMatch:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
tm: TextMatch ← NARROW[data];
subject: ROPE ← GetPart[msg, tm.where];
found: BOOL ← TextFind.SearchRope[tm.finder, subject].found;
RETURN [found];
};
DateRange: TYPE = REF DateRangeRep;
DateRangeRep:
TYPE =
RECORD [
start, end: Time];
TestDateRange:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
dr: DateRange ← NARROW[data];
dateRope: ROPE ← GetPart[msg, "Date"];
date: Time ← BasicTime.nullGMT;
inRange: BOOL;
date ← Convert.TimeFromRope[dateRope !Convert.Error => CONTINUE];
inRange ← date # BasicTime.nullGMT AND BasicTime.Period[dr.start, date]>=0 AND BasicTime.Period[date, dr.end]>=0;
RETURN [inRange];
};
InMsgSet: TYPE = REF InMsgSetRep;
InMsgSetRep:
TYPE =
RECORD [
name: ROPE];
TestInMsgSet:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
ims: InMsgSet ← NARROW[data];
FOR msl:
LOR ← msg.msList, msl.rest
WHILE msl #
NIL
DO
IF ims.name.Equal[msl.first, FALSE] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
};
Not:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
t: Test ← NARROW[data];
RETURN [NOT t.Eval[msg, t.data]]};
And:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
tl: TestList ← NARROW[data];
FOR tl ← tl, tl.rest
WHILE tl #
NIL
DO
IF NOT tl.first.Eval[msg, tl.first.data] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]};
Or:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
tl: TestList ← NARROW[data];
FOR tl ← tl, tl.rest
WHILE tl #
NIL
DO
IF tl.first.Eval[msg, tl.first.data] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE]};
XOr:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
tl: TestList ← NARROW[data];
ans: BOOL ← FALSE;
FOR tl ← tl, tl.rest
WHILE tl #
NIL
DO
ans ← ans # tl.first.Eval[msg, tl.first.data];
ENDLOOP;
RETURN [ans]};
Iff:
PROC [msg: Message, data:
REF
ANY]
RETURNS [
BOOL] = {
tl: TestList ← NARROW[data];
ans: BOOL ← FALSE;
FOR tl ← tl, tl.rest
WHILE tl #
NIL
DO
ans ← ans = tl.first.Eval[msg, tl.first.data];
ENDLOOP;
RETURN [ans]};
Prepare:
PROC [ra:
REF
ANY]
RETURNS [test: Test] = {
WITH ra
SELECT
FROM
rope: ROPE => test ← Prepare[LIST[$textMatch, bodyKey, rope]];
refText: REFTEXT => test ← Prepare[LIST[$textMatch, bodyKey, refText]];
lora:
LORA => {
key: ATOM ← NARROW[lora.first];
SELECT key
FROM
$textMatch => {
tm: TextMatch ← NEW [TextMatchRep ← [NarrowToRope[lora.rest.first], NIL]];
literal: BOOL ← TRUE;
word: BOOL ← FALSE;
ignoreCase: BOOL ← TRUE;
addBounds: BOOL ← FALSE;
FOR l:
LORA ← lora.rest.rest, l.rest
WHILE l #
NIL
DO
r: REF ANY ← l.first;
WITH r
SELECT
FROM
rope:
ROPE => {
IF tm.finder # NIL THEN ERROR;
tm.finder ← TextFind.CreateFromRope[pattern: rope, literal: literal, word: word, ignoreCase: ignoreCase, addBounds: addBounds];
};
refText:
REFTEXT => {
IF tm.finder # NIL THEN ERROR;
tm.finder ← TextFind.CreateFromRope[pattern: Rope.FromRefText[refText], literal: literal, word: word, ignoreCase: ignoreCase, addBounds: addBounds];
};
atom:
ATOM =>
SELECT atom
FROM
$literal => literal ← TRUE;
$pattern => literal ← FALSE;
$word => word ← TRUE;
$anywhere => addBounds ← word ← FALSE;
$ignoreCase => ignoreCase ← TRUE;
$testCase => ignoreCase ← FALSE;
$addBounds => addBounds ← TRUE;
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDLOOP;
test ← NEW [TestRep ← [TestTextMatch, tm]];
};
$dateRange => {
dr: DateRange ←
NEW [DateRangeRep ← [
start: ParseTime[lora.rest.first],
end: ParseTime[lora.rest.rest.first]
]];
test ← NEW [TestRep ← [TestDateRange, dr]];
};
$inMsgSet => {
ims: InMsgSet ← NEW [InMsgSetRep ← [NarrowToRope[lora.rest.first]]];
test ← NEW [TestRep ← [TestInMsgSet, ims, ims.name]];
};
$not => test ← NEW [TestRep ← [Not, Prepare[lora.rest.first]]];
$and => {
test ← NEW [TestRep ← [And, PrepareList[lora.rest]]];
test.msgSet ← PickSmallestMsgSet[NARROW[test.data]];
};
$or => {
test ← NEW [TestRep ← [Or, PrepareList[lora.rest]]];
test.msgSet ← FindSameMsgSet[NARROW[test.data]]
};
$xor => {
test ← NEW [TestRep ← [XOr, PrepareList[lora.rest]]];
test.msgSet ← FindSameMsgSet[NARROW[test.data]]
};
$iff => {
test ← NEW [TestRep ← [Iff, PrepareList[lora.rest]]];
test.msgSet ← FindSameMsgSet[NARROW[test.data]]
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
PickSmallestMsgSet:
PROC [tl: TestList]
RETURNS [msgSet:
ROPE ←
NIL] ~ {
maxSize: INT ← LAST[INT];
FOR tl ← tl, tl ← tl.rest
WHILE tl #
NIL
AND tl.first #
NIL
DO
IF
NOT Rope.IsEmpty[tl.first.msgSet]
THEN {
size: INT ← WalnutOps.SizeOfMsgSet[tl.first.msgSet].messages;
IF size < maxSize THEN { maxSize ← size; msgSet ← tl.first.msgSet };
};
ENDLOOP;
};
FindSameMsgSet:
PROC [tl: TestList]
RETURNS [msgSet:
ROPE ←
NIL] ~ {
FOR tl ← tl, tl ← tl.rest
WHILE tl #
NIL
AND tl.first #
NIL
DO
IF Rope.IsEmpty[tl.first.msgSet] THEN RETURN [NIL]
ELSE {
IF Rope.IsEmpty[msgSet] THEN msgSet ← tl.first.msgSet -- first message set
ELSE IF NOT Rope.Equal[msgSet, tl.first.msgSet, FALSE] THEN RETURN [NIL];
};
ENDLOOP;
};
bodyKey: ROPE = NIL;
ParseTime:
PROC [asAny:
REF
ANY]
RETURNS [time: Time] =
{time ← Convert.TimeFromRope[NarrowToRope[asAny]]};
NarrowToRope:
PROC [asAny:
REF
ANY]
RETURNS [rope:
ROPE] = {
rope ←
IF asAny #
NIL
THEN
WITH asAny
SELECT
FROM
rope: ROPE => rope,
refText: REFTEXT => Rope.FromRefText[refText],
ENDCASE => ERROR
ELSE NIL;
};
PrepareList:
PROC [lora:
LORA]
RETURNS [tl: TestList] = {
tail: TestList ← tl ← NIL;
FOR lora ← lora, lora.rest
WHILE lora #
NIL
DO
this: TestList ← LIST[Prepare[lora.first]];
IF tail # NIL THEN tail.rest ← this ELSE tl ← this;
tail ← this;
ENDLOOP;
tl ← tl;
};
Apply:
PROC [test: Test, consume: MessageConsumer, status: Status] = {
enumerator: WalnutOps.EnumeratorForMsgs;
msg: Message ← NEW [MessageRep ← [NIL, NIL, NIL]];
IF Rope.IsEmpty[test.msgSet] THEN enumerator ← WalnutOps.EnumerateMsgs[]
ELSE enumerator ← WalnutOps.EnumerateMsgsInMsgSet[test.msgSet];
DO
msgID: ROPE;
msList: LOR;
headersAsText: REFTEXT;
[msgID, msList, headersAsText] ← WalnutOps.NextMsg[enumerator];
IF msgID = NIL THEN EXIT;
msg^ ← [msgID, msList, WalnutOps.ParseHeaders[RefText.TrustTextAsRope[headersAsText], NIL]];
status.enumerated ← status.enumerated + 1;
IF test.Eval[msg, test.data]
THEN {
status.accepted ← status.accepted + 1;
consume[msg];
};
Process.CheckForAbort[];
ENDLOOP;
msg ← msg;
};
GetPart:
PROC [msg: Message, part:
ROPE]
RETURNS [value:
ROPE] = {
IF part = bodyKey
THEN {
value ← WalnutOps.GetMsg[msg.msgID].contents.contents;
RETURN;
};
FOR hl: Headers ← msg.headers, hl.rest
WHILE hl #
NIL
DO
IF hl.first.fieldName.Equal[part, FALSE] THEN RETURN [hl.first.value];
ENDLOOP;
value ← NIL;
};
ToDo: TYPE = LIST OF Add;
Add: TYPE = RECORD [msgID, msgSetFrom: ROPE];
FilterToMsgSet:
PUBLIC
PROC [filter:
REF
ANY, msgSetName:
ROPE, status: Status ←
NIL]
RETURNS [outCome: WalnutWindow.OutCome] = {
test: Test;
dest: WalnutDefs.MsgSet = [msgSetName];
toDo: ToDo ← NIL;
PerMsg:
PROC [msg: Message] = {
toDo ← CONS[[msg.msgID, msg.msList.first], toDo];
};
DoIt:
PROC []
RETURNS [doReset:
BOOL] = {
WalnutOps.CreateMsgSet[msgSetName, WalnutOps.dontCareDomainVersion];
FOR tdl: ToDo ← toDo, tdl.rest
WHILE tdl #
NIL
DO
a: Add ← tdl.first;
[] ← WalnutOps.AddMsg[msg: a.msgID, from: [a.msgSetFrom], to: dest];
status.added ← status.added + 1;
ENDLOOP;
doReset ← TRUE};
IF status = NIL THEN status ← NEW [StatusRec ← []];
status^ ← [phase: preparing];
test ← Prepare[filter];
status^ ← [
phase: enumerating,
msgSet: test.msgSet,
total: IF Rope.IsEmpty[test.msgSet]
THEN WalnutOps.SizeOfDatabase[].messages
ELSE WalnutOps.SizeOfMsgSet[test.msgSet].messages
];
Apply[test, PerMsg, status];
status.phase ← adding;
outCome ← WalnutWindow.QueueCall[DoIt];
status.phase ← idle;
};
NewViewedStatus:
PUBLIC
PROC [name:
ROPE ←
NIL]
RETURNS [status: Status
--with a RecordViewer on it--] = {
status ← NEW [StatusRec];
IF name = NIL THEN name ← "WalnutQuery status";
[] ← ViewRec.ViewRef[
agg: status,
createOptions: [feedBackHeight: 0],
viewerInit: [name: name]
];
};