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