MODULE FileStatus EXPORTS FileStatus, FileStatusRaw;

IMPORT
  FileAttr, Fmt, PathComp, Rd, SupMisc, Text, Thread, Time, TokScan, Wr;

REVEAL
  T = Public BRANDED OBJECT
    line: TEXT := NIL;
    ts: TokScan.T := NIL;
    lineNum := 0;
  END;

  Reader = RawRdPublic BRANDED OBJECT
  END;

  Writer = RawWrPublic BRANDED OBJECT
  END;

CONST
  Version = 5;  (* File format version number. *)

VAR (*CONST*)
  HugeText := Text.FromChars( ARRAY [0..15] OF CHAR{ LAST(CHAR), .. } );

Assumed to compare greater than any pathname component we might encounter.

PROCEDURE Compare(a, b: T): [-1..1] =
  VAR
    aName := a.name;
    bName := b.name;
  BEGIN
    IF a.type = Type.DirUp THEN
      aName := SupMisc.CatPath(aName, HugeText);
    END;
    IF b.type = Type.DirUp THEN
      bName := SupMisc.CatPath(bName, HugeText);
    END;
    RETURN SupMisc.PathCompare(aName, bName);
  END Compare;

PROCEDURE Equal(a, b: T): BOOLEAN =
  BEGIN
    RETURN Text.Equal(a.name, b.name)
      AND (a.type = Type.DirUp) = (b.type = Type.DirUp);
  END Equal;

PROCEDURE MakeCooked(fs: T; version: CARDINAL)
  RAISES {Error} =
  BEGIN
    IF fs.line = NIL THEN  (* Already cooked. *)
      RETURN;
    END;
    TRY
      CASE fs.type OF
      | Type.DirDown =>
	  (* Nothing to do. *)
      | Type.DirUp =>
	  IF version >= 5 THEN
	    fs.clientAttr := GetAttr(fs.ts, version, "directory attributes");
	  ELSE
	    fs.clientAttr := FileAttr.Bogus;
	  END;
	  fs.serverAttr := fs.clientAttr;
      | Type.CheckoutLive =>
	  fs.tag := fs.ts.getToken("tag");
	  fs.date := fs.ts.getToken("date");
	  fs.serverAttr := GetAttr(fs.ts, version, "server file attributes");
	  fs.revNum := fs.ts.getToken("revision number");
	  IF version >= 4 THEN
	    fs.revDate := fs.ts.getToken("revDate");
	  ELSE
	    fs.revDate := ".";
	  END;
	  fs.clientAttr :=
	    GetAttr(fs.ts, version, "client file attributes");
      | Type.CheckoutDead =>
	  fs.tag := fs.ts.getToken("tag");
	  fs.date := fs.ts.getToken("date");
	  fs.serverAttr := GetAttr(fs.ts, version, "server file attributes");
      | Type.FileLive =>
	  fs.clientAttr := GetAttr(fs.ts, version, "file attributes");
	  fs.serverAttr := fs.clientAttr;
      | Type.FileDead =>
	  fs.clientAttr := GetAttr(fs.ts, version, "file attributes");
	  fs.serverAttr := fs.clientAttr;
      END;
      fs.line := NIL;
      fs.ts := NIL;
    EXCEPT
    | Error(msg) =>
	RAISE Error(Fmt.Int(fs.lineNum) & ": " & msg);
    | TokScan.Error(msg) =>
	RAISE Error(Fmt.Int(fs.lineNum) & ": " & msg);
    END;
  END MakeCooked;

PROCEDURE GetAttr(ts: TokScan.T; version: CARDINAL; what: TEXT): FileAttr.T
  RAISES {Error, TokScan.Error} =
  BEGIN
    IF version < 3 THEN
      RETURN NEW(FileAttr.T).init(FileAttr.FileType.File,
	modTime := ts.getTime(what));
    ELSE
      TRY
	RETURN FileAttr.Decode(ts.getToken(what));
      EXCEPT
      | FileAttr.UnknownGroup(name) =>
	  RAISE Error("Unknown group name \"" & name & "\"");
      | FileAttr.UnknownOwner(name) =>
	  RAISE Error("Unknown user name \"" & name & "\"");
      END;
    END;
  END GetAttr;

