1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--                               Web Framework                              --
6--                                                                          --
7--                              Tools Component                             --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2012-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: 4790 $ $Date: 2014-03-31 10:05:57 +0400 (Mon, 31 Mar 2014) $
43------------------------------------------------------------------------------
44with Ada.Wide_Wide_Text_IO;
45
46with League.Strings;
47with XML.SAX.Attributes;
48with XML.SAX.String_Output_Destinations;
49with XML.SAX.Pretty_Writers;
50
51with WSDL.AST.Bindings;
52pragma Unreferenced (WSDL.AST.Bindings);
53--  GNAT Pro 7.2.0w (20130423): package is needed to access to type's
54--  components.
55with WSDL.AST.Descriptions;
56pragma Unreferenced (WSDL.AST.Descriptions);
57--  GNAT Pro 7.2.0w (20130423): package is needed to access to type's
58--  components.
59with WSDL.AST.Endpoints;
60with WSDL.AST.Interfaces;
61pragma Unreferenced (WSDL.AST.Interfaces);
62--  GNAT Pro 7.2.0w (20130423): package is needed to access to type's
63--  components.
64with WSDL.AST.Messages;
65pragma Unreferenced (WSDL.AST.Messages);
66--  GNAT Pro 7.2.0w (20130423): package is needed to access to type's
67--  components.
68with WSDL.AST.Operations;
69pragma Unreferenced (WSDL.AST.Operations);
70--  GNAT Pro 7.2.0w (20130423): package is needed to access to type's
71--  components.
72with WSDL.AST.Services;
73with WSDL.AST.Types;
74with WSDL.Constants;
75with WSDL.Iterators.Containment;
76with WSDL.Visitors;
77
78package body WSDL.Debug is
79
80   use WSDL.Constants;
81
82   type WSDL_Printer is
83     limited new WSDL.Visitors.WSDL_Visitor with
84   record
85      Output : aliased
86        XML.SAX.String_Output_Destinations.String_Output_Destination;
87      Writer : XML.SAX.Pretty_Writers.XML_Pretty_Writer;
88   end record;
89
90   overriding procedure Enter_Binding
91    (Self    : in out WSDL_Printer;
92     Node    : not null WSDL.AST.Binding_Access;
93     Control : in out WSDL.Iterators.Traverse_Control);
94
95   overriding procedure Leave_Binding
96    (Self    : in out WSDL_Printer;
97     Node    : not null WSDL.AST.Binding_Access;
98     Control : in out WSDL.Iterators.Traverse_Control);
99
100   overriding procedure Enter_Binding_Fault
101    (Self    : in out WSDL_Printer;
102     Node    : not null WSDL.AST.Binding_Fault_Access;
103     Control : in out WSDL.Iterators.Traverse_Control);
104
105   overriding procedure Leave_Binding_Fault
106    (Self    : in out WSDL_Printer;
107     Node    : not null WSDL.AST.Binding_Fault_Access;
108     Control : in out WSDL.Iterators.Traverse_Control);
109
110   overriding procedure Enter_Binding_Operation
111    (Self    : in out WSDL_Printer;
112     Node    : not null WSDL.AST.Binding_Operation_Access;
113     Control : in out WSDL.Iterators.Traverse_Control);
114
115   overriding procedure Leave_Binding_Operation
116    (Self    : in out WSDL_Printer;
117     Node    : not null WSDL.AST.Binding_Operation_Access;
118     Control : in out WSDL.Iterators.Traverse_Control);
119
120   overriding procedure Enter_Description
121    (Self    : in out WSDL_Printer;
122     Node    : not null WSDL.AST.Description_Access;
123     Control : in out WSDL.Iterators.Traverse_Control);
124
125   overriding procedure Leave_Description
126    (Self    : in out WSDL_Printer;
127     Node    : not null WSDL.AST.Description_Access;
128     Control : in out WSDL.Iterators.Traverse_Control);
129
130   overriding procedure Enter_Endpoint
131    (Self    : in out WSDL_Printer;
132     Node    : not null WSDL.AST.Endpoints.Endpoint_Access;
133     Control : in out WSDL.Iterators.Traverse_Control);
134
135   overriding procedure Leave_Endpoint
136    (Self    : in out WSDL_Printer;
137     Node    : not null WSDL.AST.Endpoints.Endpoint_Access;
138     Control : in out WSDL.Iterators.Traverse_Control);
139
140   overriding procedure Enter_Interface
141    (Self    : in out WSDL_Printer;
142     Node    : not null WSDL.AST.Interface_Access;
143     Control : in out WSDL.Iterators.Traverse_Control);
144
145   overriding procedure Leave_Interface
146    (Self    : in out WSDL_Printer;
147     Node    : not null WSDL.AST.Interface_Access;
148     Control : in out WSDL.Iterators.Traverse_Control);
149
150   overriding procedure Enter_Interface_Message
151    (Self    : in out WSDL_Printer;
152     Node    : not null WSDL.AST.Interface_Message_Access;
153     Control : in out WSDL.Iterators.Traverse_Control);
154
155   overriding procedure Leave_Interface_Message
156    (Self    : in out WSDL_Printer;
157     Node    : not null WSDL.AST.Interface_Message_Access;
158     Control : in out WSDL.Iterators.Traverse_Control);
159
160   overriding procedure Enter_Interface_Operation
161    (Self    : in out WSDL_Printer;
162     Node    : not null WSDL.AST.Interface_Operation_Access;
163     Control : in out WSDL.Iterators.Traverse_Control);
164
165   overriding procedure Leave_Interface_Operation
166    (Self    : in out WSDL_Printer;
167     Node    : not null WSDL.AST.Interface_Operation_Access;
168     Control : in out WSDL.Iterators.Traverse_Control);
169
170   overriding procedure Enter_Service
171    (Self    : in out WSDL_Printer;
172     Node    : not null WSDL.AST.Services.Service_Access;
173     Control : in out WSDL.Iterators.Traverse_Control);
174
175   overriding procedure Leave_Service
176    (Self    : in out WSDL_Printer;
177     Node    : not null WSDL.AST.Services.Service_Access;
178     Control : in out WSDL.Iterators.Traverse_Control);
179
180   overriding procedure Enter_Types
181    (Self    : in out WSDL_Printer;
182     Node    : not null WSDL.AST.Types.Types_Access;
183     Control : in out WSDL.Iterators.Traverse_Control);
184
185   overriding procedure Leave_Types
186    (Self    : in out WSDL_Printer;
187     Node    : not null WSDL.AST.Types.Types_Access;
188     Control : in out WSDL.Iterators.Traverse_Control);
189
190   ----------
191   -- Dump --
192   ----------
193
194   procedure Dump (Description : WSDL.AST.Description_Access) is
195      Printer  : WSDL_Printer;
196      Iterator : WSDL.Iterators.Containment.Containment_Iterator;
197      Control  : WSDL.Iterators.Traverse_Control := WSDL.Iterators.Continue;
198
199   begin
200      Printer.Writer.Set_Output_Destination (Printer.Output'Unchecked_Access);
201      Iterator.Visit (Printer, WSDL.AST.Node_Access (Description), Control);
202   end Dump;
203
204   -------------------
205   -- Enter_Binding --
206   -------------------
207
208   overriding procedure Enter_Binding
209    (Self    : in out WSDL_Printer;
210     Node    : not null WSDL.AST.Binding_Access;
211     Control : in out WSDL.Iterators.Traverse_Control)
212   is
213      Attributes : XML.SAX.Attributes.SAX_Attributes;
214
215   begin
216      Attributes.Set_Value (Name_Attribute, Node.Local_Name);
217      Attributes.Set_Value (Type_Attribute, Node.Binding_Type);
218      Self.Writer.Start_Element
219       (WSDL_Namespace_URI, Binding_Element, Attributes);
220   end Enter_Binding;
221
222   -------------------------
223   -- Enter_Binding_Fault --
224   -------------------------
225
226   overriding procedure Enter_Binding_Fault
227    (Self    : in out WSDL_Printer;
228     Node    : not null WSDL.AST.Binding_Fault_Access;
229     Control : in out WSDL.Iterators.Traverse_Control) is
230   begin
231      Self.Writer.Start_Element (WSDL_Namespace_URI, Fault_Element);
232   end Enter_Binding_Fault;
233
234   -----------------------------
235   -- Enter_Binding_Operation --
236   -----------------------------
237
238   overriding procedure Enter_Binding_Operation
239    (Self    : in out WSDL_Printer;
240     Node    : not null WSDL.AST.Binding_Operation_Access;
241     Control : in out WSDL.Iterators.Traverse_Control) is
242   begin
243      Self.Writer.Start_Element (WSDL_Namespace_URI, Operation_Element);
244   end Enter_Binding_Operation;
245
246   -----------------------
247   -- Enter_Description --
248   -----------------------
249
250   overriding procedure Enter_Description
251    (Self    : in out WSDL_Printer;
252     Node    : not null WSDL.AST.Description_Access;
253     Control : in out WSDL.Iterators.Traverse_Control)
254   is
255      Attributes : XML.SAX.Attributes.SAX_Attributes;
256
257   begin
258      Self.Writer.Set_Offset (2);
259      Self.Writer.Start_Document;
260      Self.Writer.Start_Prefix_Mapping
261       (League.Strings.To_Universal_String ("wsdl"), WSDL_Namespace_URI);
262      Attributes.Set_Value
263       (Target_Namespace_Attribute, Node.Target_Namespace);
264      Self.Writer.Start_Element
265       (WSDL_Namespace_URI, Description_Element, Attributes);
266   end Enter_Description;
267
268   --------------------
269   -- Enter_Endpoint --
270   --------------------
271
272   overriding procedure Enter_Endpoint
273    (Self    : in out WSDL_Printer;
274     Node    : not null WSDL.AST.Endpoints.Endpoint_Access;
275     Control : in out WSDL.Iterators.Traverse_Control)
276   is
277      Attributes : XML.SAX.Attributes.SAX_Attributes;
278
279   begin
280      Attributes.Set_Value (Name_Attribute, Node.Local_Name);
281
282      if not Node.Address.Is_Empty then
283         Attributes.Set_Value (Address_Attribute, Node.Address);
284      end if;
285
286      Self.Writer.Start_Element
287       (WSDL_Namespace_URI, Endpoint_Element, Attributes);
288   end Enter_Endpoint;
289
290   ---------------------
291   -- Enter_Interface --
292   ---------------------
293
294   overriding procedure Enter_Interface
295    (Self    : in out WSDL_Printer;
296     Node    : not null WSDL.AST.Interface_Access;
297     Control : in out WSDL.Iterators.Traverse_Control)
298   is
299      Attributes : XML.SAX.Attributes.SAX_Attributes;
300
301   begin
302      Attributes.Set_Value (Name_Attribute, Node.Local_Name);
303      Self.Writer.Start_Element
304       (WSDL_Namespace_URI, Interface_Element, Attributes);
305   end Enter_Interface;
306
307   -----------------------------
308   -- Enter_Interface_Message --
309   -----------------------------
310
311   overriding procedure Enter_Interface_Message
312    (Self    : in out WSDL_Printer;
313     Node    : not null WSDL.AST.Interface_Message_Access;
314     Control : in out WSDL.Iterators.Traverse_Control) is
315   begin
316      case Node.Direction is
317         when WSDL.AST.In_Message =>
318            Self.Writer.Start_Element (WSDL_Namespace_URI, Input_Element);
319
320         when WSDL.AST.Out_Message =>
321            Self.Writer.Start_Element (WSDL_Namespace_URI, Output_Element);
322      end case;
323   end Enter_Interface_Message;
324
325   -------------------------------
326   -- Enter_Interface_Operation --
327   -------------------------------
328
329   overriding procedure Enter_Interface_Operation
330    (Self    : in out WSDL_Printer;
331     Node    : not null WSDL.AST.Interface_Operation_Access;
332     Control : in out WSDL.Iterators.Traverse_Control)
333   is
334      Attributes : XML.SAX.Attributes.SAX_Attributes;
335
336   begin
337      Attributes.Set_Value (Name_Attribute, Node.Local_Name);
338      Self.Writer.Start_Element
339       (WSDL_Namespace_URI, Operation_Element, Attributes);
340   end Enter_Interface_Operation;
341
342   -------------------
343   -- Enter_Service --
344   -------------------
345
346   overriding procedure Enter_Service
347    (Self    : in out WSDL_Printer;
348     Node    : not null WSDL.AST.Services.Service_Access;
349     Control : in out WSDL.Iterators.Traverse_Control)
350   is
351      Attributes : XML.SAX.Attributes.SAX_Attributes;
352
353   begin
354      Attributes.Set_Value (Name_Attribute, Node.Local_Name);
355      Self.Writer.Start_Element
356       (WSDL_Namespace_URI, Service_Element, Attributes);
357   end Enter_Service;
358
359   -----------------
360   -- Enter_Types --
361   -----------------
362
363   overriding procedure Enter_Types
364    (Self    : in out WSDL_Printer;
365     Node    : not null WSDL.AST.Types.Types_Access;
366     Control : in out WSDL.Iterators.Traverse_Control) is
367   begin
368      Self.Writer.Start_Element (WSDL_Namespace_URI, Types_Element);
369   end Enter_Types;
370
371   -------------------
372   -- Leave_Binding --
373   -------------------
374
375   overriding procedure Leave_Binding
376    (Self    : in out WSDL_Printer;
377     Node    : not null WSDL.AST.Binding_Access;
378     Control : in out WSDL.Iterators.Traverse_Control) is
379   begin
380      Self.Writer.End_Element (WSDL_Namespace_URI, Binding_Element);
381   end Leave_Binding;
382
383   -------------------------
384   -- Leave_Binding_Fault --
385   -------------------------
386
387   overriding procedure Leave_Binding_Fault
388    (Self    : in out WSDL_Printer;
389     Node    : not null WSDL.AST.Binding_Fault_Access;
390     Control : in out WSDL.Iterators.Traverse_Control) is
391   begin
392      Self.Writer.End_Element (WSDL_Namespace_URI, Fault_Element);
393   end Leave_Binding_Fault;
394
395   -----------------------------
396   -- Leave_Binding_Operation --
397   -----------------------------
398
399   overriding procedure Leave_Binding_Operation
400    (Self    : in out WSDL_Printer;
401     Node    : not null WSDL.AST.Binding_Operation_Access;
402     Control : in out WSDL.Iterators.Traverse_Control) is
403   begin
404      Self.Writer.End_Element (WSDL_Namespace_URI, Operation_Element);
405   end Leave_Binding_Operation;
406
407   -----------------------
408   -- Leave_Description --
409   -----------------------
410
411   overriding procedure Leave_Description
412    (Self    : in out WSDL_Printer;
413     Node    : not null WSDL.AST.Description_Access;
414     Control : in out WSDL.Iterators.Traverse_Control) is
415   begin
416      Self.Writer.End_Element (WSDL_Namespace_URI, Description_Element);
417      Self.Writer.End_Document;
418
419      Ada.Wide_Wide_Text_IO.Put_Line
420       (Self.Output.Get_Text.To_Wide_Wide_String);
421   end Leave_Description;
422
423   --------------------
424   -- Leave_Endpoint --
425   --------------------
426
427   overriding procedure Leave_Endpoint
428    (Self    : in out WSDL_Printer;
429     Node    : not null WSDL.AST.Endpoints.Endpoint_Access;
430     Control : in out WSDL.Iterators.Traverse_Control) is
431   begin
432      Self.Writer.End_Element (WSDL_Namespace_URI, Endpoint_Element);
433   end Leave_Endpoint;
434
435   ---------------------
436   -- Leave_Interface --
437   ---------------------
438
439   overriding procedure Leave_Interface
440    (Self    : in out WSDL_Printer;
441     Node    : not null WSDL.AST.Interface_Access;
442     Control : in out WSDL.Iterators.Traverse_Control) is
443   begin
444      Self.Writer.End_Element (WSDL_Namespace_URI, Interface_Element);
445   end Leave_Interface;
446
447   -----------------------------
448   -- Leave_Interface_Message --
449   -----------------------------
450
451   overriding procedure Leave_Interface_Message
452    (Self    : in out WSDL_Printer;
453     Node    : not null WSDL.AST.Interface_Message_Access;
454     Control : in out WSDL.Iterators.Traverse_Control) is
455   begin
456      case Node.Direction is
457         when WSDL.AST.In_Message =>
458            Self.Writer.End_Element (WSDL_Namespace_URI, Input_Element);
459
460         when WSDL.AST.Out_Message =>
461            Self.Writer.End_Element (WSDL_Namespace_URI, Output_Element);
462      end case;
463   end Leave_Interface_Message;
464
465   -------------------------------
466   -- Leave_Interface_Operation --
467   -------------------------------
468
469   overriding procedure Leave_Interface_Operation
470    (Self    : in out WSDL_Printer;
471     Node    : not null WSDL.AST.Interface_Operation_Access;
472     Control : in out WSDL.Iterators.Traverse_Control) is
473   begin
474      Self.Writer.End_Element (WSDL_Namespace_URI, Operation_Element);
475   end Leave_Interface_Operation;
476
477   -------------------
478   -- Leave_Service --
479   -------------------
480
481   overriding procedure Leave_Service
482    (Self    : in out WSDL_Printer;
483     Node    : not null WSDL.AST.Services.Service_Access;
484     Control : in out WSDL.Iterators.Traverse_Control) is
485   begin
486      Self.Writer.End_Element (WSDL_Namespace_URI, Service_Element);
487   end Leave_Service;
488
489   -----------------
490   -- Leave_Types --
491   -----------------
492
493   overriding procedure Leave_Types
494    (Self    : in out WSDL_Printer;
495     Node    : not null WSDL.AST.Types.Types_Access;
496     Control : in out WSDL.Iterators.Traverse_Control) is
497   begin
498      Self.Writer.End_Element (WSDL_Namespace_URI, Types_Element);
499   end Leave_Types;
500
501end WSDL.Debug;
502