MODULE App;

<* PRAGMA LL *>

IMPORT
  Atom, Env, FileRd, FileWr, Fmt, FmtTime, IP, Lex, OSError, Params,
  Rd, RdUtils, Stdio, Text, TextRd, TextWr, Thread, Time, Wr;

VAR
  readWriteMu := NEW(MUTEX);
  readWriteCV := NEW(Thread.Condition);
  readingCnt := 0;
  writingCnt := 0;
  (* single writer, multiple reader algorithm.

     if a thread is writing, then writingCnt # 0.
     if a thread is reading, then readingCnt # 0.

     a thread can read if another thread is reading.
     a thread cannot read if another thread is writing.
     a thread can write if no thread is reading or writing.

     readingCnt and writingCnt are protected by readWriteMu.
  *)

  hostName, hostIP: TEXT;

VAR
  argMu := NEW(MUTEX);
  debug := FALSE; <* LL = argMu *>
  verbose := FALSE; <* LL = argMu *>
  noDebug := TRUE; <* LL = argMu *>
  noVerbose := TRUE; <* LL = argMu *>

VAR
  logFile: TEXT;  <* LL = argMu *>
  wrLogFile: Wr.T;  <* LL = argMu *>

PROCEDURE ReadLock() =
  BEGIN
    LOCK readWriteMu DO
      WHILE writingCnt # 0 DO
        Thread.Wait(readWriteMu, readWriteCV);
      END;

      INC(readingCnt);
    END;
  END ReadLock;

PROCEDURE ReadUnlock() =
  BEGIN
    LOCK readWriteMu DO
      DEC(readingCnt);
    END;
  END ReadUnlock;

PROCEDURE WriteLock() =
  BEGIN
    LOCK readWriteMu DO
      WHILE readingCnt # 0 OR writingCnt # 0 DO
        Thread.Wait(readWriteMu, readWriteCV);
      END;

      INC(writingCnt);
    END;
  END WriteLock;

PROCEDURE WriteUnlock() =
  BEGIN
    LOCK readWriteMu DO
      DEC(writingCnt);
    END;
  END WriteUnlock;

REVEAL
  Log = LogPublic BRANDED "App.Log" OBJECT
  OVERRIDES
    log := LogMsg;
  END;

PROCEDURE LogMsg(<* UNUSED *> self: Log;
                 msg: TEXT; status: LogStatus) RAISES {Error} =
  BEGIN
    IF status = LogStatus.Error THEN
      RAISE Error(msg);
    END;
  END LogMsg;

PROCEDURE FormatIPAddress(addr: IP.Address): TEXT =
  BEGIN
    RETURN Fmt.F("%s.%s.%s.%s", Fmt.Int(addr.a[0]), Fmt.Int(addr.a[1]),
                Fmt.Int(addr.a[2]), Fmt.Int(addr.a[3]));
  END FormatIPAddress;

PROCEDURE LockedGetHostName (ipAddr: BOOLEAN := FALSE): TEXT =
  VAR addr: IP.Address;
  BEGIN
    TRY
      IF hostName = NIL OR Text.Length(hostName) = 0 THEN
        addr := IP.GetHostAddr();
        hostIP := FormatIPAddress(addr);
        hostName := IP.GetCanonicalByAddr(addr);
      END;
    EXCEPT
    | IP.Error =>
        hostName := "localhost";
        hostIP := "127.0.0.1";
    END;
    IF ipAddr THEN RETURN hostIP; ELSE RETURN hostName; END;
  END LockedGetHostName;

PROCEDURE GetHostName (ipAddr: BOOLEAN := FALSE): TEXT =
  BEGIN
    LOCK hostMu DO RETURN LockedGetHostName(ipAddr) END
  END GetHostName;

TYPE hostEnt = RECORD host: TEXT; same: BOOLEAN END;
VAR hostMu := NEW(MUTEX);
    hostTab := ARRAY [0..9] OF hostEnt{hostEnt{"", FALSE}, ..};
    victim := 0;

PROCEDURE IPCanonical(host: TEXT): TEXT =
  VAR res: TEXT;
  BEGIN
    TRY
      res := IP.GetCanonicalByName(host);
    EXCEPT
      IP.Error => res := NIL;
    END;
    IF res = NIL THEN res := host END;
    RETURN res
  END IPCanonical;

