(*-------------------------------------------------------------------------
  :Program.       TopTen
  :Contents.      Scans and analyses UMS message areas
  :Author.        Jan Geißler
  :Address.       fidonet: Jan Geissler@2:2407/106.5
  :Address.       usenet:  jan@digit.stgt.sub.org
  :Address.       phone:   +49 (7142) 44740
  :Address.       snail:   Hermann-Rombach-Str. 17,
  :Address.                D-7120 (74321) Bietigheim-Biss.
  :Author.        Kai Bolay [kai]
  :Address.       Snail Mail:              EMail:
  :Address.       Hoffmannstraße 168       UUCP: kai@amokle.stgt.sub.org
  :Address.       D-71229 Leonberg         FIDO: 2:2407/106.3
  :Copyright.     Public Domain
  :Language.      Oberon-2
  :Translator.    Amiga Oberon V3.01 A+L
  :Usage.         USER/A,PASSWORD/A,GROUP/A
  :History.       v1.1 [jan] 19-Mar-93
  :History.       v1.2 [jan] 21-Mar-93 OddChk disabled while COPYing
  :History.       v2.0 [kai] 31-Mar-93 SINCE, MAXMSG, no VAL()
--------------------------------------------------------------------------- *)

MODULE TopTen;

(* IMPORT *)
IMPORT d:   Dos,
       s:   SYSTEM,
       NoGuru,
       Break,
       m:   ums,
       u:   Utility,
       str: Strings,
       l:   Lists,
       e:   Exec;

CONST copyright = "UMSTopTen 2.0 © Jan Geißler & Kai Bolay, Public Domain.\o$VER: UMSTopTen 2.0 (31.3.93)";

(* USAGE/CLI-PARAMS Const/Types/Vars*)
CONST
  template = "USER/A,PASSWORD/A,GROUP/A,SINCE/K/N,MAXMSG/K/N";
  usageErr = "Usage: %s\n%s\n";
TYPE
  LONGPTR = UNTRACED POINTER TO LONGINT;
VAR
  Args: STRUCT
    user, password, group: e.STRPTR;
    since, maxMsg: LONGPTR;
  END;
  RD: d.RDArgsPtr;

(* UMS Vars*)
VAR
  msgNum,
  login:    LONGINT;
  msgLen:   LONGINT;

(* STATISTIC Consts/Types/Vars *)
CONST
  separator = "---------------------------------------------------------------------------\n";
TYPE
  UserProfile * = RECORD (l.Node)
                    name:     e.STRING;
                    numMsgs:  LONGINT;
                    numBytes: LONGINT;
                  END;
  UserProfilePtr * = POINTER TO UserProfile;

  SubjectProfile * = RECORD (l.Node)
                       name:     e.STRING;
                       numMsgs:  LONGINT;
                       numBytes: LONGINT;
                  END;
  SubjectProfilePtr * = POINTER TO SubjectProfile;

VAR
  nam:         UserProfilePtr;
  sub:         SubjectProfilePtr;
  from,
  subject:     e.STRING;

  UserList:    l.List;
  SubjectList: l.List;

  tenUsers:    ARRAY 10 OF UserProfilePtr;
  tenSubjects: ARRAY 10 OF SubjectProfilePtr;

  numUsers,
  numSubjects,
  numMsgs,
  numBytes:    LONGINT;

  i,c,x:       LONGINT;

(* ---------------------------------------------------------------------------------- *)

(* PROC:   AddName     - Adds new user and/or increases "byte and message accounts"   *)

PROCEDURE AddName;
VAR x,y: LONGINT;
    no:  UserProfilePtr;
    ta:  UserProfilePtr;
    err: BOOLEAN;
    non: l.NodePtr;
