
<<-- File: SortMail.mesa>>
<<-- A program to sort laurel mail files in chronological order>>
<<-- Jorge Stolfi August 16, 1982 9:39 pm>>

DIRECTORY
  IO USING
      [CreateFileStream, STREAM, GetRope, PutBlock, GetBlock,
       GetLength, Close, PutF, int, rope, EndOfStream, BreakProc, EndOf,
       GetIndex, SetIndex, CR, GetToken],
  UserExec USING [ExecHandle, GetExecHandle],
  System USING [GreenwichMeanTime, SecondsSinceEpoch],
  DateAndTime USING [Parse],
  List USING [Sort, Comparison, less, equal, greater],
  Rope USING [ROPE, ToRefText, SkipTo, Equal, Substr, Cat, Length];

SortMail: CEDAR PROGRAM
  IMPORTS IO, DateAndTime, System, Rope, UserExec, List =

BEGIN OPEN Rope;

Error: ERROR [what: ROPE] = CODE;

DoSortMail: PROC =
BEGIN OPEN IO;

Message: TYPE = RECORD
  [index: INT, length: INT, time: Time];

Mess: TYPE = LIST OF REF ANY; -- actually REF Message

Time: TYPE = System.GreenwichMeanTime;

exec: UserExec.ExecHandle = UserExec.GetExecHandle[]; 

GetFileNames: PROC RETURNS [inn, outn: ROPE] =
BEGIN
  dotp: INT;
  root: ROPE;
  
  inn _ exec.commandLineStream.GetToken[];
  dotp _ SkipTo[inn, 0, "."];
  root _ Substr[inn, 0, dotp];

  outn _ exec.commandLineStream.GetToken[! IO.EndOfStream => CONTINUE];
  IF dotp = Length[inn] THEN {inn _ Cat[inn, ".mail"]};
  IF outn = NIL THEN outn _ inn ELSE
    {dotp _ SkipTo[outn, 0, "."];
      IF dotp = Length[outn] THEN {outn _ Cat[outn, ".mail"]}}
END;

BreakInputFile: PROC [in: STREAM] RETURNS
   [mess: Mess, nMess: INT] =
BEGIN
  -- Breaks input file into messages, finds and parse dates, builds list of descriptors
  -- Returns also number of messages
  
  lastMess: Mess _ NIL;
  genesis: Time = [0]; -- meaning january 1, 1968 00:00:00
  line: ROPE;
  ms: REF Message _ NIL;
  flf: BOOL _ TRUE; -- true for the first line in the file only
  undated: BOOL;
  
  EOLBreak: IO.BreakProc =
    {RETURN [IF c=CR THEN StopAndIncludeChar ELSE KeepGoing]};
  
  NoSkip: IO.BreakProc =
    {RETURN [KeepGoing]};
  
  IsFirstLine: PROC [ln: ROPE] RETURNS [isFirst: BOOL] =
    {RETURN [Rope.Equal[ln, "*start*\n"]]};
  
  IsDateLine: PROC [ln: ROPE] RETURNS [isFirst: BOOL] =
    {RETURN [Rope.Equal[Substr[ln, 0, 6], "Date: "]
            OR Rope.Equal[Substr[ln, 0, 7], "@Date: "]]};
  
  ParseDateLine: PROC [ln: ROPE] RETURNS [t: Time] = TRUSTED
    {pos: INT = Rope.SkipTo[ln, 0, ":"];
     tx: REF TEXT = Rope.ToRefText[Substr[ln, pos+1, Length[ln]-pos-2]];
     RETURN [DateAndTime.Parse [LOOPHOLE[tx]].dt]};
  
  -- initialize
  mess _ NIL; nMess _ 0;
  WHILE NOT in.EndOf [] DO
  line _ in.GetRope[break: EOLBreak, skipWhile: NoSkip];
  IF flf THEN
    {IF NOT IsFirstLine[line] THEN
        ERROR Error ["Missing '*start*' of first message"]};
  IF IsFirstLine[line] THEN
     {-- make descriptor for message
      ms _ NEW [Message _
          [index: in.GetIndex[] - Length[line],
           length: 0,
           time: genesis]];
      IF mess = NIL THEN
         {mess _ lastMess _ LIST [ms]}
      ELSE
         {lastMess.rest _ LIST [ms]; lastMess _ lastMess.rest};
      nMess _ nMess + 1;
      undated _ TRUE
      }
  ELSE
      {IF flf THEN ERROR Error ["Missing '*start*' of first message"];
       IF IsDateLine [line] AND undated THEN
          {ms.time _ ParseDateLine [line]; undated _ FALSE}
       };
  ms.length _ ms.length + Length[line];
  flf _ FALSE;
   ENDLOOP
END;

SortMessages: PROC [mess: Mess] RETURNS [sortedMess: Mess] =
BEGIN OPEN List;
  -- Sorts message list
  
  Earlier: PROC[x: REF ANY, y: REF ANY] RETURNS [Comparison] = TRUSTED
     {xm: REF Message = NARROW[x];
      ym: REF Message = NARROW[y];
      xt: LONG CARDINAL = System.SecondsSinceEpoch[xm.time];
      yt: LONG CARDINAL = System.SecondsSinceEpoch[ym.time];
      RETURN [IF xt < yt THEN less ELSE IF xt = yt THEN equal ELSE greater]};
   
  sortedMess _ List.Sort [mess, Earlier]
END;

CopyOutMess: PROC [in: STREAM, mess: Mess, out: STREAM] =
BEGIN
  bufLen: INT = 2000;
  tx: REF TEXT = NEW [TEXT [bufLen]];
  ms: REF Message;
  toRead, blkLen: INT;
  
  -- copy messages to output file
  WHILE mess # NIL DO
    ms _ NARROW [mess.first]; mess _ mess.rest;
    -- set index of input to start of message
    in.SetIndex [ms.index];
    -- read and write out message
    toRead _ ms.length;
    WHILE toRead # 0 DO
       blkLen_ MIN [bufLen, toRead];
       IF blkLen # in.GetBlock
           [block: tx, startIndex: 0, stopIndexPlusOne: blkLen] THEN
         ERROR Error ["Mismatch in message length"];
       out.PutBlock [block: tx, startIndex: 0, stopIndexPlusOne: blkLen];
       toRead _ toRead - blkLen
      ENDLOOP;
    IF tx[blkLen-1] # CR THEN
      ERROR Error ["Message does not end with CR"]
   ENDLOOP
 END;

-- Do it all

BEGIN
  inn, outn: ROPE;
  in, out: STREAM;
  mess, sMess: Mess;
  nMess: INT;
  [inn, outn] _ GetFileNames[];
  in _ CreateFileStream [inn, read, oldOnly];
  [mess, nMess] _ BreakInputFile [in];
  sMess _ SortMessages [mess];
  out _ CreateFileStream [outn, write];
  CopyOutMess [in, mess, out];
  exec.out.PutF ["%g messages (%g characters) written to %g\n",
       int[nMess], int[out.GetLength[]], rope[outn]];
  IF in.GetLength[] # out.GetLength[] THEN ERROR Error ["File length mismatch"];
  Close [out]; Close[in]
END
END;

DoSortMail[]

END...