MODULE UserQuery;

    IMPORT
	a:= Arguments, ac:= ANSIConsole, st:= Strings, cv:= Conversions, io, s:= SYSTEM,
	e:= Exec, d:= Dos, ol:= OberonLib,
	bo:= BBSColours, bs:= BBSStructures, bc:= BBSConstants,
	hn:= HBBSNode, hc:= HBBSCommon, req:= Requests;


    CONST EOF = -1; LF = 0AH;
	  LineLength = 80;
	  LTRUE = 1; LFALSE = 0;

    TYPE
	LineNodePtr = UNTRACED POINTER TO LineNode;
	LineNode = STRUCT
	    prev, next: LineNodePtr;
	    text: ARRAY LineLength OF CHAR;
	END;

    VAR
	BBSGlobal: bs.BBSGlobalDataPtr;
	NnD: bs.NodeDataPtr;
	NodeNum: LONGINT;
	argList: LineNodePtr;
	CountArgs: INTEGER;
	textPool: e.MemPoolPtr;
	menuName: LineNodePtr;

    PROCEDURE cleanup(num: LONGINT);
    BEGIN
	IF hn.HBBSNodeBase # NIL THEN
	    hn.HBBSCleanUpDoor;
	    e.CloseLibrary(hn.HBBSNodeBase);
	    hn.HBBSNodeBase:= NIL;
	END;
	IF hc.HBBSCommonBase # NIL THEN
	    hc.HBBSCleanUpCommon;
	    e.CloseLibrary(hc.HBBSCommonBase);
	    hc.HBBSCommonBase:= NIL;
	END;

	IF num # 0 THEN
	    io.WriteString("Door Error = ");
	    io.WriteInt(num, 0); io.WriteLn;
	     (* io.Format("Door Error = %d\n", s.ADR(num)) *)
	END;
    END cleanup;

    PROCEDURE init(name: e.STRPTR);
    BEGIN
	
	IF hc.HBBSCommonBase = NIL THEN
	    cleanup(1); RETURN
	END;
	IF NOT hc.HBBSInitCommon() THEN
	    cleanup(2); RETURN
	END;

	IF hn.HBBSNodeBase = NIL THEN
	    cleanup(3); RETURN
	END;

	IF NOT hn.HBBSInitDoor(SHORT(NodeNum), name) THEN
	    cleanup(4); RETURN
	END;

    END init;

    PROCEDURE AddNode(VAR list: LineNodePtr; at: INTEGER): LineNodePtr;
	VAR last, new: LineNodePtr;
	    dummy: LineNode;
    BEGIN
	new:= e.AllocPooled(textPool, s.SIZE(dummy));
	IF list = NIL THEN
	    IF new # NIL THEN
		new^.prev:= NIL;
		new^.next:= NIL;
	    END;
	    list:= new;
	ELSE
	    IF at <= 1 THEN
		IF new # NIL THEN
		    new^.prev:= NIL;
		    new^.next:= list;
		    list^.prev:= new;
		    list:= new;
		END;
	    ELSE
		last:= list;
		WHILE (last^.next # NIL) & (at > 2) DO
		    last:= last^.next; at:= at - 1
		END;
		IF new # NIL THEN
		    new^.next:= last^.next;
		    new^.prev:= last;
		    IF last^.next # NIL THEN
			last^.next^.prev:= new
		    END;
		    last^.next:= new;
		END;
	    END;
	END;
	RETURN new;
    END AddNode;

    PROCEDURE DeleteNode(VAR list: LineNodePtr; at: INTEGER);
	VAR this: LineNodePtr;
	    dummy: LineNode;
    BEGIN
	IF list # NIL THEN
	    this:= list;
	    IF at <= 1 THEN
		list:= this^.next;
		IF list # NIL THEN list^.prev:= NIL END;
	    ELSE
		WHILE (this^.next # NIL) & (at > 1) DO
		    this:= this^.next; at:= at - 1
		END;
		IF this^.prev # NIL THEN
		    this^.prev^.next:= this^.next
		END;
		IF this^.next # NIL THEN
		    this^.next^.prev:= this^.prev;
		END;
	    END;
	    e.FreePooled(textPool, this, s.SIZE(dummy));
	END;
    END DeleteNode;

    PROCEDURE GetNode(list: LineNodePtr; at: INTEGER): LineNodePtr;
    BEGIN
	IF list = NIL THEN RETURN NIL END;
	WHILE (list # NIL) & (at > 1) DO
	    list:= list^.next; at:= at - 1;
	END;
	RETURN list;
    END GetNode;

    PROCEDURE ReqNumber(l: LONGINT);
	VAR str: ARRAY 80 OF CHAR;
	    ok: BOOLEAN;
	    count: INTEGER; factor: LONGINT;
    BEGIN
	factor:= 1000000000; count:= 10;
	WHILE (ABS(l) < factor) & (count > 1) DO count:= count - 1; factor:= factor DIV 10 END;
	ok:= cv.IntToString(l, str, count);
	IF ok THEN
	    req.BreakPoint(str)
	END;
    END ReqNumber;

    VAR str: ARRAY 80 OF CHAR;

    PROCEDURE PutNumber(l: LONGINT);
	VAR ok: BOOLEAN;
	    count: INTEGER; factor: LONGINT;
    BEGIN
	factor:= 1000000000; count:= 10;
	WHILE (ABS(l) < factor) & (count > 1) DO count:= count - 1; factor:= factor DIV 10 END;
	ok:= cv.IntToString(l, str, count);
	IF ok THEN
	    hn.DOORWriteText(s.ADR(str));
	END;
    END PutNumber;

    VAR str1: ARRAY 2 OF CHAR;

    PROCEDURE PutChar(ch: CHAR);
    BEGIN
	str1[0]:= ch; str1[1]:= CHR(0);
	hn.DOORWriteText(s.ADR(str1));
    END PutChar;

    PROCEDURE ReplyArgs;
	VAR
	    i: INTEGER;
	    thisArg: LineNodePtr;
    BEGIN
	i:= 1;
	LOOP
	    thisArg:= GetNode(argList, i);
	    IF thisArg # NIL THEN hn.DOORWriteText(s.ADR(thisArg^.text)) END; 
	    hn.DOORWriteText(s.ADR(" "));
	    IF thisArg = NIL THEN EXIT END;
	    i:= i + 1
	END;
    END ReplyArgs;

    CONST
	SearchNone = 0; SearchNew = 1; SearchLocked = 2; SearchGlobal = 3;

    VAR
	sysopOptions, showDeleted: BOOLEAN;
	searchType: INTEGER;
	sysopFlag: LONGINT;

    PROCEDURE GetStringAt(row, column: INTEGER; len: LONGINT; VAR str: ARRAY OF CHAR): BOOLEAN;
	VAR res: LONGINT;
    BEGIN
	ac.CURSORGoTo(PutChar, row, column); ac.EraseToEOL(PutChar);
	ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
	res:= hn.DOORGetLine(bc.GlDisplay + bc.GlNoOLM + bc.GlEdit + sysopFlag, CHR(0), len, 0, s.ADR(str));
	IF (res = bc.InGotLine) THEN
	    hc.strNcpy(s.ADR(str), NnD^.CurrentLine, SHORT(len));
	    RETURN TRUE;
	ELSE
	    str:= "";
	    RETURN FALSE
	END;
    END GetStringAt;

    PROCEDURE WriteBoolAt(row, column: INTEGER; b: BOOLEAN);
    BEGIN
	ac.CURSORGoTo(PutChar, row, column);
	ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
	IF b THEN hn.DOORWriteText(s.ADR("Y")) ELSE hn.DOORWriteText(s.ADR("N")) END;
	ac.SetStyle(PutChar, ac.stPlain); ac.SetColor(PutChar, ac.cForeWhite);
	IF b THEN hn.DOORWriteText(s.ADR("es")) ELSE hn.DOORWriteText(s.ADR("o ")) END;
    END WriteBoolAt;

    PROCEDURE DisplayUser(userData: bs.UserDataPtr);
    BEGIN
	ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
	hn.DOORWriteText(s.ADR("#"));
	PutNumber(userData^.UserID);
	IF userData^.UserID >= 100 THEN hn.DOORWriteText(s.ADR(" "));
	ELSIF userData^.UserID >= 10 THEN hn.DOORWriteText(s.ADR("  "));
	ELSE hn.DOORWriteText(s.ADR("   "));
	END;
	IF userData^.Status = bc.UserNew             THEN ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeYellow);
	ELSIF userData^.Status = bc.UserValidated    THEN ac.SetStyle(PutChar, ac.stPlain); ac.SetColor(PutChar, ac.cForeGreen);
	ELSIF userData^.Status = bc.UserLoginsDenied THEN ac.SetStyle(PutChar, ac.stPlain); ac.SetColor(PutChar, ac.cForeRed);
	ELSIF userData^.Status = bc.UserDeleted      THEN ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeBlack);
	ELSIF userData^.Status = bc.UserOverwritable THEN ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeBlue);
	ELSE ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForePurple);
	END;
	hn.DOORWriteText(s.ADR(userData^.Handle));

    END DisplayUser;

    PROCEDURE DisplayWait(VAR sWait: ARRAY OF CHAR);
    BEGIN
	st.Append(sWait, ".");
	ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeWhite);
	hn.DOORWriteText(s.ADR(sWait));
    END DisplayWait;

    PROCEDURE UserPromptAt(row, column: INTEGER): LONGINT;
	VAR
	    str: ARRAY 50 OF CHAR;
	    res: LONGINT;
	    val: LONGINT;
    BEGIN
	ac.CURSORGoTo(PutChar, row, column);
	ac.SetStyle(PutChar, ac.stBold); ac.SetColor(PutChar, ac.cForeYellow);
	hn.DOORWriteText(s.ADR("User ID# or RETURN to continue > "));
	ac.SetColor(PutChar, ac.cForeWhite);
	str:= "";
	res:= hn.DOORGetLine(bc.GlDisplay + bc.GlNoOLM + bc.GlEdit + sysopFlag, CHR(0), 50, 0, s.ADR(str));
	IF (res = bc.InGotLine) THEN hc.strNcpy(s.ADR(str), NnD^.CurrentLine, 50);
	ELSE str:="";
	END;
	IF NOT cv.StringToInt(str, val) THEN val:= -1 END;
	IF st.Length(str) = 0 THEN val:= -1 END; (* canceled *)
	RETURN val;
    END UserPromptAt;

    PROCEDURE CallZoom(userID: LONGINT);
	VAR options, s2: ARRAY 40 OF CHAR;
	    res: LONGINT;
    BEGIN
	IF userID >= 0 THEN
	    options:= "USERID=";
	    cv.IntToStringLeft(userID, s2);
	    st.Append(options, s2);
	    res:= hn.DOORUserDoor(s.ADR("UserInfos"), s.ADR(options));
	    res:= hn.DOORDisplaySpecialScreen(s.ADR("USERQUERY"));
	END;
    END CallZoom;

    PROCEDURE SearchUser(searchType: INTEGER; deletedUsers: BOOLEAN; sRealName, sHandle: ARRAY OF CHAR; fillArea: BOOLEAN);

	CONST
	    startRow = 3; endRow = 20;
	VAR
	    nUsers, iPos: INTEGER;
	    userData: bs.UserData;
	    sWait, str, options, s2: ARRAY 25 OF CHAR;
	    accept: BOOLEAN;
	    rowCount: INTEGER;
	    res, userID: LONGINT;

	PROCEDURE FillArea;
	    VAR i: INTEGER;
	BEGIN
	    ac.CURSORGoTo(PutChar, startRow, 40);
	    FOR i:= startRow TO endRow DO
		ac.EraseToEOL(PutChar); ac.DOWN(PutChar, 1);
	    END;
	END FillArea;

    BEGIN
	nUsers:= SHORT(BBSGlobal^.TotalUsers);
	iPos:= 1; sWait:= ""; rowCount:= startRow;
	st.Upper(sRealName); st.Upper(sHandle);
	IF fillArea THEN FillArea END;
	ac.CURSORGoTo(PutChar, startRow - 1, 40);

	WHILE iPos <= nUsers DO

	    IF hc.HBBSLoadUser(iPos, NIL, NIL, s.VAL(bs.UserDataPtr, s.ADR(userData))) THEN
		IF searchType = SearchNew THEN accept:= (userData.Status = bc.UserNew);
		ELSIF searchType = SearchLocked THEN accept:= (userData.Status = bc.UserLoginsDenied);
		ELSIF NOT deletedUsers THEN accept:= ((userData.Status # bc.UserDeleted) & (userData.Status # bc.UserOverwritable));
		ELSE accept:= TRUE;
		END;
		IF st.Length(sHandle) > 0 THEN
		    hc.strNcpy(s.ADR(str), s.ADR(userData.Handle), 25); st.Upper(str);
		    accept:= accept & (st.Occurs(str, sHandle) = 0);
		END;
		IF st.Length(sRealName) > 0 THEN
		    hc.strNcpy(s.ADR(str), s.ADR(userData.RealName), 25); st.Upper(str);
		    accept:= accept & (st.Occurs(str, sRealName) = 0);
		END;

	    ELSE
		accept:= FALSE;
	    END;

	    IF accept THEN
		hn.DOORWriteText(s.ADR("\r\n")); ac.RIGHT(PutChar, 39);
		DisplayUser(s.VAL(bs.UserDataPtr, s.ADR(userData)));
		IF (rowCount = endRow) AND (iPos # nUsers) THEN
		    userID:= UserPromptAt(endRow + 1, 5);
		    ac.CURSORGoTo(PutChar, endRow+1, 5);
		    ac.EraseToEOL(PutChar);
		    CallZoom(userID);
		    rowCount:= startRow;
		    IF NOT(iPos = nUsers) THEN FillArea END;
		    ac.CURSORGoTo(PutChar, startRow - 1, 40);
		ELSE
		    INC(rowCount);
		END;
	    ELSE
		(* ac.CURSORGoTo(PutChar, rowCount, 40);
		DisplayWait(sWait);
		ac.UP(PutChar, 1); *)
	    END;
	    INC(iPos);
	END;
	userID:= UserPromptAt(endRow + 1, 5);
	ac.CURSORGoTo(PutChar, endRow+1, 5);
	ac.EraseToEOL(PutChar);
	IF userID >= 0 THEN
	    CallZoom(userID);
	END;
    END SearchUser;

    PROCEDURE DoorMain;

	VAR res: LONGINT;
	    sLine: ARRAY 10 OF CHAR;
	    sHandle, sRealName: ARRAY 25 OF CHAR;
	    fillArea: BOOLEAN;
	    argLine: LineNodePtr;
    BEGIN
	showDeleted:= FALSE;
	sysopOptions:= st.Occurs(NnD^.ActiveDoor^.SystemOptions^, "SYSOP") >= 0;
	searchType:= SearchNone;
	sHandle:= ""; sRealName:= "";
	fillArea:= FALSE;

	IF NnD^.NodeDevice.SysopNode = bc.LTRUE THEN sysopFlag:= bc.GlSysop ELSE sysopFlag:= 0 END;

	IF hn.DOORDisplaySpecialScreen(s.ADR("USERQUERY")) = bc.LTRUE THEN

	    IF sysopOptions THEN WriteBoolAt(8, 23, showDeleted) END;

	    LOOP
		ac.CURSORGoTo(PutChar, 21, 0);
		res:= hn.DOORGetLine(bc.GlImmediate + bc.GlNoReturn + bc.GlNoOLM + sysopFlag, CHR(0), 1, 0, NIL);

		IF (res = bc.InGotLine) OR (res = bc.InImmediate) THEN

		    hc.strNcpy (s.ADR(sLine), NnD^.CurrentLine, LEN(sLine));

		    hc.CVTUCase(s.ADR(sLine));

		    IF st.Occurs(sLine, "R") >= 0 THEN
			IF NOT GetStringAt(4, 23, 25, sRealName) THEN EXIT END;
		    ELSIF st.Occurs(sLine, "H") >= 0 THEN
			IF NOT GetStringAt(6, 23, 25, sHandle) THEN EXIT END;
		    ELSIF (st.Occurs(sLine, "D") >= 0) AND sysopOptions THEN

			ac.CURSORGoTo(PutChar, 8, 23);
			res:= hn.DOORGetLine(bc.GlImmediate + bc.GlNoReturn, CHR(0), 1, 0,NIL);

			IF (res = bc.InGotLine) OR (res = bc.InImmediate) THEN

			    hc.strNcpy(s.ADR(sLine), NnD^.CurrentLine, 1);
			    hc.CVTUCase(s.ADR(sLine));
			    showDeleted:= st.Occurs(sLine, "Y") >= 0;
			    WriteBoolAt(8, 23, showDeleted);
			END;

		    ELSIF (st.Occurs(sLine, "N") >= 0) AND sysopOptions THEN
			searchType:= SearchNew;
		    ELSIF (st.Occurs(sLine, "L") >= 0) AND sysopOptions THEN
			searchType:= SearchLocked;
		    ELSIF ((st.Occurs(sLine, "G") >= 0) AND sysopOptions)
			OR ((st.Occurs(sLine, "S") >= 0) AND NOT sysopOptions) THEN
			searchType:= SearchGlobal;
		    ELSIF (st.Occurs(sLine, "Q") >= 0) OR (st.Length(sLine) = 0)  THEN
			EXIT
		    END;

		    IF (searchType # SearchNone) THEN
			SearchUser(searchType, showDeleted, sRealName, sHandle, fillArea);
			searchType:= SearchNone; fillArea:= TRUE
		    END;

		ELSE
		    EXIT
		END;
	    END;

	ELSE
	    IF hn.DOORPausePrompt(s.ADR("User query menu not found... press any key to abort")) = bc.LTRUE THEN END;
	END;

    END DoorMain;

    PROCEDURE ParseArgs;
	VAR
	    i: INTEGER;
	    newArg: LineNodePtr;
	    s: ARRAY 80 OF CHAR;
	    ok: BOOLEAN;
    BEGIN
	CountArgs:= a.NumArgs();
	i:= 1;
	WHILE i <= CountArgs DO
	    newArg:= AddNode(argList, MAX(INTEGER));
	    IF newArg # NIL THEN
		a.GetArg(i, newArg^.text);
	    ELSE
		CountArgs:= i;
	    END;
	    i:= i + 1
	END;
    END ParseArgs;


    VAR
	newArg: LineNodePtr;
	dummy: LineNode;

BEGIN
    textPool:= e.CreatePool(LONGSET{}, s.SIZE(dummy), s.SIZE(dummy));
    ParseArgs;
    IF CountArgs > 0 THEN
	 newArg:= GetNode(argList, 1);
	 IF cv.StringToInt(newArg^.text, NodeNum) THEN
	    init(s.ADR("Query user(s)"));
	    IF hc.HBBSCommonBase # NIL THEN
		BBSGlobal:= hc.HBBSGimmeBBS();
		IF BBSGlobal # NIL THEN
		    NnD:= hc.HBBSNodeDataPtr(SHORT(NodeNum));
		    IF NnD # NIL THEN
			DoorMain;
		    END;
		END;
	    END;
	    cleanup(0);
	ELSE
	    io.WriteString("Invalid Param for door!\n")
	END;
    ELSE
	io.WriteString("No Param for door!\n");
    END;
CLOSE
    cleanup(0);
    e.DeletePool(textPool);
END UserQuery.