PROCEDURE SameHost(host: TEXT): BOOLEAN =
  VAR res: BOOLEAN;
  BEGIN
    LOCK hostMu DO
      FOR i := FIRST(hostTab) TO LAST(hostTab) DO
        IF Text.Equal(hostTab[i].host, host) THEN RETURN hostTab[i].same END;
      END;
      hostTab[victim].host := host;
      res := Text.Equal(host, "localhost") OR
         Text.Equal(host, "127.0.0.1") OR
         Text.Equal(host, LockedGetHostName(TRUE)) OR
         Text.Equal(host, LockedGetHostName(FALSE)) OR
         Text.Equal(IPCanonical(host), LockedGetHostName(TRUE));
      hostTab[victim].same := res;
      INC(victim);
      IF victim = NUMBER(hostTab) THEN victim := 0 END;
      RETURN res
    END
  END SameHost;

PROCEDURE Debug(): BOOLEAN =
  BEGIN
    LOCK argMu DO
      RETURN debug AND NOT noDebug;
    END;
  END Debug;

PROCEDURE Verbose(): BOOLEAN =
  BEGIN
    LOCK argMu DO
      RETURN verbose AND NOT noVerbose;
    END;
  END Verbose;

PROCEDURE SetValue(value: Value; f: BOOLEAN) =
  BEGIN
    LOCK argMu DO
      CASE value OF
      | Value.Debug => debug := f;
      | Value.NoDebug => noDebug := f;
      | Value.Verbose => verbose := f;
      | Value.NoVerbose => noVerbose := f;
      END;
    END;
  END SetValue;

TYPE
  DefaultLog = Log OBJECT
  OVERRIDES
    log := DefaultLogMsg;
  END;

PROCEDURE DefaultLogMsg (self: Log; msg: TEXT; status: LogStatus)
  RAISES {Error} =
  VAR wr: Wr.T;
  BEGIN
    IF status IN SET OF LogStatus{LogStatus.Verbose.. LogStatus.Status} THEN
      wr := Stdio.stdout;
    ELSE
      wr := Stdio.stderr;
    END;
    WITH lmsg = Fmt.F("%s %s: %s\n", FmtTime.Short(Time.Now()),
                      LogStatusText[status], msg) DO
      TRY
        LOCK argMu DO
          Wr.PutText(wr, lmsg);
          Wr.Flush(wr);
          IF wrLogFile # NIL THEN
            Wr.PutText(wrLogFile, lmsg);
            Wr.Flush(wrLogFile);
          END;
        END;
      EXCEPT
      | Thread.Alerted, Wr.Failure =>
      END;
      Log.log(self, msg, status);
    END;
  END DefaultLogMsg;

TYPE
  NullLog = Log OBJECT
  END;

REVEAL
  ArgHandler = ArgHandlerPublic BRANDED "App.ArgHandler" OBJECT
    atoms: ARRAY ArgSource OF Atom.T;
    src := ArgSource.None;
  OVERRIDES
    init := InitArgHandler;
    set := DefaultSetArg;
  END;

PROCEDURE MakeAtom(txt: TEXT): Atom.T =
  BEGIN
    IF txt = NIL THEN RETURN NIL ELSE RETURN Atom.FromText(txt) END;
  END MakeAtom;

PROCEDURE InitArgHandler(self: ArgHandler;
                         switchName, envName, configName: TEXT;
                         register := TRUE): ArgHandler =
  BEGIN
    self.atoms[ArgSource.Switch] := MakeAtom(switchName);
    self.atoms[ArgSource.Env] := MakeAtom(envName);
    IF configName = NIL THEN
      self.atoms[ArgSource.Config] := self.atoms[ArgSource.Switch];
    ELSE
      self.atoms[ArgSource.Config] := MakeAtom(configName);
    END;
    IF register THEN
      RegisterArgHandler(self);
    END;
    RETURN self;
  END InitArgHandler;

PROCEDURE DefaultSetArg(<* UNUSED *> self: ArgHandler;
                        <* UNUSED *> src: ArgSource;
                        <* UNUSED *> value: TEXT;
                        <* UNUSED *> log: Log) =
  BEGIN
    <* ASSERT FALSE *>
  END DefaultSetArg;

TYPE
  ArgHandlerList = REF RECORD
    head: ArgHandler;
    tail: ArgHandlerList;
  END;

VAR
  argHandlerList: ArgHandlerList := NIL;

PROCEDURE RegisterArgHandler(handler: ArgHandler) =
  BEGIN
    WriteLock();
    TRY
      argHandlerList := NEW(ArgHandlerList, head := handler,
                            tail := argHandlerList);
    FINALLY
      WriteUnlock();
    END;
  END RegisterArgHandler;

