Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file xml.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322(*
* Xml Light, an small Xml parser/printer with DTD support.
* Copyright (C) 2003 Nicolas Cannasse (ncannasse@motion-twin.com)
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library has the special exception on linking described in file
* README.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
* MA 02110-1301 USA
*)openPrintftypexml=Types.xml=|Elementof(string*(string*string)list*xmllist)|PCDataofstringtypeerror_pos=Types.error_pos={eline:int;eline_start:int;emin:int;emax:int;}typeerror_msg=Types.error_msg=|UnterminatedComment|UnterminatedString|UnterminatedEntity|IdentExpected|CloseExpected|NodeExpected|AttributeNameExpected|AttributeValueExpected|EndOfTagExpectedofstring|EOFExpectedtypeerror=error_msg*error_posexceptionErroroferrorexceptionFile_not_foundofstringexceptionNot_elementofxmlexceptionNot_pcdataofxmlexceptionNo_attributeofstringletdefault_parser=XmlParser.make()letpossource=letline,lstart,min,max=Xml_lexer.possourcein{eline=line;eline_start=lstart;emin=min;emax=max;}letparse(p:XmlParser.t)(source:XmlParser.source)=XmlParser.parsepsourceletparse_string_withpstr=parsep(XmlParser.SStringstr)letparse_inch=parsedefault_parser(XmlParser.SChannelch)letparse_stringstr=parse_string_withdefault_parserstrletparse_filef=letp=XmlParser.make()inletpath=Filename.dirnamefinXmlParser.resolvep(funfile->letname=(matchpathwith"."->file|_->path^"/"^file)inDtd.check(Dtd.parse_filename));parsep(XmlParser.SFilef)leterror_msg=function|UnterminatedComment->"Unterminated comment"|UnterminatedString->"Unterminated string"|UnterminatedEntity->"Unterminated entity"|IdentExpected->"Ident expected"|CloseExpected->"Element close expected"|NodeExpected->"Xml node expected"|AttributeNameExpected->"Attribute name expected"|AttributeValueExpected->"Attribute value expected"|EndOfTagExpectedtag->sprintf"End of tag expected : '%s'"tag|EOFExpected->"End of file expected"leterror(msg,pos)=ifpos.emin=pos.emaxthensprintf"%s line %d character %d"(error_msgmsg)pos.eline(pos.emin-pos.eline_start)elsesprintf"%s line %d characters %d-%d"(error_msgmsg)pos.eline(pos.emin-pos.eline_start)(pos.emax-pos.eline_start)letlinee=e.elineletrangee=e.emin-e.eline_start,e.emax-e.eline_startletabs_rangee=e.emin,e.emaxlettag=function|Element(tag,_,_)->tag|x->raise(Not_elementx)letpcdata=function|PCDatatext->text|x->raise(Not_pcdatax)letattribs=function|Element(_,attr,_)->attr|x->raise(Not_elementx)letattribxatt=matchxwith|Element(_,attr,_)->(tryletatt=String.lowercaseattinsnd(List.find(fun(n,_)->String.lowercasen=att)attr)withNot_found->raise(No_attributeatt))|x->raise(Not_elementx)letchildren=function|Element(_,_,clist)->clist|x->raise(Not_elementx)(*let enum = function
| Element (_,_,clist) -> List.to_enum clist
| x -> raise (Not_element x)
*)letiterf=function|Element(_,_,clist)->List.iterfclist|x->raise(Not_elementx)letmapf=function|Element(_,_,clist)->List.mapfclist|x->raise(Not_elementx)letfoldfv=function|Element(_,_,clist)->List.fold_leftfvclist|x->raise(Not_elementx)moduletypeX=sigtypetvaladd_char:t->char->unitvaladd_string:t->string->unitendmoduleMake(Buffer:X)=structletbuffer_pcdata~tmptext=letl=String.lengthtextinforp=0tol-1domatchtext.[p]with|'>'->Buffer.add_stringtmp">"|'<'->Buffer.add_stringtmp"<"|'&'->ifp<l-1&&text.[p+1]='#'thenBuffer.add_chartmp'&'elseBuffer.add_stringtmp"&"|'\''->Buffer.add_stringtmp"'"|'"'->Buffer.add_stringtmp"""|c->Buffer.add_chartmpcdoneletbuffer_attr~tmp(n,v)=Buffer.add_chartmp' ';Buffer.add_stringtmpn;Buffer.add_stringtmp"=\"";letl=String.lengthvinforp=0tol-1domatchv.[p]with|'"'->Buffer.add_stringtmp"""|c->Buffer.add_chartmpcdone;Buffer.add_chartmp'"'lettag_for_silly_humanstag=letnew_string=Bytes.of_stringtaginletnew_string=Bytes.capitalizenew_stringinfori=(Bytes.lengthnew_string)-1downto0domatchBytes.getnew_stringiwith|'_'->Bytes.setnew_stringi' '|_->()done;letnew_string=Bytes.to_stringnew_stringinnew_string^": "letreformat_tag~formattag=matchformatwith|`Xml->tag|`No_tag->tag_for_silly_humanstagletwritetmpx=letpcdata=reffalseinletrecloop=function|Element(tag,alist,[])->Buffer.add_chartmp'<';Buffer.add_stringtmptag;List.iter(buffer_attr~tmp)alist;Buffer.add_stringtmp"/>";pcdata:=false;|Element(tag,alist,l)->Buffer.add_chartmp'<';Buffer.add_stringtmptag;List.iter(buffer_attr~tmp)alist;Buffer.add_chartmp'>';pcdata:=false;List.iterloopl;Buffer.add_stringtmp"</";Buffer.add_stringtmptag;Buffer.add_chartmp'>';pcdata:=false;|PCDatatext->if!pcdatathenBuffer.add_chartmp' ';buffer_pcdata~tmptext;pcdata:=true;inloopx;;;letadd_char_if_xml~formattmpchar=matchformatwith|`Xml->Buffer.add_chartmpchar|`No_tag->()letadd_string_if_xml~formattmpstring=matchformatwith|`Xml->Buffer.add_stringtmpstring|`No_tag->()letwrite_fmttmp~formatx=letreclooptab=function|Element(tag,alist,[])->ifformat=`XmlthenbeginBuffer.add_stringtmptab;add_char_if_xml~formattmp'<';Buffer.add_stringtmp(reformat_tag~formattag);List.iter(buffer_attr~tmp)alist;add_string_if_xml~formattmp"/>";Buffer.add_chartmp'\n';end|Element(tag,alist,[PCDatatext])->Buffer.add_stringtmptab;add_char_if_xml~formattmp'<';Buffer.add_stringtmp(reformat_tag~formattag);List.iter(buffer_attr~tmp)alist;add_string_if_xml~formattmp">";buffer_pcdata~tmptext;ifformat=`XmlthenbeginBuffer.add_stringtmp"</";Buffer.add_stringtmptag;Buffer.add_chartmp'>';end;Buffer.add_chartmp'\n';|Element(tag,alist,l)->Buffer.add_stringtmptab;add_char_if_xml~formattmp'<';Buffer.add_stringtmp(reformat_tag~formattag);List.iter(buffer_attr~tmp)alist;add_string_if_xml~formattmp">";Buffer.add_chartmp'\n';List.iter(loop(tab^" "))l;ifformat=`XmlthenbeginBuffer.add_stringtmptab;Buffer.add_stringtmp"</";Buffer.add_stringtmptag;Buffer.add_chartmp'>';end;Buffer.add_chartmp'\n';|PCDatatext->buffer_pcdata~tmptext;Buffer.add_chartmp'\n';inloop""x;;;endincludeMake(Buffer)letto_stringxml=letbuffer=Buffer.create200inwritebufferxml;Buffer.contentsbufferletto_string_fmt~formatxml=letbuffer=Buffer.create200inwrite_fmtbuffer~formatxml;Buffer.contentsbufferletto_human_stringx=letformat=`No_taginto_string_fmt~formatx;;letto_string_fmtx=letformat=`Xmlinto_string_fmt~formatx;;XmlParser._raises(funxp->Error(x,posp))(funf->File_not_foundf)(funxp->Dtd.Parse_error(x,posp));Dtd._raises(funf->File_not_foundf);