CORBA Programming/Server
The server procedure needs to initialize and start the server communication. It also needs to instantiate the meta objects and register them with the name server.
-- <A HREF="http://www.adaic.org/standards/95lrm/html/RM-11-4-1.html">11.4.1 The Package Exceptions</A> with Ada.Exceptions; with CORBA.Impl; with CORBA.Object; with CORBA.ORB; with PortableServer.POA.Helper; with PortableServer.POAManager; with PolyORB.Log; with PolyORB.Setup.Thread_Per_Request_Server; with PolyORB.CORBA_P.CORBALOC; with PolyORB.CORBA_P.Naming_Tools; with Test.Meta_Echo.Impl; packages are only initialized but are not used otherwise. This would normally trigger a warning, which we switch off here.
pragma Warnings (Off, PolyORB.Setup.Thread_Per_Request_Server);
initialize packages.
pragma Elaborate_All (PolyORB.Setup.Thread_Per_Request_Server); pragma Elaborate_All (Test.Meta_Echo); procedure Server is package ORB renames CORBA.ORB; package MEcho renames Test.Meta_Echo; Initialize logging from configuration file. package Log is new PolyORB.Log.Facility_Log ("server"); Log Message when Level is at least equal to the user-requested level for Facility — which is ''notice'' for the server. procedure Put_Line ( Message : in Standard.String; Level : in PolyORB.Log.Log_Level := PolyORB.Log.Notice) renames Log.Output; Forward declarations. You don't normally need them but GNAT is rather strict when full warnings are activated.
function Init_Echo ( Root_POA : in PortableServer.POA.Ref) return CORBA.Object.Ref; function Init_Root return PortableServer.POA.Ref; Set up echo meta class.
function Init_Echo ( Root_POA : in PortableServer.POA.Ref) return CORBA.Object.Ref is package CORBALOC renames PolyORB.CORBA_P.CORBALOC; package Naming renames PolyORB.CORBA_P.Naming_Tools; package PS renames PortableServer; package POA renames PortableServer.POA; create the one and only meta echo instance
Meta_Object : constant CORBA.Impl.Object_Ptr := new MEcho.Impl.Object; create a servant for the meta echo instance
Meta_Servant : constant PS.Servant := PS.Servant (Meta_Object); activate the servant. Don't know what to do with the Id.
Meta_Id : constant PortableServer.ObjectId := POA.Activate_Object ( Self => Root_POA, P_Servant => Meta_Servant); Convert the servant type to the correct return type.
Result : CORBA.Object.Ref := POA.Servant_To_Reference ( Self => Root_POA, P_Servant => Meta_Servant); pragma Unreferenced (Meta_Id); begin The IOR and corbaloc outputs are only for diagnostics. We use a name server to propagate the meta object.
Put_Line ( "Meta_Echo = '" & CORBA.To_Standard_String (CORBA.Object.Object_To_String (Result)) & "'"); Put_Line ( "Meta_Echo = '" & CORBA.To_Standard_String (CORBALOC.Object_To_Corbaloc (Result)) & "'"); Register the meta object with the name server so the client can find the object.
Naming.Register ( Name => CORBA.To_Standard_String (MEcho.Name_Service_Id), Ref => Result, Rebind => True, Sep => '/'); return Result; end Init_Echo; Set up root POA
function Init_Root return PortableServer.POA.Ref is package CORBALOC renames PolyORB.CORBA_P.CORBALOC; package POA renames PortableServer.POA; Retrieve Root POA. Resolve_Initial_References will automatically create an object if it does not exist already.
Result : POA.Ref := POA.Helper.To_Ref ( ORB.Resolve_Initial_References ( ORB.To_CORBA_String ("RootPOA"))); begin Activate the root POA.
PortableServer.POAManager.Activate ( PortableServer.POA.Get_The_POAManager (Result)); return Result; end Init_Root; begin Try : declare ORB_Id : ORB.ORBid := ORB.To_CORBA_String ("ORB"); Argument_List : ORB.Arg_List := ORB.Command_Line_Arguments; begin ORB.Init ( ORB_Indentifier => ORB_Id, Argv => Argument_List); Run_ORB : declare Root_POA : PortableServer.POA.Ref := Init_Root; Meta_Echo : CORBA.Object.Ref := Init_Echo (Root_POA); Services : ORB.ObjectIdList := ORB.List_Initial_Services; pragma Unreferenced (Meta_Echo); begin List_Services : for Index in Positive'First .. ORB.Length (Services) loop Put_Line ( "Service " & Positive'Image (Index) & " = '" & CORBA.To_Standard_String ( CORBA.String (ORB.Get_Element (Services, Index))) & "'"); end loop List_Services; Launch the server
CORBA.ORB.Run; end Run_ORB; end Try; exception when An_Exception : CORBA.Transient => declare Member : CORBA.System_Exception_Members; begin CORBA.Get_Members ( From => An_Exception, To => Member); Put_Line ( Ada.Exceptions.Exception_Information (An_Exception), PolyORB.Log.Error); Put_Line ( "received exception transient, minor" & CORBA.Unsigned_Long'Image (Member.Minor) & ", completion status: " & CORBA.Completion_Status'Image (Member.Completed), PolyORB.Log.Error); end; when An_Exception : others => Put_Line ( Ada.Exceptions.Exception_Information (An_Exception), PolyORB.Log.Error); end Server;