BEGIN
   no  := l.Head(UserList)(UserProfilePtr);
   ta  := l.Tail(UserList)(UserProfilePtr);

   IF no#NIL THEN
         WHILE (no#NIL) AND (no.name#from) DO
            non := no; IF l.Next(non) THEN END;
            no  := non(UserProfilePtr);
         END;

      IF no#NIL THEN
         (* Eintrag gefunden! *)
         INC(no.numBytes,msgLen);
         INC(no.numMsgs);
         RETURN
      END;
   END;

   NEW(no);
   COPY(from,no.name);
   no.numBytes := msgLen;
   no.numMsgs  := 1;
   INC(numUsers);
   l.AddTail(UserList,no);
END AddName;

(* PROC:   SortUsers   - Sorts the "User Top Ten" by number of messages               *)

PROCEDURE SortUsers;
BEGIN
  nam := l.Head(UserList)(UserProfilePtr);
  FOR i := 1 TO numUsers DO
    c := 0;
    LOOP
      IF (tenUsers[c]=NIL) OR ((c=9) AND (tenUsers[9].numMsgs<=nam.numMsgs)) THEN
         tenUsers[c] := nam;
         EXIT;
      ELSE
         IF tenUsers[c].numMsgs<=nam.numMsgs THEN
            FOR x := 0 TO 9-c-1 DO
                tenUsers[9-x] := tenUsers[9-x-1];
            END;
            tenUsers[c] := nam;
            EXIT;
        END;
      END;
      INC(c); IF c=10 THEN EXIT END;
    END;
  nam := nam.next(UserProfilePtr);
  END;
END SortUsers;

(* PROC:   AddSubject  - Adds new subject and/or increases "byte and message account" *)

PROCEDURE AddSubject;
VAR x,y: LONGINT;
    no:  SubjectProfilePtr;
    ta:  SubjectProfilePtr;
    err: BOOLEAN;
    non: l.NodePtr;
BEGIN
   no  := l.Head(SubjectList)(SubjectProfilePtr);
   ta  := l.Tail(SubjectList)(SubjectProfilePtr);

   IF no#NIL THEN
         WHILE (no#NIL) AND (no.name#subject) DO
            non := no; IF l.Next(non) THEN END;
            no  := non(SubjectProfilePtr);
         END;

      IF no#NIL THEN
         (* Eintrag gefunden! *)
         INC(no.numBytes,msgLen);
         INC(no.numMsgs);
         RETURN
      END;
   END;

   NEW(no);
   COPY(subject,no.name);
   no.numBytes := msgLen;
   no.numMsgs  := 1;
   INC(numSubjects);
   l.AddTail(SubjectList,no);
END AddSubject;

(* PROC:   SortSubject - Sorts the "Subject Top Ten" by number of messages            *)

PROCEDURE SortSubjects;
BEGIN
  sub := l.Head(SubjectList)(SubjectProfilePtr);
  FOR i := 1 TO numSubjects DO
    c := 0;
    LOOP
      IF (tenSubjects[c]=NIL) OR ((c=9) AND (tenSubjects[9].numMsgs<=sub.numMsgs)) THEN
         tenSubjects[c] := sub;
         EXIT;
      ELSE
         IF tenSubjects[c].numMsgs<=sub.numMsgs THEN
            FOR x := 0 TO 9-c-1 DO
                tenSubjects[9-x] := tenSubjects[9-x-1];
            END;
            tenSubjects[c] := sub;
            EXIT;
        END;
      END;
      INC(c); IF c=10 THEN EXIT END;
    END;
  sub := sub.next(SubjectProfilePtr);
  END;
END SortSubjects;

(* PROC:   GetArgs     - Gets CLI arguments                                           *)

PROCEDURE GetArgs*;
VAR
  c:     INTEGER;
  match: e.STRPTR;
BEGIN
  RD := d.ReadArgs (template,Args,NIL);
  IF RD = NIL THEN d.PrintF (usageErr,s.ADR(copyright),s.ADR(template)); HALT (20) END;
  IF Args.since # NIL THEN d.PrintF ("SINCE not implemented yet.\n"); HALT (20) END;
  IF Args.maxMsg # NIL THEN d.PrintF ("MAXMSG not implemented yet.\n"); HALT (20) END;
END GetArgs;

(* PROC:   StripRe     - Strips "RE:" and leading spaces                              *)

PROCEDURE StripRe(VAR st:ARRAY OF CHAR);
VAR xy:e.STRING;
    i: LONGINT;
BEGIN
  COPY(st,xy); str.Upper(xy);
  REPEAT
    i := str.Occurs(xy,"RE:");
    IF i#-1 THEN str.Delete(st,i,3); str.Delete(xy,i,3) END;
  UNTIL i=-1;

  WHILE (st[0]=" ") DO
    str.Delete(st,0,1);
  END;
END StripRe;

(* PROC:   ScanData    - Scans an UMS group                                           *)

PROCEDURE ScanData;
VAR
  p1,p2: m.STRPTR;
BEGIN
  d.PrintF("Scanning data...\n");

  msgNum := 0;

  REPEAT
    msgNum := m.UMSSearchTags(login,m.tagGroup, Args.group,
                                    m.tagSearchLast,msgNum,
                                  (*  m.tagSearchPattern,1 *)
                                    m.tagSearchQuick,1,u.done);

    IF msgNum#0 THEN
       IF ~m.ReadUMSMsgTags(login,  m.tagRMsgNum,msgNum,
                                    m.tagRReadHeader,0,
                                    m.tagRFromName,s.ADR(p1),
                                    m.tagRSubject,s.ADR(p2),
                                    m.tagRTxtLength,s.ADR(msgLen),
                                    m.tagRNoUpdate,0,u.done) THEN
          d.PrintF("Cannot open msg!");
       ELSE
          INC(numMsgs); INC(numBytes,msgLen);
          (* $OddChk- *)
          COPY(p2^,subject); StripRe(subject);
          COPY(p1^,from);
          (* $OddChk= *)

          AddName;
          AddSubject;

          m.FreeUMSMsg(login,msgNum);
       END;

    END;
  UNTIL msgNum=0;

  d.PrintF("done.\nProcessing data...\n");

  SortUsers;
  SortSubjects;

  IF (numMsgs=0) THEN c := 0 ELSE c := (numBytes DIV numMsgs) END;

  d.PrintF(separator);
  d.PrintF("Area:     %s\n",Args.group);
  d.PrintF("Users:    #%ld\n",numUsers);
  d.PrintF("Messages: #%ld\n",numMsgs);
  d.PrintF("Bytes:    #%ld (av. %ld bytes/message)\n",numBytes,c);
  d.PrintF(separator);
  d.PrintF("TOP 10 - MOST MESSAGES\n");
  d.PrintF(separator);

  FOR i := 0 TO 9 DO
         IF tenUsers[i]#NIL THEN
         IF (tenUsers[i].numMsgs=0) THEN c := 0
         ELSE c := tenUsers[i].numBytes DIV tenUsers[i].numMsgs
         END;

         IF (tenUsers[i].numMsgs=0) THEN x := 0 ELSE x := (tenUsers[i].numMsgs*100) DIV numMsgs END;

         d.PrintF("%2.ld. %-30.28s (%3.ld msgs/%2.ld%%,%8.ld b.,%6.ld b./msg)\n",i+1,s.ADR(tenUsers[i].name),tenUsers[i].numMsgs,x,tenUsers[i].numBytes,c);
      END;
  END;

  d.PrintF(separator);
  d.PrintF("TOP 10 - SUBJECTS\n");
  d.PrintF(separator);
  FOR i := 0 TO 9 DO
         IF tenSubjects[i]#NIL THEN
         IF (tenSubjects[i].numMsgs=0) THEN c := 0
         ELSE c := tenSubjects[i].numBytes DIV tenSubjects[i].numMsgs
         END;

         IF (tenSubjects[i].numMsgs=0) THEN x := 0 ELSE x := (tenSubjects[i].numMsgs*100) DIV numMsgs END;

         d.PrintF("%2.ld. %-30.28s (%3.ld msgs/%2.ld%%,%8.ld b.,%6.ld b./msg)\n",i+1,s.ADR(tenSubjects[i].name),tenSubjects[i].numMsgs,x,tenSubjects[i].numBytes,c);
      END;
  END;
  d.PrintF(separator);

END ScanData;

(* ---------------------------------------------------------------------------------- *)

(* MAIN: *)

BEGIN

  GetArgs;
  l.Init(SubjectList);
  l.Init(UserList);

  (* LOGIN *)

  (* $OddChk- *)
  login := m.Login(Args.user^,Args.password^);
  (* $OddChk= *)
  IF login=0 THEN d.PrintF("Login failed.\n"); HALT(20) END;

  ScanData;

(* CLOSE: *)

CLOSE
  IF login # 0 THEN m.Logout(login); login := 0 END;
  IF RD # NIL  THEN d.FreeArgs (RD); RD := NIL  END;
END TopTen.