-- MailStampFormat
-- Edited by Horning, January 18, 1978  10:00 AM.
-- Edited by Schroeder, February 24, 1981  5:14 PM.
-- Edited by Levin, February 25, 1981  9:55 AM.
-- Edited by Brotz, March 4, 1983  10:07 AM.

DIRECTORY
  Ascii USING [CR, NUL, SP],
  intCommon USING [user],
  MailParseDefs USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName,
    InitializeParse, maxRecipientLength, ParseError, ParseHandle, ParseNameList],
  mfD: FROM "MailFormatDefs" USING [],
  opD: FROM "OperationsDefs" USING [substringSeparator],
  String USING [AppendChar, AppendDecimal, AppendString, EquivalentString,
    StringBoundsFault, StringToNumber],
  vmD: FROM "VirtualMgrDefs" USING [TOCFixedPartPtr];

MailStampFormat: PROGRAM
  IMPORTS intC: intCommon, MailParseDefs, String
  EXPORTS mfD =

BEGIN


BogusNumber: ERROR = CODE;

ParseStamp: PUBLIC PROCEDURE
    [NextChar: PROC RETURNS [CHARACTER], tp: vmD.TOCFixedPartPtr]
  RETURNS [stampOk: BOOLEAN] =
-- Reads the stamp with NextChar and fills into the TOCFixedPart located by tp the
--   deleted, seen, mark, offsetToHeader, and textLength fields.  Leaves NextChar ready to
--   read the first character following the fixed part of the stamp.  Expects NextChar to
--   return a null character if no more characters remain to be gotten.  Returns FALSE if
--   could not parse a complete stamp.
BEGIN
startOfStamp: STRING = "*start*
"L;
i, j: CARDINAL;