TYPE
  RdReader = Reader OBJECT
    rd: Rd.T;
    vers: CARDINAL;
    time: Time.T;
    statusCode: CHAR;
    originHost: TEXT;
    delta: Time.T;
    lineNum := 0;
    comp: PathComp.Compressor := NIL;
    decomp: PathComp.Decompressor := NIL;
    previous: T := NIL;
    current: T := NIL;
    eofSeen := FALSE;
    depth: CARDINAL := 0;
  OVERRIDES
    version := RdVersion;
    get := RdGet;
    getRaw := RdGetRaw;
    prune := RdPrune;
    scanTime := RdScanTime;
    status := RdStatus;
    origin := RdOrigin;
    timeDelta := RdTimeDelta;
    close := RdClose;
  END;

PROCEDURE FromRd(rd: Rd.T): Reader
  RAISES {Error, Rd.Failure, Thread.Alerted} =
  VAR
    rr := NEW(RdReader, rd := rd);
    line: TEXT;
    ts: TokScan.T;
  BEGIN
    TRY
      TRY
	line := SupMisc.GetCmdLine(rd);
	INC(rr.lineNum);
	ts := TokScan.NewDec(line);
	ts.getLiteral("F");
	rr.vers := ts.getInt("file format version number");
	IF rr.vers < 1 OR rr.vers > Version THEN
	  RAISE Error("Invalid format version " & Fmt.Int(rr.vers));
	END;
	rr.time := ts.getTime("scan time");
	TRY
	  rr.statusCode := ts.getChar("status");
	  rr.originHost := ts.getToken("origin");
	  rr.delta := ts.getTime("timeDelta");
	EXCEPT TokScan.Error =>
	  rr.statusCode := '?';
	  rr.originHost := "?";
	  rr.delta := 0.0d0;
	END;
	IF rr.vers < 3 THEN  (* No explicit directories in the file. *)
	  rr.comp := NEW(PathComp.Compressor).init();
	  rr.decomp := NEW(PathComp.Decompressor).init();
	END;
	RETURN rr;
      EXCEPT
      | Rd.EndOfFile =>
	  RAISE Error("Premature EOF");
      | TokScan.Error(msg) =>
	  RAISE Error(msg);
      END;
    EXCEPT Error(msg) =>
      RAISE Error(Fmt.Int(rr.lineNum) & ": " & msg);
    END;
  END FromRd;

PROCEDURE RdClose(rr: RdReader)
  RAISES {Rd.Failure, Thread.Alerted} =
  BEGIN
    Rd.Close(rr.rd);
  END RdClose;

PROCEDURE RdGet(rr: RdReader): T
  RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  BEGIN
    WITH fs = rr.getRaw() DO
      MakeCooked(fs, rr.vers);
      RETURN fs;
    END;
  END RdGet;

