DECLARE FUNCTION GetAddress$ (in$)
DECLARE FUNCTION StripCR$ (aline$)
DECLARE SUB MessageHeader (contents$)


ver$ = "2.4"
DIM sep$(7)

' List of seperators to use.

sep$(1) = STRING$(30, "-")
sep$(2) = STRING$(70, "-")
sep$(3) = STRING$(76, "=")
sep$(4) = "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D="
sep$(5) = "=3D"
sep$(6) = STRING$(70, "-")
sep$(7) = STRING$(72, "_")

DIM SHARED from$

IF INSTR(COMMAND$, "/CHECK") > 0 THEN quiet = 0 ELSE quiet = 1

' remove anything after / on the command line

slashpos = INSTR(COMMAND$, "/")
IF slashpos > 0 THEN
   filename$ = LEFT$(COMMAND$, slashpos - 1)
ELSE
   filename$ = COMMAND$
END IF

' take the second filename if there is more than one ...

spacepos = INSTR(filename$, " ")
IF spacepos > 0 THEN
   outdir$ = LEFT$(filename$, spacepos - 1)
   filename$ = MID$(filename$, spacepos + 1)
ELSE
   outdir$ = ""
   SCREEN 80, 43
   CLS
   PRINT "DIGESTER Version " + ver$ + ", 3-01-2001"
   PRINT
   PRINT "Written by Stephen Knight <info@dragon-it.co.uk>"
   PRINT "http://www.dragon-it.co.uk/"
   PRINT
   PRINT "You have not specified a destination directory!"
   PRINT
   PRINT "You need to call this program with two arguments :"
   PRINT
   PRINT "eg DIGESTER c:\pmail\mail 32424232.tmp"
   PRINT
   PRINT "The first paramater is your new mail directory and should be added onto"
   PRINT "the command line of digester in your filter rules.  The second is the filename"
   PRINT "of the message to convert and is added automatically by Pegasus."
   PRINT
   PRINT "Version 1.2 cuts down no. of lines scanned for sub-headers so very"
   PRINT "short messages aren't joined with the next one / blank lines removed."
   PRINT "Also checks for :on from line to stop picking out normal text with a"
   PRINT "from at the beginning of a line and converting that too."
   PRINT ""
   PRINT "Version 2.0 now creates true MIME digests for use with Pegasus's"
   PRINT "built in MIME digest viewer."
   PRINT
   PRINT "Version 2.1 comments out existing Content-Type headers put in by some"
   PRINT "ISP's or list servers which get picked up instead of the Digest type. It"
   PRINT "also adds a second reply Mailto: line to reply to the originating list."
   PRINT
   PRINT "Version 2.2 now ignores more signatures / instances where a message"
   PRINT "contains a line of dashes which is the same as the message seperator."
   PRINT
   PRINT "Version 2.3 has further message seperators such as line of = signs."
   PRINT
   PRINT "Press any key to exit"
   SLEEP
   SCREEN 80, 25
   END
END IF

IF outdir$ <> "" AND RIGHT$(outdir$, 1) <> "\" THEN outdir$ = outdir$ + "\"

'split off filename