EXCEPTION
  ConfigError;

CONST
  DefaultConfigFile = ".app_config";
  ConfigSwitch = "-config";
  ConfigEnv = "APP_CONFIG";

VAR
  defaultConfigFile: TEXT;

PROCEDURE SwitchError(log: Log) RAISES {Error} =
  VAR
    list: ArgHandlerList;
    wr := TextWr.New();
    anyArg := FALSE;
  BEGIN
    TRY
      Wr.PutText(wr, "Options: ");
      ReadLock();
      TRY
        list := argHandlerList;
        WHILE list # NIL DO
          WITH at = list.head.atoms[ArgSource.Switch] DO
            IF at # NIL THEN
              Wr.PutText(wr, Fmt.F("-%s ", Atom.ToText(at)));
              IF list.head.hasParam THEN
                Wr.PutText(wr, Fmt.F("<%s> ", list.head.paramName));
              END;
            ELSE
              anyArg := TRUE;
            END;
          END;
          list := list.tail;
        END;
      FINALLY
        ReadUnlock();
      END;
      IF anyArg THEN
        Wr.PutText(wr, "argument(s)...");
      END;
    EXCEPT
    | Wr.Failure, Thread.Alerted =>
    END;
    log.log(TextWr.ToText(wr), LogStatus.Error);
  END SwitchError;

PROCEDURE MatchArgHandler(src: ArgSource; name: Atom.T): ArgHandler =
  VAR
    list: ArgHandlerList;
  BEGIN
    ReadLock();
    TRY
      list := argHandlerList;
      WHILE list # NIL DO
        IF name = list.head.atoms[src] THEN
          RETURN list.head;
        END;
        list := list.tail;
      END;
    FINALLY
      ReadUnlock();
    END;
    RETURN NIL;
  END MatchArgHandler;

PROCEDURE ParseSwitches (log: Log; logConfiguration: BOOLEAN)
  RAISES {Error} =
  VAR
    i         : INTEGER;
    arg, value: TEXT;
    handler   : ArgHandler;
    anyArg                 := FALSE;
  BEGIN
    i := 1;
    WHILE i < Params.Count DO
      arg := Params.Get(i);
      IF Text.GetChar(arg, 0) # '-' THEN
        handler := MatchArgHandler(ArgSource.Switch, AnyArgument);
        anyArg := TRUE;
      ELSE
        handler := MatchArgHandler(
                     ArgSource.Switch, Atom.FromText(Text.Sub(arg, 1)));
      END;
      IF handler = NIL THEN
        IF NOT Text.Equal(arg, ConfigSwitch) THEN SwitchError(log) END;
        IF i + 1 = Params.Count THEN SwitchError(log) END;
        value := Params.Get(i + 1);
        INC(i);
      ELSE
        IF anyArg THEN
          value := arg;
        ELSIF handler.src
                IN SET OF ArgSource{ArgSource.Switch, ArgSource.None} THEN
          IF handler.hasParam THEN
            IF i + 1 = Params.Count THEN SwitchError(log) END;
            value := Params.Get(i + 1);
            INC(i);
          ELSE
            value := "TRUE";
          END;
        END;
        handler.src := ArgSource.Switch;
        IF logConfiguration THEN
          log.log(
            Fmt.F("program switch: %s: %s", arg, value), LogStatus.Verbose);
        END;
        handler.set(ArgSource.Switch, value, log);
      END;
      INC(i);
    END;
  END ParseSwitches;

PROCEDURE ParseEnv (log: Log; logConfiguration: BOOLEAN) RAISES {Error} =
  VAR
    list : ArgHandlerList;
    value: TEXT;
  BEGIN
    ReadLock();
    TRY
      list := argHandlerList;
      WHILE list # NIL DO
        IF list.head.src = ArgSource.None THEN
          WITH at = list.head.atoms[ArgSource.Env] DO
            IF at # NIL THEN
              value := Env.Get(Atom.ToText(at));
              IF value # NIL THEN
                list.head.src := ArgSource.Env;
                IF logConfiguration THEN
                  log.log(Fmt.F("environment switch: %s: %s",
                                Atom.ToText(at), value), LogStatus.Verbose);
                END;
                list.head.set(ArgSource.Env, value, log);
              END;
            END;
          END;
        END;
        list := list.tail;
      END;
    FINALLY
      ReadUnlock();
    END;
  END ParseEnv;