PROCEDURE RdGetRaw(rr: RdReader): T
  RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR
    line: TEXT;
    typeCh: CHAR;
    pcType: PathComp.Type;
    pcName: TEXT;
  BEGIN
    TRY
      LOOP
	IF rr.comp # NIL THEN  (* Synthesizing directory entries. *)
	  (* If anything is queued up in the compressor, return it. *)
	  IF rr.comp.get(pcType, pcName) THEN
	    WITH fullName = rr.decomp.put(pcType, pcName) DO
	      CASE pcType OF
	      | PathComp.Type.DirDown =>
		  RETURN NEW(T,
		    type := Type.DirDown,
		    name := fullName,
		    line := "D " & fullName);
	      | PathComp.Type.DirUp =>
		  RETURN NEW(T,
		    type := Type.DirUp,
		    name := fullName,
		    line := "U " & fullName);
	      | PathComp.Type.File =>
		  <* ASSERT Text.Equal(fullName, rr.current.name) *>
		  rr.previous := rr.current;
		  rr.current := NIL;
		  RETURN rr.previous;
	      END;
	    END;
	  END;
	END;

	(* Get the next record from the file. *)
	IF rr.eofSeen THEN
	  IF rr.depth # 0 THEN
	    RAISE Error("File is truncated");
	  END;
	  RAISE Rd.EndOfFile;
	END;
	TRY
	  line := SupMisc.GetCmdLine(rr.rd);
	  INC(rr.lineNum);
	  rr.current := NEW(T,
	    line := line,
	    lineNum := rr.lineNum,
	    ts := TokScan.NewDec(line));

	  typeCh := rr.current.ts.getChar("file type");
	  rr.current.name := rr.current.ts.getToken("filename");

	  CASE typeCh OF
	  | 'D' =>
	      rr.current.type := Type.DirDown;
	      IF rr.comp # NIL THEN
		RAISE Error("Unexpected directory entry in version "
		  & Fmt.Int(rr.vers) & " file");
	      END;
	      INC(rr.depth);
	  | 'C' =>
	      rr.current.type := Type.CheckoutLive;
	      IF rr.vers < 2 THEN
		rr.current.name := SupMisc.RCSName(rr.current.name);
	      END;
	  | 'c' =>
	      rr.current.type := Type.CheckoutDead;
	      IF rr.vers < 2 THEN
		rr.current.name := SupMisc.RCSName(rr.current.name);
	      END;
	  | 'V' =>
	      rr.current.type := Type.FileLive;
	  | 'v' =>
	      rr.current.type := Type.FileDead;
	  | 'U' =>
	      rr.current.type := Type.DirUp;
	      IF rr.comp # NIL THEN
		RAISE Error("Unexpected directory entry in version "
		  & Fmt.Int(rr.vers) & " file");
	      END;
	      IF rr.depth <= 0 THEN
		RAISE Error("\"U\" entry has no matching \"D\"");
	      END;
	      DEC(rr.depth);
	  ELSE
	    RAISE Error("Invalid file type \"" & Text.FromChar(typeCh) & "\"");
	  END;

	  IF rr.previous # NIL AND Compare(rr.previous, rr.current) >= 0 THEN
	    RAISE Error("File is not sorted properly");
	  END;

	  IF rr.comp # NIL THEN  (* Synthesizing directory entries. *)
	    TRY
	      CASE rr.current.type OF
	      | Type.DirDown =>	pcType := PathComp.Type.DirDown;
	      | Type.DirUp =>	pcType := PathComp.Type.DirUp;
	      ELSE
		pcType := PathComp.Type.File;
	      END;
	      rr.comp.put(pcType, rr.current.name);
	    EXCEPT PathComp.Error(msg) =>
	      RAISE Error(msg);
	    END;
	  ELSE
	    rr.previous := rr.current;
	    rr.current := NIL;
	    RETURN rr.previous;
	  END;
	EXCEPT
	| Rd.EndOfFile =>
	    rr.eofSeen := TRUE;
	    IF rr.comp # NIL THEN
	      rr.comp.finish();
	    END;
	| TokScan.Error(msg) =>
	    RAISE Error(msg);
	END;
      END;
    EXCEPT Error(msg) =>
      RAISE Error(Fmt.Int(rr.lineNum) & ": " & msg);
    END;
  END RdGetRaw;

PROCEDURE RdPrune(rr: RdReader): T
  RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR
    fs: T;
    pruneDepth := rr.depth;
  BEGIN
    WHILE rr.depth >= pruneDepth DO
      fs := rr.getRaw();
    END;
    <* ASSERT fs.type = Type.DirUp *>
    MakeCooked(fs, rr.vers);
    RETURN fs;
  END RdPrune;

PROCEDURE RdScanTime(rr: RdReader): Time.T =
  BEGIN
    RETURN rr.time;
  END RdScanTime;

PROCEDURE RdStatus(rr: RdReader): CHAR =
  BEGIN
    RETURN rr.statusCode;
  END RdStatus;

PROCEDURE RdOrigin(rr: RdReader): TEXT =
  BEGIN
    RETURN rr.originHost;
  END RdOrigin;

PROCEDURE RdTimeDelta(rr: RdReader): Time.T =
  BEGIN
    RETURN rr.delta;
  END RdTimeDelta;

