1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- XML Processor -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2010-2014, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 4777 $ $Date: 2014-03-29 11:52:24 +0400 (Sat, 29 Mar 2014) $ 43------------------------------------------------------------------------------ 44with League.IRIs; 45with League.Strings.Internals; 46with Matreshka.Internals.Text_Codecs; 47with Matreshka.Internals.Unicode.Characters.Latin; 48with XML.SAX.Attributes.Internals; 49with XML.SAX.Simple_Readers.Analyzer; 50with XML.SAX.Simple_Readers.Callbacks; 51with XML.SAX.Simple_Readers.Scanner; 52with XML.SAX.Simple_Readers.Validator; 53 54package body XML.SAX.Simple_Readers.Parser.Actions is 55 56 use Matreshka.Internals.Unicode.Characters.Latin; 57 use Matreshka.Internals.XML; 58 use Matreshka.Internals.XML.Attributes; 59 use Matreshka.Internals.XML.Attribute_Tables; 60 use Matreshka.Internals.XML.Base_Scopes; 61 use Matreshka.Internals.XML.Element_Tables; 62 use Matreshka.Internals.XML.Entity_Tables; 63 use Matreshka.Internals.XML.Namespace_Scopes; 64 use Matreshka.Internals.XML.Notation_Tables; 65 use Matreshka.Internals.XML.Symbol_Tables; 66 use type Matreshka.Internals.Unicode.Code_Unit_16; 67 use type Matreshka.Internals.Utf16.Utf16_String_Index; 68 69 70 procedure Analyze_Attribute_Declaration 71 (Self : in out Simple_Reader'Class; 72 Symbol : Matreshka.Internals.XML.Symbol_Identifier; 73 Constructor : not null access procedure 74 (Self : in out Attribute_Table; 75 Name : Symbol_Identifier; 76 Attribute : out Attribute_Identifier)); 77 -- Checks whether attribute is not declared, allocates new attribute using 78 -- specified constructor, attach it to the list of element's attributes. 79 80 function To_XML_Version 81 (Version : not null Matreshka.Internals.Strings.Shared_String_Access) 82 return XML_Version; 83 -- Converts string representation of XML version into enumeration. 84 85 ----------------------------------- 86 -- Analyze_Attribute_Declaration -- 87 ----------------------------------- 88 89 procedure Analyze_Attribute_Declaration 90 (Self : in out Simple_Reader'Class; 91 Symbol : Matreshka.Internals.XML.Symbol_Identifier; 92 Constructor : not null access procedure 93 (Self : in out Attribute_Table; 94 Name : Symbol_Identifier; 95 Attribute : out Attribute_Identifier)) 96 is 97 Last : Attribute_Identifier; 98 Current : Attribute_Identifier; 99 100 begin 101 Self.Attribute_Redefined := False; 102 Self.Current_Attribute := 103 Element_Tables.Attributes (Self.Elements, Self.Current_Element); 104 Self.Normalize_Value := False; 105 Self.Space_Before := False; 106 107 if Self.Current_Attribute = No_Attribute then 108 Constructor (Self.Attributes, Symbol, Self.Current_Attribute); 109 Set_Attributes 110 (Self.Elements, Self.Current_Element, Self.Current_Attribute); 111 112 else 113 Last := Self.Current_Attribute; 114 Current := Self.Current_Attribute; 115 116 while Current /= No_Attribute loop 117 -- [XML 3.3] Attribute List Declarations 118 -- 119 -- "When more than one AttlistDecl is provided for a given element 120 -- type, the contents of all those provided are merged. When more 121 -- than one definition is provided for the same attribute of a 122 -- given element type, the first declaration is binding and later 123 -- declarations are ignored. For interoperability, writers of DTDs 124 -- may choose to provide at most one attribute-list declaration 125 -- for a given element type, at most one attribute definition for 126 -- a given attribute name in an attribute-list declaration, and at 127 -- least one attribute definition in each attribute-list 128 -- declaration. For interoperability, an XML processor MAY at user 129 -- option issue a warning when more than one attribute-list 130 -- declaration is provided for a given element type, or more than 131 -- one attribute definition is provided for a given attribute, but 132 -- this is not an error." 133 -- 134 -- Check whether attribute is declared already, report warning and 135 -- stop future processing. 136 137 if Name (Self.Attributes, Current) = Symbol then 138 Callbacks.Call_Warning 139 (Self, 140 League.Strings.To_Universal_String 141 ("[XML 3.3]" 142 & " more than one attribute definition is provided for" 143 & " the attribute")); 144 145 Self.Attribute_Redefined := True; 146 147 return; 148 end if; 149 150 Last := Current; 151 Current := Next (Self.Attributes, Current); 152 end loop; 153 154 Constructor (Self.Attributes, Symbol, Self.Current_Attribute); 155 Append (Self.Attributes, Last, Self.Current_Attribute); 156 end if; 157 158 -- Set attribute value normalization mode. 159 160 if not Is_CDATA (Self.Attributes, Self.Current_Attribute) then 161 Self.Normalize_Value := True; 162 Self.Space_Before := True; 163 end if; 164 end Analyze_Attribute_Declaration; 165 166 ------------------------ 167 -- On_Any_Declaration -- 168 ------------------------ 169 170 procedure On_Any_Declaration 171 (Self : in out Simple_Reader'Class) is 172 begin 173 Set_Is_Any (Self.Elements, Self.Current_Element, True); 174 end On_Any_Declaration; 175 176 -------------------------------------- 177 -- On_Attribute_Default_Declaration -- 178 -------------------------------------- 179 180 procedure On_Attribute_Default_Declaration 181 (Self : in out Simple_Reader'Class; 182 Default : Matreshka.Internals.Strings.Shared_String_Access) is 183 begin 184 if not Self.Attribute_Redefined then 185 Set_Default (Self.Attributes, Self.Current_Attribute, Default); 186 end if; 187 end On_Attribute_Default_Declaration; 188 189 ------------------------------------ 190 -- On_CDATA_Attribute_Declaration -- 191 ------------------------------------ 192 193 procedure On_CDATA_Attribute_Declaration 194 (Self : in out Simple_Reader'Class; 195 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 196 begin 197 Analyze_Attribute_Declaration (Self, Symbol, New_CDATA_Attribute'Access); 198 end On_CDATA_Attribute_Declaration; 199 200 -------------------- 201 -- On_CDATA_Close -- 202 -------------------- 203 204 procedure On_CDATA_Close (Self : in out Simple_Reader'Class) is 205 begin 206 Callbacks.Call_End_CDATA (Self); 207 end On_CDATA_Close; 208 209 ------------------- 210 -- On_CDATA_Open -- 211 ------------------- 212 213 procedure On_CDATA_Open (Self : in out Simple_Reader'Class) is 214 begin 215 Callbacks.Call_Start_CDATA (Self); 216 end On_CDATA_Open; 217 218 ----------------------- 219 -- On_Character_Data -- 220 ----------------------- 221 222 procedure On_Character_Data 223 (Self : in out Simple_Reader'Class; 224 Text : not null Matreshka.Internals.Strings.Shared_String_Access; 225 Is_Whitespace : Boolean) 226 is 227 Element : constant Element_Identifier 228 := Symbol_Tables.Element 229 (Self.Symbols, Self.Element_Names.Last_Element); 230 231 begin 232 if Is_Whitespace 233 and (Element /= No_Element 234 and then Is_Declared (Self.Elements, Element) 235 and then not (Is_Mixed_Content (Self.Elements, Element) 236 or Is_Any (Self.Elements, Element) 237 or Is_Empty (Self.Elements, Element))) 238 then 239 -- When character data contains only whitespaces and element is 240 -- not declared as mixed content, any content or empty, reports 241 -- ignorable whitespaces to application. 242 -- 243 -- XXX Check can be revritten: when character data contains only 244 -- whitespaces and element has element content, then reports 245 -- ignorable whitespaces to application. But, element content is not 246 -- supported now. 247 248 Callbacks.Call_Ignorable_Whitespace (Self, Text); 249 250 else 251 Callbacks.Call_Characters (Self, Text); 252 end if; 253 end On_Character_Data; 254 255 -------------------------- 256 -- On_Element_Attribute -- 257 -------------------------- 258 259 procedure On_Element_Attribute 260 (Self : in out Simple_Reader'Class; 261 Symbol : Matreshka.Internals.XML.Symbol_Identifier; 262 Value : not null Matreshka.Internals.Strings.Shared_String_Access) 263 is 264 Inserted : Boolean; 265 266 begin 267 if Self.Current_Attribute = No_Attribute then 268 Insert 269 (Self.Attribute_Set, Symbol, Value, Symbol_CDATA, True, Inserted); 270 271 else 272 Insert 273 (Self.Attribute_Set, 274 Symbol, 275 Value, 276 Symbol_Of_Type_Name (Self.Attributes, Self.Current_Attribute), 277 True, 278 Inserted); 279 end if; 280 281 if not Inserted then 282 -- 3.1 WFC: Unique Att Spec 283 -- 284 -- An attribute name MUST NOT appear more than once in the same 285 -- start-tag or empty-element tag. 286 287 Callbacks.Call_Fatal_Error 288 (Self, 289 League.Strings.To_Universal_String 290 ("[3.1 WFC: Unique Att Spec]" 291 & " an attribute name must not appear more than once" 292 & " in the same tag")); 293 end if; 294 end On_Element_Attribute; 295 296 ------------------------------- 297 -- On_Element_Attribute_Name -- 298 ------------------------------- 299 300 procedure On_Element_Attribute_Name 301 (Self : in out Simple_Reader'Class; 302 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 303 begin 304 Self.Normalize_Value := False; 305 Self.Space_Before := False; 306 Self.Current_Attribute := No_Attribute; 307 308 if Self.Current_Element /= No_Element then 309 Self.Current_Attribute := 310 Element_Tables.Attributes (Self.Elements, Self.Current_Element); 311 312 while Self.Current_Attribute /= No_Attribute loop 313 if Name (Self.Attributes, Self.Current_Attribute) = Symbol then 314 if not Is_CDATA (Self.Attributes, Self.Current_Attribute) then 315 Self.Normalize_Value := True; 316 Self.Space_Before := True; 317 end if; 318 319 exit; 320 end if; 321 322 Self.Current_Attribute := 323 Next (Self.Attributes, Self.Current_Attribute); 324 end loop; 325 end if; 326 end On_Element_Attribute_Name; 327 328 -------------------------- 329 -- On_Empty_Declaration -- 330 -------------------------- 331 332 procedure On_Empty_Declaration 333 (Self : in out Simple_Reader'Class) is 334 begin 335 Set_Is_Empty (Self.Elements, Self.Current_Element, True); 336 end On_Empty_Declaration; 337 338 -------------------------- 339 -- On_Empty_Element_Tag -- 340 -------------------------- 341 342 procedure On_Empty_Element_Tag (Self : in out Simple_Reader'Class) is 343 begin 344 On_Start_Tag (Self); 345 346 if Self.Continue then 347 -- When error detected or caller's requests processing termination 348 -- end of tag should not be processed. 349 350 On_End_Tag (Self, Self.Current_Element_Name); 351 end if; 352 end On_Empty_Element_Tag; 353 354 ------------------------ 355 -- On_End_Of_Document -- 356 ------------------------ 357 358 procedure On_End_Of_Document (Self : in out Simple_Reader'Class) is 359 begin 360 Callbacks.Call_End_Document (Self); 361 end On_End_Of_Document; 362 363 ----------------------------------------- 364 -- On_End_Of_Document_Type_Declaration -- 365 ----------------------------------------- 366 367 procedure On_End_Of_Document_Type_Declaration 368 (Self : in out Simple_Reader'Class) is 369 begin 370 Analyzer.Analyze_Document_Type_Declaration (Self); 371 Callbacks.Call_End_DTD (Self); 372 Self.Validation.Has_DTD := True; 373 Self.In_Document_Content := True; 374 end On_End_Of_Document_Type_Declaration; 375 376 ---------------- 377 -- On_End_Tag -- 378 ---------------- 379 380 procedure On_End_Tag 381 (Self : in out Simple_Reader'Class; 382 Symbol : Matreshka.Internals.XML.Symbol_Identifier) 383 is 384 385 procedure Notify_Unmap 386 (Prefix : Matreshka.Internals.XML.Symbol_Identifier); 387 -- Calls handler to notify about unmapping of prefix. 388 389 ------------------ 390 -- Notify_Unmap -- 391 ------------------ 392 393 procedure Notify_Unmap 394 (Prefix : Matreshka.Internals.XML.Symbol_Identifier) is 395 begin 396 Callbacks.Call_End_Prefix_Mapping (Self, Name (Self.Symbols, Prefix)); 397 end Notify_Unmap; 398 399 begin 400 -- [3 WFC: Element Type Match] 401 -- 402 -- The Name in an element's end-tag MUST match the element type in the 403 -- start-tag. 404 405 if Self.Element_Names.Last_Element /= Symbol then 406 Callbacks.Call_Fatal_Error 407 (Self, 408 League.Strings.To_Universal_String 409 ("[3 WFC: Element Type Match]" 410 & " end tag name must match start tag name")); 411 412 else 413 if Self.Namespaces.Enabled then 414 Callbacks.Call_End_Element 415 (Self => Self, 416 Namespace_URI => 417 Name 418 (Self.Symbols, 419 Resolve 420 (Self.Namespace_Scope, 421 Prefix_Name (Self.Symbols, Symbol))), 422 Local_Name => Local_Name (Self.Symbols, Symbol), 423 Qualified_Name => Name (Self.Symbols, Symbol)); 424 Pop_Scope (Self.Bases); 425 Pop_Scope (Self.Namespace_Scope, Notify_Unmap'Access); 426 427 else 428 Callbacks.Call_End_Element 429 (Self => Self, 430 Namespace_URI => 431 Matreshka.Internals.Strings.Shared_Empty'Access, 432 Local_Name => 433 Matreshka.Internals.Strings.Shared_Empty'Access, 434 Qualified_Name => Name (Self.Symbols, Symbol)); 435 Pop_Scope (Self.Bases); 436 end if; 437 438 Self.Element_Names.Delete_Last; 439 end if; 440 end On_End_Tag; 441 442 --------------------------------------- 443 -- On_Entities_Attribute_Declaration -- 444 --------------------------------------- 445 446 procedure On_Entities_Attribute_Declaration 447 (Self : in out Simple_Reader'Class; 448 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 449 begin 450 Analyze_Attribute_Declaration 451 (Self, Symbol, New_Entities_Attribute'Access); 452 end On_Entities_Attribute_Declaration; 453 454 ------------------------------------- 455 -- On_Entity_Attribute_Declaration -- 456 ------------------------------------- 457 458 procedure On_Entity_Attribute_Declaration 459 (Self : in out Simple_Reader'Class; 460 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 461 begin 462 Analyze_Attribute_Declaration 463 (Self, Symbol, New_Entity_Attribute'Access); 464 end On_Entity_Attribute_Declaration; 465 466 ------------------------------------------ 467 -- On_Enumeration_Attribute_Declaration -- 468 ------------------------------------------ 469 470 procedure On_Enumeration_Attribute_Declaration 471 (Self : in out Simple_Reader'Class; 472 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 473 begin 474 Self.Notation_Attribute := False; 475 Analyze_Attribute_Declaration 476 (Self, Symbol, New_Enumeration_Attribute'Access); 477 end On_Enumeration_Attribute_Declaration; 478 479 -------------------------------------------- 480 -- On_Fixed_Attribute_Default_Declaration -- 481 -------------------------------------------- 482 483 procedure On_Fixed_Attribute_Default_Declaration 484 (Self : in out Simple_Reader'Class; 485 Default : Matreshka.Internals.Strings.Shared_String_Access) is 486 begin 487 if not Self.Attribute_Redefined then 488 Set_Is_Fixed (Self.Attributes, Self.Current_Attribute, True); 489 Set_Default (Self.Attributes, Self.Current_Attribute, Default); 490 end if; 491 end On_Fixed_Attribute_Default_Declaration; 492 493 ----------------------------------- 494 -- On_General_Entity_Declaration -- 495 ----------------------------------- 496 497 procedure On_General_Entity_Declaration 498 (Self : in out Simple_Reader'Class; 499 Symbol : Matreshka.Internals.XML.Symbol_Identifier; 500 Is_External : Boolean; 501 Value : League.Strings.Universal_String; 502 Notation : Matreshka.Internals.XML.Symbol_Identifier) 503 is 504 Name : constant League.Strings.Universal_String 505 := Matreshka.Internals.XML.Symbol_Tables.Name (Self.Symbols, Symbol); 506 Entity : Entity_Identifier; 507 508 begin 509 -- [XML 4.2 Entities Declaration] 510 -- 511 -- "The Name identifies the entity in an entity reference or, in the 512 -- case of an unparsed entity, in the value of an ENTITY or ENTITIES 513 -- attribute. If the same entity is declared more than once, the first 514 -- declaration encountered is binding; at user option, an XML processor 515 -- MAY issue a warning if entities are declared multiple times." 516 -- 517 -- Check whether entity is always declared. 518 519 if General_Entity (Self.Symbols, Symbol) /= No_Entity then 520 Callbacks.Call_Warning 521 (Self, 522 League.Strings.To_Universal_String 523 ("[XML 4.2 Entities Declaration]" 524 & " general entity is already declared")); 525 526 return; 527 end if; 528 529 if Is_External then 530 if Notation = No_Symbol then 531 New_External_Parsed_General_Entity 532 (Self.Entities, 533 Self.Scanner_State.Entity, 534 Symbol, 535 Self.Public_Id, 536 Self.System_Id, 537 Base_URI (Self.Bases).To_Universal_String, 538 Entity); 539 Set_General_Entity (Self.Symbols, Symbol, Entity); 540 Callbacks.Call_External_Entity_Declaration 541 (Self, Name, Self.Public_Id, Self.System_Id); 542 543 else 544 New_External_Unparsed_General_Entity 545 (Self.Entities, 546 Self.Scanner_State.Entity, 547 Symbol, 548 Notation, 549 Entity); 550 Set_General_Entity (Self.Symbols, Symbol, Entity); 551 Callbacks.Call_Unparsed_Entity_Declaration 552 (Self, 553 Name, 554 Self.Public_Id, 555 Self.System_Id, 556 Matreshka.Internals.XML.Symbol_Tables.Name 557 (Self.Symbols, Notation)); 558 end if; 559 560 else 561 declare 562 A : Matreshka.Internals.Strings.Shared_String_Access; 563 564 begin 565 A := League.Strings.Internals.Internal (Value); 566 Matreshka.Internals.Strings.Reference (A); 567 New_Internal_General_Entity 568 (Self.Entities, Self.Scanner_State.Entity, Symbol, A, Entity); 569 Set_General_Entity (Self.Symbols, Symbol, Entity); 570 Callbacks.Call_Internal_Entity_Declaration (Self, Name, Value); 571 end; 572 end if; 573 end On_General_Entity_Declaration; 574 575 --------------------------------- 576 -- On_Id_Attribute_Declaration -- 577 --------------------------------- 578 579 procedure On_Id_Attribute_Declaration 580 (Self : in out Simple_Reader'Class; 581 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 582 begin 583 Analyze_Attribute_Declaration (Self, Symbol, New_Id_Attribute'Access); 584 585 if not Self.Attribute_Redefined then 586 -- [XML 3.3.1 VC: One ID per Element Type] 587 -- 588 -- "An element type MUST NOT have more than one ID attribute 589 -- specified." 590 -- 591 -- Checking whether no other attributes with type ID for element. 592 593 if Self.Validation.Enabled then 594 declare 595 Current : Attribute_Identifier 596 := Element_Tables.Attributes 597 (Self.Elements, Self.Current_Element); 598 599 begin 600 while Current /= No_Attribute loop 601 if Current /= Self.Current_Attribute 602 and Is_ID (Self.Attributes, Current) 603 then 604 Callbacks.Call_Error 605 (Self, 606 League.Strings.To_Universal_String 607 ("[XML 3.3.1 VC: One ID per Element Type]" 608 & " element type must not have more than one ID" 609 & " attribute specified")); 610 611 exit; 612 end if; 613 614 Current := Next (Self.Attributes, Current); 615 end loop; 616 end; 617 end if; 618 end if; 619 end On_Id_Attribute_Declaration; 620 621 ------------------------------------ 622 -- On_IdRef_Attribute_Declaration -- 623 ------------------------------------ 624 625 procedure On_IdRef_Attribute_Declaration 626 (Self : in out Simple_Reader'Class; 627 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 628 begin 629 Analyze_Attribute_Declaration (Self, Symbol, New_IdRef_Attribute'Access); 630 end On_IdRef_Attribute_Declaration; 631 632 ------------------------------------- 633 -- On_IdRefs_Attribute_Declaration -- 634 ------------------------------------- 635 636 procedure On_IdRefs_Attribute_Declaration 637 (Self : in out Simple_Reader'Class; 638 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 639 begin 640 Analyze_Attribute_Declaration 641 (Self, Symbol, New_IdRefs_Attribute'Access); 642 end On_IdRefs_Attribute_Declaration; 643 644 ---------------------------------------------- 645 -- On_Implied_Attribute_Default_Declaration -- 646 ---------------------------------------------- 647 648 procedure On_Implied_Attribute_Default_Declaration 649 (Self : in out Simple_Reader'Class) is 650 begin 651 if not Self.Attribute_Redefined then 652 Set_Is_Implied (Self.Attributes, Self.Current_Attribute, True); 653 end if; 654 end On_Implied_Attribute_Default_Declaration; 655 656 ---------------------------------- 657 -- On_Mixed_Content_Declaration -- 658 ---------------------------------- 659 660 procedure On_Mixed_Content_Declaration 661 (Self : in out Simple_Reader'Class; 662 Is_Any : Boolean) is 663 begin 664 Set_Is_Mixed_Content (Self.Elements, Self.Current_Element, True); 665 666 -- [XML] 667 -- 668 -- [51] Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' 669 -- | '(' S? '#PCDATA' S? ')' 670 -- 671 -- Check whether asterisk is present when content has children elements. 672 673 if not Is_Any 674 and Has_Children (Self.Elements, Self.Current_Element) 675 then 676 Callbacks.Call_Fatal_Error 677 (Self, 678 League.Strings.To_Universal_String 679 ("[XML [51]] asterisk must be present after close parenthesis")); 680 681 return; 682 end if; 683 end On_Mixed_Content_Declaration; 684 685 ------------------------------------------ 686 -- On_Name_In_Mixed_Content_Declaration -- 687 ------------------------------------------ 688 689 procedure On_Name_In_Mixed_Content_Declaration 690 (Self : in out Simple_Reader'Class) is 691 begin 692 Set_Has_Children (Self.Elements, Self.Current_Element, True); 693 end On_Name_In_Mixed_Content_Declaration; 694 695 -------------------------------------- 696 -- On_NmToken_Attribute_Declaration -- 697 -------------------------------------- 698 699 procedure On_NmToken_Attribute_Declaration 700 (Self : in out Simple_Reader'Class; 701 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 702 begin 703 Analyze_Attribute_Declaration 704 (Self, Symbol, New_NmToken_Attribute'Access); 705 end On_NmToken_Attribute_Declaration; 706 707 --------------------------------------- 708 -- On_NmTokens_Attribute_Declaration -- 709 --------------------------------------- 710 711 procedure On_NmTokens_Attribute_Declaration 712 (Self : in out Simple_Reader'Class; 713 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 714 begin 715 Analyze_Attribute_Declaration 716 (Self, Symbol, New_NmTokens_Attribute'Access); 717 end On_NmTokens_Attribute_Declaration; 718 719 ------------------------------------- 720 -- On_No_Document_Type_Declaration -- 721 ------------------------------------- 722 723 procedure On_No_Document_Type_Declaration 724 (Self : in out Simple_Reader'Class) is 725 begin 726 if Self.Validation.Enabled then 727 -- Document doesn't have document type declaration. 728 -- 729 -- "[Definition: An XML document is valid if it has an associated 730 -- document type declaration and if the document complies with the 731 -- constraints expressed in it.]" 732 733 Callbacks.Call_Error 734 (Self, 735 League.Strings.To_Universal_String 736 ("Document doesn't have document type declaration")); 737 end if; 738 739 Self.Validation.Has_DTD := False; 740 741 Self.In_Document_Content := True; 742 end On_No_Document_Type_Declaration; 743 744 --------------------------------------- 745 -- On_Notation_Attribute_Declaration -- 746 --------------------------------------- 747 748 procedure On_Notation_Attribute_Declaration 749 (Self : in out Simple_Reader'Class; 750 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 751 begin 752 Self.Notation_Attribute := True; 753 Analyze_Attribute_Declaration 754 (Self, Symbol, New_Notation_Attribute'Access); 755 end On_Notation_Attribute_Declaration; 756 757 ----------------------------- 758 -- On_Notation_Declaration -- 759 ----------------------------- 760 761 procedure On_Notation_Declaration 762 (Self : in out Simple_Reader'Class; 763 Name : Matreshka.Internals.XML.Symbol_Identifier; 764 Public_Id : not null Matreshka.Internals.Strings.Shared_String_Access; 765 System_Id : not null Matreshka.Internals.Strings.Shared_String_Access) 766 is 767 Notation : Notation_Identifier; 768 769 begin 770 if Symbol_Tables.Notation (Self.Symbols, Name) /= No_Notation then 771 -- [XML VC: Unique Notation Name] 772 -- 773 -- "A given name must not be declared in more than one notation 774 -- declaration." 775 -- 776 -- Reports error when validation is enabled. 777 778 if Self.Validation.Enabled then 779 Callbacks.Call_Error 780 (Self, 781 League.Strings.To_Universal_String 782 ("[XML VC: Unique Notation Name]" 783 & " another notation is declared with this name")); 784 end if; 785 786 else 787 New_Notation (Self.Notations, Name, Public_Id, System_Id, Notation); 788 Set_Notation (Self.Symbols, Name, Notation); 789 Callbacks.Call_Notation_Declaration 790 (Self, Name, Public_Id, System_Id); 791 end if; 792 end On_Notation_Declaration; 793 794 -------------------- 795 -- On_Open_Of_Tag -- 796 -------------------- 797 798 procedure On_Open_Of_Tag 799 (Self : in out Simple_Reader'Class; 800 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 801 begin 802 -- Save name of element and resolve it. 803 804 Self.Current_Element_Name := Symbol; 805 Self.Current_Element := Element (Self.Symbols, Symbol); 806 end On_Open_Of_Tag; 807 808 ------------------------------------- 809 -- On_Parameter_Entity_Declaration -- 810 ------------------------------------- 811 812 procedure On_Parameter_Entity_Declaration 813 (Self : in out Simple_Reader'Class; 814 Symbol : Matreshka.Internals.XML.Symbol_Identifier; 815 Is_External : Boolean; 816 Value : League.Strings.Universal_String) 817 is 818 Entity : Entity_Identifier; 819 820 begin 821 -- [XML 4.2 Entities Declaration] 822 -- 823 -- "The Name identifies the entity in an entity reference or, in the 824 -- case of an unparsed entity, in the value of an ENTITY or ENTITIES 825 -- attribute. If the same entity is declared more than once, the first 826 -- declaration encountered is binding; at user option, an XML processor 827 -- MAY issue a warning if entities are declared multiple times." 828 -- 829 -- Check whether entity is always declared. 830 831 if Parameter_Entity (Self.Symbols, Symbol) /= No_Entity then 832 Callbacks.Call_Warning 833 (Self, 834 League.Strings.To_Universal_String 835 ("[XML 4.2 Entities Declaration]" 836 & " parameter entity is already declared")); 837 838 return; 839 end if; 840 841 if Is_External then 842-- if Base_URI (Self.Bases).Is_Empty then 843-- raise Program_Error; 844-- end if; 845 846 New_External_Parameter_Entity 847 (Self.Entities, 848 Self.Scanner_State.Entity, 849 Symbol, 850 Self.Public_Id, 851 Self.System_Id, 852 Base_URI (Self.Bases).To_Universal_String, 853 Entity); 854 Set_Parameter_Entity (Self.Symbols, Symbol, Entity); 855 856 else 857 declare 858 A : Matreshka.Internals.Strings.Shared_String_Access; 859 860 begin 861 A := League.Strings.Internals.Internal (Value); 862 Matreshka.Internals.Strings.Reference (A); 863 New_Internal_Parameter_Entity 864 (Self.Entities, 865 Self.Scanner_State.Entity, 866 Symbol, 867 A, 868 Entity); 869 Set_Parameter_Entity (Self.Symbols, Symbol, Entity); 870 end; 871 end if; 872 end On_Parameter_Entity_Declaration; 873 874 ------------------------------- 875 -- On_Processing_Instruction -- 876 ------------------------------- 877 878 procedure On_Processing_Instruction 879 (Self : in out Simple_Reader'Class; 880 Target : Matreshka.Internals.XML.Symbol_Identifier; 881 Data : not null Matreshka.Internals.Strings.Shared_String_Access) 882 is 883 Target_Name : 884 constant not null Matreshka.Internals.Strings.Shared_String_Access 885 := Name (Self.Symbols, Target); 886 887 begin 888 -- [XML1.1 4.3.3 Character Encoding in Entities] 889 -- 890 -- "It is a fatal error for a TextDecl to occur other than at the 891 -- beginning of an external entity." 892 893 if Target = Symbol_xml then 894 if Is_Document_Entity (Self.Entities, Self.Scanner_State.Entity) then 895 Callbacks.Call_Fatal_Error 896 (Self, 897 League.Strings.To_Universal_String 898 ("XML declaration must not occur other than at the beginning" 899 & " of document entity")); 900 901 return; 902 903 else 904 Callbacks.Call_Fatal_Error 905 (Self, 906 League.Strings.To_Universal_String 907 ("text declaration must not occur other than at the beginning" 908 & " of external entity")); 909 910 return; 911 end if; 912 end if; 913 914 -- [XML1.1 2.6 Processing Instructions] 915 -- 916 -- "... The target names "XML", "xml", and so on are reserved for 917 -- standardization in this or future versions of this specification. 918 -- ..." 919 920 if Target_Name.Unused = 3 921 and (Target_Name.Value (0) = Latin_Capital_Letter_X 922 or Target_Name.Value (0) = Latin_Small_Letter_X) 923 and (Target_Name.Value (1) = Latin_Capital_Letter_M 924 or Target_Name.Value (1) = Latin_Small_Letter_M) 925 and (Target_Name.Value (2) = Latin_Capital_Letter_L 926 or Target_Name.Value (2) = Latin_Small_Letter_L) 927 then 928 Callbacks.Call_Fatal_Error 929 (Self, 930 League.Strings.To_Universal_String 931 ("name is reserved for future standardization")); 932 933 return; 934 end if; 935 936 Callbacks.Call_Processing_Instruction (Self, Target, Data); 937 end On_Processing_Instruction; 938 939 ----------------------------------------------- 940 -- On_Required_Attribute_Default_Declaration -- 941 ----------------------------------------------- 942 943 procedure On_Required_Attribute_Default_Declaration 944 (Self : in out Simple_Reader'Class) is 945 begin 946 if not Self.Attribute_Redefined then 947 Set_Is_Required (Self.Attributes, Self.Current_Attribute, True); 948 end if; 949 end On_Required_Attribute_Default_Declaration; 950 951 ------------------- 952 -- On_Standalone -- 953 ------------------- 954 955 procedure On_Standalone 956 (Self : in out Simple_Reader'Class; 957 Text : not null Matreshka.Internals.Strings.Shared_String_Access) is 958 begin 959 if Text.Unused = 2 960 and then Text.Value (0) = Latin_Small_Letter_N 961 and then Text.Value (1) = Latin_Small_Letter_O 962 then 963 Self.Is_Standalone := False; 964 965 elsif Text.Unused = 3 966 and then Text.Value (0) = Latin_Small_Letter_Y 967 and then Text.Value (1) = Latin_Small_Letter_E 968 and then Text.Value (2) = Latin_Small_Letter_S 969 then 970 Self.Is_Standalone := True; 971 972 else 973 Callbacks.Call_Fatal_Error 974 (Self, 975 League.Strings.To_Universal_String 976 ("[XML [32]] valid values for standalone are 'yes' or 'no'")); 977 end if; 978 end On_Standalone; 979 980 -------------------------------------------- 981 -- On_Start_Of_Attribute_List_Declaration -- 982 -------------------------------------------- 983 984 procedure On_Start_Of_Attribute_List_Declaration 985 (Self : in out Simple_Reader'Class; 986 Symbol : Symbol_Identifier) is 987 begin 988 Self.Current_Element := Element (Self.Symbols, Symbol); 989 990 -- Check whether element entry was allocated and allocate entry when 991 -- necessary. 992 993 if Self.Current_Element = No_Element then 994 New_Element (Self.Elements, Self.Current_Element); 995 Set_Element (Self.Symbols, Symbol, Self.Current_Element); 996 end if; 997 998 -- [XML 3.3] Attribute List Declarations 999 -- 1000 -- "When more than one AttlistDecl is provided for a given element type, 1001 -- the contents of all those provided are merged. When more than one 1002 -- definition is provided for the same attribute of a given element 1003 -- type, the first declaration is binding and later declarations are 1004 -- ignored. For interoperability, writers of DTDs may choose to provide 1005 -- at most one attribute-list declaration for a given element type, at 1006 -- most one attribute definition for a given attribute name in an 1007 -- attribute-list declaration, and at least one attribute definition in 1008 -- each attribute-list declaration. For interoperability, an XML 1009 -- processor MAY at user option issue a warning when more than one 1010 -- attribute-list declaration is provided for a given element type, or 1011 -- more than one attribute definition is provided for a given attribute, 1012 -- but this is not an error." 1013 -- 1014 -- Check whether attribute list declaration is already provided for 1015 -- element type. 1016 1017 if Is_Attributes_Declared (Self.Elements, Self.Current_Element) then 1018 Callbacks.Call_Warning 1019 (Self, 1020 League.Strings.To_Universal_String 1021 ("[XML 3.3]" 1022 & " more than one attribute list declaration is provided for" 1023 & " the element type")); 1024 end if; 1025 1026 Set_Is_Attributes_Declared (Self.Elements, Self.Current_Element, True); 1027 end On_Start_Of_Attribute_List_Declaration; 1028 1029 -------------------------- 1030 -- On_Start_Of_Document -- 1031 -------------------------- 1032 1033 procedure On_Start_Of_Document 1034 (Self : in out Simple_Reader'Class) is 1035 begin 1036 Callbacks.Call_Start_Document (Self); 1037 end On_Start_Of_Document; 1038 1039 ------------------------------------------- 1040 -- On_Start_Of_Document_Type_Declaration -- 1041 ------------------------------------------- 1042 1043 procedure On_Start_Of_Document_Type_Declaration 1044 (Self : in out Simple_Reader'Class; 1045 Name : Matreshka.Internals.XML.Symbol_Identifier; 1046 External : Boolean) is 1047 begin 1048 Self.Root_Symbol := Name; 1049 1050 if External then 1051 New_External_Subset_Entity 1052 (Self.Entities, 1053 Self.Scanner_State.Entity, 1054 Self.Public_Id, 1055 Self.System_Id, 1056 Base_URI (Self.Bases).To_Universal_String, 1057 Self.External_Subset_Entity); 1058 Callbacks.Call_Start_DTD 1059 (Self, 1060 Name, 1061 League.Strings.Internals.Internal (Self.Public_Id), 1062 League.Strings.Internals.Internal (Self.System_Id)); 1063 1064 else 1065 Callbacks.Call_Start_DTD 1066 (Self, 1067 Name, 1068 Matreshka.Internals.Strings.Shared_Empty'Access, 1069 Matreshka.Internals.Strings.Shared_Empty'Access); 1070 end if; 1071 end On_Start_Of_Document_Type_Declaration; 1072 1073 ------------------------------------- 1074 -- On_Start_Of_Element_Declaration -- 1075 ------------------------------------- 1076 1077 procedure On_Start_Of_Element_Declaration 1078 (Self : in out Simple_Reader'Class; 1079 Symbol : Matreshka.Internals.XML.Symbol_Identifier) is 1080 begin 1081 Self.Current_Element := Element (Self.Symbols, Symbol); 1082 1083 if Self.Current_Element /= No_Element then 1084 -- [XML1.1 3.2 VC: Unique Element Type Declaration] 1085 -- 1086 -- "An element type MUST NOT be declared more than once." 1087 -- 1088 -- Check whether validation is enabled and element type is already 1089 -- declared. 1090 1091 if Self.Validation.Enabled 1092 and Is_Declared (Self.Elements, Self.Current_Element) 1093 then 1094 Callbacks.Call_Error 1095 (Self, 1096 League.Strings.To_Universal_String 1097 ("[XML1.1 3.2 VC: Unique Element Type Declaration]" 1098 & " element type must not be declared more than once")); 1099 end if; 1100 1101 else 1102 New_Element (Self.Elements, Self.Current_Element); 1103 Set_Element (Self.Symbols, Symbol, Self.Current_Element); 1104 end if; 1105 1106 Set_Is_Declared (Self.Elements, Self.Current_Element, True); 1107 end On_Start_Of_Element_Declaration; 1108 1109 ------------------ 1110 -- On_Start_Tag -- 1111 ------------------ 1112 1113 procedure On_Start_Tag (Self : in out Simple_Reader'Class) is 1114 1115 procedure Convert; 1116 -- Converts internal set of element's attributes into user visible set. 1117 -- Namespace declaration attributes are ignored when namespace 1118 -- processing is enabled and reporting of namespace prefixes is turned 1119 -- off. 1120 1121 ------------- 1122 -- Convert -- 1123 ------------- 1124 1125 procedure Convert is 1126 begin 1127 for J in 1 .. Length (Self.Attribute_Set) loop 1128 declare 1129 Qname : constant Symbol_Identifier 1130 := Qualified_Name (Self.Attribute_Set, J); 1131 1132 begin 1133 if not Self.Namespaces.Enabled 1134 or (Self.Namespaces.Prefixes 1135 or (Qname /= Symbol_xmlns 1136 and Prefix_Name (Self.Symbols, Qname) 1137 /= Symbol_xmlns)) 1138 then 1139 XML.SAX.Attributes.Internals.Unchecked_Append 1140 (Self.SAX_Attributes, 1141 Name (Self.Symbols, Namespace_URI (Self.Attribute_Set, J)), 1142 Local_Name (Self.Symbols, Qname), 1143 Name (Self.Symbols, Qname), 1144 Value (Self.Attribute_Set, J), 1145 Name (Self.Symbols, Type_Name (Self.Attribute_Set, J)), 1146 Is_Declared (Self.Attribute_Set, J), 1147 Is_Specified (Self.Attribute_Set, J)); 1148 end if; 1149 end; 1150 end loop; 1151 end Convert; 1152 1153 Element_Prefix : Symbol_Identifier; 1154 Element_Namespace : Symbol_Identifier := No_Symbol; 1155 Element_Namespace_URI : Matreshka.Internals.Strings.Shared_String_Access; 1156 Element_Local_Name : Matreshka.Internals.Strings.Shared_String_Access; 1157 Element_Qualified_Name : 1158 Matreshka.Internals.Strings.Shared_String_Access; 1159 1160 begin 1161 Self.Element_Names.Append (Self.Current_Element_Name); 1162 1163 Self.Current_Element := 1164 Element (Self.Symbols, Self.Current_Element_Name); 1165 1166 -- Append attributes with default values and mark declared attributes. 1167 1168 if Self.Current_Element /= No_Element then 1169 declare 1170 Current : Attribute_Identifier 1171 := Element_Tables.Attributes 1172 (Self.Elements, Self.Current_Element); 1173 Inserted : Boolean; 1174 1175 begin 1176 while Current /= No_Attribute loop 1177 if Has_Default (Self.Attributes, Current) then 1178 Insert 1179 (Self.Attribute_Set, 1180 Name (Self.Attributes, Current), 1181 Default (Self.Attributes, Current), 1182 Symbol_Of_Type_Name (Self.Attributes, Current), 1183 False, 1184 Inserted); 1185 end if; 1186 1187 for J in 1 .. Length (Self.Attribute_Set) loop 1188 if Qualified_Name (Self.Attribute_Set, J) 1189 = Name (Self.Attributes, Current) 1190 then 1191 Set_Is_Declared (Self.Attribute_Set, J); 1192 1193 exit; 1194 end if; 1195 end loop; 1196 1197 Current := Next (Self.Attributes, Current); 1198 end loop; 1199 end; 1200 end if; 1201 1202 -- [XMLBase] - look for 'xml:base' attribute, compute new base URI when 1203 -- necessary and push scope. 1204 1205 declare 1206 Found : Boolean := False; 1207 1208 begin 1209 for J in 1 .. Length (Self.Attribute_Set) loop 1210 if Qualified_Name (Self.Attribute_Set, J) = Symbol_xml_base then 1211 -- 'xml:base' detected by its qualified name, because namespace 1212 -- resolution is not done at this point and nor 'xml' prefix 1213 -- nor namespace can't be bound to another prefix/namespace. 1214 1215 Push_Scope 1216 (Self.Bases, 1217 Base_URI (Self.Bases).Resolve 1218 (League.IRIs.From_Universal_String 1219 (League.Strings.Internals.Create 1220 (Value (Self.Attribute_Set, J))))); 1221 Found := True; 1222 1223 exit; 1224 end if; 1225 end loop; 1226 1227 if not Found then 1228 Push_Scope (Self.Bases); 1229 end if; 1230 end; 1231 1232 if Self.Namespaces.Enabled then 1233 Push_Scope (Self.Namespace_Scope); 1234 1235 -- [NSXML1.1 3 NSC: Reserved Prefixes and Namespace Names] 1236 -- 1237 -- "The prefix xmlns is used only to declare namespace bindings 1238 -- and is by definition bound to the namespace name 1239 -- http://www.w3.org/2000/xmlns/. It must not be declared or 1240 -- undeclared. Other prefixes must not be bound to this namespace 1241 -- name, and it must not be declared as the default namespace. 1242 -- Element names must not have the prefix xmlns." 1243 -- 1244 -- Check whether element name doesn't have xmlns prefix. 1245 1246 if Prefix_Name (Self.Symbols, Self.Current_Element_Name) 1247 = Symbol_xmlns 1248 then 1249 Callbacks.Call_Fatal_Error 1250 (Self, 1251 League.Strings.To_Universal_String 1252 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1253 & " Names] element must not have the prefix xmlns")); 1254 1255 return; 1256 end if; 1257 1258 -- Process namespace attributes. 1259 1260 for J in 1 .. Length (Self.Attribute_Set) loop 1261 declare 1262 Qname : constant Symbol_Identifier 1263 := Qualified_Name (Self.Attribute_Set, J); 1264 Ns : Symbol_Identifier; 1265 Lname : Symbol_Identifier; 1266 1267 begin 1268 if Qname = Symbol_xmlns then 1269 -- Default namespace. 1270 1271 Insert (Self.Symbols, Value (Self.Attribute_Set, J), Ns); 1272 1273 -- [NSXML1.1 3 NSC: Reserved Prefixes and Namespace Names] 1274 -- 1275 -- "The prefix xml is by definition bound to the namespace 1276 -- name http://www.w3.org/XML/1998/namespace. It may, but 1277 -- need not, be declared, and must not be undeclared or 1278 -- bound to any other namespace name. Other prefixes must 1279 -- not be bound to this namespace name, and it must not be 1280 -- declared as the default namespace." 1281 -- 1282 -- Check whether xml namespace name is not declared as 1283 -- default namespace. 1284 1285 if Ns = Symbol_xml_NS then 1286 Callbacks.Call_Fatal_Error 1287 (Self, 1288 League.Strings.To_Universal_String 1289 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1290 & " Names] the xml namespace must not be declared" 1291 & " as the default namespace")); 1292 1293 return; 1294 end if; 1295 1296 -- [NSXML1.1 3 NSC: Reserved Prefixes and Namespace Names] 1297 -- 1298 -- "The prefix xmlns is used only to declare namespace 1299 -- bindings and is by definition bound to the namespace 1300 -- name http://www.w3.org/2000/xmlns/. It must not be 1301 -- declared or undeclared. Other prefixes must not be 1302 -- bound to this namespace name, and it must not be 1303 -- declared as the default namespace. Element names must 1304 -- not have the prefix xmlns." 1305 -- 1306 -- Check whether xmlns namespace name is not declared as 1307 -- default namespace. 1308 1309 if Ns = Symbol_xmlns_NS then 1310 Callbacks.Call_Fatal_Error 1311 (Self, 1312 League.Strings.To_Universal_String 1313 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1314 & " Names] the xmlns namespace must not be declared" 1315 & " as the default namespace")); 1316 1317 return; 1318 end if; 1319 1320 Bind (Self.Namespace_Scope, No_Symbol, Ns); 1321 1322 Callbacks.Call_Start_Prefix_Mapping 1323 (Self, 1324 Matreshka.Internals.Strings.Shared_Empty'Access, 1325 Name (Self.Symbols, Ns)); 1326 1327 if not Self.Continue then 1328 -- Application requests end of execution. 1329 1330 return; 1331 end if; 1332 1333 elsif Prefix_Name (Self.Symbols, Qname) = Symbol_xmlns then 1334 -- Prefixed namespace. 1335 1336 Insert (Self.Symbols, Value (Self.Attribute_Set, J), Ns); 1337 Lname := Local_Name (Self.Symbols, Qname); 1338 1339 -- [NSXML1.1 3 NSC: Reserved Prefixes and Namespace Names] 1340 -- 1341 -- "The prefix xml is by definition bound to the namespace 1342 -- name http://www.w3.org/XML/1998/namespace. It may, but 1343 -- need not, be declared, and must not be undeclared or 1344 -- bound to any other namespace name. Other prefixes must 1345 -- not be bound to this namespace name, and it must not be 1346 -- declared as the default namespace." 1347 -- 1348 -- Check whether xml prefix is not undeclared. 1349 1350 if Ns = No_Symbol and Lname = Symbol_xml then 1351 Callbacks.Call_Fatal_Error 1352 (Self, 1353 League.Strings.To_Universal_String 1354 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1355 & " Names] xml prefix must not be undeclared")); 1356 1357 return; 1358 end if; 1359 1360 -- Check whether xml prefix is not bound to any other 1361 -- namespace name. 1362 1363 if Ns /= Symbol_xml_NS and Lname = Symbol_xml then 1364 Callbacks.Call_Fatal_Error 1365 (Self, 1366 League.Strings.To_Universal_String 1367 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1368 & " Names] xml prefix must not be bound to any" 1369 & " other namespace name")); 1370 1371 return; 1372 end if; 1373 1374 -- Check whether other prefixes is not bound to xml 1375 -- namespace name. 1376 1377 if Ns = Symbol_xml_NS and Lname /= Symbol_xml then 1378 Callbacks.Call_Fatal_Error 1379 (Self, 1380 League.Strings.To_Universal_String 1381 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1382 & " Names] other prefixes must not be bound to xml" 1383 & " namespace name")); 1384 1385 return; 1386 end if; 1387 1388 -- [NSXML1.1 3 NSC: Reserved Prefixes and Namespace Names] 1389 -- 1390 -- "The prefix xmlns is used only to declare namespace 1391 -- bindings and is by definition bound to the namespace 1392 -- name http://www.w3.org/2000/xmlns/. It must not be 1393 -- declared or undeclared. Other prefixes must not be 1394 -- bound to this namespace name, and it must not be 1395 -- declared as the default namespace. Element names must 1396 -- not have the prefix xmlns." 1397 -- 1398 -- Check whether declaring binding for xmlns. 1399 1400 if Ns /= No_Symbol and Lname = Symbol_xmlns then 1401 Callbacks.Call_Fatal_Error 1402 (Self, 1403 League.Strings.To_Universal_String 1404 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1405 & " Names] the xmlns prefix must not be declared")); 1406 1407 return; 1408 end if; 1409 1410 -- Check whether undeclaring binding for xmlns. 1411 1412 if Ns = No_Symbol and Lname = Symbol_xmlns then 1413 Callbacks.Call_Fatal_Error 1414 (Self, 1415 League.Strings.To_Universal_String 1416 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1417 & " Names] the xmlns prefix must not be" 1418 & " undeclared")); 1419 1420 return; 1421 end if; 1422 1423 -- Check whether prefix is bound to xmlns namespace name. 1424 1425 if Ns = Symbol_xmlns_NS and Lname /= Symbol_xmlns then 1426 Callbacks.Call_Fatal_Error 1427 (Self, 1428 League.Strings.To_Universal_String 1429 ("[NSXML1.1 3 NSC: Reserved Prefixes and Namespace" 1430 & " Names] prefix must not be bound to xmlns" 1431 & " namespace name")); 1432 1433 return; 1434 end if; 1435 1436 -- [NSXML1.1 6.1 Namespace Scoping] 1437 -- 1438 -- "The attribute value in a namespace declaration for a 1439 -- prefix MAY be empty. This has the effect, within the 1440 -- scope of the declaration, of removing any association of 1441 -- the prefix with a namespace name. Further declarations 1442 -- MAY re-declare the prefix again." 1443 -- 1444 -- This is relevant for XML 1.1 only, Namespaces for XML 1.0 1445 -- doesn't introduce such capability. 1446 -- 1447 -- Check whether namespace URI is empty and current XML 1448 -- version is 1.0. 1449 1450 if Self.Version = XML_1_0 and Ns = No_Symbol then 1451 Callbacks.Call_Fatal_Error 1452 (Self, 1453 League.Strings.To_Universal_String 1454 ("[NSXML1.0] illegal use of 1.1-style prefix" 1455 & " unbinding in 1.0 document")); 1456 1457 return; 1458 end if; 1459 1460 -- Check whether xml prefix is bound to xml namespace. 1461 -- Nothing need to be done in this case, otherwise new 1462 -- namespace binding must be processed and reported to 1463 -- the application. 1464 1465 if Ns /= Symbol_xml_NS or Lname /= Symbol_xml then 1466 Bind (Self.Namespace_Scope, Lname, Ns); 1467 1468 Callbacks.Call_Start_Prefix_Mapping 1469 (Self, 1470 Name (Self.Symbols, Lname), 1471 Name (Self.Symbols, Ns)); 1472 1473 if not Self.Continue then 1474 -- Application requests end of execution. 1475 1476 return; 1477 end if; 1478 end if; 1479 end if; 1480 end; 1481 end loop; 1482 1483 Element_Prefix := 1484 Prefix_Name (Self.Symbols, Self.Current_Element_Name); 1485 Element_Namespace := 1486 Resolve (Self.Namespace_Scope, Element_Prefix); 1487 1488 if Element_Prefix /= No_Symbol then 1489 -- [NSXML1.1 5 NSC: Prefix Declared] 1490 -- 1491 -- "The namespace prefix, unless it is xml or xmlns, must have 1492 -- been declared in a namespace declaration attribute in either 1493 -- the start-tag of the element where the prefix is used or in an 1494 -- ancestor element (i.e. an element in whose content the prefixed 1495 -- markup occurs), Furthermore, the attribute value is the 1496 -- innermost such declaration must not be an empty string." 1497 -- 1498 -- Check whether element's prefix is declared. 1499 1500 if Element_Namespace = No_Symbol then 1501 Callbacks.Call_Fatal_Error 1502 (Self, 1503 League.Strings.To_Universal_String 1504 ("[NSXML1.1 5 NSC: Prefix Declared]" 1505 & " the element's namespace prefix have not been" 1506 & " declared")); 1507 1508 return; 1509 end if; 1510 end if; 1511 1512 -- Resolve attribute's namespaces. 1513 1514 for J in 1 .. Length (Self.Attribute_Set) loop 1515 declare 1516 Qname : constant Symbol_Identifier 1517 := Qualified_Name (Self.Attribute_Set, J); 1518 Prefix : constant Symbol_Identifier 1519 := Prefix_Name (Self.Symbols, Qname); 1520 Ns : Symbol_Identifier; 1521 1522 begin 1523 if Prefix /= No_Symbol then 1524 Ns := Resolve (Self.Namespace_Scope, Prefix); 1525 1526 -- [NSXML1.1 5 NSC: Prefix Declared] 1527 -- 1528 -- "The namespace prefix, unless it is xml or xmlns, must 1529 -- have been declared in a namespace declaration attribute 1530 -- in either the start-tag of the element where the prefix 1531 -- is used or in an ancestor element (i.e. an element in 1532 -- whose content the prefixed markup occurs), Furthermore, 1533 -- the attribute value is the innermost such declaration 1534 -- must not be an empty string." 1535 -- 1536 -- Check whether attribute's prefix is declared. 1537 1538 if Ns = No_Symbol then 1539 Callbacks.Call_Fatal_Error 1540 (Self, 1541 League.Strings.To_Universal_String 1542 ("[NSXML1.1 5 NSC: Prefix Declared]" 1543 & " the attribute's namespace prefix have not been" 1544 & " declared")); 1545 1546 return; 1547 end if; 1548 1549 Set_Namespace_URI (Self.Attribute_Set, J, Ns); 1550 end if; 1551 end; 1552 end loop; 1553 1554 -- [NSXML1.1 6.3] 1555 -- 1556 -- In XML documents conforming to this specification, no tag may 1557 -- contain two attributes which: 1558 -- 1559 -- 1. have identical names, or 1560 -- 1561 -- 2. have qualified names with the same local part and with prefixes 1562 -- which have been bound to namespace names that are identical. 1563 -- 1564 -- This constraint is equivalent to requiring that no element have 1565 -- two attributes with the same expanded name. 1566 1567 for J in 1 .. Length (Self.Attribute_Set) loop 1568 declare 1569 Ns : constant Symbol_Identifier 1570 := Namespace_URI (Self.Attribute_Set, J); 1571 Ln : constant Symbol_Identifier 1572 := Local_Name 1573 (Self.Symbols, Qualified_Name (Self.Attribute_Set, J)); 1574 1575 begin 1576 for K in J + 1 .. Length (Self.Attribute_Set) loop 1577 if Namespace_URI (Self.Attribute_Set, K) = Ns 1578 and Local_Name 1579 (Self.Symbols, Qualified_Name (Self.Attribute_Set, K)) 1580 = Ln 1581 then 1582 Callbacks.Call_Fatal_Error 1583 (Self, 1584 League.Strings.To_Universal_String 1585 ("[NSXML1.1 6.3] attributes must not have the same" 1586 & " expanded name")); 1587 1588 return; 1589 end if; 1590 end loop; 1591 end; 1592 end loop; 1593 1594 Element_Namespace_URI := Name (Self.Symbols, Element_Namespace); 1595 Element_Local_Name := 1596 Local_Name (Self.Symbols, Self.Current_Element_Name); 1597 Element_Qualified_Name := 1598 Name (Self.Symbols, Self.Current_Element_Name); 1599 1600 else 1601 Element_Namespace_URI := 1602 Matreshka.Internals.Strings.Shared_Empty'Access; 1603 Element_Local_Name := 1604 Matreshka.Internals.Strings.Shared_Empty'Access; 1605 Element_Qualified_Name := 1606 Matreshka.Internals.XML.Symbol_Tables.Name 1607 (Self.Symbols, Self.Current_Element_Name); 1608 end if; 1609 1610 Validator.Validate_Element (Self); 1611 1612 Convert; 1613 Callbacks.Call_Start_Element 1614 (Self => Self, 1615 Namespace_URI => Element_Namespace_URI, 1616 Local_Name => Element_Local_Name, 1617 Qualified_Name => Element_Qualified_Name, 1618 Attributes => Self.SAX_Attributes); 1619 1620 -- Clear set of attributes. It is slightly more efficient to do here, 1621 -- then postpone to open of tag because occupied resources are not 1622 -- used longer and some of them (character data buffer for example) can 1623 -- be reused for other purpose. 1624 1625 Clear (Self.Attribute_Set); 1626 Self.SAX_Attributes.Clear; 1627 end On_Start_Tag; 1628 1629 ------------------------- 1630 -- On_Text_Declaration -- 1631 ------------------------- 1632 1633 procedure On_Text_Declaration 1634 (Self : in out Simple_Reader'Class; 1635 Version : not null Matreshka.Internals.Strings.Shared_String_Access; 1636 Encoding : not null Matreshka.Internals.Strings.Shared_String_Access) 1637 is 1638 use type Matreshka.Internals.Text_Codecs.Character_Set; 1639 1640 Encoding_Name : constant League.Strings.Universal_String 1641 := Matreshka.Internals.Text_Codecs.Transform_Character_Set_Name 1642 (League.Strings.Internals.Create (Encoding)); 1643 Entity_Version : constant XML_Version := To_XML_Version (Version); 1644 1645 begin 1646 -- [XML1.1 4.3.4] 1647 -- 1648 -- "Each entity, including the document entity, can be separately 1649 -- declared as XML 1.0 or XML 1.1. The version declaration appearing 1650 -- in the document entity determines the version of the document as a 1651 -- whole. An XML 1.1 document may invoke XML 1.0 external entities, 1652 -- so that otherwise duplicated versions of external entities, 1653 -- particularly DTD external subsets, need not be maintained. 1654 -- However, in such a case the rules of XML 1.1 are applied to the 1655 -- entire document." 1656 1657 if Self.Version < Entity_Version then 1658 Callbacks.Call_Fatal_Error 1659 (Self, 1660 League.Strings.To_Universal_String 1661 ("external general entity has later version number")); 1662 1663 return; 1664 end if; 1665 1666 -- Check that encoding name is valid when present. 1667 1668 if Encoding.Unused /= 0 and Encoding_Name.Is_Empty then 1669 Callbacks.Call_Fatal_Error 1670 (Self, 1671 League.Strings.To_Universal_String ("invalid name of encoding")); 1672 1673 return; 1674 end if; 1675 1676 -- Check that encoding is known. 1677 -- 1678 -- Note: short circuite form must be used here, because To_Character_Set 1679 -- raises exception when encoding has empty or invalid name. 1680 1681 if not Encoding_Name.Is_Empty 1682 and then Matreshka.Internals.Text_Codecs.To_Character_Set 1683 (Encoding_Name) = 0 1684 then 1685 Callbacks.Call_Fatal_Error 1686 (Self, 1687 League.Strings.To_Universal_String ("unknown encoding")); 1688 1689 return; 1690 end if; 1691 1692 Scanner.Set_Document_Version_And_Encoding 1693 (Self, Self.Version, League.Strings.Internals.Create (Encoding)); 1694 end On_Text_Declaration; 1695 1696 ------------------------ 1697 -- On_XML_Declaration -- 1698 ------------------------ 1699 1700 procedure On_XML_Declaration 1701 (Self : in out Simple_Reader'Class; 1702 Version : not null Matreshka.Internals.Strings.Shared_String_Access; 1703 Encoding : not null Matreshka.Internals.Strings.Shared_String_Access) 1704 is 1705 use type Matreshka.Internals.Text_Codecs.Character_Set; 1706 1707 Encoding_Name : constant League.Strings.Universal_String 1708 := Matreshka.Internals.Text_Codecs.Transform_Character_Set_Name 1709 (League.Strings.Internals.Create (Encoding)); 1710 1711 Document_Version : constant XML_Version := To_XML_Version (Version); 1712 1713 begin 1714 -- [XML1.0 2.8] 1715 -- 1716 -- "Note: When an XML 1.0 processor encounters a document that 1717 -- specifies a 1.x version number other than '1.0', it will process 1718 -- it as a 1.0 document. This means that an XML 1.0 processor will 1719 -- accept 1.x documents provided they do not use any non-1.0 1720 -- features." 1721 1722 if Document_Version = XML_1_X then 1723 Self.Version := XML_1_0; 1724 1725 else 1726 Self.Version := Document_Version; 1727 end if; 1728 1729 -- Check that encoding name is valid when present. 1730 1731 if Encoding.Unused /= 0 and Encoding_Name.Is_Empty then 1732 Callbacks.Call_Fatal_Error 1733 (Self, 1734 League.Strings.To_Universal_String ("invalid name of encoding")); 1735 1736 return; 1737 end if; 1738 1739 -- Check that encoding is known. 1740 -- 1741 -- Note: short circuite form must be used here, because To_Character_Set 1742 -- raises exception when encoding has empty or invalid name. 1743 1744 if not Encoding_Name.Is_Empty 1745 and then Matreshka.Internals.Text_Codecs.To_Character_Set 1746 (Encoding_Name) = 0 1747 then 1748 Callbacks.Call_Fatal_Error 1749 (Self, 1750 League.Strings.To_Universal_String ("unknown encoding")); 1751 1752 return; 1753 end if; 1754 1755 Scanner.Set_Document_Version_And_Encoding 1756 (Self, Self.Version, League.Strings.Internals.Create (Encoding)); 1757 end On_XML_Declaration; 1758 1759 -------------------- 1760 -- To_XML_Version -- 1761 -------------------- 1762 1763 function To_XML_Version 1764 (Version : not null Matreshka.Internals.Strings.Shared_String_Access) 1765 return XML_Version is 1766 begin 1767 -- XML declaration can contains only BMP characters, so we don't need to 1768 -- use expensive UTF-16 decoding here. 1769 1770 -- XXX XML 1.0 specify version number as 1771 -- 1772 -- [26] VersionNum ::= '1.' [0-9]+ 1773 -- 1774 -- current code handle only three characters string 1775 1776 if Version.Unused = 0 then 1777 return XML_1_0; 1778 1779 elsif Version.Unused = 3 1780 and then (Version.Value (0) = Digit_One 1781 and then Version.Value (1) = Full_Stop) 1782 then 1783 if Version.Value (2) = Digit_Zero then 1784 return XML_1_0; 1785 1786 elsif Version.Value (2) = Digit_One then 1787 return XML_1_1; 1788 1789 elsif Version.Value (2) in Digit_Two .. Digit_Nine then 1790 -- Starting from 5-th edition of XML 1.0, any 1.x versions are 1791 -- legal. They are processed as XML 1.0 documents. 1792 1793 return XML_1_X; 1794 end if; 1795 end if; 1796 1797 raise Program_Error; 1798 end To_XML_Version; 1799 1800end XML.SAX.Simple_Readers.Parser.Actions; 1801