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