(*********************************************************************)
(* Title:       M2Files - Panos Implementation                       *)
(* Author:      Mick Jordan,Trevor Morris                            *)
(*              Copyright (C) 1985 by Acorn Research Centre          *)
(*********************************************************************)


(*
  $Revision: 1.5 $
  $Author: tjm $
  $Date: 85/08/15 15:05:59 $
  $Source: /util/m2/ns16k/lib/RCS/M2Files.mod,v $
  $State: Exp $
*)

IMPLEMENTATION MODULE M2Files;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM Streams IMPORT 
    Stream, ErrorCode, StreamProcs, Get, GetN, Create, Delete;
IMPORT BadStream;
FROM SysStreams IMPORT sysOut;
FROM WriteF IMPORT WriteF1, H;
IMPORT HashStrings; 
FROM HashStrings IMPORT HashTable, HashId,
  EnterString, EnterChars, LookupChars, Assoc, Retrieve;
IMPORT Extensions;
IMPORT Strings; FROM Strings IMPORT String;
IMPORT FileStream, M2Path;
FROM ArchiveLib IMPORT 
  ArchiveId, MemberId, OpenArchive, GetNextMember, CreateFastInput,
  CloseArchive;

IMPORT DecodeArg;


TYPE
  FProc = PROCEDURE(ARRAY OF CHAR): Stream;

  FileInfo = POINTER TO FileInfoData;
  FileInfoData =
    RECORD   
      next: FileInfo;
      firstInDir: BOOLEAN;
      CASE inarchive: BOOLEAN OF
        TRUE:
          archiveid: ArchiveId;
          memberid: MemberId;
          archivename: String;
      | FALSE:
          directory: String;
      END (* case *);
    END (* record *);

  FileTable = POINTER TO FileTableData;
  FileTableData =
    RECORD
      ht: HashTable;
      info: FileInfo;
    END;


VAR
  m2Path: ARRAY [0..1023] OF CHAR;
  m2PathFound: BOOLEAN;
  archive: ARRAY [0 .. 10] OF CHAR;
  wild: ARRAY [0..0] OF CHAR;
  notify: BOOLEAN;
  extht: HashTable;


TYPE Mode = (In, Out, InOut);


PROCEDURE IsHashed(ext: Extension; VAR ht: HashTable): BOOLEAN;
  VAR
    hashid: HashId;
    retrieve: FileTable;
  BEGIN
    IF LookupChars(extht, ext, hashid) THEN
      retrieve := FileTable(Retrieve(extht, hashid));
      IF retrieve # NIL THEN
        ht := retrieve^.ht;
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    ELSE
      RETURN FALSE;
    END;
  END IsHashed;


PROCEDURE Open(m: Mode; name: ARRAY OF CHAR; ext: Extension): Stream;

  VAR s: Stream;
    directoryPrefix: ARRAY [0..255] OF CHAR;
    fproc: FProc;
    fileinfo: FileInfo;
    hashid: HashId;
    ht: HashTable;
    directory: String;

  BEGIN
    (* have we hashed this extension type? *)
    IF (m = Out) OR IsHashed(ext, ht) THEN

      Extensions.ExtendC(name, ext, Filename);

      CASE m OF
        In:   fproc := FileStream.CreateInput;
      | Out:  fproc := FileStream.CreateOutput;
      | InOut: fproc := FileStream.CreateInOutput;
      END;

      IF m # Out THEN

        IF LookupChars(ht, Filename, hashid) THEN
          fileinfo := FileInfo( Retrieve(ht, hashid) );
          WITH fileinfo^ DO
            IF inarchive THEN
              s := CreateFastInput(archiveid, memberid);
              Strings.CopySC(archivename, Filename);
              RETURN s;
            ELSE
              Strings.CopySC(directory, directoryPrefix);
              Extensions.DirConcatCC(directoryPrefix, Filename, Filename);
              RETURN Try(Filename, fproc);
            END;
          END;
        ELSE                                     
         RETURN SlowOpen(m, name, ext);
         (* RETURN BadStream.CreateInOutput(); *)
        END;

      ELSE RETURN Try(Filename, fproc);
      END;

    ELSE RETURN SlowOpen(m, name, ext);
    END;
  END Open;


