------------------------------------------------------------------------------ -- XML/Ada - An XML suite for Ada95 -- -- -- -- Copyright (C) 2004-2017, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 3, or (at your option) any later -- -- version. This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- ------------------------------------------------------------------------------ -- This is a small example showing how to parse one or more XML schemas -- and then validate one XML document. To use this tool, do a -- "make test" at the root of the XML/Ada distribution, then run -- ./testschema -xsd schema1.xsd -xsd schema2.xsd file1.xml file2.xml -- where schema1.xsd, schema2.xsd, schema3.xsd,... are our schema files -- to parse, and file.xml the XML document to validate with Ada.Text_IO; with Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams; with Schema.Readers; use Schema.Readers; with Schema.Dom_Readers; use Schema.Dom_Readers; with Schema.Schema_Readers; use Schema.Schema_Readers; with Schema.Validators; use Schema.Validators; with DOM.Core.Nodes; use DOM.Core.Nodes; with DOM.Core; use DOM.Core; with DOM.Core.Documents; use DOM.Core.Documents; with Input_Sources.File; use Input_Sources.File; with Ada.Exceptions; use Ada.Exceptions; with GNAT.IO; use GNAT.IO; with Sax.Exceptions; use Sax.Exceptions; with Sax.Readers; use Sax.Readers; with Sax.Utils; use Sax.Utils; with GNAT.Command_Line; use GNAT.Command_Line; procedure TestSchema is type Test_Reader is new Schema_Reader with null record; overriding procedure Warning (Self : in out Test_Reader; Except : Sax.Exceptions.Sax_Parse_Exception'Class); overriding procedure Warning (Self : in out Test_Reader; Except : Sax.Exceptions.Sax_Parse_Exception'Class) is pragma Unreferenced (Self); begin Put_Line ("Warning: " & Get_Message (Except)); end Warning; Read : File_Input; My_Reader : Validating_Reader_Access; Schema : Test_Reader; Grammar : XML_Grammar := No_Grammar; Explicit_XSD : Boolean := False; Switches : constant String := "xsd: debug base dom h"; DOM : Boolean := False; Base_Names : Boolean := False; Tree : Document; begin -- Special case: check if we want debug output, before doing anything else loop case Getopt (Switches) is when 'h' => Put_Line ("-xsd file Specifies location of XSD file"); Put_Line ("-debug Print extra debugging info"); Put_Line ("-base Use basenames in error messages"); Put_Line ("-dom Dump the DOM tree after parsing"); Put_Line (" Uses a DOM-based parser, instead of"); Put_Line (" the default sax-based parser"); return; when 'd' => if Full_Switch = "debug" then Standard.Schema.Set_Debug_Output (True); elsif Full_Switch = "dom" then DOM := True; end if; when ASCII.NUL => exit; when others => null; -- Handled later end case; end loop; -- We want to validate with possibly several schemas to parse first. This -- is slightly more complex than a single grammar, since some checks can -- only be done at the end, and we need to let XML/Ada know about that. Set_XSD_Version (Grammar, XSD_1_0); Set_XML_Version (Schema, XML_1_0_Third_Edition); Set_Grammar (Schema, Grammar); Initialize_Option_Scan; loop case Getopt (Switches) is when 'x' => Open (Parameter, Read); begin Parse (Schema, Read); Close (Read); exception when others => Close (Read); raise; end; Explicit_XSD := True; when 'b' => Base_Names := True; Use_Basename_In_Error_Messages (Schema, Base_Names); when 'd' => null; -- Already handled when others => exit; end case; end loop; -- Create the parser if DOM then My_Reader := new Standard.Schema.Dom_Readers.Tree_Reader; else My_Reader := new Standard.Schema.Readers.Validating_Reader; end if; Set_XML_Version (My_Reader.all, XML_1_0_Third_Edition); Use_Basename_In_Error_Messages (My_Reader.all, Base_Names); -- If we have at least one schema, we need to perform the final checks -- to make sure they are correct and leave no undefined entity. if Explicit_XSD then -- Validate the documents with the schemas we have just parsed. Set_Grammar (My_Reader.all, Get_Grammar (Schema)); end if; Free (Schema); -- No longer needed -- Activate validation. Even though we have a validating reader, we can -- still choose to disable validation if we know the document is correct. -- This makes loading the document faster Set_Feature (My_Reader.all, Schema_Validation_Feature, True); -- Now valid all XML files given as input loop declare Xml_File : constant String := Get_Argument; List : Node_List; begin exit when Xml_File'Length = 0; Open (Xml_File, Read); Parse (My_Reader.all, Read); Close (Read); if DOM then Write (Stream => Stream (Ada.Text_IO.Current_Output), N => Get_Tree (Tree_Reader (My_Reader.all)), Print_XML_Declaration => False, EOL_Sequence => ""); List := Get_Elements_By_Tag_Name (Get_Tree (Tree_Reader (My_Reader.all)), Tag_Name => "Corrective_Action"); if Item (List, 0) /= null then Put_Line ("Found " & Length (List)'Img & " Corrective_Action nodes"); Put_Line ("Value=" & Node_Value (Item (List, 0))); end if; end if; end; end loop; if DOM then Tree := Get_Tree (Tree_Reader (My_Reader.all)); end if; Free (My_Reader); -- You can keep using the tree here, it is still valid. Standard.DOM.Core.Nodes.Free (Tree); exception when XML_Validation_Error => if My_Reader /= null then Put_Line (Get_Error_Message (My_Reader.all)); else Put_Line (Get_Error_Message (Schema)); end if; Close (Read); Free (My_Reader); when Standard.Schema.XML_Limitation => if My_Reader = null then Put_Line ("LIMITATION: " & Get_Error_Message (Schema)); else Put_Line ("LIMITATION: " & Get_Error_Message (My_Reader.all)); end if; Close (Read); Free (My_Reader); when Standard.Schema.XML_Not_Implemented => if My_Reader = null then Put_Line ("NOT IMPLEMENTED: " & Get_Error_Message (Schema)); else Put_Line ("NOT IMPLEMENTED: " & Get_Error_Message (My_Reader.all)); end if; Close (Read); Free (My_Reader); when E : XML_Fatal_Error => Put_Line (Exception_Message (E)); Close (Read); Free (My_Reader); end TestSchema;