PROCEDURE RdVersion(rr: RdReader): CARDINAL =
  BEGIN
    RETURN rr.vers;
  END RdVersion;

PROCEDURE FromNull(): Reader =
  BEGIN
    RETURN NEW(Reader,
      version := NullVersion,
      scanTime := NullScanTime,
      get := NullGet,
      getRaw := NullGetRaw,
      close := NullClose);
  END FromNull;

PROCEDURE NullClose(<*UNUSED*> r: Reader) =
  BEGIN
  END NullClose;

PROCEDURE NullGet(<*UNUSED*> r: Reader): T
  RAISES {Rd.EndOfFile} =
  BEGIN
    RAISE Rd.EndOfFile;
  END NullGet;

PROCEDURE NullGetRaw(<*UNUSED*> r: Reader): T
  RAISES {Rd.EndOfFile} =
  BEGIN
    RAISE Rd.EndOfFile;
  END NullGetRaw;

PROCEDURE NullScanTime(<*UNUSED*> r: Reader): Time.T =
  BEGIN
    RETURN -1.0d0;
  END NullScanTime;

PROCEDURE NullVersion(<*UNUSED*> r: Reader): CARDINAL =
  BEGIN
    RETURN Version;
  END NullVersion;

TYPE
  WrWriter = Writer OBJECT
    wr: Wr.T;
    current: T := NIL;
    comp: PathComp.Compressor;
    decomp: PathComp.Decompressor;
    cannotWrite := FALSE;
  OVERRIDES
    version := WrVersion;
    put := WrPut;
    putRaw := WrPutRaw;
    close := WrClose;
  END;

PROCEDURE ToWr(wr: Wr.T; scanTime: Time.T): Writer
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    ww := NEW(WrWriter,
      wr := wr,
      comp := NEW(PathComp.Compressor).init(),
      decomp := NEW(PathComp.Decompressor).init());
  BEGIN
    SupMisc.PutCmd(wr, "F",
      Fmt.Int(Version),
      TokScan.EncodeTime(scanTime),
      encode := TRUE);
    RETURN ww;
  END ToWr;

PROCEDURE WrClose(ww: WrWriter)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    pcType: PathComp.Type;
    pcName: TEXT;
  BEGIN
    IF NOT ww.cannotWrite THEN
      (* Close off all the open directories. *)
      ww.comp.finish();
      WHILE ww.comp.get(pcType, pcName) DO
	WITH fullName = ww.decomp.put(pcType, pcName) DO
	  CASE pcType OF
	  | PathComp.Type.DirDown =>
	      SupMisc.PutCmd(ww.wr, "D",
		fullName,
		encode := TRUE);
	  | PathComp.Type.DirUp =>
	      SupMisc.PutCmd(ww.wr, "U",
		fullName,
		FileAttr.Encode(FileAttr.Bogus),
		encode := TRUE);
	  | PathComp.Type.File =>  (* Should never happen. *)
	      <* ASSERT FALSE *>
	  END;
	END;
      END;
    END;
    Wr.Close(ww.wr);
  END WrClose;

