MODULE; IMPORT Rd, Text, TextTextTbl, TextRd, Thread, Pathname, Env, Bundle, Rsrc, FileRd, OSError, Params, RefList, TextSeq, TextList, Fmt; CompactRC
IMPORT Fmt;
IMPORT SMsg AS Msg, MsgX, MsgIF, TextUtils, TextReadingUtils, FSUtils, ProcessEnv, CompactEnvName, MiniEnv, SimpleValueEnv, CompactClient, System; IMPORT PathRepr, TextTuple, TextTupleSeq, TextTextTupleSeqTbl, RegEx;--------------------------------------------------------------------------
PROCEDURE--------------------------------------------------------------------------TpcOverridesInit (self : TpcOverrides) : TpcOverrides = BEGIN self.hosttype := NIL; self.ostype := NIL; self.variant := NIL; self.compiler := NIL; self.options := NIL; RETURN self; END TpcOverridesInit;
PROCEDURE--------------------------------------------------------------------------MappingDefined (name : TEXT) : BOOLEAN = VAR map : TextTupleSeq.T; BEGIN RETURN mappingLists.get(name, map); END MappingDefined;
PROCEDURE--------------------------------------------------------------------------GetMapping (name : TEXT) : TextTupleSeq.T = VAR map : TextTupleSeq.T; BEGIN IF mappingLists.get(name, map) THEN RETURN map; ELSE RETURN NIL; END; END GetMapping;
PROCEDURE--------------------------------------------------------------------------SetSomeDefaults (env : TextTextTbl.T) = BEGIN EVAL env.put("HOME", PathRepr.Native(MiniEnv.home)); EVAL env.put("USER", PathRepr.Native(MiniEnv.user)); EVAL env.put("COMPACTROOT", PathRepr.Native(MiniEnv.compactroot)); EVAL env.put("TMPDIR", PathRepr.Native(MiniEnv.tmpdir)); EVAL env.put(CompactEnvName.Passphrase, MiniEnv.pass); EVAL env.put("editor", PathRepr.Native(MiniEnv.editor)); EVAL env.put("editor-args-pathstyle", "native"); EVAL env.put("httpd-editor", PathRepr.Native(MiniEnv.editor)); (* editors defined *) END SetSomeDefaults;
PROCEDURE--------------------------------------------------------------------------SetEnvVars (env : TextTextTbl.T) = BEGIN (* hack for external makedir *) IF Env.Get("PKG_USE_EXTERNAL_MKDIR") # NIL THEN EVAL env.put("useExternalMakedir", "TRUE"); END; IF Env.Get("PKG_USE_POSIX_PATHNAMES") # NIL THEN EVAL env.put("usePosixPathnames", "TRUE"); END; WITH val = Env.Get("PRJ_ROOT") DO IF val # NIL THEN EVAL env.put("PRJ_ROOT", PathRepr.Native(val)); END; END; WITH val = Env.Get("COLLECTIONROOT") DO IF val # NIL THEN EVAL env.put("COLLECTIONROOT", PathRepr.Native(val)); END; END; WITH val = Env.Get("PROJECTROOT") DO IF val # NIL THEN EVAL env.put("PROJECTROOT", PathRepr.Native(val)); END; END; END SetEnvVars;
PROCEDURE--------------------------------------------------------------------------SetTPCDefaults (env : TextTextTbl.T; tpcOverrides : TpcOverrides := NIL; tpcWarnings : BOOLEAN := FALSE; msg : MsgIF.T := NIL; warn := TRUE) = VAR val : TEXT; BEGIN (* set some defaults for TPC if not explicitly declared *) EVAL env.put("tpc-hosttype-default", MiniEnv.tpc_hosttype); IF tpcOverrides = NIL OR tpcOverrides.hosttype = NIL THEN IF NOT env.get("tpc-hosttype", val) AND NOT env.get("tpc-hosttype-start", val) THEN IF Text.Equal(MiniEnv.tpc_hosttype, "") AND tpcWarnings AND warn THEN MsgX.Warning(msg, "tpc-hosttype is unknown"); END; END; ELSE EVAL env.put("tpc-hosttype", tpcOverrides.hosttype); IF Msg.dFlag THEN MsgX.V(msg, " tpc-override: tpc-hosttype=\"" & tpcOverrides.hosttype & "\""); END; END; EVAL env.put("tpc-ostype-default", MiniEnv.tpc_ostype); IF tpcOverrides = NIL OR tpcOverrides.ostype = NIL THEN IF NOT env.get("tpc-ostype", val) AND NOT env.get("tpc-ostype-start", val) THEN IF Text.Equal(MiniEnv.tpc_ostype, "") AND tpcWarnings AND warn THEN MsgX.Warning(msg, "tpc-ostype is unknown"); END; END; ELSE EVAL env.put("tpc-ostype", tpcOverrides.ostype); IF Msg.dFlag THEN MsgX.V(msg, " tpc-override: tpc-ostype=\"" & tpcOverrides.ostype & "\""); END; END; EVAL env.put("tpc-variant-default", MiniEnv.tpc_variant); IF tpcOverrides = NIL OR tpcOverrides.variant = NIL THEN IF NOT env.get("tpc-variant", val) AND NOT env.get("tpc-variant-start", val) THEN IF Text.Equal(MiniEnv.tpc_variant, "") AND tpcWarnings AND warn THEN MsgX.Warning(msg, "tpc-variant is unknown"); END; END; ELSE EVAL env.put("tpc-variant", tpcOverrides.variant); IF Msg.dFlag THEN MsgX.V(msg, " tpc-override: tpc-variant=\"" & tpcOverrides.variant & "\""); END; END; EVAL env.put("tpc-compiler-default", MiniEnv.tpc_compiler); IF tpcOverrides = NIL OR tpcOverrides.compiler = NIL THEN IF NOT env.get("tpc-compiler", val) AND NOT env.get("tpc-compiler-start", val) THEN IF Text.Equal(MiniEnv.tpc_compiler, "") AND tpcWarnings AND warn THEN MsgX.Warning(msg, "tpc-compiler is unknown"); END; END; ELSE EVAL env.put("tpc-compiler", tpcOverrides.compiler); IF Msg.dFlag THEN MsgX.V(msg, " tpc-override: tpc-compiler=\"" & tpcOverrides.compiler & "\""); END; END; IF tpcOverrides = NIL OR tpcOverrides.options = NIL THEN (* There is no sensible default for options, so we leave it undefined. IF NOT env.get("tpc-options", val) THEN EVAL env.put("tpc-options", MiniEnv.tpc_options); END; *) ELSE EVAL env.put("tpc-options", tpcOverrides.options); EVAL env.put("tpc-opts", Text.Sub(tpcOverrides.options, 1)); IF Msg.dFlag THEN MsgX.V(msg, " tpc-override: tpc-options=\"" & tpcOverrides.options & "\""); END; END; END SetTPCDefaults;
PROCEDURE--------------------------------------------------------------------------ReadAll (env : TextTextTbl.T; rsrcPath : Rsrc.Path; initBundle : Bundle.T; tpcOverrides : TpcOverrides := NIL; tpcWarnings : BOOLEAN := FALSE; msg : MsgIF.T := NIL) = (*------------------------------------------------------------------------*) PROCEDURE ReadIfExists(compactrc : TEXT) = VAR rd : FileRd.T; BEGIN IF FSUtils.IsFile(compactrc) THEN TRY rd := FileRd.Open(compactrc); MsgX.V(msg, "reading " & compactrc); Read(rd, env, msg); EXCEPT OSError.E => MsgX.Fatal(msg, "cannot read initialization file: " & compactrc); END; ELSE MsgX.V(msg, "no file " & compactrc); END; END ReadIfExists; (*------------------------------------------------------------------------*) PROCEDURE ReadIfNonNil(rd : Rd.T; name : TEXT) = BEGIN IF rd = NIL THEN MsgX.V(msg, "no remote resource " & name); ELSE MsgX.V(msg, "reading remote resource " & name); Read(rd, env, msg); END; END ReadIfNonNil; (*------------------------------------------------------------------------*) PROCEDURE ReadRemote(server : TEXT; name : TEXT; eb := CompactClient.EB.Warn) = BEGIN IF server # NIL THEN WITH rd = CompactClient.RemoteRsrcRd(compactClient, server, name, env, msg, eb) DO ReadIfNonNil(rd, name); END; END; END ReadRemote; (*------------------------------------------------------------------------*) PROCEDURE ReadText(txt : TEXT) = BEGIN trd := TextRd.New(txt); Read(trd, env, msg); END ReadText; (*------------------------------------------------------------------------*) PROCEDURE ReadCascade(server : TEXT; name : TEXT; eb := CompactClient.EB.Warn) = BEGIN (* first evaluate the compiled-in resources *) WITH txt = Bundle.Get(initBundle, name) DO IF txt = NIL THEN MsgX.V(msg, "no bundled resource " & name); ELSE MsgX.V(msg, "reading bundled resource " & name); ReadText(txt); END; END; (* then check for global resource from server *) IF server # NIL THEN WITH rd = CompactClient.RemoteRsrcRd(compactClient, server, name, env, msg, eb) DO ReadIfNonNil(rd, name); END; END; (* read resource from file system *) TRY WITH txt = Rsrc.Get(name, rsrcPath) DO IF txt = NIL THEN MsgX.V(msg, "no local resource " & name); ELSE MsgX.V(msg, "reading local resource " & name); ReadText(txt); END; END; EXCEPT Rsrc.NotFound => (* skip *) | Rd.Failure => MsgX.Fatal(msg, "can't read resource: " & name) | Thread.Alerted => MsgX.Fatal(msg, "internal error reading resource: " & name) END; (* now read ~/.{name} if it exists *) ReadIfExists(Pathname.Join(MiniEnv.home, "." & name, NIL)); END ReadCascade; (*------------------------------------------------------------------------*) CONST crc = "compactrc"; VAR compactrc := Pathname.Join(MiniEnv.home, ".compactrc", NIL); server : TEXT; hostname : TEXT; hosttype : TEXT; ostype : TEXT; platform : TEXT; trd : TextRd.T; BEGIN server := Env.Get("COMPACTSERVER"); ReadCascade(server, crc); (* if we already have a definition for `compactserver', try to read a remote resource again if necessary *) IF server = NIL THEN server := GetValue(env, "compactserver", msg); ReadRemote(server, crc); END; SetTPCDefaults(env, tpcOverrides, tpcWarnings, msg, warn := FALSE); hosttype := GetValue(env, "tpc-hosttype-default", msg); ostype := GetValue(env, "tpc-ostype-default", msg); platform := hosttype & "-" & ostype; (* let's see if there are any platform specific overrides *) ReadCascade(server, crc & "-" & hosttype, CompactClient.EB.Ignore); ReadCascade(server, crc & "-" & ostype, CompactClient.EB.Ignore); ReadCascade(server, crc & "-" & platform, CompactClient.EB.Ignore); hostname := Env.Get("HOSTNAME"); IF hostname = NIL THEN hostname := Env.Get("COMPUTERNAME"); END; IF hostname = NIL THEN hostname := System.Hostname(); END; IF hostname = NIL THEN Msg.Warning("no hostname"); ELSE WITH i = TextUtils.Pos(hostname, ".") DO IF i > 0 THEN hostname := Text.Sub(hostname, 0, i); END; END; Msg.V("hostname = " & hostname); EVAL env.put("hostname", hostname); END; IF hostname # NIL THEN ReadCascade(server, crc & "-" & hostname, CompactClient.EB.Ignore); END; compactrc := Env.Get("COMPACTRC"); IF compactrc # NIL THEN ReadIfExists(compactrc); END; END ReadAll;
PROCEDURE--------------------------------------------------------------------------Eval (initBundle : Bundle.T; tpcOverrides : TpcOverrides := NIL; tpcWarnings : BOOLEAN := FALSE; readEnvFile : BOOLEAN := TRUE; msg : MsgIF.T := NIL) : TextTextTbl.T = (*------------------------------------------------------------------------*) VAR env := NEW(TextTextTbl.Default).init(); rsrcPath : Rsrc.Path; origin : TEXT; config := Pathname.Join(MiniEnv.compactroot, "config", NIL); BEGIN SetSomeDefaults(env); SetEnvVars(env); (* MsgX.D(msg, "Params.Count = " & Fmt.Int(Params.Count)); *) IF Params.Count > 0 THEN (* FOR i := 0 TO Params.Count - 1 DO MsgX.D(msg, "Param " & Fmt.Int(i) & ": " & Params.Get(i)); END; *) origin := Pathname.Prefix(Params.Get(0)); rsrcPath := Rsrc.BuildPath( Pathname.Join(MiniEnv.home, "compact", NIL), config, origin, PathRepr.Native("/usr/contrib/lib/compact")); rsrcPath := RefList.AppendD( rsrcPath, RefList.List2( PathRepr.Native("/usr/local/lib/compact"), PathRepr.Native("/opt/compact"))); ELSE (* MsgX.D(msg, "2"); *) rsrcPath := Rsrc.BuildPath( Pathname.Join(MiniEnv.home, "compact", NIL), config, PathRepr.Native("/usr/contrib/lib/compact"), PathRepr.Native("/usr/local/lib/compact")); rsrcPath := RefList.AppendD( rsrcPath, RefList.List1( PathRepr.Native("/opt/compact"))); END; IF Msg.dFlag THEN VAR path := NEW(TextSeq.T).init(); BEGIN FOR i := 0 TO RefList.Length(rsrcPath) - 1 DO WITH e = RefList.Nth(rsrcPath, i) DO TYPECASE e OF TEXT => path.addhi(e); ELSE (* skip *) END; END; END; MsgX.D(msg, "search path for global initialization file is " & TextUtils.TextSeqToText(path, ":")); END; END; ReadAll(env, rsrcPath, initBundle, tpcOverrides, tpcWarnings, msg); (* read environment file if wanted *) IF readEnvFile THEN WITH fn = EnvFileLocation(MiniEnv.home) DO IF FSUtils.IsFile(fn) THEN MsgX.V(msg, "reading environment file " & fn); WITH sve = NEW(SimpleValueEnv.T).init(msgif := msg) DO EVAL sve.setFromTextTextTbl(env); TRY ReadEnvFile(fn, env, sve, msg); EXCEPT SimpleValueEnv.E(e) => MsgX.Error(msg, "error reading environment file " & fn & ": " & e); END; END; END; END; END; SetTPCDefaults(env, tpcOverrides, tpcWarnings, msg); (* last of all: editor overrides from the environment *) IF MiniEnv.editorovr # NIL THEN EVAL env.put("editor", MiniEnv.editorovr); END; IF MiniEnv.httpdeditorovr # NIL THEN EVAL env.put("httpd-editor", MiniEnv.httpdeditorovr); END; RETURN env; END Eval;
PROCEDURE--------------------------------------------------------------------------Read (rd : Rd.T; env : TextTextTbl.T; msg : MsgIF.T := NIL) = VAR line, varname, value : TEXT; trd : TextRd.T; poolprefix : TEXT := NIL; mappingPattern := RegEx.Compile("-mapping$"); <* NOWARN *> mappingList : TextTupleSeq.T; localMappingLists := NEW(TextTextTupleSeqTbl.Default).init(); localMappingList : TextTupleSeq.T; (*------------------------------------------------------------------------*) PROCEDURE GetLocalMapping(name : TEXT) : TextTupleSeq.T = VAR map : TextTupleSeq.T; BEGIN IF localMappingLists.get(name, map) THEN RETURN map; ELSE RETURN NIL; END; END GetLocalMapping; (*------------------------------------------------------------------------*) PROCEDURE CombineMappingLists() = VAR name : TEXT; BEGIN WITH iter = localMappingLists.iterate() DO WHILE iter.next(name, localMappingList) DO mappingList := GetMapping(name); IF mappingList = NIL THEN mappingList := localMappingList; ELSE mappingList := TextTupleSeq.Cat(localMappingList, mappingList); END; EVAL mappingLists.put(name, mappingList); END; END; END CombineMappingLists; BEGIN TRY WHILE NOT Rd.EOF(rd) DO line := TextUtils.Compress(Rd.GetLine(rd)); IF line # NIL AND NOT Text.Empty(line) AND Text.GetChar(line, 0) # '#' AND Text.GetChar(line, 0) # ';' THEN trd := TextRd.New(line); WHILE NOT Rd.EOF(trd) DO varname := TextReadingUtils.GetTokenOrString(trd); IF RegEx.Execute(mappingPattern, varname) > -1 THEN (* mapping declaration *) localMappingList := GetLocalMapping(varname); IF localMappingList = NIL THEN localMappingList := NEW(TextTupleSeq.T).init(); END; VAR left, op, right : TEXT; alreadyThere := FALSE; tuple : TextTuple.T := NIL; BEGIN left := TextReadingUtils.GetTokenOrString(trd); op := TextReadingUtils.GetTokenOrString(trd); right := TextReadingUtils.GetTokenOrString(trd); IF Text.Equal(op, "=>") THEN FOR i := 0 TO localMappingList.size() - 1 DO tuple := localMappingList.get(i); IF Text.Equal(left, tuple.getFst()) THEN alreadyThere := TRUE; EXIT; END; END; IF alreadyThere THEN (* overwrite the existing entry *) EVAL tuple.init(left, right); ELSE WITH tuple = NEW(TextTuple.T).init(left, right) DO localMappingList.addhi(tuple); END; END; IF Msg.dFlag THEN MsgX.V(msg, " " & varname & ": " & left & " " & op & " " & right); END; ELSE MsgX.Error(msg, "mapping declaration error in " & "configuration file: " & line); END; END; EVAL localMappingLists.put(varname, localMappingList); ELSE (* default (name, value) declaration *) value := TextReadingUtils.GetTokenOrString(trd); IF Msg.dFlag THEN MsgX.V(msg, " " & varname & "=\"" & value & "\""); END; IF Text.Equal(varname, "poolprefix") THEN poolprefix := PathRepr.Native(value); EVAL env.put("poolprefix", poolprefix); ELSIF Text.Equal(varname, "localpool") THEN IF poolprefix # NIL THEN value := Pathname.Join(poolprefix, PathRepr.Native(value), NIL); ELSE value := PathRepr.Native(value); END; EVAL env.put("local pool", value); EVAL env.put("localpool", value); (* used by tf *) ELSIF Text.Equal(varname, "projectpool") THEN IF poolprefix # NIL THEN value := Pathname.Join(poolprefix, PathRepr.Native(value), NIL); ELSE value := PathRepr.Native(value); END; EVAL env.put("project pool", value); EVAL env.put("projectpool", value); (* used by tf *) ELSIF Text.Equal(varname, "globalpool") THEN IF poolprefix # NIL THEN value := Pathname.Join(poolprefix, PathRepr.Native(value), NIL); ELSE value := PathRepr.Native(value); END; EVAL env.put("global pool", value); EVAL env.put("globalpool", value); (* used by tf *) ELSIF Text.Equal(varname, "useexternalmkdir") THEN EVAL env.put("useExternalMakedir", value); ELSIF Text.Equal(varname, "useposixpathnames") THEN EVAL env.put("usePosixPathnames", value); ELSIF Text.Equal(varname, "project-collection") THEN EVAL env.put(varname, PathRepr.Native(value)); EVAL env.put("projects", PathRepr.Native(value)); ELSIF Text.Equal(varname, "package-collection") THEN EVAL env.put(varname, PathRepr.Native(value)); EVAL env.put("collection", PathRepr.Native(value)); ELSIF Text.Equal(varname, "bindir") OR Text.Equal(varname, "localbindir") OR Text.Equal(varname, "projectbindir") OR Text.Equal(varname, "configpath") OR Text.Equal(varname, "globalbindir") OR Text.Equal(varname, "packageprefix") OR Text.Equal(varname, "docdir") OR Text.Equal(varname, "localdocdir") OR Text.Equal(varname, "projectdocdir") OR Text.Equal(varname, "globaldocdir") OR Text.Equal(varname, "collectionroot") OR Text.Equal(varname, "package-collection-path") OR Text.Equal(varname, "project-collection-path") OR Text.Equal(varname, "editor") OR TextUtils.Pos(varname, "httpd-editor") = 0 OR Text.Equal(varname, "httpd-logfile") OR Text.Equal(varname, "browser") OR Text.Equal(varname, "browser-arguments") OR Text.Equal(varname, "browser-remote-arguments") OR Text.Equal(varname, "cvspath") OR Text.Equal(varname, "dcvspath") THEN EVAL env.put(varname, PathRepr.Native(value)); ELSIF Text.Equal(varname, "configuration") THEN EVAL env.put("configuration", value); EVAL env.put("tpc-default", value); EVAL env.put("tpc", value); ELSIF Text.Equal(varname, "linebreakcol") OR Text.Equal(varname, "httpd-resources") OR Text.Equal(varname, "httpd-port") OR Text.Equal(varname, "httpd-addr") OR Text.Equal(varname, "httpd-listen-address") OR Text.Equal(varname, "httpd-help-resources") OR Text.Equal(varname, "httpd-home-page") OR Text.Equal(varname, "httpd-error-page") OR Text.Equal(varname, "httpd-terminate-page") OR Text.Equal(varname, "httpd-source-page") OR Text.Equal(varname, "httpd-execute-page") OR Text.Equal(varname, "httpd-verbose") OR Text.Equal(varname, "httpd-trace") OR Text.Equal(varname, "httpd-debug") OR Text.Equal(varname, "httpd-pkgvmopt") OR Text.Equal(varname, "httpd-pkgmopt") OR Text.Equal(varname, "httpd-m3buildopt") OR Text.Equal(varname, "httpd-buildopt") OR Text.Equal(varname, "httpd-internal-log") OR Text.Equal(varname, "httpd-terminate-without-sessions") OR Text.Equal(varname, "httpd-terminate-default-session") OR Text.Equal(varname, "httpd-colored-projects") OR Text.Equal(varname, "httpd-colored-packages") OR Text.Equal(varname, "httpd-colored-files") OR Text.Equal(varname, "httpd-internal-vc") OR Text.Equal(varname, "httpd-gc-ratio") OR Text.Equal(varname, "httpd-gc-background") OR Text.Equal(varname, "httpd-stacksize") OR Text.Equal(varname, "httpd-default-stacksize") OR Text.Equal(varname, "httpd-global-lock") OR Text.Equal(varname, "prjm-internal-vc") OR Text.Equal(varname, "internal-vc") OR Text.Equal(varname, "repository") OR Text.Equal(varname, "dcvs-repository") OR Text.Equal(varname, "pkgkind") OR Text.Equal(varname, "vcignore") OR Text.Equal(varname, "vc-ignore") OR Text.Equal(varname, "vc-options") OR Text.Equal(varname, "vc-locking") OR Text.Equal(varname, "pics-size") OR Text.Equal(varname, "color-scheme") OR Text.Equal(varname, "enforce-pkgdeps") OR Text.Equal(varname, "editor-args-pathstyle") OR Text.Equal(varname, "optVerbose") OR Text.Equal(varname, "optDebug") OR Text.Equal(varname, "optQuiet") OR Text.Equal(varname, "optForce") THEN EVAL env.put(varname, value); ELSIF Text.Equal(varname, "cvsroot") THEN EVAL env.put("repository", value); ELSIF Text.Equal(varname, "dcvsroot") THEN EVAL env.put("dcvs-repository", value); ELSIF TextUtils.Pos(varname, "tpc-hosttype") = 0 OR TextUtils.Pos(varname, "tpc-ostype") = 0 OR TextUtils.Pos(varname, "tpc-variant") = 0 OR TextUtils.Pos(varname, "tpc-compiler") = 0 OR TextUtils.Pos(varname, "tpc-options") = 0 THEN EVAL env.put(varname, value); ELSIF Text.Equal(varname, "tpc") OR Text.Equal(varname, "tpc-default") THEN EVAL env.put("tpc", value); EVAL env.put("tpc-default", value); EVAL env.put("configuration", value); (* file cache ignore patterns *) ELSIF Text.Equal(varname, "filecache-ignore-dirs") OR Text.Equal(varname, "filecache-ignore-files") OR Text.Equal(varname, "fingerprint-ignore-dirs") OR Text.Equal(varname, "fingerprint-ignore-files") THEN EVAL env.put(varname, value); ELSIF TextUtils.Pos(varname, "external-") = 0 AND TextUtils.Pos(varname, "-hook") > 0 THEN EVAL env.put(varname, value); ELSE MsgX.V(msg, "unexpected variable name in configuration " & "file: " & varname & ", assuming macro", level := 2); MsgX.D(msg, "unexpected variable name in configuration " & "file: " & varname & ", assuming macro", level := 2); EVAL env.put(varname, value); END; END; END; END; END; IF env.get("editor-args-pathstyle", value) THEN IF Text.Equal(value, "posix") THEN MiniEnv.editorArgsPathStyle := 'p'; ELSIF Text.Equal(value, "win32") THEN MiniEnv.editorArgsPathStyle := 'w'; ELSE MiniEnv.editorArgsPathStyle := 'n'; END; END; EXCEPT Rd.Failure => MsgX.Error(msg, "read failure on config file"); | Rd.EndOfFile => (* skip *) | Thread.Alerted => MsgX.Fatal(msg, "internal error: alert"); END; TRY Rd.Close(rd); EXCEPT ELSE END; CombineMappingLists(); END Read;
PROCEDURE--------------------------------------------------------------------------EnvFileLocation (home : TEXT) : TEXT = VAR fn : TEXT; rc : TEXT; compact := Pathname.Join(home, "compact", NIL); BEGIN fn := Pathname.Join(home, ".compact-env-rc", NIL); IF FSUtils.IsFile(fn) THEN RETURN fn; END; fn := Pathname.Join(compact, "compact-env-rc", NIL); IF FSUtils.IsFile(fn) THEN RETURN fn; END; fn := Pathname.Join(home, ".compact-env-rc", NIL); rc := Pathname.Join(home, ".compactrc", NIL); IF FSUtils.IsFile(rc) THEN RETURN fn; END; fn := Pathname.Join(compact, "compact-env-rc", NIL); rc := Pathname.Join(compact, "compactrc", NIL); IF FSUtils.IsFile(rc) THEN RETURN fn; END; IF FSUtils.IsDir(compact) THEN RETURN fn; END; RETURN Pathname.Join(home, ".compact-env-rc", NIL); END EnvFileLocation;
PROCEDURE--------------------------------------------------------------------------ReadEnvFile (fn : TEXT; env : TextTextTbl.T; sve : SimpleValueEnv.T; msg : MsgIF.T := NIL) RAISES {SimpleValueEnv.E} = VAR keys : TextList.T; n, v : TEXT; old : TEXT; BEGIN SimpleValueEnv.ReadFile(fn, sve); keys := sve.keyList(rec := FALSE); WHILE keys # NIL DO n := keys.head; IF sve.type(n) = SimpleValueEnv.Type.Text OR sve.type(n) = SimpleValueEnv.Type.Int OR sve.type(n) = SimpleValueEnv.Type.Nat OR sve.type(n) = SimpleValueEnv.Type.List OR sve.type(n) = SimpleValueEnv.Type.Seq THEN v := sve.substTextVal(n); old := GetValue(env, n, msg); IF env.put(n, v) AND NOT Text.Equal(v, old) THEN MsgX.Warning(msg, "overwriting old setting for variable `" & n & "' (`" & old & "') with new value `" & v & "' from file " & fn); END; END; keys := keys.tail; END; END ReadEnvFile;
PROCEDURE--------------------------------------------------------------------------WriteEnvFile (fn : TEXT := NIL; sve : SimpleValueEnv.T; keys : TextList.T := NIL; rec := FALSE) RAISES {SimpleValueEnv.E} = VAR home : TEXT; BEGIN IF sve.type("HOME") = SimpleValueEnv.Type.Text THEN home := sve.substTextVal("HOME"); ELSE home := MiniEnv.home; END; IF fn = NIL THEN fn := EnvFileLocation(home); END; SimpleValueEnv.WriteFile(fn, sve, keys, rec); END WriteEnvFile;
PROCEDURE--------------------------------------------------------------------------ComputePkgKind (env : TextTextTbl.T; msg : MsgIF.T := NIL) : TEXT = VAR pkgKind : TEXT; tpc_hosttype : TEXT; tpc_ostype : TEXT; platformMapping : TextTupleSeq.T; platformPattern : RegEx.Pattern; platform : TEXT; suffix : TEXT := NIL; i : INTEGER; BEGIN IF NOT env.get("tpc-hosttype", tpc_hosttype) THEN tpc_hosttype := "unknown"; END; IF NOT env.get("tpc-ostype", tpc_ostype) THEN tpc_ostype := "unknown"; END; platform := tpc_hosttype & "-" & tpc_ostype; (* first determine a suffix for the default package kind *) platformMapping := GetMapping("platform-suffix-mapping"); IF platformMapping # NIL THEN MsgX.V(msg, " evaluating pkgkind platform suffix..."); i := 0; WHILE suffix = NIL AND i < platformMapping.size() DO WITH tuple = platformMapping.get(i) DO MsgX.D(msg, " trying platform suffix mapping " & tuple.getFst() & " => " & tuple.getScd()); TRY platformPattern := RegEx.Compile(tuple.getFst()); IF RegEx.Execute(platformPattern, platform) > -1 THEN suffix := tuple.getScd(); MsgX.V(msg, " " & tuple.getFst() & " matching platform, " & "using platform suffix " & suffix); END; EXCEPT RegEx.Error(e) => MsgX.Error(msg, "malformed regular expression " & "in configuration file: " & e); END; END; INC(i); END; END; IF suffix # NIL THEN EVAL env.put("platform-suffix", suffix); END; (* platform-suffix adjusted to current platform *) IF env.get("pkgkind", pkgKind) THEN pkgKind := TextUtils.SubstEnvVars(pkgKind, penv); (* all environment variables have been substituted in the pkgkind expression *) TRY pkgKind := TextUtils.SubstituteVariables(pkgKind, env); EXCEPT TextUtils.Error(e) => MsgX.Fatal(msg, "error in pkgkind string: " & e); END; (* all internal environement variables have been substituted in the pkgkind expression *) ELSE pkgKind := NIL; END; IF pkgKind = NIL THEN MsgX.V(msg, "default package kind from compactrc undefined"); ELSE MsgX.V(msg, "default package kind from compactrc is " & pkgKind); END; RETURN pkgKind; END ComputePkgKind;
PROCEDURE--------------------------------------------------------------------------ComputeTPC (env : TextTextTbl.T; msg : MsgIF.T := NIL) : TEXT = VAR cfg := Env.Get("PKG_CONFIGURATION"); pkgKindMapping : TextTupleSeq.T; pkgKindPattern : RegEx.Pattern; pkgKind : TEXT; i : INTEGER; BEGIN IF NOT env.get("pkgkind", pkgKind) THEN pkgKind := "undefined"; END; MsgX.V(msg, " detecting target platform configuration (tpc)..."); IF cfg = NIL THEN cfg := Env.Get("TPC"); END; IF cfg = NIL THEN (* first use pkgkind-mapping to compute a valid tpc *) pkgKindMapping := GetMapping("pkgkind-tpc-mapping"); IF pkgKindMapping # NIL THEN MsgX.V(msg, " evaluating pkgkind mapping..."); i := 0; WHILE cfg = NIL AND i < pkgKindMapping.size() DO WITH tuple = pkgKindMapping.get(i) DO MsgX.D(msg, " trying package kind mapping " & tuple.getFst() & " => " & tuple.getScd()); TRY pkgKindPattern := RegEx.Compile(tuple.getFst()); IF RegEx.Execute(pkgKindPattern, pkgKind) > -1 THEN cfg := tuple.getScd(); MsgX.V(msg, " " & tuple.getFst() & " matching package kind, " & "using TPC expression " & cfg); END; EXCEPT RegEx.Error(e) => MsgX.Error(msg, "malformed regular expression " & "in configuration file: " & e); END; END; INC(i); END; END; IF cfg = NIL THEN (* fall back on default-configuration *) IF env.get("configuration", cfg) THEN MsgX.V(msg, " using TPC from resources: " & cfg); ELSE MsgX.Fatal( msg, "need target-platform-configuration (TPC) from environment\n" & "or from ~/.compactrc or compactrc resource file.\n" & "Try `pkgm -man' and search for TPC for more information."); END; END; ELSE MsgX.V(msg, " using TPC/PKG_CONFIGURATION from environment: " & cfg); EVAL env.put("configuration", cfg); END; cfg := TextUtils.SubstEnvVars(cfg, penv); (* all environment variables have been substituted in the tpc expression *) TRY cfg := TextUtils.SubstituteVariables(cfg, env); EXCEPT TextUtils.Error(e) => MsgX.Fatal(msg, "error in TPC string: " & e); END; (* all internal environement variables have been substituted in the tpc expression *) MsgX.V(msg, " TPC = " & cfg); RETURN cfg; END ComputeTPC;
PROCEDURE--------------------------------------------------------------------------Defined (env : TextTextTbl.T; name : TEXT) : BOOLEAN = VAR val : TEXT; BEGIN RETURN env.get(name, val); END Defined;
PROCEDURE--------------------------------------------------------------------------Get (env : TextTextTbl.T; name : TEXT) : TEXT = VAR val : TEXT; BEGIN IF env.get(name, val) THEN RETURN val ELSE RETURN NIL; END; END Get;
PROCEDURE--------------------------------------------------------------------------Put (env : TextTextTbl.T; name : TEXT; val : TEXT) = BEGIN EVAL env.put(name, val); END Put;
PROCEDURE--------------------------------------------------------------------------GetValue (env : TextTextTbl.T; name : TEXT; msg : MsgIF.T) : TEXT = VAR val := Get(env, name); BEGIN IF val = NIL THEN RETURN NIL END; (* obsolete IF Defined(env, "HOME") THEN val := TextUtils.Substitute(val, "{HOME}", Get(env, "HOME")); END; IF Defined(env, "USER") THEN val := TextUtils.Substitute(val, "{USER}", Get(env, "USER")); END; *) val := TextUtils.SubstEnvVars(val, penv); (* all environment variables have been substituted in val *) TRY val := TextUtils.SubstituteVariables(val, env); EXCEPT TextUtils.Error(e) => MsgX.Error(msg, "error in variable definition: " & e); END; (* all internal environement variables have been substituted in val *) RETURN val; END GetValue;
PROCEDURE--------------------------------------------------------------------------Evaluate (env: TextTextTbl.T; msg : MsgIF.T) : TextTextTbl.T = VAR iter := env.iterate(); res := NEW(TextTextTbl.Default).init(env.size()); name, val : TEXT; BEGIN WHILE iter.next(name, val) DO IF val # NIL AND Text.Length(val) > 0 THEN IF Text.GetChar(val, 0) = '!' THEN val := Text.Sub(val, 1); ELSE val := GetValue(env, name, msg); IF val = NIL THEN val := "undefined"; END; END; EVAL res.put(name, val); END; END; RETURN res; END Evaluate;
PROCEDURE--------------------------------------------------------------------------GetEditorCmd (env : SimpleValueEnv.T; files : TEXT; msg : MsgIF.T := NIL) : TEXT = VAR fnexample : TEXT; fnext : TEXT; res : TEXT := NIL; BEGIN WITH fnlist = TextUtils.Tokenize(files) DO IF fnlist.size() > 0 THEN fnexample := fnlist.get(fnlist.size() - 1); fnext := Pathname.LastExt(fnexample); ELSE fnexample := files; fnext := ""; END; END; IF MiniEnv.editorArgsPathStyle = 'p' THEN files := PathRepr.Posix(files); ELSIF MiniEnv.editorArgsPathStyle = 'w' THEN files := PathRepr.Win32(files); ELSE files := PathRepr.Native(files); END; (* let's first try the filename-editor-mapping, if it is defined *) IF MappingDefined("filename-editor-mapping") THEN VAR map := GetMapping("filename-editor-mapping"); i := 0; re : RegEx.Pattern; BEGIN WHILE i < map.size() AND res = NIL DO WITH tuple = map.get(i), pat = tuple.getFst(), ed = tuple.getScd() DO TRY re := RegEx.Compile(pat); IF RegEx.Execute(re, fnexample) > - 1 THEN res := ed & " " & files; END; EXCEPT RegEx.Error(e) => MsgX.Error(msg, "malformed regular expression " & "in configuration file: " & e); END; END; INC(i); END; END; END; IF res = NIL THEN (* Let's look for a special declaration based on the file extension, e.g. httpd-editor-txt or httpd-editor-gif *) IF env.defined("httpd-editor-" & fnext) THEN res := env.substTextVal("httpd-editor-" & fnext) & " " & files; ELSIF env.defined("httpd-editor") THEN res := env.substTextVal("httpd-editor") & " " & files; ELSIF env.defined("editor") THEN res := env.substTextVal("editor") & " " & files; ELSE res := "xterm -e vi " & files; END; END; RETURN res; END GetEditorCmd;
CONST ignErr = CompactClient.EB.Ignore;--------------------------------------------------------------------------
PROCEDURE--------------------------------------------------------------------------GetRsrcText (name : TEXT; bundle : Bundle.T; rsrcPath : Rsrc.Path; env : TextTextTbl.T := NIL; senv : SimpleValueEnv.T := NIL; commentStart := "# "; msg : MsgIF.T := NIL) : TEXT = PROCEDURE AddComment(c : TEXT) = BEGIN IF commentStart = NIL THEN RETURN END; res := res & "\n" & commentStart & "--------------------------------" & "--------------------------------------------\n"; res := res & commentStart & "(" & Fmt.Int(nr) & ") " & c & "\n"; res := res & commentStart & "--------------------------------" & "--------------------------------------------\n" & "\n"; INC(nr); END AddComment; PROCEDURE AddRemoteText(server : TEXT) = BEGIN IF server # NIL THEN WITH data = CompactClient.RemoteRsrcText(compactClient, server, name, env, NIL, ignErr) DO IF data = NIL THEN MsgX.V(msg, "no remote resource " & name); ELSE MsgX.V(msg, "reading remote resource " & name); AddComment("remote resource from server " & server); res := res & data; END; END; END; END AddRemoteText; VAR data : TEXT; server : TEXT; nr := 1; res := ""; BEGIN (* read the compiled-in definitions for package kinds *) MsgX.V(msg, "reading bundled resource " & name); AddComment("bundled resource"); res := res & Bundle.Get(bundle, name); (* try the remote resource service *) server := Env.Get("COMPACTSERVER"); AddRemoteText(server); IF server = NIL THEN IF env # NIL THEN server := GetValue(env, "compactserver", msg); AddRemoteText(server); END; IF senv # NIL THEN server := senv.textValOrNil("compactserver"); AddRemoteText(server); END; END; (* last but not least check resources in the local file system *) TRY data := Rsrc.Get(name, rsrcPath); MsgX.V(msg, "reading local resource " & name); AddComment("local resource from file"); res := res & data; EXCEPT Rsrc.NotFound => (* skip *) MsgX.V(msg, "no local resource " & name); ELSE MsgX.Fatal(msg, "internal error in resource " & name, 1001); END; RETURN res; END GetRsrcText;
PROCEDURE--------------------------------------------------------------------------GetSingleRsrcText (name : TEXT; rsrcPath : Rsrc.Path; bundlePath : Rsrc.Path; env : TextTextTbl.T := NIL; senv : SimpleValueEnv.T := NIL; msg : MsgIF.T := NIL) : TEXT = PROCEDURE GetRemoteText(server : TEXT) = BEGIN IF server # NIL THEN WITH data = CompactClient.RemoteRsrcText(compactClient, server, name, env, NIL, ignErr) DO IF data = NIL THEN MsgX.V(msg, "no remote resource " & name); ELSE MsgX.V(msg, "reading remote resource " & name); res := data; END; END; END; END GetRemoteText; VAR res : TEXT := NIL; server : TEXT := NIL; BEGIN (* check if there is a local resource *) IF rsrcPath # NIL THEN TRY res := Rsrc.Get(name, rsrcPath); MsgX.V(msg, "reading local resource " & name); EXCEPT Rsrc.NotFound => (* skip *) MsgX.V(msg, "no local resource " & name); ELSE MsgX.Error(msg, "error reading local resource " & name); END; IF res # NIL THEN RETURN res END; END; (* try to contact the remote service defined in `compactserver' *) IF env # NIL THEN IF senv # NIL THEN server := senv.textValOrNil("compactserver"); GetRemoteText(server); IF res # NIL THEN RETURN res END; END; IF env # NIL THEN server := GetValue(env, "compactserver", msg); GetRemoteText(server); IF res # NIL THEN RETURN res END; END; END; (* try to locate the remote service defined by environment variable *) IF server = NIL THEN server := Env.Get("COMPACTSERVER"); END; GetRemoteText(server); IF res # NIL THEN RETURN res END; (* last of all try the bundled resources *) IF bundlePath # NIL THEN TRY res := Rsrc.Get(name, bundlePath); MsgX.V(msg, "reading bundled resource " & name); EXCEPT Rsrc.NotFound => (* skip *) MsgX.V(msg, "no bundled resource " & name); ELSE MsgX.Error(msg, "error reading bundled resource " & name); END; END; RETURN res; END GetSingleRsrcText;
VAR penv := ProcessEnv.Current(); compactClient : CompactClient.T := NIL; BEGIN mappingLists := NEW(TextTextTupleSeqTbl.Default).init(); END CompactRC.