MODULE Repositories;
IMPORT
Streams, Modules, KernelLog, Commands, Strings, Files, Archives, Localization,
UTF8Strings, XML, XMLObjects, XMLScanner, XMLParser, D := Debugging;
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;
Generated = 0;
Locked = 1;
IndexFile = "index.xml";
DefaultFileExtension* = "rep";
Delimiter* = ":";
PrototypeID = 0;
Version = 1;
Quote = '"';
EscapeCharacter = "&";
EscapeQuote = """;
Type_Component = 1;
Type_Generator = 2;
CommandPrefix* = "cmd:";
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
Component* = OBJECT(XML.Element)
VAR
repository : Repository; name : Strings.String; refNum : LONGINT;
flags : SET;
timestamp- : LONGINT;
PROCEDURE &Init*;
BEGIN
Init^;
repository := NIL; name := NIL; refNum := 0;
flags := {};
timestamp := 0;
END Init;
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);
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;
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 : LONGINT);
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;
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;
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
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);
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
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;
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, 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, res : LONGINT;
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 : LONGINT);
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;
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;
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;
PROCEDURE Initialize() : LONGINT;
VAR enum : XMLObjects.Enumerator; ptr : ANY; element : XML.Element; res : LONGINT;
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
END;
COPY(ci.name^, cname);
component(Component).SetRepository(SELF, cname, ci.id);
IF (ci.id # PrototypeID) THEN
ci.instance := component;
IncrementTimestamp(timestamp);
END;
END;
END;
ELSE
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 : LONGINT);
VAR ci : ComponentInfo; filename : Files.FileName; nbrStr : ARRAY 16 OF CHAR; cname : Name;
BEGIN
ASSERT(component # NIL);
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 : LONGINT);
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 : LONGINT);
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 : LONGINT);
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;
PROCEDURE GetID*() : LONGINT;
BEGIN {EXCLUSIVE}
INC(nextID);
RETURN nextID;
END GetID;
PROCEDURE Store*(VAR res : LONGINT);
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 : LONGINT);
VAR writer : Streams.Writer; context: StoreContext;
BEGIN
ASSERT(component # NIL);
archive.Acquire;
D.String("StoreComponent to "); D.String(filename); D.Ln;
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;
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.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 : LONGINT;
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.SetAttributeValue(ptr(XML.Attribute).GetName()^, ptr(XML.Attribute).GetValue()^);
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;
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 : LONGINT;
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);
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
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);
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;
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<LEN(name)) & (name[i] # 0X) & ('0' <= name[i]) & (name[i] <= '9') DO
INC(i);
END;
RETURN (i<LEN(name)) & (name[i] = 0X)
END IsNumber;
PROCEDURE NewJoinName*(CONST repositoryName, componentName : ARRAY OF CHAR; id : LONGINT) : Strings.String;
VAR name : ARRAY 256 OF CHAR;
BEGIN
JoinName(repositoryName, componentName, id, name);
RETURN Strings.NewString(name);
END NewJoinName;
PROCEDURE SplitFilename(CONST fullname : ARRAY OF CHAR; VAR repositoryName, extension : ARRAY OF CHAR);
VAR name, path : Files.FileName;
BEGIN
Files.SplitPath(fullname, path, name);
Files.SplitExtension(name, repositoryName, extension);
END SplitFilename;
PROCEDURE GetCommand*(CONST command : ARRAY OF CHAR; VAR res : LONGINT) : Command;
VAR proc : Command; moduleName, procedureName : Modules.Name; msg : ARRAY 128 OF CHAR;
BEGIN
proc := NIL;
Commands.Split(command, moduleName, procedureName, res, msg);
IF (res = Commands.Ok) THEN
GETPROCEDURE(moduleName, procedureName, proc);
IF (proc # NIL) THEN
res := Ok;
ELSE
res := NotFound;
KernelLog.String("Repositories.GetCommand: "); KernelLog.String(command);
KernelLog.String(" not found"); KernelLog.Ln;
END;
ELSE
KernelLog.String("Repositories.GetCommand: "); KernelLog.String(command);
KernelLog.String(" is not a valid command string, res: "); KernelLog.Int(res, 0); KernelLog.Ln;
END;
RETURN proc;
END GetCommand;
PROCEDURE IsCommandString*(CONST string : ARRAY OF CHAR) : BOOLEAN;
BEGIN
RETURN Strings.StartsWith2(CommandPrefix, string);
END IsCommandString;
PROCEDURE ExtractCommand*(CONST string : ARRAY OF CHAR; VAR command : ARRAY OF CHAR);
BEGIN
IF IsCommandString(string) THEN
COPY(string, command);
Strings.Delete(command, 0, Strings.Length(CommandPrefix));
ELSE
command := "";
END;
END ExtractCommand;
PROCEDURE CallCommand*(CONST command : ARRAY OF CHAR; VAR context : Context; VAR res : LONGINT);
VAR
cmd : ARRAY 64 OF CHAR; param : POINTER TO ARRAY OF CHAR; reader : Streams.StringReader;
proc : Command; i, j : LONGINT;
BEGIN
IF Strings.StartsWith2(CommandPrefix, command) THEN
i := Strings.Length(CommandPrefix);
ELSE
i := 0;
END;
WHILE (i < LEN(command)) & (command[i] # 0X) & (command[i] <= " ") DO INC(i); END;
j := 0;
WHILE (j < LEN(cmd)) & (i < LEN(command)) & (command[i] > " ") DO
cmd[j] := command[i];
INC(i); INC(j);
END;
IF (j < LEN(cmd)) & (i < LEN(command)) & (j >= 2) 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);
END;
ELSE
res := NotFound;
END;
END CallCommand;
PROCEDURE GetTranslationInfo*(CONST string : ARRAY OF CHAR; VAR dictionary : Dictionary; VAR word : Strings.String; VAR res : LONGINT);
VAR repositoryName, dictionaryName, temp : ARRAY 512 OF CHAR; i, j : LONGINT;
BEGIN
res := Ok;
dictionary := NIL; word := NIL;
IF (LEN(string) > 7) THEN
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 : LONGINT;
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 : LONGINT);
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 : LONGINT);
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 : LONGINT);
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 : LONGINT);
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 : LONGINT);
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 : LONGINT);
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 : LONGINT);
VAR repository : Repository;
BEGIN
repository := ThisRepository(repositoryName);
IF (repository # NIL) THEN
repository.RemoveComponent(componentName, refNum, res);
ELSE
res := RepositoryNotFound;
END;
END RemoveComponent;
PROCEDURE Add(repository : Repository; VAR res : LONGINT);
VAR r : Repository;
BEGIN
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;
PROCEDURE Remove(repository : Repository; VAR res : LONGINT);
VAR r : Repository;
BEGIN
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;
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;
PROCEDURE ThisRepository*(CONST name : ARRAY OF CHAR) : Repository;
VAR r : Repository; res : LONGINT;
BEGIN {EXCLUSIVE}
r := FindRepository(name);
IF (r = NIL) THEN
r := LoadRepository(name, res);
END;
RETURN r;
END ThisRepository;
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;
PROCEDURE LoadRepository(CONST name : ARRAY OF CHAR; VAR res : LONGINT) : Repository;
VAR
filename : Files.FileName;
repository : Repository;
archive : Archives.Archive;
receiver : Streams.Receiver; reader : Streams.Reader;
element : XML.Element;
ignore : LONGINT;
errors : ErrorReporter;
BEGIN
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
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;
PROCEDURE UnloadRepository*(CONST name : ARRAY OF CHAR; VAR res : LONGINT);
VAR repository : Repository;
BEGIN {EXCLUSIVE}
repository := FindRepository(name);
IF (repository # NIL) THEN
Remove(repository, res);
ELSE
res := RepositoryNotLoaded;
END;
END UnloadRepository;
PROCEDURE StoreRepository*(CONST name : ARRAY OF CHAR; VAR res : LONGINT);
VAR repository : Repository;
BEGIN {EXCLUSIVE}
repository := FindRepository(name);
IF (repository # NIL) THEN
repository.Store(res);
INC(globalTimestamp);
ELSE
res := RepositoryNotLoaded;
END;
END StoreRepository;
PROCEDURE CreateRepository*(CONST filename : ARRAY OF CHAR; VAR res : LONGINT);
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('<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'); 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 ComponentFromXML*(xml: XML.Element): Component;
VAR generator: PROCEDURE(): XML.Element;
VAR
l,name: Strings.String;
moduleName, procedureName: Modules.Name;
res: LONGINT; 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 : LONGINT; 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;
PROCEDURE Create*(context : Commands.Context);
VAR repositoryName : Files.FileName; res : LONGINT;
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);
VAR repositoryName : Files.FileName; res : LONGINT;
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);
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);
VAR repositoryName : Files.FileName; res : LONGINT;
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;
PROCEDURE Put*(context : Commands.Context);
VAR
componentName, repositoryName, asName : ARRAY 256 OF CHAR;
nbr : ARRAY 3 OF CHAR;
component : Component; id, res : LONGINT;
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);
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);
VAR c : Context; cmdString : POINTER TO ARRAY OF CHAR; res : 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), res);
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.