CORBA 编程/服务器

服务器程序需要初始化并启动服务器通信。它还需要实例化元对象并将它们注册到名称服务器。

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

包只被初始化，否则不会被使用。这通常会触发警告，我们在这里将其关闭。

pragma Warnings (Off, PolyORB.Setup.Thread_Per_Request_Server);

初始化包。

 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;

前向声明。您通常不需要它们，但是当完全启用警告时，GNAT 非常严格。

   function Init_Echo (
      Root_POA : in PortableServer.POA.Ref)
   return
      CORBA.Object.Ref;
 
   function Init_Root
   return
      PortableServer.POA.Ref;

设置回显元类。

   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;

创建唯一一个元回显实例

      Meta_Object  :  constant CORBA.Impl.Object_Ptr
                   := new MEcho.Impl.Object;

为元回显实例创建服务

      Meta_Servant :  constant PS.Servant
                   := PS.Servant (Meta_Object);

激活服务。不知道如何处理 ID。

      Meta_Id      :  constant PortableServer.ObjectId
                   := POA.Activate_Object (
                         Self      => Root_POA,
                         P_Servant => Meta_Servant);

将服务类型转换为正确的返回类型。

      Result       :  CORBA.Object.Ref
                   := POA.Servant_To_Reference (
                         Self      => Root_POA,
                         P_Servant => Meta_Servant);
      pragma Unreferenced (Meta_Id);
   begin

IOR 和 corbaloc 输出仅用于诊断。我们使用名称服务器来传播元对象。

      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)) &
         "'");

在名称服务器上注册元对象，以便客户端可以找到该对象。

      Naming.Register (
         Name   => CORBA.To_Standard_String (MEcho.Name_Service_Id),
         Ref    => Result,
         Rebind => True,
         Sep    => '/');
      return Result;
   end Init_Echo;

设置根 POA

   function Init_Root
   return
      PortableServer.POA.Ref
   is
      package CORBALOC renames PolyORB.CORBA_P.CORBALOC;
      package POA      renames PortableServer.POA;

检索根 POA。Resolve_Initial_References 将自动创建对象（如果它尚不存在）。

      Result :  POA.Ref
             := POA.Helper.To_Ref (
                   ORB.Resolve_Initial_References (
                   ORB.To_CORBA_String ("RootPOA")));
   begin

激活根 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;

启动服务器

         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;