outname$ = RIGHT$(LEFT$(filename$, INSTR(filename$, ".") - 1), 8)
slashpos = INSTR(outname$, "\")
IF slashpos > 0 THEN outname$ = MID$(outname$, slashpos + 1)

' Change first letter of filename to ! to make file already read.
MID$(outname$, 1, 1) = "!"
outname$ = outdir$ + outname$ + ".cnm"

PRINT "DIGESTER Version " + ver$ + ", 3-01-2001"
PRINT
PRINT "Converting digest from "; filename$; " to "; outname$
PRINT
PRINT "Written by Stephen Knight <info@dragon-it.co.uk>"
PRINT "http://www.dragon-it.co.uk/"
PRINT
PRINT "v2.4 adds support for Yahoo Groups messages using double underscore lines"
PRINT

OPEN filename$ FOR INPUT AS #1
OPEN outname$ FOR OUTPUT AS #2

   ' Search until end of headers (blank row) to grab message info.
   DO
      LINE INPUT #1, line1$
      IF LCASE$(LEFT$(line1$, 4)) = "from" THEN
         from$ = LTRIM$(MID$(line1$, 6))
      END IF
      IF LCASE$(LEFT$(line1$, 7)) = "subject" THEN
         subject$ = LTRIM$(MID$(line1$, 9))
         line1$ = "Subject: Converted " + subject$
      END IF
      IF LCASE$(LEFT$(line1$, 12)) = "content-type" THEN
         line1$ = "X-Comments: " + line1$
      END IF
      IF LCASE$(LEFT$(line1$, 3)) = "to:" THEN
         ListTo$ = LTRIM$(MID$(line1$, 4))
      END IF
      IF RTRIM$(line1$) <> "" THEN PRINT #2, line1$
   LOOP UNTIL RTRIM$(line1$) = ""

   PRINT #2, "MIME-Version: 1.0"
'   PRINT #2, "Content-Transfer-Encoding: quoted-printable"
   PRINT #2, "Content-type: Multipart/Digest; boundary=Message-Boundary-5383"
'   PRINT #2, "X-PMFLAGS: 570949760 0"
   PRINT #2, ""
   
' PM Flags are to say Multi-Part MIME message that has been read (so not re-
' filtered)  Now removed in favour of ! filename to say it has been read.

   MessageHeader subject$
   PRINT #2, ""
   ' ^^^ Blank line to signify end of headers and start of message.
  
   PRINT #2, "This digest file has been Multi-Part MIME'd"
   PRINT #2, "using DIGESTER v " + ver$ + " by Stephen Knight <info@dragon-it.co.uk>"
   PRINT #2, "http://www.dragon-it.co.uk/"
   PRINT #2, ""
  
   DO
      LINE INPUT #1, aline$
      SELECT CASE aline$

         CASE sep$(1), sep$(2), sep$(3), sep$(4), sep$(5), sep$(6), sep$(7)
            IF NOT EOF(1) THEN LINE INPUT #1, nextline$

            IF nextline$ <> "" AND nextline$ <> sep$(4) AND nextline$ <> sep$(7) THEN
               PRINT #2, aline$
               PRINT #2, nextline$
            ELSE
               IF nextline$ = sep$(4) OR nextline$ = sep$(7) THEN
                  DO
                     IF NOT EOF(1) THEN LINE INPUT #1, nextline$
                  LOOP UNTIL nextline$ = ""
               END IF

               ' has found blank line after dashed line == new message
               subjectline$ = "(unknown)": fromline$ = "?": dateline$ = ""
               title$ = ""
              
               'headerline = 1
              
               ' scan through headers of sub-message and next few lines
               ' and pickup subject, from etc. to include in mime header.
               firstline = 1
              
               MessageHeader ""
              
               DO
                  prevline$ = line1$
                  IF NOT EOF(1) THEN LINE INPUT #1, line1$
                  headcheck$ = LTRIM$(line1$)
                 
                  SELECT CASE LTRIM$(LCASE$(LEFT$(headcheck$, 5)))
                     CASE "*****"
                        ' Normally occurs at end of Digest.
                        title$ = ""
                        subjectline$ = "(unknown)"
                        dateline$ = ""
                        fromline$ = "?"
                        PRINT #2, "From: "; ListTo$
                        PRINT #2, "Subject: "; prevline$
                        PRINT #2, "Date : 31 Dec 2099 00:00:00 +0000"
                        PRINT #2, ""
                        PRINT #2, prevline$
                        PRINT #2, line1$
                     CASE "subje":
                        subjectline$ = LTRIM$(MID$(headcheck$, 9))
                     CASE "date:":
                        dateline$ = LTRIM$(MID$(headcheck$, 6))
                     CASE "from:":
                        fromline$ = LTRIM$(MID$(headcheck$, 6))
                     END SELECT
                  firstline = 0
               LOOP UNTIL EOF(1) OR line1$ = "" AND firstline <> 1
             
               ' Add additional headers.  Date / Reply-To / Subject will carry over
               ' when Reply button is pressed (when DH fixes it in 2.53!)
               ' Add reply buttons using mailto: link.
               ' Reply will reply to List, Reply + copy CC field will also go to sender.

               IF dateline$ <> "" THEN PRINT #2, "Date: " + dateline$
               IF subjectline$ <> "(unknown)" THEN PRINT #2, "Subject: " + subjectline$
               IF fromline$ <> "?" THEN
                  PRINT #2, "Reply-To: " + GetAddress$(ListTo$)
                  PRINT #2, "From: " + fromline$
                  PRINT #2, "CC: " + fromline$
                  PRINT #2, ""
                  PRINT #2, "Reply to Sender: mailto:" + GetAddress$(fromline$)
                  PRINT #2, "Reply to List: mailto:" + GetAddress$(ListTo$)
               END IF
               PRINT #2, ""

               IF quiet = 0 THEN PRINT "Message about "; subjectline$ + " from " + fromline$
               messages = messages + 1

               ' re-write the headers back out... From / Subject / Date will have
               ' been skipped and put in the mime headers instead.
               'FOR linenum = 1 TO headerline - 1
               '   PRINT #2, header$(linenum)
               'NEXT
            END IF
         CASE "-- End --"
            REM
         CASE ELSE
            PRINT #2, aline$
      END SELECT
   LOOP UNTIL EOF(1)

PRINT #2, ""
PRINT #2, "--Message-Boundary-5383--"
PRINT #2, ""
PRINT #2, "-- End --"
PRINT #2, ""

CLOSE #1, #2

IF quiet = 0 THEN PRINT "Found "; messages; " messages."

KILL filename$

FUNCTION GetAddress$ (in$)

leftbracket = INSTR(in$, "<")
IF leftbracket > 0 THEN
   rightbracket = INSTR(leftbracket + 1, in$, ">")
   IF rightbracket > 0 THEN
      GetAddress$ = MID$(in$, leftbracket + 1, rightbracket - leftbracket - 1)
   ELSE
      GetAddress$ = MID$(in$, leftbracket + 1)
   END IF
ELSE
   GetAddress$ = in$
END IF
    
END FUNCTION

SUB MessageHeader (contents$)

   PRINT #2, "--Message-Boundary-5383"
   PRINT #2, ""
   IF contents$ <> "" THEN
      PRINT #2, "From: " + from$
      PRINT #2, "Subject: " + contents$
      PRINT #2, "Date: Mon, 01 Jan 1980 00:00 +0000"
   END IF
END SUB

FUNCTION StripCR$ (aline$)

   IF RIGHT$(aline$, 1) = CHR$(13) OR RIGHT$(aline$, 1) = CHR$(10) THEN
      stripped$ = LEFT$(aline$, LEN(aline$) - 1)
   ELSE
      stripped$ = aline$
   END IF

   IF LEFT$(stripped$, 1) = CHR$(10) THEN
      stripped$ = MID$(stripped$, 1)
      PRINT "strip chr(10)"
   END IF

   StripCR$ = stripped$
END FUNCTION