ReadFive: PROCEDURE RETURNS [k: CARDINAL] =
  BEGIN
  char: CHARACTER;
  k _ 0;
  THROUGH [0 .. 5) DO
    IF (char _ NextChar[]) ~IN ['0 .. '9] THEN ERROR BogusNumber;
    k _ k * 10 + (char - '0);
    ENDLOOP;
  END;  -- of ReadFive --

FOR i IN [0 .. 8) DO IF startOfStamp[i] # NextChar[] THEN GOTO notAStamp; ENDLOOP;

i _ ReadFive[ ! BogusNumber => GOTO notAStamp];
IF NextChar[] # Ascii.SP THEN GOTO notAStamp;
j _ ReadFive[ ! BogusNumber => GOTO notAStamp];
IF NextChar[] # Ascii.SP THEN GOTO notAStamp;

SELECT NextChar[] FROM
  'D => tp.deleted _ TRUE;
  'U => tp.deleted _ FALSE;
  ENDCASE => GOTO notAStamp;

SELECT NextChar[] FROM
  'S => tp.seen _ TRUE;
  'U => tp.seen _ FALSE;
  ENDCASE => GOTO notAStamp;

tp.offsetToHeader _ j;
IF i < j THEN GOTO notAStamp;
tp.textLength _ i - j;
tp.mark _ NextChar[];
IF tp.mark = Ascii.NUL OR NextChar[] # Ascii.CR THEN GOTO notAStamp;
tp.bogus _ FALSE;
RETURN[TRUE];

EXITS
notAStamp => {tp.bogus _ TRUE; RETURN[FALSE]};
END; -- of ParseStamp --


CreateStamp: PUBLIC PROC [tp: vmD.TOCFixedPartPtr, PutChar: PROC [CHARACTER]] =
-- This procedure may be used to update an existing stamp. The code discriminates
--   new/old by the value of offsetToHeader in tp. This should accordingly be set to 0
--   when a wholly new stamp is wanted. The practical effects concern only the
--   offsetToHeader afterwards, which has its old value in the update case and a standard
--   value in the genuine create case.
BEGIN

BinDec: PROCEDURE [i: CARDINAL] =
  BEGIN
  n: CARDINAL _ 10000;
  j, k: CARDINAL;
  FOR k IN [0 .. 3] DO
    j _ 0;
    WHILE i >= n DO
      j _ j + 1;
      i _ i - n;
      ENDLOOP;
    PutChar['0 + j];
    n _ n / 10;
    ENDLOOP;
  PutChar['0 + i];
  END;  -- of BinDec --

fixedStamp: STRING = "*start*
"L;
stampLength: CARDINAL = 24; --REMEMBER TO UPDATE THIS IF FORMAT CHANGED!
i, j: CARDINAL;

FOR i IN [0 .. fixedStamp.length) DO
  PutChar[fixedStamp[i]];
  ENDLOOP;
IF tp.offsetToHeader = 0 THEN tp.offsetToHeader _ stampLength;
  --fixed length part of stamp; whole of a new one
j _ tp.offsetToHeader + tp.textLength;
BinDec[j]; PutChar[Ascii.SP]; --put out total text length
BinDec[tp.offsetToHeader]; PutChar[Ascii.SP]; --offset to header
PutChar[IF tp.deleted THEN 'D ELSE 'U];
PutChar[IF tp.seen THEN 'S ELSE 'U]; --but we may for seen ones
PutChar[tp.mark];
PutChar[Ascii.CR]; --fixed end
END;  -- of CreateStamp --


ParseHeaderForTOC: PUBLIC PROCEDURE
  [s: STRING, next: PROCEDURE RETURNS [CHARACTER]] =
-- Produces in 's' the TOC string that goes with the message whose characters 'next' is
--   prepared to deliver.
BEGIN
OPEN mfD;

discardS: STRING _ [0];
which: STRING;
ph: MailParseDefs.ParseHandle _ MailParseDefs.InitializeParse[next];
fromS: STRING _ [100];
toS: STRING _ [MailParseDefs.maxRecipientLength];
dateS: STRING _ [25];
subjS: STRING _ [250];
sender: STRING _ [MailParseDefs.maxRecipientLength];
useFromS: BOOLEAN _ FALSE;

StandardizeDate: PROCEDURE [s: STRING] =
  BEGIN
  AtomType: TYPE = {none, number, alpha};
  ix: CARDINAL _ 0;
  i: [1 .. 12];
  numbers: ARRAY [0 .. 1] OF [0 .. 31];
  numbersSeen: CARDINAL _ 0;
  atom: STRING = [3];
  month: CARDINAL _ 0;
  got: CARDINAL _ 0;
  months: ARRAY [1 .. 12] OF STRING = 
    ["Jan"L, "Feb"L, "Mar"L, "Apr"L, "May"L, "Jun"L,
     "Jul"L, "Aug"L, "Sep"L, "Oct"L, "Nov"L, "Dec"L];

  GetChar: PROCEDURE RETURNS [char: CHARACTER] = INLINE
    BEGIN
    IF ix >= s.length THEN RETURN[0C];
    char _ s[ix];
    ix _ ix + 1;
    END;  -- of GetChar --

  CollectAtom: PROCEDURE [out: STRING] RETURNS [type: AtomType] = INLINE
    BEGIN
    char: CHARACTER;

    Append: PROCEDURE =
      {IF out.length < out.maxlength THEN String.AppendChar[out, char]};

    out.length _ 0;
    type _ none;
    DO
      char _ GetChar[];
      SELECT char FROM
        0C => RETURN;
        IN ['0..'9] => IF type = alpha THEN EXIT ELSE {type _ number; Append[]};
        IN ['a .. 'z], IN ['A .. 'Z] =>
          IF type = number THEN EXIT ELSE {type _ alpha; Append[]};
        ENDCASE => IF type ~= none THEN RETURN;
      ENDLOOP;
    ix _ ix - 1;
    END; -- of CollectAtom --

  UNTIL got = 3 DO
    SELECT CollectAtom[atom] FROM
      alpha =>
        IF month = 0 THEN
          FOR i IN [1 .. 12] DO
            IF String.EquivalentString[months[i], atom] THEN
              {month _ i; got _ got + 1; EXIT};
            ENDLOOP;
      number =>
        IF numbersSeen < 2
          AND (numbers[numbersSeen] _ String.StringToNumber[atom, 10]) <= 31
          THEN {numbersSeen _ numbersSeen + 1; got _ got + 1};
      ENDCASE => EXIT;
    ENDLOOP;
  s.length _ 0;
  IF numbersSeen = 0 THEN GO TO GarbageDate;
  IF month = 0 THEN
    {IF numbersSeen < 2 OR (month _ numbers[0]) ~IN [1 .. 12]
      OR (i _ numbers[1]) ~IN [1 .. 31]
      THEN GO TO GarbageDate}
  ELSE IF (i _ numbers[0]) ~IN [1 .. 31] THEN GO TO GarbageDate;
  String.AppendString[s, months[month]]; IF month ~= 5 THEN String.AppendChar[s, '.];
  String.AppendChar[s, ' ];
  String.AppendDecimal[s, i];

  EXITS
  GarbageDate => String.AppendString[s, "bad date"L];
  END;  -- of StandardizeDate --

AppendToOrFrom: PROCEDURE =
  -- If mail is from self (stripping off possible host name and/or registry), append
  --   "To: <recipient>".
  BEGIN
  SELECT TRUE FROM
    fromS.length = 0 => String.AppendString[s, "????"L];
    String.EquivalentString[sender, intC.user.name] AND toS.length > 0 =>
      {String.AppendString[s, "To: "L]; String.AppendString[s, toS]};
    useFromS => String.AppendString[s, fromS];
    ENDCASE => String.AppendString[s, sender];
  END;  -- of AppendToOrFrom --

ProcessFrom: PROCEDURE[name, reg: STRING, ignored1, isNested: BOOLEAN]
  RETURNS [BOOLEAN] =
  BEGIN
  IF sender.length = 0 THEN
    BEGIN
    useFromS _ isNested;
    IF String.EquivalentString[reg, intC.user.registry] THEN reg.length _ 0;
    BEGIN ENABLE String.StringBoundsFault => GO TO Truncate;
    name.length _ MIN[name.length, sender.maxlength];
    String.AppendString[sender, name];
    IF reg.length # 0 THEN
      {String.AppendChar[sender, '.]; String.AppendString[sender, reg]};
    EXITS
    Truncate => NULL;
    END;
    END
  ELSE useFromS _ TRUE;
  RETURN[FALSE]
  END; -- of ProcessFrom --

GetFromFromS: PROCEDURE RETURNS [CHARACTER] =
  BEGIN
  IF fromSIndex >= fromS.length THEN RETURN[MailParseDefs.endOfInput];
  fromSIndex _ fromSIndex + 1;
  RETURN[fromS[fromSIndex - 1]];
  END;  -- of GetFromFromS --
  
fromSIndex: CARDINAL _ 0;
fromPH: MailParseDefs.ParseHandle;

DO
  IF ~MailParseDefs.GetFieldName[ph, s ! MailParseDefs.ParseError => EXIT] THEN EXIT;
  SELECT TRUE FROM
    String.EquivalentString[s, "From"L] => which _ fromS;
    String.EquivalentString[s, "To"L] => which _ toS;
    String.EquivalentString[s, "Date"L] => which _ dateS;
    String.EquivalentString[s, "Subject"L] => which _ subjS;
    ENDCASE => which _ discardS;
  MailParseDefs.GetFieldBody
    [ph, which, FALSE ! MailParseDefs.ParseError => CONTINUE];
  ENDLOOP;

fromPH _ MailParseDefs.InitializeParse[GetFromFromS];
MailParseDefs.ParseNameList[fromPH, ProcessFrom
  ! MailParseDefs.ParseError => {sender.length _ 0; useFromS _ TRUE; CONTINUE}];
MailParseDefs.FinalizeParse[fromPH];

s.length _ 0;
StandardizeDate[dateS];
String.AppendString[s, dateS];
String.AppendChar[s, opD.substringSeparator];
AppendToOrFrom[ ! String.StringBoundsFault => CONTINUE];
IF s.length = s.maxlength THEN s.length _ s.length - 1;
String.AppendChar[s, opD.substringSeparator];
IF s.length + subjS.length > s.maxlength THEN subjS.length _ s.maxlength - s.length;
String.AppendString[s, subjS];
MailParseDefs.FinalizeParse[ph];
END;  -- of ParseHeaderForTOC --


END. -- of MailStampFormat --z19932(635)\f1