MODULE Repositories; (** AUTHOR "staubesv"; PURPOSE "Component repositories"; *) IMPORT Streams, Modules, KernelLog, Commands, Strings, Files, Archives, Localization, UTF8Strings, XML, XMLObjects, XMLScanner, XMLParser, WMEvents; CONST Ok* = 0; NotFound* = 10; RepositoryNotFound* = 11; ComponentNotFound* = 12; RepositoryNotLoaded* = 13; DuplicateName* = 20; DuplicateID* = 21; DuplicateRepository* = 22; IndexError* = 50; CannotCreateArchive* = 100; ArchivesError* = 101; WrongVersion* = 200; FormatError* = 201; ParseError* = 300; DictionaryNotFound* = 400; LanguageNotAvailable* = 410; LanguageFileNotFound* = 420; InternalError* = 999; (* Component.flags *) Generated = 0; (* this component composite was generated by a generator procedure *) Locked = 1; (* this component composite is part of a loaded component *) IndexFile = "index.xml"; DefaultFileExtension* = "rep"; Delimiter* = ":"; PrototypeID = 0; (* Header information *) Version = 1; Quote = '"'; EscapeCharacter = "&"; EscapeQuote = """; (* IndexEntry.type *) Type_Component = 1; Type_Generator = 2; CommandPrefix* = "cmd:"; (* Strings used in XML index file *) XmlRepository = "Repository"; XmlComponents = "Components"; XmlComponent = "Component"; XmlDictionaries = "Dictionaries"; XmlDictionary = "Dictionary"; XmlLanguage = "Language"; XmlApplications = "Applications"; XmlApplication = "Application"; XmlAttributeName = "name"; XmlAttributeDefault = "default"; XmlAttributeID = "id"; XmlAttributeSource = "source"; TraceLoading = 0; TraceInstantiate = 1; TraceCreation = 2; Trace = {}; TYPE Context* = OBJECT(Commands.Context) VAR object* : ANY; PROCEDURE &Init*(in, arg : Streams.Reader; out, error : Streams.Writer; caller: OBJECT); BEGIN Init^(in, arg, out, error, caller); object := NIL; END Init; END Context; StoreContext*= OBJECT VAR repository-: Repository; PROCEDURE &InitStoreContext(r: Repository); BEGIN repository := r; END InitStoreContext; END StoreContext; Command* = PROCEDURE {DELEGATE} (context : Context); TYPE (** Base class of all components *) Component* = OBJECT(XML.Element) VAR repository : Repository; name : Strings.String; refNum : LONGINT; flags : SET; timestamp- : LONGINT; onChanged* : WMEvents.EventSource; (* for update mechanisms, basically every component needs a feature to inform about updates *) PROCEDURE &Init*; BEGIN Init^; repository := NIL; name := NIL; refNum := 0; flags := {}; timestamp := 0; NEW(onChanged, NIL, NIL, NIL, NIL); END Init; PROCEDURE SetGenerator*(CONST gen: ARRAY OF CHAR); BEGIN SetAttributeValue("generator", gen); END SetGenerator; PROCEDURE SetRepository*(repository : Repository; CONST name : Name; refNum : LONGINT); BEGIN {EXCLUSIVE} SELF.repository := repository; SELF.refNum := refNum; IF (repository # NIL) THEN SELF.name := Strings.NewString(name); SetNameAsString(SELF.name); (* SetNameAsString(NewJoinName(repository.name, name, refNum)); *) ELSE IF (SELF.name # NIL) THEN SetNameAsString(SELF.name); SELF.name := NIL; ELSE SetName("Unbound"); END; END; INC(timestamp); END SetRepository; PROCEDURE GetRepository*(VAR repository : Repository; VAR name : Name; VAR refNum : LONGINT); BEGIN {EXCLUSIVE} repository := SELF.repository; refNum := SELF.refNum; IF (SELF.name # NIL) THEN COPY(SELF.name^, name); ELSE name := ""; END; END GetRepository; PROCEDURE IsLocked*() : BOOLEAN; BEGIN RETURN Locked IN flags; END IsLocked; PROCEDURE FromXML*(xml: XML.Element); VAR component: Component; enum: XMLObjects.Enumerator; c: ANY; BEGIN enum := xml.GetContents(); WHILE enum.HasMoreElements() DO c := enum.GetNext(); IF c IS XML.Element THEN component := ComponentFromXML(c(XML.Element)); IF component # NIL THEN AddContent(component) END; END; END; END FromXML; END Component; TYPE Name* = ARRAY 32 OF CHAR; ApplicationInfo = OBJECT(XML.Element) END ApplicationInfo; ComponentInfo = OBJECT(XML.Element) VAR name, source : Strings.String; (* { (name # NIL) & (source # NIL) } *) type, id : LONGINT; instance : ANY; next : ComponentInfo; PROCEDURE &Init*; BEGIN Init^; SetNameAsString(StrComponent); name := StrNoName; source := StrNoName; type := Type_Generator; id := 0; instance := NIL; next := NIL; END Init; PROCEDURE AddAttribute*(attribute : XML.Attribute); VAR name, temp : Strings.String; BEGIN name := attribute.GetName(); IF (name # NIL) THEN IF (name^ = XmlAttributeName) THEN SELF.name := attribute.GetValue(); IF (SELF.name = NIL) THEN SELF.name := StrNoName; END; ELSIF (name^ = XmlAttributeID) THEN temp := attribute.GetValue(); IF (temp # NIL) THEN Strings.StrToInt(temp^, SELF.id); END; ELSIF (name^ = XmlAttributeSource) THEN temp := attribute.GetValue(); IF (temp # NIL) THEN source := temp; IF IsXmlFilename(source^) THEN type := Type_Component; ELSE type := Type_Generator; END; ELSE source := StrNoName; END; END; END; AddAttribute^(attribute); END AddAttribute; END ComponentInfo; TYPE IndexRegistry* = OBJECT(XML.ElementRegistry) PROCEDURE InstantiateElement*(CONST name: ARRAY OF CHAR): XML.Element; VAR element : XML.Element; appInfo : ApplicationInfo; comInfo : ComponentInfo; repository : Repository; dictionary : Dictionary; BEGIN element := NIL; IF (name = XmlApplication) THEN NEW(appInfo); element := appInfo; ELSIF (name = XmlComponent) THEN NEW(comInfo); element := comInfo; ELSIF (name = XmlRepository) THEN NEW(repository); element := repository; ELSIF (name = XmlDictionary) THEN NEW(dictionary); element := dictionary; END; RETURN element; END InstantiateElement; END IndexRegistry; TYPE Entry = OBJECT VAR word, translation : Strings.String; next : Entry; PROCEDURE &Init(word, translation : Strings.String); BEGIN ASSERT((word # NIL) & (translation # NIL)); SELF.word := word; SELF.translation := translation; next := NIL; END Init; END Entry; TYPE Translator = OBJECT VAR entries : Entry; PROCEDURE &Init; BEGIN entries := NIL; END Init; PROCEDURE Add(word, translation : Strings.String); VAR e, newEntry : Entry; BEGIN ASSERT((word # NIL) & (translation # NIL)); e := Find(word^); IF (e = NIL) THEN NEW(newEntry, word, translation); IF (entries = NIL) THEN entries := newEntry; ELSIF (UTF8Strings.Compare(word^, entries.word^) # UTF8Strings.CmpLess) THEN newEntry.next := entries; entries := newEntry; ELSE e := entries; WHILE (e.next # NIL) & (UTF8Strings.Compare(word^, e.next.word^) = UTF8Strings.CmpLess) DO e := e.next; END; newEntry.next := e.next; e.next := newEntry; END; ELSE KernelLog.String("Repositories.Translator: Warning: Ignoring duplicate dictionary entry ("); KernelLog.String(word^); KernelLog.String(", "); KernelLog.String(translation^); KernelLog.String(")"); KernelLog.Ln; END; END Add; PROCEDURE Parse(reader : Streams.Reader; VAR res : WORD); VAR buffer : Strings.Buffer; entry : Entry; ch : CHAR; PROCEDURE ReportError(CONST msg : ARRAY OF CHAR; position : LONGINT); BEGIN KernelLog.String("Repositories.Dictionary.Parse: Error: "); KernelLog.String(msg); KernelLog.String(" at position "); KernelLog.Int(position, 0); KernelLog.Ln; END ReportError; (* Read all characters until '"' OR 0X (excl) *) PROCEDURE GetString(reader : Streams.Reader) : Strings.String; VAR temp : Strings.String; writer : Streams.Writer; escaping : BOOLEAN; escape : ARRAY 8 OF CHAR; i : LONGINT; BEGIN ASSERT(reader # NIL); buffer.Clear; writer := buffer.GetWriter(); escaping := FALSE; ch := reader.Peek(); WHILE (ch # Quote) & (ch # 0X) DO ch := reader.Get(); IF (ch = EscapeCharacter) THEN IF (escaping) THEN writer.String(escape); ELSE escaping := TRUE; END; escape[0] := EscapeCharacter; escape[1] := 0X; i := 1; ELSIF escaping THEN escape[i] := ch; escape[i + 1] := 0X; INC(i); IF Strings.Length(escape) = Strings.Length(EscapeQuote) THEN escaping := FALSE; IF (escape = EscapeQuote) THEN writer.Char(Quote); ELSE writer.String(escape); END; END; ELSE writer.Char(ch); END; ch := reader.Peek(); END; IF escaping THEN writer.String(escape); END; temp := buffer.GetString(); RETURN Strings.NewString(temp^); END GetString; (** Parse and generate one entry of the form "word"="translation" *) PROCEDURE ParseEntry(reader : Streams.Reader) : BOOLEAN; VAR ch : CHAR; word, translation : Strings.String; BEGIN ASSERT(reader # NIL); entry := NIL; reader.SkipWhitespace; ch := reader.Get(); IF (ch = Quote) THEN word := GetString(reader); ch := reader.Get(); IF (ch = Quote) THEN reader.SkipWhitespace; ch := reader.Get(); IF (ch = "=") THEN reader.SkipWhitespace; ch := reader.Get(); IF (ch = Quote) THEN translation := GetString(reader); ch := reader.Get(); IF (ch = Quote) THEN Add(word, translation); RETURN TRUE; ELSE ReportError("Expected closing quote", reader.Pos() - 1); END; ELSE ReportError("Expected opening quote", reader.Pos() - 1); END; ELSE ReportError("Expected equal sign", reader.Pos() - 1); END; ELSE ReportError("Expected closing quote", reader.Pos() - 1); END; ELSE ReportError("Expected opening quote", reader.Pos() - 1); END; RETURN FALSE; END ParseEntry; BEGIN ASSERT(reader # NIL); NEW(buffer, 512); reader.SkipWhitespace; ch := reader.Peek(); WHILE (ch # 0X) & ParseEntry(reader) DO reader.SkipWhitespace; ch := reader.Peek(); END; IF (ch = 0X) THEN res := Ok; ELSE res := ParseError; END; END Parse; PROCEDURE Find(CONST word : ARRAY OF CHAR) : Entry; VAR e : Entry; result : LONGINT; BEGIN result := UTF8Strings.CmpLess; e := entries; LOOP IF (e = NIL) THEN EXIT; END; result := UTF8Strings.Compare(word, e.word^); IF (result # UTF8Strings.CmpLess) THEN EXIT; ELSE e := e.next; END; END; IF (result = UTF8Strings.CmpEqual) THEN ASSERT(e # NIL); RETURN e; ELSE RETURN NIL; END; END Find; PROCEDURE ComplexTranslation(CONST word : ARRAY OF CHAR) : Strings.String; VAR buf : ARRAY 1024 OF CHAR; i, j : LONGINT; translation : Strings.String; w : Name; PROCEDURE BoundsCheck() : BOOLEAN; BEGIN RETURN (i < LEN(word)) & (j < LEN(buf) - 1); END BoundsCheck; PROCEDURE Append; BEGIN WHILE BoundsCheck() & (word[i] # 0X) & (word[i] # ":") DO buf[j] := word[i]; INC(j); INC(i); END; END Append; PROCEDURE AppendTranslation(CONST translation : ARRAY OF CHAR); VAR idx : LONGINT; BEGIN idx := 0; WHILE (j < LEN(buf) - 1) & (idx < LEN(translation)) & (translation[idx] # 0X) DO buf[j] := translation[idx]; INC(j); INC(idx); END; buf[j] := 0X; END AppendTranslation; PROCEDURE GetName(VAR w : ARRAY OF CHAR) : BOOLEAN; VAR getName : BOOLEAN; idx : LONGINT; BEGIN getName := TRUE; w := ""; WHILE BoundsCheck() & (word[i] = ":") DO (** unescape :: to : *) IF getName THEN buf[j] := ":"; getName := FALSE; ELSE getName := TRUE; END; INC(i); END; IF getName THEN idx := 0; WHILE (i < LEN(word)) & (word[i] # 0X) & (word[i] # ":") DO IF (idx < LEN(w) - 1) THEN w[idx] := word[i]; INC(idx); END; INC(i); END; w[idx] := 0X; IF (i < LEN(word)) & (word[i] = ":") THEN INC(i); END; END; RETURN getName & (w # ""); END GetName; BEGIN i := 0; j := 0; WHILE BoundsCheck() & (word[i] # 0X) DO Append; IF BoundsCheck() & (word[i] = ":") THEN INC(i); (* skip ":" *) IF GetName(w) THEN ASSERT(Strings.Count(w, ":") = 0); translation := TranslateAOC(w); ASSERT(translation # NIL); AppendTranslation(translation^); END; END; END; buf[j] := 0X; RETURN Strings.NewString(buf); END ComplexTranslation; PROCEDURE TranslateAOC(CONST word : ARRAY OF CHAR) : Strings.String; VAR result : Strings.String; entry : Entry; BEGIN IF Strings.Count(word, ":") = 0 THEN entry := Find(word); IF (entry # NIL) THEN result := entry.translation; ELSE result := Strings.NewString(word); END; ELSE result := ComplexTranslation(word); END; ASSERT(result # NIL); RETURN result; END TranslateAOC; PROCEDURE Translate(word : Strings.String) : Strings.String; VAR result : Strings.String; entry : Entry; BEGIN ASSERT(word # NIL); IF Strings.Count(word^, ":") = 0 THEN (* simple translation *) entry := Find(word^); IF (entry # NIL) THEN result := entry.translation; ELSE result := word; END; ELSE result := ComplexTranslation(word^); END; ASSERT(result # NIL); RETURN result; END Translate; END Translator; TYPE Language = RECORD code : ARRAY 3 OF CHAR; source : Files.FileName; translator : Translator; error, default : BOOLEAN; END; TYPE Dictionary* = OBJECT(XML.Element) VAR fullname- : Strings.String; (* {fullname # NIL} *) name : Strings.String; languages : POINTER TO ARRAY OF Language; repository : Repository; next : Dictionary; PROCEDURE &Init*; BEGIN Init^; fullname := StrNoName; name := StrNoName; languages := NIL; repository := NIL; next := NIL; END Init; PROCEDURE Initialize; VAR temp : ARRAY 256 OF CHAR; BEGIN ASSERT(repository # NIL); COPY(repository.name, temp); Strings.Append(temp, ":"); Strings.Append(temp, name^); fullname := Strings.NewString(temp); InitializeLanguages; END Initialize; PROCEDURE InitializeLanguages; VAR enum : XMLObjects.Enumerator; string : Strings.String; ptr : ANY; nofLanguages, i : LONGINT; BEGIN nofLanguages := 0; enum := GetContents(); WHILE enum.HasMoreElements() DO ptr := enum.GetNext(); IF (ptr IS XML.Element) THEN string := ptr(XML.Element).GetName(); IF (string # NIL) & (string^ = XmlLanguage) & (ptr(XML.Element).GetAttributeValue(XmlAttributeName) # NIL) THEN INC(nofLanguages); END; END; END; IF (nofLanguages > 0) THEN NEW(languages, nofLanguages); i := 0; enum.Reset; WHILE enum.HasMoreElements() DO ptr := enum.GetNext(); IF (ptr IS XML.Element) THEN string := ptr(XML.Element).GetName(); IF (string # NIL) & (string^ = XmlLanguage) THEN string := ptr(XML.Element).GetAttributeValue(XmlAttributeName); IF (string # NIL) THEN COPY(string^, languages[i].code); string := ptr(XML.Element).GetAttributeValue(XmlAttributeSource); IF (string # NIL) THEN COPY(string^, languages[i].source); END; string := ptr(XML.Element).GetAttributeValue(XmlAttributeDefault); languages[i].default := (string # NIL) & (string^ = "true"); languages[i].translator := NIL; languages[i].error := FALSE; INC(i); END; END; END; END; END; END InitializeLanguages; PROCEDURE Find(CONST language : Localization.Language) : Translator; VAR t : Translator; res: WORD; i : LONGINT; BEGIN t := NIL; IF (languages # NIL) THEN i := 0; WHILE (i < LEN(languages)) & (languages[i].code # language.code) DO INC(i); END; IF (i < LEN(languages)) THEN t := languages[i].translator; IF (t = NIL) & ~languages[i].error THEN LoadLanguage(languages[i], res); IF (res = Ok) THEN t := languages[i].translator; ELSE KernelLog.String("Repositories.Dictionary "); IF (name # NIL) THEN KernelLog.String(name^); ELSE KernelLog.String("UNKNOWN"); END; KernelLog.String(": ERROR: Could not load language file "); KernelLog.String(languages[i].source); KernelLog.String(", res = "); KernelLog.Int(res, 0); KernelLog.Ln; END; END; END; END; RETURN t; END Find; PROCEDURE GetDefaultTranslator() : Translator; VAR t : Translator; i: LONGINT; res : WORD; BEGIN t := NIL; IF (languages # NIL) THEN i := 0; WHILE (i < LEN(languages)) & ~languages[i].default DO INC(i); END; IF (i < LEN(languages)) THEN t := languages[i].translator; IF (t = NIL) & ~languages[i].error THEN LoadLanguage(languages[i], res); IF (res = Ok) THEN t := languages[i].translator; END; END; END; END; RETURN t; END GetDefaultTranslator; PROCEDURE FindBestMatch(languages : Localization.Languages) : Translator; VAR translator : Translator; i : LONGINT; BEGIN ASSERT(languages # NIL); translator := NIL; i := 0; WHILE (translator = NIL) & (i < LEN(languages)) DO translator := Find(languages[i]); INC(i); END; IF (translator = NIL) THEN translator := GetDefaultTranslator(); END; RETURN translator; END FindBestMatch; PROCEDURE AddAttribute*(attribute : XML.Attribute); VAR name : Strings.String; BEGIN name := attribute.GetName(); IF (name # NIL) THEN IF (name^ = XmlAttributeName) THEN SELF.name := attribute.GetValue(); IF (SELF.name = NIL) THEN SELF.name := StrNoName; END; END; END; AddAttribute^(attribute); END AddAttribute; PROCEDURE LoadLanguage(VAR language :Language; VAR res : WORD); VAR translator : Translator; reader : Streams.Reader; BEGIN {EXCLUSIVE} ASSERT(repository # NIL); reader := repository.GetFile(language.source); IF (reader # NIL) THEN NEW(translator); translator.Parse(reader, res); IF (res = Ok) THEN language.translator := translator; ELSE language.error := TRUE; res := ParseError; END; ELSE language.error := TRUE; res := LanguageFileNotFound; END; END LoadLanguage; (** Translate UTF8 string 'word' to UTF8 string translation. The resulting string has to be considered immutable! *) PROCEDURE TranslateAOC*(CONST word : ARRAY OF CHAR; languages : Localization.Languages) : Strings.String; VAR translator : Translator; translation : Strings.String; BEGIN ASSERT(languages # NIL); translator := FindBestMatch(languages); IF (translator # NIL) THEN translation := translator.TranslateAOC(word); ELSE translation := Strings.NewString(word); END; RETURN translation; END TranslateAOC; (** Translate UTF8 string 'word' to UTF8 string translation. The resulting string has to be considered immutable! *) PROCEDURE Translate*(word : Strings.String; languages : Localization.Languages) : Strings.String; VAR translator : Translator; translation : Strings.String; BEGIN ASSERT(languages # NIL); IF (word # NIL) THEN translator := FindBestMatch(languages); IF (translator # NIL) THEN translation := translator.Translate(word); ELSE translation := word; END; ELSE translation := NIL; END; ASSERT(((word = NIL) & (translation = NIL)) OR ((word # NIL) & (translation # NIL))); RETURN translation; END Translate; PROCEDURE GetLanguages*() : Localization.Languages; VAR languages : Localization.Languages; i : LONGINT; BEGIN IF (SELF.languages # NIL) THEN NEW(languages, LEN(SELF.languages)); FOR i := 0 TO LEN(languages)-1 DO COPY(SELF.languages[i].code, languages[i].code); END; ELSE languages := NIL; END; RETURN languages; END GetLanguages; END Dictionary; TYPE Repository* = OBJECT(XML.Element) VAR name- : Name; filename- : Files.FileName; archive : Archives.Archive; timestamp- : LONGINT; modified : BOOLEAN; nextID : LONGINT; components : ComponentInfo; dictionaries : Dictionary; errors : ErrorReporter; registry-: Registry; next : Repository; PROCEDURE &Init*; BEGIN Init^; SetNameAsString(StrRepository); name := ""; archive := NIL; timestamp := 0; modified := FALSE; nextID := 0; components := NIL; dictionaries := NIL; NEW(errors); NEW(registry, SELF); next := NIL; END Init; (* Post-instantiation initialization *) PROCEDURE Initialize() : WORD; VAR enum : XMLObjects.Enumerator; ptr : ANY; element : XML.Element; res : WORD; BEGIN nextID := 0; element := FindChild(SELF, "Components"); IF (element # NIL) THEN enum := element.GetContents(); WHILE enum.HasMoreElements() DO ptr := enum.GetNext(); IF (ptr # NIL) & (ptr IS ComponentInfo) THEN ptr(ComponentInfo).next := components; components := ptr(ComponentInfo); nextID := Strings.Max(nextID, components(ComponentInfo).id); END; END; ELSE res := 9934; END; element := FindChild(SELF, XmlDictionaries); IF (element # NIL) THEN enum := element.GetContents(); WHILE enum.HasMoreElements() DO ptr := enum.GetNext(); IF (ptr # NIL) & (ptr IS Dictionary) THEN ptr(Dictionary).next := dictionaries; dictionaries := ptr(Dictionary); dictionaries.repository := SELF; dictionaries.Initialize; END; END; END; RETURN res; END Initialize; PROCEDURE FindComponentInfo(CONST name : ARRAY OF CHAR; id : LONGINT) : ComponentInfo; VAR ci : ComponentInfo; BEGIN ci := components; WHILE (ci # NIL) & ((ci.name^ # name) OR (ci.id # id)) DO ci := ci.next; END; RETURN ci; END FindComponentInfo; PROCEDURE GetDictionary*(CONST name : ARRAY OF CHAR) : Dictionary; VAR d : Dictionary; BEGIN d := dictionaries; WHILE (d # NIL) & (d.name^ # name) DO d := d.next; END; RETURN d; END GetDictionary; PROCEDURE AddComponentInfo(ci : ComponentInfo); VAR element : XML.Element; BEGIN ASSERT(ci # NIL); element := FindChild(SELF, XmlComponents); ASSERT(element # NIL); element.AddContent(ci); ci.next := components; components := ci; END AddComponentInfo; PROCEDURE RemoveComponentInfo(ci : ComponentInfo); VAR c : ComponentInfo; element : XML.Element; BEGIN ASSERT(ci # NIL); element := FindChild(SELF, XmlComponents); ASSERT(element # NIL); element.RemoveContent(ci); IF (components # NIL) THEN IF (components = ci) THEN components := components.next; ELSE c := components; WHILE (c.next # NIL) & (c.next # ci) DO c := c.next; END; IF (c.next # NIL) THEN c.next := c.next.next; END; END; END; END RemoveComponentInfo; PROCEDURE GetComponentEnumerator*() : XMLObjects.Enumerator; VAR element : XML.Element; BEGIN element := FindChild(SELF, XmlComponents); ASSERT(element # NIL); RETURN element.GetContents(); END GetComponentEnumerator; PROCEDURE GetApplicationEnumerator*() : XMLObjects.Enumerator; VAR element : XML.Element; BEGIN element := FindChild(SELF, XmlApplications); ASSERT(element # NIL); RETURN element.GetContents(); END GetApplicationEnumerator; PROCEDURE GetFile(CONST name : ARRAY OF CHAR) : Streams.Reader; VAR receiver : Streams.Receiver; reader : Streams.Reader; BEGIN {EXCLUSIVE} reader := NIL; archive.Acquire; receiver := archive.OpenReceiver(name); archive.Release; IF (receiver # NIL) THEN NEW(reader, receiver, 1024); END; RETURN reader; END GetFile; PROCEDURE Check() : BOOLEAN; VAR archiveIndex : Archives.Index; error : BOOLEAN; i : LONGINT; BEGIN {EXCLUSIVE} error := TRUE; archive.Acquire; archiveIndex := archive.GetIndex(); IF (archiveIndex # NIL) THEN FOR i := 0 TO LEN(archiveIndex)-1 DO END; END; archive.Release; RETURN error; END Check; PROCEDURE GetComponent*(CONST name : ARRAY OF CHAR; id : LONGINT) : Component; VAR ci : ComponentInfo; component : Component; cname : Name; BEGIN IF TraceInstantiate IN Trace THEN KernelLog.String("GetComponent: "); KernelLog.String(SELF.name); KernelLog.String(":"); KernelLog.String(name); KernelLog.String(":"); KernelLog.Int(id, 0); KernelLog.Ln; END; ci := FindComponentInfo(name, id); IF (ci # NIL) & (ci.source # StrNoName) THEN IF TraceInstantiate IN Trace THEN KernelLog.String("Entry found for "); KernelLog.String(ci.name^); KernelLog.String(" (ID="); KernelLog.Int(ci.id, 0); KernelLog.String(", instance: "); KernelLog.Boolean(ci.instance # NIL); KernelLog.String(")"); KernelLog.Ln; END; IF (ci.instance # NIL) THEN ASSERT(ci.id # PrototypeID); component := ci.instance(Component); IF TraceInstantiate IN Trace THEN KernelLog.String("GetComponent: Reuse!!!"); KernelLog.Ln; END; ELSE IF (ci.type = Type_Generator) THEN component := GenerateComponent(ci.source^); ELSIF (ci.type = Type_Component) THEN component := LoadComponent(ci.source^); END; IF (component # NIL) THEN IF (ci.type = Type_Generator) THEN INCL(component.flags, Generated); ELSIF (ci.type = Type_Component) THEN (*! what is this for? temporary commented to check persistency implementation.. *) (* LockChildren(component); *) END; COPY(ci.name^, cname); component(Component).SetRepository(SELF, cname, ci.id); IF (ci.id # PrototypeID) THEN ci.instance := component; (*TBD: Replaced by weak reference *) IncrementTimestamp(timestamp); END; END; END; ELSIF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.GetComponent: Component '"); KernelLog.String(SELF.name); KernelLog.String(":"); KernelLog.String(name); KernelLog.String(":"); KernelLog.Int(id, 0); KernelLog.String("' not found"); KernelLog.Ln; END; RETURN component; END GetComponent; PROCEDURE PutComponent*(component : Component; CONST name : ARRAY OF CHAR; VAR id : LONGINT; VAR res : WORD); VAR ci : ComponentInfo; filename : Files.FileName; nbrStr : ARRAY 16 OF CHAR; cname : Name; BEGIN ASSERT(component # NIL); (* TBD: Locking *) ci := components; WHILE (ci # NIL) & (ci.instance # component) DO ci := ci.next; END; IF (ci # NIL) THEN id := ci.id; res := Ok; RETURN END; NEW(ci); IF (id # 0) THEN id := GetID(); END; Strings.IntToStr(id, nbrStr); COPY(name, filename); Strings.Append(filename, nbrStr); Strings.Append(filename, ".xml"); ci.SetAttributeValue(XmlAttributeName, name); ci.SetAttributeValue(XmlAttributeID, nbrStr); ci.SetAttributeValue(XmlAttributeSource, filename); ASSERT(ci.type = Type_Component); ci.instance := component; StoreComponent(filename, component, res); IF (res = Ok) THEN AddComponentInfo(ci); IF (res = Ok) THEN COPY(ci.name^, cname); component.SetRepository(SELF, cname, ci.id); END; ELSE HALT(100); END; Store(res); IncrementTimestamp(timestamp); END PutComponent; PROCEDURE UnbindComponent*(CONST name : ARRAY OF CHAR; id : LONGINT; VAR res : WORD); VAR ci : ComponentInfo; BEGIN ci := FindComponentInfo(name, id); IF (ci # NIL) THEN ci.instance := NIL; res := Ok; ELSE res := NotFound; END; IncrementTimestamp(timestamp); END UnbindComponent; PROCEDURE Unbind*(component : Component); VAR c : ComponentInfo; BEGIN ASSERT(component # NIL); c := components; WHILE (c # NIL) & (c.instance # component) DO c := c.next; END; IF (c # NIL) THEN c.instance := NIL; END; IncrementTimestamp(timestamp); END Unbind; PROCEDURE RemoveComponent*(CONST name : ARRAY OF CHAR; refNum : LONGINT; VAR res : WORD); VAR ci : ComponentInfo; BEGIN archive.Acquire; ci := FindComponentInfo(name, refNum); IF (ci # NIL) THEN RemoveComponentInfo(ci); IF (ci.type = Type_Component) THEN archive.RemoveEntry(ci.source^); END; res := Ok; ELSE res := NotFound; END; archive.Release; IncrementTimestamp(timestamp); END RemoveComponent; PROCEDURE Remove*(component : Component; VAR res : WORD); VAR ci : ComponentInfo; BEGIN ci := components; WHILE (ci # NIL) & (ci.instance # component) DO ci := ci.next; END; IF (ci # NIL) THEN archive.Acquire; RemoveComponentInfo(ci); IF (ci.type = Type_Component) THEN archive.RemoveEntry(ci.source^); END; archive.Release; END; IncrementTimestamp(timestamp); END Remove; PROCEDURE LoadComponent(CONST filename : ARRAY OF CHAR) : Component; VAR element : XML.Element; reader : Streams.Reader; BEGIN IF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.Registry.Create: "); KernelLog.String(filename); KernelLog.Ln; END; element := NIL; reader := GetFile(filename); IF (reader # NIL) THEN IF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.Registry.Create: File found"); KernelLog.Ln; END; element := Parse(reader, registry, errors); END; IF (element # NIL) & (element IS Component) THEN RETURN element (Component); ELSE RETURN NIL; END; END LoadComponent; (* Return an ID that is unique withhin this repository *) PROCEDURE GetID*() : LONGINT; BEGIN {EXCLUSIVE} INC(nextID); RETURN nextID; END GetID; PROCEDURE Store*(VAR res : WORD); VAR writer : Streams.Writer;context: StoreContext; BEGIN archive.Acquire; writer := GetWriter(archive, IndexFile); IF (writer # NIL) THEN NEW(context, SELF); Write(writer, context, 0); writer.Update; ELSE res := 99; END; archive.Release; END Store; PROCEDURE StoreComponent(CONST filename : ARRAY OF CHAR; component : Component; VAR res : WORD); VAR writer : Streams.Writer; context: StoreContext; BEGIN ASSERT(component # NIL); archive.Acquire; writer := GetWriter(archive, filename); IF (writer # NIL) THEN NEW(context, SELF); component.Write(writer, context, 0); writer.Update; res := Ok; ELSE res := 9912; END; archive.Release; END StoreComponent; PROCEDURE Dump*(writer : Streams.Writer); BEGIN IF (writer = NIL) THEN NEW(writer, KernelLog.Send, 1024); END; writer.String("Dump repository "); writer.String(name); writer.String(": "); writer.Ln; writer.Update; SELF.Write(writer, NIL, 0); writer.Ln; writer.Update; END Dump; END Repository; Repositories* = POINTER TO ARRAY OF Repository; Properties* = OBJECT(XML.Element) VAR repository-: Repository; (* to pass repository during creation *) PROCEDURE &New(r: Repository); BEGIN repository := r END New; END Properties; TYPE Registry* = OBJECT(XML.ElementRegistry) VAR repository: Repository; PROCEDURE & InitRegistry(r: Repository); BEGIN repository := r END InitRegistry; PROCEDURE InstantiateElement*(CONST name: ARRAY OF CHAR): XML.Element; VAR repositoryName, componentName : ARRAY 128 OF CHAR; id : LONGINT; repository : Repository; element : XML.Element; properties : Properties; BEGIN IF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.Registry.InstantiateElement: "); KernelLog.String(name); KernelLog.Ln; END; element := NIL; IF SplitName(name, repositoryName, componentName, id) THEN IF (repositoryName # "") THEN repository := ThisRepository(repositoryName); IF (repository # NIL) THEN element := repository.GetComponent(componentName, id); IF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.Registry.InstantiateElement: Instantiate component: "); KernelLog.String(componentName); KernelLog.Ln; KernelLog.Boolean(element # NIL); KernelLog.Ln; END; ELSE KernelLog.String("Repository not found:"); KernelLog.String(repositoryName); KernelLog.Ln; END; ELSIF (componentName = "Properties") THEN NEW(properties,SELF.repository); RETURN properties; ELSIF SELF.repository # NIL THEN repository := SELF.repository; element := repository.GetComponent(componentName, id); IF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.Registry.InstantiateElement: Instantiate component: "); KernelLog.String(componentName); KernelLog.Ln; KernelLog.Boolean(element # NIL); KernelLog.Ln; END; END; ELSE KernelLog.String("Wrong name: "); KernelLog.String(name); KernelLog.Ln; END; RETURN element; END InstantiateElement; PROCEDURE InstantiateLate*(e: XML.Element): XML.Element; VAR generator: XML.String; element: XML.Element; moduleName, procedureName : Modules.Name; msg : ARRAY 128 OF CHAR; res : WORD; generate : XML.GeneratorProcedure; a: XML.Attribute; enumerator: XMLObjects.Enumerator; ptr: ANY; BEGIN element := NIL; generator := e.GetAttributeValue("generator"); IF generator # NIL THEN IF TraceInstantiate IN Trace THEN KernelLog.String("Repositories.Registry.InstantiateElementLate:"); KernelLog.String(generator^); KernelLog.Ln; END; Commands.Split(generator^, moduleName, procedureName, res, msg); IF (res = Commands.Ok) THEN GETPROCEDURE(moduleName, procedureName, generate); IF (generate # NIL) THEN element := generate(); ELSE KernelLog.String("Generator procedure not found: "); KernelLog.String(moduleName); KernelLog.Char("."); KernelLog.String(procedureName); KernelLog.Ln; END; ELSE KernelLog.String("Invalid generator name"); KernelLog.Ln; END; END; IF (element # NIL) THEN enumerator := e.GetAttributes(); WHILE enumerator.HasMoreElements() DO ptr := enumerator.GetNext(); IF (ptr IS XML.Attribute) THEN (*! element must be copied ..., how to avoid this ? *) element.SetAttributeValue(ptr(XML.Attribute).GetName()^, ptr(XML.Attribute).GetValue()^); (* element.AddAttribute(ptr(XML.Attribute)); *) END; END; RETURN element; ELSE RETURN e; END; END InstantiateLate; END Registry; TYPE ErrorReporter = OBJECT VAR nofErrors : LONGINT; PROCEDURE &Reset; BEGIN nofErrors := 0; END Reset; PROCEDURE Report(pos, line, col: LONGINT; CONST msg: ARRAY OF CHAR); BEGIN INC(nofErrors); KernelLog.Enter; KernelLog.Char(CHR(9H)); KernelLog.Char(CHR(9H)); KernelLog.String("pos "); KernelLog.Int(pos, 6); KernelLog.String(", line "); KernelLog.Int(line, 0); KernelLog.String(", column "); KernelLog.Int(col, 0); KernelLog.String(" "); KernelLog.String(msg); KernelLog.Exit; END Report; END ErrorReporter; VAR registry- : Registry; indexRegistry : IndexRegistry; repositories : Repository; globalTimestamp : LONGINT; StrNoName, StrRepository, StrComponent, StrApplication, StrDictionary : Strings.String; (* Set Locked flag for and all its children *) PROCEDURE SetLockedFlag(component : Component; locked : BOOLEAN); VAR c : XML.Content; BEGIN ASSERT(component # NIL); IF locked THEN INCL(component.flags, Locked); ELSE EXCL(component.flags, Locked); END; c := component.GetFirst(); WHILE (c # NIL) DO IF (c IS Component) THEN SetLockedFlag(c(Component), locked); END; c := component.GetNext(c); END; END SetLockedFlag; PROCEDURE LockChildren(component : Component); VAR c : XML.Content; BEGIN ASSERT(component # NIL); c := component.GetFirst(); WHILE (c # NIL) DO IF (c IS Component) THEN SetLockedFlag(c(Component), TRUE); END; c := component.GetNext(c); END; END LockChildren; PROCEDURE GenerateComponent*(CONST generator : ARRAY OF CHAR) : Component; VAR moduleName, procedureName : Modules.Name; msg : ARRAY 128 OF CHAR; res : WORD; generate : XML.GeneratorProcedure; element : XML.Element; BEGIN element := NIL; Commands.Split(generator, moduleName, procedureName, res, msg); IF (res = Commands.Ok) THEN GETPROCEDURE(moduleName, procedureName, generate); IF (generate # NIL) THEN element := generate(); ELSE KernelLog.String("Generator procedure not found: "); KernelLog.String(moduleName); KernelLog.Char("."); KernelLog.String(procedureName); KernelLog.Ln; END; ELSE KernelLog.String("Invalid generator name"); KernelLog.Ln; END; IF (element # NIL) THEN RETURN element (Component); ELSE RETURN NIL; END; END GenerateComponent; PROCEDURE FindChild(parent : XML.Element; CONST elementName : ARRAY OF CHAR) : XML.Element; VAR enum : XMLObjects.Enumerator; ptr : ANY; name : Strings.String; BEGIN ASSERT(parent # NIL); enum := parent.GetContents(); WHILE enum.HasMoreElements() DO ptr := enum.GetNext(); IF (ptr # NIL) & (ptr IS XML.Element) THEN name := ptr(XML.Element).GetName(); IF (name # NIL) & (name^ = elementName) THEN RETURN ptr (XML.Element); END; END; END; RETURN NIL; END FindChild; PROCEDURE IncrementTimestamp*(VAR timestamp : LONGINT); BEGIN {EXCLUSIVE} INC(timestamp); INC(globalTimestamp); END IncrementTimestamp; PROCEDURE GetTimestamp*() : LONGINT; BEGIN RETURN globalTimestamp; END GetTimestamp; PROCEDURE AwaitChange*(VAR curTimestamp : LONGINT); BEGIN {EXCLUSIVE} AWAIT(curTimestamp # globalTimestamp); curTimestamp := globalTimestamp; END AwaitChange; PROCEDURE IsXmlFilename(string : ARRAY OF CHAR) : BOOLEAN; BEGIN Strings.LowerCase(string); RETURN Strings.Match("*.xml", string); END IsXmlFilename; PROCEDURE Parse(reader : Streams.Reader; elemReg : XML.ElementRegistry; errors : ErrorReporter) : XML.Element; VAR scanner : XMLScanner.Scanner; parser : XMLParser.Parser; document : XML.Document; BEGIN ASSERT((reader # NIL) & (errors # NIL)); NEW(scanner, reader); (* scanner.SetStringPooling({0..31}); *) NEW(parser, scanner); parser.elemReg := elemReg; parser.reportError := errors.Report; document := parser.Parse(); IF (document # NIL) THEN RETURN document.GetRoot(); ELSE RETURN NIL; END; END Parse; PROCEDURE GetWriter(archive : Archives.Archive; CONST filename : ARRAY OF CHAR) : Streams.Writer; VAR writer : Streams.Writer; sender : Streams.Sender; BEGIN (* must hold archive lock!! *) sender := archive.OpenSender(filename); IF (sender # NIL) THEN NEW(writer, sender, 4096); ELSE writer := NIL; END; RETURN writer; END GetWriter; PROCEDURE SplitName*(CONST name : ARRAY OF CHAR; VAR repositoryName, componentName : ARRAY OF CHAR; VAR id : LONGINT) : BOOLEAN; VAR count, pos, next : LONGINT; succeeded : BOOLEAN; BEGIN succeeded := TRUE; count := Strings.Count (name, Delimiter); IF (count = 0) THEN repositoryName := ""; COPY(name, componentName); id := 0; ELSIF (count = 1) THEN next := Strings.Find(name, 0, Delimiter); Strings.Copy(name, 0, next, repositoryName); Strings.Copy(name, next + 1, Strings.Length(name) - next, componentName); id := 0; succeeded := ((repositoryName = "" ) OR IsValidName(repositoryName)) & IsValidName(componentName); (* no, this is ambiguous, rather use ":ComponenName:Number" for such cases IF ~succeeded & IsValidName(repositoryName) & IsNumber(componentName) THEN succeeded := TRUE; Strings.StrToInt(componentName, id); D.String("split name with index"); D.String(repositoryName); D.String(" : "); D.Int(id,1); D.Ln; COPY(repositoryName, componentName); repositoryName := ""; END; *) ELSIF (count = 2) THEN next := Strings.Find(name, 0, Delimiter); Strings.Copy(name, 0, next, repositoryName); pos := next + 1; next := Strings.Find(name, pos, Delimiter); Strings.Copy(name, pos, next - pos, componentName); pos := next + 1; Strings.StrToIntPos(name, id, pos); succeeded := ((repositoryName = "") OR IsValidName(repositoryName)) & IsValidName(componentName); ELSE succeeded := FALSE; END; RETURN succeeded; END SplitName; PROCEDURE JoinName*(CONST repositoryName, componentName : ARRAY OF CHAR; id : LONGINT; VAR name : ARRAY OF CHAR); VAR nbrStr : ARRAY 16 OF CHAR; BEGIN COPY(repositoryName, name); Strings.Append(name, Delimiter); Strings.Append(name, componentName); IF (id # 0) THEN Strings.Append(name, Delimiter); Strings.IntToStr(id, nbrStr); Strings.Append(name, nbrStr); END; END JoinName; (** valid name: Starts with latin letter, contains only latin letter and arabic number *) PROCEDURE IsValidName*(CONST name : ARRAY OF CHAR) : BOOLEAN; VAR valid : BOOLEAN; i : LONGINT; BEGIN valid := (("A" <= CAP(name[0])) & (CAP(name[0]) <= "Z")); IF valid THEN i := 0; WHILE valid & (i < LEN(name)) & (name[i] # 0X) DO valid := (("A" <= CAP(name[i])) & (CAP(name[i]) <= "Z")) OR (("0" <= name[i]) & (name[i] <= "9")); INC(i); END; valid := (i < LEN(name)) & (name[i] = 0X); END; RETURN valid; END IsValidName; PROCEDURE IsNumber*(CONST name: ARRAY OF CHAR): BOOLEAN; VAR i: LONGINT; BEGIN i := 0; WHILE (i " ") DO cmd[j] := command[i]; INC(i); INC(j); END; IF (j < LEN(cmd)) & (i < LEN(command)) & (j >= 2) (* M.P *) THEN cmd[j] := 0X; proc := GetCommand(cmd, res); IF (res = Ok) THEN WHILE (i < LEN(command)) & (command[i] # 0X) & (command[i] <= " ") DO INC(i); END; IF (i < Strings.Length(command)) THEN NEW(param, Strings.Length(command) - i + 1); j := 0; WHILE (i < LEN(command)) & (command[i] # 0X) DO param[j] := command[i]; INC(i); INC(j); END; param[j] := 0X; NEW(reader, Strings.Length(command)); reader.Set(param^); ELSE reader := NIL; END; IF (context = NIL) THEN NEW(context, NIL, reader, NIL, NIL, NIL); ELSE context.Init(context.in, reader, context.out, context.error, context.caller); END; proc(context); ELSE object := GenerateComponent(cmd); IF object # NIL THEN IF (context = NIL) THEN NEW(context, NIL, reader, NIL, NIL, NIL); ELSE context.Init(context.in, reader, context.out, context.error, context.caller); END; context.object := object END; END; ELSE res := NotFound; END; END CallCommand; PROCEDURE GetTranslationInfo*(CONST string : ARRAY OF CHAR; VAR dictionary : Dictionary; VAR word : Strings.String; VAR res : WORD); VAR repositoryName, dictionaryName, temp : ARRAY 512 OF CHAR; i, j : LONGINT; BEGIN res := Ok; dictionary := NIL; word := NIL; IF (LEN(string) > 7) THEN (** "::" + LibraryName + ":" + DictionaryName + ":" + DictionaryWord *) IF (string[0] = ":") & (string[1] = ":") THEN i := 2; j := 0; WHILE (i < LEN(string)) & (j < LEN(repositoryName) - 1) & (string[i] # 0X) & (string[i] # ":") DO repositoryName[j] := string[i]; INC(i); INC(j); END; repositoryName[j] := 0X; IF (i < LEN(string)) & (string[i] = ":") THEN INC(i); j := 0; WHILE (i < LEN(string)) & (j < LEN(dictionaryName) - 1) & (string[i] # 0X) & (string[i] # ":") DO dictionaryName[j] := string[i]; INC(i); INC(j); END; dictionaryName[j] := 0X; IF (i < LEN(string)) & (string[i] = ":") THEN INC(i); j := 0; WHILE(i < LEN(string)) & (j < LEN(temp) - 1) & (string[i] # 0X) DO temp[j] := string[i]; INC(i); INC(j); END; temp[j] := 0X; IF (i < LEN(string)) & (string[i] = 0X) THEN word := Strings.NewString(temp); GetDictionary(repositoryName, dictionaryName, dictionary, res); IF (res # Ok) THEN KernelLog.String("Repositories.GetTranlationInfo: Warning: Dictionary "); KernelLog.String(repositoryName); KernelLog.String(":"); KernelLog.String(dictionaryName); KernelLog.String(" not found, res: "); KernelLog.Int(res, 0); KernelLog.Ln; END; END; END; END; END; END; END GetTranslationInfo; PROCEDURE Translate*(CONST string : ARRAY OF CHAR; languages : Localization.Languages) : Strings.String; VAR dictionary : Dictionary; word, translation : Strings.String; res : WORD; BEGIN ASSERT(languages # NIL); GetTranslationInfo(string, dictionary, word, res); IF (res = Ok) & (dictionary # NIL) & (word # NIL) THEN translation := dictionary.Translate(word, languages); ELSE translation := Strings.NewString(string); END; ASSERT(translation # NIL); RETURN translation; END Translate; PROCEDURE GetDictionary*(CONST repositoryName, dictionaryName : ARRAY OF CHAR; VAR dictionary : Dictionary; VAR res : WORD); VAR repository : Repository; BEGIN dictionary := NIL; repository := ThisRepository(repositoryName); IF (repository # NIL) THEN dictionary := repository.GetDictionary(dictionaryName); IF (dictionary # NIL) THEN res := Ok; ELSE res := DictionaryNotFound; END; ELSE res := RepositoryNotFound; END; END GetDictionary; PROCEDURE GetDictionaryByString*(CONST string : ARRAY OF CHAR; VAR dictionary : Dictionary; VAR res : WORD); VAR repositoryName : Files.FileName; dictionaryName : ARRAY 128 OF CHAR; ignoreID : LONGINT; BEGIN IF SplitName(string, repositoryName, dictionaryName, ignoreID) THEN GetDictionary(repositoryName, dictionaryName, dictionary, res); ELSE res := FormatError; END; END GetDictionaryByString; PROCEDURE GetComponent*(CONST repositoryName, componentName : ARRAY OF CHAR; refNum : LONGINT; VAR component : Component; VAR res : WORD); VAR repository : Repository; BEGIN component := NIL; repository := ThisRepository(repositoryName); IF (repository # NIL) THEN component := repository.GetComponent(componentName, refNum); IF (component # NIL) THEN res := Ok; ELSE res := ComponentNotFound; END; ELSE res := RepositoryNotFound; END; END GetComponent; PROCEDURE GetComponentByString*(CONST string : ARRAY OF CHAR; VAR component : Component; VAR res : WORD); VAR repositoryName : Files.FileName; componentName : ARRAY 128 OF CHAR; componentID : LONGINT; BEGIN IF SplitName(string, repositoryName, componentName, componentID) THEN GetComponent(repositoryName, componentName, componentID, component, res); ELSE res := FormatError; END; END GetComponentByString; PROCEDURE PutComponent*(component : Component; CONST repositoryName, componentName : ARRAY OF CHAR; VAR id : LONGINT; VAR res : WORD); VAR repository : Repository; BEGIN ASSERT(component # NIL); repository := ThisRepository(repositoryName); IF (repository # NIL) THEN repository.PutComponent(component, componentName, id, res); ELSE res := RepositoryNotFound; END; END PutComponent; PROCEDURE UnbindComponent*(CONST repositoryName, componentName : ARRAY OF CHAR; refNum : LONGINT; VAR res : WORD); VAR repository : Repository; BEGIN repository := ThisRepository(repositoryName); IF (repository # NIL) THEN repository.UnbindComponent(componentName, refNum, res); ELSE res := RepositoryNotFound; END; END UnbindComponent; PROCEDURE RemoveComponent*(CONST repositoryName, componentName : ARRAY OF CHAR; refNum : LONGINT; VAR res : WORD); VAR repository : Repository; BEGIN repository := ThisRepository(repositoryName); IF (repository # NIL) THEN repository.RemoveComponent(componentName, refNum, res); ELSE res := RepositoryNotFound; END; END RemoveComponent; (* Append repository to global list of repositories *) PROCEDURE Add(repository : Repository; VAR res : WORD); VAR r : Repository; BEGIN (* {EXCLUSIVE} *) ASSERT(repository # NIL); r := FindRepository(repository.name); IF (r = NIL) THEN IF (repositories = NIL) THEN repositories := repository; ELSE r := repositories; WHILE (r.next # NIL) DO r := r.next; END; r.next := repository; END; INC(globalTimestamp); res := Ok; ELSE res := DuplicateRepository; END; END Add; (* Remove repository from global list of repositories *) PROCEDURE Remove(repository : Repository; VAR res : WORD); VAR r : Repository; BEGIN (* {EXCLUSIVE} *) ASSERT(repository # NIL); IF (repositories = repository) THEN repositories := repository.next; res := Ok; ELSE r := repositories; WHILE (r # NIL) & (r.next # repository) DO r := r.next; END; IF (r # NIL) THEN r.next := r.next.next; res := Ok; ELSE res := RepositoryNotFound; END; END; IF (res = Ok) THEN INC(globalTimestamp); END; END Remove; (* Find a loaded repository by name *) PROCEDURE FindRepository(CONST name : ARRAY OF CHAR) : Repository; VAR r : Repository; BEGIN r := repositories; WHILE (r # NIL) & (r.name # name) DO r := r.next; END; RETURN r; END FindRepository; (** Retrieve a repository be name *) PROCEDURE ThisRepository*(CONST name : ARRAY OF CHAR) : Repository; VAR r : Repository; res : WORD; BEGIN {EXCLUSIVE} r := FindRepository(name); IF (r = NIL) THEN r := LoadRepository(name, res); END; RETURN r; END ThisRepository; (** Retrieve all currently loaded repositories *) PROCEDURE GetAll*(VAR reps : Repositories); VAR r : Repository; nofRepositories, i : LONGINT; PROCEDURE GetNofRepositories() : LONGINT; VAR r : Repository; nofRepositories : LONGINT; BEGIN nofRepositories := 0; r := repositories; WHILE (r # NIL) DO INC(nofRepositories); r := r.next; END; RETURN nofRepositories; END GetNofRepositories; BEGIN {EXCLUSIVE} nofRepositories := GetNofRepositories(); IF (nofRepositories > 0) THEN IF (reps = NIL) OR (LEN(reps) < nofRepositories) THEN NEW(reps, nofRepositories); END; r := repositories; i := 0; WHILE (i < LEN(reps)) DO reps[i] := r; IF (r # NIL) THEN r := r.next; END; INC(i); END; ELSE IF (reps # NIL) THEN FOR i := 0 TO LEN(reps)-1 DO reps[i] := NIL; END; END; END; END GetAll; (* Load a repository *) PROCEDURE LoadRepository(CONST name : ARRAY OF CHAR; VAR res : WORD) : Repository; VAR filename : Files.FileName; repository : Repository; archive : Archives.Archive; receiver : Streams.Receiver; reader : Streams.Reader; element : XML.Element; ignore : WORD; errors : ErrorReporter; file: Files.File; writer: Files.Writer; freader: Files.Reader; ch: CHAR; buf: ARRAY 512 OF CHAR; len: LONGINT; BEGIN (* {EXCLUSIVE} *) ASSERT(FindRepository(name) = NIL); COPY(name, filename); Strings.Append(filename, "."); Strings.Append(filename, DefaultFileExtension); IF TraceLoading IN Trace THEN KernelLog.String("Repositories.LoadRepository: "); KernelLog.String(filename); KernelLog.String(" ... "); END; repository := NIL; archive := Archives.Old(filename, "tar"); IF (archive # NIL) THEN IF TraceLoading IN Trace THEN KernelLog.String("archive found ... "); END; archive.Acquire; receiver := archive.OpenReceiver(IndexFile); archive.Release; IF (receiver # NIL) THEN NEW(reader, receiver, 4096); (* file := Files.New(""); Files.OpenWriter(writer, file, 0); REPEAT reader.Bytes(buf, 0, LEN(buf), len); writer.Bytes(buf, 0, len); UNTIL reader.res # 0; writer.Update; Files.OpenReader(freader, file,0); reader := freader; *) IF TraceLoading IN Trace THEN KernelLog.String("index file found ... "); END; (*NEW(reader, receiver, 4096);*) NEW(errors); element := Parse(reader, indexRegistry, errors); IF (element # NIL) & (element IS Repository) THEN repository := element (Repository); repository.archive := archive; COPY(name, repository.name); COPY(filename, repository.filename); ignore := repository.Initialize(); END; IF (repository # NIL) THEN IF TraceLoading IN Trace THEN KernelLog.String("index file parsed... "); END; Add(repository, res); END; ELSE res := FormatError; END; ELSE res := RepositoryNotFound; END; IF TraceLoading IN Trace THEN KernelLog.Int(res, 0); KernelLog.Ln; END; RETURN repository; END LoadRepository; (** Unload a currently loaded repository *) PROCEDURE UnloadRepository*(CONST name : ARRAY OF CHAR; VAR res : WORD); VAR repository : Repository; BEGIN {EXCLUSIVE} repository := FindRepository(name); IF (repository # NIL) THEN Remove(repository, res); ELSE res := RepositoryNotLoaded; END; END UnloadRepository; (** Store the current state of a currenlty loaded repository *) PROCEDURE StoreRepository*(CONST name : ARRAY OF CHAR; VAR res : WORD); VAR repository : Repository; BEGIN {EXCLUSIVE} repository := FindRepository(name); IF (repository # NIL) THEN repository.Store(res); INC(globalTimestamp); ELSE res := RepositoryNotLoaded; END; END StoreRepository; (** Create an empty new repository. The repository name is derived from the filename (repository name = filename without extension) The repository is not loaded upon creation *) PROCEDURE CreateRepository*(CONST filename : ARRAY OF CHAR; VAR res : WORD); VAR repository : Repository; archive : Archives.Archive; sender : Streams.Sender; writer : Streams.Writer; extension : ARRAY 16 OF CHAR; PROCEDURE AddHeader(parent : XML.Element); VAR header, element : XML.Element; charArray : XML.ArrayChars; BEGIN ASSERT(parent # NIL); NEW(header); header.SetName("Header"); parent.AddContent(header); NEW(element); element.SetName("Version"); header.AddContent(element); NEW(charArray); charArray.SetStr("1"); element.AddContent(charArray); NEW(element); element.SetName("Public"); header.AddContent(element); NEW(charArray); charArray.SetStr("FALSE"); element.AddContent(charArray); END AddHeader; PROCEDURE AddStructure(parent : XML.Element); VAR element : XML.Element; BEGIN ASSERT(parent # NIL); NEW(element); element.SetName("Applications"); parent.AddContent(element); NEW(element); element.SetName("Components"); parent.AddContent(element); NEW(element); element.SetName("Dictionaries"); parent.AddContent(element); END AddStructure; BEGIN IF TraceCreation IN Trace THEN KernelLog.String("Repositories.CreateRepository "); KernelLog.String(filename); KernelLog.String(" ... "); END; archive := Archives.New(filename, "tar"); IF (archive # NIL) THEN archive.Acquire; sender := archive.OpenSender(IndexFile); archive.Release; IF (sender # NIL) THEN NEW(writer, sender, 4096); NEW(repository); SplitFilename(filename, repository.name, extension); COPY(filename, repository.filename); repository.archive := archive; AddHeader(repository); AddStructure(repository); writer.String(''); writer.Ln; repository.Write(writer, NIL, 0); writer.Update; res := Ok; ELSE res := ArchivesError; END; ELSE res := CannotCreateArchive; END; IF TraceCreation IN Trace THEN KernelLog.String("res = "); KernelLog.Int(res, 0); KernelLog.Ln; END; END CreateRepository; (* PROCEDURE FromXMLInRepository*(xml: XML.Element; repository: Repository); VAR generator: PROCEDURE(): XML.Element; VAR l,name: Strings.String; moduleName, procedureName: Modules.Name; res: WORD; msg: ARRAY 32 OF CHAR; component: Component; element: XML.Element; BEGIN component := NIL; IF xml # NIL THEN name := xml.GetName(); l := xml.GetAttributeValue("generator"); IF l # NIL THEN Commands.Split(l^, moduleName, procedureName, res, msg); IF (res = Commands.Ok) THEN GETPROCEDURE(moduleName, procedureName, generator); IF (generator # NIL) THEN element := generator(); IF (element # NIL) & (element IS Component) THEN component := element(Component); component.SetName(name^); component.FromXMLInRepository(xml,repository); END; ELSE KernelLog.String("WMComponents error: invalid generator "); KernelLog.String(l^); KernelLog.Ln; END; ELSE KernelLog.String("WMComponents error: could not generate component "); KernelLog.String(l^); KernelLog.Ln; END; ELSE l := xml.GetAttributeValue("reference"); IF l # NIL THEN repository.GetComponent(l^); END; END; RETURN component END FromXMLInRepository; *) PROCEDURE ComponentFromXML*(xml: XML.Element): Component; VAR generator: PROCEDURE(): XML.Element; VAR l,name: Strings.String; moduleName, procedureName: Modules.Name; res: WORD; msg: ARRAY 32 OF CHAR; component: Component; element: XML.Element; BEGIN component := NIL; IF xml # NIL THEN name := xml.GetName(); l := xml.GetAttributeValue("generator"); IF l # NIL THEN Commands.Split(l^, moduleName, procedureName, res, msg); IF (res = Commands.Ok) THEN GETPROCEDURE(moduleName, procedureName, generator); IF (generator # NIL) THEN element := generator(); IF (element # NIL) & (element IS Component) THEN component := element(Component); component.SetName(name^); component.FromXML(xml); END; ELSE KernelLog.String("WMComponents error: invalid generator "); KernelLog.String(l^); KernelLog.Ln; END; ELSE KernelLog.String("WMComponents error: could not generate component "); KernelLog.String(l^); KernelLog.Ln; END; END; END; RETURN component END ComponentFromXML; PROCEDURE ShowRes*(res : WORD; out : Streams.Writer); BEGIN ASSERT(out # NIL); out.String("res: "); out.Int(res, 0); out.String(" ("); CASE res OF |Ok: out.String("Ok"); |NotFound: out.String("Not found"); |RepositoryNotFound: out.String("Repository not found"); |ComponentNotFound: out.String("Component not found"); |RepositoryNotLoaded: out.String("Repository not loaded"); |DuplicateName: out.String("Duplicate name"); |DuplicateID: out.String("Duplicate ID"); |DuplicateRepository: out.String("Duplicate repository"); |IndexError: out.String("Index error"); |CannotCreateArchive: out.String("Cannot create archive"); |ArchivesError: out.String("Archive error"); |WrongVersion: out.String("Wrong version"); |FormatError: out.String("Format error"); ELSE out.String("Unknown"); END; out.String(")"); END ShowRes; (** Create an empty repository *) PROCEDURE Create*(context : Commands.Context); (** repositoryName ~ *) VAR repositoryName : Files.FileName; res : WORD; BEGIN context.arg.SkipWhitespace; context.arg.String(repositoryName); context.out.String("Creating repository '"); context.out.String(repositoryName); context.out.String("' ... "); context.out.Update; CreateRepository(repositoryName, res); IF (res = Ok) THEN context.out.String("done."); ELSE context.out.String("not done, "); ShowRes(res, context.out); END; context.out.Ln; END Create; PROCEDURE Store*(context : Commands.Context); (** repositoryName ~ *) VAR repositoryName : Files.FileName; res : WORD; BEGIN context.arg.SkipWhitespace; context.arg.String(repositoryName); context.out.String("Storing repository '"); context.out.String(repositoryName); context.out.String("' ... "); context.out.Update; StoreRepository(repositoryName, res); IF (res = Ok) THEN context.out.String("done."); ELSE context.out.String("not done, "); ShowRes(res, context.out); END; context.out.Ln; END Store; PROCEDURE Load*(context : Commands.Context); (** filename ~ *) VAR repository : Repository; filename : Files.FileName; BEGIN context.arg.SkipWhitespace; context.arg.String(filename); context.out.String("Loading repository '"); context.out.String(filename); context.out.String("' ... "); repository := ThisRepository(filename); IF (repository # NIL) THEN context.out.String("done."); ELSE context.out.String("repository not found."); END; context.out.Ln; END Load; PROCEDURE Unload*(context : Commands.Context); (** repositoryName ~ *) VAR repositoryName : Files.FileName; res : WORD; BEGIN context.arg.SkipWhitespace; context.arg.String(repositoryName); context.out.String("Unloaded repository '"); context.out.String(repositoryName); context.out.String("' ... "); context.out.Update; UnloadRepository(repositoryName, res); IF (res = Ok) THEN context.out.String("done."); ELSE context.out.String("not done, "); ShowRes(res, context.out); END; context.out.Ln; END Unload; (** Put component into repository *) PROCEDURE Put*(context : Commands.Context); (** componentName repositoryName asName [zeroID] ~ *) VAR componentName, repositoryName, asName : ARRAY 256 OF CHAR; nbr : ARRAY 3 OF CHAR; component : Component; id : LONGINT; res: WORD; BEGIN context.arg.SkipWhitespace; context.arg.String(componentName); context.arg.SkipWhitespace; context.arg.String(repositoryName); context.arg.SkipWhitespace; context.arg.String(asName); context.arg.SkipWhitespace; context.arg.String(nbr); IF (nbr = "0") THEN id := 0; ELSE id := -1; END; context.out.String("Put component '"); context.out.String(componentName); context.out.String("' to repository '"); context.out.String(repositoryName); context.out.String("' as '"); context.out.String(asName); context.out.String("' ... "); context.out.Update; GetComponentByString(componentName, component, res); IF (res = Ok) & (component # NIL) THEN PutComponent(component, repositoryName, asName, id, res); IF (res = Ok) THEN context.out.String("done."); ELSE context.out.String("not done, "); ShowRes(res, context.out); END; ELSE context.out.String("component loading error, "); ShowRes(res, context.out); END; context.out.Ln; END Put; PROCEDURE Dump*(context : Commands.Context); (** filename ~ *) VAR repository : Repository; filename : Files.FileName; BEGIN context.arg.SkipWhitespace; context.arg.String(filename); context.out.String("Dump of repository '"); context.out.String(filename); context.out.String("': "); context.out.Ln; context.out.Update; repository := ThisRepository(filename); IF (repository # NIL) THEN repository.Dump(context.out); ELSE context.out.String("Repository not found."); END; context.out.Ln; END Dump; PROCEDURE DumpAll*(context : Commands.Context); (** ~ *) VAR repositories : Repositories; count, i : LONGINT; BEGIN context.out.String("Currently loaded repositories: "); context.out.Ln; GetAll(repositories); IF (repositories # NIL) THEN count := 0; FOR i := 0 TO LEN(repositories) - 1 DO IF (repositories[i] # NIL) THEN INC(count); repositories[i].Dump(context.out); END; END; context.out.Int(count, 0); context.out.String(" repositories loaded."); ELSE context.out.String("none"); END; context.out.Ln; END DumpAll; PROCEDURE Call*(context : Commands.Context); (** moduleName.procedureName [params] ~ *) VAR c : Context; cmdString : POINTER TO ARRAY OF CHAR; res : WORD; ignore: LONGINT; BEGIN NEW(c, NIL, NIL, context.out, context.error, context.caller); IF (context.arg.Available() > 0) THEN NEW(cmdString, context.arg.Available()); context.arg.Bytes(cmdString^, 0, LEN(cmdString), ignore); CallCommand(cmdString^, c, res); context.out.String("res: "); context.out.Int(res, 0); context.out.Ln; context.out.String("c.res: "); context.out.Int(c.result, 0); context.out.Ln; context.out.String("c.object: "); IF (c.object = NIL) THEN context.out.String("NIL"); ELSE context.out.String("Present"); END; context.out.Ln; ELSE context.error.String("Missing arguments"); context.error.Ln; END; END Call; PROCEDURE InitStrings; BEGIN StrNoName := Strings.NewString("NoName"); StrRepository := Strings.NewString(XmlRepository); StrComponent := Strings.NewString(XmlComponent); StrApplication := Strings.NewString(XmlApplication); StrDictionary := Strings.NewString(XmlDictionary); END InitStrings; BEGIN globalTimestamp := 0; repositories := NIL; InitStrings; NEW(registry,NIL); NEW(indexRegistry); END Repositories.