MacGames Sampler/PHT MacGames Bundle.iso/MacSource Folder/Samples from the CD/Pascal/Source□/Talk Source/Talkd ƒ/Tables.p

Text File | 1992-04-20 | 4.7 KB | 219 lines | [TEXT/PJMM]

unit Tables;

{ This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }

interface

    uses
        MyLists, TalkdTypes;

    procedure InitTables;
    procedure FinishTables;
    function NewID: longInt;
    function FindIndexedAnnounce (index: integer): ctlMsgPtr;
    function FindMatch (var request: ctlMsg): ctlMsgPtr;
    function FindRequest (var request: ctlMsg): ctlMsgPtr;
    function InsertTable (var request: ctlMsg): answers;
    function DeleteInvite (id_num: longInt): answers;
    procedure DumpTable;
    procedure DumpRequest (r: ctlMsg);
    procedure DumpAddr (a: osockaddr);

implementation

    type
        entryRecord = record
                request: ctlMsg;
                time: longInt;
            end;
        entryPtr = ^entryRecord;

    var
        table: listHead;
        currentID: longInt;

    procedure InitTables;
    begin
        CreateList(table);
        currentID := 0;
    end;

    procedure FinishTables;
        var
            item: listItem;
            ret: entryPtr;
    begin
        ReturnHead(table, item);
        while not IsTail(item) do begin
            DeleteItem(item, ret);
            DisposPtr(ptr(ret));
        end;
        DestroyList(table, false);
    end;

    function NewID: longInt;
    begin
        currentID := currentID + 1;
        NewID := currentID;
    end;

    procedure ZotOldMessages;
        var
            curtime: longInt;
            item: listItem;
            ret: entryPtr;
    begin
        GetDateTime(curtime);
        ReturnHead(table, item);
        while not IsTail(item) do begin
            Fetch(item, ret);
            if curtime - ret^.time > MAX_LIFE then
                DeleteItem(item, ret)
            else
                MoveToNext(item);
        end;
    end;

    function FindIndexedAnnounce (index: integer): ctlMsgPtr;
        var
            item: listItem;
            ret: entryPtr;
    begin
        if index = 1 then
            ZotOldMessages; { that way we don't muck up the order quite as much }
        ReturnHead(table, item);
        while not IsTail(item) do begin
            Fetch(item, ret);
            if ret^.request.typ = CT_announce then begin
                if index = 1 then begin
                    FindIndexedAnnounce := @ret^.request;
                    exit(FindIndexedAnnounce);
                end;
                index := index - 1;
            end;
            MoveToNext(item);
        end;
        FindIndexedAnnounce := nil;
    end;

    function UpCase (ch: char): char;
    begin
        if ('a' <= ch) and (ch <= 'z') then
            ch := chr(ord(ch) - $20);
        UpCase := ch;
    end;

    function CEqualStr (s1, s2: userStr): boolean;
        var
            i: integer;
    begin
        i := 1;
        while (i <= name_size) & (UpCase(s1[i]) = UpCase(s2[i])) & (s1[i] <> chr(0)) & (s2[i] <> chr(0)) do
            i := i + 1;
        CEqualStr := (i > name_size) | (UpCase(s1[i]) = UpCase(s2[i]));
    end;

    function FindEntry (typ: ctlTypes; l_name, r_name: userStr; touch: boolean): ctlMsgPtr;
        var
            item: listItem;
            ret: entryPtr;
    begin
        ZotOldMessages;
        ReturnHead(table, item);
        while not IsTail(item) do begin
            Fetch(item, ret);
            if (ret^.request.typ = typ) & CEqualStr(l_name, ret^.request.l_name) & CEqualStr(r_name, ret^.request.r_name) then begin
                FindEntry := @ret^.request;
                if touch then
                    GetDateTime(ret^.time);
                exit(FindEntry);
            end;
            MoveToNext(item);
        end;
        FindEntry := nil;
    end;

    function FindMatch (var request: ctlMsg): ctlMsgPtr;
    begin
        FindMatch := FindEntry(CT_leave_invite, request.r_name, request.l_name, false);
    end;

    function FindRequest (var request: ctlMsg): ctlMsgPtr;
    begin
        FindRequest := FindEntry(request.typ, request.l_name, request.r_name, true);
    end;

    function InsertTable (var request: ctlMsg): answers;
        var
            item, temp: listItem;
            ret: entryPtr;
    begin
        request.id_num := NewID;
        ret := entryPtr(NewPtr(SizeOf(entryRecord)));
        if ret <> nil then begin
            GetDateTime(ret^.time);
            ret^.request := request;
            AddTail(table, ret);
            InsertTable := A_success;
        end
        else
            InsertTable := A_failed;
    end;

    function DeleteInvite (id_num: longInt): answers;
        var
            item: listItem;
            ret: entryPtr;
    begin
        ReturnHead(table, item);
        while not IsTail(item) do begin
            Fetch(item, ret);
            if ret^.request.id_num = id_num then begin
                DeleteItem(item, ret);
                DisposPtr(ptr(ret));
                DeleteInvite := A_success;
                exit(DeleteInvite);
            end;
            MoveToNext(item);
        end;
        DeleteInvite := A_not_here;
    end;

    procedure DumpAddr (a: osockaddr);
    begin
        with a do begin
            writeln('(', family : 1, ':', pointer(ip), ' ', port : 1, ')');
        end;
    end;

    procedure DumpRequest (r: ctlMsg);
    begin
        with r do begin
            writeln('vers=', vers : 1, ', typ=', typ, ', answer=', answer, ', id_num=', id_num : 1);
            write('addr=');
            DumpAddr(addr);
            write('ctl_addr=');
            DumpAddr(ctl_addr);
            writeln('l_name=', l_name, ', r_name=', r_name, ', r_tty=', r_tty);
        end;
    end;

    procedure DumpTable;
        var
            item: listItem;
            ret: entryPtr;
            t: longInt;
    begin
        ReturnHead(table, item);
        GetDateTime(t);
        writeln('Table dump at time ', t);
        while not IsTail(item) do begin
            Fetch(item, ret);
            writeln('Entry ', ret, 'at time ', ret^.time);
            DumpRequest(ret^.request);
            MoveToNext(item);
        end;
        writeln;
    end;

end.