CORBA Programming/Server

From Wikibooks, open books for an open world
Jump to navigation Jump to search

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