1/* Part of SWI-Prolog WSDL pack 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@cs.vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (C): 2012, VU University Amsterdam 7 8 This program is free software; you can redistribute it and/or 9 modify it under the terms of the GNU General Public License 10 as published by the Free Software Foundation; either version 2 11 of the License, or (at your option) any later version. 12 13 This program is distributed in the hope that it will be useful, 14 but WITHOUT ANY WARRANTY; without even the implied warranty of 15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 GNU General Public License for more details. 17 18 You should have received a copy of the GNU General Public 19 License along with this library; if not, write to the Free Software 20 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 21 22 As a special exception, if you link this library with other files, 23 compiled with a Free Software compiler, to produce an executable, this 24 library does not by itself cause the resulting executable to be covered 25 by the GNU General Public License. This exception does not however 26 invalidate any other reasons why the executable file might be covered by 27 the GNU General Public License. 28*/ 29 30:- module(xml_schema, 31 [ xsd_read/2, % :File, +Options 32 xsd_load/2, % :DOM, +Options 33 xsd_clean/1, % :Options 34 xsd_create_element/3, % +ElementName, +Values, -DOM 35 xsd_type_description/2, % :DOM, -PrologType 36 xsd_element_documentation/3 % ?Element, ?Type, ?Documentation 37 ]). 38:- use_module(library(sgml)). 39:- use_module(library(xpath)). 40:- use_module(library(option)). 41:- use_module(library(error)). 42:- use_module(library(assoc)). 43:- use_module(library(apply)). 44 45:- meta_predicate 46 xsd_read(:, +), 47 xsd_create_element(+, :, -), 48 xsd_element_documentation(:, ?, ?), 49 xsd_type_description(:, -), 50 qualify_dom(+, -, 2, +).

Query XML Schema files

Provide a simple mapping between Prolog structures and an XML DOM structure that satisfies a given XSD type. Input is

The desired element name
List of (sub)element name=value. E.g. xml_dom(authenticate, [authId=jan, password=geheim], DOM).
Element values can be a list for multiple
Element names can be name1/name2/... to disambiguate paths.

How it works:

Find the element, create element(Element, Atts, Content)
Find the type declaration
Fill in Atts and Content

To be done: - This library is very incomplete. It currently only supports a few XML primitive types (string, integer and boolean). There is no clear view how to deal with abiguities and documents that demand complicated nesting. It mainly supports simple SOAP messages that typically require simple attribute-value pairs. */

81xsd_create_element(ElementName, Module:Values, DOM) :- 82 var(DOM), !, 83 must_be(list, Values), 84 maplist(normalize_input, Values, Values1), 85 xsd_create_element(ElementName, Values1, RestValues, 86 [], DOM, [module(Module)]), 87 assertion(RestValues == []). 88xsd_create_element(ElementName, Module:Values, DOM) :- 89 xsd_create_element(ElementName, Values, [], 90 [], DOM, [module(Module)]). 91 92normalize_input(Name=Value, Name=Value) :- !. 93normalize_input(Term, Name=Value) :- 94 Term =.. [Name,Value], !. 95normalize_input(Term, _) :- 96 type_error(input_value, Term). 97 98xsd_create_element(ElementName, 99 Values, RestValues, 100 Path, 101 Element, 102 Options) :- 103 find_element(ElementName, QName, Type, Options), 104 create_element(QName, Type, Values, RestValues, Path, Element, Options). 105 106create_element(QName, Type, Values, RestValues, Path, Element, Options) :- 107 Element = element(QName, Attrs, Content), 108 fill_attributes(Type, Values, RestValues1, Attrs, Options), 109 fill_content(Type, RestValues1, RestValues, [QName|Path], 110 Content, Options).

120fill_attributes(_, Values0, Values, Attributes, _) :- 121 var(Attributes), !, 122 Attributes = [], 123 Values = Values0. 124fill_attributes(_, Values0, Values, Attributes, _) :- 125 exclude(xmlns_attribute, Attributes, RealAttributes), 126 append(RealAttributes, Values, Values0). 127 128xmlns_attribute(xmlns=_). 129xmlns_attribute(xmlns:_=_).

