home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 109 / EnigmaAmiga109CD.iso / software / on-line / gmsuite / rexx / gmcleanconf.thor < prev    next >
Text File  |  2000-01-23  |  13KB  |  504 lines
  1. /*
  2. ** $VER: GMCleanConf.thor 5.003 (23.01.00)
  3. **       © Gian Maria Calzolari <gcalzo@geocities.com>
  4. **
  5. **  FUNCTION:
  6. **      Saving and purging messages from Thor Conferences
  7. **
  8. **      Parameters:
  9. **        <none>    to use Thor's RequestInteger function
  10. **
  11. **          or
  12. **
  13. **        MONTH     message creation month to search
  14. **        YEAR      message creation year to search
  15. **
  16. ** $HISTORY:
  17. **
  18. ** 23 Jan 2000 : 005.003 : To avoid unwanted "deadlock" the needed "signal on"
  19. **                         routines have been created
  20. ** 07 Jan 2000 : 005.002 : Nothing, bumped up rev
  21. ** 21 Dec 1999 : 005.001 : Nothing, bumped up rev
  22. ** 17 Nov 1999 : 005.000 : Bumped up rev for consistency with first aminet
  23. **                         release of GMsuite!
  24. **                         Messages Unread or SuperUnread are not processed
  25. **                         Added pack of Event, User, Kill & File data at script end
  26. ** 17 Nov 1999 : 000.013 : Got the way to use conference's KeepDays!
  27. **                         Removed tag ARCHIVE in config file:
  28. **                          if KeepDays is used then no messages are saved!
  29. ** 16 Nov 1999 : 000.012 : added directory search for execution within Thor
  30. ** 15 Nov 1999 : 000.011 : added validation to shell params
  31. ** 14 Nov 1999 : 000.010 : added external config file because there is no way
  32. **                         to get the KeepDays or KeepMsgs from the Conference
  33. **                         configuration! :-(
  34. ** 08 Nov 1999 : 000.009 : Added conference recursion
  35. ** 07 Nov 1999 : 000.008 : ...started migration to Thor...
  36. ** 11 Feb 1995 : 000.007 : Last EMS version...
  37. **
  38. */
  39.  
  40. signal on syntax
  41. signal on break_c
  42. signal on failure
  43. signal on halt
  44.  
  45. options results
  46.  
  47. VerStr     = subword(sourceline(2),3)
  48.  
  49. parse arg SMonth SYear .
  50.  
  51. call Init
  52.  
  53. if address() ~= thorport then
  54.    address(thorport)
  55.  
  56. CurrentSystem stem Current
  57.  
  58. if rc = 1 then ExitMsg('This script must be called from INSIDE a Systme!')
  59. if rc > 5 then signal error
  60.  
  61. ConfigFile = 'ENV:Thor/' || Current.BBSNAME || '_C.cfg'
  62.  
  63. /* default path & default KeepDays */
  64. GETGLOBALCONFIG stem GLOBALDATA
  65.  
  66. if rc > 5 then signal error
  67.  
  68. AltPath = GLOBALDATA.SAVEDIR
  69.  
  70. if bittst(GLOBALDATA.FLAGS,GCB_IGNORE_KEEPTIME) then
  71.    GlbIgnoreKeepDays = true
  72.   else
  73.    GlbIgnoreKeepDays = false
  74.  
  75. /**/
  76.  
  77. call ReadConfig
  78. call Validate
  79.  
  80. /*
  81. ** 15-11-99 RequestInteger is trashing TAGS.0 if keyword 'var' is used!
  82. **          Using 'result' solves the error!
  83. */
  84. if SMonth = "" then do
  85.    REQUESTINTEGER MIN 1 MAX 12 TITLE '"Enter the Month number:"' BT '"Ok|Cancel"'
  86.  
  87.    if rc = 5 then ExitMsg('Cancel button pressed!')
  88.    if rc > 5 then signal error
  89.  
  90.    SMonth = result
  91. end
  92.  
  93. if SYear = "" then do
  94.    REQUESTINTEGER MIN 1978 MAX 2050 TITLE '"Enter the Year:"' BT '"Ok|Cancel"'
  95.  
  96.    if rc = 5 then ExitMsg('Cancel button pressed!')
  97.    if rc > 5 then signal error
  98.  
  99.    SYear = result
  100. end
  101.  
  102. LockGUI
  103.  
  104. address BBSREAD
  105.  
  106. GetConfList bbsname Current.BBSNAME stem ConfList
  107.  
  108. if rc > 5 then signal error
  109.  
  110. say ''
  111.  
  112. do k = 1 to ConfList.COUNT
  113.    CurrentConf = ConfList.k
  114.  
  115.    GETCONFDATA bbsname Current.BBSNAME confname CurrentConf stem ConfData
  116.  
  117.    if rc > 5 then signal error
  118.  
  119. /*
  120. ** Archive flag was a TAG in the external config file, now is set when
  121. **          KeepDays is not used neither in the conference nor in the global
  122. **          Thor's configuration!
  123. */
  124.    archive = false
  125.  
  126.    if bittst(ConfData.FLAGS,CDB_IGNORE_KEEPTIME) then
  127.       archive = true
  128.      else
  129.       if bittst(ConfData.FLAGS,CDB_BBS_KEEPTIME) & GlbIgnoreKeepDays then
  130.          archive = true
  131.  
  132.    index = SrcConf(CurrentConf)
  133.  
  134.    if index = 0 then
  135.       index = SrcConf("DEFAULT")
  136.  
  137.    if archive then do                            /* Archive, delete */
  138.       if symbol('Tags.index.PATH') ~= 'VAR' then
  139.          Tags.index.PATH = AltPath
  140.  
  141.       if Smonth < 10 then
  142.          SaveFile = Tags.index.PATH || '/' || trim(left(CurrentConf,22)) || '_' || '0' || SMonth || '-' || SYear
  143.         else
  144.          SaveFile = Tags.index.PATH || '/' || trim(left(CurrentConf,22)) || '_' || SMonth || '-' || SYear
  145.  
  146.       call SearchMsgs
  147.    end
  148.  
  149.    PACKDATAFILE  BbsName  '"' || Current.BBSNAME || '"',
  150.                  ConfName '"' || CurrentConf || '"',
  151.                  ShowProgress
  152.  
  153.    if rc > 5 then signal error
  154.  
  155. end
  156.  
  157. say ''
  158.  
  159. PACKDATAFILE  BbsName  '"' || Current.BBSNAME || '"',
  160.               EventData UserData KillData FileData,
  161.               ShowProgress
  162.  
  163. if rc > 5 then signal error
  164.  
  165. if address() ~= thorport then
  166.    address(thorport)
  167.  
  168. UnLockGUI
  169.  
  170. UPDATECONFWINDOW
  171.  
  172. if rc > 5 then signal error
  173.  
  174. if SavedDir ~= "" then
  175.    call Pragma(D,SavedDir)
  176.  
  177. exit 0
  178.  
  179. /* ...game over... */
  180.  
  181.  
  182.  
  183. /* Search loop in conference */
  184. SearchMsgs:
  185.    drop msgs.
  186.    Msgs.0  = 0
  187.    MsgsNum = 0
  188.  
  189.    do y = ConfData.FIRSTMSG to ConfData.LASTMSG
  190.       drop MsgHead.
  191.       ReadBRMessage bbsname  '"' || Current.BBSNAME || '"',
  192.                     confname '"' || CurrentConf || '"',
  193.                     msgnr y,
  194.                     headstem MsgHead datastem MsgData
  195.  
  196.       if rc > 5 then signal error
  197.  
  198.       if ~bittst(MsgData.FLAGS,MDB_DELETED) then do
  199.  
  200.          /* My tests proved that 'Marked' means 'Unread' :-| */
  201.          if ~bittst(MsgData.FLAGS,MDB_MARKED) & ~bittst(MsgData.FLAGS,MDB_SUPERMARKED) then do
  202.  
  203.             if symbol('MsgHead.CREATIONDATE') = "VAR" then do
  204.                Amiga2Date MsgHead.CREATIONDATE MsgD
  205.  
  206.                if rc > 5 then signal error
  207.  
  208.                if MsgD.month = SMonth & MsgD.year = SYear then do
  209.                   MsgsNum            = MsgsNum + 1
  210.                   Msgs.MsgsNum       = y
  211.                   Msgs.MsgsNum.flags = MsgData.FLAGS
  212.                end
  213.             end
  214.          end
  215.       end
  216.    end
  217.  
  218.    Msgs.0 = MsgsNum
  219.  
  220.    if Msgs.0 ~= 0 then do
  221.  
  222.        do i = 1 to Msgs.0
  223.           call GMarchive.thor Current.BBSNAME CurrentConf Msgs.i SaveFile
  224.  
  225.           if result > 0 then signal error
  226.  
  227.           if ~bittst(Msgs.i.flags,MDB_KEEP) & Tags.index.KEEP = false then do
  228.              UpdateBRMessage bbsname  '"' || Current.BBSNAME || '"',
  229.                              confname '"' || CurrentConf || '"',
  230.                              msgnr Msgs.i,
  231.                              SetDeleted
  232.  
  233.              if rc > 5 then signal error
  234.           end
  235.        end
  236.    end
  237. return
  238.  
  239.  
  240.  
  241. /* Searches the conference in the config
  242. **  parm1   conference to be searched
  243. **
  244. **  returns the index or 0 if not found
  245. */
  246. SrcConf:
  247.    cnfr = upper(arg(1))
  248.  
  249.    do i = 1 to Tags.0
  250.       CONF = cnfr
  251.  
  252.       if Tags.i.PAT = 0 then do
  253.  
  254.          if CONF = Tags.i then return i
  255.  
  256.         end
  257.         else do
  258.          select
  259.             when Tags.i.PAT = 1 then do
  260.                  CONF = left(CONF, length(Tags.i))
  261.  
  262.                  if CONF = Tags.i then return i
  263.  
  264.             end
  265.             when Tags.i.PAT = 2 then do
  266.                  CONF = right(CONF, length(Tags.i))
  267.  
  268.                  if CONF = Tags.i then return i
  269.  
  270.             end
  271.             when Tags.i.PAT = 3 then do
  272.  
  273.                  if index(CONF, Tags.i) > 0 then return i
  274.  
  275.             end
  276.          end
  277.       end
  278.    end
  279.  
  280. return 0
  281.  
  282.  
  283.  
  284. Validate:
  285.  
  286.    do i = 1 to Tags.0
  287.  
  288.       do y = 1 to NumOpts
  289.          Opt = upper(word(TagOptions, y))
  290.          OptDef = symbol('Tags.i.Opt')
  291.  
  292.          Select
  293.              When find(upper(TagOptsBlk),Opt) > 0 then
  294.                if OptDef ~= 'VAR' then Tags.i.Opt = ''
  295.              When find(upper(TagOptsZro),Opt) > 0 then
  296.                if OptDef ~= 'VAR' then Tags.i.Opt = 0
  297.              Otherwise
  298.                if OptDef ~= 'VAR' then call ExitMsg("'" || Opt || "' not defined in tag '" || Tags.i || "'")
  299.          end
  300.  
  301.       end
  302.    end
  303.  
  304. return
  305.  
  306.  
  307.  
  308. /* Initialization */
  309. Init:
  310.    p = ' ' || address() || ' ' || show('P',,)
  311.    thorport = pos(' THOR.',p)
  312.  
  313.    if thorport > 0 then
  314.       thorport = word(substr(p,thorport+1),1)
  315.      else
  316.       ExitMsg('This script must be called from THOR!')
  317.  
  318.    /* Load bbsread.library if necessary */
  319.    if ~show('p', 'BBSREAD') then do
  320.        address command
  321.        'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  322.        'WaitForPort BBSREAD'
  323.    end
  324.  
  325.    TPath = GetClip('ThorPath')
  326.  
  327.    if TPath = "" then do
  328.       address command 'RXSET ThorPath="`GetEnv THOR/THORPath`"'
  329.       TPath = GetClip('ThorPath')
  330.    end
  331.  
  332.    if right(TPath,1) ~= ":" & right(TPath,1) ~= "/" then
  333.       TPath = TPath || "/"
  334.  
  335.    SavedDir = pragma(D,TPath || "rexx")
  336.  
  337.    if SMonth ~= "" then
  338.       if SMonth < 1 | SMonth > 12 then
  339.          call ExitMsg(SMonth "is not a valid month!")
  340.  
  341.    if SYear ~= "" then
  342.       if Syear < 1978 | SYear > 2050 then
  343.          call ExitMsg(SYear "is not a valid year!")
  344.  
  345.    /* from $VER: GlobalDefs.br 4.2 (9.9.97) */
  346.    /* Bit numbers for message flags */
  347.    MDB_READ          =  0   /* Message is read. */
  348.    MDB_REPLIED       =  1   /* Message is replied. */
  349.    MDB_PRIVATE       =  2   /* Message is private. */
  350.    MDB_TO_USER       =  3   /* Message is to the user. */
  351.    MDB_FROM_USER     =  4   /* Message is from the user. */
  352.    MDB_DELETED       =  5   /* Message is deleted. */
  353.    MDB_UNRECOVERABLE =  6   /* Message is can not be undeleted. */
  354.    MDB_KEEP          =  7   /* Keep message. Message will not be deleted during conference packing. */
  355.    MDB_TO_ALL        =  8   /* Message is to all. (has no reciever) */
  356.    MDB_XPK_TEXT      =  9   /* Message text is Xpk'ed. (Private flag) */
  357.    MDB_MARKED        = 10   /* Message is marked.  */
  358.    MDB_URGENT        = 11   /* Message is urgent.  */
  359.    MDB_IMPORTANT     = 12   /* Message is important. */
  360.    MDB_SUPERMARKED   = 13   /* Message will not be unmarked as long as this flag is set. */
  361.    MDB_BINARY_PARTS  = 14   /* Message contains 1 or more binary parts. */
  362.    MDB_TEXT_PARTS    = 15   /* Message contains 1 or more extra text parts. */
  363.        /* These two flags does also concern possible message parts. */
  364.    MDB_MESSAGE_PARTS = 16   /* Message contains 1 or more message parts. */
  365.    MDB_HAZE_BIT0     = 24   /* Message haze level bit 0. */
  366.    MDB_HAZE_BIT1     = 25   /* Message haze level bit 1. */
  367.  
  368.    /* Bit numbers for conference data */
  369.    CDB_BBS_KEEPMSG         = 9   /* Use bbs KeepMsg. */
  370.    CDB_BBS_KEEPTIME        = 10  /* Use bbs KeepTime. */
  371.    CDB_IGNORE_KEEPMSG      = 11  /* Don't count messages when packing conference. */
  372.    CDB_IGNORE_KEEPTIME     = 12  /* Don't check time when packing conference. */
  373.  
  374.    /* Bit numbers for global data flags */
  375.    GCB_IGNORE_KEEPMSG     = 0   /* Don't count messages when packing conferences. */
  376.    GCB_IGNORE_KEEPTIME    = 1   /* Don't check time when packing conferences. */
  377.  
  378.    true  = 1
  379.    false = 0
  380.  
  381.    /* This tags can be omitted, default will be "blank" */
  382.    TagOptsBlk = "Path"
  383.  
  384.    /* This tags can be omitted, default will be "zero" */
  385.    TagOptsZro = "Keep"
  386.  
  387.    TagOptions = "" TagOptsBlk TagOptsZro     /* no tags are required... */
  388.    NumOpts = words(TagOptions)
  389. return
  390.  
  391.  
  392.  
  393. ReadConfig:
  394.     /* Tags.0 will contains the Conference numbers, Tags.X will be the
  395.     **        Conference name (without the "*" if used...)
  396.     ** Tags.X.y will be defined as follow:
  397.     **     Tags.X.Path     Full path where msgs will be saved, default is "Thor Save Dir"
  398.     **     Tags.X.Keep     if msg saved: 1 = do not delete msg 0 = delete it (default 0)
  399.     **     Tags.X.Pat      internal field: 0=no pattern, 1=on right, 2=on left, 3=both
  400.     */
  401.     drop Tags.
  402.     Tags.0  = 0
  403.     TagsNum = 0
  404.  
  405.     CfgOpen = open(cfgfile,ConfigFile,'r')
  406.  
  407.     if ~(CfgOpen) then call ExitMsg('Reading: failed to open' ConfigFile)
  408.  
  409.     do until eof(cfgfile)
  410.         nextline = readln(cfgfile)
  411.  
  412.         if compress(nextline) = "" then iterate
  413.  
  414.         parse var nextline CfgName CfgVal
  415.         CfgName = upper(CfgName)
  416.         CfgVal  = strip(compress(CfgVal,'"'))
  417.  
  418.         if CfgName = 'TAG' then do
  419.            TagsNum = TagsNum + 1
  420.  
  421.            pattern = 0
  422.  
  423.            if right(CfgVal,1) = '*' then
  424.               pattern = pattern +1
  425.  
  426.            if left(CfgVal,1) = '*' then
  427.               pattern = pattern +2
  428.  
  429.            CfgVal = compress(CfgVal,'*')
  430.            Tags.TagsNum.PAT = pattern
  431.  
  432.            Tags.TagsNum = upper(CfgVal)
  433.          end
  434.          else do
  435.  
  436.            if TagsNum = 0 then call ExitMsg('No Tag names found!')
  437.  
  438.            if find(upper(TagOptions), CfgName) > 0 then
  439.               Tags.TagsNum.CfgName = CfgVal
  440.              else
  441.               call ExitMsg("Option '" || CfgName || "' (with value '" || CfgVal || "') in tag '" || Tags.TagsNum || "' not allowed!")
  442.         end
  443.     end
  444.  
  445.     if TagsNum = 0 then call ExitMsg('No Tag names found!')
  446.  
  447.     Tags.0 = TagsNum
  448.  
  449.     if (CfgOpen) then dummy = close(cfgfile)
  450. return
  451.  
  452.  
  453.  
  454. /* Exit with a message */
  455. ExitMsg:
  456.     parse arg msgstr
  457.  
  458.     if thorport > 0 then do
  459.  
  460.        if address() ~= thorport then
  461.           address(thorport)
  462.  
  463.        UnLockGUI
  464.     end
  465.  
  466.     if SavedDir ~= "" then
  467.        call Pragma(D,SavedDir)
  468.  
  469.     address command
  470.     'RequestChoice >NIL: "GMCleanConf.thor" "'msgstr'" "OK :-("'
  471. exit
  472.  
  473.  
  474.  
  475. error:
  476. syntax:
  477. BEAK_C:
  478. FAILURE:
  479. HALT:
  480.  
  481.     if SavedDir ~= "" then
  482.        call Pragma(D,SavedDir)
  483.  
  484.     say '|'
  485.     say '|' VerStr
  486.     say '| ***BREAK: error at' sigl ',' rc ',' ErrorText(rc)
  487.  
  488.     if symbol('THOR.LASTERROR') = 'VAR' then do
  489.        say '|'
  490.        say '| * Thor.LastError    =' THOR.LASTERROR
  491.     end
  492.  
  493.     if symbol('BBSREAD.LASTERROR') = 'VAR' then do
  494.        say '|'
  495.        say '| * BBSread.LastError =' BBSREAD.LASTERROR
  496.     end
  497.  
  498.     if address() ~= thorport then
  499.        address(thorport)
  500.  
  501.     UnLockGUI
  502. exit rc
  503.  
  504.