(*************************************************************************

:Program.    SGConfiguration.mod
:Contents.   helps loading and saving configs according to SyleGuide
:Contents.   Part of ZOC's StyleGuideSupport module library
:Author.     Hartmut Goebel [hG]
:Address.    Aufseßplatz 5, D-8500 Nürnberg 40
:Copyright.  Copyright © 1992 by Hartmut Goebel
:Language.   Oberon
:Translator. Amiga Oberon V2.25
:History.    V1.0, 23 Apr 1992 [hG]
:History.    V1.1  07 May 1992 [hG] BaseName as global Var
:History.    V1.1b 15 May 1992 [hG] UnLock after ConfgFile has been closed
:Date.       17 May 1992 23:04:17

:Imports.    Printf [Volker Rudolph]

*************************************************************************)

MODULE SGConfiguration;

IMPORT
  d *:= Dos,
  e  := Exec,
  pf := Printf,
  s  := SYSTEM,
  str:= Strings,
  sd := SecureDos;

CONST
  HERE   = "%0.32s.%s";
  ENV    = "ENV:%0.32s/%0.32s.%s";
  ENVARC = "ENVARC:%0.32s/%0.32s.%s";
  ENVDIR    = "ENV:%0.32s";
  ENVARCDIR = "ENVARC:%0.32s";

  EnvArgLen = 90; (* max. FilenameLen = 32 *)

TYPE
  ReadProc  * = PROCEDURE(file: d.FileHandlePtr): BOOLEAN;
  WriteProc * = PROCEDURE(name: ARRAY OF CHAR): BOOLEAN;

VAR
  Extension * : ARRAY 10 OF CHAR;
  BaseName  * : ARRAY 40 OF CHAR;

PROCEDURE ReadConfig * (VAR setting : ARRAY OF CHAR;
                        VAR dirLock : d.FileLockPtr;
                            currentFirst: BOOLEAN;
                            envToTry: ARRAY  OF CHAR;
                            readProc: ReadProc): BOOLEAN;
(*
:Semantic. finds out which setting have to be loaded and calls the load proc
:Semantic. if <setting> not specified searchs as descripted in the SG

:Input.    setting: if userdefined else ""
:Input.    currentFirst: search in current dir first of all (if no setting given)
:Input.    envToTry: try contents before progs home dir
:Input.    readProc: procedure the reads the config

:Output.   setting: the setting really read
:Output.   dirLock: lock to dir the setting have been read from

:Result.   result from readProc, or FALSE if <setting> can't be locked

:Note.     make sure to free dirLock when no longer needed!
*)

VAR
  oldLock, lock: d.FileLockPtr;
  file: d.FileHandlePtr;
  return: BOOLEAN;