136fill_content('http://www.w3.org/2001/XMLSchema':string, 137 Values, RestValues, [_:Name|_], [Value], _Options) :- !, 138 ( select(Name=Value, Values, RestValues) 139 -> true 140 ; existence_error(parameter, Name:'xsd:string') 141 ). 142fill_content(Type, Values, RestValues, Path, Content, Options) :- 143 option(module(M), Options), 144 call(M:xsd_type(Type, Descr)), !, 145 xml_fill_content(Descr, Values, RestValues, Path, Content, Options). 146 147xml_fill_content(Descr, Values, RestValues, Path, Content, Options) :- 148 sequence_type(Descr, Seq, Options), !, 149 findall(Part, xml_element_info(Seq, Part, Options), Parts), 150 content(Parts, Values, RestValues, Path, Content, Options).

158xsd_type_description('http://www.w3.org/2001/XMLSchema':boolean, boolean) :- !. 159xsd_type_description('http://www.w3.org/2001/XMLSchema':string, atom) :- !. 160xsd_type_description('http://www.w3.org/2001/XMLSchema':integer, integer) :- !. 161xsd_type_description(Module:XML, Prolog) :- 162 xsd_type_description(XML, Prolog, [module(Module)]). 163 164xsd_type_description(XML, Prolog, Options) :- 165 sequence_type(XML, Sequence, Options), !, 166 Prolog = sequence(Sequence). 167xsd_type_description(XML, Prolog, _Options) :- 168 enum_type(XML, Values), !, 169 Prolog = oneof(Values).

179sequence_type(Descr, Seq, _) :- 180 xpath_chk(Descr, /(_:complexType(self)), _), 181 xpath_chk(Descr, _:sequence(self), Seq), !. 182sequence_type(Descr, Seq, Options) :- 183 xpath_chk(Descr, /(_:complexType(self)), _), 184 xpath_chk(Descr, (_:complexContent)/(_:extension(@base=Base)), Ext), 185 xpath_chk(Ext, _:sequence(self), ExtSeq), 186 option(module(M), Options), 187 call(M:xsd_type(Base, BaseDescr)), 188 sequence_type(BaseDescr, BaseSeq, Options), !, 189 append_content(BaseSeq, ExtSeq, Seq). 190 191append_content(element(Name, Attrs, Content0), 192 element(_, _, ExtraContent), 193 element(Name, Attrs, Content)) :- 194 append(Content0, ExtraContent, Content).

202enum_type(Descr, Values) :- 203 xpath_chk(Descr, /(_:simpleType), _), 204 xpath(Descr, /(_:simpleType)/(_:restriction(@base=_:string)), Res), !, 205 findall(V, xpath(Res, _:enumeration(@value=V), _), Values).

217xml_element_info(Seq, Info, Options) :- 218 xpath(Seq, _:element, Elem), 219 element_info(Elem, Info, Options). 220 221element_info(Elem, c(Name,Type,Opts), _Options) :- 222 xpath(Elem, /(_:element(@name=Name,@type=Type)), _), 223 Elem = element(_, Attrs, _), 224 elem_info(Attrs, Opts). 225element_info(Elem, c(Ref,Type,Opts), Options) :- 226 xpath(Elem, /(_:element(@ref=Ref)), _), 227 option(module(M), Options), 228 M:xsd_element(Ref, Type, _), !, 229 Elem = element(_, Attrs, _), 230 elem_info(Attrs, Opts). 231 232elem_info([], []). 233elem_info([H|T], Opts) :- 234 elem_info_1(H, Opt), !, 235 Opts = [Opt|Rest], 236 elem_info(T, Rest). 237elem_info([_|T], Opts) :- 238 elem_info(T, Opts). 239 240elem_info_1(minOccurs=Atom, min_occurs(N)) :- !, 241 ( atom_number(Atom, N) 242 -> true 243 ; domain_error(number_text, Atom) 244 ). 245elem_info_1(maxOccurs=Atom, max_occurs(N)) :- !, 246 ( Atom == unbounded 247 -> N = unbounded 248 ; atom_number(Atom, N) 249 -> true 250 ; domain_error(number_text, Atom) 251 ). 252 253 254content([], Values, Values, _, [], _). 255content([H|T], Values0, Values, Path, Content, Options) :- 256 content1(H, Values0, Values1, Path, Content, Tail, Options), 257 content(T, Values1, Values, Path, Tail, Options). 258 259content1(c(Name,Type,Opts), Values0, Values1, Path, Content, Tail, Options) :- 260 var(Content), !, 261 Name = _NS:Local, 262 ( complex_type(Type, Options) 263 -> create_element(Name, Type, Values0, Values1, [Name|Path], 264 Element, Options), 265 Content = [Element|Tail] 266 ; select(Local=Value, Values0, Values1) 267 -> ( is_list(Value) 268 -> check_cardinality(Value, Opts), 269 maplist(map_make_element(Type, Name, Options), Value, Elements), 270 append(Elements, Tail, Content) 271 ; make_element(Type, Value, Name, Element, Options), 272 Content = [Element|Tail] 273 ) 274 ; option(min_occurs(0), Opts) 275 -> Tail = Content, 276 Values1 = Values0 277 ; existence_error(parameter, Name:Type) 278 ). 279content1(c(Name,Type,Opts), Values0, Values1, Path, Content, Tail, Options) :- 280 Name = _NS:Local, 281 partition(named(Name), Content, ValueElements, Tail), 282 ( option(min_occurs(0), Opts), 283 ValueElements == [] 284 -> Values1 = Values0 285 ; complex_type(Type, Options), 286 ( multi_valued(Opts) 287 -> Values0 = [Local=Values|Values1], 288 maplist(element_content(Type, Options, [Name|Path]), 289 ValueElements, Values) 290 ; ValueElements = [element(_,_,SubContent)], 291 fill_content(Type, Values0, Values1, [Name|Path], 292 SubContent, Options) 293 ) 294 -> true 295 ; multi_valued(Opts) 296 -> Values0 = [Local=Values|Values1], 297 maplist(element_value(Name,Type,Options), ValueElements, Values) 298 ; ValueElements = [ValueElement] 299 -> Values0 = [Local=Value|Values1], 300 element_value(Name, Type, Options, ValueElement, Value) 301 ; assertion(fail) 302 ). 303 304named(Name, element(Name,_,_)). 305 306multi_valued(Opts) :- 307 option(max_occurs(NotOne), Opts), NotOne \== 1.