CONST
  NonColon = SET OF CHAR{'\000'..'\377'} - SET OF CHAR{':'};

PROCEDURE ParseConfig (configFile      : TEXT;
                       log             : Log;
                       logConfiguration: BOOLEAN) RAISES {Error} =
  VAR
    rd                : FileRd.T;
    trd               : TextRd.T;
    line, field, value: TEXT;
    handler           : ArgHandler;
  BEGIN
    TRY
      IF logConfiguration THEN
        log.log(Fmt.F("config file: %s", configFile), LogStatus.Verbose);
      END;
      rd := FileRd.Open(configFile);
      LOOP
        REPEAT
          line := Rd.GetLine(rd);
        UNTIL Rd.EOF(rd) OR Text.Length(line) > 0;
        trd := TextRd.New(line);
        field := Lex.Scan(trd, NonColon);
        IF Rd.EOF(trd) OR Rd.GetChar(trd) = ':' THEN
          handler :=
            MatchArgHandler(ArgSource.Config, Atom.FromText(field));
          IF handler = NIL THEN
            RAISE ConfigError;
          ELSIF handler.src
                  IN SET OF ArgSource{ArgSource.None, ArgSource.Config} THEN
            handler.src := ArgSource.Config;
            Lex.Skip(trd);
            IF handler.hasParam THEN
              IF Rd.EOF(trd) THEN RAISE ConfigError END;
              value := Rd.GetLine(trd);
            ELSE
              value := "TRUE";
            END;
            IF logConfiguration THEN
              log.log(Fmt.F("config file switch: %s: %s", field, value),
                      LogStatus.Verbose);
            END;
            handler.set(ArgSource.Config, value, log);
            IF NOT Rd.EOF(trd) THEN RAISE ConfigError END;
          END;
        ELSE
          RAISE ConfigError;
        END;
      END;
    EXCEPT
    | Rd.EndOfFile => Rd.Close(rd); <* NOWARN *>
    | OSError.E(reason) =>
        IF configFile # defaultConfigFile THEN
          log.log(Fmt.F("Can't open config file \"%s\" (%s)", configFile,
                  RdUtils.FailureText(reason)),  LogStatus.Error);
        END;
    | Rd.Failure, Thread.Alerted =>
        log.log(Fmt.F("Problems reading config file %s", configFile),
                LogStatus.Error);
    | ConfigError =>
        log.log(Fmt.F("Bad entry in configFile %s: %s", configFile, line),
                LogStatus.Error);
    END;
  END ParseConfig;

PROCEDURE ArgDefaults (log: Log; logConfiguration: BOOLEAN) RAISES {Error} =
  VAR list: ArgHandlerList;
  BEGIN
    ReadLock();
    TRY
      list := argHandlerList;
      WHILE list # NIL DO
        IF list.head.src = ArgSource.None THEN
          list.head.src := ArgSource.Default;
          IF list.head.atoms[ArgSource.Switch] = NIL
               OR list.head.default = NIL THEN
            log.log("Bad Default arg", LogStatus.Verbose);
            log.log(
              Fmt.F("id = %s", Fmt.Int(list.head.id)), LogStatus.Verbose);
            IF list.head.paramName = NIL THEN
              log.log("NIL paramName", LogStatus.Verbose);
            ELSE
              log.log(Fmt.F("paramName = %s", list.head.paramName),
                      LogStatus.Verbose);
            END;
            IF list.head.default = NIL THEN
              log.log("NIL default", LogStatus.Verbose);
            ELSE
              log.log(Fmt.F("default = %s", list.head.default),
                      LogStatus.Verbose);
            END;
            IF list.head.atoms[ArgSource.Switch] = NIL THEN
              log.log("NIL switch atom", LogStatus.Verbose);
            ELSE
              log.log(
                Fmt.F("switch = %s",
                      Atom.ToText(list.head.atoms[ArgSource.Switch])),
                LogStatus.Verbose);
            END;
            IF list.head.atoms[ArgSource.Env] = NIL THEN
              log.log("NIL env atom", LogStatus.Verbose);
            ELSE
              log.log(Fmt.F("env = %s",
                            Atom.ToText(list.head.atoms[ArgSource.Env])),
                      LogStatus.Verbose);
            END;
            IF list.head.atoms[ArgSource.Config] = NIL THEN
              log.log("NIL config atom", LogStatus.Verbose);
            ELSE
              log.log(
                Fmt.F("config = %s",
                      Atom.ToText(list.head.atoms[ArgSource.Config])),
                LogStatus.Verbose);
            END;
          ELSIF logConfiguration THEN
            log.log(Fmt.F("Default arg %s: %s",
                          Atom.ToText(list.head.atoms[ArgSource.Switch]),
                          list.head.default), LogStatus.Verbose);
          END;
          list.head.set(ArgSource.Default, list.head.default, log);
        END;
        list := list.tail;
      END;
    FINALLY
      ReadUnlock();
    END;
  END ArgDefaults;

