1:- module(validate, [
    2  validate/2,
    3  validate/3
    4]).    5
    6:- use_module(library(xsd/flatten)).    7:- use_module(library(xsd/simpletype)).    8:- use_module(library(xsd/xpath)).    9:- use_module(library(xsd/xsd_helper)).   10
   11:- use_module(library(statistics)).   12:- use_module(library(settings)).   13:- setting('without-tabling', boolean, false, 'Run without tabling').   14:- setting(profile, boolean, false, 'Show profile').   15
   16
   17/*
   18  validate/2
   19  Validates given XML document `D_File` against XSD schema `S_File`.
   20  (Both files must be loaded using `flatten_xml/2`)
   21
   22  ?- validate(xml_file, xsd_file).
   23*/
   24validate(S_File, D_File) :-
   25  validate(S_File, D_File, []).
   26
   27validate(S_File, D_File, Options) :-
   28  set_options(Options),
   29  (setting(profile, true) ->
   30    time(validate(D_File, [0], 1, S_File, [0]))
   31  ; validate(D_File, [0], 1, S_File, [0])),
   32%  validate(D_File, [0], 1, S_File, [0]),
   33  % only one solution
   34  !,
   35  set_default_options(Options).
   36
   37set_options(Options) :-
   38  maplist(set_option, Options),
   39  !.
   40
   41set_option(Option) :-
   42  Option =.. [Key, Value],
   43  current_setting(Key),
   44  set_setting(Key, Value).
   45set_option(_Option) :-
   46  true.
   47
   48set_default_options(Options) :-
   49  maplist(set_default_option, Options),
   50  !.
   51set_default_option(Option) :-
   52  Option =.. [Key, _Value],
   53  current_setting(Key),
   54  restore_setting(Key).
   55set_default_option(_Option) :-
   56  true.
   57
   58validate(D_File, D_ID, Validated_Nodes, S_File, S_ID) :-
   59  % annotation stuff
   60  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
   61  member(S_Type, [annotation, appinfo, documentation])
   62  ;
   63  % schema
   64  Validated_Nodes = 1,
   65  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), schema),
   66  % validate: D_ID and one child 'element' in schema
   67  child(S_File, S_ID, S_Child_ID),
   68  node(S_File, S_Child_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), element),
   69  validate(D_File, D_ID, 1, S_File, S_Child_ID)
   70  ;
   71  % ref
   72  % Resolves references to other elements in the document using the attribute ref
   73  attribute(S_File, S_ID, ref, S_QName),
   74  attribute(S_File, S_ID0, name, S_QName),
   75  validate(D_File, D_ID, Validated_Nodes, S_File, S_ID0)
   76  ;
   77  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), element),
   78  (
   79    % minOccurs = 0
   80    Validated_Nodes = 0,
   81    attribute(S_File, S_ID, minOccurs, '0')
   82  ;
   83    % minOccurs =< # of elements =< maxOccurs
   84    % Min/MaxOccurs
   85    attribute(S_File, S_ID, minOccurs, MinOccurs),
   86    atom_number(MinOccurs, Min),
   87    attribute(S_File, S_ID, maxOccurs, MaxOccurs),
   88    ( MaxOccurs = unbounded ->
   89      count_remaining_siblings(D_File, D_ID, Max)
   90    ;
   91      atom_number(MaxOccurs, Max)
   92    ),
   93    % Validated_Nodes in Range
   94    between(Min, Max, Validated_Nodes),
   95    % Validate each Element Node
   96    forall(between(1, Validated_Nodes, Nth),
   97      (get_nth_sibling(D_File, D_ID, Nth, Nth_ID), validate_element(D_File, Nth_ID, S_File, S_ID)))
   98  )
   99  ;
  100  % complexType
  101  Validated_Nodes = 1,
  102  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), complexType),
  103  (
  104    child(S_File, S_ID, S_Type_ID),
  105    node(S_File, S_Type_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  106    member(S_Type, [sequence, choice, all]),
  107    validate_all_attributes(D_File, D_ID, S_File, S_ID),
  108    count_children(D_File, D_ID, N_Children),
  109    ( N_Children = 0 ->
  110      % no children -> validate schema against no element (equals non-existing element -> [1])
  111      validate(D_File, [1], 0, S_File, S_Type_ID)
  112    ;
  113      % validate all N_Children otherwise
  114      get_nth_child(D_File, D_ID, 1, Child_ID),
  115      validate(D_File, Child_ID, N_Children, S_File, S_Type_ID)
  116    )
  117    ;
  118    % empty complexType (except attributes)
  119    % no content defining children
  120    forall((child(S_File, S_ID, S_Type_ID), member(S_Type, [sequence, choice, all])),
  121      \+ node(S_File, S_Type_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type)),
  122    % no children in document
  123    count_children(D_File, D_ID, 0),
  124    validate_all_attributes(D_File, D_ID, S_File, S_ID)
  125  ),
  126  !,
  127  % validate every assert on the complexType
  128  forall((child(S_File, S_ID, As_ID), node(S_File, As_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), assert)),
  129    (
  130      attribute(S_File, As_ID, test, XPathExpr),
  131      (
  132        child(S_File, As_ID, An_ID), node(S_File, An_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), annotation),
  133        child(S_File, An_ID, Do_ID), node(S_File, Do_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), documentation),
  134        child(S_File, Do_ID, Text_ID) ->
  135          text_node(S_File, Text_ID, Documentation)
  136          ;
  137          Documentation = null
  138      ),
  139      !,
  140      xpath:assert(D_File, D_ID, false, XPathExpr, Documentation)
  141    )
  142  )
  143  ;
  144  % simpleType as content of nodes (actual validation of content or attribute values handled by `validate_simpleType/5`)
  145  Validated_Nodes = 1,
  146  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), simpleType),
  147  % no attributes in xml file, 1 or 0 children
  148  \+ attribute(D_File, D_ID, _Name, _Value),
  149  (
  150    count_children(D_File, D_ID, 1),
  151    child(D_File, D_ID, D_Child),
  152    text_node(D_File, D_Child, D_Text)
  153  ;
  154    count_children(D_File, D_ID, 0),
  155    D_Text = ''
  156  ),
  157  validate_simpleType(D_File, D_ID, D_Text, S_File, S_ID)
  158  ;
  159  % sequence / choice
  160  get_n_siblings(D_File, D_ID, Validated_Nodes, D_Nodes),
  161  get_children(S_File, S_ID, S_Children),
  162  % Min/MaxOccurs
  163  attribute(S_File, S_ID, minOccurs, MinOccurs),
  164  atom_number(MinOccurs, Min),
  165  attribute(S_File, S_ID, maxOccurs, MaxOccurs),
  166  ( MaxOccurs = unbounded ->
  167    count_remaining_siblings(D_File, D_ID, Max)
  168  ;
  169    atom_number(MaxOccurs, Max)
  170  ),
  171  (
  172    % sequence
  173    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), sequence),
  174    validate_sequence(D_File, D_Nodes, S_File, S_Children, S_Children, Min, Max)
  175  ;
  176    % choice
  177    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), choice),
  178    validate_choice(D_File, D_Nodes, S_File, S_Children, Min, Max)
  179  )
  180  ;
  181  % all
  182  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), all),
  183  attribute(S_File, S_ID, maxOccurs, '1'),
  184  get_children(S_File, S_ID, S_IDs),
  185  count_remaining_siblings(D_File, D_ID, Validated_Nodes),
  186  get_n_siblings(D_File, D_ID, Validated_Nodes, D_IDs),
  187  validate_all(D_File, D_IDs, S_File, S_IDs);
  188  Validated_Nodes = 0,
  189  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), all),
  190  attribute(S_File, S_ID, minOccurs, '0')
  191  .
  192
  193/*
  194  #### (End of validate/5) ####
  195*/
  196
  197/*
  198  attribute
  199*/
  200validate_all_attributes(D_File, D_ID, S_File, S_ID) :-
  201  get_children(S_File, S_ID, S_Children),
  202  findall(S_Child,
  203    (member(S_Child, S_Children), node(S_File, S_Child, ns(_, 'http://www.w3.org/2001/XMLSchema'), attribute)),
  204    S_Attribute_IDs),
  205  findall(attribute(D_File, D_ID, Name, Value),
  206    attribute(D_File, D_ID, Name, Value),
  207    D_Attribute_List),
  208  validate_attributes(D_File, D_Attribute_List, S_File, S_Attribute_IDs).
  209
  210/*
  211  validate_element/4
  212  validate_element(D_File, D_ID, S_File, S_ID)
  213
  214  Validates a single element `D_ID` from file `D_File` against schema node `S_ID` from `S_File`.
  215
  216  Is called by validate(element,_,_,_,_,_). (min/maxOccurs is handled there)
  217*/
  218
  219validate_element(D_File, D_ID, S_File, S_ID) :-
  220  % annotation stuff
  221  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  222  member(S_Type, [annotation, appinfo, documentation])
  223  ;
  224  % otherwise
  225  validate_element_name(D_File, D_ID, S_File, S_ID),
  226  (
  227    get_children(S_File, S_ID, []),
  228    (
  229      % no type
  230      \+ attribute(S_File, S_ID, type, _),
  231      \+ attribute(S_File, S_ID, ref, _),
  232      get_children(D_File, D_ID, []),
  233      \+ attribute(D_File, D_ID, _Name, _Value)
  234      ;
  235      % xsd simple Type
  236      % no child nodes in Schema
  237      attribute(S_File, S_ID, type, S_Type_NameNS),
  238      namespace(S_Type_NameNS, NS_Prefix, S_Type_Name),
  239      resolve_namespace(S_File, S_ID, NS_Prefix, 'http://www.w3.org/2001/XMLSchema'),
  240      (
  241        % one child node in Document (is text node with ID = Child_Node)
  242        get_children(D_File, D_ID, [Child_Node]),
  243        text_node(D_File, Child_Node, D_Text)
  244        ;
  245        % otherwise: no children
  246        get_children(D_File, D_ID, []),
  247        D_Text = ''
  248      ),
  249      \+attribute(D_File, D_ID, _Name1, _Value1),
  250      validate_xsd_simpleType(S_Type_Name, D_Text)
  251    )
  252    ;
  253    % xsd simple Type
  254    (
  255      % nested type: type definition in child node
  256      child(S_File, S_ID, S_Type_ID)
  257    ;
  258      % global type: type definition anywhere in document
  259      attribute(S_File, S_ID, type, S_User_Type),
  260      attribute(S_File, S_Type_ID, name, S_User_Type)
  261    ),
  262    node(S_File, S_Type_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  263    (
  264      % annotation stuff
  265      member(S_Type, [annotation, appinfo, documentation])
  266    ;
  267      % [complexType, simpleType]
  268      member(S_Type, [complexType, simpleType]),
  269      validate(D_File, D_ID, 1, S_File, S_Type_ID)
  270    )
  271  )
  272  .
  273
  274/*
  275  validate_element_name/4
  276
  277  Validates name of `D_ID` against specified name in `S_ID`
  278*/
  279validate_element_name(D_File, D_ID, S_File, S_ID) :-
  280  % check Name (currently: ignoring namespaces; TODO (?))
  281  node(D_File, D_ID, _D_NS, D_Name),
  282  attribute(S_File, S_ID, name, D_Name).
  283
  284/*
  285  validate_simpleType
  286*/
  287% find simpleType by name `S_Type` and validate (S_ID only for namespace handling)
  288
  289
  290validate_simpleType(D_File, D_ID, D_Text, S_File, S_ID, S_Type) :-
  291  node(S_File, S_ID0, ns(_, 'http://www.w3.org/2001/XMLSchema'), simpleType),
  292  attribute(S_File, S_ID0, name, S_Type),
  293  validate_simpleType(D_File, D_ID, D_Text, S_File, S_ID0)
  294  ;
  295  namespace(S_Type, NS_Prefix, S_Type_Name),
  296  resolve_namespace(S_File, S_ID, NS_Prefix, 'http://www.w3.org/2001/XMLSchema'),
  297  validate_xsd_simpleType(S_Type_Name, D_Text)
  298  .
  299
  300validate_simpleType(D_File, D_ID, D_Text, S_File, S_ID) :-
  301  child(S_File, S_ID, S_Child),
  302  (
  303    % annotation stuff
  304    node(S_File, S_Child, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Child_Type),
  305    member(S_Child_Type, [annotation, appinfo, documentation])
  306  ;
  307    % restriction
  308    node(S_File, S_Child, ns(_, 'http://www.w3.org/2001/XMLSchema'), restriction),
  309    attribute(S_File, S_Child, base, S_Type),
  310    validate_simpleType(D_File, D_ID, D_Text, S_File, S_ID, S_Type),
  311    get_children(S_File, S_Child, S_Facets),
  312    validate_restriction(D_File, D_ID, D_Text, S_File, S_Facets)
  313  ;
  314    % union
  315    node(S_File, S_Child, ns(_, 'http://www.w3.org/2001/XMLSchema'), union),
  316    (
  317      % types as memberTypes-attribute
  318      attribute(S_File, S_Child, memberTypes, S_Types),
  319      atomic_list_concat(Types_List, ' ', S_Types),
  320      member(S_Type, Types_List),
  321      validate_simpleType(D_File, D_ID, D_Text, S_File, S_ID, S_Type)
  322    ;
  323      % types as children
  324      get_children(S_File, S_Child, S_SimpleTypes),
  325      member(S_SimpleType, S_SimpleTypes),
  326      node(S_File, S_SimpleType, ns(_, 'http://www.w3.org/2001/XMLSchema'), simpleType),
  327      validate_simpleType(D_File, D_ID, D_Text, S_File, S_SimpleType)
  328    )
  329  ;
  330    % list
  331    node(S_File, S_Child, ns(_, 'http://www.w3.org/2001/XMLSchema'), list),
  332    (
  333      % type as itemType-attribute
  334      attribute(S_File, S_Child, itemType, S_Type),
  335      atomic_list_concat(D_Items, ' ', D_Text),
  336      subtract(D_Items, [''], D_Items0),
  337      forall(member(D_Item, D_Items0), validate_simpleType(D_File, D_ID, D_Item, S_File, S_ID, S_Type))
  338    ;
  339      % type as child
  340      child(S_File, S_Child, S_SimpleType),
  341      node(S_File, S_SimpleType, ns(_, 'http://www.w3.org/2001/XMLSchema'), simpleType),
  342      atomic_list_concat(D_Items, ' ', D_Text),
  343      subtract(D_Items, [''], D_Items0),
  344      forall(member(D_Item, D_Items0), validate_simpleType(D_File, D_ID, D_Item, S_File, S_SimpleType))
  345    )
  346  )
  347  .
  348
  349/*
  350  validate_restriction
  351*/
  352validate_restriction(D_File, D_ID, D_Text, S_File, SIDs) :-
  353  SIDs = []
  354  ;
  355  SIDs = [S_ID|S_IDs],
  356  (
  357    % annotation stuff
  358    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  359    member(S_Type, [annotation, appinfo, documentation]),
  360    validate_restriction(D_File, D_ID, D_Text, S_File, S_IDs)
  361    ;
  362    % min/max facets
  363    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), Facet),
  364    attribute(S_File, S_ID, value, Val),
  365    facet(Facet, Val, D_Text),
  366    validate_restriction(D_File, D_ID, D_Text, S_File, S_IDs)
  367    ;
  368    % enumeration
  369    findall(S_ID0,
  370      (member(S_ID0, [S_ID|S_IDs]), node(S_File, S_ID0, ns(_, 'http://www.w3.org/2001/XMLSchema'), enumeration)),
  371      Enum_IDs),
  372    member(Enum_ID, Enum_IDs),
  373    attribute(S_File, Enum_ID, value, D_Text),
  374    subtract([S_ID|S_IDs], Enum_IDs, S_IDs0),
  375    validate_restriction(D_File, D_ID, D_Text, S_File, S_IDs0)
  376    ;
  377    % assertion
  378    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), assertion),
  379    attribute(S_File, S_ID, test, XPathExpr),
  380    (
  381      child(S_File, S_ID, An_ID), node(S_File, An_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), annotation),
  382      child(S_File, An_ID, Do_ID), node(S_File, Do_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), documentation),
  383      child(S_File, Do_ID, Text_ID) ->
  384        text_node(S_File, Text_ID, Documentation)
  385        ;
  386        Documentation = null
  387    ),
  388    xpath:assert(D_File, D_ID, D_Text, XPathExpr, Documentation),
  389    validate_restriction(D_File, D_ID, D_Text, S_File, S_IDs)
  390  )
  391  .
  392/*
  393  validate_sequence/6
  394  validate_sequence(D_File, D_Remaining_IDs, S_File, S_Remaining_IDs, S_IDs, MinOccurs, MaxOccurs)
  395
  396  Validates a list of document nodes `D_Remaining_IDs` against a list of schema nodes `S_Remaining_IDs`.
  397  There must be a corresponding number of document nodes for each schema node in the given order.
  398
  399  Is called by validate(sequence,_,_,_,_,_)
  400*/
  401
  402validate_sequence(D_File, D_IDs, S_File, S_Remaining_IDs, S_IDs, Min, Max) :-
  403  D_IDs = [],
  404  (
  405    % minOccurs = 0 / end of recursion
  406    member(S_Remaining_IDs, [[], S_IDs]),
  407    Min =< 0,
  408    Max >= 0
  409  ;
  410    % empty sequence -> every element in sequence validates against zero elements
  411    forall(member(S_ID, S_Remaining_IDs), (node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type), validate(D_File, [], 0, S_File, S_ID))),
  412    (
  413      Min =< 1
  414    ;
  415      forall(member(S_ID, S_IDs), (node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type), validate(D_File, null, 0, S_File, S_ID)))
  416    )
  417  )
  418  ;
  419  S_Remaining_IDs = [S_ID|S_Remaining_IDs0],
  420  (
  421    % annotation stuff
  422    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  423    member(S_Type, [annotation, appinfo, documentation]),
  424    validate_sequence(D_File, D_IDs, S_File, S_Remaining_IDs0, S_IDs, Min, Max)
  425    ;
  426    % otherwise
  427    Max > 0,
  428    D_IDs = [D_ID|_],
  429    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  430    member(S_Type, [element, sequence, choice]),
  431    length(D_IDs, D_Remaining),
  432    between(0, D_Remaining, Val_Nodes),
  433    validate(D_File, D_ID, Val_Nodes, S_File, S_ID),
  434    length(TempList, Val_Nodes),
  435    append(TempList, D_IDs0, D_IDs),
  436    (
  437      S_Remaining_IDs0 = [],
  438      % reset S_Remaining_IDs and validate next sequence
  439      Min0 is Min - 1,
  440      Max0 is Max - 1,
  441      validate_sequence(D_File, D_IDs0, S_File, S_IDs, S_IDs, Min0, Max0)
  442      ;
  443      % Validate `Val_Nodes` many document nodes against next schema node
  444      S_Remaining_IDs0 \= [],
  445      validate_sequence(D_File, D_IDs0, S_File, S_Remaining_IDs0, S_IDs, Min, Max)
  446    )
  447  )
  448  .
  449
  450/*
  451  validate_choice/7
  452  validate_choice(D_File, D_Nodes, S_File, S_Children, S_Children, Min, Max)
  453*/
  454validate_choice(D_File, D_IDs, S_File, S_IDs, Min, Max) :-
  455  D_IDs = [],
  456  (
  457    % end of recursion & minOccurs = 0
  458    Min =< 0,
  459    Max >= 0
  460    ;
  461    % empty choice declaration
  462    S_IDs = []
  463    ;
  464    % no document nodes -> one element in choice validates against zero elements in document
  465    member(S_ID, S_IDs),
  466    node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  467    member(S_Type, [element, choice, sequence]),
  468    validate(D_File, [1], 0, S_File, S_ID)
  469  )
  470  ;
  471  Max > 0,
  472  % Validate `Val_Nodes` many document nodes against schema node
  473  D_IDs = [D_ID|_],
  474  member(S_ID, S_IDs),
  475  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), S_Type),
  476  member(S_Type, [element, choice, sequence]),
  477  length(D_IDs, D_Remaining),
  478  between(0, D_Remaining, Val_Nodes),
  479  validate(D_File, D_ID, Val_Nodes, S_File, S_ID),
  480  length(TempList, Val_Nodes),
  481  append(TempList, D_IDs0, D_IDs),
  482
  483  Min0 is Min - 1,
  484  Max0 is Max - 1,
  485  validate_choice(D_File, D_IDs0, S_File, S_IDs, Min0, Max0)
  486  .
  487
  488/*
  489  validate_all/4
  490  validate_sequence(D_File, D_IDs, S_File, S_IDs)
  491
  492  Validates a list of document nodes `D_IDs` against a list of schema nodes `S_IDs`.
  493  Without regard to the order, each given document node must validate against one schema node.
  494*/
  495validate_all(D_File, DIDs, S_File, S_IDs) :-
  496  DIDs = [],
  497  (
  498    S_IDs = []
  499    ;
  500    forall(member(S_ID, S_IDs), (node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), _S_Type), validate(D_File, null, 0, S_File, S_ID)))
  501  )
  502  ;
  503  DIDs = [D_ID|D_IDs],
  504  member(S_ID, S_IDs),
  505  node(S_File, S_ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), element),
  506  validate(D_File, D_ID, 1, S_File, S_ID),
  507  delete(S_IDs, S_ID, S_IDs0),
  508  validate_all(D_File, D_IDs, S_File, S_IDs0)
  509  .
  510
  511/*
  512  validate_attributes/4
  513  validate_attributes(D_File, D_Attribute_List, S_File, S_Attribute_IDs)
  514
  515  `D_Attribute_List`: List of `attribute/4` nodes.
  516  `S_Attribute_IDs`: List of IDs correspoding to <xs:attribute .. /> nodes
  517*/
  518validate_attributes(D_File, DAttributes, S_File, S_Attribute_IDs) :-
  519  DAttributes = [],
  520  (
  521    S_Attribute_IDs = []
  522    ;
  523    forall(member(S_ID, S_Attribute_IDs),
  524      \+attribute(S_File, S_ID, use, 'required'))
  525  )
  526  ;
  527  DAttributes = [D_Attribute|D_Attributes],
  528  D_Attribute = attribute(D_File, _D_ID, Name, _Value),
  529  (
  530    % skip xmlns attributes
  531    ( Name = xmlns ; Name = xmlns:_ ),
  532    validate_attributes(D_File, D_Attributes, S_File, S_Attribute_IDs)
  533    ;
  534    member(S_ID, S_Attribute_IDs),
  535    attribute(S_File, S_ID, name, Name),
  536    \+attribute(S_File, S_ID, use, 'prohibited'),
  537    validate_attribute(D_Attribute, S_File, S_ID),
  538    delete(S_Attribute_IDs, S_ID, S_Attribute_IDs0),
  539    validate_attributes(D_File, D_Attributes, S_File, S_Attribute_IDs0)
  540  )
  541  .
  542
  543validate_attribute(D_Attribute, S_File, S_ID) :-
  544  D_Attribute = attribute(D_File, D_ID, _Name, D_Value),
  545  % check fixed values
  546  (attribute(S_File, S_ID, fixed, S_FixedVal) ->
  547    S_FixedVal = D_Value
  548    ;
  549    true
  550  ),
  551  % validate simpleType (reference or nested)
  552  (
  553    attribute(S_File, S_ID, type, S_Type),
  554    validate_simpleType(D_File, D_ID, D_Value, S_File, S_ID, S_Type)
  555  ;
  556    child(S_File, S_ID, S_Child),
  557    validate_simpleType(D_File, D_ID, D_Value, S_File, S_Child)
  558  ).
  559
  560/*
  561  attribute/4
  562  attribute(File_ID, ID, Attribute_Name, Value)
  563
  564  Determines the attribute value `Value` of given `File_ID`, `ID` and `Attribute_Name` using `node_attribute/4`.
  565    Specifies all permitted attributes, including default ones, if `Attribute_Name` is left empty.
  566
  567  Currently, only some (minOccurs, maxOccurs, use) XML-Schema-Defaults are supported.
  568*/
  569attribute(File_ID, ID, Attribute_Name, Value) :-
  570  node_attribute(File_ID, ID, Attribute_Name, Value),
  571  Attribute_Name \= _NS:_Name.
  572
  573% XML-Schema Defaults
  574attribute(File_ID, ID, minOccurs, '1') :-
  575  \+node_attribute(File_ID, ID, minOccurs, _),
  576  % Check type and namespace
  577  member(Element_Type, [element, choice, sequence, all]),
  578  node(File_ID, ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), Element_Type).
  579
  580attribute(File_ID, ID, maxOccurs, '1') :-
  581  \+node_attribute(File_ID, ID, maxOccurs, _),
  582  % Check type and namespace
  583  member(Element_Type, [element, choice, sequence, all]),
  584  node(File_ID, ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), Element_Type).
  585
  586attribute(File_ID, ID, use, 'optional') :-
  587  \+node_attribute(File_ID, ID, use, _),
  588  % Check type and namespace
  589  member(Element_Type, [attribute]),
  590  node(File_ID, ID, ns(_, 'http://www.w3.org/2001/XMLSchema'), Element_Type)