1------------------------------------------------------------------------------ 2-- XML/Ada - An XML suite for Ada95 -- 3-- -- 4-- Copyright (C) 2004-2017, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify it -- 7-- under terms of the GNU General Public License as published by the Free -- 8-- Software Foundation; either version 3, or (at your option) any later -- 9-- version. This library is distributed in the hope that it will be useful, -- 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are granted -- 14-- additional permissions described in the GCC Runtime Library Exception, -- 15-- version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22------------------------------------------------------------------------------ 23 24-- This is a small example showing how to parse one or more XML schemas 25-- and then validate one XML document. To use this tool, do a 26-- "make test" at the root of the XML/Ada distribution, then run 27-- ./testschema -xsd schema1.xsd -xsd schema2.xsd file1.xml file2.xml 28-- where schema1.xsd, schema2.xsd, schema3.xsd,... are our schema files 29-- to parse, and file.xml the XML document to validate 30 31with Ada.Text_IO; 32with Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams; 33with Schema.Readers; use Schema.Readers; 34with Schema.Dom_Readers; use Schema.Dom_Readers; 35with Schema.Schema_Readers; use Schema.Schema_Readers; 36with Schema.Validators; use Schema.Validators; 37with DOM.Core.Nodes; use DOM.Core.Nodes; 38with DOM.Core; use DOM.Core; 39with DOM.Core.Documents; use DOM.Core.Documents; 40with Input_Sources.File; use Input_Sources.File; 41with Ada.Exceptions; use Ada.Exceptions; 42with GNAT.IO; use GNAT.IO; 43with Sax.Exceptions; use Sax.Exceptions; 44with Sax.Readers; use Sax.Readers; 45with Sax.Utils; use Sax.Utils; 46with GNAT.Command_Line; use GNAT.Command_Line; 47 48procedure TestSchema is 49 50 type Test_Reader is new Schema_Reader with null record; 51 overriding procedure Warning 52 (Self : in out Test_Reader; 53 Except : Sax.Exceptions.Sax_Parse_Exception'Class); 54 55 overriding procedure Warning 56 (Self : in out Test_Reader; 57 Except : Sax.Exceptions.Sax_Parse_Exception'Class) 58 is 59 pragma Unreferenced (Self); 60 begin 61 Put_Line ("Warning: " & Get_Message (Except)); 62 end Warning; 63 64 Read : File_Input; 65 My_Reader : Validating_Reader_Access; 66 Schema : Test_Reader; 67 Grammar : XML_Grammar := No_Grammar; 68 Explicit_XSD : Boolean := False; 69 Switches : constant String := "xsd: debug base dom h"; 70 DOM : Boolean := False; 71 Base_Names : Boolean := False; 72 Tree : Document; 73 74begin 75 -- Special case: check if we want debug output, before doing anything else 76 loop 77 case Getopt (Switches) is 78 when 'h' => 79 Put_Line ("-xsd file Specifies location of XSD file"); 80 Put_Line ("-debug Print extra debugging info"); 81 Put_Line ("-base Use basenames in error messages"); 82 Put_Line ("-dom Dump the DOM tree after parsing"); 83 Put_Line (" Uses a DOM-based parser, instead of"); 84 Put_Line (" the default sax-based parser"); 85 return; 86 87 when 'd' => 88 if Full_Switch = "debug" then 89 Standard.Schema.Set_Debug_Output (True); 90 elsif Full_Switch = "dom" then 91 DOM := True; 92 end if; 93 when ASCII.NUL => 94 exit; 95 when others => 96 null; -- Handled later 97 end case; 98 end loop; 99 100 -- We want to validate with possibly several schemas to parse first. This 101 -- is slightly more complex than a single grammar, since some checks can 102 -- only be done at the end, and we need to let XML/Ada know about that. 103 104 Set_XSD_Version (Grammar, XSD_1_0); 105 Set_XML_Version (Schema, XML_1_0_Third_Edition); 106 Set_Grammar (Schema, Grammar); 107 Initialize_Option_Scan; 108 109 loop 110 case Getopt (Switches) is 111 when 'x' => 112 Open (Parameter, Read); 113 begin 114 Parse (Schema, Read); 115 Close (Read); 116 exception 117 when others => 118 Close (Read); 119 raise; 120 end; 121 122 Explicit_XSD := True; 123 124 when 'b' => 125 Base_Names := True; 126 Use_Basename_In_Error_Messages (Schema, Base_Names); 127 128 when 'd' => 129 null; -- Already handled 130 131 when others => 132 exit; 133 end case; 134 end loop; 135 136 -- Create the parser 137 138 if DOM then 139 My_Reader := new Standard.Schema.Dom_Readers.Tree_Reader; 140 else 141 My_Reader := new Standard.Schema.Readers.Validating_Reader; 142 end if; 143 144 Set_XML_Version (My_Reader.all, XML_1_0_Third_Edition); 145 Use_Basename_In_Error_Messages (My_Reader.all, Base_Names); 146 147 -- If we have at least one schema, we need to perform the final checks 148 -- to make sure they are correct and leave no undefined entity. 149 150 if Explicit_XSD then 151 -- Validate the documents with the schemas we have just parsed. 152 Set_Grammar (My_Reader.all, Get_Grammar (Schema)); 153 end if; 154 155 Free (Schema); -- No longer needed 156 157 -- Activate validation. Even though we have a validating reader, we can 158 -- still choose to disable validation if we know the document is correct. 159 -- This makes loading the document faster 160 161 Set_Feature (My_Reader.all, Schema_Validation_Feature, True); 162 163 -- Now valid all XML files given as input 164 165 loop 166 declare 167 Xml_File : constant String := Get_Argument; 168 List : Node_List; 169 begin 170 exit when Xml_File'Length = 0; 171 172 Open (Xml_File, Read); 173 Parse (My_Reader.all, Read); 174 Close (Read); 175 176 if DOM then 177 Write 178 (Stream => Stream (Ada.Text_IO.Current_Output), 179 N => Get_Tree (Tree_Reader (My_Reader.all)), 180 Print_XML_Declaration => False, 181 EOL_Sequence => ""); 182 183 List := Get_Elements_By_Tag_Name 184 (Get_Tree (Tree_Reader (My_Reader.all)), 185 Tag_Name => "Corrective_Action"); 186 if Item (List, 0) /= null then 187 Put_Line 188 ("Found " & Length (List)'Img & " Corrective_Action nodes"); 189 Put_Line 190 ("Value=" & Node_Value (Item (List, 0))); 191 end if; 192 end if; 193 end; 194 end loop; 195 196 if DOM then 197 Tree := Get_Tree (Tree_Reader (My_Reader.all)); 198 end if; 199 200 Free (My_Reader); 201 202 -- You can keep using the tree here, it is still valid. 203 204 Standard.DOM.Core.Nodes.Free (Tree); 205 206exception 207 when XML_Validation_Error => 208 if My_Reader /= null then 209 Put_Line (Get_Error_Message (My_Reader.all)); 210 else 211 Put_Line (Get_Error_Message (Schema)); 212 end if; 213 214 Close (Read); 215 Free (My_Reader); 216 217 when Standard.Schema.XML_Limitation => 218 if My_Reader = null then 219 Put_Line ("LIMITATION: " & Get_Error_Message (Schema)); 220 else 221 Put_Line ("LIMITATION: " & Get_Error_Message (My_Reader.all)); 222 end if; 223 224 Close (Read); 225 Free (My_Reader); 226 227 when Standard.Schema.XML_Not_Implemented => 228 if My_Reader = null then 229 Put_Line ("NOT IMPLEMENTED: " & Get_Error_Message (Schema)); 230 else 231 Put_Line ("NOT IMPLEMENTED: " & Get_Error_Message (My_Reader.all)); 232 end if; 233 234 Close (Read); 235 Free (My_Reader); 236 237 when E : XML_Fatal_Error => 238 Put_Line (Exception_Message (E)); 239 Close (Read); 240 Free (My_Reader); 241end TestSchema; 242