PROCEDURE InitializeArguments(log: Log;
                              configFile: TEXT;
                              logConfiguration: BOOLEAN) RAISES {Error} =
  VAR
    i: INTEGER;
    arg: TEXT;
  BEGIN
    IF log = NIL THEN log := defaultLog END;
    IF configFile = NIL THEN configFile := DefaultConfigFile; END;
    defaultConfigFile := configFile;

    IF Env.Get(ConfigEnv) # NIL THEN configFile := Env.Get(ConfigEnv) END;

    i := 1;
    WHILE i < Params.Count DO
      arg := Params.Get(i);
      IF Text.Equal(arg, ConfigSwitch) THEN
        IF i + 1 = Params.Count THEN
          log.log("No parameter for \"-config\" switch", LogStatus.Status);
          SwitchError(log);
        END;
        configFile := Params.Get(i + 1);
        EXIT;
      END;
      INC(i);
    END;

    ParseSwitches(log, logConfiguration);
    ParseEnv(log, logConfiguration);
    ParseConfig(configFile, log, logConfiguration);
    ArgDefaults(log, logConfiguration);
  END InitializeArguments;

TYPE
  Arg = {Debug, NoDebug, Verbose, NoVerbose, LogFile, HostName, Comment};

  AppArgHandler = ArgHandler OBJECT
  OVERRIDES
    set := SetArg;
  END;

PROCEDURE SetArg (             self : ArgHandler;
                  <* UNUSED *> src  : ArgSource;
                               value: TEXT;
                  <* UNUSED *> log  : Log         ) =
  BEGIN
    LOCK argMu DO
      CASE VAL(self.id, Arg) OF
      | Arg.Debug => debug := Text.Equal(value, "TRUE");
      | Arg.Verbose => verbose := Text.Equal(value, "TRUE");
      | Arg.NoDebug => noDebug := Text.Equal(value, "TRUE");
      | Arg.NoVerbose => noVerbose := Text.Equal(value, "TRUE");
      | Arg.Comment =>
      | Arg.LogFile =>
          logFile := value;
          IF wrLogFile = NIL AND logFile # NIL
               AND NOT Text.Equal(logFile, "") THEN
            TRY
              wrLogFile := FileWr.OpenAppend(logFile);
            EXCEPT
            | OSError.E (reason) =>
                TRY
                  Wr.PutText(
                    Stdio.stderr,
                    Fmt.F("*************\nERROR (%s) OPENING LOG FILE: %s",
                          logFile, RdUtils.FailureText(reason)));
                EXCEPT
                | Wr.Failure, Thread.Alerted =>
                END;
            END;
          END;
      | Arg.HostName => hostName := value;
      END;
    END;
  END SetArg;

BEGIN
  EVAL NEW(AppArgHandler, id := ORD(Arg.Debug), hasParam:= FALSE).init(
                                     switchName := "debug",
                                     envName := "APP_DEBUG");
  EVAL NEW(AppArgHandler, id := ORD(Arg.NoDebug), hasParam:= FALSE).init(
                                     switchName := "noDebug",
                                     envName := "APP_NODEBUG");
  EVAL NEW(AppArgHandler, id := ORD(Arg.Verbose), hasParam:= FALSE).init(
                                     switchName := "verbose",
                                     envName := "APP_VERBOSE");
  EVAL NEW(AppArgHandler, id := ORD(Arg.NoVerbose), hasParam:= FALSE).init(
                                     switchName := "noVerbose",
                                     envName := "APP_NOVERBOSE");
  EVAL NEW(AppArgHandler, id := ORD(Arg.Comment),
           paramName := "comment", default := "").init(switchName := "comment");
  EVAL NEW(AppArgHandler, id := ORD(Arg.LogFile),
           paramName := "log filename", default := "").init(switchName := "logFile");
  EVAL NEW(AppArgHandler, id := ORD(Arg.HostName),
           paramName := "host IP name", default := "").init(switchName := "hostname");

  defaultLog := NEW(DefaultLog);
  nullLog := NEW(NullLog);

END App.