WebStd.Mod 94 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616
  1. MODULE WebStd; (** AUTHOR "Luc Blaeser"; PURPOSE "Standard Active Element Library for Dynamic Webpage Generation"*)
  2. IMPORT DynamicWebpage, PrevalenceSystem, HTTPSupport, HTTPSession, GenericSort, XML, XMLObjects, DynamicStrings,
  3. Dates, Strings, TFClasses, KernelLog, WebHTTP;
  4. CONST
  5. DateTimeFormat* = "dd.mm.yyyy hh:nn:ss";
  6. SessionContainerNamePrefix = "dxp-WebStd-sessioncontainer-";
  7. SessionVariableNamePrefix = "dxp-WebStd-variable-";
  8. SessionGuardNamePrefix = "dxp-WebStd-Guard-";
  9. SessionVisitorCounterPrefix = "dxp-WebStd-VisitorCounter-";
  10. TYPE
  11. (** normal XHTML attribute and element names should be lowercase *)
  12. (** hyperlink with implicit delegation of sessionid if target is not another webserver.
  13. * if href is not specified then the previously requested page is used as href .
  14. * usage expamle:
  15. * <WebStd:Hyperlink href="site.dxp" target="mainview" ...>text or image</WebStd:Hyperlink> *)
  16. Hyperlink* = OBJECT (DynamicWebpage.StateLessActiveElement)
  17. PROCEDURE Transform*(input: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  18. VAR a: XML.Element; hrefString, attrName, sessionCounterStr: Strings.String; newUri: ARRAY 4096 OF CHAR;
  19. enum: XMLObjects.Enumerator; p: ANY; attr: XML.Attribute; content: XML.Content;
  20. dynStr: DynamicStrings.DynamicString; session: HTTPSession.Session;
  21. BEGIN
  22. session := HTTPSession.GetSession(request); (* session # NIL *)
  23. hrefString := input.GetAttributeValue("href");
  24. IF ((hrefString = NIL) OR (~IsExternalHyperlink(hrefString^, request.header.host))) THEN
  25. IF (hrefString # NIL) THEN
  26. COPY(hrefString^, newUri);
  27. IF (Strings.Pos("?", hrefString^) = -1) THEN
  28. Strings.Append(newUri, "?")
  29. ELSE
  30. Strings.Append(newUri, "&")
  31. END
  32. ELSE
  33. (* href is the previous requested page *)
  34. Strings.Concat(request.shortUri, "?", newUri)
  35. END;
  36. Strings.Append(newUri, HTTPSession.HTTPVarSessionIdName);
  37. Strings.Append(newUri, "=");
  38. Strings.Append(newUri, session.sessionId);
  39. p := session.GetVariableValue(DynamicWebpage.StateCounterVariable);
  40. IF ((p # NIL) & (p IS DynamicStrings.DynamicString)) THEN
  41. dynStr := p(DynamicStrings.DynamicString); sessionCounterStr := dynStr.ToArrOfChar(); (* sessionCounterStr # NIL *)
  42. Strings.Append(newUri, "&");
  43. Strings.Append(newUri, DynamicWebpage.StateCounterVariable);
  44. Strings.Append(newUri, "=");
  45. Strings.Append(newUri, sessionCounterStr^)
  46. END
  47. ELSE
  48. COPY(hrefString^, newUri)
  49. END;
  50. NEW(a); a.SetName("a"); a.SetAttributeValue("href", newUri);
  51. enum := input.GetAttributes();
  52. WHILE (enum.HasMoreElements()) DO
  53. p := enum.GetNext(); attr := p(XML.Attribute);
  54. attrName := attr.GetName();
  55. IF ((attrName # NIL) & (attrName^ # "href") & (Strings.Pos("xmlns", attrName^) # 0)) THEN
  56. a.AddAttribute(attr)
  57. END
  58. END;
  59. enum := input.GetContents();
  60. WHILE (enum.HasMoreElements()) DO
  61. p := enum.GetNext(); content := p(XML.Content);
  62. a.AddContent(content)
  63. END;
  64. RETURN a
  65. END Transform;
  66. END Hyperlink;
  67. (** returns a HTTP header field value specified by name attribute and special header properties like "#ip", "#port", "#method"
  68. * <WebStd:GetHeaderField name="referer" />
  69. *)
  70. GetHeaderField* = OBJECT(DynamicWebpage.StateLessActiveElement)
  71. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  72. VAR fieldName : Strings.String;
  73. result : ARRAY 256 OF CHAR;
  74. BEGIN
  75. fieldName := elem.GetAttributeValue("name");
  76. IF (fieldName # NIL) THEN
  77. WebHTTP.GetRequestPropertyValue(request.header, fieldName^, result);
  78. RETURN CreateXMLText(result)
  79. ELSE RETURN NIL
  80. END
  81. END Transform;
  82. END GetHeaderField;
  83. (** set a session global variable, usage example:
  84. * <WebStd:SetVariable name="myvar" value="myVal"/>
  85. *)
  86. SetVariable* = OBJECT(DynamicWebpage.StateLessActiveElement)
  87. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  88. VAR varName, varValue, encVarName: Strings.String; session: HTTPSession.Session;
  89. dynVarValue, dynVarName: DynamicStrings.DynamicString;
  90. BEGIN (* only DynamicString can have a type guard for PTR *)
  91. varName := elem.GetAttributeValue("name");
  92. varValue := elem.GetAttributeValue("value");
  93. IF ((varName # NIL) & (varValue # NIL)) THEN
  94. NEW(dynVarValue); dynVarValue.Append(varValue^);
  95. NEW(dynVarName); Concat(dynVarName, SessionVariableNamePrefix);
  96. dynVarName.Append(varName^);
  97. encVarName := dynVarName.ToArrOfChar();
  98. session := HTTPSession.GetSession(request);
  99. session.AddVariableValue(encVarName^, dynVarValue)
  100. END;
  101. RETURN NIL
  102. END Transform;
  103. END SetVariable;
  104. (** get a session global variable, usage example:
  105. * <WebStd:GetVariable name="myvar"/>
  106. *)
  107. GetVariable* = OBJECT(DynamicWebpage.StateLessActiveElement)
  108. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  109. VAR varName, varValue, encVarName: Strings.String; session: HTTPSession.Session;
  110. dynVarValue, dynVarName: DynamicStrings.DynamicString; p: ANY;
  111. BEGIN
  112. varName := elem.GetAttributeValue("name");
  113. IF (varName # NIL) THEN
  114. NEW(dynVarName); Concat(dynVarName, SessionVariableNamePrefix);
  115. dynVarName.Append(varName^);
  116. encVarName := dynVarName.ToArrOfChar();
  117. session := HTTPSession.GetSession(request);
  118. p := session.GetVariableValue(encVarName^);
  119. IF ((p # NIL) & (p IS DynamicStrings.DynamicString)) THEN
  120. dynVarValue := p(DynamicStrings.DynamicString);
  121. IF (dynVarValue.Length() > 0) THEN
  122. varValue := dynVarValue.ToArrOfChar();
  123. RETURN CreateXMLText(varValue^)
  124. END
  125. END
  126. END;
  127. RETURN NIL
  128. END Transform;
  129. END GetVariable;
  130. (** conditional element. If 'condition' contains exactly the text "true" then the 'Expression'-content is the result.
  131. * If 'condition' contains exactly the text 'false' then no result will be generated and active elements apearing
  132. * under the 'Expression'-element will not be transformed.
  133. * The condition value could be the result of another active element like <WebStd:IsEqual>
  134. * "WebStd:IsEqual". Usage example:
  135. * <WebStd:Guard>
  136. * <Condition>true|false</Condition>
  137. * <Expression> .. </Expression>
  138. * </WebStd:Guard>
  139. *)
  140. Guard* = OBJECT (DynamicWebpage.StateLessActiveElement)
  141. (* the 'Expression' subtree is only transformed if the condition has the value 'true'. Since the condition can have
  142. * further active element in its content, it can only be decided in the Transform()-method if the contents of
  143. * the 'Expression'-element will be used for the transformation result.
  144. * Therefore in PreTransform the 'Expression'-subtree is cut out and stored into the session using the
  145. * SessionGuardNamePrefix followed by the request.shortUri to support parallel requests of the same client
  146. * for different documents with if statements. The use of a state full active element would result in worse
  147. * performance, since each 'Guard'-occurence would have its own instances *)
  148. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  149. VAR conditionElem, expressionElem: XML.Element; session: HTTPSession.Session;
  150. dynVarName: DynamicStrings.DynamicString; varName, condText: Strings.String; p: ANY;
  151. outContainer: XML.Container;
  152. BEGIN
  153. session := HTTPSession.GetSession(request);
  154. NEW(dynVarName); Concat(dynVarName, SessionGuardNamePrefix);
  155. dynVarName.Append(request.shortUri);
  156. varName := dynVarName.ToArrOfChar();
  157. p := session.GetVariableValue(varName^);
  158. IF ((p # NIL) & (p IS XML.Element)) THEN
  159. expressionElem := p(XML.Element)
  160. ELSE
  161. expressionElem := NIL
  162. END;
  163. session.RemoveVariable(varName^);
  164. conditionElem := GetXMLSubElement(elem, "Condition");
  165. IF (conditionElem # NIL) THEN
  166. condText := GetXMLCharContent(conditionElem);
  167. IF ((condText # NIL) & (condText^ = "true")) THEN
  168. IF (expressionElem # NIL) THEN
  169. NEW(outContainer);
  170. CopyXMLSubContents(expressionElem, outContainer);
  171. RETURN outContainer
  172. ELSE
  173. RETURN NIL
  174. END
  175. ELSIF ((condText # NIL) & (condText^ = "false")) THEN
  176. RETURN NIL
  177. ELSE
  178. NEW(outContainer);
  179. AppendXMLContent(outContainer, CreateXMLText("WebStd:Guard: Condition value must be either 'true' or 'false' but not "));
  180. IF (condText # NIL) THEN AppendXMLContent(outContainer, CreateXMLText(condText^)) END;
  181. RETURN outContainer
  182. END
  183. ELSE
  184. RETURN CreateXMLText("No condition specified for WebStd:Guard.")
  185. END
  186. END Transform;
  187. PROCEDURE PreTransform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  188. VAR expressionElem: XML.Element; session: HTTPSession.Session; dynVarName: DynamicStrings.DynamicString;
  189. varName: Strings.String;
  190. BEGIN
  191. session := HTTPSession.GetSession(request);
  192. expressionElem := GetXMLSubElement(elem, "Expression");
  193. NEW(dynVarName); Concat(dynVarName, SessionGuardNamePrefix);
  194. dynVarName.Append(request.shortUri);
  195. varName := dynVarName.ToArrOfChar();
  196. session.AddVariableValue(varName^, expressionElem);
  197. IF (expressionElem # NIL) THEN
  198. elem.RemoveContent(expressionElem)
  199. END;
  200. RETURN elem
  201. END PreTransform;
  202. END Guard;
  203. (** sequence over multiple requests of one page for a session. If the attribute 'circular' is set to 'true' then at the end of the
  204. * sequence the sequence will be restarted. if the sequence is non circular and has reached the last state then it stays in
  205. * the last state. Usage example:
  206. * <WebStd:Sequence id="mySeq3" circular="true">
  207. * <State> .. <State>
  208. * <State> .. <State>
  209. * ..
  210. * </WebStd:Sequence>
  211. * the event "SetState" with parameter "pos" can be used to set the actual state position for a sequence *)
  212. Sequence* = OBJECT (DynamicWebpage.StateFullActiveElement)
  213. VAR
  214. stateCounter: LONGINT;
  215. PROCEDURE &Init*;
  216. BEGIN stateCounter := 0
  217. END Init;
  218. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  219. BEGIN RETURN elem
  220. END Transform;
  221. PROCEDURE PreTransform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  222. VAR p: ANY; enum: XMLObjects.Enumerator; counter: LONGINT; state, actState: XML.Element;
  223. stateName: Strings.String; container: XML.Container; content: XML.Content; circularVal: Strings.String;
  224. BEGIN
  225. actState:= NIL; counter := 0;
  226. enum := elem.GetContents();
  227. WHILE (enum.HasMoreElements()) DO
  228. p := enum.GetNext();
  229. IF (p IS XML.Element) THEN
  230. state := p(XML.Element); stateName := state.GetName();
  231. IF ((stateName # NIL) & (stateName^ = "State")) THEN
  232. IF (stateCounter = counter) THEN
  233. actState := state
  234. END;
  235. INC(counter);
  236. END
  237. END
  238. END;
  239. INC(stateCounter);
  240. circularVal := elem.GetAttributeValue("circular");
  241. IF ((counter > 0) & (stateCounter >= counter)) THEN
  242. IF ((circularVal # NIL) & (circularVal^ = "true")) THEN
  243. stateCounter := stateCounter MOD counter
  244. ELSE
  245. stateCounter := counter-1
  246. END
  247. END;
  248. IF (actState # NIL) THEN
  249. NEW(container);
  250. enum := actState.GetContents();
  251. WHILE (enum.HasMoreElements()) DO
  252. p := enum.GetNext(); content := p(XML.Content);
  253. container.AddContent(content)
  254. END;
  255. RETURN container
  256. ELSE (* end of the sequence was already reached *)
  257. RETURN NIL
  258. END
  259. END PreTransform;
  260. PROCEDURE SetState(request: HTTPSupport.HTTPRequest; params: DynamicWebpage.ParameterList);
  261. (* parameters "pos" *)
  262. VAR posStr: Strings.String;
  263. BEGIN
  264. posStr := params.GetParameterValueByName("pos");
  265. IF (posStr # NIL) THEN
  266. Strings.StrToInt(posStr^, stateCounter)
  267. ELSE
  268. KernelLog.String("WebStd:Sequence - event handler 'SetState' has parameter 'pos'.");
  269. KernelLog.Ln
  270. END
  271. END SetState;
  272. PROCEDURE GetEventHandlers*() : DynamicWebpage.EventHandlerList;
  273. VAR list: DynamicWebpage.EventHandlerList;
  274. BEGIN
  275. NEW(list, 1);
  276. NEW(list[0], "SetState", SetState);
  277. RETURN list
  278. END GetEventHandlers;
  279. END Sequence;
  280. (** an equal comparison for two XML subforests in 'Arg1' and 'Arg2'.
  281. * Returns 'true' iff the subforests are equal otherwise 'false'. Usage example:
  282. * <WebStd:IsEqual>
  283. * <Arg1></Arg1>
  284. * <Arg2></Arg2>
  285. * </WebStd:IsEqual> *)
  286. IsEqual* = OBJECT (DynamicWebpage.StateLessActiveElement)
  287. PROCEDURE Compare(arg1, arg2: XML.Content) : BOOLEAN;
  288. VAR chars1, chars2: XML.Chars; str1, str2: Strings.String; cref1, cref2: XML.CharReference;
  289. ncont1, ncont2: XML.NameContent; attr1, attr2: XML.Attribute; cont1, cont2: XML.Container;
  290. enum1, enum2: XMLObjects.Enumerator; p1, p2: ANY; content1, content2: XML.Content;
  291. elem1, elem2: XML.Element;
  292. BEGIN
  293. IF ((arg1 = NIL) OR (arg2 = NIL)) THEN
  294. RETURN arg1 = arg2
  295. ELSIF (arg1 IS XML.Chars) THEN
  296. IF (arg2 IS XML.Chars) THEN
  297. chars1 := arg1(XML.Chars); chars2 := arg2(XML.Chars);
  298. str1 := chars1.GetStr(); str2 := chars2.GetStr();
  299. IF ((str1 # NIL) & (str2 # NIL)) THEN
  300. RETURN str1^ = str2^
  301. ELSE
  302. RETURN str1 = str2
  303. END
  304. ELSE
  305. RETURN FALSE
  306. END
  307. ELSIF (arg1 IS XML.CharReference) THEN
  308. IF (arg2 IS XML.CharReference) THEN
  309. cref1 := arg1(XML.CharReference); cref2 := arg2(XML.CharReference);
  310. RETURN cref1.GetCode() = cref2.GetCode()
  311. ELSE
  312. RETURN FALSE
  313. END
  314. ELSIF (arg1 IS XML.NameContent) THEN
  315. IF (arg2 IS XML.NameContent) THEN
  316. ncont1 := arg1(XML.NameContent); ncont2 := arg2(XML.NameContent);
  317. str1 := ncont1.GetName(); str2 := ncont2.GetName();
  318. IF ((str1 = NIL) OR (str2 = NIL)) THEN
  319. IF (str1 # str2) THEN RETURN FALSE END
  320. ELSIF (str1^ # str2^) THEN
  321. RETURN FALSE
  322. END;
  323. IF (ncont1 IS XML.Attribute) THEN
  324. IF (ncont2 IS XML.Attribute) THEN
  325. attr1 := ncont1(XML.Attribute); attr2 := ncont2(XML.Attribute);
  326. str1 := attr1.GetValue(); str2 := attr2.GetValue();
  327. IF ((str1 # NIL) & (str2 # NIL)) THEN
  328. RETURN str1^ = str2^
  329. ELSE
  330. RETURN str1 = str2
  331. END
  332. ELSE
  333. RETURN FALSE
  334. END
  335. END;
  336. RETURN TRUE
  337. ELSE
  338. RETURN FALSE
  339. END
  340. ELSIF (arg1 IS XML.Container) THEN
  341. IF (arg2 IS XML.Container) THEN
  342. cont1 := arg1(XML.Container); cont2 := arg2(XML.Container);
  343. enum1 := cont1.GetContents(); enum2 := cont2.GetContents();
  344. WHILE ((enum1.HasMoreElements()) & (enum2.HasMoreElements())) DO
  345. p1 := enum1.GetNext(); p2 := enum2.GetNext();
  346. content1 := p1(XML.Content); content2 := p2(XML.Content);
  347. IF (~Compare(content1, content2)) THEN RETURN FALSE END
  348. END;
  349. IF ((enum1.HasMoreElements()) OR (enum2.HasMoreElements())) THEN RETURN FALSE END;
  350. IF (cont1 IS XML.Element) THEN
  351. IF (cont2 IS XML.Element) THEN
  352. elem1 := cont1(XML.Element); elem2 := cont2(XML.Element);
  353. str1 := elem1.GetName(); str2 := elem2.GetName();
  354. IF ((str1 # NIL) & (str2 # NIL)) THEN
  355. IF (str1^ # str2^) THEN RETURN FALSE END
  356. ELSE
  357. IF (str1 # str2) THEN RETURN FALSE END
  358. END;
  359. enum1 := elem1.GetAttributes(); enum2 := elem2.GetAttributes();
  360. WHILE ((enum1.HasMoreElements()) & (enum2.HasMoreElements())) DO
  361. p1 := enum1.GetNext(); p2 := enum2.GetNext();
  362. content1 := p1(XML.Content); content2 := p2(XML.Content);
  363. IF (~Compare(content1, content2)) THEN RETURN FALSE END
  364. END;
  365. IF ((enum1.HasMoreElements()) OR (enum2.HasMoreElements())) THEN RETURN FALSE END;
  366. RETURN TRUE
  367. ELSE
  368. RETURN FALSE
  369. END;
  370. END;
  371. RETURN TRUE
  372. ELSE
  373. RETURN FALSE
  374. END
  375. ELSE
  376. (* not supported *)
  377. RETURN FALSE
  378. END
  379. END Compare;
  380. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  381. VAR arg1, arg2: XML.Element; enum1, enum2: XMLObjects.Enumerator; p1, p2: ANY; content1, content2: XML.Content;
  382. BEGIN
  383. arg1 := GetXMLSubElement(elem, "Arg1"); arg2 := GetXMLSubElement(elem, "Arg2");
  384. IF ((arg1 # NIL) & (arg2 # NIL)) THEN
  385. enum1 := arg1.GetContents(); enum2 := arg2.GetContents();
  386. WHILE ((enum1.HasMoreElements()) & (enum2.HasMoreElements())) DO
  387. p1 := enum1.GetNext(); p2 := enum2.GetNext();
  388. content1 := p1(XML.Content); content2 := p2(XML.Content);
  389. IF (~Compare(content1, content2)) THEN
  390. RETURN CreateXMLText("false")
  391. END
  392. END;
  393. IF ((enum1.HasMoreElements()) OR (enum2.HasMoreElements())) THEN
  394. RETURN CreateXMLText("false")
  395. END;
  396. RETURN CreateXMLText("true")
  397. ELSE
  398. RETURN CreateXMLText("WebStd:IsEqual: Missing 'Arg1' or 'Arg2' subelement")
  399. END
  400. END Transform;
  401. END IsEqual;
  402. (** returns 'true' if the content is 'false'. If the content is 'false' then it returns 'true'. Usage example
  403. * The content could be the results of active elements like 'IsEqual'.
  404. * <WebStd:Not>true|false</WebStd:Not> *)
  405. Not* = OBJECT(DynamicWebpage.StateLessActiveElement)
  406. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  407. VAR str: Strings.String;
  408. BEGIN
  409. str := GetXMLCharContent(elem);
  410. IF ((str # NIL) & (str^ = "true")) THEN
  411. RETURN CreateXMLText("false")
  412. ELSIF ((str # NIL) & (str^ = "false")) THEN
  413. RETURN CreateXMLText("true")
  414. ELSE
  415. RETURN CreateXMLText("WebStd:Not - Content must be either 'true' or 'false'.")
  416. END
  417. END Transform;
  418. END Not;
  419. (** returns 'true' if both arguments 'Arg1' and 'Arg2' have content 'true'. If one of them has content 'false' the result will be
  420. * 'false'. The contents could be the results of active elements like 'IsEqual'. Usage example:
  421. * <WebStd:And>
  422. * <Arg1>true|false</Arg1>
  423. * <Arg2>true|false</Arg2>
  424. * </WebStd:And> *)
  425. And* = OBJECT(DynamicWebpage.StateLessActiveElement)
  426. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  427. VAR arg1, arg2: XML.Element; str1, str2: Strings.String;
  428. BEGIN
  429. arg1 := GetXMLSubElement(elem, "Arg1");
  430. arg2 := GetXMLSubElement(elem, "Arg2");
  431. IF ((arg1 # NIL) & (arg2 # NIL)) THEN
  432. str1 := GetXMLCharContent(arg1);
  433. str2 := GetXMLCharContent(arg2);
  434. IF ((str1 # NIL) & (str1^ = "true") & (str2 # NIL) & (str2^ = "true")) THEN
  435. RETURN CreateXMLText("true")
  436. ELSIF ((str1 # NIL) & (str1^ = "true") & (str2 # NIL) & (str2^ = "false")) THEN
  437. RETURN CreateXMLText("false")
  438. ELSIF ((str1 # NIL) & (str1^ = "false") & (str2 # NIL) & (str2^ = "true")) THEN
  439. RETURN CreateXMLText("false")
  440. ELSIF ((str1 # NIL) & (str1^ = "false") & (str2 # NIL) & (str2^ = "false")) THEN
  441. RETURN CreateXMLText("false")
  442. ELSE
  443. RETURN CreateXMLText("WebStd:And - Content of 'Arg1' and 'Arg2' must be either 'true' or 'false'.")
  444. END
  445. ELSE
  446. RETURN CreateXMLText("WebStd:And - 'Arg1' or 'Arg2' subelements missing.")
  447. END
  448. END Transform;
  449. END And;
  450. (** returns 'true' if argument 'Arg1' or 'Arg2' (or both) has content 'true'. If both of them have content 'false'
  451. * the result will be 'false'. The contents could be the results of active elements like 'IsEqual'. Usage example:
  452. * <WebStd:Or>
  453. * <Arg1>true|false</Arg1>
  454. * <Arg2>true|false</Arg2>
  455. * </WebStd:Or> *)
  456. Or* = OBJECT(DynamicWebpage.StateLessActiveElement)
  457. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  458. VAR arg1, arg2: XML.Element; str1, str2: Strings.String;
  459. BEGIN
  460. arg1 := GetXMLSubElement(elem, "Arg1");
  461. arg2 := GetXMLSubElement(elem, "Arg2");
  462. IF ((arg1 # NIL) & (arg2 # NIL)) THEN
  463. str1 := GetXMLCharContent(arg1);
  464. str2 := GetXMLCharContent(arg2);
  465. IF ((str1 # NIL) & (str1^ = "false") & (str2 # NIL) & (str2^ = "false")) THEN
  466. RETURN CreateXMLText("false")
  467. ELSIF ((str1 # NIL) & (str1^ = "true") & (str2 # NIL) & (str2^ = "false")) THEN
  468. RETURN CreateXMLText("true")
  469. ELSIF ((str1 # NIL) & (str1^ = "false") & (str2 # NIL) & (str2^ = "true")) THEN
  470. RETURN CreateXMLText("true")
  471. ELSIF ((str1 # NIL) & (str1^ = "true") & (str2 # NIL) & (str2^ = "true")) THEN
  472. RETURN CreateXMLText("true")
  473. ELSE
  474. RETURN CreateXMLText("WebStd:Or - Content of 'Arg1' and 'Arg2' must be either 'true' or 'false'.")
  475. END
  476. ELSE
  477. RETURN CreateXMLText("WebStd:Or - 'Arg1' or 'Arg2' subelements missing.")
  478. END
  479. END Transform;
  480. END Or;
  481. (** returns 'true' if argument either 'Arg1' or 'Arg2' has content 'true'. If both of them have the same content 'true' or 'false'
  482. * the result will be 'false'. The contents could be the results of active elements like 'IsEqual'. Usage example:
  483. * <WebStd:Xor>
  484. * <Arg1>true|false</Arg1>
  485. * <Arg2>true|false</Arg2>
  486. * </WebStd:Xor> *)
  487. Xor* = OBJECT(DynamicWebpage.StateLessActiveElement)
  488. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  489. VAR arg1, arg2: XML.Element; str1, str2: Strings.String;
  490. BEGIN
  491. arg1 := GetXMLSubElement(elem, "Arg1");
  492. arg2 := GetXMLSubElement(elem, "Arg2");
  493. IF ((arg1 # NIL) & (arg2 # NIL)) THEN
  494. str1 := GetXMLCharContent(arg1);
  495. str2 := GetXMLCharContent(arg2);
  496. IF ((str1 # NIL) & (str1^ = "true") & (str2 # NIL) & (str2^ = "false")) THEN
  497. RETURN CreateXMLText("true")
  498. ELSIF ((str1 # NIL) & (str1^ = "false") & (str2 # NIL) & (str2^ = "true")) THEN
  499. RETURN CreateXMLText("true")
  500. ELSIF ((str1 # NIL) & (str1^ = "false") & (str2 # NIL) & (str2^ = "false")) THEN
  501. RETURN CreateXMLText("false")
  502. ELSIF ((str1 # NIL) & (str1^ = "true") & (str2 # NIL) & (str2^ = "true")) THEN
  503. RETURN CreateXMLText("false")
  504. ELSE
  505. RETURN CreateXMLText("WebStd:Xor - Content of 'Arg1' and 'Arg2' must be either 'true' or 'false'.")
  506. END
  507. ELSE
  508. RETURN CreateXMLText("WebStd:Xor - 'Arg1' or 'Arg2' subelements missing.")
  509. END
  510. END Transform;
  511. END Xor;
  512. (** a button that triggers a user event, usage example:
  513. * EventButton can optionally have an attribute 'href' to specify another target page as the current one.
  514. * If the target object is a statefull active element then 'objectid' has to used to specify the instance.
  515. * <WebStd:EventButton label="ButtonLabel" method="invoke123" object="ObjABC" module="ModXYZ" objectid="myElem3">
  516. * <Param name="param1" value="val1"/>
  517. * <Param name="param2" value="val2"/>
  518. * ...
  519. * </WebStd:EventButton> *)
  520. EventButton* = OBJECT (DynamicWebpage.StateLessActiveElement)
  521. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  522. VAR labelName, methodName, objectName, objectIdName, moduleName, elemName, paramName, paramValue,
  523. hrefString, sessionCounterStr: Strings.String; form, input, param: XML.Element; enum: XMLObjects.Enumerator;
  524. p: ANY; newParamName, encStr: ARRAY 128 OF CHAR; content: XML.Content; session: HTTPSession.Session;
  525. dynStr: DynamicStrings.DynamicString;
  526. BEGIN
  527. session := HTTPSession.GetSession(request); (* session # NIL *)
  528. labelName := elem.GetAttributeValue("label");
  529. methodName := elem.GetAttributeValue("method");
  530. objectName := elem.GetAttributeValue("object");
  531. objectIdName := elem.GetAttributeValue("objectid");
  532. moduleName := elem.GetAttributeValue("module");
  533. IF ((moduleName # NIL) & (methodName# NIL) & (objectName # NIL)) THEN
  534. NEW(form); form.SetName("form");
  535. form.SetAttributeValue("method", "POST");
  536. hrefString := elem.GetAttributeValue("href");
  537. IF (hrefString # NIL) THEN
  538. form.SetAttributeValue("action", hrefString^)
  539. ELSE
  540. form.SetAttributeValue("action", request.shortUri)
  541. END;
  542. NEW(input); input.SetName("input");
  543. input.SetAttributeValue("type", "hidden");
  544. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandModule);
  545. input.SetAttributeValue("value", moduleName^);
  546. form.AddContent(input);
  547. NEW(input); input.SetName("input");
  548. input.SetAttributeValue("type", "hidden");
  549. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandObject);
  550. input.SetAttributeValue("value", objectName^);
  551. form.AddContent(input);
  552. NEW(input); input.SetName("input");
  553. input.SetAttributeValue("type", "hidden");
  554. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandMethod);
  555. input.SetAttributeValue("value", methodName^);
  556. form.AddContent(input);
  557. IF (objectIdName # NIL) THEN
  558. NEW(input); input.SetName("input");
  559. input.SetAttributeValue("type", "hidden");
  560. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandObjectId);
  561. input.SetAttributeValue("value", objectIdName^);
  562. form.AddContent(input)
  563. END;
  564. enum := elem.GetContents();
  565. WHILE (enum.HasMoreElements()) DO
  566. p := enum.GetNext();
  567. IF (p IS XML.Element) THEN
  568. param := p(XML.Element); elemName := param.GetName();
  569. IF ((elemName # NIL) & (elemName^ = "Param")) THEN
  570. paramName := param.GetAttributeValue("name");
  571. paramValue := param.GetAttributeValue("value");
  572. IF ((paramName # NIL) & (paramValue # NIL)) THEN
  573. HTTPSupport.HTTPEncode(paramName^, encStr);
  574. Strings.Concat(DynamicWebpage.HTTPVarCommandParamPrefix, encStr, newParamName);
  575. NEW(input); input.SetName("input");
  576. input.SetAttributeValue("type", "hidden");
  577. input.SetAttributeValue("name", newParamName);
  578. HTTPSupport.HTTPEncode(paramValue^, encStr);
  579. input.SetAttributeValue("value", encStr);
  580. form.AddContent(input)
  581. ELSE
  582. form.AddContent(param)
  583. END
  584. ELSE
  585. content := p(XML.Content); form.AddContent(content)
  586. END
  587. END
  588. END;
  589. NEW(input); input.SetName("input");
  590. input.SetAttributeValue("type", "hidden");
  591. input.SetAttributeValue("name", HTTPSession.HTTPVarSessionIdName);
  592. input.SetAttributeValue("value", session.sessionId);
  593. form.AddContent(input);
  594. p := session.GetVariableValue(DynamicWebpage.StateCounterVariable);
  595. IF ((p # NIL) & (p IS DynamicStrings.DynamicString)) THEN
  596. dynStr := p(DynamicStrings.DynamicString); sessionCounterStr := dynStr.ToArrOfChar(); (* sessionCounterStr # NIL *)
  597. NEW(input); input.SetName("input");
  598. input.SetAttributeValue("type", "hidden");
  599. input.SetAttributeValue("name", DynamicWebpage.StateCounterVariable);
  600. input.SetAttributeValue("value", sessionCounterStr^);
  601. form.AddContent(input)
  602. END;
  603. NEW(input); input.SetName("input");
  604. input.SetAttributeValue("type", "submit");
  605. IF (labelName # NIL) THEN
  606. input.SetAttributeValue("value", labelName^)
  607. END;
  608. form.AddContent(input);
  609. RETURN form
  610. ELSE
  611. RETURN CreateXMLText("Missing module, object or method name for WebStd:EventButton")
  612. END
  613. END Transform;
  614. END EventButton;
  615. (** a hyperlink that triggers a user event.
  616. * EventLink can optionally have an attribute 'href' to specify another target page as the current one.
  617. * If the target object is a statefull active element then 'objectid' is used to specify the instance.
  618. * usage example:
  619. * <WebStd:EventLink method="invoke123" object="ObjABC" module="ModXYZ" objectId="myElem3">
  620. * <Label>text or image html code</Label>
  621. * <Param name="param1" value="val1"/>
  622. * <Param name="param2" value="val2"/>
  623. * ...
  624. * </WebStd:EventLink> *)
  625. EventLink* = OBJECT(DynamicWebpage.StateLessActiveElement)
  626. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  627. VAR a: XML.Element; newUri: ARRAY 4096 OF CHAR; enum, labelEnum: XMLObjects.Enumerator;
  628. p, labelp: ANY; attr: XML.Attribute; content, labelContent: XML.Content;
  629. methodName, objectName, objectIdName, moduleName, attrName, subElemName, paramName, paramValue,
  630. hrefString, sessionCounterStr: Strings.String; encStr: ARRAY 128 OF CHAR; subElem: XML.Element;
  631. session: HTTPSession.Session; dynStr: DynamicStrings.DynamicString;
  632. BEGIN
  633. session := HTTPSession.GetSession(request);
  634. methodName := elem.GetAttributeValue("method");
  635. objectName := elem.GetAttributeValue("object");
  636. objectIdName := elem.GetAttributeValue("objectid");
  637. moduleName := elem.GetAttributeValue("module");
  638. IF ((moduleName # NIL) & (methodName# NIL) & (objectName # NIL)) THEN
  639. hrefString := elem.GetAttributeValue("href");
  640. IF (hrefString # NIL) THEN
  641. COPY(hrefString^, newUri);
  642. IF (Strings.Pos("?", hrefString^) = -1) THEN
  643. Strings.Append(newUri, "?")
  644. ELSE
  645. Strings.Append(newUri, "&")
  646. END
  647. ELSE
  648. Strings.Concat(request.shortUri, "?", newUri)
  649. END;
  650. Strings.Append(newUri, HTTPSession.HTTPVarSessionIdName);
  651. Strings.Append(newUri, "=");
  652. Strings.Append(newUri, session.sessionId);
  653. Strings.Append(newUri, "&");
  654. Strings.Append(newUri, DynamicWebpage.HTTPVarCommandModule);
  655. Strings.Append(newUri, "=");
  656. Strings.Append(newUri, moduleName^);
  657. Strings.Append(newUri, "&");
  658. Strings.Append(newUri, DynamicWebpage.HTTPVarCommandObject);
  659. Strings.Append(newUri, "=");
  660. Strings.Append(newUri, objectName^);
  661. Strings.Append(newUri, "&");
  662. Strings.Append(newUri, DynamicWebpage.HTTPVarCommandMethod);
  663. Strings.Append(newUri, "=");
  664. Strings.Append(newUri, methodName^);
  665. IF (objectIdName # NIL) THEN
  666. Strings.Append(newUri, "&");
  667. Strings.Append(newUri, DynamicWebpage.HTTPVarCommandObjectId);
  668. Strings.Append(newUri, "=");
  669. Strings.Append(newUri, objectIdName^)
  670. END;
  671. p := session.GetVariableValue(DynamicWebpage.StateCounterVariable);
  672. IF ((p # NIL) & (p IS DynamicStrings.DynamicString)) THEN
  673. dynStr := p(DynamicStrings.DynamicString); sessionCounterStr := dynStr.ToArrOfChar(); (* sessionCounterStr # NIL *)
  674. Strings.Append(newUri, "&");
  675. Strings.Append(newUri, DynamicWebpage.StateCounterVariable);
  676. Strings.Append(newUri, "=");
  677. Strings.Append(newUri, sessionCounterStr^)
  678. END;
  679. NEW(a); a.SetName("a");
  680. enum := elem.GetAttributes();
  681. WHILE (enum.HasMoreElements()) DO
  682. p := enum.GetNext(); attr := p(XML.Attribute);
  683. attrName := attr.GetName();
  684. IF ((attrName # NIL) & (attrName^ # "href") & (attrName^ # "method") & (attrName^ # "object") &
  685. (attrName^ # "objectid") & (attrName^ # "module") & (Strings.Pos("xmlns", attrName^) # 0)) THEN
  686. a.AddAttribute(attr)
  687. END
  688. END;
  689. enum := elem.GetContents();
  690. WHILE (enum.HasMoreElements()) DO
  691. p := enum.GetNext(); content := p(XML.Content);
  692. IF (content IS XML.Element) THEN
  693. subElem := content(XML.Element); subElemName := subElem.GetName();
  694. IF (subElemName^ = "Param") THEN
  695. paramName := subElem.GetAttributeValue("name");
  696. paramValue := subElem.GetAttributeValue("value");
  697. IF ((paramName # NIL) & (paramValue # NIL)) THEN
  698. Strings.Append(newUri, "&");
  699. Strings.Append(newUri, DynamicWebpage.HTTPVarCommandParamPrefix);
  700. HTTPSupport.HTTPEncode(paramName^, encStr);
  701. Strings.Append(newUri, encStr);
  702. Strings.Append(newUri, "=");
  703. HTTPSupport.HTTPEncode(paramValue^, encStr);
  704. Strings.Append(newUri, encStr)
  705. END
  706. ELSIF ((subElemName # NIL) & (subElemName^ = "Label")) THEN
  707. labelEnum := subElem.GetContents();
  708. WHILE (labelEnum.HasMoreElements()) DO
  709. labelp := labelEnum.GetNext(); labelContent := labelp(XML.Content);
  710. a.AddContent(labelContent)
  711. END
  712. END
  713. END
  714. END;
  715. a.SetAttributeValue("href", newUri);
  716. RETURN a
  717. ELSE
  718. RETURN CreateXMLText("Missing module, object or method name for WebStd:EventLink")
  719. END
  720. END Transform;
  721. END EventLink;
  722. (** a formular that triggers a user event with parameters if submitted.
  723. * transfer-method is HTTP POST.
  724. * Formular can have an optionally attribute 'href' to specify another target page as the current one.
  725. * If the target object is a statefull active element then 'objectid' has to used to specfiy the instance.
  726. * usage example:
  727. * <WebStd:Formular method="invoke123" object="ObjABC" module="ModXYZ" objectid="myElem3">
  728. * ...
  729. * <input type="text" name="method-param1" value="val1"/>
  730. * <textarea name="method-param3">hdsdaj</textarea>
  731. * <input type="password" name="method-param2" value="val2"/>
  732. * ...
  733. * <input type="submit" value="Submit"/>
  734. * ...
  735. * </WebStd:Formular> *)
  736. Formular* = OBJECT(DynamicWebpage.StateLessActiveElement)
  737. PROCEDURE Transform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  738. VAR methodName, objectName, objectIdName, moduleName, attrName, hrefString, sessionCounterStr: Strings.String;
  739. session: HTTPSession.Session; form, input: XML.Element; enum: XMLObjects.Enumerator; p: ANY;
  740. content: XML.Content; attr: XML.Attribute; dynStr: DynamicStrings.DynamicString;
  741. BEGIN
  742. session := HTTPSession.GetSession(request); (* session # NIL *)
  743. methodName := elem.GetAttributeValue("method");
  744. objectName := elem.GetAttributeValue("object");
  745. objectIdName := elem.GetAttributeValue("objectid");
  746. moduleName := elem.GetAttributeValue("module");
  747. IF ((moduleName # NIL) & (methodName# NIL) & (objectName # NIL)) THEN
  748. NEW(form); form.SetName("form");
  749. form.SetAttributeValue("method", "post");
  750. hrefString := elem.GetAttributeValue("href");
  751. IF (hrefString # NIL) THEN
  752. form.SetAttributeValue("action", hrefString^)
  753. ELSE
  754. form.SetAttributeValue("action", request.shortUri)
  755. END;
  756. enum := elem.GetAttributes();
  757. WHILE (enum.HasMoreElements()) DO
  758. p := enum.GetNext(); attr := p(XML.Attribute);
  759. attrName := attr.GetName();
  760. IF ((attrName # NIL) & (attrName^ # "href") & (attrName^ # "method")) THEN
  761. form.AddAttribute(attr)
  762. END
  763. END;
  764. NEW(input); input.SetName("input");
  765. input.SetAttributeValue("type", "hidden");
  766. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandModule);
  767. input.SetAttributeValue("value", moduleName^);
  768. form.AddContent(input);
  769. NEW(input); input.SetName("input");
  770. input.SetAttributeValue("type", "hidden");
  771. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandObject);
  772. input.SetAttributeValue("value", objectName^);
  773. form.AddContent(input);
  774. NEW(input); input.SetName("input");
  775. input.SetAttributeValue("type", "hidden");
  776. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandMethod);
  777. input.SetAttributeValue("value", methodName^);
  778. form.AddContent(input);
  779. IF (objectIdName # NIL) THEN
  780. NEW(input); input.SetName("input");
  781. input.SetAttributeValue("type", "hidden");
  782. input.SetAttributeValue("name", DynamicWebpage.HTTPVarCommandObjectId);
  783. input.SetAttributeValue("value", objectIdName^);
  784. form.AddContent(input)
  785. END;
  786. NEW(input); input.SetName("input");
  787. input.SetAttributeValue("type", "hidden");
  788. input.SetAttributeValue("name", HTTPSession.HTTPVarSessionIdName);
  789. input.SetAttributeValue("value", session.sessionId);
  790. form.AddContent(input);
  791. enum := elem.GetContents();
  792. WHILE (enum.HasMoreElements()) DO
  793. p := enum.GetNext(); content := p(XML.Content);
  794. RenameInputAttr(content);
  795. form.AddContent(content)
  796. END;
  797. p := session.GetVariableValue(DynamicWebpage.StateCounterVariable);
  798. IF ((p # NIL) & (p IS DynamicStrings.DynamicString)) THEN
  799. dynStr := p(DynamicStrings.DynamicString); sessionCounterStr := dynStr.ToArrOfChar(); (* sessionCounterStr # NIL *)
  800. NEW(input); input.SetName("input");
  801. input.SetAttributeValue("type", "hidden");
  802. input.SetAttributeValue("name", DynamicWebpage.StateCounterVariable);
  803. input.SetAttributeValue("value", sessionCounterStr^);
  804. form.AddContent(input)
  805. END;
  806. RETURN form
  807. ELSE
  808. RETURN CreateXMLText("Missing module, object or method name for WebStd:Formular")
  809. END
  810. END Transform;
  811. (* rename 'name' attribute for <input>, <textarea>, <select> xhtml elements *)
  812. PROCEDURE RenameInputAttr(n: XML.Content);
  813. VAR elem: XML.Element; elemName, paramName: Strings.String; elemNameLow, newParamName, encStr: ARRAY 128 OF CHAR;
  814. paramNameAttr: XML.Attribute; enum: XMLObjects.Enumerator; container: XML.Container; p: ANY; content: XML.Content;
  815. BEGIN
  816. IF (n IS XML.Element) THEN
  817. elem := n(XML.Element); elemName := elem.GetName();
  818. IF (elemName # NIL) THEN
  819. COPY(elemName^, elemNameLow);
  820. Strings.LowerCase(elemNameLow);
  821. IF ((elemNameLow = "input") OR (elemNameLow = "textarea") OR (elemNameLow = "select")
  822. OR (elemNameLow = "submit")) THEN
  823. paramNameAttr := elem.GetAttribute("name"); (* attribute name 'name' must be lowercase *)
  824. IF (paramNameAttr # NIL) THEN
  825. paramName := paramNameAttr.GetValue();
  826. HTTPSupport.HTTPEncode(paramName^, encStr);
  827. Strings.Concat(DynamicWebpage.HTTPVarCommandParamPrefix, encStr, newParamName);
  828. paramNameAttr.SetValue(newParamName)
  829. END
  830. END
  831. END
  832. END;
  833. IF (n IS XML.Container) THEN
  834. container := n(XML.Container);
  835. enum := container.GetContents();
  836. WHILE (enum.HasMoreElements()) DO
  837. p := enum.GetNext(); content := p(XML.Content);
  838. RenameInputAttr(content)
  839. END
  840. END
  841. END RenameInputAttr;
  842. END Formular;
  843. (** persistent data container support *)
  844. (** abstract web displayable persistent object *)
  845. PersistentDataObject *= OBJECT (PrevalenceSystem.PersistentObject)
  846. (** use oid instance field to identify persistent object *)
  847. PROCEDURE ToXML*(request: HTTPSupport.HTTPRequest) : XML.Content; (** the object specfifies its web representation *)
  848. BEGIN RETURN Externalize() (** use default xml serialization of the prevalence system *)
  849. END ToXML;
  850. END PersistentDataObject;
  851. PersistentDataObjectList* = POINTER TO ARRAY OF PersistentDataObject;
  852. (** has to return true iff obj is selected *)
  853. PersistentDataFilter* = PROCEDURE {DELEGATE} (obj: PersistentDataObject) : BOOLEAN;
  854. (** has to return true iff obj1 < obj2 in the order *)
  855. PersistentDataCompare* = PROCEDURE {DELEGATE} (obj1, obj2: PersistentDataObject): BOOLEAN;
  856. (** persistent data container *)
  857. PersistentDataContainer*= OBJECT (PersistentDataObject)
  858. VAR
  859. name: Strings.String;
  860. dataObjList: TFClasses.List; (* List of PersistentDataObject *)
  861. PROCEDURE &Create*;
  862. BEGIN
  863. Init; (* call superconstructor *)
  864. NEW(dataObjList);
  865. END Create;
  866. PROCEDURE GetName*() : Strings.String;
  867. BEGIN RETURN name
  868. END GetName;
  869. PROCEDURE SetName*(n: ARRAY OF CHAR); (** the name must be unique for all instances of PersistentDataContainer *)
  870. VAR oldName: Strings.String; resultList: PrevalenceSystem.PersistentObjectList;
  871. BEGIN
  872. ASSERT(LEN(n) > 0, 9999);
  873. BeginModification;
  874. oldName := name;
  875. NEW(name, LEN(n));
  876. COPY(n, name^);
  877. IF (registeredAt # NIL) THEN
  878. (* check name uniqueness contraint *)
  879. resultList := registeredAt.FindPersistentObjects(FilterContainerByName);
  880. IF (resultList # NIL) THEN
  881. KernelLog.String("WebStd.PersistentDataContainer: name '"); KernelLog.String(name^);
  882. KernelLog.String("' must be unique for all instances of PersistentDataContainer."); KernelLog.Ln;
  883. name := oldName; (* rollback *)
  884. EndModification;
  885. HALT(9999)
  886. END;
  887. END;
  888. EndModification
  889. END SetName;
  890. (** returns NIL iff not present in this container *)
  891. PROCEDURE GetObjectByOid*(objectId: LONGINT) : PersistentDataObject;
  892. VAR i: LONGINT; p: ANY; obj: PersistentDataObject;
  893. BEGIN
  894. dataObjList.Lock;
  895. FOR i := 0 TO dataObjList.GetCount()-1 DO
  896. p := dataObjList.GetItem(i); obj := p(PersistentDataObject); (* obj # NIL & obj.oid # 0 since it was registered in prevalence system*)
  897. IF (obj.oid = objectId) THEN
  898. dataObjList.Unlock;
  899. RETURN obj
  900. END
  901. END;
  902. dataObjList.Unlock;
  903. RETURN NIL
  904. END GetObjectByOid;
  905. PROCEDURE GetCount*() : LONGINT;
  906. BEGIN RETURN dataObjList.GetCount()
  907. END GetCount;
  908. PROCEDURE GetItem*(i: LONGINT) : PersistentDataObject;
  909. VAR p: ANY; obj: PersistentDataObject;
  910. BEGIN
  911. IF ((i >= 0) & (i < dataObjList.GetCount())) THEN
  912. p := dataObjList.GetItem(i); obj := p(PersistentDataObject);
  913. RETURN obj
  914. ELSE
  915. RETURN NIL
  916. END
  917. END GetItem;
  918. (** returns a list of filtered persistent data objects entries, if filter = NIL THEN no filter is applied. persComp defines the
  919. * ordering of the list and can be NIL *)
  920. PROCEDURE GetElementList*(filter: PersistentDataFilter; persComp: PersistentDataCompare) : PersistentDataObjectList;
  921. VAR i: LONGINT; filteredList: TFClasses.List; persList: PersistentDataObjectList; p: ANY; obj: PersistentDataObject;
  922. genArray: GenericSort.GenericArray; persSorter: PersistentDataSorter;
  923. BEGIN
  924. NEW (filteredList);
  925. IF (filter = NIL) THEN filter := DefaultPersistentDataFilter END;
  926. dataObjList.Lock;
  927. FOR i := 0 TO dataObjList.GetCount()-1 DO
  928. p := dataObjList.GetItem(i); obj := p(PersistentDataObject); (* obj # NIL & obj.oid # 0 since it was registered in prevalence system*)
  929. IF (filter(obj)) THEN
  930. filteredList.Add(obj)
  931. END
  932. END;
  933. dataObjList.Unlock;
  934. IF (filteredList.GetCount() > 0) THEN
  935. NEW(genArray, filteredList.GetCount());
  936. FOR i := 0 TO filteredList.GetCount()-1 DO
  937. genArray[i] := filteredList.GetItem(i)
  938. END;
  939. IF (persComp # NIL) THEN
  940. NEW(persSorter, persComp);
  941. GenericSort.QuickSort(genArray, persSorter.GenericCompare)
  942. END;
  943. NEW(persList, LEN(genArray));
  944. FOR i := 0 TO LEN(genArray)-1 DO
  945. persList[i] := genArray[i](PersistentDataObject)
  946. END;
  947. RETURN persList
  948. ELSE
  949. RETURN NIL
  950. END
  951. END GetElementList;
  952. PROCEDURE AddPersistentDataObject*(obj: PersistentDataObject; desc: PrevalenceSystem.PersistentObjectDescriptor);
  953. BEGIN
  954. IF (obj # NIL) THEN
  955. IF (~Contains(obj)) THEN
  956. BeginModification;
  957. dataObjList.Add(obj);
  958. IF (registeredAt # NIL) THEN
  959. registeredAt.AddPersistentObject(obj, desc);
  960. END;
  961. EndModification
  962. (* make sure that the object is registered in the prevalence system *)
  963. (* the object must be added to the prevalence system after there is a reference from a persistent object to it
  964. * otherwise it could be already collected from the garbage collection mechanism of the prevalence system *)
  965. END;
  966. END
  967. END AddPersistentDataObject;
  968. PROCEDURE Contains*(obj: PersistentDataObject) : BOOLEAN;
  969. VAR p: ANY; i: LONGINT;
  970. BEGIN
  971. dataObjList.Lock;
  972. FOR i := 0 TO dataObjList.GetCount()-1 DO
  973. p := dataObjList.GetItem(i);
  974. IF (p = obj) THEN
  975. dataObjList.Unlock;
  976. RETURN TRUE
  977. END
  978. END;
  979. dataObjList.Unlock;
  980. RETURN FALSE
  981. END Contains;
  982. PROCEDURE RemovePersistentDataObject*(obj: PersistentDataObject);
  983. BEGIN
  984. IF (obj # NIL) THEN
  985. BeginModification;
  986. dataObjList.Remove(obj);
  987. (* the object will automatically and safely removed by the garbage collector of the prevalence system *)
  988. EndModification
  989. END
  990. END RemovePersistentDataObject;
  991. PROCEDURE FilterContainerByName(obj: PrevalenceSystem.PersistentObject) : BOOLEAN;
  992. VAR c: PersistentDataContainer; n: Strings.String;
  993. BEGIN
  994. IF ((obj IS PersistentDataContainer) & (obj # SELF)) THEN
  995. c := obj(PersistentDataContainer); n := c.GetName();
  996. IF ((n # NIL) & (n^ = name^)) THEN
  997. RETURN TRUE
  998. END
  999. END;
  1000. RETURN FALSE
  1001. END FilterContainerByName;
  1002. PROCEDURE Externalize*() : XML.Content;
  1003. VAR elem: XML.Element; i: LONGINT; p: ANY; obj: PersistentDataObject; container: XML.Container;
  1004. oidString: ARRAY 14 OF CHAR;
  1005. BEGIN
  1006. NEW(container);
  1007. IF (name # NIL) THEN
  1008. NEW(elem); elem.SetName("name");
  1009. AppendXMLContent(elem, CreateXMLText(name^));
  1010. container.AddContent(elem)
  1011. END;
  1012. dataObjList.Lock;
  1013. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1014. p := dataObjList.GetItem(i); obj := p(PersistentDataObject); (* obj # NIL & obj.oid # 0 since it was registered in prevalence system*)
  1015. Strings.IntToStr(obj.oid, oidString);
  1016. NEW(elem); elem.SetName("elem"); elem.SetAttributeValue("ref", oidString);
  1017. container.AddContent(elem)
  1018. END;
  1019. dataObjList.Unlock;
  1020. RETURN container
  1021. END Externalize;
  1022. PROCEDURE Internalize*(xml: XML.Content);
  1023. VAR container: XML.Container; elem: XML.Element; enumContainer: XMLObjects.Enumerator; p: ANY;
  1024. BEGIN
  1025. dataObjList.Clear; (* ! *)
  1026. IF (xml # NIL) THEN
  1027. IF (xml IS XML.Element) THEN
  1028. elem := xml(XML.Element);
  1029. InternalizeElem(elem)
  1030. ELSE
  1031. container := xml(XML.Container);
  1032. enumContainer := container.GetContents();
  1033. WHILE(enumContainer.HasMoreElements()) DO
  1034. p := enumContainer.GetNext();
  1035. IF (p IS XML.Element) THEN
  1036. elem := p(XML.Element);
  1037. InternalizeElem(elem)
  1038. END
  1039. END
  1040. END
  1041. END
  1042. END Internalize;
  1043. PROCEDURE InternalizeElem(elem: XML.Element);
  1044. VAR elemLabel, refStr: Strings.String; ref: LONGINT; persObj: PrevalenceSystem.PersistentObject;
  1045. BEGIN
  1046. elemLabel := elem.GetName();
  1047. IF (elemLabel^ = "name") THEN
  1048. name := GetXMLCharContent(elem)
  1049. ELSIF (elemLabel^ = "elem") THEN
  1050. refStr := elem.GetAttributeValue("ref");
  1051. IF (refStr # NIL) THEN
  1052. Strings.StrToInt(refStr^, ref);
  1053. IF (registeredAt # NIL) THEN
  1054. persObj := registeredAt.GetPersistentObject(ref);
  1055. (* this is possible because of the recovery algorithm of the prevalence system *)
  1056. IF ((persObj # NIL) & (persObj IS PersistentDataObject)) THEN
  1057. dataObjList.Add(persObj)
  1058. ELSE
  1059. HALT(9999)
  1060. END
  1061. ELSE
  1062. HALT(9999) (* object must be registered in at least one prevalence system *)
  1063. END
  1064. END
  1065. END
  1066. END InternalizeElem;
  1067. PROCEDURE GetReferrencedObjects*() : PrevalenceSystem.PersistentObjectList;
  1068. VAR list: PrevalenceSystem.PersistentObjectList; i: LONGINT; pers: PrevalenceSystem.PersistentObject; p: ANY;
  1069. BEGIN
  1070. IF (dataObjList.GetCount() > 0) THEN
  1071. NEW(list, dataObjList.GetCount());
  1072. dataObjList.Lock;
  1073. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1074. p := dataObjList.GetItem(i); pers := p(PrevalenceSystem.PersistentObject);
  1075. list[i] := pers
  1076. END;
  1077. dataObjList.Unlock;
  1078. RETURN list
  1079. ELSE
  1080. RETURN NIL
  1081. END
  1082. END GetReferrencedObjects;
  1083. PROCEDURE ToXML*(request: HTTPSupport.HTTPRequest) : XML.Content;
  1084. VAR elem: XML.Element; i: LONGINT; p: ANY; obj: PersistentDataObject; container: XML.Container;
  1085. nameText: XML.ArrayChars; oidString, posString: ARRAY 14 OF CHAR; objSer: XML.Content;
  1086. persList: PersistentDataObjectList;
  1087. BEGIN
  1088. NEW(container);
  1089. IF (name # NIL) THEN
  1090. NEW(elem); elem.SetName("name");
  1091. NEW(nameText); nameText.SetStr(name^);
  1092. elem.AddContent(nameText);
  1093. container.AddContent(elem)
  1094. END;
  1095. dataObjList.Lock;
  1096. persList := GetElementList(DefaultPersistentDataFilter, NIL);
  1097. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1098. p := dataObjList.GetItem(i); obj := p(PersistentDataObject); (* obj # NIL & obj.oid # 0 since it was registered in prevalence system*)
  1099. Strings.IntToStr(obj.oid, oidString);
  1100. Strings.IntToStr(i, posString);
  1101. NEW(elem); elem.SetName("Elem");
  1102. elem.SetAttributeValue("pos", posString);
  1103. elem.SetAttributeValue("ref", oidString);
  1104. (* here would be an exception handler fine *)
  1105. objSer := obj.ToXML(request);
  1106. AppendXMLContent(elem, objSer);
  1107. container.AddContent(elem)
  1108. END;
  1109. dataObjList.Unlock;
  1110. RETURN container
  1111. END ToXML;
  1112. END PersistentDataContainer;
  1113. (* helper object to wrap the generic compare function *)
  1114. PersistentDataSorter = OBJECT
  1115. VAR
  1116. comp: PersistentDataCompare;
  1117. PROCEDURE &Init*(persComp: PersistentDataCompare);
  1118. BEGIN (* persComp # NIL *)
  1119. comp := persComp
  1120. END Init;
  1121. PROCEDURE GenericCompare(obj1, obj2: ANY): BOOLEAN;
  1122. VAR persO1, persO2: PersistentDataObject;
  1123. BEGIN
  1124. persO1 := obj1(PersistentDataObject); persO2 := obj2(PersistentDataObject);
  1125. RETURN comp(persO1, persO2)
  1126. END GenericCompare;
  1127. END PersistentDataSorter;
  1128. (** a stateless data container active element which represents the access to a PersistentDataContainer
  1129. * of the prevalence system optionally specified. if 'prevalencesystem' is not present then the
  1130. * standardPrevalenceSystem will be used. The container name has to be globally unique in the corresponding
  1131. * prevalence system to allow global access to the persistent data container.
  1132. * usage example:
  1133. * <WebStd:DataContainer name="Persons" prevalencesystem="standardPrevalenceSystem"/> *)
  1134. DataContainer* = OBJECT (DynamicWebpage.StateLessActiveElement)
  1135. PROCEDURE Transform*(input: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  1136. VAR errStr: ARRAY 256 OF CHAR; persCont: PersistentDataContainer; prevSys: PrevalenceSystem.PrevalenceSystem;
  1137. containerName, prevSysName: Strings.String;
  1138. BEGIN
  1139. containerName := input.GetAttributeValue("name");
  1140. prevSysName := input.GetAttributeValue("prevalencesystem");
  1141. IF (prevSys # NIL) THEN
  1142. prevSys := PrevalenceSystem.GetPrevalenceSystem(prevSysName^)
  1143. ELSE
  1144. prevSys := PrevalenceSystem.standardPrevalenceSystem;
  1145. END;
  1146. IF ((containerName # NIL) & (prevSys # NIL)) THEN
  1147. persCont := GetPersistentDataContainer(prevSys, containerName^);
  1148. IF (persCont # NIL) THEN
  1149. RETURN persCont.ToXML(request)
  1150. ELSE
  1151. COPY("WebStd:DataContainer with name '", errStr); Strings.Append(errStr, containerName^);
  1152. Strings.Append(errStr, "' is not present in the prevalence system.");
  1153. RETURN CreateXMLText(errStr)
  1154. END
  1155. ELSIF (containerName = NIL) THEN
  1156. RETURN CreateXMLText("Missing attribute name for WebStd:DataContainer")
  1157. ELSE
  1158. RETURN CreateXMLText("Specified prevalence system is not present")
  1159. END
  1160. END Transform;
  1161. END DataContainer;
  1162. (** session container support *)
  1163. (** abstract web displayable object with session bounded lifetime *)
  1164. SessionDataObject* = OBJECT
  1165. VAR oid*: LONGINT; (** unique object id *)
  1166. PROCEDURE &Init*;
  1167. BEGIN
  1168. oid := GetNewOid()
  1169. END Init;
  1170. PROCEDURE ToXML*(request: HTTPSupport.HTTPRequest) : XML.Content;
  1171. BEGIN HALT(309)
  1172. END ToXML;
  1173. END SessionDataObject;
  1174. SessionDataObjectList* = POINTER TO ARRAY OF SessionDataObject;
  1175. (** has to return true iff obj is selected *)
  1176. SessionDataFilter* = PROCEDURE {DELEGATE} (obj: SessionDataObject) : BOOLEAN;
  1177. (** has to return true iff obj1 < obj2 in the order *)
  1178. SessionDataCompare* = PROCEDURE {DELEGATE} (obj1, obj2: SessionDataObject): BOOLEAN;
  1179. (** session data container *)
  1180. SessionDataContainer* = OBJECT (SessionDataObject)
  1181. VAR
  1182. name: Strings.String;
  1183. dataObjList: TFClasses.List; (* List of SessionDataObject *)
  1184. PROCEDURE &Create*(containerName: ARRAY OF CHAR);
  1185. BEGIN
  1186. NEW(dataObjList);
  1187. NEW(name, LEN(containerName)); COPY(containerName, name^)
  1188. END Create;
  1189. PROCEDURE GetName*() : Strings.String;
  1190. BEGIN RETURN name
  1191. END GetName;
  1192. (** returns NIL iff not present in this container *)
  1193. PROCEDURE GetObjectByOid*(objectId: LONGINT) : SessionDataObject;
  1194. VAR i: LONGINT; p: ANY; obj: SessionDataObject;
  1195. BEGIN
  1196. dataObjList.Lock;
  1197. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1198. p := dataObjList.GetItem(i); obj := p(SessionDataObject);
  1199. IF (obj.oid = objectId) THEN
  1200. dataObjList.Unlock;
  1201. RETURN obj
  1202. END
  1203. END;
  1204. dataObjList.Unlock;
  1205. RETURN NIL
  1206. END GetObjectByOid;
  1207. PROCEDURE GetCount*() : LONGINT;
  1208. BEGIN RETURN dataObjList.GetCount()
  1209. END GetCount;
  1210. PROCEDURE GetItem*(i: LONGINT) : SessionDataObject;
  1211. VAR p: ANY; obj: SessionDataObject;
  1212. BEGIN
  1213. IF ((i >= 0) & (i < dataObjList.GetCount())) THEN
  1214. p := dataObjList.GetItem(i); obj := p(SessionDataObject);
  1215. RETURN obj
  1216. ELSE
  1217. RETURN NIL
  1218. END
  1219. END GetItem;
  1220. (** returns a list of filtered session data objects entries, if filter = NIL THEN no filter is applied. sessComp defines the
  1221. ordering of the list and can be NIL *)
  1222. PROCEDURE GetElementList*(filter: SessionDataFilter; sessComp: SessionDataCompare) : SessionDataObjectList;
  1223. VAR i: LONGINT; filteredList: TFClasses.List; sessList: SessionDataObjectList; p: ANY; obj: SessionDataObject;
  1224. genArray: GenericSort.GenericArray; sessSorter: SessionDataSorter;
  1225. BEGIN
  1226. NEW (filteredList);
  1227. IF (filter = NIL) THEN filter := DefaultSessionDataFilter END;
  1228. dataObjList.Lock;
  1229. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1230. p := dataObjList.GetItem(i); obj := p(SessionDataObject); (* obj # NIL & obj.oid # 0 since it was registered in prevalence system*)
  1231. IF (filter(obj)) THEN
  1232. filteredList.Add(obj)
  1233. END
  1234. END;
  1235. dataObjList.Unlock;
  1236. IF (filteredList.GetCount() > 0) THEN
  1237. NEW(genArray, filteredList.GetCount());
  1238. FOR i := 0 TO filteredList.GetCount()-1 DO
  1239. genArray[i] := filteredList.GetItem(i)
  1240. END;
  1241. IF (sessComp # NIL) THEN
  1242. NEW(sessSorter, sessComp);
  1243. GenericSort.QuickSort(genArray, sessSorter.GenericCompare)
  1244. END;
  1245. NEW(sessList, LEN(genArray));
  1246. FOR i := 0 TO LEN(genArray)-1 DO
  1247. sessList[i] := genArray[i](SessionDataObject)
  1248. END;
  1249. RETURN sessList
  1250. ELSE
  1251. RETURN NIL
  1252. END
  1253. END GetElementList;
  1254. PROCEDURE AddSessionDataObject*(obj: SessionDataObject);
  1255. BEGIN
  1256. IF (obj # NIL) THEN
  1257. IF (obj.oid = 0) THEN obj.oid := GetNewOid() END; (* set unique oid if not initialized *)
  1258. dataObjList.Add(obj)
  1259. END
  1260. END AddSessionDataObject;
  1261. PROCEDURE Contains*(obj: SessionDataObject) : BOOLEAN;
  1262. VAR p: ANY; i: LONGINT;
  1263. BEGIN
  1264. dataObjList.Lock;
  1265. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1266. p := dataObjList.GetItem(i);
  1267. IF (p = obj) THEN
  1268. dataObjList.Unlock;
  1269. RETURN TRUE
  1270. END
  1271. END;
  1272. dataObjList.Unlock;
  1273. RETURN FALSE
  1274. END Contains;
  1275. PROCEDURE RemoveSessionDataObject*(obj: SessionDataObject);
  1276. BEGIN
  1277. IF (obj # NIL) THEN
  1278. dataObjList.Remove(obj)
  1279. END
  1280. END RemoveSessionDataObject;
  1281. PROCEDURE ToXML*(request: HTTPSupport.HTTPRequest) : XML.Content;
  1282. VAR elem: XML.Element; i: LONGINT; p: ANY; obj: SessionDataObject; container: XML.Container;
  1283. nameText: XML.ArrayChars; objSer: XML.Content; posString, oidString: ARRAY 14 OF CHAR;
  1284. BEGIN
  1285. NEW(container);
  1286. IF (name # NIL) THEN
  1287. NEW(elem); elem.SetName("name");
  1288. NEW(nameText); nameText.SetStr(name^);
  1289. elem.AddContent(nameText);
  1290. container.AddContent(elem)
  1291. END;
  1292. dataObjList.Lock;
  1293. FOR i := 0 TO dataObjList.GetCount()-1 DO
  1294. p := dataObjList.GetItem(i); obj := p(SessionDataObject); (* obj # NIL *)
  1295. Strings.IntToStr(obj.oid, oidString);
  1296. Strings.IntToStr(i, posString);
  1297. (* here would be an exception handler fine *)
  1298. objSer := obj.ToXML(request);
  1299. NEW(elem); elem.SetName("Elem");
  1300. elem.SetAttributeValue("pos", posString);
  1301. elem.SetAttributeValue("ref", oidString);
  1302. AppendXMLContent(elem, objSer);
  1303. container.AddContent(elem)
  1304. END;
  1305. dataObjList.Unlock;
  1306. RETURN container
  1307. END ToXML;
  1308. END SessionDataContainer;
  1309. (* helper object to wrap the generic compare function *)
  1310. SessionDataSorter = OBJECT
  1311. VAR
  1312. comp: SessionDataCompare;
  1313. PROCEDURE &Init*(sessComp: SessionDataCompare);
  1314. BEGIN (* sessComp # NIL *)
  1315. comp := sessComp
  1316. END Init;
  1317. PROCEDURE GenericCompare(obj1, obj2: ANY): BOOLEAN;
  1318. VAR sessO1, sessO2: SessionDataObject;
  1319. BEGIN
  1320. sessO1 := obj1(SessionDataObject); sessO2 := obj2(SessionDataObject);
  1321. RETURN comp(sessO1, sessO2)
  1322. END GenericCompare;
  1323. END SessionDataSorter;
  1324. (** a session container active element which represents the access to a SessionDataContainer
  1325. * the name has to globally unique for a session to allow global access to the session data container for the session
  1326. * usage example:
  1327. * <WebStd:SessionContainer name="Persons"/> *)
  1328. SessionContainer* = OBJECT (DynamicWebpage.StateLessActiveElement)
  1329. (* the container is stored in the session object, hence the SessionContainer can be stateless *)
  1330. PROCEDURE Transform*(input: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  1331. VAR errStr: ARRAY 128 OF CHAR; sessionCont: SessionDataContainer; containerName: Strings.String;
  1332. session: HTTPSession.Session;
  1333. BEGIN
  1334. containerName := input.GetAttributeValue("name");
  1335. IF (containerName # NIL) THEN
  1336. session := HTTPSession.GetSession(request);
  1337. sessionCont := GetSessionDataContainer(session, containerName^);
  1338. IF (sessionCont # NIL) THEN
  1339. RETURN sessionCont.ToXML(request)
  1340. ELSE
  1341. COPY("WebStd:SessionContainer: The session variable with name '", errStr);
  1342. Strings.Append(errStr, containerName^);
  1343. Strings.Append(errStr, "' is already used by another non session container object .");
  1344. RETURN CreateXMLText(errStr)
  1345. END
  1346. ELSE
  1347. RETURN CreateXMLText("Missing attribute name for WebStd:DataContainer")
  1348. END
  1349. END Transform;
  1350. END SessionContainer;
  1351. (** simple datagrid statefull active element with paging, usage example:
  1352. * <WebStd:Datagrid id="mygrid3">
  1353. * <Header>...</Header>
  1354. * <Data>
  1355. * <WebStd:SessionContainer name="persons"/>
  1356. * or
  1357. * <WebStd:DataContainer name="employees"/>
  1358. * or
  1359. * <Elem ..> ... </Elem>
  1360. * <Elem ..> ... </Elem>
  1361. * ...
  1362. * </Data>
  1363. * <Footer>..</Footer>
  1364. * <Paging size="10" nextlabel="more.." previouslabel="..back"/>
  1365. * </WebStd:Datagrid>
  1366. * will transform into:
  1367. * <table>
  1368. * <tr> header-content </tr>
  1369. * <tr> 1.st data element </tr>
  1370. * <tr> 2.nd data element </tr>
  1371. * ...
  1372. * <tr> 10.th data element </tr>
  1373. * <tr><td colspan=""><WebStd:EventButton label="back..." ../><WebStd:EventButton label="more.."/></td></tr>
  1374. * <tr> footer content </tr>
  1375. * </table>
  1376. *)
  1377. Datagrid* = OBJECT (DynamicWebpage.StateFullActiveElement)
  1378. VAR
  1379. pos: LONGINT; (* statefull instance variable: start position for paging *)
  1380. PROCEDURE &Init*;
  1381. BEGIN
  1382. pos := 0
  1383. END Init;
  1384. PROCEDURE Transform*(input: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  1385. VAR table, tr, td, tdHeader, data, header, footer, elem, paging, subElem, eventButton, eventParam: XML.Element; p, pElem: ANY;
  1386. content: XML.Content; gridEnum, elemEnum, enum: XMLObjects.Enumerator; elemName, pagingSizeStr,
  1387. subElemName, labelName, objectId: Strings.String; columns, pagingSize, counter, k: LONGINT;
  1388. colString, posString: ARRAY 14 OF CHAR;
  1389. BEGIN
  1390. objectId := input.GetAttributeValue(DynamicWebpage.XMLAttributeObjectIdName);
  1391. (* objectId # NIL by DynamicWebpagePlugin logic*)
  1392. gridEnum := input.GetContents();
  1393. WHILE (gridEnum.HasMoreElements()) DO (* faster than 4 invocations of GetXMLSubElement(input) *)
  1394. p := gridEnum.GetNext();
  1395. IF (p IS XML.Element) THEN
  1396. subElem := p(XML.Element); elemName := subElem.GetName();
  1397. IF ((subElem # NIL) & (elemName^ = "Header")) THEN
  1398. header := subElem
  1399. ELSIF ((subElem # NIL) & (elemName^ = "Data")) THEN
  1400. data := subElem
  1401. ELSIF ((subElem # NIL) & (elemName^ = "Footer")) THEN
  1402. footer := subElem
  1403. ELSIF ((subElem # NIL) & (elemName^ = "Paging")) THEN
  1404. paging := subElem
  1405. END
  1406. END
  1407. END;
  1408. NEW(table); table.SetName("table");
  1409. IF (header # NIL) THEN
  1410. NEW(tr); tr.SetName("tr");
  1411. NEW(tdHeader); tdHeader.SetName("td"); (* set "colspan" attribute later if the #columns is known *)
  1412. enum := header.GetContents();
  1413. WHILE (enum.HasMoreElements()) DO
  1414. p := enum.GetNext(); content := p(XML.Content);
  1415. tdHeader.AddContent(content)
  1416. END;
  1417. tr.AddContent(tdHeader);
  1418. table.AddContent(tr)
  1419. END;
  1420. IF (paging # NIL) THEN
  1421. pagingSizeStr := paging.GetAttributeValue("size");
  1422. IF (pagingSizeStr # NIL) THEN
  1423. Strings.StrToInt(pagingSizeStr^, pagingSize)
  1424. ELSE
  1425. pagingSize := MAX(LONGINT)
  1426. END
  1427. END;
  1428. columns := 1;
  1429. IF (data # NIL) THEN
  1430. counter := 0;
  1431. elemEnum := data.GetContents();
  1432. WHILE ((elemEnum.HasMoreElements()) & (counter < pos + pagingSize)) DO
  1433. pElem := elemEnum.GetNext();
  1434. IF (pElem IS XML.Element) THEN
  1435. elem := pElem(XML.Element); elemName := elem.GetName();
  1436. IF ((elemName # NIL) & (elemName^ = "Elem")) THEN
  1437. IF (counter >= pos) THEN
  1438. NEW(tr); tr.SetName("tr");
  1439. enum := elem.GetContents();
  1440. k := 0; (* # columns *)
  1441. WHILE (enum.HasMoreElements()) DO
  1442. p := enum.GetNext(); content := p(XML.Content);
  1443. (* count columns *)
  1444. IF (content IS XML.Element) THEN
  1445. subElem := content(XML.Element); subElemName := subElem.GetName();
  1446. IF ((subElemName # NIL) & (subElemName^ = "td")) THEN (* 'td' must be lowercase *)
  1447. INC(k)
  1448. END
  1449. END;
  1450. tr.AddContent(content)
  1451. END;
  1452. table.AddContent(tr);
  1453. IF (k > columns) THEN columns := k END
  1454. END;
  1455. enum := elem.GetContents();
  1456. IF (enum.HasMoreElements()) THEN INC(counter) END
  1457. END
  1458. END
  1459. END;
  1460. IF ((paging # NIL) & ((pos > 0) OR (elemEnum.HasMoreElements()))) THEN (* previous or next button needed *)
  1461. NEW(tr); tr.SetName("tr");
  1462. Strings.IntToStr(columns-1, colString);
  1463. NEW(td); td.SetName("td");
  1464. tr.AddContent(td);
  1465. IF (pos > 0) THEN (* previous button *)
  1466. labelName := paging.GetAttributeValue("previouslabel");
  1467. Strings.IntToStr(pos-pagingSize, posString);
  1468. NEW(eventButton); eventButton.SetName("WebStd:EventButton");
  1469. eventButton.SetAttributeValue("xmlns:WebStd", "WebStd");
  1470. IF (labelName # NIL) THEN
  1471. eventButton.SetAttributeValue("label", labelName^)
  1472. ELSE
  1473. eventButton.SetAttributeValue("label", "back")
  1474. END;
  1475. eventButton.SetAttributeValue("method", "SetPos");
  1476. eventButton.SetAttributeValue("object", "Datagrid");
  1477. eventButton.SetAttributeValue("module", "WebStd");
  1478. eventButton.SetAttributeValue("objectid", objectId^);
  1479. NEW(eventParam); eventParam.SetName("Param");
  1480. eventParam.SetAttributeValue("name", "pos");
  1481. eventParam.SetAttributeValue("value", posString);
  1482. eventButton.AddContent(eventParam);
  1483. td.AddContent(eventButton)
  1484. ELSE
  1485. AppendXMLContent(td, CreateXMLText(" "));
  1486. END;
  1487. NEW(td); td.SetName("td"); td.SetAttributeValue("colspan", colString);
  1488. tr.AddContent(td);
  1489. IF (elemEnum.HasMoreElements()) THEN (* next button *)
  1490. labelName := paging.GetAttributeValue("nextlabel");
  1491. Strings.IntToStr(pos+pagingSize, posString);
  1492. NEW(eventButton); eventButton.SetName("WebStd:EventButton");
  1493. eventButton.SetAttributeValue("xmlns:WebStd", "WebStd");
  1494. IF (labelName # NIL) THEN
  1495. eventButton.SetAttributeValue("label", labelName^)
  1496. ELSE
  1497. eventButton.SetAttributeValue("label", "back")
  1498. END;
  1499. eventButton.SetAttributeValue("method", "SetPos");
  1500. eventButton.SetAttributeValue("object", "Datagrid");
  1501. eventButton.SetAttributeValue("module", "WebStd");
  1502. eventButton.SetAttributeValue("objectid", objectId^);
  1503. NEW(eventParam); eventParam.SetName("Param");
  1504. eventParam.SetAttributeValue("name", "pos");
  1505. eventParam.SetAttributeValue("value", posString);
  1506. eventButton.AddContent(eventParam);
  1507. td.AddContent(eventButton)
  1508. ELSE
  1509. AppendXMLContent(td, CreateXMLText(" "));
  1510. END;
  1511. table.AddContent(tr)
  1512. END
  1513. END;
  1514. Strings.IntToStr(columns, colString);
  1515. IF (header # NIL) THEN (* set colspan for the header row *)
  1516. tdHeader.SetAttributeValue("colspan", colString)
  1517. END;
  1518. IF (footer # NIL) THEN
  1519. NEW(tr); tr.SetName("tr");
  1520. NEW(td); td.SetName("td"); td.SetAttributeValue("colspan", colString);
  1521. enum := footer.GetContents();
  1522. WHILE (enum.HasMoreElements()) DO
  1523. p := enum.GetNext(); content := p(XML.Content);
  1524. td.AddContent(content)
  1525. END;
  1526. tr.AddContent(td);
  1527. table.AddContent(tr)
  1528. END;
  1529. RETURN table
  1530. END Transform;
  1531. PROCEDURE SetPos(request: HTTPSupport.HTTPRequest; params: DynamicWebpage.ParameterList);
  1532. (* parameters: "pos" *)
  1533. VAR posString: Strings.String;
  1534. BEGIN
  1535. posString := params.GetParameterValueByName("pos");
  1536. IF (posString # NIL) THEN
  1537. Strings.StrToInt(posString^, pos)
  1538. ELSE
  1539. KernelLog.String("WebStd:Datagrid - event handler 'SetPos' has parameter 'pos'.");
  1540. KernelLog.Ln
  1541. END
  1542. END SetPos;
  1543. PROCEDURE GetEventHandlers*() : DynamicWebpage.EventHandlerList;
  1544. VAR list: DynamicWebpage.EventHandlerList;
  1545. BEGIN
  1546. NEW(list, 1);
  1547. NEW(list[0], "SetPos", SetPos);
  1548. RETURN list
  1549. END GetEventHandlers;
  1550. END Datagrid;
  1551. (** statefull active element to allow toggling between two states. The state ('Show' or 'Hide') specified by 'startWith' is
  1552. * the initial state. The default initial state is 'Show' if 'startWith' is not specified. Usage example
  1553. * <WebStd:ToggleBlock id="MyToggleBlock3" startWith="Show" showLabel="show" hideLabel="hide">
  1554. * <Show>...</Show>
  1555. * <Hide>...</Hide>
  1556. * <WebStd:ToogleBlock>
  1557. *)
  1558. ToggleBlock* = OBJECT(DynamicWebpage.StateFullActiveElement)
  1559. VAR
  1560. isShowing: BOOLEAN; (* true iff in show state *)
  1561. firstAccess: BOOLEAN; (* is true if the active element will be the first time transformed for its incarnation *)
  1562. PROCEDURE &Init*;
  1563. BEGIN isShowing := TRUE; firstAccess := TRUE
  1564. END Init;
  1565. PROCEDURE PreTransform*(elem: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  1566. VAR pTag, label, eventLink, show, hide: XML.Element; container: XML.Container;
  1567. showLabel, hideLabel, objectId, startWith: Strings.String;
  1568. BEGIN
  1569. IF (firstAccess) THEN
  1570. firstAccess := FALSE;
  1571. startWith := elem.GetAttributeValue("startWith");
  1572. IF (startWith # NIL) THEN
  1573. IF (startWith^ = "Hide") THEN isShowing := FALSE
  1574. ELSIF (startWith^ # "Show") THEN
  1575. RETURN CreateXMLText("WebStd:ToggleBlock - Attribute value for 'startWith' must be either 'Show' or 'Hide'")
  1576. END
  1577. END
  1578. END;
  1579. objectId := elem.GetAttributeValue(DynamicWebpage.XMLAttributeObjectIdName); (* objectId # NIL *)
  1580. showLabel := elem.GetAttributeValue("showLabel");
  1581. hideLabel := elem.GetAttributeValue("hideLabel");
  1582. show := GetXMLSubElement(elem, "Show");
  1583. hide := GetXMLSubElement(elem, "Hide");
  1584. NEW(container);
  1585. NEW(pTag); pTag.SetName("p"); container.AddContent(pTag);
  1586. NEW(eventLink); eventLink.SetName("WebStd:EventLink");
  1587. eventLink.SetAttributeValue("xmlns:WebStd", "WebStd");
  1588. NEW(label); label.SetName("Label");
  1589. eventLink.AddContent(label);
  1590. IF (isShowing) THEN
  1591. IF (hideLabel # NIL) THEN
  1592. AppendXMLContent(label, CreateXMLText(hideLabel^))
  1593. ELSE
  1594. AppendXMLContent(label, CreateXMLText("hide"))
  1595. END;
  1596. eventLink.SetAttributeValue("method", "Hide");
  1597. ELSE
  1598. IF (showLabel # NIL) THEN
  1599. AppendXMLContent(label, CreateXMLText(showLabel^))
  1600. ELSE
  1601. AppendXMLContent(label, CreateXMLText("show"))
  1602. END;
  1603. eventLink.SetAttributeValue("method", "Show");
  1604. END;
  1605. eventLink.SetAttributeValue("object", "ToggleBlock");
  1606. eventLink.SetAttributeValue("module", "WebStd");
  1607. eventLink.SetAttributeValue("objectid", objectId^);
  1608. pTag.AddContent(eventLink);
  1609. IF (isShowing) THEN
  1610. CopyXMLSubContents(show, container)
  1611. ELSE
  1612. CopyXMLSubContents(hide, container)
  1613. END;
  1614. RETURN container
  1615. END PreTransform;
  1616. PROCEDURE Show(request: HTTPSupport.HTTPRequest; params: DynamicWebpage.ParameterList);
  1617. BEGIN isShowing := TRUE
  1618. END Show;
  1619. PROCEDURE Hide(request: HTTPSupport.HTTPRequest; params: DynamicWebpage.ParameterList);
  1620. BEGIN isShowing := FALSE
  1621. END Hide;
  1622. PROCEDURE GetEventHandlers*() : DynamicWebpage.EventHandlerList;
  1623. VAR list: DynamicWebpage.EventHandlerList;
  1624. BEGIN
  1625. NEW(list, 2);
  1626. NEW(list[0], "Show", Show);
  1627. NEW(list[1], "Hide", Hide);
  1628. RETURN list
  1629. END GetEventHandlers;
  1630. END ToggleBlock;
  1631. (* persistent counter to store the visiting information *)
  1632. PersistentCounter = OBJECT(PrevalenceSystem.PersistentObject)
  1633. VAR
  1634. name: Strings.String;
  1635. counter: LONGINT;
  1636. PROCEDURE &Initialize*;
  1637. BEGIN
  1638. Init; name := NIL; counter := 0
  1639. END Initialize;
  1640. PROCEDURE IncreaseCounter;
  1641. BEGIN
  1642. BeginModification;
  1643. INC(counter);
  1644. EndModification
  1645. END IncreaseCounter;
  1646. PROCEDURE Internalize*(xml: XML.Content);
  1647. VAR container: XML.Container;
  1648. BEGIN
  1649. container := xml(XML.Container);
  1650. name := InternalizeString(container, "Name");
  1651. counter := InternalizeInteger(container, "Counter")
  1652. END Internalize;
  1653. PROCEDURE Externalize*() : XML.Content;
  1654. VAR container: XML.Container;
  1655. BEGIN
  1656. NEW(container);
  1657. ExternalizeString(name, container, "Name");
  1658. ExternalizeInteger(counter, container, "Counter");
  1659. RETURN container
  1660. END Externalize;
  1661. END PersistentCounter;
  1662. (** a visitor counter uniquely specified by 'name'. Returns the number of different sessions having visited this counter.
  1663. * Usage example:
  1664. * <WebStd:VisitorCounter name="MyVisits"/> *)
  1665. VisitorCounter* = OBJECT(DynamicWebpage.StateLessActiveElement)
  1666. VAR
  1667. counterName: Strings.String;
  1668. nameLock: BOOLEAN;
  1669. PROCEDURE &Init*;
  1670. BEGIN nameLock := FALSE
  1671. END Init;
  1672. PROCEDURE Transform*(input: XML.Element; request: HTTPSupport.HTTPRequest) : XML.Content;
  1673. VAR name: Strings.String; persCounter: PersistentCounter; numberStr: ARRAY 14 OF CHAR;
  1674. session: HTTPSession.Session; p: ANY; dynVarName, dynVarValue: DynamicStrings.DynamicString;
  1675. varName: Strings.String;
  1676. BEGIN
  1677. name := input.GetAttributeValue("name");
  1678. IF (name # NIL) THEN
  1679. persCounter := GetCounterByName(name^); (* persCounter # NIL *)
  1680. NEW(dynVarName); Concat(dynVarName, SessionVisitorCounterPrefix);
  1681. dynVarName.Append(name^);
  1682. varName := dynVarName.ToArrOfChar(); (* varName # NIL *)
  1683. session := HTTPSession.GetSession(request); (* session # NIL *)
  1684. p := session.GetVariableValue(varName^);
  1685. IF (p = NIL) THEN (* increase counter only once for each session *)
  1686. NEW(dynVarValue); dynVarValue.Append(name^);
  1687. session.AddVariableValue(varName^, dynVarValue);
  1688. persCounter.IncreaseCounter
  1689. END;
  1690. Strings.IntToStr(persCounter.counter, numberStr);
  1691. RETURN CreateXMLText(numberStr)
  1692. ELSE
  1693. RETURN CreateXMLText("WebStd:VisitorCounter - missing attribute 'name'")
  1694. END
  1695. END Transform;
  1696. PROCEDURE LockName;
  1697. BEGIN {EXCLUSIVE}
  1698. AWAIT (~nameLock); nameLock := TRUE
  1699. END LockName;
  1700. PROCEDURE UnlockName;
  1701. BEGIN {EXCLUSIVE}
  1702. nameLock := FALSE
  1703. END UnlockName;
  1704. PROCEDURE FilterPersistentCounter(obj: PrevalenceSystem.PersistentObject) : BOOLEAN;
  1705. VAR persCounter: PersistentCounter;
  1706. BEGIN (* obj # NIL & counterName # NIL *)
  1707. IF (obj IS PersistentCounter) THEN
  1708. persCounter := obj(PersistentCounter);
  1709. RETURN ((persCounter.name # NIL) & (persCounter.name^ = counterName^))
  1710. ELSE
  1711. RETURN FALSE
  1712. END
  1713. END FilterPersistentCounter;
  1714. PROCEDURE GetCounterByName(name: ARRAY OF CHAR) : PersistentCounter;
  1715. VAR list: PrevalenceSystem.PersistentObjectList; persCounter: PersistentCounter;
  1716. BEGIN
  1717. LockName;
  1718. counterName := GetString(name); (* counterName # NIL *)
  1719. list := PrevalenceSystem.FindPersistentObjects(FilterPersistentCounter);
  1720. IF (list = NIL) THEN
  1721. (* create a new persistent counter *)
  1722. NEW(persCounter); persCounter.name := counterName;
  1723. PrevalenceSystem.AddPersistentObjectToRootSet(persCounter, persistentCounterDesc)
  1724. ELSE
  1725. persCounter := list[0](PersistentCounter) (* persCounter # NIL *)
  1726. END;
  1727. UnlockName;
  1728. RETURN persCounter
  1729. END GetCounterByName;
  1730. END VisitorCounter;
  1731. PtrDateTime* = POINTER TO Dates.DateTime;
  1732. VAR
  1733. persistentDataContainerDesc*: PrevalenceSystem.PersistentObjectDescriptor; (** descriptor for PersistentDataContainer *)
  1734. persistentCounterDesc: PrevalenceSystem.PersistentObjectDescriptor; (** descriptor for PersistentCounter *)
  1735. tempContainerName: Strings.String; (* used temporary for the prevalence system filter predicate FilterPersistentDataContainer *)
  1736. qlock: BOOLEAN; (* locking for persistent object querying becuase of tempContainerName *)
  1737. oidCounter: LONGINT; (* counter for unique oid among all SessionDataObject *)
  1738. (** usefull XML-DOM operations *)
  1739. (** returns the first XML subelement with name 'name' as child of 'parent' *)
  1740. PROCEDURE GetXMLSubElement*(parent: XML.Container; name: ARRAY OF CHAR) : XML.Element;
  1741. BEGIN
  1742. RETURN GetXMLSubElementByIndex(parent, name, 0)
  1743. END GetXMLSubElement;
  1744. (** returns the number of XML subelements with name 'name' as child of 'parent' *)
  1745. PROCEDURE NofXMLSubElements*(parent: XML.Container; name: ARRAY OF CHAR) : LONGINT;
  1746. VAR enum: XMLObjects.Enumerator; p: ANY; elem: XML.Element; elemName: Strings.String; counter: LONGINT;
  1747. BEGIN
  1748. counter := 0;
  1749. IF (parent # NIL) THEN
  1750. enum := parent.GetContents();
  1751. WHILE (enum.HasMoreElements()) DO
  1752. p := enum.GetNext();
  1753. IF (p IS XML.Element) THEN
  1754. elem := p(XML.Element); elemName := elem.GetName();
  1755. IF ((elemName # NIL) & (elemName^ = name)) THEN
  1756. INC(counter)
  1757. END
  1758. END
  1759. END
  1760. END;
  1761. RETURN counter
  1762. END NofXMLSubElements;
  1763. (** returns the 'index'.th XML subelement with name 'name' as child of 'parent' *)
  1764. PROCEDURE GetXMLSubElementByIndex*(parent: XML.Container; name: ARRAY OF CHAR; index: LONGINT) : XML.Element;
  1765. VAR enum: XMLObjects.Enumerator; p: ANY; elem: XML.Element; elemName: Strings.String; counter: LONGINT;
  1766. BEGIN
  1767. counter := 0;
  1768. IF (parent # NIL) THEN
  1769. enum := parent.GetContents();
  1770. WHILE (enum.HasMoreElements()) DO
  1771. p := enum.GetNext();
  1772. IF (p IS XML.Element) THEN
  1773. elem := p(XML.Element); elemName := elem.GetName();
  1774. IF ((elemName # NIL) & (elemName^ = name)) THEN
  1775. IF (index = counter) THEN RETURN elem END;
  1776. INC(counter)
  1777. END
  1778. END
  1779. END
  1780. END;
  1781. RETURN NIL
  1782. END GetXMLSubElementByIndex;
  1783. (** return first character content of an XML container *)
  1784. PROCEDURE GetXMLCharContent*(parent: XML.Container) : Strings.String;
  1785. VAR enum: XMLObjects.Enumerator; p: ANY; chars: XML.Chars; ent: XML.EntityRef;
  1786. dynStr: DynamicStrings.DynamicString; text, name: Strings.String;
  1787. decl: XML.EntityDecl; charRef: XML.CharReference; ch: ARRAY 2 OF CHAR;
  1788. BEGIN
  1789. IF (parent # NIL) THEN
  1790. NEW(dynStr);
  1791. enum := parent.GetContents();
  1792. WHILE (enum.HasMoreElements()) DO
  1793. p := enum.GetNext();
  1794. IF (p IS XML.CharReference) THEN
  1795. charRef := p(XML.CharReference);
  1796. ch[0] := CHR(charRef.GetCode()); dynStr.Append(ch)
  1797. ELSIF (p IS XML.Chars) THEN
  1798. chars := p(XML.Chars);
  1799. text := chars.GetStr();
  1800. IF (text # NIL) THEN
  1801. (* ! XML.Element::Write does insert a CRLF at the end of the opening element name *)
  1802. Strings.Trim(text^, DynamicStrings.CR);
  1803. Strings.Trim(text^, DynamicStrings.LF);
  1804. Strings.Trim(text^, DynamicStrings.CR);
  1805. dynStr.Append(text^)
  1806. END
  1807. ELSIF (p IS XML.EntityRef) THEN
  1808. ent := p(XML.EntityRef);
  1809. name := ent.GetName(); decl := ent.GetEntityDecl();
  1810. IF (decl # NIL) THEN
  1811. text := decl.GetValue();
  1812. IF (text # NIL) THEN
  1813. dynStr.Append(text^)
  1814. END
  1815. ELSIF (name # NIL) THEN
  1816. IF (name^ = "lt") THEN
  1817. COPY("<", ch); dynStr.Append(ch)
  1818. ELSIF (name^ = "gt") THEN
  1819. COPY(">", ch); dynStr.Append(ch)
  1820. ELSIF (name^ = "amp") THEN
  1821. COPY("&", ch); dynStr.Append(ch)
  1822. ELSIF (name^ = "apos") THEN
  1823. COPY("'", ch); dynStr.Append(ch)
  1824. ELSIF (name^ = "quot") THEN
  1825. COPY('"', ch); dynStr.Append(ch)
  1826. ELSIF (name^ = "nbsp") THEN
  1827. COPY(" ", ch); dynStr.Append(ch)
  1828. ELSE
  1829. KernelLog.String("GetXMLCharContent: Unknown XML.EntityRef with name '");
  1830. KernelLog.String(name^); KernelLog.String("'"); KernelLog.Ln
  1831. END
  1832. ELSE
  1833. KernelLog.String("GetXMLCharContent: Unknown XML.EntityRef with name NIL"); KernelLog.Ln
  1834. END
  1835. END
  1836. END;
  1837. IF (dynStr.Length() > 0) THEN
  1838. RETURN dynStr.ToArrOfChar()
  1839. END
  1840. END;
  1841. RETURN NIL
  1842. END GetXMLCharContent;
  1843. PROCEDURE SpecialCharacter(c: CHAR) : BOOLEAN;
  1844. BEGIN (* ? < > & " are illegal characters *)
  1845. RETURN (c = "?") OR (c = "<") OR (c = ">") OR (c = "&") OR (c = '"')
  1846. END SpecialCharacter;
  1847. (** create an xml text as XML.ArrayChars and XML.EntityRef *)
  1848. PROCEDURE CreateXMLText*(text: ARRAY OF CHAR) : XML.Container;
  1849. VAR cont: XML.Container; chars: XML.ArrayChars; ent: XML.EntityRef; charRef: XML.CharReference; pos, at: LONGINT;
  1850. dynStr: DynamicStrings.DynamicString; str: Strings.String;ch: ARRAY 6 OF CHAR;
  1851. BEGIN
  1852. NEW(cont);
  1853. pos := 0;
  1854. WHILE (pos < Strings.Length(text)) DO
  1855. NEW(dynStr); at := 0;
  1856. WHILE((pos < Strings.Length(text)) & (~SpecialCharacter(text[pos]))) DO
  1857. dynStr.Put(text[pos], at); INC(pos); INC(at);
  1858. END;
  1859. IF (at > 0) THEN
  1860. str := dynStr.ToArrOfChar();
  1861. NEW(chars); chars.SetStr(str^); cont.AddContent(chars)
  1862. END;
  1863. WHILE ((pos < Strings.Length(text)) & (SpecialCharacter(text[pos]))) DO
  1864. ch[0] := 0X;
  1865. CASE text[pos] OF
  1866. "<": NEW(ent); COPY("lt", ch); ent.SetName(ch); cont.AddContent(ent)
  1867. | ">": NEW(ent); COPY("gt", ch); ent.SetName(ch); cont.AddContent(ent)
  1868. | "&": NEW(ent); COPY("amp", ch); ent.SetName(ch); cont.AddContent(ent)
  1869. | '"': NEW(ent); COPY("quot", ch); ent.SetName(ch); cont.AddContent(ent)
  1870. ELSE NEW(charRef); charRef.SetCode(ORD(text[pos])); cont.AddContent(charRef)
  1871. END;
  1872. INC(pos)
  1873. END
  1874. END;
  1875. RETURN cont
  1876. END CreateXMLText;
  1877. (** create attribute value text with encoded special charcters *)
  1878. PROCEDURE GetEncXMLAttributeText*(text: ARRAY OF CHAR): Strings.String;
  1879. VAR i: LONGINT; dynStr: DynamicStrings.DynamicString; chs: ARRAY 8 OF CHAR;
  1880. str: Strings.String;
  1881. BEGIN
  1882. NEW(dynStr);
  1883. FOR i := 0 TO Strings.Length(text)-1 DO
  1884. CASE text[i] OF
  1885. "<": COPY("&lt;", chs)
  1886. | ">": COPY("&gt;", chs)
  1887. | "&": COPY("&amp;", chs)
  1888. | '"': COPY("&quot;", chs)
  1889. ELSE chs[0] := text[i]; chs[1] := 0X
  1890. END;
  1891. dynStr.Append(chs)
  1892. END;
  1893. str := dynStr.ToArrOfChar();
  1894. RETURN str
  1895. END GetEncXMLAttributeText;
  1896. (** create xml text with <br/> tags for CR *)
  1897. PROCEDURE CreateXMLTextWithBR*(text: ARRAY OF CHAR) : XML.Container;
  1898. VAR cont: XML.Container; chars: XML.ArrayChars; ent: XML.EntityRef; charRef: XML.CharReference; pos, at: LONGINT;
  1899. dynStr: DynamicStrings.DynamicString; str: Strings.String;ch: ARRAY 6 OF CHAR;
  1900. br: XML.Element;
  1901. BEGIN
  1902. NEW(cont);
  1903. pos := 0;
  1904. WHILE (pos < Strings.Length(text)) DO
  1905. NEW(dynStr); at := 0;
  1906. WHILE((pos < Strings.Length(text)) & (~SpecialCharacter(text[pos]) & (text[pos] # CHR(13)))) DO
  1907. IF (text[pos] # CHR(10)) THEN
  1908. dynStr.Put(text[pos], at); INC(at)
  1909. END;
  1910. INC(pos);
  1911. END;
  1912. IF (at > 0) THEN
  1913. str := dynStr.ToArrOfChar();
  1914. NEW(chars); chars.SetStr(str^); cont.AddContent(chars)
  1915. END;
  1916. WHILE ((pos < Strings.Length(text)) & ((SpecialCharacter(text[pos]) OR (text[pos] = CHR(13)))))DO
  1917. ch[0] := 0X;
  1918. CASE text[pos] OF
  1919. CHR(13): NEW(br); br.SetName("br"); cont.AddContent(br)
  1920. | "<": NEW(ent); COPY("lt", ch); ent.SetName(ch); cont.AddContent(ent)
  1921. | ">": NEW(ent); COPY("gt", ch); ent.SetName(ch); cont.AddContent(ent)
  1922. | "&": NEW(ent); COPY("amp", ch); ent.SetName(ch); cont.AddContent(ent)
  1923. | '"': NEW(ent); COPY("quot", ch); ent.SetName(ch); cont.AddContent(ent)
  1924. ELSE NEW(charRef); charRef.SetCode(ORD(text[pos])); cont.AddContent(charRef)
  1925. END;
  1926. INC(pos)
  1927. END
  1928. END;
  1929. RETURN cont
  1930. END CreateXMLTextWithBR;
  1931. (** append the content 'appendix' to 'container' by avoiding nested XML containers *)
  1932. PROCEDURE AppendXMLContent*(container: XML.Container; appendix: XML.Content);
  1933. VAR subCont: XML.Container; enum: XMLObjects.Enumerator; pSub: ANY; content: XML.Content;
  1934. BEGIN
  1935. IF (appendix # NIL) THEN
  1936. IF ((appendix IS XML.Container) & (~(appendix IS XML.Element))) THEN (* avoid nested containers *)
  1937. subCont := appendix(XML.Container);
  1938. enum := subCont.GetContents();
  1939. WHILE (enum.HasMoreElements()) DO
  1940. pSub := enum.GetNext(); content := pSub(XML.Content);
  1941. AppendXMLContent(container, content)
  1942. END
  1943. ELSE
  1944. container.AddContent(appendix)
  1945. END
  1946. END
  1947. END AppendXMLContent;
  1948. (** copy the contents of 'from' to 'to' by avoiding nested XML containers *)
  1949. PROCEDURE CopyXMLSubContents*(from, to: XML.Container);
  1950. VAR enum: XMLObjects.Enumerator; pSub: ANY; content: XML.Content;
  1951. BEGIN
  1952. IF ((from # NIL) & (to # NIL)) THEN
  1953. enum := from.GetContents();
  1954. WHILE (enum.HasMoreElements()) DO
  1955. pSub := enum.GetNext(); content := pSub(XML.Content);
  1956. AppendXMLContent(to, content)
  1957. END
  1958. END
  1959. END CopyXMLSubContents;
  1960. PROCEDURE Concat(dynStr: DynamicStrings.DynamicString; appendix: ARRAY OF CHAR);
  1961. VAR appStr: Strings.String;
  1962. BEGIN
  1963. appStr := GetString(appendix);
  1964. dynStr.Append(appStr^)
  1965. END Concat;
  1966. PROCEDURE GetString*(text: ARRAY OF CHAR): Strings.String;
  1967. VAR str: Strings.String;
  1968. BEGIN
  1969. NEW(str, Strings.Length(text)+1); COPY(text, str^); RETURN str
  1970. END GetString;
  1971. (** format 'day month year hour minute second" no check for validity *)
  1972. PROCEDURE StrToDateTime*(str: ARRAY OF CHAR; VAR dt: Dates.DateTime);
  1973. VAR i: SIZE;
  1974. PROCEDURE GoToNextBlock;
  1975. BEGIN
  1976. WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END
  1977. END GoToNextBlock;
  1978. BEGIN
  1979. i := 0;
  1980. GoToNextBlock;
  1981. Strings.StrToIntPos(str, dt.day, i);
  1982. GoToNextBlock;
  1983. Strings.StrToIntPos(str, dt.month, i);
  1984. GoToNextBlock;
  1985. Strings.StrToIntPos(str, dt.year, i);
  1986. GoToNextBlock;
  1987. Strings.StrToIntPos(str, dt.hour, i);
  1988. GoToNextBlock;
  1989. Strings.StrToIntPos(str, dt.minute, i);
  1990. GoToNextBlock;
  1991. Strings.StrToIntPos(str, dt.second, i)
  1992. END StrToDateTime;
  1993. (** date time to string by DateTimeFormat in CONST block *)
  1994. PROCEDURE DateTimeToStr*(VAR dt: Dates.DateTime) : Strings.String;
  1995. VAR dateStr: ARRAY 40 OF CHAR;
  1996. BEGIN
  1997. Strings.FormatDateTime(DateTimeFormat, dt, dateStr);
  1998. RETURN GetString(dateStr)
  1999. END DateTimeToStr;
  2000. (** get the actual date time as a string *)
  2001. PROCEDURE GetNowDateTimeAsStr*() : Strings.String;
  2002. VAR dateStr: ARRAY 40 OF CHAR;
  2003. BEGIN
  2004. Strings.FormatDateTime(DateTimeFormat, Dates.Now(), dateStr);
  2005. RETURN GetString(dateStr)
  2006. END GetNowDateTimeAsStr;
  2007. (** return true if date time 'a' is strictly earlier than 'b' *)
  2008. PROCEDURE CompareDateTime*(VAR a, b: Dates.DateTime) : BOOLEAN;
  2009. BEGIN
  2010. IF (a.year # b.year) THEN RETURN a.year > b.year END;
  2011. IF (a.month # b.month) THEN RETURN a.month > b.month END;
  2012. IF (a.day # b.day) THEN RETURN a.day > b.day END;
  2013. IF (a.hour # b.hour) THEN RETURN a.hour > b.hour END;
  2014. IF (a.minute # b.minute) THEN RETURN a.minute > b.minute END;
  2015. RETURN a.second > b.second
  2016. END CompareDateTime;
  2017. (** usefull operations for the internalization and externalization process *)
  2018. (** return the internalized string in XML element named 'elementName' from 'container', result is NIL if not present *)
  2019. PROCEDURE InternalizeString*(container: XML.Container; elementName: ARRAY OF CHAR) : Strings.String;
  2020. VAR elem: XML.Element; str: Strings.String;
  2021. BEGIN
  2022. elem := GetXMLSubElement(container, elementName);
  2023. IF (elem # NIL) THEN
  2024. str := GetXMLCharContent(elem)
  2025. ELSE
  2026. str := NIL
  2027. END;
  2028. RETURN str
  2029. END InternalizeString;
  2030. (** return the internalized date time in XML element named 'elementName' from 'container', result is NIL if not present *)
  2031. PROCEDURE InternalizeDateTime*(container: XML.Container; elementName: ARRAY OF CHAR) : PtrDateTime;
  2032. VAR elem: XML.Element; dateTimeStr: Strings.String; dateTime: PtrDateTime;
  2033. BEGIN
  2034. elem := GetXMLSubElement(container, elementName);
  2035. IF (elem # NIL) THEN
  2036. dateTimeStr := GetXMLCharContent(elem);
  2037. IF (dateTimeStr # NIL) THEN
  2038. NEW(dateTime); StrToDateTime(dateTimeStr^, dateTime^)
  2039. END
  2040. ELSE
  2041. dateTime := NIL
  2042. END;
  2043. RETURN dateTime
  2044. END InternalizeDateTime;
  2045. (** return the internalized LONGINT in XML element named 'elementName' from 'container', result is 0 if not present *)
  2046. PROCEDURE InternalizeInteger*(container: XML.Container; elementName: ARRAY OF CHAR) : LONGINT;
  2047. VAR elem: XML.Element; intStr: Strings.String; number: LONGINT;
  2048. BEGIN
  2049. number := 0;
  2050. elem := GetXMLSubElement(container, elementName);
  2051. IF (elem # NIL) THEN
  2052. intStr := GetXMLCharContent(elem);
  2053. IF (intStr # NIL) THEN
  2054. Strings.StrToInt(intStr^, number)
  2055. END
  2056. END;
  2057. RETURN number
  2058. END InternalizeInteger;
  2059. (** return the internalized BOOLEAN in XML element named 'elementName' from 'container', result is FALSE if not present *)
  2060. PROCEDURE InternalizeBoolean*(container: XML.Container; elementName: ARRAY OF CHAR) : BOOLEAN;
  2061. VAR elem: XML.Element; boolStr: Strings.String; boolVal: BOOLEAN;
  2062. BEGIN
  2063. boolVal := FALSE;
  2064. elem := GetXMLSubElement(container, elementName);
  2065. IF (elem # NIL) THEN
  2066. boolStr := GetXMLCharContent(elem);
  2067. IF ((boolStr # NIL) & (boolStr^ = "true")) THEN
  2068. boolVal := TRUE
  2069. END
  2070. END;
  2071. RETURN boolVal
  2072. END InternalizeBoolean;
  2073. (** externlize string 'str' to 'container' with XML element named 'elementName'. 'str' could be NIL *)
  2074. PROCEDURE ExternalizeString*(str: Strings.String; container: XML.Container; elementName: ARRAY OF CHAR);
  2075. VAR elem: XML.Element;
  2076. BEGIN
  2077. IF (str # NIL) THEN
  2078. NEW(elem); elem.SetName(elementName);
  2079. AppendXMLContent(elem, CreateXMLText(str^));
  2080. container.AddContent(elem)
  2081. END
  2082. END ExternalizeString;
  2083. (** externlize dateTime 'dateTime' to 'container' with XML element named 'elementName'. 'dateTime' could be NIL *)
  2084. PROCEDURE ExternalizeDateTime*(dateTime: PtrDateTime; container: XML.Container; elementName: ARRAY OF CHAR);
  2085. VAR elem: XML.Element; dateTimeStr: Strings.String;
  2086. BEGIN
  2087. IF (dateTime # NIL) THEN
  2088. NEW(elem); elem.SetName(elementName);
  2089. dateTimeStr := DateTimeToStr(dateTime^);
  2090. AppendXMLContent(elem, CreateXMLText(dateTimeStr^));
  2091. container.AddContent(elem)
  2092. END;
  2093. END ExternalizeDateTime;
  2094. (** externalize LONGINT 'number' to 'container' with XML element named 'elementName'. *)
  2095. PROCEDURE ExternalizeInteger*(number: LONGINT; container: XML.Container; elementName: ARRAY OF CHAR);
  2096. VAR elem: XML.Element; intStr: ARRAY 14 OF CHAR;
  2097. BEGIN
  2098. Strings.IntToStr(number, intStr);
  2099. NEW(elem); elem.SetName(elementName);
  2100. AppendXMLContent(elem, CreateXMLText(intStr));
  2101. container.AddContent(elem);
  2102. END ExternalizeInteger;
  2103. (** externalize BOOLEAN 'boolVal' to 'container' with XML element named 'elementName'. *)
  2104. PROCEDURE ExternalizeBoolean*(boolVal: BOOLEAN; container: XML.Container; elementName: ARRAY OF CHAR);
  2105. VAR elem: XML.Element; boolStr: Strings.String;
  2106. BEGIN
  2107. IF (boolVal) THEN
  2108. boolStr := GetString("true")
  2109. ELSE
  2110. boolStr := GetString("false")
  2111. END;
  2112. NEW(elem); elem.SetName(elementName);
  2113. AppendXMLContent(elem, CreateXMLText(boolStr^));
  2114. container.AddContent(elem);
  2115. END ExternalizeBoolean;
  2116. PROCEDURE DefaultPersistentDataFilter*(obj: PersistentDataObject) : BOOLEAN;
  2117. BEGIN RETURN TRUE
  2118. END DefaultPersistentDataFilter;
  2119. PROCEDURE DefaultSessionDataFilter*(obj: SessionDataObject) : BOOLEAN;
  2120. BEGIN RETURN TRUE
  2121. END DefaultSessionDataFilter;
  2122. (** get an existing session data container, if not present create a new one, return NIL if the session variable is
  2123. already used for another purpose *)
  2124. PROCEDURE GetSessionDataContainer*(session: HTTPSession.Session; name: ARRAY OF CHAR) : SessionDataContainer;
  2125. VAR dynVarName: DynamicStrings.DynamicString; varName: Strings.String; p: ANY;
  2126. sessionCont: SessionDataContainer;
  2127. BEGIN (** session # NIL *)
  2128. NEW(dynVarName); Concat(dynVarName, SessionContainerNamePrefix);
  2129. dynVarName.Append(name);
  2130. varName := dynVarName.ToArrOfChar();
  2131. p := session.GetVariableValue(varName^);
  2132. IF ((p # NIL) & (p IS SessionDataContainer)) THEN
  2133. sessionCont := p(SessionDataContainer);
  2134. RETURN sessionCont
  2135. ELSIF (p = NIL) THEN
  2136. (* create new session container *)
  2137. NEW(sessionCont, name);
  2138. session.AddVariableValue(varName^, sessionCont);
  2139. RETURN sessionCont
  2140. END;
  2141. KernelLog.String("WebStd:SessionDataContainer: Warning - The reserved prefix '");
  2142. KernelLog.String(SessionContainerNamePrefix); KernelLog.String("' should not be used for session variables.");
  2143. KernelLog.Ln;
  2144. RETURN NIL
  2145. END GetSessionDataContainer;
  2146. (** find an existing session data container, if not present then return NIL, return NIL if the session variable is
  2147. already used for another purpose *)
  2148. PROCEDURE FindSessionDataContainer*(session: HTTPSession.Session; name: ARRAY OF CHAR) : SessionDataContainer;
  2149. VAR dynVarName: DynamicStrings.DynamicString; varName: Strings.String; p: ANY;
  2150. sessionCont: SessionDataContainer;
  2151. BEGIN (** session # NIL *)
  2152. NEW(dynVarName); Concat(dynVarName, SessionContainerNamePrefix);
  2153. dynVarName.Append(name);
  2154. varName := dynVarName.ToArrOfChar();
  2155. p := session.GetVariableValue(varName^);
  2156. IF ((p # NIL) & (p IS SessionDataContainer)) THEN
  2157. sessionCont := p(SessionDataContainer);
  2158. RETURN sessionCont
  2159. ELSIF (p = NIL) THEN
  2160. RETURN NIL
  2161. END;
  2162. KernelLog.String("WebStd:SessionDataContainer: Warning - The reserved prefix '");
  2163. KernelLog.String(SessionContainerNamePrefix); KernelLog.String("' should not be used for session variables.");
  2164. KernelLog.Ln;
  2165. RETURN NIL
  2166. END FindSessionDataContainer;
  2167. (** get an existing persistent data container, if not present create a new one. if prevSys is NIL then the
  2168. * standard prevalence system is used *)
  2169. PROCEDURE GetPersistentDataContainer*(prevSys: PrevalenceSystem.PrevalenceSystem;
  2170. name: ARRAY OF CHAR) : PersistentDataContainer;
  2171. VAR resultList: PrevalenceSystem.PersistentObjectList; cont: PersistentDataContainer;
  2172. BEGIN
  2173. IF (prevSys = NIL) THEN
  2174. prevSys := PrevalenceSystem.standardPrevalenceSystem
  2175. END;
  2176. QueryLock;
  2177. tempContainerName := GetString(name);
  2178. resultList := prevSys.FindPersistentObjects(FilterPersistentDataContainer);
  2179. IF (resultList # NIL) THEN
  2180. cont := resultList[0](PersistentDataContainer);
  2181. QueryUnlock;
  2182. RETURN cont
  2183. END;
  2184. (* create new persistent data container *)
  2185. NEW(cont); prevSys.AddPersistentObjectToRootSet(cont, persistentDataContainerDesc);
  2186. cont.SetName(name);
  2187. QueryUnlock;
  2188. RETURN cont
  2189. END GetPersistentDataContainer;
  2190. (** find an existing persistent data container, if not present then return NIL. if prevSys is NIL then the
  2191. * standard prevalence system is used *)
  2192. PROCEDURE FindPersistentDataContainer*(prevSys: PrevalenceSystem.PrevalenceSystem;
  2193. name: ARRAY OF CHAR) : PersistentDataContainer;
  2194. VAR resultList: PrevalenceSystem.PersistentObjectList; cont: PersistentDataContainer;
  2195. BEGIN
  2196. IF (prevSys = NIL) THEN
  2197. prevSys := PrevalenceSystem.standardPrevalenceSystem
  2198. END;
  2199. QueryLock;
  2200. tempContainerName := GetString(name);
  2201. resultList := prevSys.FindPersistentObjects(FilterPersistentDataContainer);
  2202. IF (resultList # NIL) THEN
  2203. cont := resultList[0](PersistentDataContainer);
  2204. QueryUnlock;
  2205. RETURN cont
  2206. END;
  2207. QueryUnlock;
  2208. RETURN NIL
  2209. END FindPersistentDataContainer;
  2210. PROCEDURE FilterPersistentDataContainer(obj: PrevalenceSystem.PersistentObject) : BOOLEAN;
  2211. VAR pers: PersistentDataContainer; n: Strings.String;
  2212. BEGIN
  2213. IF (obj IS PersistentDataContainer) THEN
  2214. pers := obj(PersistentDataContainer);
  2215. n := pers.GetName();
  2216. IF ((n # NIL) & (n^ = tempContainerName^)) THEN
  2217. RETURN TRUE
  2218. END
  2219. END;
  2220. RETURN FALSE
  2221. END FilterPersistentDataContainer;
  2222. (* true iff href is a link to another webserver then 'host' *)
  2223. PROCEDURE IsExternalHyperlink(href: ARRAY OF CHAR; host: ARRAY OF CHAR) : BOOLEAN;
  2224. BEGIN
  2225. Strings.LowerCase(href); Strings.LowerCase(host);
  2226. IF (Strings.Pos("://", href) > 0) THEN
  2227. RETURN ~((Strings.Pos("http://", href) = 0) & (Strings.Pos(host, href) = Strings.Length("http://")))
  2228. ELSE
  2229. RETURN FALSE
  2230. END
  2231. END IsExternalHyperlink;
  2232. PROCEDURE QueryLock;
  2233. BEGIN {EXCLUSIVE}
  2234. AWAIT(~qlock);
  2235. qlock := TRUE
  2236. END QueryLock;
  2237. PROCEDURE QueryUnlock;
  2238. BEGIN {EXCLUSIVE}
  2239. qlock := FALSE
  2240. END QueryUnlock;
  2241. PROCEDURE GetNewOid(): LONGINT;
  2242. BEGIN INC(oidCounter); RETURN oidCounter
  2243. END GetNewOid;
  2244. PROCEDURE CreateHyperlinkElement() : DynamicWebpage.ActiveElement;
  2245. VAR obj: Hyperlink;
  2246. BEGIN
  2247. NEW(obj); RETURN obj
  2248. END CreateHyperlinkElement;
  2249. PROCEDURE CreateEventButtonElement() : DynamicWebpage.ActiveElement;
  2250. VAR obj: EventButton;
  2251. BEGIN
  2252. NEW(obj); RETURN obj
  2253. END CreateEventButtonElement;
  2254. PROCEDURE CreateEventLinkElement() : DynamicWebpage.ActiveElement;
  2255. VAR obj: EventLink;
  2256. BEGIN
  2257. NEW(obj); RETURN obj
  2258. END CreateEventLinkElement;
  2259. PROCEDURE CreateFormularElement() : DynamicWebpage.ActiveElement;
  2260. VAR obj: Formular;
  2261. BEGIN
  2262. NEW(obj); RETURN obj
  2263. END CreateFormularElement;
  2264. PROCEDURE CreateDataContainerElement() : DynamicWebpage.ActiveElement;
  2265. VAR obj: DataContainer;
  2266. BEGIN
  2267. NEW(obj); RETURN obj
  2268. END CreateDataContainerElement;
  2269. PROCEDURE CreateSessionContainerElement() : DynamicWebpage.ActiveElement;
  2270. VAR obj: SessionContainer;
  2271. BEGIN
  2272. NEW(obj); RETURN obj
  2273. END CreateSessionContainerElement;
  2274. PROCEDURE CreateDatagridElement() : DynamicWebpage.ActiveElement;
  2275. VAR obj: Datagrid;
  2276. BEGIN
  2277. NEW(obj); RETURN obj
  2278. END CreateDatagridElement;
  2279. PROCEDURE CreateGetHeaderFieldElement() : DynamicWebpage.ActiveElement;
  2280. VAR obj: GetHeaderField;
  2281. BEGIN
  2282. NEW(obj); RETURN obj
  2283. END CreateGetHeaderFieldElement;
  2284. PROCEDURE CreateGetVariableElement() : DynamicWebpage.ActiveElement;
  2285. VAR obj: GetVariable;
  2286. BEGIN
  2287. NEW(obj); RETURN obj
  2288. END CreateGetVariableElement;
  2289. PROCEDURE CreateSetVariableElement() : DynamicWebpage.ActiveElement;
  2290. VAR obj: SetVariable;
  2291. BEGIN
  2292. NEW(obj); RETURN obj
  2293. END CreateSetVariableElement;
  2294. PROCEDURE CreateGuardElement() : DynamicWebpage.ActiveElement;
  2295. VAR obj: Guard;
  2296. BEGIN
  2297. NEW(obj); RETURN obj
  2298. END CreateGuardElement;
  2299. PROCEDURE CreateSequenceElement() : DynamicWebpage.ActiveElement;
  2300. VAR obj: Sequence;
  2301. BEGIN
  2302. NEW(obj); RETURN obj
  2303. END CreateSequenceElement;
  2304. PROCEDURE CreateIsEqualElement() : DynamicWebpage.ActiveElement;
  2305. VAR obj: IsEqual;
  2306. BEGIN
  2307. NEW(obj); RETURN obj
  2308. END CreateIsEqualElement;
  2309. PROCEDURE CreateToggleBlockElement() : DynamicWebpage.ActiveElement;
  2310. VAR obj: ToggleBlock;
  2311. BEGIN
  2312. NEW(obj); RETURN obj
  2313. END CreateToggleBlockElement;
  2314. PROCEDURE CreateVisitorCounterElement() : DynamicWebpage.ActiveElement;
  2315. VAR obj: VisitorCounter;
  2316. BEGIN
  2317. NEW(obj); RETURN obj
  2318. END CreateVisitorCounterElement;
  2319. PROCEDURE CreateNotElement() : DynamicWebpage.ActiveElement;
  2320. VAR obj: Not;
  2321. BEGIN
  2322. NEW(obj); RETURN obj
  2323. END CreateNotElement;
  2324. PROCEDURE CreateAndElement() : DynamicWebpage.ActiveElement;
  2325. VAR obj: And;
  2326. BEGIN
  2327. NEW(obj); RETURN obj
  2328. END CreateAndElement;
  2329. PROCEDURE CreateOrElement() : DynamicWebpage.ActiveElement;
  2330. VAR obj: Or;
  2331. BEGIN
  2332. NEW(obj); RETURN obj
  2333. END CreateOrElement;
  2334. PROCEDURE CreateXorElement() : DynamicWebpage.ActiveElement;
  2335. VAR obj: Xor;
  2336. BEGIN
  2337. NEW(obj); RETURN obj
  2338. END CreateXorElement;
  2339. PROCEDURE GetActiveElementDescriptors*() : DynamicWebpage.ActiveElementDescSet;
  2340. VAR desc: POINTER TO ARRAY OF DynamicWebpage.ActiveElementDescriptor;
  2341. descSet: DynamicWebpage.ActiveElementDescSet;
  2342. BEGIN
  2343. NEW(desc, 19);
  2344. NEW(desc[0], "Hyperlink", CreateHyperlinkElement);
  2345. NEW(desc[1], "EventButton", CreateEventButtonElement);
  2346. NEW(desc[2], "EventLink", CreateEventLinkElement);
  2347. NEW(desc[3], "Formular", CreateFormularElement);
  2348. NEW(desc[4], "DataContainer", CreateDataContainerElement);
  2349. NEW(desc[5], "SessionContainer", CreateSessionContainerElement);
  2350. NEW(desc[6], "Datagrid", CreateDatagridElement);
  2351. NEW(desc[7], "GetHeaderField", CreateGetHeaderFieldElement);
  2352. NEW(desc[8], "GetVariable", CreateGetVariableElement);
  2353. NEW(desc[9], "SetVariable", CreateSetVariableElement);
  2354. NEW(desc[10], "Guard", CreateGuardElement);
  2355. NEW(desc[11], "Sequence", CreateSequenceElement);
  2356. NEW(desc[12], "IsEqual", CreateIsEqualElement);
  2357. NEW(desc[13], "ToggleBlock", CreateToggleBlockElement);
  2358. NEW(desc[14], "VisitorCounter", CreateVisitorCounterElement);
  2359. NEW(desc[15], "Not", CreateNotElement);
  2360. NEW(desc[16], "And", CreateAndElement);
  2361. NEW(desc[17], "Or", CreateOrElement);
  2362. NEW(desc[18], "Xor", CreateXorElement);
  2363. NEW(descSet, desc^); RETURN descSet
  2364. END GetActiveElementDescriptors;
  2365. PROCEDURE GetNewPersistentDataContainer() : PrevalenceSystem.PersistentObject;
  2366. VAR obj: PersistentDataContainer;
  2367. BEGIN
  2368. NEW(obj); RETURN obj
  2369. END GetNewPersistentDataContainer;
  2370. PROCEDURE GetNewPersistentCounter() : PrevalenceSystem.PersistentObject;
  2371. VAR obj: PersistentCounter;
  2372. BEGIN
  2373. NEW(obj); RETURN obj
  2374. END GetNewPersistentCounter;
  2375. (** used by the prevalence system *)
  2376. PROCEDURE GetPersistentObjectDescriptors*() : PrevalenceSystem.PersistentObjectDescSet;
  2377. VAR descSet : PrevalenceSystem.PersistentObjectDescSet;
  2378. descs: ARRAY 2 OF PrevalenceSystem.PersistentObjectDescriptor;
  2379. BEGIN
  2380. descs[0] := persistentDataContainerDesc;
  2381. descs[1] := persistentCounterDesc;
  2382. NEW(descSet, descs);
  2383. RETURN descSet
  2384. END GetPersistentObjectDescriptors;
  2385. BEGIN
  2386. oidCounter := 0;
  2387. NEW(persistentDataContainerDesc, "WebStd", "PersistentDataContainer", GetNewPersistentDataContainer);
  2388. NEW(persistentCounterDesc, "WebStd", "PersistentCounter", GetNewPersistentCounter);
  2389. END WebStd.