File : soap/soap-wsdl-parser.adb
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2004 --
-- ACT-Europe --
-- --
-- Authors: Dmitriy Anisimkov - Pascal Obry --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, 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 --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- $Id: soap-wsdl-parser.adb,v 1.24 2004/03/22 21:44:22 obry Exp $
with Ada.Characters.Handling;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with DOM.Core.Nodes;
with SOAP.Types;
with SOAP.Utils;
with SOAP.XML;
package body SOAP.WSDL.Parser is
use Ada;
use Ada.Exceptions;
use Ada.Strings.Unbounded;
use type DOM.Core.Node;
Verbose_Mode : Verbose_Level := 0;
Skip_Error : Boolean := False;
function Get_Node
(Parent : in DOM.Core.Node;
Element : in String;
Name : in String := "";
NS : in Boolean := False)
return DOM.Core.Node;
-- Returns child node named Name
function First_Child (Parent : in DOM.Core.Node) return DOM.Core.Node;
-- Returns the first child, ship #text nodes
function Next_Sibling (N : in DOM.Core.Node) return DOM.Core.Node;
-- Returns the next sibling, ship #text nodes
function "+" (Str : in String) return Unbounded_String
renames To_Unbounded_String;
function "-" (Str : in Unbounded_String) return String
renames To_String;
procedure Parse_Service
(O : in out Object'Class;
Service : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL service nodes
procedure Parse_Binding
(O : in out Object'Class;
Binding : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL binding nodes
procedure Parse_Operation
(O : in out Object'Class;
Operation : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL operation nodes
procedure Parse_PortType
(O : in out Object'Class;
Operation : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL PortType nodes
procedure Parse_Part
(O : in out Object'Class;
Part : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL part nodes
procedure Parse_Message
(O : in out Object'Class;
Message : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL message nodes
procedure Parse_Element
(O : in out Object'Class;
Element : in DOM.Core.Node;
Document : in WSDL.Object);
-- Parse WSDL element nodes
procedure Add_Parameter
(O : in out Object'Class;
Name : in String;
P_Type : in Parameter_Type);
pragma Inline (Add_Parameter);
-- Add parameter Name / P_Type into O using current mode (O.Mode)
procedure Add_Parameter
(O : in out Object'Class;
Param : in Parameters.Parameter);
pragma Inline (Add_Parameter);
-- Add parameter into O using current mode (O.Mode)
function Parse_Parameter
(O : in Object'Class;
N : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter;
-- Returns parameter in node P
function Parse_Record
(O : in Object'Class;
R : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter;
-- Returns record in node N
function Parse_Array
(O : in Object'Class;
R : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter;
-- Returns array in node N
function Parse_Simple
(O : in Object'Class;
R : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter;
-- Returns the derived or enumeration type in node N (N must be a
-- simpleType schema node).
function Is_Array
(O : in Object'Class;
N : in DOM.Core.Node)
return Boolean;
-- Returns True if N is an array description node. Set the array element
-- name into the object.
function Is_Record
(O : in Object'Class;
N : in DOM.Core.Node)
return Boolean;
-- Returns True if N is a struct description node.
procedure Check_Character (R : in DOM.Core.Node);
-- Checks that N is a valid schema definition for a Character Ada type
-----------
-- Debug --
-----------
procedure Trace (Message : in String; N : in DOM.Core.Node);
-- Display trace message and info about the node
----------------
-- Accept_RPC --
----------------
procedure Accept_Document (O : in out Object'Class) is
begin
O.Accept_Document := True;
end Accept_Document;
-------------------
-- Add_Parameter --
-------------------
procedure Add_Parameter
(O : in out Object'Class;
Name : in String;
P_Type : in Parameter_Type) is
begin
Add_Parameter (O, (Parameters.K_Simple, +Name, null, P_Type));
end Add_Parameter;
procedure Add_Parameter
(O : in out Object'Class;
Param : in Parameters.Parameter) is
begin
Parameters.Append (O.Params (O.Mode), Param);
end Add_Parameter;
---------------------
-- Check_Character --
---------------------
procedure Check_Character (R : in DOM.Core.Node) is
function Character_Facet
(Parent : in DOM.Core.Node;
Child : in Boolean := False)
return DOM.Core.Node;
-- Returns the first node corresponding to a character type definition.
-- It skips annotation tag for example.
---------------------
-- Character_Facet --
---------------------
function Character_Facet
(Parent : in DOM.Core.Node;
Child : in Boolean := False)
return DOM.Core.Node
is
N : DOM.Core.Node := Parent;
begin
if Child then
N := First_Child (N);
else
N := Next_Sibling (N);
end if;
while N /= null
and then DOM.Core.Nodes.Local_Name (N) /= "length"
and then DOM.Core.Nodes.Local_Name (N) /= "minLength"
and then DOM.Core.Nodes.Local_Name (N) /= "maxLength"
loop
N := Next_Sibling (N);
end loop;
return N;
end Character_Facet;
N : DOM.Core.Node := R;
begin
Trace ("(Check_Character)", R);
pragma Assert
(R /= null
and then Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "simpleType");
-- Now check that if Name is Character and base is xsd:string
-- that this is really an Ada Character type. For this the
-- type must be constrained to a single character.
--
-- Either we have the facet <length value="1">
-- Or <minLength value="1"> and <maxLength value="1">
declare
Name : constant String := XML.Get_Attr_Value (R, "name", False);
begin
-- Get restriction node
N := First_Child (N);
declare
Base : constant String := XML.Get_Attr_Value (N, "base", False);
begin
if Characters.Handling.To_Lower (Name) /= "character"
or else Base /= "string"
then
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond to Ada Character type.");
end if;
N := Character_Facet (N, Child => True);
if N /= null
and then DOM.Core.Nodes.Local_Name (N) = "length"
then
-- Check length
if XML.Get_Attr_Value (N, "value", False) /= "1" then
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond"
& " to Ada Character type (length /= 1).");
end if;
elsif N /= null
and then DOM.Core.Nodes.Local_Name (N) = "minLength"
then
if XML.Get_Attr_Value (N, "value", False) /= "1" then
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond"
& " to Ada Character type (minLength /= 1).");
end if;
N := Character_Facet (N);
if N = null
or else DOM.Core.Nodes.Local_Name (N) /= "maxLength"
or else XML.Get_Attr_Value (N, "value", False) /= "1"
then
if N = null then
Text_IO.Put_Line ("N=null");
end if;
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond"
& " to Ada Character type (maxLength /= 1).");
end if;
elsif N /= null
and then DOM.Core.Nodes.Local_Name (N) = "maxLength"
then
if XML.Get_Attr_Value (N, "value", False) /= "1" then
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond"
& " to Ada Character type (maxLength /= 1).");
end if;
N := Character_Facet (N);
if N = null
or else DOM.Core.Nodes.Local_Name (N) /= "minLength"
or else XML.Get_Attr_Value (N, "value", False) /= "1"
then
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond"
& " to Ada Character type (minLength /= 1).");
end if;
else
Raise_Exception
(WSDL_Error'Identity,
"Schema does not correspond"
& " to Ada Character type (no facet).");
end if;
end;
end;
end Check_Character;
-----------------------
-- Continue_On_Error --
-----------------------
procedure Continue_On_Error is
begin
Skip_Error := True;
end Continue_On_Error;
-----------------
-- End_Service --
-----------------
procedure End_Service
(O : in out Object;
Name : in String)
is
pragma Unreferenced (O);
pragma Unreferenced (Name);
begin
null;
end End_Service;
-----------------
-- First_Child --
-----------------
function First_Child (Parent : in DOM.Core.Node) return DOM.Core.Node is
N : DOM.Core.Node;
begin
Trace ("(First_Child)", Parent);
N := DOM.Core.Nodes.First_Child (Parent);
while N /= null and then DOM.Core.Nodes.Node_Name (N) = "#text" loop
N := DOM.Core.Nodes.Next_Sibling (N);
end loop;
return N;
end First_Child;
--------------
-- Get_Node --
--------------
function Get_Node
(Parent : in DOM.Core.Node;
Element : in String;
Name : in String := "";
NS : in Boolean := False)
return DOM.Core.Node
is
function Get_Node_Int
(Parent : in DOM.Core.Node;
Element : in String;
Name : in String)
return DOM.Core.Node;
K : Positive := Element'First;
E : Natural;
N : DOM.Core.Node := Parent;
------------------
-- Get_Node_Int --
------------------
function Get_Node_Int
(Parent : in DOM.Core.Node;
Element : in String;
Name : in String)
return DOM.Core.Node
is
N : DOM.Core.Node;
begin
-- Iterate through childs, look for "service"
N := First_Child (Parent);
while N /= null loop
exit when
((not NS and then DOM.Core.Nodes.Local_Name (N) = Element)
or else (NS and then DOM.Core.Nodes.Node_Name (N) = Element))
and then (Name = ""
or else XML.Get_Attr_Value (N, "name") = Name);
N := Next_Sibling (N);
end loop;
return N;
end Get_Node_Int;
begin
Trace ("(Get_Node) - " & Element & " -> " & Name, Parent);
while K < Element'Last loop
E := Strings.Fixed.Index (Element (K .. Element'Last), ".");
if E = 0 then
E := Element'Last;
N := Get_Node_Int (N, Element (K .. E), Name);
else
E := E - 1;
N := Get_Node_Int (N, Element (K .. E), "");
end if;
exit when N = null;
K := E + 2;
end loop;
return N;
end Get_Node;
--------------
-- Is_Array --
--------------
function Is_Array
(O : in Object'Class;
N : in DOM.Core.Node)
return Boolean
is
function Array_Elements return Unbounded_String;
-- Returns array's element type encoded in node L
L : DOM.Core.Node := N;
--------------------
-- Array_Elements --
--------------------
function Array_Elements return Unbounded_String is
Attributes : constant DOM.Core.Named_Node_Map
:= DOM.Core.Nodes.Attributes (L);
begin
-- Look for arrayType in Attributes list
for K in 1 .. DOM.Core.Nodes.Length (Attributes) loop
declare
N : constant DOM.Core.Node
:= DOM.Core.Nodes.Item (Attributes, K);
begin
if Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "arrayType" then
-- Found get the value removing []
declare
Value : constant String
:= Utils.No_NS (DOM.Core.Nodes.Node_Value (N));
First : Natural;
Last : Natural;
begin
First := Strings.Fixed.Index (Value, "[");
Last := Strings.Fixed.Index (Value, "]");
if First = 0 or else Last = 0 then
Raise_Exception
(WSDL_Error'Identity,
"missing [] in arrayType value.");
end if;
if Last > First + 1 then
O.Self.Array_Length
:= Natural'Value (Value (First + 1 .. Last - 1));
else
O.Self.Array_Length := 0;
end if;
return To_Unbounded_String
(Value (Value'First .. First - 1));
end;
end if;
end;
end loop;
Raise_Exception
(WSDL_Error'Identity, "array element type not found.");
end Array_Elements;
begin
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexType" then
L := First_Child (L);
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexContent" then
L := First_Child (L);
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "restriction" then
L := First_Child (L);
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "attribute" then
O.Self.Array_Elements := Array_Elements;
return True;
end if;
end if;
end if;
end if;
return False;
end Is_Array;
---------------
-- Is_Record --
---------------
function Is_Record
(O : in Object'Class;
N : in DOM.Core.Node)
return Boolean
is
pragma Unreferenced (O);
L : DOM.Core.Node := N;
begin
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexType" then
L := First_Child (L);
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "all" then
L := First_Child (L);
if Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "element" then
return True;
end if;
end if;
end if;
return False;
end Is_Record;
-------------------
-- New_Procedure --
-------------------
procedure New_Procedure
(O : in out Object;
Proc : in String;
SOAPAction : in String;
Namespace : in String;
Input : in Parameters.P_Set;
Output : in Parameters.P_Set;
Fault : in Parameters.P_Set)
is
pragma Unreferenced (O, Proc, SOAPAction, Namespace);
pragma Unreferenced (Input, Output, Fault);
begin
null;
end New_Procedure;
------------------
-- Next_Sibling --
------------------
function Next_Sibling (N : in DOM.Core.Node) return DOM.Core.Node is
M : DOM.Core.Node := N;
begin
Trace ("(Next_Sibling)", N);
loop
M := DOM.Core.Nodes.Next_Sibling (M);
exit when M = null or else DOM.Core.Nodes.Node_Name (M) /= "#text";
end loop;
return M;
end Next_Sibling;
-----------
-- Parse --
-----------
procedure Parse
(O : in out Object'Class;
Document : in WSDL.Object)
is
N : constant DOM.Core.Node := First_Child (DOM.Core.Node (Document));
NL : constant DOM.Core.Node_List := DOM.Core.Nodes.Child_Nodes (N);
Found : Boolean := False;
begin
for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop
declare
S : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K);
begin
if DOM.Core.Nodes.Node_Name (S) = "service" then
Parse_Service (O, DOM.Core.Nodes.Item (NL, K), Document);
Found := True;
end if;
end;
end loop;
if Verbose_Mode > 0 and then not Found then
Text_IO.New_Line;
Text_IO.Put_Line ("No service found in this document.");
end if;
end Parse;
-----------------
-- Parse_Array --
-----------------
function Parse_Array
(O : in Object'Class;
R : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter
is
P : Parameters.Parameter (Parameters.K_Array);
begin
Trace ("(Parse_Array)", R);
pragma Assert
(R /= null
and then Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "complexType");
declare
Name : constant String := XML.Get_Attr_Value (R, "name", False);
begin
-- Set array name, R is a complexType node
if Name = "ArrayOfanyType" then
-- ??? This is only a convention, we should check the array
-- defintion in the schema.
Raise_Exception
(WSDL_Error'Identity, "ArrayOfanyType not supported.");
end if;
P.Name := O.Current_Name;
P.T_Name := +Name;
P.E_Type := O.Array_Elements;
P.Length := O.Array_Length;
if not WSDL.Is_Standard (To_String (O.Array_Elements)) then
-- This is not a standard type, parse it
declare
N : constant DOM.Core.Node
:= Get_Node (DOM.Core.Node (Document),
"definitions.types.schema.complexType",
To_String (O.Array_Elements));
begin
-- ??? Right now pretend that it is a record, there is
-- certainly some cases not covered here.
Parameters.Append (P.P, Parse_Record (O, N, Document));
end;
end if;
return P;
end;
end Parse_Array;
-------------------
-- Parse_Binding --
-------------------
procedure Parse_Binding
(O : in out Object'Class;
Binding : in DOM.Core.Node;
Document : in WSDL.Object)
is
N : DOM.Core.Node;
begin
Trace ("(Parse_Binding)", Binding);
N := Get_Node (Binding, "soap:binding", NS => True);
-- Check for style (only Document is supported)
if not O.Accept_Document
and then XML.Get_Attr_Value (N, "style") = "document"
then
Raise_Exception
(WSDL_Error'Identity, "Document Web Service style not supported.");
end if;
-- Check for transport (only HTTP is supported)
declare
T : constant String := XML.Get_Attr_Value (N, "transport");
begin
if T (T'Last - 4 .. T'Last) /= "/http" then
Raise_Exception
(WSDL_Error'Identity, "Only HTTP transport supported.");
end if;
end;
-- Read all operations
declare
NL : constant DOM.Core.Node_List
:= DOM.Core.Nodes.Child_Nodes (Binding);
begin
for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop
declare
S : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K);
begin
if DOM.Core.Nodes.Node_Name (S) = "operation" then
begin
Parse_Operation
(O, DOM.Core.Nodes.Item (NL, K), Document);
exception
when E : WSDL_Error =>
if Skip_Error then
Text_IO.Put_Line
(" "
& XML.Get_Attr_Value (S, "name")
& " skipped : "
& Exceptions.Exception_Message (E));
else
Text_IO.New_Line;
Text_IO.Put_Line
("Error in operation "
& XML.Get_Attr_Value (S, "name")
& " : " & Exceptions.Exception_Message (E));
raise;
end if;
end;
end if;
end;
end loop;
end;
end Parse_Binding;
-------------------
-- Parse_Element --
-------------------
procedure Parse_Element
(O : in out Object'Class;
Element : in DOM.Core.Node;
Document : in WSDL.Object)
is
N : DOM.Core.Node := Element;
CT_Node : DOM.Core.Node;
begin
Trace ("(Parse_Element)", Element);
while N /= null
and then DOM.Core.Nodes.Local_Name (N) /= "complexType"
and then DOM.Core.Nodes.Local_Name (N) /= "simpleType"
loop
N := First_Child (N);
end loop;
if N = null then
Raise_Exception
(WSDL_Error'Identity, "No element found in schema.");
else
CT_Node := N;
end if;
if DOM.Core.Nodes.Local_Name (N) = "simpleType" then
Add_Parameter (O, Parse_Simple (O, CT_Node, Document));
else
-- This is a complexType, continue analyse
N := First_Child (N);
if Is_Record (O, CT_Node) then
-- This is a record or composite type
Add_Parameter (O, Parse_Record (O, CT_Node, Document));
elsif Is_Array (O, CT_Node) then
Add_Parameter (O, Parse_Array (O, CT_Node, Document));
else
declare
NL : constant DOM.Core.Node_List
:= DOM.Core.Nodes.Child_Nodes (N);
begin
for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop
declare
N : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K);
begin
if DOM.Core.Nodes.Node_Name (N) /= "#text" then
Add_Parameter (O, Parse_Parameter (O, N, Document));
end if;
end;
end loop;
end;
end if;
end if;
end Parse_Element;
-------------------
-- Parse_Message --
-------------------
procedure Parse_Message
(O : in out Object'Class;
Message : in DOM.Core.Node;
Document : in WSDL.Object)
is
N : DOM.Core.Node := Message;
begin
Trace ("(Parse_Message)", Message);
N := First_Child (N);
while N /= null loop
Parse_Part (O, N, Document);
N := Next_Sibling (N);
end loop;
end Parse_Message;
---------------------
-- Parse_Operation --
---------------------
procedure Parse_Operation
(O : in out Object'Class;
Operation : in DOM.Core.Node;
Document : in WSDL.Object)
is
N : DOM.Core.Node;
begin
Trace ("(Parse_Operation)", Operation);
O.Proc := +XML.Get_Attr_Value (Operation, "name");
N := Get_Node (Operation, "soap:operation", NS => True);
if N = null then
Raise_Exception
(WSDL_Error'Identity, "soap:operation not found.");
end if;
O.SOAPAction := +XML.Get_Attr_Value (N, "soapAction");
N := Next_Sibling (N);
N := First_Child (N);
O.Namespace := +XML.Get_Attr_Value (N, "namespace");
-- Check that input/output/fault is literal
-- ???
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"portType.operation", -O.Proc);
if N = null then
Raise_Exception
(WSDL_Error'Identity,
"portType.operation for " & (-O.Proc) & " not found.");
end if;
Parse_PortType (O, N, Document);
end Parse_Operation;
---------------------
-- Parse_Parameter --
---------------------
function Parse_Parameter
(O : in Object'Class;
N : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter
is
P_Type : constant String := XML.Get_Attr_Value (N, "type", False);
begin
Trace ("(Parse_Parameter)", N);
if WSDL.Is_Standard (P_Type) then
return (Parameters.K_Simple, +XML.Get_Attr_Value (N, "name"),
null, To_Type (P_Type));
elsif P_Type = "anyType" then
Raise_Exception
(WSDL_Error'Identity, "Type anyType is not supported.");
else
declare
R : DOM.Core.Node
:= Get_Node (DOM.Core.Node (Document),
"definitions.types.schema.complexType", P_Type);
begin
if R = null then
-- Now check for a simpleType
R := Get_Node (DOM.Core.Node (Document),
"definitions.types.schema.simpleType", P_Type);
if R = null then
Raise_Exception
(WSDL_Error'Identity,
"types.schema definition for " & P_Type & " not found.");
else
O.Self.Current_Name := +XML.Get_Attr_Value (N, "name");
return Parse_Simple (O, R, Document);
end if;
end if;
if Is_Array (O, R) then
declare
P : Parameters.Parameter := Parse_Array (O, R, Document);
begin
P.Name := +XML.Get_Attr_Value (N, "name");
return P;
end;
else
O.Self.Current_Name := +XML.Get_Attr_Value (N, "name");
return Parse_Record (O, R, Document);
end if;
end;
end if;
end Parse_Parameter;
----------------
-- Parse_Part --
----------------
procedure Parse_Part
(O : in out Object'Class;
Part : in DOM.Core.Node;
Document : in WSDL.Object)
is
N : DOM.Core.Node;
ET : Unbounded_String;
begin
Trace ("(Parse_Part)", Part);
ET := +XML.Get_Attr_Value (Part, "element");
if ET = Null_Unbounded_String then
ET := +XML.Get_Attr_Value (Part, "type");
end if;
if ET = Null_Unbounded_String then
Raise_Exception
(WSDL_Error'Identity,
"No type or element attribute found for part element.");
end if;
O.Current_Name := +XML.Get_Attr_Value (Part, "name");
declare
T : constant String := -ET;
T_No_NS : constant String := Utils.No_NS (T);
begin
if WSDL.Is_Standard (T_No_NS) then
if WSDL.To_Type (T_No_NS) = WSDL.P_Character then
Check_Character
(Get_Node (DOM.Core.Node (Document),
"definitions.types.schema.simpleType", T_No_NS));
end if;
Add_Parameter (O, -O.Current_Name, WSDL.To_Type (T_No_NS));
elsif T = Types.XML_Any_Type then
Raise_Exception
(WSDL_Error'Identity, "Type anyType is not supported.");
else
-- First search for element in the schema
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"types.schema.element", T_No_NS);
-- If not present look for a simpleType
if N = null then
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"types.schema.simpleType", T_No_NS);
end if;
-- If not present look for a complexType
if N = null then
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"types.schema.complexType", T_No_NS);
end if;
if N = null then
Raise_Exception
(WSDL_Error'Identity, "Definition for " & T & " not found.");
end if;
Parse_Element (O, N, Document);
end if;
end;
end Parse_Part;
--------------------
-- Parse_PortType --
--------------------
procedure Parse_PortType
(O : in out Object'Class;
Operation : in DOM.Core.Node;
Document : in WSDL.Object)
is
procedure Get_Element (M : in DOM.Core.Node);
-- Returns the element node which contains parameters for node M
-----------------
-- Get_Element --
-----------------
procedure Get_Element (M : in DOM.Core.Node) is
N : DOM.Core.Node;
Message : Unbounded_String;
begin
Message := +XML.Get_Attr_Value (M, "message", False);
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"message", -Message);
if N = null then
-- In this case the message reference the schema element.
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"types.schema.element", -Message);
if N = null then
Raise_Exception
(WSDL_Error'Identity,
"types.schema.element for " & (-Message) & " not found.");
end if;
Parse_Element (O, N, Document);
else
Parse_Message (O, N, Document);
end if;
end Get_Element;
N : DOM.Core.Node;
begin
Trace ("(Parse_PortType)", Operation);
-- Input parameters
N := Get_Node (Operation, "input");
if N /= null then
O.Mode := Input;
Get_Element (N);
end if;
-- Output parameters
N := Get_Node (Operation, "output");
if N /= null then
O.Mode := Output;
Get_Element (N);
end if;
-- Fault parameters
N := Get_Node (Operation, "fault");
if N /= null then
O.Mode := Fault;
Get_Element (N);
end if;
if Verbose_Mode > 0 then
Text_IO.New_Line;
Text_IO.Put_Line
("Procedure " & (-O.Proc) & " SOAPAction:" & (-O.SOAPAction));
Text_IO.Put_Line (" Input");
Parameters.Output (O.Params (Input));
Text_IO.Put_Line (" Output");
Parameters.Output (O.Params (Output));
end if;
New_Procedure
(O, -O.Proc, -O.SOAPAction, -O.Namespace,
O.Params (Input), O.Params (Output), O.Params (Fault));
Parameters.Release (O.Params (Input));
Parameters.Release (O.Params (Output));
Parameters.Release (O.Params (Fault));
end Parse_PortType;
------------------
-- Parse_Record --
------------------
function Parse_Record
(O : in Object'Class;
R : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter
is
P : Parameters.Parameter (Parameters.K_Record);
N : DOM.Core.Node;
begin
Trace ("(Parse_Record)", R);
pragma Assert
(R /= null
and then Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "complexType");
declare
Name : constant String := XML.Get_Attr_Value (R, "name", False);
begin
-- Set record name, R is a complexType node
P.Name := O.Current_Name;
P.T_Name := +Name;
-- Enter complexType element
N := First_Child (R);
-- Get first element
N := First_Child (N);
while N /= null loop
Parameters.Append (P.P, Parse_Parameter (O, N, Document));
N := Next_Sibling (N);
end loop;
return P;
end;
end Parse_Record;
-------------------
-- Parse_Service --
-------------------
procedure Parse_Service
(O : in out Object'Class;
Service : in DOM.Core.Node;
Document : in WSDL.Object)
is
N : DOM.Core.Node;
Name : Unbounded_String;
Documentation : Unbounded_String;
Location : Unbounded_String;
Binding : Unbounded_String;
begin
Trace ("(Parse_Service)", Service);
Name := +XML.Get_Attr_Value (Service, "name");
N := Get_Node (Service, "documentation");
if N /= null then
DOM.Core.Nodes.Normalize (N);
Documentation :=
+DOM.Core.Nodes.Node_Value (DOM.Core.Nodes.First_Child (N));
end if;
N := Get_Node (Service, "port.soap:address", NS => True);
if N /= null then
Location := +XML.Get_Attr_Value (N, "location");
end if;
Start_Service (O, -Name, -Documentation, -Location);
-- Look for the right binding
N := Get_Node (Service, "port");
if N /= null then
Binding := +XML.Get_Attr_Value (N, "binding", False);
end if;
N := Get_Node
(First_Child (DOM.Core.Node (Document)),
"binding", -Binding);
if N = null then
Raise_Exception
(WSDL_Error'Identity,
"binding for " & (-Binding) & " not found.");
end if;
Parse_Binding (O, N, Document);
End_Service (O, -Name);
end Parse_Service;
------------------
-- Parse_Simple --
------------------
function Parse_Simple
(O : in Object'Class;
R : in DOM.Core.Node;
Document : in WSDL.Object)
return Parameters.Parameter
is
pragma Unreferenced (Document);
function Build_Derived
(Name, Base : in String)
return Parameters.Parameter;
-- Returns the derived type definition
function Build_Enumeration
(Name, Base : in String;
E : in DOM.Core.Node)
return Parameters.Parameter;
-- Returns the enumeration type definition
-------------------
-- Build_Derived --
-------------------
function Build_Derived
(Name, Base : in String)
return Parameters.Parameter
is
P : Parameters.Parameter (Parameters.K_Derived);
begin
P.Name := O.Current_Name;
P.D_Name := +Name;
if WSDL.Is_Standard (Base) then
P.Parent_Type := To_Type (Base);
if P.Parent_Type = WSDL.P_Character then
Check_Character (R);
end if;
else
-- We do not support derived type at more than one level for
-- now.
Raise_Exception
(WSDL_Error'Identity,
"Parent type must be a standard type.");
end if;
return P;
end Build_Derived;
-----------------------
-- Build_Enumeration --
-----------------------
function Build_Enumeration
(Name, Base : in String;
E : in DOM.Core.Node)
return Parameters.Parameter
is
pragma Unreferenced (Base);
use type Parameters.E_Node_Access;
P : Parameters.Parameter (Parameters.K_Enumeration);
N : DOM.Core.Node := E;
D : Parameters.E_Node_Access;
begin
P.Name := O.Current_Name;
P.E_Name := +Name;
while N /= null
and then DOM.Core.Nodes.Node_Name (E) = "enumeration"
loop
declare
Value : constant String
:= XML.Get_Attr_Value (N, "value", False);
New_Node : Parameters.E_Node_Access
:= new Parameters.E_Node'(To_Unbounded_String (Value), null);
begin
if D = null then
P.E_Def := New_Node;
else
D.Next := New_Node;
end if;
D := New_Node;
end;
N := Next_Sibling (N);
end loop;
return P;
end Build_Enumeration;
N, E : DOM.Core.Node;
Name : Unbounded_String;
Base : Unbounded_String;
begin
Trace ("(Parse_Simple)", R);
pragma Assert
(R /= null
and then Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "simpleType");
Name := +XML.Get_Attr_Value (R, "name", False);
-- Enter simpleType restriction
N := First_Child (R);
Base := +XML.Get_Attr_Value (N, "base", False);
-- Check if this is an enumeration
E := First_Child (N);
if E /= null and then DOM.Core.Nodes.Node_Name (E) = "enumeration" then
return Build_Enumeration (-Name, -Base, E);
else
return Build_Derived (-Name, -Base);
end if;
end Parse_Simple;
-------------------
-- Start_Service --
-------------------
procedure Start_Service
(O : in out Object;
Name : in String;
Documentation : in String;
Location : in String)
is
pragma Unreferenced (O, Name, Documentation, Location);
begin
null;
end Start_Service;
-----------
-- Trace --
-----------
procedure Trace (Message : in String; N : in DOM.Core.Node) is
begin
if Verbose_Mode = 2 then
Text_IO.Put_Line (Message);
if N = null then
Text_IO.Put_Line (" Node is null.");
else
declare
Name : constant String
:= DOM.Core.Nodes.Local_Name (N);
Atts : constant DOM.Core.Named_Node_Map
:= DOM.Core.Nodes.Attributes (N);
begin
Text_IO.Put_Line (" " & Name);
for K in 0 .. DOM.Core.Nodes.Length (Atts) - 1 loop
Text_IO.Put (" ");
declare
N : constant DOM.Core.Node
:= DOM.Core.Nodes.Item (Atts, K);
Name : constant String := DOM.Core.Nodes.Local_Name (N);
Value : constant String := DOM.Core.Nodes.Node_Value (N);
begin
Text_IO.Put (Name & " = " & Value);
end;
Text_IO.New_Line;
end loop;
end;
end if;
end if;
end Trace;
-------------
-- Verbose --
-------------
procedure Verbose (Level : in Verbose_Level := 1) is
begin
Verbose_Mode := Level;
end Verbose;
end SOAP.WSDL.Parser;