BEGIN
  IF BaseName = "" THEN HALT(20); END;
  (* $IFNOT ClearVars *)
  lock := NIL; oldLock := NIL; return := FALSE;
  (* $END *)

  IF setting # "" THEN                    (* are any setting given? *)
    lock := sd.Lock(setting,d.accessRead);
    IF lock = NIL THEN RETURN FALSE; END;
  ELSE
    IF currentFirst THEN
      pf.SPrintf2(setting,HERE,s.ADR(BaseName),s.ADR(Extension));
      lock := sd.Lock(setting,d.accessRead);   (* current *)
    END;
    IF (lock = NIL) & (envToTry # "")
    & (d.GetVar(envToTry,setting,LEN(setting),LONGSET{}) > 0) THEN
      lock := sd.Lock(setting,d.accessRead); (* envToTry *)
    END;
    IF lock = NIL THEN
      dirLock := d.GetProgramDir();
      IF dirLock # NIL THEN
        pf.SPrintf2(setting,HERE,s.ADR(BaseName),s.ADR(Extension));
        oldLock := d.CurrentDir(dirLock);
        lock := sd.Lock(setting,d.accessRead); (* programms home *)
      END;
    END;
    IF lock = NIL THEN
      pf.SPrintf3(setting,ENV,s.ADR(BaseName),s.ADR(BaseName),s.ADR(Extension));
      lock := sd.Lock(setting,d.accessRead);  (* ENV: *)
    END;
    IF lock = NIL THEN
      setting := "";
    END;
  END;

  IF lock # NIL THEN
    dirLock := sd.ParentDir(lock);
    file := sd.OpenFromLock(lock); (* must not be UnLocked, if file opend *)
    IF file # NIL THEN
      return  := readProc(file);
      sd.Close(file);
    ELSE
      sd.UnLock(lock);
      return := FALSE;
    END;
  END;

  IF oldLock # NIL THEN
    IF d.CurrentDir(oldLock) = NIL THEN END;
  END;

  RETURN return;
END ReadConfig;


PROCEDURE ReadConfigEH * (VAR setting : ARRAY OF CHAR;
                          VAR dirLock : d.FileLockPtr;
                              currentFirst: BOOLEAN;
                              envToTry: ARRAY  OF CHAR;
                              readProc: ReadProc): BOOLEAN;
(*
:Semantic. finds out which setting have to be loaded and calls the load proc
:Semantic. if <setting> not specified searchs in ENV:, then in progs home dir

:Input.    setting: if userdefined else ""
:Input.    currentFirst: search in current dir first of all (if no setting given)
:Input.    envToTry: try contents before progs home dir
:Input.    readProc: procedure the reads the config

:Output.   setting: the setting really read
:Output.   dirLock: lock to dir the setting have been read from

:Result.   result from readProc, or FALSE if <setting> can't be locked

:Note.     make sure to free dirLock when no longer needed!
*)

VAR
  oldLock, lock: d.FileLockPtr;
  file: d.FileHandlePtr;
  return: BOOLEAN;
BEGIN
  IF BaseName = "" THEN HALT(20); END;
  (* $IFNOT ClearVars *)
  lock := NIL; oldLock := NIL; return := FALSE;
  (* $END *)

  IF setting # "" THEN                    (* are any setting given? *)
    lock := sd.Lock(setting,d.accessRead);
    IF lock = NIL THEN RETURN FALSE; END;
  ELSE
    IF currentFirst THEN
      pf.SPrintf2(setting,HERE,s.ADR(BaseName),s.ADR(Extension));
      lock := sd.Lock(setting,d.accessRead);   (* current *)
    END;
    IF lock = NIL THEN
      pf.SPrintf3(setting,ENV,s.ADR(BaseName),s.ADR(BaseName),s.ADR(Extension));
      lock := sd.Lock(setting,d.accessRead);  (* ENV: *)
    END;
    IF (lock = NIL) & (envToTry # "")
    & (d.GetVar(envToTry,setting,LEN(setting),LONGSET{}) > 0) THEN
      lock := sd.Lock(setting,d.accessRead); (* envToTry *)
    END;
    IF lock = NIL THEN
      dirLock := d.GetProgramDir();
      IF dirLock # NIL THEN
        pf.SPrintf2(setting,HERE,s.ADR(BaseName),s.ADR(Extension));
        oldLock := d.CurrentDir(dirLock);
        lock := sd.Lock(setting,d.accessRead); (* programms home *)
      END;
    END;
    IF lock = NIL THEN
      setting := "";
    END;
  END;

  IF lock # NIL THEN
    dirLock := sd.ParentDir(lock);
    file := sd.OpenFromLock(lock); (* must not be UnLocked, if file opend *)
    IF file # NIL THEN
      return  := readProc(file);
      sd.Close(file);
    ELSE
      sd.UnLock(lock);
      return := FALSE;
    END;
  END;

  IF oldLock # NIL THEN
    IF d.CurrentDir(oldLock) = NIL THEN END;
  END;

  RETURN return;
END ReadConfigEH;


PROCEDURE UseConfig * (save: BOOLEAN;
                       writeProc: WriteProc): BOOLEAN;
(*
:Semantic. saves the setting to ENV: and ENVARC:
:Semantic. if ENV:<BaseName> not exists it will be created, same for ENVARC:

:Input.    save:  TRUE to save config also to ENVARC:
:Input.    writeProc: procedure that writes the config

:Result.   result from writeProc, or FALSE if subdir can't be created
*)
VAR
  lock: d.FileLockPtr;
  return: BOOLEAN;
  nameBuffer: ARRAY EnvArgLen OF CHAR;
BEGIN
  IF BaseName = "" THEN HALT(20); END;
  IF save THEN
    (* if ENVARC:<BaseName> not exists, make it *)
    pf.SPrintf1(nameBuffer,ENVARCDIR,s.ADR(BaseName));
    lock := sd.Lock(nameBuffer,d.sharedLock);
    IF (lock = NIL) & (d.IoErr() = d.objectNotFound) THEN
      lock := sd.CreateDir(nameBuffer); END;
    IF lock = NIL THEN RETURN FALSE; END;

    (* first write to ENVARC: *)
    pf.SPrintf3(nameBuffer,ENVARC,s.ADR(BaseName),s.ADR(BaseName),s.ADR(Extension));
    return := writeProc(nameBuffer);
    sd.UnLock(lock);
    IF ~return THEN RETURN FALSE; END;
  END;

  (* exists dir in ENV:? *)
  pf.SPrintf1(nameBuffer,ENVDIR,s.ADR(BaseName));
  lock := sd.Lock(nameBuffer,d.sharedLock);
  IF (lock = NIL) & (d.IoErr() = d.objectNotFound) THEN
    lock := sd.CreateDir(nameBuffer); END;
  IF lock = NIL THEN RETURN FALSE; END;

  (* noew write to ENV: *)
  pf.SPrintf3(nameBuffer,ENV,s.ADR(BaseName),s.ADR(BaseName),s.ADR(Extension));
  return := writeProc(nameBuffer);
  sd.UnLock(lock);
  RETURN return;
END UseConfig;


PROCEDURE WriteConfig * (setting: ARRAY OF CHAR;
                         dirLock : d.FileLockPtr;
                         writeProc: WriteProc): BOOLEAN;
(*
:Semantic. finds out where the setting have to be saved and calls the write proc
:Semantic. if <setting> not specified tries progs home dir and then ENV: and ENVARC:

:Input.    setting: if userdefined else ""
:Input.    dirLock: lock to dir the setting have been read from (from ReadConfig)
:Input.    writeProc: procedure that writes the config

:Result.   result from writeProc
*)

VAR
  oldLock: d.FileLockPtr;
  return: BOOLEAN;
BEGIN
  IF BaseName = "" THEN HALT(20); END;
  (* $IFNOT ClearVars *)
  return := FALSE;
  (* $END *)

  IF dirLock # NIL THEN oldLock := d.CurrentDir(dirLock); END;

  IF setting # "" THEN     (* has config been loaded from somewere? *)
    return := writeProc(setting);
  ELSE
    (*
     * config has not been loaded, so we write to the progs home dir
     * or, if this failes to ENV: and ENVARC:
     *)
    IF dirLock # NIL THEN
      pf.SPrintf2(setting,HERE,s.ADR(BaseName),s.ADR(Extension));
      return := writeProc(setting);
    END;
    IF ~return THEN
      return := UseConfig(TRUE,writeProc);
    END;
  END;

  IF d.CurrentDir(oldLock) # NIL THEN END;

  RETURN return;
END WriteConfig;


BEGIN
  (*BaseName ="";*)
  Extension := "config";

END SGConfiguration.