PROCEDURE WrPut(ww: WrWriter; fs: T)
  RAISES {Error, Thread.Alerted, Wr.Failure} =
  VAR
    pcType: PathComp.Type;
    pcName: TEXT;
    dirUpAttr: FileAttr.T;
  BEGIN
    IF ww.cannotWrite THEN  (* Don't even try. *)
      RETURN;
    END;
    IF ww.current # NIL THEN  (* Don't ever write the records out of order. *)
      <* ASSERT Compare(ww.current, fs) < 0 *>
    END;
    ww.current := fs;

    TRY
      (* Rather than rely on the proper DirDown and DirUp entries being
	 supplied, we synthesize them on our own.  This is necessary in
	 certain situations when we are reading from an older version of
	 the status file which did not have explicit directory entries. *)

      TRY
	dirUpAttr := FileAttr.Bogus;

	CASE fs.type OF
	| Type.DirDown =>
	    ww.comp.put(PathComp.Type.DirDown, fs.name);
	| Type.DirUp =>
	    ww.comp.put(PathComp.Type.DirUp, fs.name);
	    dirUpAttr := fs.clientAttr;
	ELSE
	  ww.comp.put(PathComp.Type.File, fs.name);
	END;

	WHILE ww.comp.get(pcType, pcName) DO
	  WITH fullName = ww.decomp.put(pcType, pcName) DO
	    CASE pcType OF
	    | PathComp.Type.DirDown =>
		SupMisc.PutCmd(ww.wr, "D",
		  fullName,
		  encode := TRUE);
	    | PathComp.Type.DirUp =>
		SupMisc.PutCmd(ww.wr, "U",
		  fullName,
		  FileAttr.Encode(dirUpAttr),
		  encode := TRUE);
		dirUpAttr := FileAttr.Bogus;
	    | PathComp.Type.File =>
		(* Just swallow it. *)
		<* ASSERT Text.Equal(fullName, fs.name) *>
	    END;
	  END;
	END;
      EXCEPT PathComp.Error(msg) =>
	RAISE Error(msg);
      END;

      CASE fs.type OF
      | Type.DirDown, Type.DirUp =>
	  (* Already emitted above. *)
      | Type.CheckoutLive =>
	  SupMisc.PutCmd(ww.wr, "C",
	    fs.name,
	    fs.tag,
	    fs.date,
	    FileAttr.Encode(fs.serverAttr),
	    fs.revNum,
	    fs.revDate,
	    FileAttr.Encode(fs.clientAttr),
	    encode := TRUE);
      | Type.CheckoutDead =>
	  SupMisc.PutCmd(ww.wr, "c",
	    fs.name,
	    fs.tag,
	    fs.date,
	    FileAttr.Encode(fs.serverAttr),
	    encode := TRUE);
      | Type.FileLive =>
	  SupMisc.PutCmd(ww.wr, "V",
	    fs.name,
	    FileAttr.Encode(fs.clientAttr),
	    encode := TRUE);
      | Type.FileDead =>
	  SupMisc.PutCmd(ww.wr, "v",
	    fs.name,
	    FileAttr.Encode(fs.clientAttr),
	    encode := TRUE);
      END;
    EXCEPT Wr.Failure(l) =>
      ww.cannotWrite := TRUE;
      RAISE Wr.Failure(l);
    END;
  END WrPut;

PROCEDURE WrPutRaw(ww: WrWriter; fs: T)
  RAISES {Error, Thread.Alerted, Wr.Failure} =
  VAR
    pcType: PathComp.Type;
    pcName: TEXT;
    gotOne: BOOLEAN;
  BEGIN
    IF ww.cannotWrite THEN  (* Don't even try. *)
      RETURN;
    END;
    TRY
      (* Unfortunately, we have to do the work to keep the pathname
	 compressor in sync. *)
      TRY
	CASE fs.type OF
	| Type.DirDown =>	ww.comp.put(PathComp.Type.DirDown, fs.name);
	| Type.DirUp =>	ww.comp.put(PathComp.Type.DirUp, fs.name);
	ELSE
	  ww.comp.put(PathComp.Type.File, fs.name);
	END;
	(* Calls to putRaw() always originate from a getRaw().  Therefore,
	   we expect them to have all the necessary DirDowns and DirUps.
	   The compressor should return exactly one value, which is whatever
	   we put into it. *)
	gotOne := ww.comp.get(pcType, pcName);
	<* ASSERT gotOne *>
	EVAL ww.decomp.put(pcType, pcName);
	gotOne := ww.comp.get(pcType, pcName);
	<* ASSERT NOT gotOne *>
      EXCEPT PathComp.Error(msg) =>
	RAISE Error(msg);
      END;

      <* ASSERT fs.line # NIL *>
      Wr.PutText(ww.wr, fs.line & "\n");
    EXCEPT Wr.Failure(l) =>
      ww.cannotWrite := TRUE;
      RAISE Wr.Failure(l);
    END;
  END WrPutRaw;

PROCEDURE WrVersion(<*UNUSED*> ww: WrWriter): CARDINAL =
  BEGIN
    RETURN Version;
  END WrVersion;

BEGIN
END FileStatus.