File : soap/soap-generator.adb
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003 --
-- 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-generator.adb,v 1.38 2003/11/28 15:27:14 obry Exp $
with Ada.Calendar;
with Ada.Characters.Handling;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with GNAT.Calendar.Time_IO;
with AWS;
with AWS.OS_Lib;
with AWS.Templates;
with AWS.Utils;
with SOAP.Utils;
with SOAP.WSDL.Parameters;
package body SOAP.Generator is
use Ada;
use Ada.Exceptions;
use Ada.Strings.Unbounded;
function Format_Name (O : in Object; Name : in String) return String;
-- Returns Name formated with the Ada style if O.Ada_Style is true and
-- Name unchanged otherwise.
function Time_Stamp return String;
-- Returns a time stamp Ada comment line
function Version_String return String;
-- Returns a version string Ada comment line
procedure Put_File_Header (O : in Object; File : in Text_IO.File_Type);
-- Add a standard file header into file.
procedure Put_Types
(O : in Object;
Proc : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set);
-- This must be called to create the data types for composite objects
procedure Put_Header
(File : in Text_IO.File_Type;
O : in Object;
Proc : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set);
-- Output procedure header into File. The terminating ';' or 'is' is not
-- outputed for this routine to be used to generate the spec and body.
function Result_Type
(O : in Object;
Proc : in String;
Output : in WSDL.Parameters.P_Set)
return String;
-- Returns the result type given the output parameters
procedure Header_Box
(O : in Object;
File : in Text_IO.File_Type;
Name : in String);
-- Generate header box
function To_Unit_Name
(Filename : in String)
return String;
-- Returns the unit name given a filename following the GNAT
-- naming scheme.
Root : Text_IO.File_Type; -- Parent packages
Type_Ads : Text_IO.File_Type; -- Child with all type definitions
Type_Adb : Text_IO.File_Type;
Stub_Ads : Text_IO.File_Type; -- Child with client interface
Stub_Adb : Text_IO.File_Type;
Skel_Ads : Text_IO.File_Type; -- Child with server interface
Skel_Adb : Text_IO.File_Type;
CB_Ads : Text_IO.File_Type; -- Child with all callback routines
CB_Adb : Text_IO.File_Type;
Tmp_Adb : Text_IO.File_Type; -- Temporary files with callback definitions
-- Stub generator routines
package Stub is
procedure Start_Service
(O : in out Object;
Name : in String;
Documentation : in String;
Location : in String);
procedure End_Service
(O : in out Object;
Name : in String);
procedure New_Procedure
(O : in out Object;
Proc : in String;
SOAPAction : in String;
Namespace : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set;
Fault : in WSDL.Parameters.P_Set);
end Stub;
-- Skeleton generator routines
package Skel is
procedure Start_Service
(O : in out Object;
Name : in String;
Documentation : in String;
Location : in String);
procedure End_Service
(O : in out Object;
Name : in String);
procedure New_Procedure
(O : in out Object;
Proc : in String;
SOAPAction : in String;
Namespace : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set;
Fault : in WSDL.Parameters.P_Set);
end Skel;
-- Callback generator routines
package CB is
procedure Start_Service
(O : in out Object;
Name : in String;
Documentation : in String;
Location : in String);
procedure End_Service
(O : in out Object;
Name : in String);
procedure New_Procedure
(O : in out Object;
Proc : in String;
SOAPAction : in String;
Namespace : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set;
Fault : in WSDL.Parameters.P_Set);
end CB;
-- Simple name set used to keep record of all generated types
package Name_Set is
procedure Add (Name : in String);
-- Add new name into the set
function Exists (Name : in String) return Boolean;
-- Returns true if Name is in the set
end Name_Set;
---------------
-- Ada_Style --
---------------
procedure Ada_Style (O : in out Object) is
begin
O.Ada_Style := True;
end Ada_Style;
--------
-- CB --
--------
package body CB is separate;
-------------
-- CVS_Tag --
-------------
procedure CVS_Tag (O : in out Object) is
begin
O.CVS_Tag := True;
end CVS_Tag;
-----------------
-- End_Service --
-----------------
procedure End_Service
(O : in out Object;
Name : in String)
is
U_Name : constant String := To_Unit_Name (Format_Name (O, Name));
begin
-- Root
Text_IO.New_Line (Root);
Text_IO.Put_Line (Root, "end " & U_Name & ";");
Text_IO.Close (Root);
-- Types
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, "end " & U_Name & ".Types;");
Text_IO.Close (Type_Ads);
Text_IO.New_Line (Type_Adb);
Text_IO.Put_Line (Type_Adb, "end " & U_Name & ".Types;");
Text_IO.Close (Type_Adb);
-- Stub
if O.Gen_Stub then
Stub.End_Service (O, Name);
Text_IO.Close (Stub_Ads);
Text_IO.Close (Stub_Adb);
end if;
-- Skeleton
if O.Gen_Skel then
Skel.End_Service (O, Name);
Text_IO.Close (Skel_Ads);
Text_IO.Close (Skel_Adb);
end if;
-- Callbacks
if O.Gen_CB then
CB.End_Service (O, Name);
Text_IO.Close (CB_Ads);
Text_IO.Close (CB_Adb);
Text_IO.Close (Tmp_Adb);
end if;
end End_Service;
-----------------
-- Format_Name --
-----------------
function Format_Name (O : in Object; Name : in String) return String is
function Ada_Format (Name : in String) return String;
-- Returns Name with the Ada style
function Ada_Format (Name : in String) return String is
Result : Unbounded_String;
begin
-- No need to reformat this name
if not O.Ada_Style then
return Name;
end if;
for K in Name'Range loop
if K = Name'First then
Append (Result, Characters.Handling.To_Upper (Name (K)));
elsif Characters.Handling.Is_Upper (Name (K))
and then K > Name'First
and then Name (K - 1) /= '_'
and then Name (K - 1) /= '.'
and then K < Name'Last
and then Name (K + 1) /= '_'
and then Name (K + 1) /= '.'
then
Append (Result, "_" & Name (K));
else
Append (Result, Name (K));
end if;
end loop;
return To_String (Result);
end Ada_Format;
Ada_Name : constant String := Ada_Format (Name);
begin
if Utils.Is_Ada_Reserved_Word (Name) then
return "v_" & Ada_Name;
else
return Ada_Name;
end if;
end Format_Name;
------------
-- Gen_CB --
------------
procedure Gen_CB (O : in out Object) is
begin
O.Gen_CB := True;
end Gen_CB;
----------------
-- Header_Box --
----------------
procedure Header_Box
(O : in Object;
File : in Text_IO.File_Type;
Name : in String)
is
pragma Unreferenced (O);
begin
Text_IO.Put_Line
(File, " " & String'(1 .. 6 + Name'Length => '-'));
Text_IO.Put_Line
(File, " -- " & Name & " --");
Text_IO.Put_Line
(File, " " & String'(1 .. 6 + Name'Length => '-'));
end Header_Box;
----------
-- Main --
----------
procedure Main (O : in out Object; Name : in String) is
begin
O.Main := To_Unbounded_String (Name);
end Main;
--------------
-- Name_Set --
--------------
package body Name_Set is separate;
-------------------
-- New_Procedure --
-------------------
procedure New_Procedure
(O : in out Object;
Proc : in String;
SOAPAction : in String;
Namespace : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set;
Fault : in WSDL.Parameters.P_Set) is
begin
if not O.Quiet then
Text_IO.Put_Line (" > " & Proc);
end if;
Put_Types (O, Proc, Input, Output);
if O.Gen_Stub then
Stub.New_Procedure
(O, Proc, SOAPAction, Namespace, Input, Output, Fault);
end if;
if O.Gen_Skel then
Skel.New_Procedure
(O, Proc, SOAPAction, Namespace, Input, Output, Fault);
end if;
if O.Gen_CB then
CB.New_Procedure
(O, Proc, SOAPAction, Namespace, Input, Output, Fault);
end if;
end New_Procedure;
-------------
-- No_Skel --
-------------
procedure No_Skel (O : in out Object) is
begin
O.Gen_Skel := False;
end No_Skel;
-------------
-- No_Stub --
-------------
procedure No_Stub (O : in out Object) is
begin
O.Gen_Stub := False;
end No_Stub;
-------------
-- Options --
-------------
procedure Options (O : in out Object; Options : in String) is
begin
O.Options := To_Unbounded_String (Options);
end Options;
---------------
-- Overwrite --
---------------
procedure Overwrite (O : in out Object) is
begin
O.Force := True;
end Overwrite;
---------------------
-- Put_File_Header --
---------------------
procedure Put_File_Header (O : in Object; File : in Text_IO.File_Type) is
begin
Text_IO.New_Line (File);
Text_IO.Put_Line (File, "-- wsdl2aws SOAP Generator v" & Version);
Text_IO.Put_Line (File, "--");
Text_IO.Put_Line (File, Version_String);
Text_IO.Put_Line (File, Time_Stamp);
Text_IO.Put_Line (File, "--");
Text_IO.Put_Line (File, "-- $ wsdl2aws " & To_String (O.Options));
Text_IO.New_Line (File);
if O.CVS_Tag then
Text_IO.Put_Line (File, "-- $" & "Id$");
Text_IO.New_Line (File);
end if;
end Put_File_Header;
----------------
-- Put_Header --
----------------
procedure Put_Header
(File : in Text_IO.File_Type;
O : in Object;
Proc : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set)
is
use Ada.Strings.Fixed;
use type SOAP.WSDL.Parameters.P_Set;
use type SOAP.WSDL.Parameters.Kind;
L_Proc : constant String := Format_Name (O, Proc);
Max_Len : Positive := 1;
N : WSDL.Parameters.P_Set;
begin
-- Compute maximum name length
N := Input;
while N /= null loop
Max_Len := Positive'Max
(Max_Len, Format_Name (O, To_String (N.Name))'Length);
N := N.Next;
end loop;
-- Ouput header
if Output = null then
Text_IO.Put (File, "procedure " & L_Proc);
if Input /= null then
Text_IO.New_Line (File);
end if;
else
Text_IO.Put_Line (File, "function " & L_Proc);
end if;
if Input /= null then
Text_IO.Put (File, " (");
-- Output parameters
N := Input;
while N /= null loop
declare
Name : constant String
:= Format_Name (O, To_String (N.Name));
begin
Text_IO.Put (File, Name);
Text_IO.Put (File, (Max_Len - Name'Length) * ' ');
end;
Text_IO.Put (File, " : in ");
case N.Mode is
when WSDL.Parameters.K_Simple =>
Text_IO.Put (File, WSDL.To_Ada (N.P_Type));
when WSDL.Parameters.K_Derived =>
Text_IO.Put (File, To_String (N.D_Name) & "_Type");
when WSDL.Parameters.K_Enumeration =>
Text_IO.Put (File, To_String (N.E_Name) & "_Type");
when WSDL.Parameters.K_Record | WSDL.Parameters.K_Array =>
Text_IO.Put
(File, Format_Name (O, To_String (N.T_Name) & "_Type"));
end case;
if N.Next = null then
Text_IO.Put (File, ")");
else
Text_IO.Put_Line (File, ";");
Text_IO.Put (File, " ");
end if;
N := N.Next;
end loop;
end if;
if Output /= null then
if Input /= null then
Text_IO.New_Line (File);
end if;
Text_IO.Put (File, " return ");
Text_IO.Put (File, Result_Type (O, Proc, Output));
end if;
end Put_Header;
---------------
-- Put_Types --
---------------
procedure Put_Types
(O : in Object;
Proc : in String;
Input : in WSDL.Parameters.P_Set;
Output : in WSDL.Parameters.P_Set)
is
use type WSDL.Parameters.Kind;
use type WSDL.Parameters.P_Set;
procedure Generate_Record
(Name : in String;
P : in WSDL.Parameters.P_Set;
Output : in Boolean := False);
-- Output record definitions (type and routine conversion)
function Type_Name (N : in WSDL.Parameters.P_Set) return String;
-- Returns the name of the type for parameter on node N
function Array_Type (Name : in String) return String;
-- Returns the type of the array element given the array Name.
procedure Generate_Array
(Name : in String;
P : in WSDL.Parameters.P_Set);
-- Generate array definitions (type and routine conversion)
procedure Generate_Derived
(Name : in String;
P : in WSDL.Parameters.P_Set);
-- Generate derived type definition
procedure Generate_Enumeration
(Name : in String;
P : in WSDL.Parameters.P_Set);
-- Generate enumeration type definition
procedure Generate_Safe_Array
(Name : in String;
P : in WSDL.Parameters.P_Set);
-- Generate the safe array runtime support. This is only done when a
-- user spec is speficied. We must generate such reference to user's
-- spec only if we have an array inside a record.
procedure Output_Types (P : in WSDL.Parameters.P_Set);
-- Output types conversion routines
function Get_Routine (P : in WSDL.Parameters.P_Set) return String;
-- Returns the Get routine for the given type
function Set_Routine (P : in WSDL.Parameters.P_Set) return String;
-- Returns the constructor routine for the given type
function Set_Type (Name : in String) return String;
-- Returns the SOAP type for Name
function Is_Inside_Record (Name : in String) return Boolean;
-- Returns True if Name is defined inside a record in the Input
-- or Output parameter list.
----------------
-- Array_Type --
----------------
function Array_Type (Name : in String) return String is
K : Natural := Strings.Fixed.Index (Name, "_");
begin
-- Skip trailing _xyz
if K = 0 then
K := Name'Last;
else
K := K - 1;
end if;
return Name (Name'First .. K);
end Array_Type;
--------------------
-- Generate_Array --
--------------------
procedure Generate_Array
(Name : in String;
P : in WSDL.Parameters.P_Set)
is
function To_Ada_Type (Name : in String) return String;
-- Returns the Ada corresponding type
-----------------
-- To_Ada_Type --
-----------------
function To_Ada_Type (Name : in String) return String is
begin
if WSDL.Is_Standard (Name) then
return WSDL.To_Ada
(WSDL.To_Type (Name), Context => WSDL.Component);
else
return Name & "_Type";
end if;
end To_Ada_Type;
F_Name : constant String := Format_Name (O, Name);
T_Name : constant String := To_String (P.E_Type);
begin
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " " & String'(1 .. 12 + F_Name'Length => '-'));
Text_IO.Put_Line
(Type_Ads, " -- Array " & F_Name & " --");
Text_IO.Put_Line
(Type_Ads, " " & String'(1 .. 12 + F_Name'Length => '-'));
Text_IO.New_Line (Type_Ads);
-- Is types are to be reused from an Ada spec ?
if O.Types_Spec = Null_Unbounded_String then
-- No user's spec, generate all typ definitions
-- Array type
if P.Length = 0 then
-- Unconstrained array
Text_IO.Put_Line
(Type_Ads,
" type " & F_Name & " is array (Positive range <>) of "
& To_Ada_Type (T_Name) & ";");
else
-- A constrained array
Text_IO.Put_Line
(Type_Ads,
" subtype " & F_Name & "_Index is Positive range 1 .. "
& AWS.Utils.Image (P.Length) & ";");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads,
" type " & F_Name & " is array (" & F_Name & "_Index)"
& " of " & To_Ada_Type (T_Name) & ";");
end if;
-- Access to it
-- Safe pointer, needed only for unconstrained arrays
if P.Length = 0 then
Text_IO.Put_Line
(Type_Ads, " type "
& F_Name & "_Access" & " is access all " & F_Name & ';');
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " package " & F_Name & "_Safe_Pointer is");
Text_IO.Put_Line
(Type_Ads, " new SOAP.Utils.Safe_Pointers ("
& F_Name & ", " & F_Name & "_Access);");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " subtype " & F_Name & "_Safe_Access");
Text_IO.Put_Line
(Type_Ads, " is " & F_Name
& "_Safe_Pointer.Safe_Pointer;");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " function ""+""");
Text_IO.Put_Line
(Type_Ads, " (O : in " & F_Name & ')');
Text_IO.Put_Line
(Type_Ads, " return " & F_Name & "_Safe_Access");
Text_IO.Put_Line
(Type_Ads, " renames " & F_Name
& "_Safe_Pointer.To_Safe_Pointer;");
Text_IO.Put_Line
(Type_Ads, " -- Convert an array to a safe pointer");
end if;
else
-- Here we have a reference to a spec, just build alias to it
if P.Length /= 0 then
-- This is a constrained array, create the index subtype
Text_IO.Put_Line
(Type_Ads,
" subtype " & F_Name & "_Index is Positive range 1 .. "
& AWS.Utils.Image (P.Length) & ";");
end if;
Text_IO.Put_Line
(Type_Ads, " subtype " & F_Name & " is "
& To_String (O.Types_Spec)
& "." & To_String (P.T_Name) & ";");
-- Note that we can't generate safe array runtime support at this
-- point. It could be the case that this array is not inside a
-- record but another reference in the WSDL document will be
-- inside a record. As a type is analyzed only once we must
-- deferred this code generation. See Generate_Safe_Array.
end if;
Text_IO.New_Line (Type_Ads);
if P.Length = 0 then
Text_IO.Put_Line
(Type_Ads, " function To_" & F_Name
& " is new SOAP.Utils.To_T_Array");
else
Text_IO.Put_Line
(Type_Ads, " function To_" & F_Name
& " is new SOAP.Utils.To_T_Array_C");
end if;
Text_IO.Put
(Type_Ads, " (" & To_Ada_Type (T_Name) & ", ");
if P.Length = 0 then
Text_IO.Put (Type_Ads, F_Name);
else
Text_IO.Put (Type_Ads, F_Name & "_Index, " & F_Name);
end if;
Text_IO.Put_Line (Type_Ads, ", " & Get_Routine (P) & ");");
Text_IO.New_Line (Type_Ads);
if P.Length = 0 then
Text_IO.Put_Line
(Type_Ads, " function To_Object_Set"
& " is new SOAP.Utils.To_Object_Set");
else
Text_IO.Put_Line
(Type_Ads, " function To_Object_Set"
& " is new SOAP.Utils.To_Object_Set_C");
end if;
Text_IO.Put
(Type_Ads, " (" & To_Ada_Type (T_Name) & ", ");
if P.Length = 0 then
Text_IO.Put_Line (Type_Ads, F_Name & ",");
else
Text_IO.Put_Line (Type_Ads, F_Name & "_Index, " & F_Name & ",");
end if;
Text_IO.Put_Line
(Type_Ads,
" " & Set_Type (T_Name) & ", " & Set_Routine (P) & ");");
end Generate_Array;
----------------------
-- Generate_Derived --
----------------------
procedure Generate_Derived
(Name : in String;
P : in WSDL.Parameters.P_Set)
is
F_Name : constant String := Format_Name (O, Name);
T_Name : constant String := WSDL.To_Ada (P.Parent_Type);
begin
Text_IO.New_Line (Type_Ads);
-- Is types are to be reused from an Ada spec ?
if O.Types_Spec = Null_Unbounded_String then
Text_IO.Put_Line
(Type_Ads, " type " & F_Name
& " is new " & T_Name & ";");
else
Text_IO.Put_Line
(Type_Ads, " subtype " & F_Name & " is "
& To_String (O.Types_Spec)
& "." & To_String (P.D_Name) & ";");
end if;
end Generate_Derived;
--------------------------
-- Generate_Enumeration --
--------------------------
procedure Generate_Enumeration
(Name : in String;
P : in WSDL.Parameters.P_Set)
is
use type WSDL.Parameters.E_Node_Access;
F_Name : constant String := Format_Name (O, Name);
function Image (E : in WSDL.Parameters.E_Node_Access) return String;
-- Returns the enumeration definition
-----------
-- Image --
-----------
function Image (E : in WSDL.Parameters.E_Node_Access) return String is
Result : Unbounded_String;
N : WSDL.Parameters.E_Node_Access := E;
begin
while N /= null loop
if Result = Null_Unbounded_String then
Append (Result, "(");
else
Append (Result, ", ");
end if;
Append (Result, To_String (N.Value));
N := N.Next;
end loop;
Append (Result, ")");
return To_String (Result);
end Image;
N : WSDL.Parameters.E_Node_Access := P.E_Def;
begin
Text_IO.New_Line (Type_Ads);
-- Is types are to be reused from an Ada spec ?
if O.Types_Spec = Null_Unbounded_String then
Text_IO.Put_Line
(Type_Ads, " type " & F_Name
& " is " & Image (P.E_Def) & ";");
else
Text_IO.Put_Line
(Type_Ads, " subtype " & F_Name & " is "
& To_String (O.Types_Spec)
& "." & To_String (P.E_Name) & ";");
end if;
-- Generate Image function
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads,
" function Image (E : in " & F_Name & ") return String;");
Text_IO.New_Line (Type_Adb);
Text_IO.Put_Line
(Type_Adb,
" function Image (E : in " & F_Name & ") return String is");
Text_IO.Put_Line (Type_Adb, " begin");
Text_IO.Put_Line (Type_Adb, " case E is");
while N /= null loop
Text_IO.Put (Type_Adb, " when ");
if O.Types_Spec /= Null_Unbounded_String then
Text_IO.Put (Type_Adb, To_String (O.Types_Spec) & '.');
end if;
Text_IO.Put_Line
(Type_Adb, To_String (N.Value)
& " => return """ & To_String (N.Value) & """;");
N := N.Next;
end loop;
Text_IO.Put_Line (Type_Adb, " end case;");
Text_IO.Put_Line (Type_Adb, " end Image;");
end Generate_Enumeration;
---------------------
-- Generate_Record --
---------------------
procedure Generate_Record
(Name : in String;
P : in WSDL.Parameters.P_Set;
Output : in Boolean := False)
is
F_Name : constant String := Format_Name (O, Name);
R : WSDL.Parameters.P_Set;
N : WSDL.Parameters.P_Set;
Max : Positive;
begin
if Output then
R := P;
else
R := P.P;
end if;
-- Generate record type
Text_IO.New_Line (Type_Ads);
Header_Box (O, Type_Ads, "Record " & F_Name);
-- Is types are to be reused from an Ada spec ?
if O.Types_Spec = Null_Unbounded_String then
-- Compute max filed width
N := R;
Max := 1;
while N /= null loop
Max := Positive'Max
(Max, Format_Name (O, To_String (N.Name))'Length);
N := N.Next;
end loop;
-- Output field
N := R;
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " type " & F_Name & " is record");
while N /= null loop
declare
F_Name : constant String
:= Format_Name (O, To_String (N.Name));
begin
Text_IO.Put
(Type_Ads, " "
& F_Name
& String'(1 .. Max - F_Name'Length => ' ') & " : ");
end;
Text_IO.Put (Type_Ads, Format_Name (O, Type_Name (N)));
Text_IO.Put_Line (Type_Ads, ";");
if N.Mode = WSDL.Parameters.K_Array then
Text_IO.Put_Line
(Type_Ads,
" -- Access items with : result.Item (n)");
end if;
N := N.Next;
end loop;
Text_IO.Put_Line
(Type_Ads, " end record;");
else
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " subtype " & F_Name & " is "
& To_String (O.Types_Spec)
& "." & To_String (P.T_Name) & ";");
end if;
-- Generate conversion spec
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " function To_" & F_Name);
Text_IO.Put_Line (Type_Ads, " (O : in SOAP.Types.Object'Class)");
Text_IO.Put_Line (Type_Ads, " return " & F_Name & ';');
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " function To_SOAP_Object");
Text_IO.Put_Line (Type_Ads, " (R : in " & F_Name & ';');
Text_IO.Put_Line (Type_Ads, " Name : in String := ""item"")");
Text_IO.Put_Line (Type_Ads, " return SOAP.Types.SOAP_Record;");
-- Generate conversion body
Text_IO.New_Line (Type_Adb);
Header_Box (O, Type_Adb, "Record " & F_Name);
-- SOAP to Ada
Text_IO.New_Line (Type_Adb);
Text_IO.Put_Line (Type_Adb, " function To_" & F_Name);
Text_IO.Put_Line (Type_Adb, " (O : in SOAP.Types.Object'Class)");
Text_IO.Put_Line (Type_Adb, " return " & F_Name);
Text_IO.Put_Line (Type_Adb, " is");
Text_IO.Put_Line
(Type_Adb,
" R : constant SOAP.Types.SOAP_Record "
& ":= SOAP.Types.SOAP_Record (O);");
N := R;
while N /= null loop
case N.Mode is
when WSDL.Parameters.K_Simple =>
declare
I_Type : constant String := WSDL.Set_Type (N.P_Type);
begin
Text_IO.Put_Line
(Type_Adb,
" " & Format_Name (O, To_String (N.Name))
& " : constant " & I_Type);
Text_IO.Put_Line
(Type_Adb,
" := " & I_Type & " (SOAP.Types.V (R, """
& To_String (N.Name) & """));");
end;
when WSDL.Parameters.K_Derived =>
declare
I_Type : constant String := WSDL.Set_Type (N.Parent_Type);
begin
Text_IO.Put_Line
(Type_Adb,
" " & Format_Name (O, To_String (N.Name))
& " : constant " & I_Type);
Text_IO.Put_Line
(Type_Adb,
" := " & I_Type & " (SOAP.Types.V (R, """
& To_String (N.Name) & """));");
end;
when WSDL.Parameters.K_Enumeration =>
Text_IO.Put_Line
(Type_Adb,
" " & Format_Name (O, To_String (N.Name))
& " : constant SOAP.Types.SOAP_Enumeration");
Text_IO.Put_Line
(Type_Adb,
" := SOAP.Types.SOAP_Enumeration (SOAP.Types.V "
& "(R, """ & To_String (N.Name) & """));");
when WSDL.Parameters.K_Array =>
Text_IO.Put_Line
(Type_Adb,
" " & Format_Name (O, To_String (N.Name))
& " : constant SOAP.Types.SOAP_Array");
Text_IO.Put_Line
(Type_Adb,
" := SOAP.Types.SOAP_Array (SOAP.Types.V (R, """
& To_String (N.Name) & """));");
when WSDL.Parameters.K_Record =>
Text_IO.Put_Line
(Type_Adb,
" " & Format_Name (O, To_String (N.Name))
& " : constant SOAP.Types.SOAP_Record");
Text_IO.Put_Line
(Type_Adb,
" := SOAP.Types.SOAP_Record (SOAP.Types.V (R, """
& To_String (N.Name) & """));");
end case;
N := N.Next;
end loop;
Text_IO.Put_Line (Type_Adb, " begin");
Text_IO.Put (Type_Adb, " return (");
N := R;
if N.Next = null then
-- We have a single element into this record, we must use a named
-- notation for the aggregate.
Text_IO.Put (Type_Adb, To_String (N.Name) & " => ");
end if;
while N /= null loop
if N /= R then
Text_IO.Put (Type_Adb, " ");
end if;
case N.Mode is
when WSDL.Parameters.K_Simple =>
Text_IO.Put
(Type_Adb, WSDL.V_Routine (N.P_Type, WSDL.Component)
& " (" & Format_Name (O, To_String (N.Name)) & ')');
when WSDL.Parameters.K_Derived =>
Text_IO.Put
(Type_Adb,
To_String (N.D_Name) & "_Type ("
& WSDL.V_Routine (N.Parent_Type, WSDL.Component)
& " (" & Format_Name (O, To_String (N.Name)) & "))");
when WSDL.Parameters.K_Enumeration =>
Text_IO.Put
(Type_Adb,
To_String (N.E_Name) & "_Type'Value ("
& "SOAP.Types.V ("
& Format_Name (O, To_String (N.Name)) & "))");
when WSDL.Parameters.K_Array =>
Text_IO.Put
(Type_Adb, "+To_" & Format_Name (O, To_String (N.T_Name))
& "_Type (SOAP.Types.V ("
& Format_Name (O, To_String (N.Name)) & "))");
when WSDL.Parameters.K_Record =>
Text_IO.Put (Type_Adb, Get_Routine (N));
Text_IO.Put
(Type_Adb,
" (" & Format_Name (O, To_String (N.Name)) & ")");
end case;
if N.Next = null then
Text_IO.Put_Line (Type_Adb, ");");
else
Text_IO.Put_Line (Type_Adb, ",");
end if;
N := N.Next;
end loop;
Text_IO.Put_Line (Type_Adb, " end To_" & F_Name & ';');
-- To_SOAP_Object
Text_IO.New_Line (Type_Adb);
Text_IO.Put_Line (Type_Adb, " function To_SOAP_Object");
Text_IO.Put_Line (Type_Adb, " (R : in " & F_Name & ';');
Text_IO.Put_Line (Type_Adb, " Name : in String := ""item"")");
Text_IO.Put_Line (Type_Adb, " return SOAP.Types.SOAP_Record");
Text_IO.Put_Line (Type_Adb, " is");
Text_IO.Put_Line (Type_Adb, " Result : SOAP.Types.SOAP_Record;");
Text_IO.Put_Line (Type_Adb, " begin");
N := R;
Text_IO.Put_Line (Type_Adb, " Result := SOAP.Types.R");
while N /= null loop
if N = R then
if R.Next = null then
-- We have a single element into this record, we must use a
-- named notation for the aggregate.
Text_IO.Put (Type_Adb, " ((1 => +");
else
Text_IO.Put (Type_Adb, " ((+");
end if;
else
Text_IO.Put (Type_Adb, " +");
end if;
case N.Mode is
when WSDL.Parameters.K_Simple =>
Text_IO.Put (Type_Adb, Set_Routine (N));
Text_IO.Put
(Type_Adb,
" (R." & Format_Name (O, To_String (N.Name))
& ", """ & To_String (N.Name) & """)");
when WSDL.Parameters.K_Derived =>
Text_IO.Put (Type_Adb, Set_Routine (N));
Text_IO.Put
(Type_Adb,
" (" & WSDL.To_Ada (N.Parent_Type)
& " (R." & Format_Name (O, To_String (N.Name))
& "), """ & To_String (N.Name) & """)");
when WSDL.Parameters.K_Enumeration =>
Text_IO.Put
(Type_Adb,
" SOAP.Types.E (Image"
& " (R." & Format_Name (O, To_String (N.Name))
& "), """ & To_String (N.E_Name)
& """, """ & To_String (N.Name) & """)");
when WSDL.Parameters.K_Array =>
Text_IO.Put
(Type_Adb,
"SOAP.Types.A (To_Object_Set (R."
& Format_Name (O, To_String (N.Name))
& ".Item.all), """ & To_String (N.Name) & """)");
when WSDL.Parameters.K_Record =>
Text_IO.Put (Type_Adb, Set_Routine (N));
Text_IO.Put
(Type_Adb,
" (R." & Format_Name (O, To_String (N.Name))
& ", """ & To_String (N.Name) & """)");
end case;
if N.Next = null then
Text_IO.Put_Line (Type_Adb, "),");
else
Text_IO.Put_Line (Type_Adb, ",");
end if;
N := N.Next;
end loop;
Text_IO.Put_Line
(Type_Adb,
" Name, """ & To_String (P.T_Name) & """);");
Text_IO.Put_Line (Type_Adb, " return Result;");
Text_IO.Put_Line (Type_Adb, " end To_SOAP_Object;");
end Generate_Record;
-------------------------
-- Generate_Safe_Array --
-------------------------
procedure Generate_Safe_Array
(Name : in String;
P : in WSDL.Parameters.P_Set)
is
F_Name : constant String := Format_Name (O, Name) & "_Type";
begin
if O.Types_Spec /= Null_Unbounded_String
and then Is_Inside_Record (Name)
and then not Name_Set.Exists (Name & "Safe_Array_Support__")
then
-- Only if we have a user's spec specificed and this array is
-- inside a record and we don't have generated this support.
Name_Set.Add (Name & "Safe_Array_Support__");
Text_IO.New_Line (Type_Ads);
Header_Box (O, Type_Ads, "Safe Array " & F_Name);
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " subtype " & F_Name & "_Safe_Access");
Text_IO.Put_Line
(Type_Ads, " is " & To_String (O.Types_Spec) & "."
& To_String (P.T_Name) & "_Safe_Pointer.Safe_Pointer;");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads, " function ""+""");
Text_IO.Put_Line
(Type_Ads, " (O : in " & F_Name & ')');
Text_IO.Put_Line
(Type_Ads, " return " & F_Name & "_Safe_Access");
Text_IO.Put_Line
(Type_Ads, " renames " & To_String (O.Types_Spec) & "."
& To_String (P.T_Name) & "_Safe_Pointer.To_Safe_Pointer;");
Text_IO.Put_Line
(Type_Ads, " -- Convert an array to a safe pointer");
end if;
end Generate_Safe_Array;
-----------------
-- Get_Routine --
-----------------
function Get_Routine (P : in WSDL.Parameters.P_Set) return String is
begin
case P.Mode is
when WSDL.Parameters.K_Simple =>
return WSDL.Get_Routine (P.P_Type);
when WSDL.Parameters.K_Derived =>
return WSDL.Get_Routine (P.Parent_Type);
when WSDL.Parameters.K_Enumeration =>
return WSDL.Get_Routine (WSDL.P_String);
when WSDL.Parameters.K_Array =>
declare
T_Name : constant String
:= Array_Type (To_String (P.E_Type));
begin
if WSDL.Is_Standard (T_Name) then
return WSDL.Get_Routine
(WSDL.To_Type (T_Name), WSDL.Component);
else
return "To_" & T_Name & "_Type";
end if;
end;
when WSDL.Parameters.K_Record =>
return "To_" & Type_Name (P);
end case;
end Get_Routine;
----------------------
-- Is_Inside_Record --
----------------------
function Is_Inside_Record (Name : in String) return Boolean is
use type WSDL.Parameters.Kind;
In_Record : Boolean := False;
procedure Check_Record
(P_Set : in WSDL.Parameters.P_Set;
Mode : out Boolean);
-- Checks all record fields for Name
procedure Check_Parameters
(P_Set : in WSDL.Parameters.P_Set);
-- Checks P_Set for Name declared inside a record
----------------------
-- Check_Parameters --
----------------------
procedure Check_Parameters
(P_Set : in WSDL.Parameters.P_Set)
is
P : WSDL.Parameters.P_Set := P_Set;
begin
while P /= null loop
if P.Mode = WSDL.Parameters.K_Record then
Check_Record (P.P, In_Record);
end if;
P := P.Next;
end loop;
end Check_Parameters;
------------------
-- Check_Record --
------------------
procedure Check_Record
(P_Set : in WSDL.Parameters.P_Set;
Mode : out Boolean)
is
P : WSDL.Parameters.P_Set := P_Set;
begin
while P /= null loop
if P.Mode = WSDL.Parameters.K_Array
and then To_String (P.T_Name) = Name
then
Mode := True;
end if;
if P.Mode = WSDL.Parameters.K_Record then
Check_Record (P.P, Mode);
end if;
P := P.Next;
end loop;
end Check_Record;
begin
Check_Parameters (Input);
Check_Parameters (Output);
return In_Record;
end Is_Inside_Record;
------------------
-- Output_Types --
------------------
procedure Output_Types (P : in WSDL.Parameters.P_Set) is
N : WSDL.Parameters.P_Set := P;
begin
while N /= null loop
case N.Mode is
when WSDL.Parameters.K_Simple =>
null;
when WSDL.Parameters.K_Derived =>
declare
Name : constant String := To_String (N.D_Name);
begin
if not Name_Set.Exists (Name) then
Name_Set.Add (Name);
Generate_Derived (Name & "_Type", N);
end if;
end;
when WSDL.Parameters.K_Enumeration =>
declare
Name : constant String := To_String (N.E_Name);
begin
if not Name_Set.Exists (Name) then
Name_Set.Add (Name);
Generate_Enumeration (Name & "_Type", N);
end if;
end;
when WSDL.Parameters.K_Array =>
Output_Types (N.P);
declare
Name : constant String := To_String (N.T_Name);
begin
if not Name_Set.Exists (Name) then
Name_Set.Add (Name);
Generate_Array (Name & "_Type", N);
end if;
Generate_Safe_Array (Name, N);
end;
when WSDL.Parameters.K_Record =>
Output_Types (N.P);
declare
Name : constant String := To_String (N.T_Name);
begin
if not Name_Set.Exists (Name) then
Name_Set.Add (Name);
Generate_Record (Name & "_Type", N);
end if;
end;
end case;
N := N.Next;
end loop;
end Output_Types;
-----------------
-- Set_Routine --
-----------------
function Set_Routine (P : in WSDL.Parameters.P_Set) return String is
begin
case P.Mode is
when WSDL.Parameters.K_Simple =>
return WSDL.Set_Routine (P.P_Type, Context => WSDL.Component);
when WSDL.Parameters.K_Derived =>
return WSDL.Set_Routine
(P.Parent_Type, Context => WSDL.Component);
when WSDL.Parameters.K_Enumeration =>
return WSDL.Set_Routine
(WSDL.P_String, Context => WSDL.Component);
when WSDL.Parameters.K_Array =>
declare
T_Name : constant String
:= Array_Type (To_String (P.E_Type));
begin
if WSDL.Is_Standard (T_Name) then
return WSDL.Set_Routine
(WSDL.To_Type (T_Name), Context => WSDL.Component);
else
return "To_SOAP_Object";
end if;
end;
when WSDL.Parameters.K_Record =>
return "To_SOAP_Object";
end case;
end Set_Routine;
--------------
-- Set_Type --
--------------
function Set_Type (Name : in String) return String is
begin
if WSDL.Is_Standard (Name) then
return WSDL.Set_Type (WSDL.To_Type (Name));
else
return "SOAP.Types.SOAP_Record";
end if;
end Set_Type;
---------------
-- Type_Name --
---------------
function Type_Name (N : in WSDL.Parameters.P_Set) return String is
use type WSDL.Parameter_Type;
begin
case N.Mode is
when WSDL.Parameters.K_Simple =>
-- This routine is called only for SOAP object in records
-- or arrays.
return WSDL.To_Ada (N.P_Type, Context => WSDL.Component);
when WSDL.Parameters.K_Derived =>
return To_String (N.D_Name) & "_Type";
when WSDL.Parameters.K_Enumeration =>
return To_String (N.E_Name) & "_Type";
when WSDL.Parameters.K_Array =>
return To_String (N.T_Name) & "_Type_Safe_Access";
when WSDL.Parameters.K_Record =>
return To_String (N.T_Name) & "_Type";
end case;
end Type_Name;
L_Proc : constant String := Format_Name (O, Proc);
begin
Output_Types (Input);
Output_Types (Output);
if Output /= null then
-- Output mode and more than one parameter
if Output.Next = null then
case Output.Mode is
when WSDL.Parameters.K_Simple =>
null;
when WSDL.Parameters.K_Derived =>
-- A single declaration, this is a derived type create a
-- subtype.
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads,
" subtype " & L_Proc & "_Result is "
& To_String (Output.D_Name) & "_Type;");
when WSDL.Parameters.K_Enumeration =>
-- A single declaration, this is an enumeration type create
-- a subtype.
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads,
" subtype " & L_Proc & "_Result is "
& To_String (Output.E_Name) & "_Type;");
when WSDL.Parameters.K_Record | WSDL.Parameters.K_Array =>
-- A single declaration, this is a composite type create
-- a subtype.
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line
(Type_Ads,
" subtype " & L_Proc & "_Result is "
& To_String (Output.T_Name) & "_Type;");
end case;
else
Generate_Record (L_Proc & "_Result", Output, Output => True);
end if;
end if;
end Put_Types;
-----------
-- Quiet --
-----------
procedure Quiet (O : in out Object) is
begin
O.Quiet := True;
end Quiet;
-----------------
-- Result_Type --
-----------------
function Result_Type
(O : in Object;
Proc : in String;
Output : in WSDL.Parameters.P_Set)
return String
is
use type WSDL.Parameters.Kind;
L_Proc : constant String := Format_Name (O, Proc);
begin
if WSDL.Parameters.Length (Output) = 1
and then Output.Mode = WSDL.Parameters.K_Simple
then
return WSDL.To_Ada (Output.P_Type);
else
return L_Proc & "_Result";
end if;
end Result_Type;
---------------
-- Set_Proxy --
---------------
procedure Set_Proxy
(O : in out Object; Proxy, User, Password : in String) is
begin
O.Proxy := To_Unbounded_String (Proxy);
O.P_User := To_Unbounded_String (User);
O.P_Pwd := To_Unbounded_String (Password);
end Set_Proxy;
----------
-- Skel --
----------
package body Skel is separate;
-------------------
-- Start_Service --
-------------------
procedure Start_Service
(O : in out Object;
Name : in String;
Documentation : in String;
Location : in String)
is
U_Name : constant String := To_Unit_Name (Format_Name (O, Name));
procedure Create (File : in out Text_IO.File_Type; Filename : in String);
-- Create Filename, raise execption Generator_Error if the file already
-- exists and overwrite mode not activated.
procedure Generate_Main (Filename : in String);
-- Generate the main server's procedure. Either the file exists and is
-- a template use it to generate the main otherwise just generate a
-- standard main procedure.
------------
-- Create --
------------
procedure Create
(File : in out Text_IO.File_Type;
Filename : in String) is
begin
if AWS.OS_Lib.Is_Regular_File (Filename) and then not O.Force then
Raise_Exception
(Generator_Error'Identity,
"File " & Filename & " exists, activate overwrite mode.");
else
Text_IO.Create (File, Text_IO.Out_File, Filename);
end if;
end Create;
-------------------
-- Generate_Main --
-------------------
procedure Generate_Main (Filename : in String) is
use Text_IO;
use AWS;
L_Filename : constant String
:= Characters.Handling.To_Lower (Filename);
Template_Filename : constant String := L_Filename & ".amt";
File : Text_IO.File_Type;
begin
Create (File, L_Filename & ".adb");
Put_File_Header (O, File);
if AWS.OS_Lib.Is_Regular_File (Template_Filename) then
-- Use template file
declare
Translations : Templates.Translate_Table
:= (1 => Templates.Assoc ("SOAP_SERVICE", U_Name),
2 => Templates.Assoc ("SOAP_VERSION", SOAP.Version),
3 => Templates.Assoc ("AWS_VERSION", AWS.Version),
4 => Templates.Assoc ("UNIT_NAME",
To_Unit_Name (Filename)));
begin
Put (File,
Templates.Parse (Template_Filename, Translations));
end;
else
-- Generate a minimal main for the server
Put_Line (File, "with AWS.Config.Set;");
Put_Line (File, "with AWS.Server;");
Put_Line (File, "with AWS.Status;");
Put_Line (File, "with AWS.Response;");
Put_Line (File, "with SOAP.Dispatchers.Callback;");
New_Line (File);
Put_Line (File, "with " & U_Name & ".CB;");
Put_Line (File, "with " & U_Name& ".Server;");
New_Line (File);
Put_Line (File, "procedure " & To_Unit_Name (Filename) & " is");
New_Line (File);
Put_Line (File, " use AWS;");
New_Line (File);
Put_Line (File, " function CB ");
Put_Line (File, " (Request : in Status.Data)");
Put_Line (File, " return Response.Data");
Put_Line (File, " is");
Put_Line (File, " R : Response.Data;");
Put_Line (File, " begin");
Put_Line (File, " return R;");
Put_Line (File, " end CB;");
New_Line (File);
Put_Line (File, " WS : AWS.Server.HTTP;");
Put_Line (File, " Conf : Config.Object;");
Put_Line (File, " Disp : " & U_Name & ".CB.Handler;");
New_Line (File);
Put_Line (File, "begin");
Put_Line (File, " Config.Set.Server_Port");
Put_Line (File, " (Conf, " & U_Name & ".Server.Port);");
Put_Line (File, " Disp := SOAP.Dispatchers.Callback.Create");
Put_Line (File, " (CB'Unrestricted_Access,");
Put_Line (File, " " & U_Name & ".CB.SOAP_CB'Access);");
New_Line (File);
Put_Line (File, " AWS.Server.Start (WS, Disp, Conf);");
New_Line (File);
Put_Line (File, " AWS.Server.Wait (AWS.Server.Forever);");
Put_Line (File, "end " & To_Unit_Name (Filename) & ";");
end if;
Text_IO.Close (File);
end Generate_Main;
LL_Name : constant String
:= Characters.Handling.To_Lower (Format_Name (O, Name));
begin
O.Location := To_Unbounded_String (Location);
if not O.Quiet then
Text_IO.New_Line;
Text_IO.Put_Line ("Service " & Name);
Text_IO.Put_Line (" " & Documentation);
end if;
Create (Root, LL_Name & ".ads");
Create (Type_Ads, LL_Name & "-types.ads");
Create (Type_Adb, LL_Name & "-types.adb");
if O.Gen_Stub then
Create (Stub_Ads, LL_Name & "-client.ads");
Create (Stub_Adb, LL_Name & "-client.adb");
end if;
if O.Gen_Skel then
Create (Skel_Ads, LL_Name & "-server.ads");
Create (Skel_Adb, LL_Name & "-server.adb");
end if;
if O.Gen_CB then
Create (CB_Ads, LL_Name & "-cb.ads");
Create (CB_Adb, LL_Name & "-cb.adb");
Text_IO.Create (Tmp_Adb, Text_IO.Out_File);
end if;
-- Types
Put_File_Header (O, Type_Ads);
Text_IO.Put_Line (Type_Ads, "with Ada.Calendar;");
Text_IO.Put_Line (Type_Ads, "with Ada.Strings.Unbounded;");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, "with SOAP.Types;");
Text_IO.Put_Line (Type_Ads, "with SOAP.Utils;");
Text_IO.New_Line (Type_Ads);
if O.Types_Spec /= Null_Unbounded_String then
Text_IO.Put_Line (Type_Ads, "with " & To_String (O.Types_Spec) & ';');
Text_IO.New_Line (Type_Ads);
end if;
Text_IO.Put_Line
(Type_Ads, "package " & U_Name & ".Types is");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " pragma Warnings (Off, Ada.Calendar);");
Text_IO.Put_Line
(Type_Ads, " pragma Warnings (Off, Ada.Strings.Unbounded);");
Text_IO.Put_Line (Type_Ads, " pragma Warnings (Off, SOAP.Types);");
Text_IO.Put_Line (Type_Ads, " pragma Warnings (Off, SOAP.Utils);");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " pragma Style_Checks (Off);");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " pragma Elaborate_Body;");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " use Ada.Strings.Unbounded;");
Text_IO.New_Line (Type_Ads);
Text_IO.Put_Line (Type_Ads, " function ""+""");
Text_IO.Put_Line (Type_Ads, " (Str : in String)");
Text_IO.Put_Line (Type_Ads, " return Unbounded_String");
Text_IO.Put_Line (Type_Ads, " renames To_Unbounded_String;");
Put_File_Header (O, Type_Adb);
Text_IO.Put_Line
(Type_Adb, "package body " & U_Name & ".Types is");
Text_IO.New_Line (Type_Adb);
Text_IO.Put_Line (Type_Adb, " use SOAP.Types;");
-- Root
Put_File_Header (O, Root);
if Documentation /= "" then
Text_IO.Put_Line (Root, "-- " & Documentation);
Text_IO.New_Line (Root);
end if;
Text_IO.Put_Line (Root, "package " & U_Name & " is");
Text_IO.New_Line (Root);
Text_IO.Put_Line (Root,
" URL : constant String := """ & Location & """;");
if O.WSDL_File /= Null_Unbounded_String then
Text_IO.New_Line (Root);
Text_IO.Put_Line (Root, " pragma Style_Checks (Off);");
declare
File : Text_IO.File_Type;
Buffer : String (1 .. 1_024);
Last : Natural;
begin
Text_IO.Open (File, Text_IO.In_File, To_String (O.WSDL_File));
while not Text_IO.End_Of_File (File) loop
Text_IO.Get_Line (File, Buffer, Last);
Text_IO.Put_Line (Root, "-- " & Buffer (1 .. Last));
end loop;
Text_IO.Close (File);
end;
Text_IO.Put_Line (Root, " pragma Style_Checks (On);");
Text_IO.New_Line (Root);
end if;
O.Unit := To_Unbounded_String (U_Name);
-- Stubs
if O.Gen_Stub then
Put_File_Header (O, Stub_Ads);
Put_File_Header (O, Stub_Adb);
Stub.Start_Service (O, Name, Documentation, Location);
end if;
-- Skeletons
if O.Gen_Skel then
Put_File_Header (O, Skel_Ads);
Put_File_Header (O, Skel_Adb);
Skel.Start_Service (O, Name, Documentation, Location);
end if;
-- Callbacks
if O.Gen_CB then
Put_File_Header (O, CB_Ads);
Put_File_Header (O, CB_Adb);
CB.Start_Service (O, Name, Documentation, Location);
end if;
-- Main
if O.Main /= Null_Unbounded_String then
Generate_Main (To_String (O.Main));
end if;
end Start_Service;
----------
-- Stub --
----------
package body Stub is separate;
----------------
-- Time_Stamp --
----------------
function Time_Stamp return String is
begin
return "-- This file was generated on "
& GNAT.Calendar.Time_IO.Image
(Ada.Calendar.Clock, "%A %d %B %Y at %T");
end Time_Stamp;
------------------
-- To_Unit_Name --
------------------
function To_Unit_Name
(Filename : in String)
return String is
begin
return Strings.Fixed.Translate
(Filename, Strings.Maps.To_Mapping ("-", "."));
end To_Unit_Name;
----------------
-- Types_From --
----------------
procedure Types_From (O : in out Object; Spec : in String) is
begin
O.Types_Spec := To_Unbounded_String (To_Unit_Name (Spec));
end Types_From;
--------------------
-- Version_String --
--------------------
function Version_String return String is
begin
return "-- AWS " & AWS.Version
& " - SOAP " & SOAP.Version;
end Version_String;
---------------
-- WSDL_File --
---------------
procedure WSDL_File (O : in out Object; Filename : in String) is
begin
O.WSDL_File := To_Unbounded_String (Filename);
end WSDL_File;
end SOAP.Generator;