313complex_type(Type, Options) :- 314 option(module(M), Options), 315 M:xsd_type(Type, Descr), 316 xpath(Descr, /(_:complexType), _), !. 317 318element_content(Type, Options, Path, element(_,_,Content), Value) :- 319 fill_content(Type, Value, [], Path, Content, Options). 320 321element_value(Name, Type, Options, Element0, Value) :- 322 strip_xmlns(Element0, Element), 323 make_element(Type, Value, Name, Element, Options). 324 325strip_xmlns(element(Name, Atts0, Content), 326 element(Name, Atts, Content)) :- 327 exclude(xmlns_attribute, Atts0, Atts). 328 329map_make_element(Type, Name, Options, Value, Element) :- 330 make_element(Type, Value, Name, Element, Options).

337make_element('http://www.w3.org/2001/XMLSchema':string, 338 Value, Name, element(Name, [], [Value]), _) :- !. 339make_element('http://www.w3.org/2001/XMLSchema':language, 340 Value, Name, element(Name, [], [Value]), _) :- !. 341make_element('http://www.w3.org/2001/XMLSchema':boolean, 342 Value, Name, element(Name, [], [Value]), _) :- !, 343 must_be(boolean, Value). 344make_element('http://www.w3.org/2001/XMLSchema':integer, 345 Value, Name, element(Name, [], [Atom]), _) :- !, 346 atom_number(Atom, Value). 347make_element('http://www.w3.org/2001/XMLSchema':nonNegativeInteger, 348 Value, Name, element(Name, [], [Atom]), _) :- !, 349 atom_number(Atom, Value), 350 must_be(nonneg, Value). 351make_element('http://www.w3.org/2001/XMLSchema':base64Binary, 352 Value, Name, element(Name, [], [Encoded]), _) :- !, 353 base64(Value, Encoded). 354make_element('http://www.w3.org/2001/XMLSchema':dateTime, 355 Stamp, Name, element(Name, [], [Value]), _) :- !, 356 ( nonvar(Value) 357 -> parse_time(Value, Stamp) 358 ; number(Stamp), Stamp > 3000 % Time stamp, not a year 359 -> format_time(atom(Value), '%FT%T%:z', Stamp) 360 ; Value = Stamp % User supplied time 361 ). 362make_element(Type, Value, Name, Element, Options) :- 363 option(module(M), Options), 364 M:xsd_type(Type, Descr), 365 xpath(Descr, /(_:simpleType)/(_:restriction(@base=Base)), _), !, 366 make_element(Base, Value, Name, Element, Options). 367make_element(Type, Value, Name, element(Name, [], [Value]), _) :- 368 ( debugging(soap) 369 -> print_message(warning, literal_type(Type)) 370 ; true 371 ). 372 373check_cardinality(Value, Options) :- 374 option(max_occurs(Max), Options), !, 375 ( ( Max == unbounded 376 ; length(Value, Len), 377 Len =< Max 378 ) 379 -> ( option(min_occurs(Min), Options), 380 Len < Min 381 -> domain_error(min_occurs(Min), Value) 382 ; true 383 ) 384 ; domain_error(max_occurs(Max), Value) 385 ). 386check_cardinality(Value, Options) :- 387 option(min_occurs(Min), Options), !, 388 length(Value, Len), 389 ( Len >= Min 390 -> true 391 ; domain_error(min_occurs(Min), Value) 392 ).

