langxml.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langxml.c 1260 2006-04-13 06:13:10Z sethdill $    */
00003 
00004 /******************************************************************************
00005 
00006     UserLand Frontier(tm) -- High performance Web content management,
00007     object database, system-level and Internet scripting environment,
00008     including source code editing and debugging.
00009 
00010     Copyright (C) 1992-2004 UserLand Software, Inc.
00011 
00012     This program is free software; you can redistribute it and/or modify
00013     it under the terms of the GNU General Public License as published by
00014     the Free Software Foundation; either version 2 of the License, or
00015     (at your option) any later version.
00016 
00017     This program is distributed in the hope that it will be useful,
00018     but WITHOUT ANY WARRANTY; without even the implied warranty of
00019     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00020     GNU General Public License for more details.
00021 
00022     You should have received a copy of the GNU General Public License
00023     along with this program; if not, write to the Free Software
00024     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00025 
00026 ******************************************************************************/
00027 
00028 #include "frontier.h"
00029 #include "standard.h"
00030 
00031 #include "memory.h"
00032 #include "strings.h"
00033 #include "ops.h"
00034 #include "resources.h"
00035 #include "timedate.h"
00036 #include "lang.h"
00037 #include "langinternal.h"
00038 #include "langhtml.h"
00039 #include "langexternal.h"
00040 #include "langsystem7.h"
00041 #include "tableinternal.h"
00042 #include "tablestructure.h"
00043 #include "tableverbs.h"
00044 #include "kernelverbs.h"
00045 #include "kernelverbdefs.h"
00046 #include "oplist.h"
00047 #include "BASE64.H" //for xmlvaltostring
00048 #include "langxml.h" /*7.0b21 PBS*/
00049 #include "process.h"
00050 
00051 #define stringerrorlist 264
00052 #define notimplementederror 1
00053 
00054 #define STR_atts    (BIGSTRING ("\x05" "/atts"))
00055 #define STR_i4      (BIGSTRING ("\x02" "i4"))
00056 #define STR_i2      (BIGSTRING ("\x02" "i2"))
00057 #define STR_i1      (BIGSTRING ("\x02" "i1"))
00058 #define STR_float   (BIGSTRING ("\x05" "float"))
00059 
00060 #define STR_base64_begin    (BIGSTRING ("\x08" "<base64>"))
00061 #define STR_base64_end      (BIGSTRING ("\x09" "</base64>"))
00062 #define STR_value_begin     (BIGSTRING ("\x07" "<value>"))
00063 #define STR_value_end       (BIGSTRING ("\x08" "</value>"))
00064 #define STR_array_begin     (BIGSTRING ("\x07" "<array>"))
00065 #define STR_array_end       (BIGSTRING ("\x08" "</array>"))
00066 #define STR_data_begin      (BIGSTRING ("\x06" "<data>"))
00067 #define STR_data_end        (BIGSTRING ("\x07" "</data>"))
00068 #define STR_struct_begin    (BIGSTRING ("\x08" "<struct>"))
00069 #define STR_struct_end      (BIGSTRING ("\x09" "</struct>"))
00070 #define STR_member_begin    (BIGSTRING ("\x08" "<member>"))
00071 #define STR_member_end      (BIGSTRING ("\x09" "</member>"))
00072 #define STR_name_begin      (BIGSTRING ("\x06" "<name>"))
00073 #define STR_name_end        (BIGSTRING ("\x07" "</name>"))
00074 
00075 #define STR_struct      (BIGSTRING ("\x06" "struct"))
00076 #define STR_member      (BIGSTRING ("\x06" "member"))
00077 #define STR_base64      (BIGSTRING ("\x06" "base64"))
00078 #define STR_array       (BIGSTRING ("\x05" "array"))
00079 #define STR_value       (BIGSTRING ("\x05" "value"))
00080 #define STR_data        (BIGSTRING ("\x04" "data"))
00081 #define STR_name        (BIGSTRING ("\x04" "name"))
00082 
00083 #define STR_contents    (BIGSTRING ("\x09" "/contents"))
00084 #define STR_namespace   (BIGSTRING ("\x09" "namespace"))
00085 #define STR_version     (BIGSTRING ("\x07" "version"))
00086 #define STR_prefix      (BIGSTRING ("\x06" "prefix"))
00087 #define STR_pcdata      (BIGSTRING ("\x07" "/pcdata"))
00088 #define STR_cdata       (BIGSTRING ("\x06" "/cdata"))
00089 #define STR_pi          (BIGSTRING ("\x03" "/pi"))
00090 #define STR_doctype     (BIGSTRING ("\x08" "/doctype"))
00091 #define STR_comment     (BIGSTRING ("\x08" "/comment"))
00092 
00093 #define STR_xmldecl             (BIGSTRING ("\x04" "?xml"))
00094 #define STR_xmlversion          (BIGSTRING ("\x15" "<?xml version=\"1.0\"?>"))
00095 #define STR_xmlnamespace        (BIGSTRING ("\x0e" "?xml:namespace"))
00096 #define STR_endtag              (BIGSTRING ("\x01" ">"))
00097 #define STR_startCDATA          (BIGSTRING ("\x09" "<![CDATA["))
00098 #define STR_endCDATA            (BIGSTRING ("\x03" "]]>"))
00099 #define STR_startcomment        (BIGSTRING ("\x04" "<!--"))
00100 #define STR_endcomment          (BIGSTRING ("\x03" "-->"))
00101 #define STR_startdoctype        (BIGSTRING ("\x0a" "<!DOCTYPE "))
00102 
00103 #define STR_datetimeiso8601     (BIGSTRING ("\x10" "dateTime.iso8601"))
00104 #define STR_cantendwithLT       (BIGSTRING ("\x1d" "can't end the text with a '<'"))
00105 #define STR_didntfindGTafterLT  (BIGSTRING ("\x1d" "didn't find a '>' after a '<'"))
00106 #define STR_tagmustbeofform     (BIGSTRING ("\x1f" "tag must be of the form <?xxx?>"))
00107 #define STR_improperlyformatted (BIGSTRING ("\x27" "string constant is improperly formatted"))
00108 #define STR_itmustendwithtag    (BIGSTRING ("\x19" "it must end with a </tag>"))
00109 #define STR_itcantendontag      (BIGSTRING ("\x17" "it can't end on a <tag>"))
00110 #define STR_wewereexpecting     (BIGSTRING ("\x17" "we were expecting </^0>"))
00111 #define STR_toomanytags         (BIGSTRING ("\x10" "too many </tag>s"))
00112 #define STR_wewereexpectingtag  (BIGSTRING ("\x1d" "we were expecting a </^0> tag"))
00113 #define STR_atcharacteroffset   (BIGSTRING ("\x14" " (At character #^0.)"))
00114 #define STR_tablehasnosubs      (BIGSTRING ("\x1c" " the table has no sub-items."))
00115 
00116 #define STR_user_protocols              (BIGSTRING ("\x0e" "user.protocols"))
00117 #define STR_sys_protocols               (BIGSTRING ("\x12" "Frontier.protocols"))
00118 #define STR_unknown_protocol            (BIGSTRING ("\x35" "Can't call \"^0\" because the \"^1\" protocol is unknown."))
00119 #define STR_serverprefix                (BIGSTRING ("\x03" "://"))
00120 #define STR_cant_decompile_empty_table  (BIGSTRING ("\x46" "Can't decompile the table to an XML string because the table is empty."))
00121 
00122 
00123 typedef enum tyxmlverbtoken { /*verbs that are processed by langxml.c*/
00124     
00125     xmladdtablefunc,
00126     xmladdvaluefunc,
00127     xmlcompilefunc,
00128     xmldecompilefunc,
00129     xmlgetaddressfunc,
00130     xmlgetaddresslistfunc,
00131     xmlgetattributefunc,
00132     xmlgetattributevaluefunc,
00133     xmlgetvaluefunc,
00134     xmlvaltostringfunc,
00135     xmlfrontiervaltotaggedtextfunc,
00136     xmlstructtofrontiervaluefunc,
00137     xmlgetpathaddressfunc,
00138     xmlconverttodisplaynamefunc,
00139     
00140     ctxmlverbs
00141     } tyxmlverbtoken;
00142 
00143 
00144 typedef struct xmltoken {
00145 
00146     long pos; // 5.1.3: offset in text stream of token start
00147     boolean isTag;
00148     boolean openTag;
00149     boolean isDoctype;
00150     boolean isCDATA;
00151     boolean isPI; //processing instruction
00152     boolean isComment;
00153     Handle tokenstring;
00154     hdlhashtable atts;
00155     tyvaluerecord attsvalue;
00156     } xmltoken, *ptrxmltoken;
00157 
00158 
00159 
00160 
00161 
00162 /* function templates */
00163 
00164 static boolean xmlvaltostring (tyvaluerecord xmlval, short indentlevel, boolean fltranslatestrings, Handle *string);
00165 
00166 static boolean xmlfrontiervaltotaggedtext (tyvaluerecord *val, short indentlevel, Handle *xmltext, hdlhashnode);
00167 
00168 static boolean xmlstructtofrontiervalue (tyaddress *adrstruct, tyvaluerecord *v);
00169 
00170 static boolean xmlgetaddress (hdlhashtable ht, bigstring name);
00171 
00172 
00173 static boolean handlebeginswith (Handle h, bigstring bs) {
00174     
00175     long ct = gethandlesize (h);
00176     long ctcompare = stringlength (bs);
00177     
00178     if (ct < ctcompare)
00179         return (false);
00180     
00181     return (strncmp (stringbaseaddress ((char *) bs), ((char *) *h), ctcompare) == 0);
00182     } /*handleendswith*/
00183 
00184 
00185 #if 0
00186 
00187 static boolean handleendswith (Handle h, bigstring bs) {
00188     
00189     long ct = gethandlesize (h);
00190     long ctcompare = stringlength (bs);
00191     
00192     if (ct < ctcompare)
00193         return (false);
00194     
00195     return (strncmp (stringbaseaddress (bs), ((char *) *h) + (ct - ctcompare), ctcompare) == 0);
00196     } /*handleendswith*/
00197 
00198 #endif
00199 
00200 
00201 static boolean handlecontains (Handle h, bigstring bs) {
00202 
00203     return (textpatternmatch ((byte *)(*h), gethandlesize (h), bs, false) >= 0);
00204     } /*handlecontains*/
00205 
00206 
00207 static boolean replaceallinstring (char chfind, bigstring bsreplace, bigstring bs) {
00208     
00209     /*
00210     replace all instances of ch1 in bs with ch2
00211     
00212     5.0d14 dmb: scanstring is 1-based, setstringcharacter is 0-based.
00213     */
00214     
00215     short ix = 1;
00216     
00217     while (scanstring (chfind, bs, &ix)) {
00218     
00219         replacestring (bs, ix, 1, bsreplace);
00220         
00221         ix += stringlength (bsreplace) - 1;
00222         }
00223     
00224     return (true);
00225     } /*replaceallinstring*/
00226 
00227 
00228 boolean replaceallinhandle (bigstring bsfind, bigstring bsreplace, Handle htext) {
00229     
00230     Handle hfind = nil;
00231     Handle hreplace = nil;
00232     boolean fl = false;
00233     
00234     if (!newtexthandle (bsfind, &hfind))
00235         return (false);
00236     
00237     if (!newtexthandle (bsreplace, &hreplace))
00238         goto exit;
00239     
00240     fl = textfindreplace (hfind, hreplace, htext, true, false);
00241     
00242  exit:
00243     disposehandle (hfind);
00244     
00245     disposehandle (hreplace);
00246     
00247     return (fl);
00248     } /*replaceallinhandle*/
00249 
00250 
00251 static boolean trimtrailingwhitespace (Handle htext) {
00252     
00253     /*
00254     5.1.3 dmb: remove any trailing whitespace from the handle. return true
00255     if anything is trimmed
00256     
00257     whitespace is defined as cr, lf, tab, space
00258     */
00259     
00260     long ctbytes = gethandlesize (htext);
00261     long ctorig = ctbytes;
00262     
00263     while (ctbytes > 0) {
00264         
00265         switch ((*htext) [ctbytes - 1]) {
00266             
00267             case chreturn:
00268             case chlinefeed:
00269             case chspace:
00270             case chtab:
00271                 --ctbytes;
00272                 break;
00273             
00274             default:
00275                 goto exit;
00276             }
00277         }
00278     
00279     exit:
00280     
00281     if (ctbytes == ctorig) // nothing needs to be trimmed
00282         return (false);
00283     
00284     sethandlesize (htext, ctbytes); // getting smaller, can't fail
00285     
00286     return (true);
00287     } /*trimtrailingwhitespace*/
00288 
00289 
00290 static boolean breakatfirstwhitespacechar (bigstring bs) {
00291     
00292     /*
00293     trunate at first whitespace character. return true if whitespace is actually found
00294     */
00295     
00296     short i;
00297     
00298     for (i = 0; i < stringlength (bs); ++i) {
00299         
00300         if (isspace (getstringcharacter (bs, i))) {
00301             
00302             setstringlength (bs, i);
00303             
00304             return (true);
00305             }
00306         }
00307     
00308     return (false);
00309     } /*breakatfirstwhitespacechar*/
00310 
00311 
00312 #if 0
00313 
00314 static boolean bettyRPCclient (bigstring server, short port, bigstring procedurename, hdltreenode hparams) {
00315 
00316     /*
00317     «A full-featured client for the RPC2 responder
00318         «Prior to the release of 5.0.2 this is the only way to talk to the server from Frontier
00319         «A beautiful client interface is coming, but even after that, this script will still have a purpose -- debugging.
00320         «If you call it with fldebug true, you'll get a lot of information about the XML conversation.
00321         «4/4/98; 6:13:06 AM by DW
00322 
00323     on client (rpcServer=tcp.addressDecode (tcp.myAddress ()), rpcPort=user.inetd.config.http.port, procedureName="", adrparamlist=nil, fldebug=false) {
00324         
00325         local (xmltext = "");
00326         bundle { //build the XML request
00327             local (indentlevel = 0);
00328             on add (s) {
00329                 xmltext = xmltext + string.filledString ("\t", indentlevel) + s + "\r\n"};
00330             add ("<?XML VERSION=\"1.0\"?>");
00331             add ("<methodCall>"); indentlevel++;
00332             add ("<methodName>" + procedureName + "</methodName>");
00333             add ("<params>"); indentlevel++;
00334             if adrparamlist != nil {
00335                 local (item);
00336                 for item in adrparamlist^ {
00337                     add ("<param>"); indentlevel++;
00338                     «add ("<name>" + nameOf (adritem^) + "</name>")
00339                     add ("<value>" + xml.coercions.frontierValueToTaggedText (@item, indentlevel) + "</value>");
00340                     add ("</param>"); indentlevel--}};
00341             add ("</params>"); indentlevel--;
00342             add ("</methodCall>"); indentlevel--};
00343         local (s);
00344         bundle { //send the HTTP request
00345             s = tcp.httpClient (method:"POST", server:rpcServer, port:rpcPort, path:"/RPC2", data:xmltext, datatype:"text/xml", debug:fldebug);
00346             if fldebug {
00347                 edit (@scratchpad.httpResult); //the result of setting debug to true in the call above
00348                 edit (@scratchpad.httpCommand)}};
00349         
00350         local (ix = string.patternMatch ("\r\n\r\n", s));
00351         local (response = string.delete (s, 1, ix + 3));
00352         
00353         local (adrtable = @temp.rpcReturn);
00354         xml.compile (s, adrtable);
00355         local (returnedValue);
00356         try { //walk the response structure, get returnedValue
00357             local (adrresponse = xml.getaddress (adrtable, "methodResponse"));
00358             local (adrparams = xml.getaddress (adrresponse, "params"));
00359             local (adrparam = xml.getaddress (adrparams, "param"));
00360             returnedValue = xml.getvalue (adrparam, "value")}
00361         else { //scriptError
00362             local (adrresponse = xml.getaddress (adrtable, "methodResponse"));
00363             local (adrfault = xml.getaddress (adrresponse, "fault"));
00364             local (adrvalue = xml.getaddress (adrfault, "value"));
00365             local (adrstruct = xml.getaddress (adrvalue, "struct"));
00366             local (memberlist = xml.getaddresslist (adrstruct, "member"));
00367             local (member, name, value, faultCode, faultString);
00368             for member in memberlist {
00369                 name = xml.getvalue (member, "name");
00370                 value = xml.getvalue (member, "value");
00371                 case name {
00372                     "faultCode" {
00373                         faultCode = value};
00374                     "faultString" {
00375                         faultString = value}}};
00376             scriptError ("The server, " + rpcServer + ", returned error code " + faultCode + ": " + faultString)};
00377         
00378         adrparamlist^ = {xmltext, adrtable^}; //save copies for the caller, helpful for examples
00379         return (returnedValue)}
00380     */
00381     
00382     return (true);
00383     } /*bettyRPCclient*/
00384 
00385 #endif
00386 
00387 
00388 static boolean xmladdtaggedvalue (tyvaluerecord *val, short indentlevel, handlestream *sptr) {
00389 
00390     /*
00391     6.1d3 AR: add the xml representation of a Frontier value to the handlestream.
00392     */
00393     
00394     Handle h = nil;
00395     
00396     assert (!(*val).fldiskval); /*08/04/2000 AR*/
00397     
00398     if ((*val).valuetype == stringvaluetype) {
00399         
00400         if (!xmlfrontiervaltotaggedtext (val, indentlevel, &h, HNoNode)
00401                 || !inserttextinhandle (h, 0, STR_value_begin)
00402                 || !pushtexthandle (STR_value_end, h)
00403                 || !writehandlestreamhandleindent (sptr, h, indentlevel))
00404             goto exit;
00405         }
00406     else {
00407         
00408         if (!writehandlestreamstringindent (sptr, STR_value_begin, indentlevel))
00409             goto exit;
00410         
00411         indentlevel++;
00412         
00413         if (!xmlfrontiervaltotaggedtext (val, indentlevel, &h, HNoNode))
00414             goto exit;
00415         
00416         if (!writehandlestreamhandleindent (sptr, h, indentlevel))
00417             goto exit;
00418         
00419         if (!writehandlestreamstringindent (sptr, STR_value_end, indentlevel))
00420             goto exit;
00421 
00422         indentlevel--;
00423         }
00424     
00425     disposehandle (h);
00426 
00427     return (true);
00428 
00429 exit:
00430     disposehandle (h);
00431     
00432     return (false);
00433     } /*xmladdtaggedvalue*/
00434 
00435     
00436 /*
00437 on frontierValueToTaggedText (adrFrontierValue, indentlevel) {
00438     local (xmltext = "");
00439     case typeOf (adrFrontierValue^) {
00440         listtype {
00441             local (item, ix);
00442             add ("<array>"); indentlevel++;
00443             add ("<data>"); indentlevel++;
00444             for ix = 1 to sizeof (adrFrontierValue^) { //Thu, 27 May 1999 22:02:21 GMT by AR
00445                 table.assign (@item, adrFrontierValue^[ix]);
00446                 addValue (@item)};
00447             add ("</data>"); indentlevel--;
00448             add ("</array>"); indentlevel--};
00449         tabletype {
00450             local (i, ct = sizeof (adrFrontierValue^), adritem);
00451             add ("<struct>"); indentlevel++;
00452             for i = 1 to ct {
00453                 adritem = @adrFrontierValue^ [i];
00454                 add ("<member>"); indentlevel++;
00455                 add ("<name>" + nameof (adritem^) + "</name>");
00456                 addValue (adritem);
00457                 add ("</member>"); indentlevel--};
00458             add ("</struct>"); indentlevel--}}
00459     else {
00460         add (xml.valToString (adrFrontierValue^, indentlevel))};
00461     xmltext = string.popleading (xmltext, "\t");
00462     xmltext = string.poptrailing (xmltext, "\r");
00463     return (xmltext)}   */
00464 
00465         
00466 static boolean xmlfrontiervaltotaggedtext (tyvaluerecord *val, short indentlevel, Handle *xmltext, hdlhashnode hnode) {
00467     
00468     /*
00469     6.1d3 AR: build the xml representation of a Frontier value.
00470     */
00471 
00472     handlestream s;
00473     
00474     openhandlestream (nil, &s);
00475     
00476     switch ((*val).valuetype) {
00477         
00478         case listvaluetype: {
00479             
00480             long ix, ct;
00481             tyvaluerecord v;
00482             
00483             if (!writehandlestreamstringindent (&s, STR_array_begin, indentlevel))
00484                 goto exit;
00485             
00486             indentlevel++;
00487 
00488             if (!writehandlestreamstringindent (&s, STR_data_begin, indentlevel))
00489                 goto exit;
00490             
00491             indentlevel++;
00492             
00493             if (!langgetlistsize (val, &ct))
00494                 goto exit;
00495             
00496             for (ix = 1; ix <= ct; ix++) {
00497                 
00498                 if (!langgetlistitem (val, ix, nil, &v))
00499                     goto exit;
00500                 
00501                 if (!xmladdtaggedvalue (&v, indentlevel, &s))
00502                     goto exit;
00503                 } /*for*/
00504             
00505             if (!writehandlestreamstringindent (&s, STR_data_end, indentlevel))
00506                 goto exit;
00507             
00508             indentlevel--;
00509 
00510             if (!writehandlestreamstringindent (&s, STR_array_end, indentlevel))
00511                 goto exit;
00512             
00513             indentlevel--;
00514 
00515             break;
00516             }
00517         
00518         case externalvaluetype: {
00519             hdlhashtable ht;
00520             boolean fl;
00521             
00522             disablelangerror ();
00523             
00524             fl = langexternalvaltotable (*val, &ht, hnode);
00525             
00526             enablelangerror ();
00527             
00528             if (fl) {
00529                 hdlhashnode x;
00530                 register long ix = 0;
00531                 tyvaluerecord v;
00532                 bigstring bsname;
00533                 Handle h;
00534                 
00535                 if (!writehandlestreamstringindent (&s, STR_struct_begin, indentlevel))
00536                     goto exit;
00537                 
00538                 indentlevel++;
00539                 
00540                 while (hashgetnthnode (ht, ix++, &x)) { /*loop through the table*/
00541                     
00542                     if (!hashresolvevalue (ht, x)) /*08/04/2000 AR*/
00543                         goto exit;
00544                     
00545                     if (!writehandlestreamstringindent (&s, STR_member_begin, indentlevel))
00546                         goto exit;
00547                     
00548                     indentlevel++;
00549                     
00550                     gethashkey (x, bsname);
00551                     
00552                     if (!newtexthandle (bsname, &h))
00553                         goto exit;
00554                     
00555                     fl = inserttextinhandle (h, 0, STR_name_begin)
00556                             && pushtexthandle (STR_name_end, h)
00557                             && writehandlestreamhandleindent (&s, h, indentlevel);
00558                     
00559                     disposehandle (h);                      
00560                     
00561                     if (!fl)
00562                         goto exit;
00563                     
00564                     v = (**x).val;
00565                     
00566                     if (!xmladdtaggedvalue (&v, indentlevel, &s))
00567                         goto exit;
00568                                 
00569                     if (!writehandlestreamstringindent (&s, STR_member_end, indentlevel))
00570                         goto exit;
00571                     
00572                     indentlevel--;
00573                     } /*while*/
00574             
00575                 if (!writehandlestreamstringindent (&s, STR_struct_end, indentlevel))
00576                     goto exit;
00577                 
00578                 indentlevel--;
00579 
00580                 break;
00581                 }
00582             } /*note fall-through for externals that are not a table*/
00583         
00584         default: {
00585             Handle h;
00586             boolean fl;
00587             
00588             if (!xmlvaltostring (*val, indentlevel, true, &h))
00589                 goto exit;
00590             
00591             fl = writehandlestreamhandleindent (&s, h, indentlevel);
00592             
00593             disposehandle (h);
00594             
00595             if (!fl)
00596                 goto exit;
00597             
00598             break;
00599             }   
00600         
00601         } /*switch*/
00602     
00603     *xmltext = closehandlestream (&s);
00604 
00605     handlepopleadingchars (*xmltext, '\t');
00606 
00607     handlepoptrailingchars (*xmltext, '\r');
00608     
00609     return (true);
00610 
00611 exit:
00612 
00613     disposehandlestream (&s);
00614     
00615     return (false);
00616     } /*xmlfrontiervaltotaggedtext*/
00617 
00618 
00619     /*
00620 on structToFrontierValue (adrstruct, adrFrontierVal) {
00621     local (name = string.nthfield (nameof (adrstruct^), '\t', 2));
00622     case name {
00623         "struct" {
00624             new (tabletype, adrFrontierVal);
00625             local (i);
00626             for i = 1 to sizeOf (adrstruct^) {
00627                 local (itemName = string.nthField (nameOf (adrstruct^ [i]), '\t', 2));
00628                 if itemName == "member" {
00629                     local (member = @adrstruct^ [i]);
00630                     local (name, adrvalue);
00631                     name = xml.getValue (member, "name");
00632                     adrvalue = xml.getAddress (member, "value");
00633                     if typeof (adrvalue^) == tabletype {
00634                         local (coercedvalue);
00635                         xml.coercions.structToFrontierValue (@adrvalue^ [1], @coercedvalue);
00636                         adrFrontierVal^.[name] = coercedvalue}
00637                     else {
00638                         adrFrontierVal^.[name] = adrvalue^}}};
00639             return (true)};
00640         "array" {
00641             local (i, val = {}, adrdata = xml.getAddress (adrstruct, "data"));
00642             for i = 1 to sizeOf (adrdata^) {
00643                 local (itemName = string.nthField (nameOf (adrdata^ [i]), '\t', 2));
00644                 if itemName == "value" {
00645                     local (adrvalue = @adrdata^ [i]);
00646                     if typeof (adrvalue^) == tabletype {
00647                         local (coercedvalue);
00648                         xml.coercions.structToFrontierValue (@adrvalue^ [1], @coercedvalue);
00649                         val = val + {coercedvalue}}
00650                     else {
00651                         val = val + adrvalue^}}};
00652             adrFrontierVal^ = val;
00653             return (true)};
00654         "base64" { //2/28/99; 11:32:12 AM by DW
00655             adrFrontierVal^ = binary (base64.decode (adrstruct^));
00656             return (true)}};
00657     adrFrontierVal^ = adrstruct^;
00658     return (true)}  */
00659 
00660 static boolean structtofrontiervalvisit (hdlhashnode hn, hdlhashtable htnew) {
00661 
00662     hdlhashtable ht;
00663     bigstring bsname;
00664     hdlhashnode hnode;
00665     
00666     gethashkey (hn, bsname);
00667 
00668     if (stringfindchar ('\t', bsname))
00669         nthword (bsname, 2, '\t', bsname);
00670     
00671     if (equalstrings (bsname, STR_member)) {
00672     
00673         bigstring bsvalue, bsvaluename, bsnewname;
00674         tyvaluerecord vname, val;
00675         tyaddress adrstruct;
00676         
00677         if (!langexternalvaltotable ((**hn).val, &ht, hn))
00678             return (false);
00679         
00680         copystring (STR_name, bsvaluename);
00681         
00682         if (!xmlgetaddress (ht, bsvaluename))
00683             return (false);
00684                 
00685         if (!hashtablelookup (ht, bsvaluename, &vname, &hnode))
00686             return (false);
00687         
00688         if (langexternalvaltotable (vname, &ht, hnode))
00689             if (!hashtablelookup (ht, STR_pcdata, &vname, &hnode))
00690                 if (!hashtablelookup (ht, STR_contents, &vname, &hnode))
00691                     return (false);
00692         
00693         if (vname.valuetype != stringvaluetype)
00694             if (!copyvaluerecord (vname, &vname) || !coercetostring (&vname))
00695                 return (false);
00696         
00697         pullstringvalue (&vname, bsnewname);
00698 
00699         copystring (STR_value, bsvalue);
00700         
00701         if (!xmlgetaddress (ht, bsvalue))
00702             return (false);
00703         
00704         if (!hashtablelookup (ht, bsvalue, &val, &hnode))
00705             return (false);
00706                 
00707         if (langexternalvaltotable (val, &adrstruct.ht, hnode)) {
00708             
00709             tyvaluerecord vcoerced;
00710             hdlhashnode hnode2;
00711             
00712             if (!hashgetnthnode (adrstruct.ht, 0L, &hnode2))
00713                 return (false);
00714             
00715             gethashkey (hnode2, adrstruct.bs);
00716             
00717             if (!xmlstructtofrontiervalue (&adrstruct, &vcoerced))
00718                 return (false);
00719             
00720             exemptfromtmpstack (&vcoerced);
00721             
00722             if (!hashtableassign (htnew, bsnewname, vcoerced)) {
00723             
00724                 disposevaluerecord (vcoerced, false);
00725                 
00726                 return (false);
00727                 }
00728             }
00729         else {
00730         
00731             if (!copyvaluerecord (val, &val))
00732                 return (false);
00733             
00734             exemptfromtmpstack (&val);
00735             
00736             if (!hashtableassign (htnew, bsnewname, val)) {
00737                 
00738                 disposevaluerecord (val, false);
00739                 
00740                 return (false);
00741                 }
00742             }
00743         }
00744     
00745     return (true);
00746     } /*structtofrontiervalvisit*/
00747 
00748 
00749 static boolean arraytofrontiervalvisit (hdlhashnode hn, hdllistrecord hlist) {
00750 
00751     tyvaluerecord val;
00752     bigstring bsname;
00753     
00754     gethashkey (hn, bsname);
00755 
00756     if (stringfindchar ('\t', bsname))
00757         nthword (bsname, 2, '\t', bsname);
00758     
00759     if (equalstrings (bsname, STR_value)) {
00760     
00761         tyaddress adrstruct;
00762 
00763         val = (**hn).val;
00764         
00765         if (langexternalvaltotable (val, &adrstruct.ht, hn)) {
00766             
00767             tyvaluerecord vcoerced;
00768             hdlhashnode hnode;
00769             
00770             if (!hashgetnthnode (adrstruct.ht, 0L, &hnode))
00771                 return (false);
00772             
00773             gethashkey (hnode, adrstruct.bs);
00774             
00775             if (!xmlstructtofrontiervalue (&adrstruct, &vcoerced))
00776                 return (false);
00777             
00778             if (!langpushlistval (hlist, nil, &vcoerced))
00779                 return (false);
00780             }
00781         else if (!langpushlistval (hlist, nil, &val))
00782             return (false);
00783         }
00784     
00785     return (true);
00786     } /*arraytofrontiervalvisit*/
00787 
00788 
00789 static boolean xmlstructtofrontiervalue (tyaddress *adrstruct, tyvaluerecord *v) {
00790     
00791     bigstring bsname;
00792     tyvaluerecord vstruct, val;
00793     hdlhashnode hnode;
00794 
00795     if (!langhashtablelookup ((*adrstruct).ht, (*adrstruct).bs, &vstruct, &hnode))
00796         return (false);
00797 
00798     copystring ((*adrstruct).bs, bsname);
00799 
00800     if (stringfindchar ('\t', bsname))
00801         nthword (bsname, 2, '\t', bsname);
00802     
00803     if (equalstrings (bsname, STR_struct)) {
00804         
00805         hdlhashtable ht, htnew;
00806         hdlhashnode hn;
00807         long ix = 0;
00808             
00809         if (!tablenewtablevalue (&htnew, &val))
00810             return (false);
00811         
00812         //pushtmpstackvalue (&val);
00813         pushvalueontmpstack (&val);
00814         
00815         if (!langexternalvaltotable (vstruct, &ht, hnode))
00816             goto done;
00817         
00818         while (hashgetnthnode (ht, ix++, &hn))
00819             if (!structtofrontiervalvisit (hn, htnew))
00820                 return (false);
00821         }
00822     else if (equalstrings (bsname, STR_array)) {
00823         
00824         tyvaluerecord vdata;
00825         tyaddress adrdata;
00826         hdlhashtable ht;
00827         hdlhashnode hn;
00828         hdllistrecord hlist;
00829         long ix = 0;
00830 
00831         if (!opnewlist (&hlist, false))
00832             return (false);
00833     
00834         setheapvalue ((Handle) hlist, listvaluetype, &val);
00835 
00836         if (!langexternalvaltotable (vstruct, &adrdata.ht, hnode))
00837             goto done;
00838                 
00839         copystring (STR_data, adrdata.bs);
00840         
00841         if (!xmlgetaddress (adrdata.ht, adrdata.bs))
00842             return (false);
00843         
00844         if (!langhashtablelookup (adrdata.ht, adrdata.bs, &vdata, &hnode))
00845             return (false);
00846         
00847         if (!langexternalvaltotable (vdata, &ht, hnode))
00848             goto done;
00849                 
00850         while (hashgetnthnode (ht, ix++, &hn))
00851             if (!arraytofrontiervalvisit (hn, hlist))
00852                 return (false);
00853         }
00854     else if (equalstrings (bsname, STR_base64)) {
00855         
00856         Handle htext;
00857 
00858         if (!copyvaluerecord (vstruct, &vstruct)
00859                 || !coercetostring (&vstruct))
00860             return (false);
00861         
00862         if (!newemptyhandle (&htext))
00863             return (false);
00864             
00865         if (!base64decodehandle (vstruct.data.stringvalue, htext)) {
00866             
00867             disposehandle (htext);
00868             
00869             return (false);
00870             }
00871         
00872         setbinaryvalue (htext, '\?\?\?\?', &val);
00873         }
00874     else {
00875 
00876         if (!copyvaluerecord (vstruct, &val) || !copyvaluedata (&val))
00877             return (false);
00878         }   
00879 
00880 done:
00881     *v = val;
00882     
00883     return (true);
00884     } /*xmlstructtofrontierval*/
00885 
00886 
00887 static boolean langfindnamedparam (hdltreenode hp1) {
00888 
00889     while (hp1 != nil) {
00890 
00891         if ((**hp1).nodetype == fieldop)
00892             return (true);
00893 
00894         hp1 = (**hp1).link; /*advance to the next parameter name*/
00895         }
00896 
00897     return (false);
00898     } /*langfindnamedparam*/
00899 
00900 
00901 static boolean callprotocolhandler (hdlhashtable hremotetable, bigstring bsprotocol, hdltreenode hcode, 
00902                                 bigstring bsserver, bigstring bsfunction, hdltreenode hparam1, tyvaluerecord *vreturned) {
00903 
00904     /*
00905     02/05/02 dmb: call the specified remote function. NOTE: bsserver is a misnomer; it's really 
00906     the full url of the server, less the path; i.e. is includes the protocol, port, the path
00907     */
00908 
00909     hdllistrecord hparamlist = nil;
00910     tyvaluerecord vparamlist;
00911     tyvaluerecord vparams;
00912     tyvaluerecord vserver;
00913     tyvaluerecord vfunction;
00914     boolean fl;
00915 
00916     if (langfindnamedparam (hparam1))
00917         fl = makerecordvalue (hparam1, true, &vparams);
00918     else
00919         fl = makelistvalue (hparam1, &vparams);
00920 
00921     if (!fl)
00922         return (false);
00923     
00924     if (!setstringvalue (bsserver, &vserver))
00925         return (false);
00926     
00927     if (!setstringvalue (bsfunction, &vfunction))
00928         return (false);
00929     
00930     if (!opnewlist (&hparamlist, false))
00931         return (false);
00932     
00933     if (!langpushlistval (hparamlist, nil, &vserver))
00934         goto error;
00935 
00936     if (!langpushlistval (hparamlist, nil, &vfunction))
00937         goto error;
00938 
00939     if (!langpushlistval (hparamlist, nil, &vparams))
00940         goto error;
00941     
00942     if (!setheapvalue ((Handle) hparamlist, listvaluetype, &vparamlist))
00943         return (false);
00944 
00945     if (!langrunscriptcode (hremotetable, bsprotocol, hcode, &vparamlist, nil, vreturned))
00946         return (false);
00947 
00948     return (true);
00949 
00950     error: {
00951         
00952         opdisposelist (hparamlist);
00953         
00954         return (false);
00955         }
00956 
00957     } /*callprotocolhandler*/
00958 
00959 
00960 static boolean parseremotefunction (bigstring bs, ptrstring bsprotocol, ptrstring bsserver, short *port) {
00961 #pragma unused (port)
00962 
00963     /*
00964     5.0.2 dmb: given a string like "rpc2://betty.userland.com:81", set bsprotocol to "rpc2", 
00965     server to "betty.userland.com"
00966     */
00967     
00968     firstword (bs, ':', bsprotocol);
00969     
00970     if (isemptystring (bsprotocol) || stringlength (bsprotocol) < 1)
00971         return (false);
00972     
00973     midstring (bs, stringlength (bsprotocol) + 1, stringlength (bs) - stringlength (bsprotocol), bsserver);
00974     
00975     if (stringlength (bsserver) < 6) // room for ://x.y
00976         return (false);
00977     
00978     // is STR_serverprefix next?
00979 
00980     if (!equaltextidentifiers (stringbaseaddress (bsserver), stringbaseaddress (STR_serverprefix), stringlength (STR_serverprefix)))
00981         return (false);
00982     
00983     deletestring (bsserver, 1, stringlength (STR_serverprefix));
00984     
00985     /*nthword (bsserver, 2, ':', bsport);
00986     
00987     if (isemptystring (bsport))
00988         *port = -1;
00989     else {
00990         firstword (bsserver, ':', bsserver);
00991         
00992         stringtoshort (bsport, port);
00993         }
00994     */
00995 
00996     return (true);
00997     } /*parseremotefunction*/
00998 
00999 
01000 static boolean findoneprotocolhandler (hdlhashtable hlookin, bigstring bshandlertable, bigstring bsprotocol, hdlhashtable *hremotetable, hdltreenode *hcode) {
01001 
01002     /*
01003     Given the <b>bsprotocol</b>, look for a script at user.remoteCallers.[bsprotocol].
01004     If none found, look for a script at Frontier.remoteCallers.[bsprotocol].
01005     
01006     2002-10-13 AR: Declared static to eliminate compiler warning about missing prototype.
01007     */
01008     
01009     tyvaluerecord val;
01010     hdlhashnode hnode;
01011     boolean fl;
01012 
01013     disablelangerror ();
01014     
01015     fl = langfastaddresstotable (hlookin, bshandlertable, hremotetable);
01016     
01017     enablelangerror ();
01018     
01019     if (!fl)
01020         return (false);
01021 
01022     if (hashtablelookup (*hremotetable, bsprotocol, &val, &hnode)) {
01023     
01024         while (langfollowifaddressvalue (&val)) // follow indirection
01025             ;
01026         
01027         return (langvaltocode (&val, hcode));
01028         }
01029     
01030     return (false);
01031     } /*findoneprotocolhandler*/
01032 
01033 
01034 static boolean findprotocolhandler (bigstring bsprotocol, hdlhashtable *hremotetable, hdltreenode *hcode) {
01035 
01036     /*
01037     Given the <b>bsprotocol</b>, look for a script at user.remoteCallers.[bsprotocol].
01038     If none found, look for a script at Frontier.remoteCallers.[bsprotocol].
01039     
01040     2002-10-13 AR: Declared static to eliminate compiler warning about missing prototype.
01041     */
01042 
01043     if (findoneprotocolhandler (roottable, STR_user_protocols, bsprotocol, hremotetable, hcode))
01044         return (true);
01045 
01046     if (findoneprotocolhandler (builtinstable, STR_sys_protocols, bsprotocol, hremotetable, hcode))
01047         return (true);
01048     
01049     return (false);
01050     } /*findprotocolhandler*/
01051 
01052 
01053 boolean langisremotefunction (hdltreenode htree) {
01054     
01055     /*
01056     5.0.2b8 dmb: carefully walk the code tree to determine if it's a remote
01057     call, without side effects if it's not.
01058     
01059     we're looking for a dotted id lead by a bracked expression whose (string)
01060     value looks like a simple url
01061     */
01062     
01063     bigstring bs;
01064     bigstring bsprotocol;
01065     bigstring bsserver;
01066     short port;
01067     tyvaluerecord val;
01068     
01069     while ((**htree).nodetype == dotop)
01070         htree = (**htree).param1;
01071     
01072     if ((**htree).nodetype != bracketop)
01073         return (false);
01074     
01075     htree = (**htree).param1;
01076     
01077     if (!evaluatereadonlyparam (htree, &val))
01078         return (false);
01079 
01080     pullstringvalue (&val, bs);
01081 
01082     return (parseremotefunction (bs, bsprotocol, bsserver, &port));
01083     } /*langisremotefunction*/
01084 
01085 
01086 boolean langremotefunctioncall (hdltreenode htree, hdltreenode hparam1, tyvaluerecord *vreturned) {
01087     
01088     /*
01089     5.0.2b8 dmb: we assume that htree has already been examined by langisremotefunction,
01090     or has been constructed according to its definition of a remote function call tree.
01091 
01092     1. Decompile the call and construct the parameters
01093         The code tree from ["xmlrpc://127.0.0.1:5335/RPC2"].radio.helloworld ("Dave") does not have the string "radio.helloworld" in it.
01094         Walk the code tree and contruct that part of the text that created it.
01095     2. Create a new param list, with the original param list ( {"Dave"} as the second parameter, the procedureName from step 1 ( "radio.helloWorld" ) the first parameter.
01096     3. Given the <b>bsprotocol</b>, look for a script at user.remoteCallers.[bsprotocol].
01097     4. if none found, look for a script at Frontier.remoteCallers.[bsprotocol].
01098     5. Make a param list of { server, procedureName, params } and call the script.
01099     */
01100     
01101     bigstring bs;
01102     bigstring bsprotocol;
01103     bigstring bsserver;
01104     bigstring bsfunction;
01105     hdlhashtable hremotetable;
01106     hdltreenode hcode;
01107     short port;
01108 
01109     setemptystring (bsfunction);
01110     
01111     while ((**htree).nodetype == dotop) { // build the function name from the dotted id
01112     
01113         if (!langgetidentifier ((**htree).param2, bs))
01114             return (false);
01115         
01116         if (isemptystring (bsfunction))
01117             copystring (bs, bsfunction);
01118         
01119         else {
01120             insertchar ('.', bsfunction);
01121             
01122             insertstring (bs, bsfunction);
01123             }
01124         
01125         htree = (**htree).param1;
01126         }
01127     
01128     if (!langgetidentifier (htree, bs))
01129         return (false);
01130     
01131     if (!parseremotefunction (bs, bsprotocol, bsserver, &port))
01132         return (false);
01133     
01134     if (!findprotocolhandler (bsprotocol, &hremotetable, &hcode)) {
01135     
01136         parsedialogstring (STR_unknown_protocol, bsfunction, bsprotocol, nil, nil, bs);
01137         
01138         langerrormessage (bs);
01139         
01140         return (false);
01141         }
01142     
01143     return (callprotocolhandler (hremotetable, bsprotocol, hcode, bs, bsfunction, hparam1, vreturned));
01144     } /*langremotefunctioncall*/
01145 
01146 
01147 static boolean newxmltoken (xmltoken *token) {
01148     
01149     clearbytes (token, sizeof (xmltoken));
01150     
01151     return (true);
01152     } /*newxmltoken*/
01153 
01154 
01155 static void disposexmltoken (xmltoken *token) {
01156     
01157     disposehandle ((*token).tokenstring);
01158     
01159     //disposehashtable ((*token).atts, false);
01160     if ((*token).atts != nil)
01161         disposevaluerecord ((*token).attsvalue, false);
01162     
01163     clearbytes (token, sizeof (xmltoken));
01164     } /*disposexmltoken*/
01165 
01166 
01167 static void assignxmltoken (xmltoken *totoken, xmltoken *fromtoken) {
01168 
01169     disposexmltoken (totoken); // collect garbage
01170 
01171     *totoken = *fromtoken;
01172     
01173     clearbytes (fromtoken, sizeof (*fromtoken)); // doesn't own the data anymore
01174     } /*assignxmltoken*/
01175 
01176 
01177 static boolean lookupstringvalue (hdlhashtable ht, const bigstring bs, bigstring value) {
01178     
01179     tyvaluerecord val;
01180     hdlhashnode hnode;
01181     
01182     if (!hashtablelookup (ht, bs, &val, &hnode))
01183         return (false);
01184     
01185     assert (val.valuetype == stringvaluetype);
01186     
01187     pullstringvalue (&val, value);
01188     
01189     return (true);
01190     } /*lookupstringvalue*/
01191 
01192 
01193 /*static boolean assignstringvalue (hdlhashtable ht, const bigstring bs, const bigstring value) {
01194     
01195     tyvaluerecord val;
01196     
01197     if (!setstringvalue ((ptrstring) value, &val))
01198         return (false);
01199     
01200     if (!hashtableassign (ht, bs, val))
01201         return (false);
01202     
01203     exemptfromtmpstack (&val);
01204     
01205     return (true);
01206     } /%assignstringvalue%/
01207 */
01208 
01209 static boolean assigntokenstringvalue (hdlhashtable ht, const bigstring bs, xmltoken *value) {
01210     
01211     /*
01212     assign the token's tokenstring to a table cell, consuming the token
01213     
01214     5.1.3 dmb: "compile" &amp; and &lt; as we assign to table
01215     */
01216     
01217     tyvaluerecord val;
01218     boolean fl;
01219     
01220     fl = setheapvalue ((*value).tokenstring, stringvaluetype, &val);
01221     
01222     (*value).tokenstring = nil; // it's been consumed
01223     
01224     if (!fl)
01225         return (false);
01226     
01227     /*
01228     if (!(*value).isCDATA) {
01229         
01230         if (!replaceallinhandle ("\x05" "&amp;", "\x01" "&", val.data.stringvalue))
01231             return (false);
01232         
01233         if (!replaceallinhandle ("\x04" "&lt;", "\x01" "<", val.data.stringvalue))
01234             return (false);
01235         
01236         if (!replaceallinhandle ("\x06" "]]&gt;", "\x03" "]]>", val.data.stringvalue))
01237             return (false);
01238         }
01239     */
01240     
01241     if (!hashtableassign (ht, bs, val))
01242         return (false);
01243     
01244     exemptfromtmpstack (&val);
01245     
01246     return (true);
01247     } /*assigntokenstringvalue*/
01248 
01249 
01250 static boolean createtokentable (xmladdress *adrtable, xmltoken *token, hdlhashtable *newtable) {
01251     
01252     /*
01253     create a new table at the given xmladdress. if the token has attributes, 
01254     move them into the new table
01255     */
01256     
01257     if (!langassignnewtablevalue ((*adrtable).ht, (*adrtable).bs, newtable))
01258         return (false);
01259     
01260     if ((*token).atts != nil) {
01261         
01262         if (!hashtableassign (*newtable, STR_atts, (*token).attsvalue))
01263             return (false);
01264         
01265         (*token).atts = nil; // token doesn't own the table anymore
01266         }
01267     
01268     return (true);
01269     } /*createtokentable*/
01270 
01271 
01272 /*
01273 static boolean skipblanks (Handle s) {
01274     
01275     /%
01276     on skipBlanks () {
01277         loop {
01278             if sizeof (s) == 0 {
01279                 break};
01280             if s [1] != ' ' {
01281                 break};
01282             s = string.delete (s, 1, 1)}};
01283     %/
01284     
01285     long ix, ct = gethandlesize (s);
01286     
01287     for (ix = 0; (ix < ct) && ((*s) [ix] == chspace); ++ix)
01288         ;
01289     
01290     pullfromhandle (s, 0, ix, nil);
01291     } /%skipblanks%/
01292 */
01293 
01294 static boolean namenomad (xmladdress *nomad, bigstring name) {
01295     
01296     /*
01297     on namenomad () { //return the name of the current table, without serialization
01298         return (string.nthfield (nameof (nomad^), '\t', 2))};
01299     */
01300     
01301     return (nthword ((*nomad).bs, 2, '\t', name));
01302     } /*namenomad*/
01303 
01304 
01305 #define serialinterval 1000
01306 
01307 static long nextserialnum (hdlhashtable ht) {
01308     
01309     hdlhashnode hn = (**ht).hfirstsort;
01310     hdlhashnode hnext;
01311     bigstring bs;
01312     long ct = 0, n;
01313     
01314     if (hn == nil)
01315         return (0);
01316     
01317     while (true) {
01318         
01319         ++ct;
01320         
01321         hnext = (**hn).sortedlink;
01322         
01323         if (hnext == nil)
01324             break;
01325         
01326         hn = hnext;
01327         }
01328     
01329     gethashkey (hn, bs);
01330     
01331     firstword (bs, '\t', bs);
01332     
01333     stringtonumber (bs, &n);
01334     
01335     return (max (n / serialinterval, ct));
01336     } /*nextserialnum*/
01337     
01338     
01339 static boolean serialstring (hdlhashtable ht, bigstring serializedname) {
01340     
01341     /*
01342     on serialstring () { //return a serial number string for an about-to-be-created object
01343         return (string.padwithzeros (sizeof (nomad^) + 1, 4) + "\t")};
01344     
01345     5.1.3 dmb: make serial strings 8 digits, with 3 trailing zeros
01346     */
01347     
01348     long ct;
01349     
01350     //hashcountitems (ht, &ct);
01351     ct = nextserialnum (ht);
01352     
01353     numbertostring (ct + 1, serializedname);
01354     
01355     while (stringlength (serializedname) < 5)
01356         insertchar ('0', serializedname);
01357     
01358     pushstring (BIGSTRING ("\x04" "000\t"), serializedname);
01359     
01360     return (true);
01361     } /*serialstring*/
01362 
01363 
01364 static void getnewitemaddress (hdlhashtable ht, bigstring bs, xmladdress *adr) {
01365 
01366     /*
01367     on newitemaddress () { //this code was turning up all over
01368         return (@nomad^.[serialstring () + token.tokenstring])};
01369     */
01370     
01371     (*adr).ht = ht;
01372     
01373     serialstring (ht, (*adr).bs);
01374     
01375     pushstring (bs, (*adr).bs);
01376     } /*getnewitemaddress*/
01377 
01378 
01379 static boolean assignemptytag (hdlhashtable htable, bigstring bstoken, xmltoken *tagtoken) {
01380 
01381     //  if defined (token.atts)
01382     //      new (tabletype, adrnewitem)
01383     //      adrnewitem^.["/contents"] = ""
01384     //      adrnewitem^.["/atts"] = token.atts
01385     //  else
01386     //      adrnewitem^ = ""
01387     
01388     xmladdress adrnewitem;
01389     hdlhashtable newitemtable;
01390     
01391     getnewitemaddress (htable, bstoken, &adrnewitem);
01392     
01393     if ((*tagtoken).atts != nil) {
01394         
01395         if (!createtokentable (&adrnewitem, tagtoken, &newitemtable))
01396             return (false);
01397         
01398         if (!langassignstringvalue (newitemtable, STR_pcdata, zerostring))
01399             return (false);
01400         }
01401     else {
01402         if (!langassignstringvalue (adrnewitem.ht, adrnewitem.bs, zerostring))
01403             return (false);
01404         }
01405     
01406     return (true);
01407     } /*assignemptytag*/
01408                     
01409 
01410 static boolean assignstringtag (hdlhashtable htable, bigstring bstoken, xmltoken *tagtoken, xmltoken *elementtoken) {
01411     
01412     xmladdress adrnewitem;
01413     hdlhashtable newitemtable;
01414     
01415     // local (adrnewitem = newitemaddress ())
01416     getnewitemaddress (htable, bstoken, &adrnewitem);
01417     
01418     // if defined (token.atts)
01419     if ((*tagtoken).atts != nil) {
01420     
01421         // new (tabletype, adrnewitem)
01422         if (!createtokentable (&adrnewitem, tagtoken, &newitemtable))
01423             return (false);
01424         
01425         // adrnewitem^.["/contents"] = lookaheadtoken.tokenstring
01426         if ((*elementtoken).isCDATA) {
01427             
01428             if (!assigntokenstringvalue (newitemtable, STR_cdata, elementtoken))
01429                 return (false);
01430             }
01431         else {
01432             if (!assigntokenstringvalue (newitemtable, STR_pcdata, elementtoken))
01433                 return (false);
01434             }
01435         }
01436     else {
01437         // adrnewitem^ = lookaheadtoken.tokenstring;
01438         if (!assigntokenstringvalue (adrnewitem.ht, adrnewitem.bs, elementtoken))
01439             return (false);
01440         }
01441     
01442     return (true);
01443     } /*assignstringtag*/
01444 
01445 
01446 static void langparamerrormessage (short num, const bigstring bs, const bigstring bs1, long pos) {
01447     
01448     /*
01449     5.1.3 dmb: take and report error position
01450     */
01451     
01452     bigstring bs2, bs3, bspos;
01453     
01454     parsedialogstring (bs, (ptrstring) bs1, nil, nil, nil, bs2);
01455     
01456     getstringlist (langerrorlist, num, bs3);
01457     
01458     parsedialogstring (bs3, bs2, nil, nil, nil, bs3);
01459     
01460     numbertostring (pos, bspos);
01461     
01462     parsedialogstring (STR_atcharacteroffset, bspos, nil, nil, nil, bs2);
01463     
01464     pushstring (bs2, bs3);
01465     
01466     langerrormessage (bs3);
01467     } /*langparamerrormessage*/
01468 
01469 
01470 static void push2digitnum (int n, bigstring s) {
01471 
01472     bigstring bsint;
01473     
01474     numbertostring (n, bsint);
01475     
01476     if (stringlength (bsint) == 1)
01477         insertchar ('0', bsint);
01478     
01479     pushstring (bsint, s);
01480     } /*push2digitnum*/
01481 
01482 
01483 static void getiso8601datetimestring (unsigned long secs, bigstring bs) {
01484     
01485     /*
01486     6.1b2 AR: Return seconds as a two-digit number, too.
01487     */
01488 
01489     //  return (string (year) + string.padWithZeros(month, 2) + string.padWithZeros(day, 2) +"T"+ string.padWithZeros(hour, 2)+":"+ string.padWithZeros(minute, 2)+":"+second;
01490     
01491     short day, month, year, hour, minute, second;
01492     
01493     secondstodatetime (secs, &day, &month, &year, &hour, &minute, &second);
01494     
01495     shorttostring (year, bs);
01496     push2digitnum (month, bs);
01497     push2digitnum (day, bs);
01498     
01499     pushchar ('T', bs);
01500     
01501     push2digitnum (hour, bs);
01502     pushchar (':', bs);
01503     
01504     push2digitnum (minute, bs);
01505     pushchar (':', bs);
01506 
01507     //pushint (second, bs);
01508     push2digitnum (second, bs);
01509     } /*getiso8601datetimestring*/
01510 
01511 
01512 static void setiso8601datetimestring (bigstring bsiso8601, unsigned long *secs) {
01513 
01514     //  19980616T09:54:52
01515     
01516     short day, month, year, hour, minute, second;
01517     bigstring bs;
01518     
01519     midstring (bsiso8601, 1, 4, bs);
01520     stringtoshort (bs, &year);
01521     
01522     midstring (bsiso8601, 5, 2, bs);
01523     stringtoshort (bs, &month);
01524     
01525     midstring (bsiso8601, 7, 2, bs);
01526     stringtoshort (bs, &day);
01527     
01528     midstring (bsiso8601, 10, 2, bs);
01529     stringtoshort (bs, &hour);
01530     
01531     midstring (bsiso8601, 13, 2, bs);
01532     stringtoshort (bs, &minute);
01533     
01534     midstring (bsiso8601, 16, 2, bs);
01535     stringtoshort (bs, &second);
01536     
01537     *secs = datetimetoseconds (day, month, year, hour, minute, second);
01538     } /*setiso8601datetimestring*/
01539 
01540 
01541 #define scriptError(n, s, x, pos) do {langparamerrormessage (n, s, x, pos); goto exit;} while (0)
01542 
01543 
01544 static boolean findinhandlestream (handlestream *s, bigstring bsfind, boolean flunicase) {
01545     
01546     byte *p = (byte *) (*(*s).data);
01547     long ix;
01548     
01549     ix = textpatternmatch (p + (*s).pos, (*s).eof - (*s).pos, bsfind, flunicase);
01550     
01551     if (ix < 0)
01552         return (false);
01553     
01554     (*s).pos += ix;
01555     
01556     return (true);
01557     } /*findinhandlestream*/
01558 
01559 
01560 static boolean athandlestreamstring (handlestream *s, bigstring bs) {
01561     
01562     /*
01563     5.1.4 dmb: return true if the next bytes of the stream match bs
01564     */
01565     
01566     bigstring bstemp;
01567     long ixtemp = (*s).pos;
01568     
01569     if (loadfromhandle ((*s).data, &ixtemp, stringlength (bs), stringbaseaddress (bstemp))) {
01570         
01571         setstringlength (bstemp, stringlength (bs));
01572         
01573         return (equalidentifiers (bstemp, bs));
01574         }
01575         
01576     return (false);
01577     } /*athandlestreamstring*/
01578 
01579 
01580 static boolean getnexttoken (handlestream *source, hdlhashtable namespaces, xmltoken *adrtoken) {
01581     
01582     /*
01583     on getNextToken (adrtoken) {
01584     
01585     5.1.3 dmb: accept single or double quoted strings; ignore !DOCTYPE tags
01586     
01587     5.1.4 dmb: smarter doctype, comment and processing instruction parsing; handle
01588     any whitespace, not just chspace.
01589 
01590     6.2a9 AR: Decode &lt; before &amp; and pop trailing whitespace from attribute names
01591     
01592     6.2b10 AR: Decode &gt; in CDATA sections
01593     */
01594     
01595     handlestream *x = source;
01596     Handle tokenstring = nil;
01597     boolean fl = false;
01598     byte bsendtag [16];
01599     #undef getchar
01600     #define getchar(x) ((*(*x).data) [(*x).pos])
01601     #define nextchar(x) ((*(*x).data) [(*x).pos+1])
01602     #define getnextchar(x) ((*(*x).data) [++(*x).pos])
01603     
01604     disposexmltoken (adrtoken);
01605     
01606     while (true) { //skip white space
01607         byte ch;
01608         
01609         if ((*x).pos >= (*x).eof)
01610             return (false);
01611         
01612         ch = getchar (x);
01613         
01614         if ((ch != '\r') && (ch != '\n') && (ch != '\t') && (ch != ' '))
01615             break;
01616         
01617         ++(*x).pos;
01618         }
01619     
01620     (*adrtoken).pos = (*x).pos;
01621     
01622     if (getchar (x) == '<') {
01623         long ixstart, ixtemp;
01624         bigstring bstag;
01625         byte ch;
01626         
01627         if ((*x).pos == (*x).eof)
01628             scriptError (badxmltexterror, STR_cantendwithLT, nil, (*x).pos);
01629         
01630         (*adrtoken).isTag = true;
01631         
01632         copystring (STR_endtag, bsendtag);
01633         
01634         ch = nextchar(x);
01635         
01636         if (ch == '/') {
01637             
01638             (*adrtoken).openTag = false;
01639             
01640             ++(*x).pos;
01641             }
01642         else {
01643             
01644             (*adrtoken).openTag = true;
01645             
01646             ixtemp = (*x).pos;
01647             
01648             if (athandlestreamstring (x, STR_startCDATA)) {
01649                 
01650                 (*adrtoken).isTag = false;
01651                 
01652                 (*adrtoken).isCDATA = true;
01653                 
01654                 (*x).pos += stringlength (STR_startCDATA) - 1; // we've already read the 1st char
01655                 
01656                 copystring (STR_endCDATA, bsendtag);
01657                 }
01658             else if (athandlestreamstring (x, STR_startcomment)) {
01659                 
01660                 //(*adrtoken).isTag = false;
01661                 
01662                 (*adrtoken).isComment = true;
01663                 
01664                 (*x).pos += stringlength (STR_startcomment) - 1;
01665                 
01666                 copystring (STR_endcomment, bsendtag);
01667                 }
01668             else if (athandlestreamstring (x, STR_startdoctype)) {
01669                 
01670                 (*adrtoken).isDoctype = true;
01671                 
01672                 (*x).pos += stringlength (STR_startdoctype) - 1;
01673                 }
01674             }
01675         
01676         ixstart = (*x).pos + 1;
01677         
01678         //find the end of the tag
01679         if (!findinhandlestream (x, bsendtag, false))
01680             scriptError (badxmltexterror, STR_didntfindGTafterLT, nil, (*adrtoken).pos);
01681         
01682         ixtemp = ixstart;
01683         
01684         if (!loadfromhandletohandle ((*x).data, &ixtemp, (*x).pos - ixstart, true, &tokenstring))
01685             goto exit;
01686         
01687         (*x).pos += stringlength (bsendtag); //point past the ">" or "]]>"
01688         
01689         if ((*adrtoken).isCDATA) { // take it literally and return
01690         
01691             (*adrtoken).tokenstring = tokenstring;
01692             
01693             return (true);
01694             }
01695         
01696         //if (handlebeginswith (tokenstring, "\x03" "!--") && handleendswith (tokenstring, "\x02" "--")) 
01697         if ((*adrtoken).isComment) {
01698             
01699             /*
01700             disposehandle (tokenstring);
01701             
01702             return (getnexttoken (source, namespaces, adrtoken)); //recurse
01703             */
01704             
01705             (*adrtoken).isComment = true;
01706             
01707             (*adrtoken).tokenstring = tokenstring;
01708             
01709             return (true);
01710             }
01711         
01712         if ((*adrtoken).isDoctype) { //it's for validating parsers
01713             
01714             if (handlecontains (tokenstring, BIGSTRING ("\x01" "[")) && !handlecontains (tokenstring, BIGSTRING ("\x01" "]"))) { // didn't read far enough, 
01715             
01716                 // skip to end of [decls]
01717                 if (!findinhandlestream (x, BIGSTRING ("\x01" "]"), false))
01718                     scriptError (badxmltexterror, STR_didntfindGTafterLT, nil, (*adrtoken).pos);
01719                 
01720                 // now skip to true end of tag
01721                 if (!findinhandlestream (x, bsendtag, false))
01722                     scriptError (badxmltexterror, STR_didntfindGTafterLT, nil, (*adrtoken).pos);
01723                 
01724                 // rebuild the token handle
01725                 disposehandle (tokenstring);
01726                 
01727                 ixtemp = ixstart;
01728                 
01729                 if (!loadfromhandletohandle ((*x).data, &ixtemp, (*x).pos - ixstart, true, &tokenstring))
01730                     goto exit;
01731                 
01732                 (*x).pos += stringlength (bsendtag); //point past the ">"
01733                 }
01734             
01735             (*adrtoken).tokenstring = tokenstring;
01736             
01737             return (true);
01738             }
01739         
01740         texthandletostring (tokenstring, bstag); // tags should be < 255 chars
01741         
01742         if (breakatfirstwhitespacechar (bstag)) { // has attributes, or is a processing instruction
01743         
01744             handlestream s;
01745             
01746             if (!tablenewtablevalue (&(*adrtoken).atts, &(*adrtoken).attsvalue))
01747                 goto exit;
01748             
01749             if (!newtexthandle (bstag, &(*adrtoken).tokenstring))
01750                 goto exit;
01751             
01752             openhandlestream (tokenstring, &s);
01753             pullfromhandlestream (&s, stringlength (bstag), nil);
01754             
01755             if (getstringcharacter (bstag, 0) == '?') {
01756                 
01757                 if (lasthandlestreamcharacter (&s) != '?')
01758                     scriptError (badxmltexterror, STR_tagmustbeofform, nil, (*adrtoken).pos);
01759                 
01760                 (*adrtoken).isPI = true;
01761                 
01762                 s.eof--;
01763                 }
01764             
01765             if (lasthandlestreamcharacter (&s) == '/') {
01766             
01767                 pushtexthandle (BIGSTRING ("\x01" "/"), (*adrtoken).tokenstring);
01768                 
01769                 s.eof--;
01770                 }
01771             
01772             while (true) {
01773                 bigstring attname;
01774                 byte chquote;
01775                 
01776                 skiphandlestreamwhitespace (&s);
01777                 
01778                 if (athandlestreameof (&s))
01779                     break;
01780                 
01781                 readhandlestreamfield (&s, '=', attname);
01782                 
01783                 if (isemptystring (attname))
01784                     break;
01785                 
01786                 poptrailingwhitespace (attname); /*6.2a9 AR*/
01787                 
01788                 skiphandlestreamwhitespace (&s);
01789                 
01790                 if ((*adrtoken).isPI && athandlestreameof (&s)) { // a processing instruction w/out assignment
01791 
01792                     if (!langassignstringvalue ((*adrtoken).atts, STR_pi, attname))
01793                         goto exit;
01794                     }
01795                 else {
01796                     Handle hattval;
01797                     
01798                     chquote = nexthandlestreamcharacter (&s);
01799                     
01800                     if (chquote != '"' && chquote != '\'')
01801                         scriptError (badxmltexterror, STR_improperlyformatted, nil, (*adrtoken).pos + stringlength (bstag) + s.pos);
01802                     
01803                     s.pos++;
01804                     
01805                     if (!readhandlestreamfieldtohandle (&s, chquote, &hattval))
01806                         goto exit;
01807                     
01808                     if (gethandlestreamcharacter (&s, s.pos - 1) != chquote) {
01809                     
01810                         disposehandle (hattval);
01811                         
01812                         scriptError (badxmltexterror, STR_improperlyformatted, nil, (*adrtoken).pos + s.pos);
01813                         }
01814 
01815                     if (!langassigntextvalue ((*adrtoken).atts, attname, hattval))
01816                         goto exit;
01817                     }
01818                 }
01819             }
01820     
01821         else {
01822             (*adrtoken).tokenstring = tokenstring;
01823             tokenstring = nil;
01824             }
01825         }
01826     else {
01827         long ixstart = (*x).pos;
01828         
01829         (*adrtoken).isTag = false;
01830         
01831         while (true) {
01832             if (getchar (x) == '<') {
01833                 
01834                 if (!loadfromhandletohandle ((*x).data, &ixstart, (*x).pos - ixstart, true, &(*adrtoken).tokenstring))
01835                     goto exit;
01836                 
01837                 break;
01838                 }
01839             
01840             if ((*x).pos++ == (*x).eof)
01841                 scriptError (badxmltexterror, STR_itmustendwithtag, nil, (*x).pos);
01842             }
01843         }
01844     
01845     if ((*adrtoken).isTag) { //check tokenstring for namespaces
01846     
01847         if (handlecontains ((*adrtoken).tokenstring, BIGSTRING ("\x01" ":")) && !handlebeginswith ((*adrtoken).tokenstring, BIGSTRING ("\x01" "?"))) {
01848         
01849             bigstring shortname, longname;
01850             
01851             texthandletostring ((*adrtoken).tokenstring, shortname);
01852             
01853             firstword (shortname, ':', shortname);
01854             
01855             copystring (shortname, longname);
01856             
01857             pushchar (':', longname);
01858             
01859             lookupstringvalue (namespaces, shortname, longname);
01860         
01861             if ((*adrtoken).atts == nil) {
01862                 
01863                 if (!tablenewtablevalue (&(*adrtoken).atts, &(*adrtoken).attsvalue))
01864                     goto exit;
01865                 }
01866             
01867             if (!langassignstringvalue ((*adrtoken).atts, STR_namespace, longname))
01868                 goto exit;
01869             
01870             bundle {
01871                 Handle h = (*adrtoken).tokenstring;
01872                 long ctbytes = gethandlesize ((*adrtoken).tokenstring);
01873                 long ixword, lenword;
01874             
01875                 if (!textnthword ((ptrbyte)(*h), ctbytes, 2, ':', true, &ixword, &lenword))
01876                     sethandlesize (h, 0);
01877                 else {
01878                     
01879                     popfromhandle (h, ctbytes - (ixword + lenword), nil);
01880                     
01881                     pullfromhandle (h, 0, ixword, nil);
01882                     }
01883                 }
01884             }
01885         
01886         if (!replaceallinhandle (BIGSTRING ("\x04" "&gt;"), BIGSTRING ("\x01" ">"), (*adrtoken).tokenstring))
01887             return (false);
01888         }
01889     else { //not a tag
01890         
01891         trimtrailingwhitespace ((*adrtoken).tokenstring);
01892         
01893         if (!replaceallinhandle (BIGSTRING ("\x06" "]]&gt;"), BIGSTRING ("\x03" "]]>"), (*adrtoken).tokenstring))
01894             return (false);
01895         }
01896 
01897     if (!(*adrtoken).isCDATA) { // always true; we bail early for cdata
01898         
01899         if (!replaceallinhandle (BIGSTRING ("\x04" "&lt;"), BIGSTRING ("\x01" "<"), (*adrtoken).tokenstring))
01900             return (false);
01901         
01902         if (!replaceallinhandle (BIGSTRING ("\x04" "&gt;"), BIGSTRING ("\x01" ">"), (*adrtoken).tokenstring))
01903             return (false);
01904 
01905         if (!replaceallinhandle (BIGSTRING ("\x05" "&amp;"), BIGSTRING ("\x01" "&"), (*adrtoken).tokenstring))
01906             return (false);
01907         }
01908     
01909     fl = true;
01910     
01911     exit:
01912         disposehandle (tokenstring);
01913         
01914         return (fl);
01915     } /*getnexttoken*/
01916 
01917 
01918 #define compileall
01919 
01920 boolean xmlcompile (Handle htext, xmladdress *xmladr) {
01921     
01922     /*
01923     on compile (htext, adrtable) {
01924         «An XML compiler running in Frontier 5
01925             «Original code, Dave Winer, 12/4/97
01926             «Rewritten, Dave Winer, 3/19/98
01927         
01928         5.0.2b8 dmb: coded in C
01929 
01930         5.1 dmb: fixed memory leak
01931         
01932         5.1.3 dmb: handle cdata; multiple anomynous elements; fixed boolean bug
01933         
01934         5.1.4 dmb: smarter doctype, comment and processing instruction handling; 
01935         ready to create structure
01936         
01937         7.0b21 PBS: no longer static -- used by op<-->xml routines.
01938     */
01939     
01940     handlestream source;
01941     byte xmlversion [16] = "\x03" "0.0";
01942     xmladdress nomad = *xmladr;
01943     xmladdress adrnewitem;
01944     xmltoken token = {0}, lookaheadtoken = {0}, closetoken = {0};
01945     bigstring bstoken;
01946     boolean reuselookahead = false;
01947     hdlhashtable namespaces;
01948     boolean fl = false; //success?
01949     //hdlhashtable newitemtable;
01950     hdlhashtable nomadtable;
01951     hdlhashnode hnode;
01952     //long ixsleep = 0;
01953     long lastsleeptickcount = gettickcount ();
01954     long ticksbetweensleeps = 60; /*one second*/
01955     long tickcount;
01956     
01957     openhandlestream (htext, &source);
01958     
01959     if (!langassignnewtablevalue ((*xmladr).ht, (*xmladr).bs, &nomadtable))
01960         return (false);
01961     
01962     assert ((**nomadtable).parenthashtable == (*xmladr).ht);
01963     
01964     if (!newxmltoken (&token) || !newxmltoken (&lookaheadtoken) || !newxmltoken (&closetoken))
01965         goto exit;
01966     
01967     if (!newhashtable (&namespaces))
01968         goto exit;
01969     
01970     while (true) {
01971 
01972         if (!inmainthread () && !debuggingcurrentprocess ()) { /*PBS 7.1b25: sleep some, once a second*/
01973 
01974             tickcount = gettickcount ();
01975 
01976             if (tickcount >= lastsleeptickcount + ticksbetweensleeps) {
01977 
01978                 lastsleeptickcount = tickcount;
01979 
01980                 processsleep (getcurrentthread (), 0);
01981                 } /*if*/
01982             } /*if*/
01983 
01984         if (reuselookahead) {
01985             
01986             assignxmltoken (&token, &lookaheadtoken); // token = lookaheadtoken
01987             
01988             reuselookahead = false;
01989             }
01990         else {
01991             // if not getNextToken (@token)
01992             if (!getnexttoken (&source, namespaces, &token)) { //no more tokens left, parsing is finished
01993                 
01994                 fl = true;
01995                 
01996                 break;
01997                 }
01998             };
01999         
02000         texthandletostring (token.tokenstring, bstoken);
02001         
02002         if (token.isPI) {
02003             
02004             if (equalidentifiers (bstoken, STR_xmldecl))
02005                 lookupstringvalue (token.atts, STR_version, xmlversion);
02006             
02007             else if (equalidentifiers (bstoken, STR_xmlnamespace)) { // "?xml:namespace"
02008                 
02009                 bigstring prefix, ns;
02010             
02011                 // namespaces.[token.atts.prefix] = token.atts.ns
02012                 if (lookupstringvalue (token.atts, STR_prefix, prefix) && lookupstringvalue (token.atts, BIGSTRING ("\x02" "ns"), ns)) {
02013                 
02014                     if (!langassignstringvalue (namespaces, prefix, ns))
02015                         goto exit;
02016                     }
02017                 else
02018                     scriptError (missingxmlattributeserror, zerostring, nil, token.pos);
02019                 }
02020             
02021             #ifdef compileall
02022             getnewitemaddress (nomadtable, bstoken, &adrnewitem);
02023             
02024             if (!hashtableassign (adrnewitem.ht, adrnewitem.bs, token.attsvalue))
02025                 return (false);
02026             
02027             token.atts = nil; // token doesn't own the table anymore
02028             #endif
02029             
02030             continue;
02031             }
02032         
02033         if (token.isDoctype) {
02034             
02035             #ifdef compileall
02036             getnewitemaddress (nomadtable, STR_doctype, &adrnewitem);
02037             
02038             if (!assigntokenstringvalue (adrnewitem.ht, adrnewitem.bs, &token))
02039                 return (false);
02040             #endif
02041             
02042             continue;
02043             }
02044         
02045         if (token.isComment) {
02046             
02047             #ifdef compileall
02048             getnewitemaddress (nomadtable, STR_comment, &adrnewitem);
02049             
02050             if (!assigntokenstringvalue (adrnewitem.ht, adrnewitem.bs, &token))
02051                 return (false);
02052             #endif
02053             
02054             continue;
02055             }
02056         
02057         if (token.isTag) {
02058             
02059             // if token.tokenstring beginswith '?'
02060             // assert (token.isPI == (getstringcharacter (bstoken, 0) == '?'));
02061             
02062             if (token.openTag) {
02063                 
02064                 if (lastchar (bstoken) == '/') { //self-contained empty tag, like <hello/>
02065                     
02066                     setstringlength (bstoken, stringlength (bstoken) - 1);
02067                     
02068                     if (!assignemptytag (nomadtable, bstoken, &token))
02069                         goto exit;
02070                     
02071                     assert (reuselookahead == false); // dmb: shouldn't need this anymore
02072                     }
02073                         
02074                 else {
02075                     if (!getnexttoken (&source, namespaces, &lookaheadtoken))
02076                         scriptError (badxmltexterror, STR_itcantendontag, nil, token.pos);
02077                     
02078                     if (lookaheadtoken.isTag) {
02079                         
02080                         if (lookaheadtoken.openTag) { //create a sub-table
02081                             
02082                             // nomad = newitemaddress ()
02083                             getnewitemaddress (nomadtable, bstoken, &nomad);
02084                             
02085                             // new (tabletype, nomad)
02086                             if (!createtokentable (&nomad, &token, &nomadtable))
02087                                 goto exit;
02088                             
02089                             assert ((**nomadtable).parenthashtable == nomad.ht);
02090                             
02091                             reuselookahead = true;
02092                             }
02093                 
02094                         else { // create an empty tag
02095                         
02096                             // if lookaheadtoken.tokenstring != token.tokenstring
02097                             if (!equalhandles (lookaheadtoken.tokenstring, token.tokenstring))
02098                                 scriptError (badxmltexterror, STR_wewereexpecting, bstoken, lookaheadtoken.pos);
02099                             
02100                             // newitemaddress ()^ = ""
02101                             if (!assignemptytag (nomadtable, bstoken, &token))
02102                                 goto exit;
02103                             
02104                             assert (reuselookahead == false); // dmb: shouldn't need this anymore
02105                             }
02106                         }
02107                     else { // lookahead is not a tag
02108                         
02109                         if (!getnexttoken (&source, namespaces, &closetoken))
02110                             scriptError (badxmltexterror, STR_itmustendwithtag, nil, source.pos);
02111                         
02114                     
02115                         if (!closetoken.isTag || closetoken.openTag) { // not closing, must add lookahead and reuse closetoken
02116                         
02117                             getnewitemaddress (nomadtable, bstoken, &nomad);
02118                             
02119                             if (!createtokentable (&nomad, &token, &nomadtable))
02120                                 goto exit;
02121                             
02122                             if (lookaheadtoken.isCDATA)
02123                                 getnewitemaddress (nomadtable, STR_cdata, &adrnewitem);
02124                             else
02125                                 getnewitemaddress (nomadtable, STR_pcdata, &adrnewitem);
02126                             
02127                             if (!assigntokenstringvalue (adrnewitem.ht, adrnewitem.bs, &lookaheadtoken))
02128                                 goto exit;
02129                             
02130                             assignxmltoken (&lookaheadtoken, &closetoken);
02131                             
02132                             reuselookahead = true;
02133                             }
02134                         else { // closing, must validate
02135 
02136                             if (!equalhandles (closetoken.tokenstring, token.tokenstring))
02137                                 scriptError (badxmltexterror, STR_wewereexpecting, bstoken, closetoken.pos);
02138                             
02139                             if (!assignstringtag (nomadtable, bstoken, &token, &lookaheadtoken))
02140                                 goto exit;
02141                             
02142                             reuselookahead = false; // dmb: shouldn't need this anymore
02143                             }
02144                         }
02145                     }
02146                 }
02147             else { // it's a close token, closing out a table
02148                 
02149                 bigstring bsnomad;
02150                 long ctitems;               
02151                 
02152                 //if (!inmainthread () && !debuggingcurrentprocess ()) { /*PBS 7.1b14: give up some time to other threads periodically.*/
02153 
02154                 /*  ixsleep++;
02155 
02156                     if (ixsleep == 500) {
02157 
02158                         ixsleep = 0;
02159                     
02160                         processsleep (getcurrentthread (), 0);
02161                         } /%if%/
02162                     } /%if%/
02163                 */
02164                 
02165                 // if nomad == adrtable
02166                 if (nomad.ht == (*xmladr).ht && equalstrings (nomad.bs, (*xmladr).bs))
02167                     scriptError (badxmltexterror, STR_toomanytags, nil, token.pos);
02168                 
02169                 // if namenomad () != token.tokenstring
02170                 namenomad (&nomad, bsnomad);
02171                 
02172                 if (!equalstrings (bsnomad, bstoken))
02173                     scriptError (badxmltexterror, STR_wewereexpectingtag, bstoken, token.pos);
02174                 
02175                 //if sizeOf (nomad^) == 1 //has one sub-item, maybe a special name?
02176                 //  «See //http://www.microsoft.com/standards/xml/xmldata.htm#ComplexTypes
02177                 //  local (adrsubitem, val, flspecialname = false, namesubitem)
02178                 //  adrsubitem = @nomad^ [1]
02179                 //  namesubitem = string.nthfield (nameof (adrsubitem^), '\t', 2)
02180                 
02181                 if (hashcountitems (nomadtable, &ctitems) && (ctitems == 1)) {
02182                     xmladdress adrsubitem;
02183                     tyvaluerecord val;
02184                     //boolean flspecialname = false;
02185                     bigstring namesubitem;
02186                     tyvaluetype specialtype;
02187                     
02188                     adrsubitem.ht = nomadtable;
02189                     gethashkey ((**nomadtable).hfirstsort, adrsubitem.bs);
02190                     
02191                     namenomad (&adrsubitem, namesubitem);
02192                     
02193                     //case namesubitem //is it a special name?
02194                     //  "boolean"
02195                     //      val = boolean (adrsubitem^)
02196                     //      flspecialname = true
02197                     //  "string"
02198                     //      val = string (adrsubitem^)
02199                     //      flspecialname = true
02200                     //  "int"
02201                     //  "i4"
02202                     //      val = long (adrsubitem^)
02203                     //      flspecialname = true
02204                     //  "i1"
02205                     //  "i2"
02206                     //      val = short (adrsubitem^)
02207                     //      flspecialname = true
02208                     //  "float"
02209                     //  "double"
02210                     //      val = double (adrsubitem^)
02211                     //      flspecialname = true
02212                     
02213                     specialtype = novaluetype;
02214                     
02215                     if (equalstrings (namesubitem, STR_boolean))
02216                         specialtype = booleanvaluetype;
02217                     
02218                     else if (equalstrings (namesubitem, STR_string))
02219                         specialtype = stringvaluetype;
02220                     
02221                     else if (equalstrings (namesubitem, STR_int) || equalstrings (namesubitem, STR_i4))
02222                         specialtype = longvaluetype;
02223                     
02224                     else if (equalstrings (namesubitem, STR_i1) || equalstrings (namesubitem, STR_i2))
02225                         specialtype = intvaluetype;
02226                     
02227                     else if (equalstrings (namesubitem, STR_float) || equalstrings (namesubitem, STR_double))
02228                         specialtype = doublevaluetype;
02229                     
02230                     else if (equalstrings (namesubitem, STR_datetimeiso8601)) {
02231                         bigstring bsiso8601;
02232                         unsigned long secs;
02233                         
02234                         if (!hashtablelookup (adrsubitem.ht, adrsubitem.bs, &val, &hnode))
02235                             goto exit;
02236                         
02237                         pullstringvalue (&val, bsiso8601);
02238                         
02239                         setiso8601datetimestring (bsiso8601, &secs);
02240                         
02241                         setdatevalue (secs, &val);
02242                         
02243                         if (!hashtableassign (nomad.ht, nomad.bs, val))
02244                             goto exit;
02245                         
02246                         exemptfromtmpstack (&val);
02247                         }
02248                     
02249                     if (specialtype != novaluetype) { // do table surgery, nomad changes from an XML table to a native Frontier type
02250                         
02251                         hashtablelookup (adrsubitem.ht, adrsubitem.bs, &val, &hnode);
02252                         
02253                         if (!copyvaluerecord (val, &val))
02254                             goto exit;
02255                         
02256                         if ((specialtype == booleanvaluetype) && (val.valuetype == stringvaluetype)) { // special case for booleans
02257                             
02258                             bigstring bs;
02259                             
02260                             pullstringvalue (&val, bs);
02261                             
02262                             if (isallnumeric (bs))
02263                                 if (!coercevalue (&val, longvaluetype)) // make sure that "0" and "0.0", etc. coece to false
02264                                     goto exit;
02265                             }
02266                         
02267                         if (!coercevalue (&val, specialtype))
02268                             goto exit;
02269                         
02270                         if (!hashtabledelete (nomad.ht, nomad.bs) || !hashtableassign (nomad.ht, nomad.bs, val))
02271                             goto exit;
02272                         
02273                         exemptfromtmpstack (&val);
02274                         }
02275                     }
02276                 
02277                 // nomad = parentof (nomad^);
02278                 nomadtable = nomad.ht;
02279                 
02280                 findinparenttable (nomadtable, &nomad.ht, nomad.bs);
02281                 }
02282             }
02283         else { // not a tag, add text to current table
02284         
02285             if (token.isCDATA)
02286                 getnewitemaddress (nomadtable, STR_cdata, &adrnewitem);
02287             else
02288                 getnewitemaddress (nomadtable, STR_pcdata, &adrnewitem);
02289             
02290             if (!assigntokenstringvalue (adrnewitem.ht, adrnewitem.bs, &token))
02291                 goto exit;
02292             }
02293         }
02294     
02295     exit:
02296     
02297     disposexmltoken (&token); disposexmltoken (&lookaheadtoken); disposexmltoken (&closetoken);
02298     
02299     if (!fl)
02300         hashtabledelete ((*xmladr).ht, (*xmladr).bs);
02301     
02302     disposehashtable (namespaces, true);
02303     
02304     return (fl);
02305     } /*xmlcompile*/
02306 
02307 
02308 boolean xmlgetname (bigstring bsname) {
02309     
02310     /*
02311     on getname (adr) {
02312         local (name = nameof (adr^));
02313         if name contains "\t" {
02314             return (string.nthfield (name, "\t", 2))}
02315         else {
02316             return (name)}};
02317     */
02318     
02319     if (stringfindchar ('\t', bsname))
02320         nthword (bsname, 2, '\t', bsname);
02321     
02322     replaceallinstring ('&', BIGSTRING ("\x05" "&amp;"), bsname);
02323     
02324     replaceallinstring ('<', BIGSTRING ("\x04" "&lt;"),  bsname);
02325     
02326     replaceallinstring ('>', BIGSTRING ("\x04" "&gt;"),  bsname);
02327     
02328     return (true);
02329     } /*xmlgetname*/
02330 
02331 
02332 static boolean xmlvaltostring (tyvaluerecord xmlval, short indentlevel, boolean fltranslatestrings, Handle *string) {
02333 #pragma unused(indentlevel)
02334 
02335     /*
02336     on valToString (val, indentlevel=0) { //http://www.microsoft.com/standards/xml/xmldata.htm#ComplexTypes
02337         «Return an XML-Data representation of a Frontier value
02338             «We only support a small subset of the types that XML-Data specifies.
02339             «If we get a type that's not supported, we throw an error.
02340             «The caller is expected to watch for this, within a try statement.
02341     
02342     5.1.3 dmb: don't add <string> tags to string values. it's the default type; added fltranslatestrings
02343     
02344     6.2b10 AR: No longer emit <i2> tags -- they never made it into the XML-RPC spec
02345     */
02346     
02347 //  bigstring bsindent;
02348 //  #define add(s) do {filledstring ('\t', indentlevel, bsindent); 
02349 
02350     tyvaluerecord val;
02351     bigstring bstag, bsval, bsxml;
02352     
02353     assert (!xmlval.fldiskval); /*08/04/2000 AR*/
02354 
02355     if (!copyvaluerecord (xmlval, &val))
02356         return (false);
02357     
02358     switch (val.valuetype) {
02359                 
02360         //  stringType
02361         //      return ("<string>"+ val + "</string>")
02362         case stringvaluetype:
02363             // copystring (STR_string, bstag)
02364             // break
02365             
02366             if (fltranslatestrings) {
02367                 
02368                 if (!replaceallinhandle (BIGSTRING ("\x01" "&"), BIGSTRING ("\x05" "&amp;"), val.data.stringvalue))
02369                     return (false);
02370                 
02371                 if (!replaceallinhandle (BIGSTRING ("\x01" "<"), BIGSTRING ("\x04" "&lt;"), val.data.stringvalue))
02372                     return (false);
02373                 
02374                 if (!replaceallinhandle (BIGSTRING ("\x03" "]]>"), BIGSTRING ("\x06" "]]&gt;"), val.data.stringvalue))
02375                     return (false);
02376                 }
02377             
02378             exemptfromtmpstack (&val);
02379             
02380             *string = val.data.stringvalue;
02381             
02382             return (true);
02383         
02384         //  binaryType
02385         //      return ("<base64>" + base64.encode (val, 0) + "</base64>")
02386         case binaryvaluetype: {
02387             Handle h64;
02388             
02389             if (!coercetostring (&val))
02390                 return (false);
02391             
02392             if (!newemptyhandle (&h64))
02393                 return (false);
02394             
02395             if (!base64encodehandle (val.data.stringvalue, h64, 0)
02396                     || !inserttextinhandle (h64, 0, STR_base64_begin)
02397                     || !pushtexthandle (STR_base64_end, h64)) {
02398 
02399                 disposehandle (h64);
02400                 
02401                 return (false);
02402                 }
02403             
02404             *string = h64;
02405             
02406             return (true);
02407             }
02408         
02409         //  longType //a 32-bit signed integer
02410         //      return ("<i4>" + val + "</i4>")
02411         case intvaluetype:
02412         case longvaluetype:
02413             copystring (STR_i4, bstag);
02414             break;
02415         
02416         //  shortType //a 16-bit signed integer
02417         //      return ("<i2>" + val + "</i2>")
02418         /*
02419         case intvaluetype:
02420             copystring (STR_i2, bstag);
02421             break;
02422         */
02423 
02424         //  doubleType
02425         //      return ("<double>" + val + "</double>")
02426         case doublevaluetype:
02427             copystring (STR_double, bstag);
02428             break;
02429         
02430         //  booleanType
02431         //      local (bit)
02432         //      if val
02433         //          bit = 1
02434         //      else
02435         //          bit = 0
02436         //      return ("<boolean>" + bit + "</boolean>")
02437         case booleanvaluetype:
02438             coercetolong (&val); // [force string coercsion to get {1, 0}, not {true, false}]
02439             copystring (STR_boolean, bstag);
02440             break;
02441         
02442         //  dateType
02443         //      local
02444         //          year, month, day, hour, minute, second
02445         //      date.get (val, @day, @month, @year, @hour, @minute, @second
02446         //      return ("<dateTime.iso8601>" + string (year) + string.padWithZeros(month, 2) + string.padWithZeros(day, 2) +"T"+ string.padWithZeros(hour, 2)+":"+ string.padWithZeros(minute, 2)+":"+second + "</dateTime.iso8601>")
02447         case datevaluetype:
02448             getiso8601datetimestring (val.data.datevalue, bsval);
02449             
02450             copystring (STR_datetimeiso8601, bstag);
02451             
02452             parsedialogstring (BIGSTRING ("\x0b" "<^0>^1</^0>"), bstag, bsval, nil, nil, bsxml);
02453             
02454             return (newtexthandle (bsxml, string));
02455         
02456         //  local (s = "Can't process the request because a Frontier value of type \"")
02457         //  s = s + string (typeof (val)) + "\" can't be represented in XML-Data at this time."
02458         //  scriptError (s)
02459         default:
02460             langgettypestring (val.valuetype, bsval);
02461             
02462             langparamerror (frontierxmldatatypeerror, bsval);
02463             
02464             return (false);
02465         }
02466     
02467     if (!coercetostring (&val))
02468         return (false);
02469     
02470     insertchar ('<', bstag);
02471     pushchar ('>', bstag);
02472     
02473     if (!newtexthandle (bstag, string))
02474         return (false);
02475     
02476     if (!pushhandle (val.data.stringvalue, *string))
02477         return (false);
02478     
02479     midinsertstring (BIGSTRING ("\x01" "/"), bstag, 2);
02480      
02481     return (pushtexthandle (bstag, *string));
02482     } /*xmlvaltostring*/
02483 
02484 
02485 static boolean xmladdstring (bigstring bs, Handle h, short indentlevel, handlestream *xmltext) {
02486     
02487     /*
02488     write _either_ the string or the handle to the stream
02489     
02490     on add (s) {
02491         xmltext = xmltext + string.filledstring ("\t", indentlevel) + s + "\r\n"};
02492     */
02493     
02494     bigstring bsindent;
02495     boolean fl;
02496     
02497     filledstring ('\t', indentlevel, bsindent);
02498     
02499     if (!writehandlestreamstring (xmltext, bsindent))
02500         return (false);
02501     
02502     if (h != nil)
02503         fl = writehandlestreamhandle (xmltext, h);
02504     else
02505         fl = writehandlestreamstring (xmltext, bs);
02506     
02507     return (fl && writehandlestreamstring (xmltext, BIGSTRING ("\x02\r\n")));
02508     } /*xmladdstring*/
02509 
02510 
02511 boolean gethashnodetable (hdlhashnode hn, hdlhashtable *ht) {
02512 
02513     bigstring bsname;
02514     
02515     if (hn && langexternalvaltotable ((**hn).val, ht, hn))
02516         return (true);
02517     
02518     if (hn == nil)
02519         langgetmiscstring (nilstring, bsname);
02520     else
02521         gethashkey (hn, bsname);
02522     
02523     langparamerror (cantdecompilerror, bsname);
02524     
02525     return (false);
02526     } /*gethashnodetable*/
02527 
02528 
02529 static boolean decompilespecialtable (hdlhashtable ht, Handle *hnamevalpairs, bigstring bsspecial, Handle *hspecial, boolean flwantleadingspace) {
02530     
02531     /*
02532     5.1.4 dmb: for /attr and PI tables, decompile all items into name=val expressions, 
02533     except for the item potentially named bsspecial, whose value is saved separately
02534     */
02535     
02536     hdlhashnode hn;
02537     bigstring attname;
02538     tyvaluerecord attvalue;
02539     tyvaluerecord specialval = {novaluetype};
02540     Handle attstring = nil;
02541     hdldatabaserecord hdb = tablegetdatabase (ht);
02542     boolean fl;
02543         
02544     for (hn = (**ht).hfirstsort; hn != nil; hn = (**hn).sortedlink) {
02545         
02546         gethashkey (hn, attname);
02547         
02548         if (hdb)
02549             dbpushdatabase (hdb);
02550         
02551         fl = copyvaluerecord ((**hn).val, &attvalue) && coercetostring (&attvalue);
02552         
02553         if (hdb)
02554             dbpopdatabase ();
02555 
02556         if (!fl) {
02557             
02558             disposehandle (attstring);
02559             
02560             return (false);
02561             }
02562         
02563         if (equalidentifiers (attname, bsspecial)) {
02564             
02565             specialval = attvalue;
02566             }
02567         else {
02568             pushstring (BIGSTRING ("\x02" "=\""), attname);
02569             
02570             if (flwantleadingspace || attstring != nil)
02571                 insertchar (' ', attname);
02572             
02573             if (attstring == nil)
02574                 newtexthandle (attname, &attstring);
02575             else
02576                 pushtexthandle (attname, attstring);
02577             
02578             pushhandle (attvalue.data.stringvalue, attstring);
02579             
02580             pushtexthandle (BIGSTRING ("\x01" "\""), attstring);
02581             
02582             disposevaluerecord (attvalue, false);
02583             }
02584         }
02585     
02586     *hnamevalpairs = attstring;
02587     
02588     if (specialval.valuetype != novaluetype) {
02589     
02590         *hspecial = specialval.data.stringvalue; 
02591         
02592         exemptfromtmpstack (&specialval);
02593         }
02594     
02595     return (true);
02596     } /*decompilespecialtable*/
02597 
02598 static boolean decompilevisit (hdlhashtable adrtable, bigstring nametable, short indentlevel, handlestream *xmltext) {
02599     
02600     /*
02601     on visit (adrtable) {
02602     
02603     5.1.3 dmb: don't prettyprint terminal data nodes; strings no longer have type tags
02604     handle cdata nodes.
02605     
02606     5.1.4 dmb: decompile comments, pis, doctypes
02607     */
02608     
02609     Handle namespace = nil, attstring = nil, opentag = nil, hadd = nil;
02610     hdlhashtable adratts;
02611     hdlhashnode hn;
02612     hdlhashtable ht;
02613     bigstring bsadd;
02614     tyvaluerecord contentsval;
02615     boolean fl = false;
02616     
02617     xmlgetname (nametable);
02618     
02619     //  if defined (adratts^) {
02620     if (hashtablelookupnode (adrtable, STR_atts, &hn)) {
02621         
02622         if (!gethashnodetable (hn, &adratts))
02623             return (false);
02624         
02625         //  local (i, ct = sizeof (adratts^), adratt);
02626         //  for i = 1 to ct {
02627         //      adratt = @adratts^ [i];
02628         //      if nameof (adratt^) == "namespace" {
02629         //          namespace = adratt^}
02630         //      else {
02631         //          attstring = attstring + " " + nameof (adratt^) + "=\"" + adratt^ + "\""}}};
02632         
02633         #ifdef compileall
02634         if (!decompilespecialtable (adratts, &attstring, STR_namespace, &namespace, true))
02635             goto exit;
02636         #else
02637         for (hn = (**adratts).hfirstsort; hn != nil; hn = (**hn).sortedlink) {
02638             
02639             bigstring attname;
02640             tyvaluerecord attvalue;
02641             
02642             gethashkey (hn, attname);
02643             
02644             if (!copyvaluerecord ((**hn).val, &attvalue) || !coercetostring (&attvalue))
02645                 goto exit;
02646             
02647             if (equalidentifiers (attname, STR_namespace)) {
02648                 
02649                 namespace = attvalue.data.stringvalue; 
02650                 
02651                 exemptfromtmpstack (&attvalue);
02652                 }
02653             else {
02654                 insertchar (' ', attname);
02655                 
02656                 pushstring (BIGSTRING ("\x02" "=\""), attname);
02657                 
02658                 if (attstring == nil)
02659                     newtexthandle (attname, &attstring);
02660                 else
02661                     pushtexthandle (attname, attstring);
02662                 
02663                 pushhandle (attvalue.data.stringvalue, attstring);
02664                 
02665                 pushtexthandle (BIGSTRING ("\x01" "\""), attstring);
02666                 
02667                 disposevaluerecord (attvalue, false);
02668                 }
02669             }
02670         #endif
02671         }
02672         
02673     //  local (opentag = "<");
02674     //  if namespace != "" {
02675     //      opentag = opentag + namespace};
02676     //  opentag = opentag + nametable + attstring + ">";
02677     
02678     newtexthandle (BIGSTRING ("\x01" "<"), &opentag);
02679     
02680     if (namespace != nil)
02681         pushhandle (namespace, opentag);
02682     
02683     pushtexthandle (nametable, opentag);
02684     pushhandle (attstring, opentag);
02685     pushtexthandle (BIGSTRING ("\x01" ">"), opentag);
02686     
02687     //  local (adrcontents = @adrtable^.["/contents"]);
02688     //  if defined (adrcontents^) {
02689     //      add (opentag + adrcontents^ + "</" + namespace + nametable + ">");
02690     //      return};
02691     
02692     // if there's just a pcdata subnode, unserialized, merge into single tag
02693     if (hashtablelookupnode (adrtable, STR_pcdata, &hn) || hashtablelookupnode (adrtable, STR_contents, &hn)) {
02694         
02695         if (!copyvaluerecord ((**hn).val, &contentsval) || !coercetostring (&contentsval))
02696             goto exit;
02697         
02698         if (!pushhandle (contentsval.data.stringvalue, opentag))
02699             goto exit;
02700         
02701         disposevaluerecord (contentsval, false);
02702         
02703         pushtexthandle (BIGSTRING ("\x02" "</"), opentag);
02704         
02705         if (!pushhandle (namespace, opentag))
02706             goto exit;
02707         
02708         pushchar ('>', nametable);
02709         
02710         if (!pushtexthandle (nametable, opentag))
02711             goto exit;
02712         
02713         fl = xmladdstring (nil, opentag, indentlevel, xmltext);
02714         
02715         goto exit;
02716         }
02717     
02718     //  add (opentag); indentlevel++;
02719     #ifdef compileall
02720     if (indentlevel < 0)
02721         ++indentlevel;
02722     else
02723     #endif
02724     if (!xmladdstring (nil, opentag, indentlevel++, xmltext))
02725         goto exit;
02726     
02727     // loop through all of the items in the table
02728     for (hn = (**adrtable).hfirstsort; hn != nil; hn = (**hn).sortedlink) {
02729         
02730         bigstring nameitem;
02731         Handle valitem;
02732         boolean flcdata, flpcdata;
02733         #ifdef compileall
02734         boolean flcomment, fldoctype;
02735         #endif
02736         
02737         gethashkey (hn, nameitem);
02738         
02739         xmlgetname (nameitem);
02740         
02741         if (langexternalgettype ((**hn).val) == idtableprocessor) {
02742         
02743             switch (getstringcharacter (nameitem, 0)) {
02744             
02745                 case '/': //one of the special tables, probably /atts
02746                     break;
02747                 
02748                 #ifdef compileall
02749                 case '?': {
02750                     Handle pistring = nil;
02751                     
02752                     gethashnodetable (hn, &ht);
02753                     
02754                     if (!decompilespecialtable (ht, &pistring, STR_pi, &pistring, false))
02755                         goto exit;
02756                     
02757                     /*
02758                     hdlhashnode hpi;
02759                     bigstring piname;
02760                     tyvaluerecord pivalue;
02761                     if (hashtablelookup (ht, STR_pi, &pivalue)) {
02762                         
02763                         if (!copyvaluerecord (pivalue, &pivalue) || !coercetostring (&pivalue))
02764                             goto exit;
02765                         
02766                         exemptfromtmpstack (&pivalue);
02767                         
02768                         pistring = pivalue.data.stringvalue;
02769                         }
02770                     else {
02771                         for (hpi = (**ht).hfirstsort; hpi != nil; hpi = (**hpi).sortedlink) {
02772                             
02773                             gethashkey (hpi, piname);
02774                             
02775                             if (!copyvaluerecord ((**hpi).val, &pivalue) || !coercetostring (&pivalue))
02776                                 goto exit;
02777                             
02778                             pushstring ("\x02" "=\"", piname);
02779                             
02780                             if (pistring == nil)
02781                                 newtexthandle (piname, &pistring);
02782                                 
02783                             else {
02784                                 insertchar (chspace, piname);
02785                                 
02786                                 pushtexthandle (piname, pistring);
02787                                 }
02788                             
02789                             pushhandle (pivalue.data.stringvalue, pistring);
02790                             
02791                             pushtexthandle ("\x01" "\"", pistring);
02792                             
02793                             disposevaluerecord (pivalue, false);
02794                             }
02795                         }
02796                     */
02797                     
02798                     insertchar ('<', nameitem);
02799                     
02800                     pushchar (chspace, nameitem);
02801                     
02802                     fl = insertinhandle (pistring, 0, stringbaseaddress (nameitem), stringlength (nameitem));
02803                     
02804                     if (fl)
02805                         fl = pushtexthandle (BIGSTRING ("\x02" "?>"), pistring);
02806                 
02807                     if (fl)
02808                         fl = xmladdstring (nil, pistring, indentlevel, xmltext);
02809                     
02810                     disposehandle (pistring);
02811                     
02812                     break;
02813                     }
02814                 #endif
02815                 
02816                 default:
02817                     gethashnodetable (hn, &ht);
02818                     
02819                     if (!decompilevisit (ht, nameitem, indentlevel, xmltext))
02820                         goto exit;
02821                 }
02822             
02823             fl = true;
02824             }
02825         
02826         // not a table      
02827         else {
02828             flcdata = equalidentifiers (nameitem, STR_cdata);
02829             
02830             flpcdata = equalidentifiers (nameitem, STR_pcdata);
02831             
02832             #ifdef compileall
02833             flcomment = equalidentifiers (nameitem, STR_comment);
02834             
02835             fldoctype = equalidentifiers (nameitem, STR_doctype);
02836             
02837             if (!hashresolvevalue (adrtable, hn)) /*08/04/2000 AR*/
02838                 goto exit;
02839             
02840             if (!xmlvaltostring ((**hn).val, indentlevel + 1, !flcdata && !flcomment && !fldoctype, &valitem))
02841                 goto exit;
02842             
02843             #else
02844             if (!xmlvaltostring ((**hn).val, indentlevel + 1, !flcdata, &valitem))
02845                 goto exit;
02846             #endif
02847             
02848             if (valitem == nil) {
02849                 
02850                 // add ("<" + nameitem + "/>")
02851                 parsedialogstring (BIGSTRING ("\x05" "<^0/>"), nameitem, nil, nil, nil, bsadd);
02852                 
02853                 fl = xmladdstring (bsadd, nil, indentlevel, xmltext);
02854                 }
02855             
02856             else {
02857                 
02858                 if (flcdata) {
02859                 
02860                     // add ("<![CDATA[" + valitem + ">]]")
02861                     fl = insertinhandle (valitem, 0, stringbaseaddress (STR_startCDATA), stringlength (STR_startCDATA));
02862                     
02863                     if (fl)
02864                         fl = pushtexthandle (STR_endCDATA, valitem);
02865                     }
02866                 else if (flpcdata) {
02867                     
02868                     // add (valitem)
02869                     fl = true;
02870                     }
02871                 #ifdef compileall
02872                 else if (fldoctype) {
02873                     fl = insertinhandle (valitem, 0, stringbaseaddress (STR_startdoctype), stringlength (STR_startdoctype));
02874                     
02875                     if (fl)
02876                         fl = pushtexthandle (STR_endtag, valitem);
02877                     }
02878                 else if (flcomment) {
02879                     fl = insertinhandle (valitem, 0, stringbaseaddress (STR_startcomment), stringlength (STR_startcomment));
02880                     
02881                     if (fl)
02882                         fl = pushtexthandle (STR_endcomment, valitem);
02883                     }
02884                 #endif
02885                 else {
02886                 
02887                     // add ("<" + nameitem + ">" + valitem + "</" + nameitem + ">")
02888                     parsedialogstring (BIGSTRING ("\x04" "<^0>"), nameitem, nil, nil, nil, bsadd);
02889                     
02890                     fl = insertinhandle (valitem, 0, stringbaseaddress (bsadd), stringlength (bsadd));
02891                     
02892                     if (fl) {
02893                     
02894                         parsedialogstring (BIGSTRING ("\x05" "</^0>"), nameitem, nil, nil, nil, bsadd);
02895                         
02896                         fl = pushtexthandle (bsadd, valitem);
02897                         }
02898                     }
02899                 
02900                 if (fl)
02901                     fl = xmladdstring (nil, valitem, indentlevel, xmltext);
02902                 
02903                 disposehandle (valitem);
02904                 }
02905             }
02906         }
02907     
02908     if (!fl)
02909         goto exit;
02910         
02911     //  add ("</" + namespace + nametable + ">"); indentlevel--};
02912     newtexthandle (BIGSTRING ("\x02" "</"), &hadd);
02913     pushhandle (namespace, hadd);
02914     pushstring (BIGSTRING ("\x01" ">"), nametable);
02915     
02916     if (!pushtexthandle (nametable, hadd))
02917         goto exit;
02918     
02919     #ifdef compileall
02920     if (indentlevel <= 0)
02921         --indentlevel;
02922     else
02923     #endif
02924     fl = xmladdstring (nil, hadd, indentlevel--, xmltext);
02925     
02926     exit:
02927         disposehandle (hadd);
02928         disposehandle (namespace);
02929         disposehandle (opentag);
02930         disposehandle (attstring);
02931         return (fl);
02932     } /*decompilevisit*/
02933 
02934 
02935 static boolean xmldecompile (hdlhashtable hxmltable, Handle *htext) {
02936     
02937     /*
02938     turn a Frontier-table structure into XML text
02939     
02940     5.0.2b8 dmb: coded in C
02941     
02942     5.1.4 dmb: decompile whole table, not just 1st item in it.
02943     */
02944     
02945     handlestream xmltext;
02946     hdlhashnode hn;
02947     hdlhashtable ht, htoss;
02948     bigstring tablename;
02949     short indentlevel = 0;
02950     boolean fl;
02951     
02952     openhandlestream (nil, &xmltext);
02953     
02954     #ifdef compileall
02955         ht = hxmltable;
02956         
02957         //see if there's an xml declaration starting the structure
02958         hn = (**ht).hfirstsort;
02959         
02960         if (hn == 0) {      // 9.0.1 JES: don't crash if the table is empty //
02961             langerrormessage (STR_cant_decompile_empty_table);
02962             return (false);
02963             }
02964         
02965         gethashkey (hn, tablename);
02966         
02967         xmlgetname (tablename);
02968         
02969         //if not, add the stock xml decl
02970         if (!equalidentifiers (tablename, STR_xmldecl))
02971             if (!xmladdstring (STR_xmlversion, nil, indentlevel, &xmltext))
02972                 return (false);
02973         
02974         // decompile our whole table
02975         if (!findinparenttable (ht, &htoss, tablename))
02976             return (false);
02977         
02978         // if we're at the top of the structure, inhibit outer tags
02979         if (!stringfindchar (chtab, tablename))
02980             --indentlevel;
02981     #else
02982     // set ht to @adrtable^ [1]
02983     hn = (**hxmltable).hfirstsort;
02984     
02985     if (!gethashnodetable (hn, &ht))
02986         return (false);
02987     
02988     gethashkey (hn, tablename);
02989     
02990     if (!xmladdstring (STR_xmlversion, nil, indentlevel, &xmltext))
02991         return (false);
02992     #endif
02993     
02994     fl = decompilevisit (ht, tablename, indentlevel, &xmltext);
02995     
02996     closehandlestream (&xmltext);
02997     
02998     *htext = xmltext.data;
02999 
03000     return (fl);
03001     } /*xmldecompile*/
03002 
03003 
03004 boolean isxmlmatch (hdlhashnode hn, bigstring name) {
03005     
03006     bigstring bs;
03007     
03008     gethashkey (hn, bs);
03009     
03010     return (nthword (bs, 2, '\t', bs) && equalstrings (bs, name));
03011     } /*isxmlmatch*/
03012 
03013 
03014 static void xmlmakenewaddress (hdlhashtable ht, bigstring name) {
03015     
03016     /*
03017         adr = @adrparent^.[string.padwithzeros (sizeof (adrparent^) + 1, 4) + "\t" + name];
03018     */
03019     
03020     bigstring prefix;
03021     
03022     serialstring (ht, prefix);
03023     
03024     insertstring (prefix, name);
03025     } /*xmlmakenewaddress*/
03026 
03027 
03028 static boolean xmlgetaddress (hdlhashtable ht, bigstring name) {
03029     
03030     /*
03031     on getAddress (adrtable, name) { //return the address of the first object in the table with the indicated name
03032     */
03033     
03034     hdlhashnode hn;
03035     
03036     for (hn = (**ht).hfirstsort; hn != nil; hn = (**hn).sortedlink) {
03037         
03038         if (isxmlmatch (hn, name)) {
03039             
03040             gethashkey (hn, name);
03041             
03042             return (true);
03043             }
03044         }
03045     
03046     langparamerror (cantgetxmladdresserror, name);
03047     
03048     return (false);
03049     } /*xmlgetaddress*/
03050 
03051 
03052 static boolean xmlgetaddresslist (hdlhashtable ht, bigstring name, boolean justone, hdllistrecord *hlist) {
03053     
03054     /*
03055     on getAddressList (adrtable, commonname, justone=false) { //return a list of all 
03056     objects with this name in the table
03057     
03058     5.1.3 dmb: if ht is nil, just return the empty list
03059     */
03060     
03061     hdlhashnode hn;
03062     bigstring bs;
03063     tyvaluerecord val;
03064     
03065     if (!opnewlist (hlist, false))
03066         return (false);
03067     
03068     if (ht == nil)
03069         return (true);
03070     
03071     for (hn = (**ht).hfirstsort; hn != nil; hn = (**hn).sortedlink) {
03072         
03073         if (isxmlmatch (hn, name)) {
03074             
03075             gethashkey (hn, bs);
03076             
03077             if (!setaddressvalue (ht, bs, &val))
03078                 goto error;
03079             
03080             if (!langpushlistval (*hlist, nil, &val))
03081                 goto error;
03082             
03083             disposevaluerecord (val, false);
03084             
03085             if (justone)
03086                 break;
03087             }
03088         }
03089     
03090     return (true);
03091     
03092     error:
03093         opdisposelist (*hlist);
03094         
03095         return (false);
03096     } /*xmlgetaddresslist*/
03097 
03098 
03099 boolean xmlgetattribute (hdlhashtable ht, bigstring name, hdlhashtable *adratts) {
03100 
03101     /*
03102     on getAttribute (adrtable, name) { //return the address of the attribute with the indicated name
03103         local (adratts = @adrtable^.["/atts"]);
03104         if not defined (adratts^) {
03105             scriptError ("Can't get the \"" + name + "\" attribute because the table doesn't have a sub-table named /atts.")};
03106         local (adratt = @adratts^.[name]);
03107         if not defined (adratt^) {
03108             scriptError ("Can't get the \"" + name + "\" attribute because the table doesn't an attribute with that name.")};
03109         return (adratt)}
03110     */
03111     
03112     tyvaluerecord val;
03113     hdlhashnode hnode;
03114     
03115     if (!hashtablelookup (ht, STR_atts, &val, &hnode) || !langexternalvaltotable (val, adratts, hnode)) {
03116         
03117         langparamerror (noattributestableerror, name);
03118         
03119         return (false);
03120         }
03121     
03122     if (!hashtablesymbolexists (*adratts, name)) {
03123         
03124         langparamerror (cantfindattributeerror, name);
03125         
03126         return (false);
03127         }
03128     
03129     return (true);
03130     } /*xmlgetattribute*/
03131 
03132 
03133 static boolean xmlgetpathaddress (tyaddress *xtable, Handle h, tyaddress *adrresult, boolean *flvalid) {
03134     
03135     /*
03136     6.1d5 AR: Kernelized. From the root of the table, travel from the top down
03137     the /-separated path, e.g. "/ticket/header/title". Set adrresult^ to point
03138     to the the value at the end of the path. Set *flvalid to true if the path
03139     is valid.
03140     */
03141     
03142     tyvaluerecord val;
03143     tyaddress nomad = *xtable;
03144     long len = gethandlesize (h);
03145     long ix;
03146     long lenwd;
03147     long ctwd = 1;
03148     boolean fl;
03149     hdlhashnode hnode;
03150     
03151     *flvalid = false;
03152     
03153     if ((*h)[0] == '/') /*handle leading slash*/
03154         ctwd++;
03155     
03156     while (textnthword ((ptrbyte)(*h), len, ctwd++, '/', true, &ix, &lenwd)) {
03157 
03158         disablelangerror ();
03159 
03160         fl = hashtablelookup (nomad.ht, nomad.bs, &val, &hnode);
03161         
03162         fl = fl && langexternalvaltotable (val, &nomad.ht, hnode);
03163         
03164         enablelangerror ();
03165         
03166         if (!fl)
03167             return (true);
03168 
03169         if (lenwd > lenbigstring)
03170             lenwd = lenbigstring;
03171         
03172         assert ((0 <= ix) && (ix < len) && (ix + lenwd <= len));
03173         
03174         setstringlength (nomad.bs, lenwd);
03175 
03176         moveleft (*h + ix, stringbaseaddress (nomad.bs), lenwd);
03177 
03178         disablelangerror ();
03179 
03180         fl = xmlgetaddress (nomad.ht, nomad.bs);
03181         
03182         enablelangerror ();
03183         
03184         if (!fl)
03185             return (true);
03186         
03187         } /*while*/
03188         
03189     *flvalid = true;    
03190 
03191     *adrresult = nomad;
03192 /*
03193     (*adrresult).ht = nomad.ht;
03194     
03195     copystring (nomad.bs, (*adrresult).bs);
03196 */  
03197     return (true);
03198     } /*xmlgetpathaddress*/
03199 
03200 
03201     
03202 static boolean xmlconverttodisplayname (Handle h) {
03203 
03204     /*
03205     6.1d5 AR: Kernelized.
03206     */
03207     
03208     long len = gethandlesize (h);
03209     
03210     if (len > 5 && ((*h)[4] == chtab))
03211         return (pullfromhandle (h, 0, 5, nil));
03212 
03213     if (len > 9 && ((*h)[8] == chtab))
03214         return (pullfromhandle (h, 0, 9, nil));
03215         
03216     return (true);
03217     } /*xmlconverttodisplayname*/
03218 
03219 
03220 
03221 
03222 
03223 static boolean xmlcompileverb (hdltreenode hp1, tyvaluerecord *v) {
03224     
03225     /*
03226     5.0.2b8 dmb: new verb
03227         on compile (htext, adrtable) {
03228     */
03229     
03230     Handle x;
03231     xmladdress adr;
03232     
03233     if (!gettextvalue (hp1, 1, &x))
03234         return (false);
03235     
03236     flnextparamislast = true;
03237     
03238     if (!getvarparam (hp1, 2, &adr.ht, adr.bs))
03239         return (false);
03240     
03241     if (!xmlcompile (x, &adr))
03242         return (false);
03243     
03244     return (setbooleanvalue (true, v));
03245     } /*xmlcompileverb*/
03246 
03247 
03248 static boolean xmldecompileverb (hdltreenode hp1, tyvaluerecord *v) {
03249     
03250     /*
03251     5.0.2b8 dmb: new verb
03252     
03253         on decompile (adrtable)
03254             return s
03255     */
03256     
03257     hdlhashtable ht;
03258     Handle xmltext;
03259     
03260     flnextparamislast = true;
03261     
03262     if (!gettablevalue (hp1, 1, &ht))
03263         return (false);
03264     
03265     if (!xmldecompile (ht, &xmltext))
03266         return (false);
03267     
03268     return (setheapvalue (xmltext, stringvaluetype, v));
03269     } /*xmldecompileverb*/
03270 
03271 
03272 static boolean xmladdtableverb (hdltreenode hp1, tyvaluerecord *v) {
03273     
03274     /*
03275     on addTable (adrparent, name) {
03276         local (adr = @adrparent^.[string.padwithzeros (sizeof (adrparent^) + 1, 4) + "\t" + name]);
03277         new (tabletype, adr);
03278         return (adr)}
03279     */
03280     
03281     hdlhashtable ht, hnew;
03282     bigstring name;
03283     
03284     if (!gettablevalue (hp1, 1, &ht))
03285         return (false);
03286     
03287     flnextparamislast = true;
03288     
03289     if (!getstringvalue (hp1, 2, name))
03290         return (false);
03291     
03292     xmlmakenewaddress (ht, name);
03293     
03294     if (!langassignnewtablevalue (ht, name, &hnew))
03295         return (false);
03296     
03297     return (setaddressvalue (ht, name, v));
03298     } /*xmladdtableverb*/
03299 
03300 
03301 static boolean xmladdvalueverb (hdltreenode hp1, tyvaluerecord *v) {
03302 
03303     /*
03304     on addValue (adrparent, name, value) {
03305         local (adr = @adrparent^.[string.padwithzeros (sizeof (adrparent^) + 1, 4) + "\t" + name]);
03306         adr^ = value;
03307         return (adr)}
03308     */
03309     
03310     hdlhashtable ht;
03311     bigstring name;
03312     tyvaluerecord val;
03313     
03314     if (!gettablevalue (hp1, 1, &ht))
03315         return (false);
03316     
03317     if (!getstringvalue (hp1, 2, name))
03318         return (false);
03319     
03320     flnextparamislast = true;
03321     
03322     if (!getparamvalue (hp1, 3, &val))
03323         return (false);
03324     
03325     xmlmakenewaddress (ht, name);
03326     
03327     if (!hashtableassign (ht, name, val))
03328         return (false);
03329     
03330     exemptfromtmpstack (&val);
03331     
03332     return (setaddressvalue (ht, name, v));
03333     } /*xmladdvalueverb*/
03334 
03335 
03336 static boolean xmlgetvalueverb (hdltreenode hp1, tyvaluerecord *v) {
03337 
03338     /*
03339     on getValue (adrtable, name) { //return the contents of the indicated object
03340         local (adrobject = xml.getAddress (adrtable, name));
03341         if typeof (adrobject^) == tabletype {
03342             try {
03343                 return (adrobject^.["/contents"]^)}};
03344         return (adrobject^)}
03345     */
03346     
03347     hdlhashtable ht;
03348     bigstring name;
03349     tyvaluerecord val;
03350     hdlhashnode hnode;
03351     
03352     if (!gettablevalue (hp1, 1, &ht))
03353         return (false);
03354     
03355     flnextparamislast = true;
03356     
03357     if (!getstringvalue (hp1, 2, name))
03358         return (false);
03359     
03360     if (!xmlgetaddress (ht, name))
03361         return (false);
03362     
03363     hashtablelookup (ht, name, &val, &hnode);
03364     
03365     if (langexternalvaltotable (val, &ht, hnode))
03366         if (!hashtablelookup (ht, STR_pcdata, &val, &hnode))
03367             hashtablelookup (ht, STR_contents, &val, &hnode);
03368     
03369     return (copyvaluerecord (val, v));
03370     } /*xmlgetvalueverb*/
03371 
03372 
03373 static boolean xmlgetaddressverb (hdltreenode hp1, tyvaluerecord *v) {
03374     
03375     /*
03376     on getAddress (adrtable, name) { //return the address of the first object in the table with the indicated name
03377         local (addresslist);
03378         addresslist = xml.getAddressList (adrtable, name, justone:true);
03379         if sizeof (addresslist) == 0 {
03380             scriptError ("Can't get the address of \"" + name + "\" because the table doesn't have an object with that name.")};
03381         return (addresslist [1])}
03382     */
03383     
03384     hdlhashtable ht;
03385     bigstring name;
03386     
03387     if (!gettablevalue (hp1, 1, &ht))
03388         return (false);
03389     
03390     flnextparamislast = true;
03391     
03392     if (!getstringvalue (hp1, 2, name))
03393         return (false);
03394     
03395     if (!xmlgetaddress (ht, name))
03396         return (false);
03397     
03398     return (setaddressvalue (ht, name, v));
03399     } /*xmlgetaddressverb*/
03400 
03401 
03402 static boolean xmlgetaddresslistverb (hdltreenode hp1, tyvaluerecord *v) {
03403     
03404     /*
03405     on getAddressList (adrtable, commonname, justone=false) { //return a list of all objects with this name in the table
03406         local (i, ct = sizeof (adrtable^), adritem, nameitem, addresslist = {});
03407         for i = 1 to ct {
03408             adritem = @adrtable^ [i];
03409             nameitem = string.nthfield (nameof (adritem^), '\t', 2);
03410             if nameitem == commonname {
03411                 addresslist = addresslist + adritem;
03412                 if justone {
03413                     break}}};
03414         return (addresslist)};
03415     
03416     5.1.3 dmb: if the first parameter is the address of a string, not a table, just return the empty list.
03417     */
03418     
03419     hdlhashtable ht;
03420     bigstring name;
03421     tyvaluerecord val;
03422     boolean justone = false;
03423     bigstring bserror;
03424     hdllistrecord hlist;
03425     hdlhashnode hnode;
03426     
03427     //if (!gettablevalue (hp1, 1, &ht))
03428     //  return (false);
03429     if (!getvarparam (hp1, 1, &ht, name))
03430         return (false);
03431     
03432     if (!langsymbolreference (ht, name, &val, &hnode))
03433         return (false);
03434     
03435     if (val.valuetype == stringvaluetype)
03436         ht = nil;
03437     
03438     else {
03439         if (!tablevaltotable (val, &ht, hnode)) {
03440             
03441             if (!fllangerror) {
03442         
03443                 getstringlist (tableerrorlist, namenottableerror, bserror);
03444                 
03445                 langerrormessage (bserror);
03446                 }
03447             
03448             return (false);
03449             }
03450         }
03451     
03452     if (!getstringvalue (hp1, 2, name))
03453         return (false);
03454     
03455     if (langgetparamcount (hp1) > 2) {
03456     
03457         flnextparamislast = true;
03458         
03459         if (!getbooleanvalue (hp1, 3, &justone))
03460             return (false);
03461         }
03462     
03463     if (!xmlgetaddresslist (ht, name, justone, &hlist))
03464         return (false);
03465     
03466     return (setheapvalue ((Handle) hlist, listvaluetype, v));
03467     } /*xmlgetaddresslistverb*/
03468 
03469 
03470 static boolean xmlgetattributeverb (hdltreenode hp1, tyvaluerecord *v) {
03471 
03472     /*
03473     on getAttribute (adrtable, name) { //return the address of the attribute with the indicated name
03474         local (adratts = @adrtable^.["/atts"]);
03475         if not defined (adratts^) {
03476             scriptError ("Can't get the \"" + name + "\" attribute because the table doesn't have a sub-table named /atts.")};
03477         local (adratt = @adratts^.[name]);
03478         if not defined (adratt^) {
03479             scriptError ("Can't get the \"" + name + "\" attribute because the table doesn't an attribute with that name.")};
03480         return (adratt)}
03481     */
03482     
03483     hdlhashtable ht;
03484     bigstring name;
03485     
03486     if (!gettablevalue (hp1, 1, &ht))
03487         return (false);
03488     
03489     flnextparamislast = true;
03490     
03491     if (!getstringvalue (hp1, 2, name))
03492         return (false);
03493     
03494     if (!xmlgetattribute (ht, name, &ht))
03495         return (false);
03496     
03497     return (setaddressvalue (ht, name, v));
03498     } /*xmlgetattributeverb*/
03499 
03500 
03501 static boolean xmlgetattributevalueverb (hdltreenode hp1, tyvaluerecord *v) {
03502 
03503     /*
03504     on getAttributeValue (adrtable, name) { //return the value of the attribute with the indicated name
03505         return (xml.getAttribute (adrtable, name)^)}
03506     */
03507     
03508     hdlhashtable ht;
03509     bigstring name;
03510     tyvaluerecord val;
03511     hdlhashnode hnode;
03512     
03513     if (!gettablevalue (hp1, 1, &ht))
03514         return (false);
03515     
03516     flnextparamislast = true;
03517     
03518     if (!getstringvalue (hp1, 2, name))
03519         return (false);
03520     
03521     if (!xmlgetattribute (ht, name, &ht))
03522         return (false);
03523     
03524     hashtablelookup (ht, name, &val, &hnode);
03525     
03526     return (copyvaluerecord (val, v));
03527     } /*xmlgetattributevalueverb*/
03528 
03529 
03530 static boolean xmlvaltostringverb (hdltreenode hp1, tyvaluerecord *v) {
03531     
03532     /*
03533     on valToString (val, indentlevel=0) { //http://www.microsoft.com/standards/xml/xmldata.htm#ComplexTypes
03534         «Return an XML-Data representation of a Frontier value
03535             «We only support a small subset of the types that XML-Data specifies.
03536             «If we get a type that's not supported, we throw an error.
03537             «The caller is expected to watch for this, within a try statement.
03538     */
03539     
03540     tyvaluerecord val;
03541     long indentlevel = 0;
03542     Handle htext;
03543     
03544     if (!getparamvalue (hp1, 1, &val))
03545         return (false);
03546     
03547     if (langgetparamcount (hp1) > 1) {
03548         
03549         flnextparamislast = true;
03550         
03551         if (!getlongvalue (hp1, 2, &indentlevel))
03552             return (false);
03553         }
03554     
03555     if (!xmlvaltostring (val, indentlevel, true, &htext))
03556         return (false);
03557     
03558     return (setheapvalue (htext, stringvaluetype, v));
03559     } /*xmlvaltostringverb*/
03560 
03561 
03562 static boolean xmlfrontiervaltotaggedtextverb (hdltreenode hp1, tyvaluerecord *v) {
03563     
03564     Handle htext;
03565     hdlhashtable ht;
03566     bigstring bs;
03567     tyvaluerecord val;
03568     long indentlevel;
03569     hdlhashnode hnode;
03570     
03571     if (!getaddressparam (hp1, 1, &val))
03572         return (false);
03573     
03574     if (!getaddressvalue (val, &ht, bs))
03575         return (false);
03576 
03577     flnextparamislast = true;
03578 
03579     if (!getlongvalue (hp1, 2, &indentlevel))
03580         return (false);
03581     
03582     if (!langhashtablelookup (ht, bs, &val, &hnode)) /*08/04/2000 AR*/
03583         return (false);
03584 
03585     if (!xmlfrontiervaltotaggedtext (&val, indentlevel, &htext, hnode))
03586         return (false);
03587     
03588     return (setheapvalue (htext, stringvaluetype, v));
03589     } /*xmlfrontiervaltotaggedtextverb*/
03590 
03591 
03592 static boolean xmlstructtofrontiervalueverb (hdltreenode hp1, tyvaluerecord *v) {
03593     
03594     tyvaluerecord val;
03595     tyaddress adrstruct, adrvalue;
03596     
03597     if (!getaddressparam (hp1, 1, &val))
03598         return (false);
03599     
03600     if (!getaddressvalue (val, &adrstruct.ht, adrstruct.bs))
03601         return (false);
03602     
03603     if (!getaddressparam (hp1, 2, &val))
03604         return (false);
03605     
03606     if (!getaddressvalue (val, &adrvalue.ht, adrvalue.bs))
03607         return (false);
03608 
03609     if (!xmlstructtofrontiervalue (&adrstruct, &val))
03610         return (false);
03611     
03612     exemptfromtmpstack (&val);
03613     
03614     if (!hashtableassign (adrvalue.ht, adrvalue.bs, val)) {
03615         
03616         disposevaluerecord (val, false);
03617         
03618         return (false);
03619         }
03620 
03621     return (setbooleanvalue (true, v));
03622     } /*xmlstructtofrontiervalueverb*/
03623 
03624 
03625 static boolean xmlfunctionvalue (short token, hdltreenode hparam1, tyvaluerecord *vreturned, bigstring bserror) {
03626     
03627     /*
03628     */
03629     
03630     hdltreenode hp1 = hparam1;
03631     tyvaluerecord *v = vreturned;
03632     
03633     setbooleanvalue (false, v); /*by default, string functions return false*/
03634     
03635     switch (token) {
03636         
03637         case xmlcompilefunc:
03638             return (xmlcompileverb (hp1, v));
03639         
03640         case xmldecompilefunc:
03641             return (xmldecompileverb (hp1, v));
03642         
03643         case xmladdtablefunc:
03644             return (xmladdtableverb (hp1, v));
03645         
03646         case xmladdvaluefunc:
03647             return (xmladdvalueverb (hp1, v));
03648         
03649         case xmlgetvaluefunc:
03650             return (xmlgetvalueverb (hp1, v));
03651 
03652         case xmlgetaddressfunc:
03653             return (xmlgetaddressverb (hp1, v));
03654 
03655         case xmlgetaddresslistfunc:
03656             return (xmlgetaddresslistverb (hp1, v));
03657 
03658         case xmlgetattributefunc:
03659             return (xmlgetattributeverb (hp1, v));
03660 
03661         case xmlgetattributevaluefunc:
03662             return (xmlgetattributevalueverb (hp1, v));
03663 
03664         case xmlvaltostringfunc:
03665             return (xmlvaltostringverb (hp1, v));
03666 
03667         case xmlfrontiervaltotaggedtextfunc:
03668             return (xmlfrontiervaltotaggedtextverb (hp1, v));
03669 
03670         case xmlstructtofrontiervaluefunc:
03671             return (xmlstructtofrontiervalueverb (hp1, v));
03672         
03673         case xmlgetpathaddressfunc: {
03674             tyvaluerecord val;
03675             tyaddress xtable, adrresult, adr;
03676             Handle path;
03677             boolean fl;
03678             
03679             if (!getaddressparam (hp1, 1, &val))
03680                 return (false);
03681             
03682             if (!getaddressvalue (val, &xtable.ht, xtable.bs))
03683                 return (false);
03684             
03685             if (!getreadonlytextvalue (hp1, 2, &path))
03686                 return (false);
03687                 
03688             flnextparamislast = true;
03689             
03690             if (!getaddressparam (hp1, 3, &val))
03691                 return (false);
03692             
03693             if (!getaddressvalue (val, &adrresult.ht, adrresult.bs))
03694                 return (false);
03695 
03696             if (!xmlgetpathaddress (&xtable, path, &adr, &fl))
03697                 return (false);
03698             
03699             if (!langassignaddressvalue (adrresult.ht, adrresult.bs, &adr))
03700                 return (false);
03701             
03702             return (setbooleanvalue (fl, v));
03703             }
03704         
03705         case xmlconverttodisplaynamefunc: {
03706             Handle h;
03707             
03708             flnextparamislast = true;
03709 
03710             if (!getexempttextvalue (hp1, 1, &h))
03711                 return (false);
03712             
03713             if (!xmlconverttodisplayname (h)) {
03714                 
03715                 disposehandle (h);
03716                 
03717                 return (false);
03718                 }
03719             
03720             return (setheapvalue (h, stringvaluetype, v));      
03721             }
03722         
03723         default:
03724             getstringlist (langerrorlist, unimplementedverberror, bserror);
03725             
03726             return (false);
03727         } /*switch*/
03728     } /*xmlfunctionvalue*/
03729 
03730 
03731 boolean xmlinitverbs (void) {
03732     
03733     /*
03734     5.0.2 dmb: new verbs
03735     */
03736     
03737     return (loadfunctionprocessor (idxmlverbs, &xmlfunctionvalue));
03738     } /*xmlinitverbs*/
03739     
03740 
03741 
03742 

Generated on Wed May 31 18:19:54 2006 for frontierkernel 10.1.10a by  doxygen 1.4.6