home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 6 / AACD06.ISO / AACD / Online / GMSuite / Rexx / GMarchive.thor next >
Text File  |  2000-01-23  |  11KB  |  367 lines
  1. /*
  2. ** $VER: GMarchive.thor 5.003 (23.01.00)
  3. **       © Gian Maria Calzolari <gcalzo@geocities.com>
  4. **
  5. **  FUNCTION:
  6. **      Message(s) archivier for Thor
  7. **
  8. **      Parameters:
  9. **        <none>    to save the currently selected msg (useful as a Rexx menu script)
  10. **
  11. **          or
  12. **
  13. **        BBSNAME   This is the System name, required
  14. **        CONFNAME  This is the Conference name, required
  15. **        MSGNUM    This is the Message Number, required
  16. **        ARCFILE   This is the fully qualified file, default is THOR's Save dir
  17. **                    plus 'GM' plus first_14_chars_of_subject plus '.txt'
  18. **                    if there is no subject name is 'GMarchivedMsgs.txt'
  19. **                    If file already exists the message is appended
  20. **        EXTRACOMM Switch to save *all* the message's comments, default to save
  21. **                    only the basic ones
  22. **
  23. ** $HISTORY:
  24. **
  25. ** 23 Jan 2000 : 005.003 : Nothing, bumped up rev
  26. ** 07 Jan 2000 : 005.002 : Nothing, bumped up rev
  27. ** 21 Dec 1999 : 005.001 : Nothing, bumped up rev
  28. ** 17 Nov 1999 : 005.000 : Bumped up rev for consistency with first aminet
  29. **                         release of GMsuite!
  30. **                         Added flags 'Marked' and 'SuperMarked' but they mean
  31. **                         'Unread' and 'SuperUnread'!
  32. ** 16 Nov 1999 : 002.004 : tried to add flag 'UnRead' but it doesn't work!
  33. ** 15 Nov 1999 : 002.003 : Msg flags are now correctly printed for the 'main'
  34. **                         msg only
  35. ** 14 Nov 1999 : 002.002 : changed the way parms are checked to allow use
  36. **                         from Thor Rexx menu and changed the default filename
  37. ** 08 Nov 1999 : 002.001 : ExtraComments is now a parameter
  38. ** 07 Nov 1999 : 002.000 : First working version! :-))
  39. ** 31 Oct 1999 : 001.004 : Thor conversion started...
  40. ** 10 Jan 1999 : 001.003 : Last EMS version
  41. **
  42. */
  43.  
  44. signal on syntax
  45.  
  46. parse upper arg arguments
  47.  
  48. call Init
  49.  
  50. drop HeadS.
  51. drop TextS.
  52. drop DataS.
  53.  
  54. address BBSREAD
  55.  
  56. ReadBRMessage bbsname  '"' || opts.BBSNAME || '"',
  57.               confname '"' || opts.CONFNAME || '"',
  58.               msgnr opts.MSGNUM,
  59.               headstem HeadS textstem TextS datastem DataS
  60.  
  61. if rc > 5 then signal error
  62.  
  63. /* let's create a meaningfull filename... */
  64. if symbol('opts.ARCFILE') ~= "VAR" then
  65.  
  66.    if symbol('HeadS.SUBJECT') = "VAR" then
  67.       opts.ARCFILE = AltPath || "/" || 'GM' || trim(left(translate(HeadS.SUBJECT, '', ' :/;,*()?`#[]<>~|$%"', '_'),14)) || '.txt'
  68.      else
  69.       opts.ARCFILE = AltPath || "/" || 'GMarchivedMsgs.txt'
  70.  
  71. if ~bittst(DataS.FLAGS,MDB_DELETED) then do
  72.  
  73.    if open( 'tempname', opts.ARCFILE, 'A') ~= 1 then
  74.       if open( 'tempname', opts.ARCFILE, 'W') ~= 1 then
  75.          call ExitMsg ("Can't open '" || opts.ARCFILE || "' file for output.")
  76.  
  77.    flgs = ''
  78.  
  79.    do k = 1 to flag.0
  80.  
  81.       if bittst(DataS.FLAGS, flag.k) then flgs = flgs flag.k.desc
  82.  
  83.    end
  84.  
  85.    call ShowMessagePart('', 'HEADS', 'TEXTS')
  86.  
  87.    call close('tempname')
  88. end
  89.  
  90. exit 0
  91.  
  92.  
  93.  
  94. /* Show message part, since parts can be recursive, this function is recursive!
  95. **
  96. **  parm1       left message indent, usually "" the first time and then incremented by a few blanks...
  97. **  parm2       HeadStem name
  98. **  parm3       TextStem name
  99. */
  100. ShowMessagePart:
  101.     procedure expose HeadS. TextS. tempname flgs do_cmt
  102.  
  103.     parse arg indent, hstem, tstem .
  104.  
  105.     lf = '0a'x
  106.  
  107.     from    = ""
  108.     addfrom = ""
  109.     to      = ""
  110.     addto   = ""
  111.     subject = ""
  112.     CrtDate = ""
  113.     TmpHdr  = ""
  114.  
  115.     if symbol(hstem'.FROMNAME') = "VAR" then
  116.        from = value(hstem'.FROMNAME')
  117.  
  118.     if symbol(hstem'.FROMADDR') = "VAR" then
  119.        addfrom = value(hstem'.FROMADDR')
  120.  
  121.     if symbol(hstem'.TONAME') = "VAR" then
  122.        to = value(hstem'.TONAME')
  123.  
  124.     if symbol(hstem'.TOADDR') = "VAR" then
  125.        addto = value(hstem'.TOADDR')
  126.  
  127.     if symbol(hstem'.SUBJECT') = "VAR" then
  128.        subject = value(hstem'.SUBJECT')
  129.  
  130.     if symbol(hstem'.CREATIONDATE') = "VAR" then do
  131.        Amiga2Date value(hstem'.CREATIONDATE') MsgD
  132.  
  133.        if rc > 5 then signal error
  134.  
  135.        CrtDate = MsgD.mday || '/' || MsgD.month || '/' || MsgD.year MsgD.hour || ':' || MsgD.min
  136.     end
  137.  
  138.     if from ~= "" | addfrom ~= "" then
  139.        TmpHdr =                 indent || "From   :" from "<" || addfrom || ">"
  140.     if to ~= "" | addto ~= "" then
  141.        TmpHdr = TmpHdr || lf || indent || "To     :" to "<" || addto   || ">"
  142.     if subject ~= "" then
  143.        TmpHdr = TmpHdr || lf || indent || "Subject:" subject
  144.     if CrtDate ~= "" then
  145.        TmpHdr = TmpHdr || lf || indent || "CrtDate:" CrtDate
  146.     if flgs ~= "" then
  147.        TmpHdr = TmpHdr || lf || indent || "Flags  :" flgs
  148.  
  149.     if length(TmpHdr) ~= 0 then do
  150.        call writeln('tempname', indent || "")
  151.  
  152.        if length(indent) = 0 then
  153.           call writeln('tempname', indent || "-------------------------- Archived Message ---------------------------")
  154.          else
  155.           call writeln('tempname', indent || "-------------------------- Message Part ---------------------------")
  156.  
  157.        call writeln('tempname', TmpHdr)
  158.  
  159.        if length(indent) = 0 then
  160.           call writeln('tempname', indent || "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -")
  161.          else
  162.           call writeln('tempname', indent || "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -")
  163.     end
  164.  
  165.     if do_cmt & symbol(tstem'.COMMENT.COUNT') = "VAR" then do
  166.        call writeln('tempname', indent || "Comment:")
  167.        cnt = value(tstem'.COMMENT.COUNT')
  168.  
  169.        do n=1 to cnt
  170.           call writeln('tempname', indent || value(tstem'.COMMENT.'n))
  171.        end
  172.  
  173.        call writeln('tempname', indent || "")
  174.     end
  175.  
  176.     if symbol(tstem'.TEXT.COUNT') = "VAR" then do
  177.        cnt = value(tstem'.TEXT.COUNT')
  178.  
  179.        do n=1 to cnt
  180.           call writeln('tempname', indent || value(tstem'.TEXT.'n))
  181.        end
  182.     end
  183.  
  184.     if symbol(tstem'.PART.COUNT') = "VAR" then do
  185.        parts = value(tstem'.PART.COUNT')
  186.  
  187.        do n=1 to parts
  188.  
  189.           if symbol(tstem'.PART.'n'.BINARY') = "VAR" then do                     /* Is it a binary part? */
  190.              call writeln('tempname', indent || "======")
  191.              call writeln('tempname', indent || "Binary:" '[' || value(tstem'.PART.'n'.BINARY')      || ']')
  192.              call writeln('tempname', indent || "BinDes:" '"' || value(tstem'.PART.'n'.BINARY.DESC') || '"')
  193.  
  194.              if do_cmt then do
  195.                 cnt = value(tstem'.PART.'n'.BINARY.COMMENT.COUNT')
  196.  
  197.                 do m=1 to cnt
  198.                    call writeln('tempname', indent || "BinCom:" value(tstem'.PART.'n'.BINARY.COMMENT.'m))
  199.                 end
  200.              end
  201.            end
  202.            else if(symbol(tstem'.PART.'n'.TEXT.COUNT') = "VAR") then do         /* Is it a text part? */
  203.              call writeln('tempname', indent || "")
  204.  
  205.              cnt = value(tstem'.PART.'n'.TEXT.COUNT')
  206.  
  207.              do m=1 to cnt
  208.                 call writeln('tempname', indent || "Text  :" value(tstem'.PART.'n'.TEXT.'m))
  209.              end
  210.  
  211.              if do_cmt then do
  212.                 cnt = value(tstem'.PART.'n'.TEXT.COMMENT.COUNT')
  213.  
  214.                 do m=1 to cnt
  215.                    call writeln('tempname', indent || "TxtCom:" value(tstem'.PART.'n'.TEXT.COMMENT.'m))
  216.                 end
  217.              end
  218.            end
  219.            else do                                                              /* It is a message part. */
  220.              flgs = ''
  221.              usestem = tstem'.PART.'n'.MSG'
  222.              call ShowMessagePart(indent || '  ', usestem, usestem)
  223.           end
  224.        end
  225.     end
  226.  
  227. return 0
  228.  
  229.  
  230.  
  231. /* pad a string with blank to the left
  232. **  parm1       string to be padded with blank
  233. **  parm2       new lenght
  234. */
  235. Pad:
  236. return left( arg(1) || copies(' ', arg(2) ), arg(2) )
  237.  
  238.  
  239.  
  240. /* Initialization */
  241. Init:
  242.    Template = 'BBSNAME/A,CONFNAME/A,MSGNUM/A/N,ARCFILE,EXTRACOMM/S'
  243.  
  244.    VerStr     = subword(sourceline(2),3)
  245.  
  246.    AddressSaved = address()
  247.  
  248.    p = ' ' || address() || ' ' || show('P',,)
  249.    thorport = pos(' THOR.',p)
  250.  
  251.    if thorport > 0 then
  252.       thorport = word(substr(p,thorport+1),1)
  253.      else
  254.       ExitMsg('This script must be called from THOR!')
  255.  
  256.    /* Load bbsread.library if necessary */
  257.    if ~show('p', 'BBSREAD') then do
  258.        address command
  259.        'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  260.        'WaitForPort BBSREAD'
  261.    end
  262.  
  263.    address(thorport)
  264.  
  265.    /* setting defaults */
  266.    GETGLOBALCONFIG stem GLOBALDATA
  267.  
  268.    if rc > 5 then signal error
  269.  
  270.    drop opts.
  271.  
  272.    opts.EXTRACOMM = 0
  273.    AltPath        = GLOBALDATA.SAVEDIR
  274.    /**/
  275.  
  276.    if compress(arguments) = "" then do               /* no parms, must be from Thor Rexx menu... */
  277.       CURRENTMSG stem MSG
  278.  
  279.       if rc > 5 then signal error
  280.  
  281.       opts.BBSNAME  = MSG.BBSNAME
  282.       opts.CONFNAME = MSG.CONFNAME
  283.       opts.MSGNUM   = MSG.MSGNR
  284.     end
  285.     else do                         /* probably from another script... */
  286.       address BBSREAD
  287.  
  288.       ReadArgs Template opts CMDLINE arguments
  289.  
  290.       if rc = 5 then call ExitMsg(arguments || '*N' || BBSREAD.LASTERROR || '*N' || "Template is:" Template)
  291.       if rc > 5 then signal error
  292.  
  293.    end
  294.  
  295.    if opts.EXTRACOMM = 0 then do_cmt = 0
  296.                          else do_cmt = 1
  297.  
  298.    /* from $VER: GlobalDefs.br 4.2 (9.9.97) */
  299.    /* Bit numbers for message flags */
  300.    MDB_READ          =  0   /* Message is read. */
  301.    MDB_REPLIED       =  1   /* Message is replied. */
  302.    MDB_PRIVATE       =  2   /* Message is private. */
  303.    MDB_TO_USER       =  3   /* Message is to the user. */
  304.    MDB_FROM_USER     =  4   /* Message is from the user. */
  305.    MDB_DELETED       =  5   /* Message is deleted. */
  306.    MDB_UNRECOVERABLE =  6   /* Message is can not be undeleted. */
  307.    MDB_KEEP          =  7   /* Keep message. Message will not be deleted during conference packing. */
  308.    MDB_TO_ALL        =  8   /* Message is to all. (has no reciever) */
  309.    MDB_XPK_TEXT      =  9   /* Message text is Xpk'ed. (Private flag) */
  310.    MDB_MARKED        = 10   /* Message is marked.  */
  311.    MDB_URGENT        = 11   /* Message is urgent.  */
  312.    MDB_IMPORTANT     = 12   /* Message is important. */
  313.    MDB_SUPERMARKED   = 13   /* Message will not be unmarked as long as this flag is set. */
  314.    MDB_BINARY_PARTS  = 14   /* Message contains 1 or more binary parts. */
  315.    MDB_TEXT_PARTS    = 15   /* Message contains 1 or more extra text parts. */
  316.        /* These two flags does also concern possible message parts. */
  317.    MDB_MESSAGE_PARTS = 16   /* Message contains 1 or more message parts. */
  318.    MDB_HAZE_BIT0     = 24   /* Message haze level bit 0. */
  319.    MDB_HAZE_BIT1     = 25   /* Message haze level bit 1. */
  320.  
  321.    flag.0       = 7
  322.    flag.1       = MDB_MARKED
  323.    flag.1.desc  = 'UnRead'
  324.    flag.2       = MDB_SUPERMARKED
  325.    flag.2.desc  = 'SuperUnRead'
  326.    flag.3       = MDB_READ
  327.    flag.3.desc  = 'Read'
  328.    flag.4       = MDB_PRIVATE
  329.    flag.4.desc  = 'Priv'
  330.    flag.5       = MDB_KEEP
  331.    flag.5.desc  = 'Keep'
  332.    flag.6       = MDB_URGENT
  333.    flag.6.desc  = 'Urg'
  334.    flag.7       = MDB_IMPORTANT
  335.    flag.7.desc  = 'Imp'
  336. return
  337.  
  338.  
  339.  
  340. /* Exit with a message */
  341. ExitMsg:
  342.     parse arg msgstr
  343.     address command
  344.     'RequestChoice >NIL: "GMarchive.thor" "'msgstr'" "OK :-("'
  345. exit
  346.  
  347.  
  348.  
  349. error:
  350. syntax:
  351.     say '|'
  352.     say '|' VerStr
  353.     say '| ***BREAK: error at' sigl ',' rc ',' ErrorText(rc)
  354.  
  355.     if symbol('THOR.LASTERROR') = 'VAR' then do
  356.        say '|'
  357.        say '| * Thor.LastError    =' THOR.LASTERROR
  358.     end
  359.  
  360.     if symbol('BBSREAD.LASTERROR') = 'VAR' then do
  361.        say '|'
  362.        say '| * BBSread.LastError =' BBSREAD.LASTERROR
  363.     end
  364.  
  365. exit rc
  366.  
  367.