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.

File: server.adb (view, plain text, download page, browse all)

 --  <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;