403xsd_read(Module:File, Options) :- 404 ( option(namespace(NameSpace), Options) 405 -> LoadOptions = [xmlns(NameSpace)] 406 ; LoadOptions = [] 407 ), 408 load_structure(File, [Schema], 409 [ dialect(xmlns), 410 space(remove) 411 | LoadOptions 412 ]), 413 prefix_map(Schema, PrefixMap), 414 ( xpath(Schema, /(_:schema(@targetNamespace)), TargetNameSpace) 415 -> TSOptions = [target_namespace(TargetNameSpace)] 416 ; TSOptions = [] 417 ), 418 merge_options([ file(File), 419 prefixmap(PrefixMap) 420 | TSOptions 421 ], 422 Options, NewOptions), 423 424 xsd_load(Module:Schema, NewOptions). 425 426prefix_map(element(_, Attrs, _), PrefixMap) :- 427 prefix_list(Attrs, Pairs), 428 list_to_assoc(Pairs, PrefixMap). 429 430prefix_list([], []). 431prefix_list([xmlns:Name=Prefix|T0], [Name-Prefix|T]) :- !, 432 prefix_list(T0, T). 433prefix_list([xmlns=Prefix|T0], [''-Prefix|T]) :- !, 434 prefix_list(T0, T). 435prefix_list([_|T0], T) :- 436 prefix_list(T0, T).

