home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / comm / fido / spot / rexx / areastat.spot < prev    next >
Text File  |  1993-08-25  |  15KB  |  471 lines
  1. /************************************************************/
  2. /*           Spot-Area Statistics Generator                 */
  3. /*          $VER: AreaStat.spot 1.1 (5.8.93)                */
  4. /*                                                          */
  5. /* Author: Brian Jacobsen   FidoNet: 2:230/311.17           */
  6. /************************************************************/
  7.  
  8. address 'SPOT'
  9. signal on syntax
  10. signal on failure
  11. options results
  12.  
  13. VER = "1.1"                                            /* version               */
  14. cr = '0d'X                                            /* Carriage return       */
  15.  
  16. UserNames. = ""                                        /* Userlist array        */
  17. UserNames.0 = 0                                        /* Number of users       */
  18. UserCounter = 0                                        /* Temp counter          */
  19. Writers. = 0                                        /* User Written array    */
  20. TotalNumberWriters = 0                                /* Total writers counter */
  21. Receivers. = 0                                        /* User Received array   */
  22. TotalNumberReceivers = 0                            /* Total receiver counter*/
  23.  
  24. SubjectCounter = 0                                    /* Temp counter          */
  25. Subjects. = ""                                        /* Subjects array        */
  26. Subjects.0 = 0                                        /* Number of Subjects    */
  27. SubjectsC. = 0                                        /* Subject message array */
  28.  
  29. TopTen = 0                                            /* BOOL indicator        */
  30. AllMessages = 0                                        /* BOOL All Messages     */
  31. SelectedMessages = 0                                /* Number of selected mes*/
  32. BoxStr = '+----------------------------------------------------------------------+'
  33.  
  34.  
  35. 'lockgui'                                            /* Lock Spot's GUI       */
  36.  
  37. 'requestresponse TITLE "Please choose..." PROMPT "Do you want the TopTen chart only'cr'or the complete statistics for this area?" GADGETS "Top10|Complete"'
  38. IF rc ~= 0 THEN TopTen = 1
  39.  
  40. 'requestresponse TITLE "Please choose..." PROMPT "Do you want stats for all messages'cr'or do you want select messages by date?" GADGETS "Date|All"'
  41. IF rc = 0 THEN
  42.     AllMessages = 1
  43. ELSE                                                /* Get dates             */
  44.     DO
  45.         CALL SetupDates                                /* Routine to get dates  */
  46.         day = SUBSTR(StartDate,7,2)
  47.         month = SUBSTR(StartDate,5,2)
  48.         year = SUBSTR(StartDate,1,4)
  49.         DispStartDate = day'.'month'.'year            /* For display in stats  */
  50.  
  51.         day = SUBSTR(StopDate,7,2)
  52.         month = SUBSTR(StopDate,5,2)
  53.         year = SUBSTR(StopDate,1,4)
  54.         DispStopDate = day'.'month'.'year            /* For display in stats  */
  55.     END
  56.  
  57. 'messagelist'                                        /* Goto messagelist      */
  58. 'gotomessage 2'                                        /* Gotomessage 1 doesn't */
  59. 'prevmessage'                                        /* work properly in Spot1.1 */
  60.  
  61. StartTime = TIME('R')                                /* Start time measure    */
  62. 'progressopen TITLE "Reading area..."'                /* Open progress window  */
  63. preq = result
  64.  
  65. 'getnummsgs'                                        /* Get total number of   */
  66. TotalMessages=result                                /* messages in area.     */
  67. IF TotalMessages = 0 THEN signal exit
  68.  
  69. /* Now we start examining all messages in current area. */
  70.  
  71. DO count = 1 to TotalMessages
  72.     'progressupdate' preq count TotalMessages        /* Update progress indicator */
  73.     IF rc = 5 THEN signal exit
  74.  
  75.     'gotomessage' count                                /* goto next message     */
  76.  
  77.     IF AllMessages = 0 THEN                            /* Date stat selected */
  78.         DO
  79.             'getdatewritten'
  80.             Parse VAR result day '.' month '.' year
  81.             day = RIGHT(day,2,'0')
  82.             month = RIGHT(month,2,'0')
  83.             DateWritten = year||month||day
  84.             IF DateWritten < StartDate | DateWritten > StopDate THEN
  85.                 ITERATE
  86.         END
  87.  
  88.     'getfrom'                                        /* Get from username     */
  89.     from_name = result
  90.     'getto'                                            /* Get to username       */
  91.     to_name = result
  92.     'getsubject'                                    /* Get Subject           */
  93.     subject = result
  94.  
  95.     SelectedMessages = SelectedMessages + 1
  96.     IF Writers.from_name = 0 & Receivers.from_name = 0 THEN /* This is the first message from or to this bloke */
  97.         DO
  98.             UserCounter = UserCounter + 1            /* We found a new user */
  99.             UserNames.0 = UserCounter                /* Total number of users in */
  100.             UserNames.UserCounter = from_name        /* Add him to the list */
  101.         END
  102.  
  103.     IF Writers.from_name = 0 THEN
  104.         TotalNumberWriters = TotalNumberWriters + 1
  105.     Writers.from_name = Writers.from_name + 1        /* Great, another message from this bloke */
  106.  
  107.     IF Writers.to_name = 0 & Receivers.to_name = 0 THEN /* This is the first message from or to this bloke */
  108.         DO
  109.             UserCounter = UserCounter + 1            /* We found a new user */
  110.             UserNames.0 = UserCounter                /* Total number of users in */
  111.             UserNames.UserCounter = to_name            /* Add him to the list */
  112.         END
  113.  
  114.     IF Receivers.to_name = 0 THEN
  115.         TotalNumberReceivers = TotalNumberReceivers + 1
  116.     Receivers.to_name = Receivers.to_name + 1        /* Great, another message to this bloke */
  117.  
  118.     tempsubject = UPPER(subject)                    /* Strip RE: */
  119.     IF LEFT(tempsubject,3) = 'RE:' THEN
  120.         DO
  121.             subject = DELSTR(subject,1,3)
  122.             subject = STRIP(subject,'L')
  123.         END
  124.  
  125.     IF SubjectsC.subject = 0 THEN                    /* Well, Well new subject */
  126.         DO
  127.             SubjectCounter = SubjectCounter + 1        /* New subject */
  128.             Subjects.0 = SubjectCounter
  129.             Subjects.SubjectCounter = subject
  130.         END
  131.     SubjectsC.subject = SubjectsC.subject + 1
  132. END
  133.  
  134. 'progressclose' preq
  135.  
  136. IF TopTen THEN
  137.     DO
  138.         WriterHeader1 = '                           | Top Ten Writers |'
  139.         WriterHeader2 = '| No. Username                                                Wrote    |'
  140.         ReceiverHeader1 = '                          | Top Ten Receivers |'
  141.         ReceiverHeader2 = '| No. Username                                                Received |'
  142.         SubjectHeader1 =  '                          | Top Ten Subjects |'
  143.         SubjectHeader2 = '| No. Subjects                                                Count    |'
  144.         IF UserNames.0 < 10 THEN
  145.             UserCounter = UserNames.0
  146.         ELSE
  147.             UserCounter = 10
  148.         IF Subjects.0 < 10 THEN
  149.             SubjectCounter = Subjects.0
  150.         ELSE
  151.             SubjectCounter = 10
  152.     END
  153. ELSE
  154.     DO
  155.         WriterHeader1 = '                           |     Writers     |'
  156.         WriterHeader2 = '| Username                                                    Wrote    |'
  157.         ReceiverHeader1 = '                          |     Receivers     |'
  158.         ReceiverHeader2 = '| Username                                                    Received |'
  159.         SubjectHeader1 = '                          |     Subjects     |'
  160.         SubjectHeader2 = '| Subjects                                                    Count    |'
  161.         UserCounter = UserNames.0
  162.         SubjectCounter = Subjects.0
  163.     END
  164. 'getareaname'
  165. AreaName = result
  166.  
  167. 'progressopen TITLE "Creating List..."'
  168. preq = result
  169. CALL open out,"T:Area.stats",write
  170.  
  171. CALL WRITELN out, '          +-------------------------------------------------+'
  172. CALL WRITELN out, '          | Stats for area   :' LEFT(AreaName,28) '|'
  173. IF AllMessages THEN
  174.     CALL WRITELN out, '          | Created          :' LEFT(date(),28) '|'
  175. ELSE
  176.     DO
  177.         CALL WRITELN out, '          | Start Date       :' LEFT(DispStartDate,28) '|'
  178.         CALL WRITELN out, '          | End Date         :' LEFT(DispStopDate,28) '|'
  179.         DaysCovered = DATE('C',StopDate,'S') - DATE('C',StartDate,'S') + 1
  180.         CALL WRITELN out, '          | Days covered     :' LEFT(DaysCovered,28) '|'
  181.     END
  182.  
  183. CALL WRITELN out, '          | No of messages   :' LEFT(SelectedMessages,28) '|'
  184.  
  185. IF AllMessages = 0 THEN
  186.     DO
  187.         MessPerDay = SelectedMessages / DaysCovered
  188.         Remainder = MessPerDay // 1
  189.         MessPerDay = MessPerDay % 1
  190.         IF Remainder > 0.5 THEN MessPerDay = MessPerDay + 1
  191.         CALL WRITELN out, '          | Messages per day :' LEFT(MessPerDay,28) '|'
  192.     END
  193.  
  194. CALL WRITELN out, '          +-------------------------------------------------+'
  195. CALL WRITELN out, ''
  196. CALL WRITELN out, ''
  197. CALL WRITELN out, ''
  198. CALL WRITELN out, '                           +-----------------+'
  199. CALL WRITELN out, WriterHeader1
  200. CALL WRITELN out, BoxStr
  201. CALL WRITELN out, WriterHeader2
  202. CALL WRITELN out, BoxStr
  203.  
  204. CALL WriterSort 1,UserNames.0                            /* Sort list of Writers   */
  205. DO i = 1 TO UserCounter
  206.     Name = UserNames.i
  207.  
  208.     IF Writers.Name ~= 0 THEN
  209.         DO
  210.             PercentWritten = (Writers.Name * 100) / SelectedMessages
  211.             Remainder = PercentWritten // 1
  212.             PercentWritten = PercentWritten % 1
  213.             IF Remainder > 0.5 THEN PercentWritten = PercentWritten + 1
  214.             IF TopTen THEN
  215.                 CALL WRITELN out, '|' RIGHT(i,2)||'.' LEFT(Name,52) RIGHT(Writers.Name,4) '('||RIGHT(PercentWritten,3)'%) |'
  216.             ELSE
  217.                 CALL WRITELN out, '|' LEFT(Name,56) RIGHT(Writers.Name,4) '('||RIGHT(PercentWritten,3)'%) |'
  218.         END
  219. END
  220. CALL WRITELN out, BoxStr
  221. CALL WRITELN out, ''
  222.  
  223. 'progressupdate' preq 1 3
  224. IF rc = 5 THEN signal exit
  225.  
  226. CALL ReceiverSort 1,UserNames.0                            /* Sort list of Receivers   */
  227.  
  228. CALL WRITELN out, '                          +-------------------+'
  229. CALL WRITELN out, ReceiverHeader1
  230. CALL WRITELN out, BoxStr
  231. CALL WRITELN out, ReceiverHeader2
  232. CALL WRITELN out, BoxStr
  233. DO i = 1 TO UserCounter
  234.     Name = UserNames.i
  235.  
  236.     IF Receivers.Name ~= 0 THEN
  237.         DO
  238.             PercentReceived = Receivers.Name / SelectedMessages * 100
  239.             Remainder = PercentReceived // 1
  240.             PercentReceived = PercentReceived % 1
  241.             IF Remainder > 0.5 THEN PercentReceived = PercentReceived + 1
  242.             IF TopTen THEN
  243.                 CALL WRITELN out, '|' RIGHT(i,2)||'.' LEFT(Name,52) RIGHT(Receivers.Name,4) '('||RIGHT(PercentReceived,3)'%) |'
  244.             ELSE
  245.                 CALL WRITELN out, '|' LEFT(Name,56) RIGHT(Receivers.Name,4) '('||RIGHT(PercentReceived,3)'%) |'
  246.         END
  247. END
  248. CALL WRITELN out, BoxStr
  249. CALL WRITELN out, ''
  250. 'progressupdate' preq 2 3
  251. IF rc = 5 THEN signal exit
  252.  
  253.  
  254. CALL SubjectSort 1,Subjects.0                            /* Sort Subjects          */
  255. 'progressupdate' preq 3 3
  256. IF rc = 5 THEN signal exit
  257. CALL WRITELN out, '                          +------------------+'
  258. CALL WRITELN out, SubjectHeader1
  259. CALL WRITELN out, BoxStr
  260. CALL WRITELN out, SubjectHeader2
  261. CALL WRITELN out, BoxStr
  262. DO i = 1 TO SubjectCounter
  263.     Subject = Subjects.i
  264.     IF SubjectsC.Subject ~= 0 THEN
  265.         DO
  266.             PercentSubject = SubjectsC.Subject / SelectedMessages * 100
  267.             Remainder = PercentSubject // 1
  268.             PercentSubject = PercentSubject % 1
  269.             IF Remainder > 0.5 THEN PercentSubject = PercentSubject + 1
  270.             IF TopTen THEN
  271.                 CALL WRITELN out, '|' RIGHT(i,2)||'.' LEFT(Subject,52) RIGHT(SubjectsC.Subject,4) '('||RIGHT(PercentSubject,3)'%) |'
  272.             ELSE
  273.                 CALL WRITELN out, '|' LEFT(Subject,56) RIGHT(SubjectsC.Subject,4) '('||RIGHT(PercentSubject,3)'%) |'
  274.         END
  275. END
  276. CALL WRITELN out, BoxStr
  277. CALL WRITELN out, ''
  278.  
  279. CALL WRITELN out, ''
  280. CALL WRITELN out, '-> Total number of participants in this area:' UserNames.0
  281. CALL WRITELN out, '-> Total number of writers:' TotalNumberWriters
  282. CALL WRITELN out, '-> Total number of receivers:' TotalNumberReceivers
  283.  
  284. CALL WRITELN out, ''
  285. CALL WRITELN out, '-- This chart was created with AreaStat' VER 'written by Brian Jacobsen'
  286.  
  287. CALL close out
  288. 'progressclose' preq
  289. 'unlockgui'
  290.  
  291. EndTime = TIME('E')                                        /* Stop time measure */
  292. TotalTime = TRUNC(EndTime - StartTime)
  293.  
  294. /* Ask user if he wants the result posted in area or to a file */
  295. requestdata = 'TITLE "Please choose..." PROMPT "Finished. Took:' TotalTime 'seconds.'||cr'Do you want the result sent to a file'cr'or posted in this area?" GADGETS "File|Post in area"'
  296. 'requestresponse' requestdata
  297. IF rc = 0 THEN                                            /* Post in area */
  298.     DO
  299.         'write TO "All" SUBJECT "Stats for this area." FILE "T:Area.stats" NOEDIT NOGUI REFLOW=OFF'
  300.         'requestresponse TITLE "Please choose..." PROMPT "Do you wish to edit this message?"'
  301.         IF rc = 0 THEN
  302.             DO
  303.                 'messages'
  304.                 'lastmessage'
  305.                 'edit'
  306.             END
  307.     END
  308. ELSE                                                    /* Write to file */
  309.     DO
  310.         FileName = AreaName'.stat'
  311.         requestdata = 'TITLE "Please choose a file..." PATH "RAM:" FILE "'FileName'"'
  312.         'requestfile' requestdata
  313.         IF rc = 0 THEN
  314.             DO
  315.                 FileName = result
  316.                 address command 'Copy T:Area.Stats "'FileName'"'
  317.             END
  318.     END
  319.  
  320. address command 'Delete >NIL: T:Area.stats'
  321. 'messages'
  322. 'lastmessage'
  323. EXIT
  324.  
  325. SetupDates: PROCEDURE EXPOSE StartDate StopDate
  326.     StopDate = DATE('S')                        /* Setup default dates   */
  327.     day = SUBSTR(StopDate,7,2)
  328.     month = SUBSTR(StopDate,5,2)
  329.     year = SUBSTR(StopDate,1,4)
  330.     DispStopDate = day'.'month'.'year
  331.     DispStartDate = '01.'month'.'year
  332.  
  333.     'requestresponse TITLE "Please choose..." PROMPT "How far back do you want to go?" GADGETS "1 week|14 days|30 days|Specify dates"'
  334.  
  335.     SELECT
  336.         WHEN RC = 1 THEN
  337.             StartDate = DATE('S',DATE('I')-6)
  338.         WHEN RC = 2 THEN
  339.             StartDate = DATE('S',DATE('I')-13)
  340.         WHEN RC = 3 THEN
  341.             StartDate = DATE('S',DATE('I')-29)
  342.         OTHERWISE
  343.             DO
  344.                 RequestData = 'TITLE "Please Enter Start date" PROMPT "(Format DD.MM.YYYY) Example: 22.9.1966" DEFAULT' DispStartDate
  345.                 DO WHILE DATATYPE(StartDate,'N') ~= 1
  346.                     'requeststring' requestdata
  347.                     IF rc ~= 0 THEN signal exit
  348.                     Parse VAR result day '.' month '.' year
  349.                     day = RIGHT(day,2,'0')
  350.                     month = RIGHT(month,2,'0')
  351.                     StartDate = year||month||day
  352.                     IF LENGTH(StartDate) ~= 8 THEN DROP StartDate
  353.                 END
  354.  
  355.                 DROP StopDate
  356.                 RequestData = 'TITLE "Please Enter Stop date" PROMPT "(Format DD.MM.YYYY) Example: 22.9.1966" DEFAULT' DispStopDate
  357.                 DO WHILE DATATYPE(StopDate,'N') ~= 1
  358.                     'requeststring' RequestData
  359.                     IF rc ~= 0 THEN signal exit
  360.                     Parse VAR result day '.' month '.' year
  361.                     day = RIGHT(day,2,'0')
  362.                     month = RIGHT(month,2,'0')
  363.                     StopDate = year||month||day
  364.                     IF LENGTH(StopDate) ~= 8 | StopDate < StartDate THEN DROP StopDate
  365.                 END
  366.             END
  367.     END
  368.  
  369. RETURN
  370.  
  371. /***************************************/
  372. /* Sort-routines. QuickSort algoritm   */
  373. /***************************************/
  374. SubjectSort: PROCEDURE EXPOSE Subjects. SubjectsC.
  375. ARG Left,Right
  376. i = Left; j = Right
  377. m = (Left + Right) % 2
  378. TempSubject = Subjects.m
  379. DO UNTIL (i > j)
  380.     Tempi = Subjects.i
  381.     DO WHILE (SubjectsC.Tempi > SubjectsC.TempSubject & i < Right)
  382.         i = i + 1
  383.         Tempi = Subjects.i
  384.     END
  385.     Tempj = Subjects.j
  386.  
  387.     DO WHILE (SubjectsC.Tempj < SubjectsC.TempSubject & j > Left)
  388.         j = j - 1
  389.         Tempj = Subjects.j
  390.     END
  391.     IF i <= j THEN
  392.         DO
  393.             Temp = Subjects.i
  394.             Subjects.i = Subjects.j
  395.             Subjects.j = Temp
  396.             i = i + 1; j = j - 1
  397.         END
  398. END
  399. IF Left < j  THEN CALL SubjectSort Left,j
  400. IF i < Right THEN CALL SubjectSort i,Right
  401. RETURN
  402.  
  403. WriterSort: PROCEDURE EXPOSE UserNames. Writers.
  404. ARG Left,Right
  405. i = Left; j = Right
  406. m = (Left + Right) % 2
  407. TempWritten = UserNames.m
  408.  
  409. DO UNTIL (i > j)
  410.     Tempi = UserNames.i
  411.     DO WHILE (Writers.Tempi > Writers.TempWritten & i < Right)
  412.         i = i + 1
  413.         Tempi = UserNames.i
  414.     END
  415.     Tempj = UserNames.j
  416.     DO WHILE (Writers.Tempj < Writers.TempWritten & j > Left)
  417.         j = j - 1
  418.         Tempj = UserNames.j
  419.     END
  420.     IF i <= j THEN
  421.         DO
  422.             Temp = UserNames.i
  423.             UserNames.i = UserNames.j
  424.             UserNames.j = Temp
  425.             i = i + 1; j = j - 1
  426.         END
  427. END
  428. IF left < j  THEN CALL WriterSort Left,j
  429. IF i < Right THEN CALL WriterSort i,Right
  430. RETURN
  431.  
  432. ReceiverSort: PROCEDURE EXPOSE UserNames. Receivers.
  433. ARG Left,Right
  434. i = Left; j = Right
  435. m = (Left + Right) % 2
  436. TempWritten = UserNames.m
  437.  
  438. DO UNTIL (i > j)
  439.     Tempi = UserNames.i
  440.     DO WHILE (Receivers.Tempi > Receivers.TempWritten & i < Right)
  441.         i = i + 1
  442.         Tempi = UserNames.i
  443.     END
  444.     Tempj = UserNames.j
  445.     DO WHILE (Receivers.Tempj < Receivers.TempWritten & j > Left)
  446.         j = j - 1
  447.         Tempj = UserNames.j
  448.     END
  449.     IF i <= j THEN
  450.         DO
  451.             Temp = UserNames.i
  452.             UserNames.i = UserNames.j
  453.             UserNames.j = Temp
  454.             i = i + 1; j = j - 1
  455.         END
  456. END
  457. IF left < j  THEN CALL ReceiverSort Left,j
  458. IF i < Right THEN CALL ReceiverSort i,Right
  459. RETURN
  460.  
  461. syntax:
  462. say rc errortext(rc) 'in line' SIGL
  463. failure:
  464. exit:
  465. 'unlockgui'
  466. IF preq ~= 'PREQ' THEN
  467.     'progressclose' preq
  468. 'messages'
  469. 'lastmessage'
  470. exit
  471.