PROCEDURE Try(name: ARRAY OF CHAR; fproc: FProc): Stream;
  BEGIN
    IF notify THEN
      WriteF1(sysOut, "Trying %S\N", H(name));
    END;
    RETURN fproc(name);
  END Try;


PROCEDURE CreateInput(name: ARRAY OF CHAR; ext: Extension): Stream;
  BEGIN
    RETURN Open(In, name, ext);
  END CreateInput;


PROCEDURE CreateOutput(name: ARRAY OF CHAR; ext: Extension): Stream;
  BEGIN
    RETURN Open(Out, name, ext);
  END CreateOutput;


PROCEDURE CreateInOutput(name: ARRAY OF CHAR; ext: Extension): Stream;
  BEGIN
    RETURN Open(InOut, name, ext);
  END CreateInOutput;


PROCEDURE HashExt(ext: Extension);
  VAR
    m2dir, target, name: ARRAY [0..255] OF CHAR;
    endstring, nullm2dir: BOOLEAN;
    firstindex, lastindex, lwb, upb, i, l: CARDINAL;
    m2dirString: String;
    r: INTEGER;
    info: DecodeArg.DecodedInformation;
    ft: FileTable;
    hashid: HashId;
    fileinfo: FileInfo;
  BEGIN
    IF NOT m2PathFound THEN FindM2Path END;

    IF EnterChars(extht, ext, hashid)
     OR (FileTable(Retrieve(extht, hashid)) = FileTable(NIL)) THEN
      (*  new type *)

      NEW(ft);
      ft^.ht := HashStrings.NewC(128, Strings.IgnoreCase);
      ft^.info := NIL;
      Assoc(extht, hashid, ft);

      firstindex := 0; lastindex := 0;
      REPEAT
        endstring := NOT Strings.FindC(m2Path, M2Path.M2PathSepCh, lastindex);

        (* extract first directory to search *)
        nullm2dir := lastindex = firstindex;
        IF nullm2dir THEN
          m2dir[0] := 0C;
        ELSE
          Strings.ExtractCC(m2Path, firstindex, lastindex, m2dir);
        END;
        INC(lastindex);
        firstindex :=  lastindex;
        
        IF nullm2dir OR (NOT ReadArchive(m2dir, ft, ext)) THEN 
          Extensions.ExtendC(wild, ext, target);
          Extensions.DirConcatCC(m2dir, target, target);

          r := DecodeArg.DecodeInit(info, "file/e/?", target);
          IF r = 0 THEN
            m2dirString := Strings.CopyCS(m2dir);
            FOR i := 1 TO DecodeArg.XGetNumberOfValues("file", info) DO

              l := DecodeArg.XGetStringArg(name, "file", i, info);
              Extensions.TailC(name, lwb, upb);
              Strings.ExtractCC(name, lwb, upb, name);

              IF EnterChars(ft^.ht, name, hashid) THEN
                NEW(fileinfo, FALSE);
                fileinfo^.next := ft^.info; (* prepend to ft^.info *)
                ft^.info := fileinfo;
                fileinfo^.firstInDir := (i = 1);
                fileinfo^.inarchive := FALSE;
                fileinfo^.directory := m2dirString;
                Assoc(ft^.ht, hashid, fileinfo);
              END;

            END;

          END;
        END;

      UNTIL endstring;
    END (* if *)
  END HashExt;


PROCEDURE ReadArchive(m2dir: ARRAY OF CHAR; ft: FileTable; ext: Extension): BOOLEAN;
  (*  returns TRUE if the archive exists *)
VAR
  m2archive: ARRAY [0 .. 255] OF CHAR;
  m2archivestring: String;
  arcid: ArchiveId;
  memid: MemberId;
  memname: ARRAY [0 .. 19] OF CHAR;
  extsuffix: ARRAY [0..4] OF CHAR;
  hashid: HashId;
  fileinfo: FileInfo;
  first: BOOLEAN;