443xsd_load(Module:Schema, Options) :- 444 xsd_clean(Module:Options), 445 extract_imports(Schema, Module, Options), 446 extract_elements(Schema, Module, Options), 447 extract_types(Schema, Module, Options). 448 449xsd_clean(Module:Options) :- 450 ( option(cleanup(true), Options, true) 451 -> retractall(Module:xsd_element(_,_,_)), 452 retractall(Module:xsd_type(_,_)) 453 ; true 454 ). 455 456extract_imports(Schema, Module, Options) :- 457 forall(xpath(Schema, _:import(@namespace=NameSpace, 458 @schemaLocation=Import), _), 459 import_schema(Import, NameSpace, Module, Options)). 460 461import_schema(File, NameSpace, Module, Options) :- 462 option(file(RelativeTo), Options), 463 absolute_file_name(File, Path, 464 [ access(read), 465 relative_to(RelativeTo) 466 ]), 467 merge_options([ namespace(NameSpace) 468 ], Options, NewOptions), 469 xsd_read(Module:Path, [cleanup(false)|NewOptions]). 470 471 472extract_elements(Schema, Module, Options) :- 473 forall(xpath(Schema, _:element(@name=Name), Element), 474 extract_element(Element, Name, Module, Options)). 475 476extract_element(Element, Name, Module, Options) :- 477 xpath(Element, /(_:element(@type)), Type), !, 478 qualify_name(Name, QName, Options), 479 qualify_name(Type, QType, Options), 480 element_options(Element, ElOpts), 481 assert_element(QName, QType, ElOpts, Module). 482extract_element(Element, Name, Module, Options) :- 483 Element = element(_, _, [Description]), 484 qualify_name(Name, QName, Options), 485 ( QName = Prefix:Local 486 -> atomic_list_concat([typeof_, Prefix, :, Local], Type) 487 ; assertion(fail) 488 ), 489 qualify_dom(Description, QDescription, qattr, Options), 490 element_options(Element, ElOpts), 491 assert_element(QName, Type, ElOpts, Module), 492 assert_type(Type, QDescription, Module). 493 494assert_element(QName, QType, ElOpts, Module) :- 495 Module:xsd_element(QName, QType, ElOpts), !. 496assert_element(QName, QType, ElOpts, Module) :- 497 assertz(Module:xsd_element(QName, QType, ElOpts)). 498 499assert_type(Type, QDescription, Module) :- 500 Module:xsd_type(Type, QDescription), !. 501assert_type(Type, QDescription, Module) :- 502 assertz(Module:xsd_type(Type, QDescription)). 503 504 505element_options(Element, Documentation) :- 506 findall(documentation(Doc), 507 xpath(Element, //(_:documentation(text)), Doc), 508 Documentation). 509 510qattr(type, xmlns). 511qattr(base, xmlns). 512qattr(name, tns). 513qattr(ref, tns). 514 515extract_types(Schema, Module, Options) :- 516 forall(xpath(Schema, _:complexType(@name=Type), Description), 517 ( qualify_name(Type, QType, Options), 518 qualify_dom(Description, QDescription, qattr, Options), 519 assertz(Module:xsd_type(QType, QDescription)))), 520 forall(xpath(Schema, _:simpleType(@name=Type), Description), 521 ( qualify_name(Type, QType, Options), 522 qualify_dom(Description, QDescription, qattr, Options), 523 assertz(Module:xsd_type(QType, QDescription)))).

532find_element(QName, QName, Type, Options) :- 533 option(module(M), Options), 534 M:xsd_element(QName, Type, _), !. 535find_element(Name, _, _, _) :- 536 existence_error(xsd_element, Name). 537 538 539 /******************************* 540 * UTIL * 541 *******************************/

545qualify_name(Name, QName, Options) :- 546 qualify_name(Name, tns, QName, Options). 547 548qualify_name(Name, _, Prefix:LN, Options) :- 549 sub_atom(Name, B, _, A, :), !, 550 sub_atom(Name, 0, B, _, NS), 551 sub_atom(Name, _, A, 0, LN), 552 option(prefixmap(PrefixMap), Options), 553 ( get_assoc(NS, PrefixMap, Prefix) 554 -> true 555 ; existence_error(namespace, NS) 556 ). 557qualify_name(Name, xmlns, Prefix:Name, Options) :- !, 558 option(prefixmap(PrefixMap), Options), 559 get_assoc('', PrefixMap, Prefix), 560 ( Prefix == 'http://www.w3.org/2001/XMLSchema' 561 -> true 562 ; writeln(Prefix) 563 ). 564qualify_name(Name, tns, Prefix:Name, Options) :- 565 option(target_namespace(Prefix), Options).

571qualify_dom(element(Name, Attrs, Content), 572 element(Name, QAttrs, QContent), 573 Qualify, Options) :- !, 574 maplist(qualify_attr(Qualify, Options), Attrs, QAttrs), 575 qualify_content(Content, QContent, Qualify, Options). 576qualify_dom(DOM, DOM, _, _). 577 578qualify_attr(Qualify, Options, Name=Value, Name=QValue) :- 579 atom(Value), 580 call(Qualify, Name, How), !, 581 qualify_name(Value, How, QValue, Options). 582qualify_attr(_, _, Attr, Attr). 583 584qualify_content([], [], _, _). 585qualify_content([H0|T0], [H|T], Qualify, Options) :- 586 qualify_dom(H0, H, Qualify, Options), 587 qualify_content(T0, T, Qualify, Options). 588 589 590 /******************************* 591 * DOCUMENTATION * 592 *******************************/

598xsd_element_documentation(Module:Element, Type, Doc) :- 599 Term = element_documentation(Element, Type, Doc, Module), 600 setof(Term, Term, Results), 601 member(Term, Results). 602 603element_documentation(Element, Type, Doc, Module) :- 604 Module:xsd_element(_:Element, TypeName, Doc), 605 type_description(TypeName, Type, Module). 606element_documentation(Element, Type, Doc, Module) :- 607 Module:xsd_type(_Type, Descr), 608 xpath(Descr, //(_:element(@name=(_:Element), @type=TypeName)), DOM), 609 element_options(DOM, Doc), 610 type_description(TypeName, Type, Module). 611 612type_description(TypeName, Type, Module) :- 613 Module:xsd_type(TypeName, TypeDOM), !, 614 ( xsd_type_description(Module:TypeDOM, Type) 615 -> true 616 ; Type = TypeDOM 617 ). 618type_description(TypeName, Type, _) :- 619 xsd_type_description(TypeName, Type), !. 620type_description(TypeName, TypeName, _)