BEGIN
  Extensions.DirConcatCC(m2dir, archive, m2archive);
  Extensions.ExtendC(m2archive, ext, m2archive);
  IF OpenArchive(m2archive, arcid) THEN
    m2archivestring := Strings.CopyCS(m2archive);
    first := TRUE;
    WHILE GetNextMember(arcid, memname, memid) DO
      IF EnterChars(ft^.ht, memname, hashid) THEN
        NEW(fileinfo, TRUE);
        WITH fileinfo^ DO
          next := ft^.info; (* prepend to ft^.info *)
          ft^.info := fileinfo;
          firstInDir := first;
          inarchive := TRUE;
          archiveid := arcid;
          memberid := memid;
          archivename := m2archivestring;
        END (* with *);
        Assoc(ft^.ht, hashid, fileinfo);
      END (* if *);
      first := FALSE;
    END (* while *);
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END (* if *);
END ReadArchive;


PROCEDURE SlowOpen(m: Mode; name: ARRAY OF CHAR; ext: Extension): Stream;

  VAR firstindex, lastindex: CARDINAL;
    s: Stream;
    tFilename, m2dir: ARRAY [0 .. 255] OF CHAR;
    nullm2dir, endstring: BOOLEAN;
    fproc: FProc;

  BEGIN
    firstindex := 0; lastindex := 0;

    IF NOT m2PathFound THEN FindM2Path END;

    Extensions.ExtendC(name, ext, Filename);
    Strings.CopyCC(Filename, tFilename); (*  save *)

    CASE m OF
      In:   fproc := FileStream.CreateInput;
    | Out:  fproc := FileStream.CreateOutput;
    | InOut: fproc := FileStream.CreateInOutput;
    END;

    LOOP
      endstring := NOT Strings.FindC(m2Path, M2Path.M2PathSepCh, lastindex);

      (* extract first directory to search *)
      nullm2dir := lastindex = firstindex;
      IF NOT nullm2dir THEN
        Strings.ExtractCC(m2Path, firstindex, lastindex, m2dir);
      END;
      INC(lastindex);
      firstindex :=  lastindex;

      Strings.CopyCC(tFilename, Filename); (*  recover *)
      IF NOT nullm2dir THEN
        Extensions.DirConcatCC(m2dir, Filename, Filename);
      END;

      s := Try(Filename, fproc);
      IF s^.status = Success THEN RETURN s END;
      IF endstring THEN RETURN BadStream.CreateInOutput() END;
    END;
  END SlowOpen;


PROCEDURE FindM2Path;
  BEGIN
    M2Path.GetM2Path(m2Path);
    m2PathFound := TRUE;
  END FindM2Path;


PROCEDURE SetM2PathFromFile;
  BEGIN
    M2Path.GetM2PathFromFile(m2Path);
    m2PathFound := TRUE;
  END SetM2PathFromFile;


PROCEDURE DisposeFileInfo(VAR fileinfo: FileInfo);
  BEGIN
    IF fileinfo # NIL THEN
      DisposeFileInfo(fileinfo^.next);
      IF fileinfo^.inarchive THEN
        IF fileinfo^.firstInDir THEN
          Strings.Dispose(fileinfo^.archivename);
          CloseArchive(fileinfo^.archiveid);
        END;
        DISPOSE(fileinfo, TRUE);
      ELSE
        IF fileinfo^.firstInDir THEN
          Strings.Dispose(fileinfo^.directory);
        END;
        DISPOSE(fileinfo, FALSE);
      END;
    END;
  END DisposeFileInfo;


PROCEDURE UnhashExt(ext: Extension);
  VAR
    hashid: HashId;
    ft: FileTable;
  BEGIN
    IF LookupChars(extht, ext, hashid) THEN
      ft := FileTable(Retrieve(extht, hashid));
      IF ft # NIL THEN
        DisposeFileInfo(ft^.info);
        HashStrings.Dispose(ft^.ht);
        DISPOSE(ft);
        Assoc(extht, hashid, NIL);
      END;
    END;
  END UnhashExt;


BEGIN
  (* construct single character strings ! *)
  notify := FALSE;
  archive := "archive_";
  wild[0] := '*';
  m2PathFound := FALSE;
  extht := HashStrings.NewC(9, Strings.IgnoreCase);
END M2Files.

(*
$Log:	M2Files.mod,v $
Revision 1.5  85/08/15  15:05:59  tjm
use 255 char buffers (some were 79 char and overflowing)

Revision 1.3  85/06/26  09:46:21  mjj
Added directory scanning to HashExt.

*)