mirror of
https://github.com/AdaCore/PolyORB.git
synced 2026-02-12 13:01:15 -08:00
Implementation of the CORBA::Object::get_policy,
get_client_policy, set_policy_overrides, get_policy_overrides, and get_domain_managers operations. Patch submitted by Vadim Godunko, reviewed by Jerome Hugues. [Imported from Perforce change 9172 at 2006-12-01 21:16:18] Subversion-branch: /trunk/polyorb Subversion-revision: 36690
This commit is contained in:
2
MANIFEST
2
MANIFEST
@@ -586,6 +586,8 @@ src/corba/corba-nvlist.adb
|
||||
src/corba/corba-nvlist.ads
|
||||
src/corba/corba-object-helper.adb
|
||||
src/corba/corba-object-helper.ads
|
||||
src/corba/corba-object-policies.adb
|
||||
src/corba/corba-object-policies.ads
|
||||
src/corba/corba-object.adb
|
||||
src/corba/corba-object.ads
|
||||
src/corba/corba-orb.adb
|
||||
|
||||
@@ -15,6 +15,6 @@
|
||||
//PolyORB:NI: in boolean constr_policy
|
||||
//PolyORB:NI: );
|
||||
//PolyORB:NI: };
|
||||
//PolyORB:NI:
|
||||
//PolyORB:NI: typedef sequence <DomainManager> DomainManagersList;
|
||||
|
||||
typedef sequence <DomainManager> DomainManagersList;
|
||||
|
||||
|
||||
@@ -12,6 +12,12 @@
|
||||
|
||||
typedef sequence <Policy> PolicyList;
|
||||
typedef sequence <PolicyType> PolicyTypeSeq;
|
||||
//PolyORB:WACORBA: InvalidPolicies defined in CORBA 3.0.3 specification
|
||||
//but not defined in OMG IDL files
|
||||
exception InvalidPolicies {
|
||||
sequence <unsigned short> indices;
|
||||
};
|
||||
//PolyORB:WACORBA:
|
||||
|
||||
typedef short PolicyErrorCode;
|
||||
exception PolicyError {PolicyErrorCode reason;};
|
||||
|
||||
@@ -44,28 +44,28 @@
|
||||
in Flags req_flag
|
||||
);
|
||||
|
||||
//PolyORB:NI: Policy get_policy (
|
||||
//PolyORB:NI: in PolicyType policy_type
|
||||
//PolyORB:NI: );
|
||||
//PolyORB:NI:
|
||||
//PolyORB:NI: DomainManagersList get_domain_managers ();
|
||||
//PolyORB:NI:
|
||||
//PolyORB:NI: Object set_policy_overrides(
|
||||
//PolyORB:NI: in PolicyList policies,
|
||||
//PolyORB:NI: in SetOverrideType set_add
|
||||
//PolyORB:NI: ) raises(InvalidPolicies);
|
||||
//PolyORB:NI:
|
||||
//PolyORB:NI: Policy get_client_policy(
|
||||
//PolyORB:NI: in PolicyType type
|
||||
//PolyORB:NI: );
|
||||
//PolyORB:NI:
|
||||
//PolyORB:NI: PolicyList get_policy_overrides(
|
||||
//PolyORB:NI: in PolicyTypeSeq types
|
||||
//PolyORB:NI: );
|
||||
//PolyORB:NI:
|
||||
Policy get_policy (
|
||||
in PolicyType policy_type
|
||||
);
|
||||
|
||||
DomainManagersList get_domain_managers ();
|
||||
|
||||
Object set_policy_overrides(
|
||||
in PolicyList policies,
|
||||
in SetOverrideType set_add
|
||||
) raises(InvalidPolicies);
|
||||
|
||||
Policy get_client_policy(
|
||||
in PolicyType type
|
||||
);
|
||||
|
||||
PolicyList get_policy_overrides(
|
||||
in PolicyTypeSeq types
|
||||
);
|
||||
|
||||
//PolyORB:NI: boolean validate_connection(
|
||||
//PolyORB:NI: out PolicyList inconsistent_policies
|
||||
//PolyORB:NI: );
|
||||
//PolyORB:NI:
|
||||
|
||||
//PolyORB:NI: Object get_component ();
|
||||
};
|
||||
|
||||
@@ -17,6 +17,7 @@ ADA_SPECS_WITH_BODY = \
|
||||
corba-impl.ads \
|
||||
corba-nvlist.ads \
|
||||
corba-object-helper.ads \
|
||||
corba-object-policies.ads \
|
||||
corba-object.ads \
|
||||
corba-orb.ads \
|
||||
corba-policy-helper.ads \
|
||||
|
||||
@@ -35,12 +35,20 @@ with PolyORB.Initialization;
|
||||
with PolyORB.Utils.Strings;
|
||||
|
||||
with CORBA.Object.Helper;
|
||||
with PolyORB.Sequences.Unbounded.CORBA_Helper;
|
||||
|
||||
package body CORBA.DomainManager.Helper is
|
||||
|
||||
package IDL_Sequence_CORBA_DomainManager_Helper is
|
||||
new IDL_Sequence_CORBA_DomainManager.CORBA_Helper
|
||||
(Element_To_Any => To_Any,
|
||||
Element_From_Any => From_Any);
|
||||
|
||||
procedure Deferred_Initialization;
|
||||
|
||||
TC_DomainManager_Cache : TypeCode.Object;
|
||||
TC_DomainManager_Cache : TypeCode.Object;
|
||||
TC_IDL_Sequence_CORBA_DomainManager_Cache : TypeCode.Object;
|
||||
TC_DomainManagersList_Cache : TypeCode.Object;
|
||||
|
||||
-----------------------------
|
||||
-- Deferred_Initialization --
|
||||
@@ -54,12 +62,39 @@ package body CORBA.DomainManager.Helper is
|
||||
(TC_DomainManager_Cache, To_Any (To_CORBA_String ("DomainManager")));
|
||||
TypeCode.Internals.Add_Parameter
|
||||
(TC_DomainManager_Cache, To_Any (To_CORBA_String (Repository_Id)));
|
||||
|
||||
IDL_Sequence_CORBA_DomainManager_Helper.Initialize (TC_DomainManager);
|
||||
TC_IDL_Sequence_CORBA_DomainManager_Cache :=
|
||||
IDL_Sequence_CORBA_DomainManager_Helper.Sequence_TC;
|
||||
|
||||
TC_DomainManagersList_Cache :=
|
||||
TypeCode.Internals.To_CORBA_Object (PolyORB.Any.TypeCode.TC_Alias);
|
||||
TypeCode.Internals.Add_Parameter
|
||||
(TC_DomainManagersList_Cache,
|
||||
To_Any (To_CORBA_String ("DomainManagersList")));
|
||||
TypeCode.Internals.Add_Parameter
|
||||
(TC_DomainManagersList_Cache,
|
||||
To_Any (To_CORBA_String ("IDL:CORBA_A/DomainManagersList:1.0")));
|
||||
TypeCode.Internals.Add_Parameter
|
||||
(TC_DomainManagersList_Cache,
|
||||
To_Any (TC_IDL_Sequence_CORBA_DomainManager));
|
||||
end Deferred_Initialization;
|
||||
|
||||
--------------
|
||||
-- From_Any --
|
||||
--------------
|
||||
|
||||
function From_Any (Item : in Any)
|
||||
return IDL_Sequence_CORBA_DomainManager.Sequence
|
||||
renames IDL_Sequence_CORBA_DomainManager_Helper.From_Any;
|
||||
|
||||
function From_Any (Item : in Any) return DomainManagersList is
|
||||
Result : constant IDL_Sequence_CORBA_DomainManager.Sequence
|
||||
:= From_Any (Item);
|
||||
begin
|
||||
return DomainManagersList (Result);
|
||||
end From_Any;
|
||||
|
||||
function From_Any (Item : in Any) return Ref is
|
||||
begin
|
||||
return To_Ref (Object.Helper.From_Any (Item));
|
||||
@@ -74,10 +109,40 @@ package body CORBA.DomainManager.Helper is
|
||||
return TC_DomainManager_Cache;
|
||||
end TC_DomainManager;
|
||||
|
||||
---------------------------
|
||||
-- TC_DomainManagersList --
|
||||
---------------------------
|
||||
|
||||
function TC_DomainManagersList return TypeCode.Object is
|
||||
begin
|
||||
return TC_DomainManagersList_Cache;
|
||||
end TC_DomainManagersList;
|
||||
|
||||
-----------------------------------------
|
||||
-- TC_IDL_Sequence_CORBA_DomainManager --
|
||||
-----------------------------------------
|
||||
|
||||
function TC_IDL_Sequence_CORBA_DomainManager return TypeCode.Object is
|
||||
begin
|
||||
return TC_IDL_Sequence_CORBA_DomainManager_Cache;
|
||||
end TC_IDL_Sequence_CORBA_DomainManager;
|
||||
|
||||
------------
|
||||
-- To_Any --
|
||||
------------
|
||||
|
||||
function To_Any (Item : in IDL_Sequence_CORBA_DomainManager.Sequence)
|
||||
return Any
|
||||
renames IDL_Sequence_CORBA_DomainManager_Helper.To_Any;
|
||||
|
||||
function To_Any (Item : in DomainManagersList) return Any is
|
||||
Result : Any
|
||||
:= To_Any (IDL_Sequence_CORBA_DomainManager.Sequence (Item));
|
||||
begin
|
||||
CORBA.Set_Type (Result, TC_DomainManagersList);
|
||||
return Result;
|
||||
end To_Any;
|
||||
|
||||
function To_Any (Item : in Ref) return Any is
|
||||
Result : Any := Object.Helper.To_Any (Object.Ref (Item));
|
||||
begin
|
||||
|
||||
@@ -50,4 +50,21 @@ package CORBA.DomainManager.Helper is
|
||||
|
||||
function To_Any (Item : in Ref) return Any;
|
||||
|
||||
-- DomainManager sequence
|
||||
|
||||
function TC_IDL_Sequence_CORBA_DomainManager return TypeCode.Object;
|
||||
|
||||
function From_Any (Item : in Any)
|
||||
return IDL_Sequence_CORBA_DomainManager.Sequence;
|
||||
|
||||
function To_Any
|
||||
(Item : in IDL_Sequence_CORBA_DomainManager.Sequence)
|
||||
return Any;
|
||||
|
||||
function TC_DomainManagersList return TypeCode.Object;
|
||||
|
||||
function From_Any (Item : in Any) return DomainManagersList;
|
||||
|
||||
function To_Any (Item : in DomainManagersList) return Any;
|
||||
|
||||
end CORBA.DomainManager.Helper;
|
||||
|
||||
@@ -38,6 +38,7 @@
|
||||
|
||||
with CORBA.Object;
|
||||
with CORBA.Policy;
|
||||
with CORBA.Sequences.Unbounded;
|
||||
|
||||
package CORBA.DomainManager is
|
||||
|
||||
@@ -51,7 +52,16 @@ package CORBA.DomainManager is
|
||||
function Is_A
|
||||
(Self : in Ref;
|
||||
Logical_Type_Id : in Standard.String)
|
||||
return CORBA.Boolean;
|
||||
return CORBA.Boolean;
|
||||
|
||||
-- Implementation note: this Sequence type should be defined in
|
||||
-- package CORBA. Yet, this would create circular dependencies
|
||||
-- between CORBA and CORBA.Sequences.
|
||||
|
||||
package IDL_Sequence_CORBA_DomainManager is
|
||||
new CORBA.Sequences.Unbounded (Ref);
|
||||
|
||||
type DomainManagersList is new IDL_Sequence_CORBA_DomainManager.Sequence;
|
||||
|
||||
private
|
||||
|
||||
|
||||
297
src/corba/corba-object-policies.adb
Normal file
297
src/corba/corba-object-policies.adb
Normal file
@@ -0,0 +1,297 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- POLYORB COMPONENTS --
|
||||
-- --
|
||||
-- C O R B A . O B J E C T . P O L I C I E S --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2005 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- PolyORB is free software; you can redistribute it and/or modify it --
|
||||
-- under terms of the GNU General Public License as published by the Free --
|
||||
-- Software Foundation; either version 2, or (at your option) any later --
|
||||
-- version. PolyORB is distributed in the hope that it will be useful, --
|
||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
||||
-- TABILITY 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 distributed with PolyORB; see file COPYING. If --
|
||||
-- not, write to the Free Software Foundation, 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. --
|
||||
-- --
|
||||
-- PolyORB is maintained by AdaCore --
|
||||
-- (email: sales@adacore.com) --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with PolyORB.Annotations;
|
||||
with PolyORB.Any.NVList;
|
||||
with PolyORB.ORB;
|
||||
with PolyORB.Requests;
|
||||
with PolyORB.Setup;
|
||||
with PolyORB.Tasking.Threads.Annotations;
|
||||
|
||||
with CORBA.DomainManager.Helper;
|
||||
with PolyORB.CORBA_P.Exceptions;
|
||||
with PolyORB.CORBA_P.Interceptors_Hooks;
|
||||
with PolyORB.CORBA_P.Local;
|
||||
with PolyORB.CORBA_P.Policy_Management;
|
||||
|
||||
package body CORBA.Object.Policies is
|
||||
|
||||
use PolyORB.Annotations;
|
||||
use PolyORB.CORBA_P.Policy_Management;
|
||||
|
||||
-----------------------
|
||||
-- Get_Client_Policy --
|
||||
-----------------------
|
||||
|
||||
function Get_Client_Policy
|
||||
(Self : in Ref'Class;
|
||||
The_Type : in PolicyType)
|
||||
return CORBA.Policy.Ref
|
||||
is
|
||||
Npad : Notepad_Access;
|
||||
Note : Policy_Manager_Note;
|
||||
Result : CORBA.Policy.Ref;
|
||||
|
||||
begin
|
||||
if Is_Nil (Self) then
|
||||
Raise_Inv_Objref (CORBA.Default_Sys_Member);
|
||||
end if;
|
||||
|
||||
if PolyORB.CORBA_P.Local.Is_Local (Self) then
|
||||
Raise_No_Implement (No_Implement_Members'(Minor => 3,
|
||||
Completed => Completed_No));
|
||||
end if;
|
||||
|
||||
-- First, checking reference overrides
|
||||
|
||||
Npad :=
|
||||
PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self)));
|
||||
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
|
||||
Result := Note.Overrides (The_Type);
|
||||
|
||||
if not CORBA.Policy.Is_Null (Result) then
|
||||
return Result;
|
||||
end if;
|
||||
|
||||
-- Second, checking thread overrides
|
||||
|
||||
Npad := PolyORB.Tasking.Threads.Annotations.Get_Current_Thread_Notepad;
|
||||
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
|
||||
Result := Note.Overrides (The_Type);
|
||||
|
||||
if not CORBA.Policy.Is_Null (Result) then
|
||||
return Result;
|
||||
end if;
|
||||
|
||||
-- Third, checking ORB overrides
|
||||
|
||||
Npad := PolyORB.ORB.Notepad_Of (PolyORB.Setup.The_ORB);
|
||||
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
|
||||
Result := Note.Overrides (The_Type);
|
||||
|
||||
if not CORBA.Policy.Is_Null (Result) then
|
||||
return Result;
|
||||
end if;
|
||||
|
||||
-- Last, try to find default value
|
||||
|
||||
return Policy_System_Default_Value (The_Type);
|
||||
end Get_Client_Policy;
|
||||
|
||||
-------------------------
|
||||
-- Get_Domain_Managers --
|
||||
-------------------------
|
||||
|
||||
function Get_Domain_Managers
|
||||
(Self : in Ref'Class)
|
||||
return CORBA.DomainManager.DomainManagersList
|
||||
is
|
||||
Operation_Name : constant Standard.String := "get_domain_managers";
|
||||
|
||||
Request : PolyORB.Requests.Request_Access;
|
||||
Arg_List : PolyORB.Any.NVList.Ref;
|
||||
Result : PolyORB.Any.NamedValue;
|
||||
Result_Name : CORBA.String := To_CORBA_String ("Result");
|
||||
|
||||
begin
|
||||
if CORBA.Object.Is_Nil (Self) then
|
||||
CORBA.Raise_Inv_Objref (Default_Sys_Member);
|
||||
end if;
|
||||
|
||||
PolyORB.Any.NVList.Create (Arg_List);
|
||||
|
||||
Result :=
|
||||
(Name => PolyORB.Types.Identifier (Result_Name),
|
||||
Argument => CORBA.Internals.To_PolyORB_Any
|
||||
(Get_Empty_Any
|
||||
(CORBA.DomainManager.Helper.TC_IDL_Sequence_CORBA_DomainManager)),
|
||||
Arg_Modes => 0);
|
||||
|
||||
PolyORB.Requests.Create_Request
|
||||
(Target => Internals.To_PolyORB_Ref (Ref (Self)),
|
||||
Operation => Operation_Name,
|
||||
Arg_List => Arg_List,
|
||||
Result => Result,
|
||||
Req => Request);
|
||||
|
||||
PolyORB.CORBA_P.Interceptors_Hooks.Client_Invoke
|
||||
(Request, PolyORB.Requests.Flags (0));
|
||||
|
||||
if not PolyORB.Any.Is_Empty (Request.Exception_Info) then
|
||||
Result.Argument := Request.Exception_Info;
|
||||
PolyORB.Requests.Destroy_Request (Request);
|
||||
PolyORB.CORBA_P.Exceptions.Raise_From_Any (Result.Argument);
|
||||
end if;
|
||||
|
||||
PolyORB.Requests.Destroy_Request (Request);
|
||||
|
||||
return CORBA.DomainManager.Helper.From_Any
|
||||
(CORBA.Internals.To_CORBA_Any (Result.Argument));
|
||||
end Get_Domain_Managers;
|
||||
|
||||
----------------
|
||||
-- Get_Policy --
|
||||
----------------
|
||||
|
||||
function Get_Policy
|
||||
(Self : in Ref;
|
||||
Policy_Type : in PolicyType)
|
||||
return CORBA.Policy.Ref
|
||||
is
|
||||
Result : CORBA.Policy.Ref;
|
||||
|
||||
begin
|
||||
Result := Get_Client_Policy (Self, Policy_Type);
|
||||
|
||||
if not Policy.Is_Nil (Result) then
|
||||
-- XXX Client policy should be reconcilied with value
|
||||
-- defined in IOR. Not supported for now.
|
||||
|
||||
return Result;
|
||||
end if;
|
||||
|
||||
if not Is_Domain_Policy (Policy_Type) then
|
||||
return Result;
|
||||
end if;
|
||||
|
||||
-- Obtain domain list from Object
|
||||
|
||||
declare
|
||||
use CORBA.DomainManager;
|
||||
|
||||
Managers : constant DomainManagersList := Get_Domain_Managers (Self);
|
||||
begin
|
||||
-- XXX For now we simply find the first domain manager which
|
||||
-- hold information about the requested policy and return
|
||||
-- policy value. This is not conformant with CORBA
|
||||
-- specifications which require to resolve policy
|
||||
-- overlapping conflicts but not define any way to do this
|
||||
-- (CORBA 3.0.3 par. 4.10.1.4 Object Membership of Policy
|
||||
-- Domains).
|
||||
|
||||
for J in 1 .. Length (Managers) loop
|
||||
begin
|
||||
Result :=
|
||||
Get_Domain_Policy (Element_Of (Managers, J), Policy_Type);
|
||||
|
||||
if not Policy.Is_Nil (Result) then
|
||||
return Result;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when CORBA.Inv_Policy =>
|
||||
null;
|
||||
end;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
Raise_Inv_Policy (Default_Sys_Member);
|
||||
end Get_Policy;
|
||||
|
||||
--------------------------
|
||||
-- Get_Policy_Overrides --
|
||||
--------------------------
|
||||
|
||||
function Get_Policy_Overrides
|
||||
(Self : in Ref'Class;
|
||||
Types : in CORBA.Policy.PolicyTypeSeq)
|
||||
return CORBA.Policy.PolicyList
|
||||
is
|
||||
Npad : Notepad_Access;
|
||||
Note : Policy_Manager_Note;
|
||||
|
||||
begin
|
||||
if Is_Nil (Self) then
|
||||
Raise_Inv_Objref (CORBA.Default_Sys_Member);
|
||||
end if;
|
||||
|
||||
if PolyORB.CORBA_P.Local.Is_Local (Self) then
|
||||
Raise_No_Implement (No_Implement_Members'(Minor => 3,
|
||||
Completed => Completed_No));
|
||||
end if;
|
||||
|
||||
Npad :=
|
||||
PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self)));
|
||||
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
|
||||
|
||||
return Get_Policy_Overrides (Note.Overrides, Types);
|
||||
end Get_Policy_Overrides;
|
||||
|
||||
--------------------------
|
||||
-- Set_Policy_Overrides --
|
||||
--------------------------
|
||||
|
||||
procedure Set_Policy_Overrides
|
||||
(Self : in Ref'Class;
|
||||
Policies : in CORBA.Policy.PolicyList;
|
||||
Set_Add : in SetOverrideType)
|
||||
is
|
||||
Npad : Notepad_Access;
|
||||
Note : Policy_Manager_Note;
|
||||
Indexes : CORBA.Short;
|
||||
|
||||
begin
|
||||
if Is_Nil (Self) then
|
||||
Raise_Inv_Objref (CORBA.Default_Sys_Member);
|
||||
end if;
|
||||
|
||||
if PolyORB.CORBA_P.Local.Is_Local (Self) then
|
||||
Raise_No_Implement (No_Implement_Members'(Minor => 3,
|
||||
Completed => Completed_No));
|
||||
end if;
|
||||
|
||||
Npad :=
|
||||
PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self)));
|
||||
|
||||
if Set_Add = ADD_OVERRIDE then
|
||||
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
|
||||
end if;
|
||||
|
||||
Add_Policy_Overrides (Note.Overrides, Policies, Reference_Level);
|
||||
|
||||
Check_Compatibility (Note.Overrides, Indexes);
|
||||
|
||||
if Indexes /= 0 then
|
||||
raise Program_Error;
|
||||
-- XXX should raise the CORBA.InvalidPolicies exception
|
||||
end if;
|
||||
|
||||
Set_Note (Npad.all, Note);
|
||||
end Set_Policy_Overrides;
|
||||
|
||||
-- procedure Validate_Connection
|
||||
-- (Self : in Ref;
|
||||
-- Inconsistent_Policies : out CORBA.Policy.PolicyList;
|
||||
-- Result : out Boolean);
|
||||
|
||||
end CORBA.Object.Policies;
|
||||
73
src/corba/corba-object-policies.ads
Normal file
73
src/corba/corba-object-policies.ads
Normal file
@@ -0,0 +1,73 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- POLYORB COMPONENTS --
|
||||
-- --
|
||||
-- C O R B A . O B J E C T . P O L I C I E S --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2005 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the CORBA Specification, and adapted --
|
||||
-- for use with PolyORB. The copyright notice above, and the license --
|
||||
-- provisions that follow apply solely to the contents neither explicitely --
|
||||
-- nor implicitely specified by the CORBA Specification defined by the OMG. --
|
||||
-- --
|
||||
-- PolyORB is free software; you can redistribute it and/or modify it --
|
||||
-- under terms of the GNU General Public License as published by the Free --
|
||||
-- Software Foundation; either version 2, or (at your option) any later --
|
||||
-- version. PolyORB is distributed in the hope that it will be useful, --
|
||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
||||
-- TABILITY 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 distributed with PolyORB; see file COPYING. If --
|
||||
-- not, write to the Free Software Foundation, 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. --
|
||||
-- --
|
||||
-- PolyORB is maintained by AdaCore --
|
||||
-- (email: sales@adacore.com) --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with CORBA.DomainManager;
|
||||
with CORBA.Policy;
|
||||
|
||||
package CORBA.Object.Policies is
|
||||
|
||||
function Get_Policy
|
||||
(Self : in Ref;
|
||||
Policy_Type : in PolicyType)
|
||||
return CORBA.Policy.Ref;
|
||||
|
||||
function Get_Domain_Managers
|
||||
(Self : in Ref'Class)
|
||||
return CORBA.DomainManager.DomainManagersList;
|
||||
|
||||
procedure Set_Policy_Overrides
|
||||
(Self : in Ref'Class;
|
||||
Policies : in CORBA.Policy.PolicyList;
|
||||
Set_Add : in SetOverrideType);
|
||||
|
||||
function Get_Client_Policy
|
||||
(Self : in Ref'Class;
|
||||
The_Type : in PolicyType)
|
||||
return CORBA.Policy.Ref;
|
||||
|
||||
function Get_Policy_Overrides
|
||||
(Self : in Ref'Class;
|
||||
Types : in CORBA.Policy.PolicyTypeSeq)
|
||||
return CORBA.Policy.PolicyList;
|
||||
|
||||
-- procedure Validate_Connection
|
||||
-- (Self : in Ref;
|
||||
-- Inconsistent_Policies : out CORBA.Policy.PolicyList;
|
||||
-- Result : out Boolean);
|
||||
|
||||
end CORBA.Object.Policies;
|
||||
@@ -38,6 +38,7 @@ package body PolyORB.CORBA_P.Policy_Management is
|
||||
type Policy_Info is record
|
||||
Registered : Boolean := False;
|
||||
POA_Level : Boolean;
|
||||
Domain_Level : Boolean;
|
||||
ORB_Level : Boolean;
|
||||
Thread_Level : Boolean;
|
||||
Reference_Level : Boolean;
|
||||
@@ -97,6 +98,9 @@ package body PolyORB.CORBA_P.Policy_Management is
|
||||
CORBA.Raise_No_Permission (CORBA.Default_Sys_Member);
|
||||
end if;
|
||||
|
||||
when Domain_Level =>
|
||||
raise Program_Error;
|
||||
|
||||
end case;
|
||||
|
||||
To (The_Type) := Element_Of (Policies, J);
|
||||
@@ -179,6 +183,20 @@ package body PolyORB.CORBA_P.Policy_Management is
|
||||
return Result;
|
||||
end Get_Policy_Overrides;
|
||||
|
||||
----------------------
|
||||
-- Is_Domain_Policy --
|
||||
----------------------
|
||||
|
||||
function Is_Domain_Policy
|
||||
(The_Type : in CORBA.PolicyType)
|
||||
return Boolean
|
||||
is
|
||||
begin
|
||||
pragma Assert (Policy_Registry (The_Type).Registered);
|
||||
|
||||
return Policy_Registry (The_Type).Domain_Level;
|
||||
end Is_Domain_Policy;
|
||||
|
||||
-------------------
|
||||
-- Is_ORB_Policy --
|
||||
-------------------
|
||||
@@ -244,6 +262,20 @@ package body PolyORB.CORBA_P.Policy_Management is
|
||||
return Policy_Registry (The_Type).Thread_Level;
|
||||
end Is_Thread_Policy;
|
||||
|
||||
---------------------------------
|
||||
-- Policy_System_Default_Value --
|
||||
---------------------------------
|
||||
|
||||
function Policy_System_Default_Value
|
||||
(The_Type : in CORBA.PolicyType)
|
||||
return CORBA.Policy.Ref
|
||||
is
|
||||
begin
|
||||
pragma Assert (Policy_Registry (The_Type).Registered);
|
||||
|
||||
return Policy_Registry (The_Type).System_Default;
|
||||
end Policy_System_Default_Value;
|
||||
|
||||
-----------------------
|
||||
-- Raise_PolicyError --
|
||||
-----------------------
|
||||
@@ -267,6 +299,7 @@ package body PolyORB.CORBA_P.Policy_Management is
|
||||
ORB_Level : in Boolean := False;
|
||||
Thread_Level : in Boolean := False;
|
||||
Reference_Level : in Boolean := False;
|
||||
Domain_Level : in Boolean := False;
|
||||
Factory : in Policy_Factory := null;
|
||||
Compatibility_Check : in Compatibility_Check_Proc := null;
|
||||
Reconciliation : in Reconciliation_Proc := null;
|
||||
@@ -276,6 +309,7 @@ package body PolyORB.CORBA_P.Policy_Management is
|
||||
Policy_Registry (The_Type) :=
|
||||
(Registered => True,
|
||||
POA_Level => POA_Level,
|
||||
Domain_Level => Domain_Level,
|
||||
ORB_Level => ORB_Level,
|
||||
Thread_Level => Thread_Level,
|
||||
Reference_Level => Reference_Level,
|
||||
|
||||
@@ -50,7 +50,7 @@ package PolyORB.CORBA_P.Policy_Management is
|
||||
Null_Policy : CORBA.Policy.Ref;
|
||||
|
||||
type Policy_Override_Level is
|
||||
(POA_Level, ORB_Level, Thread_Level, Reference_Level);
|
||||
(POA_Level, Domain_Level, ORB_Level, Thread_Level, Reference_Level);
|
||||
-- Level of policy overrides
|
||||
|
||||
type Policy_Factory is
|
||||
@@ -74,6 +74,11 @@ package PolyORB.CORBA_P.Policy_Management is
|
||||
return Boolean;
|
||||
-- Return True iff The_Type is a POA level policy
|
||||
|
||||
function Is_Domain_Policy
|
||||
(The_Type : in CORBA.PolicyType)
|
||||
return Boolean;
|
||||
-- Return True iff The_Type is a Domain level policy
|
||||
|
||||
function Is_ORB_Policy
|
||||
(The_Type : in CORBA.PolicyType)
|
||||
return Boolean;
|
||||
@@ -89,6 +94,11 @@ package PolyORB.CORBA_P.Policy_Management is
|
||||
return Boolean;
|
||||
-- Return True iff The_Type is an object reference policy
|
||||
|
||||
function Policy_System_Default_Value
|
||||
(The_Type : in CORBA.PolicyType)
|
||||
return CORBA.Policy.Ref;
|
||||
-- Return system default value for given policy type
|
||||
|
||||
procedure Add_Policy_Overrides
|
||||
(To : in out Policy_List;
|
||||
Policies : in CORBA.Policy.PolicyList;
|
||||
@@ -137,6 +147,7 @@ package PolyORB.CORBA_P.Policy_Management is
|
||||
ORB_Level : in Boolean := False;
|
||||
Thread_Level : in Boolean := False;
|
||||
Reference_Level : in Boolean := False;
|
||||
Domain_Level : in Boolean := False;
|
||||
Factory : in Policy_Factory := null;
|
||||
Compatibility_Check : in Compatibility_Check_Proc := null;
|
||||
Reconciliation : in Reconciliation_Proc := null;
|
||||
@@ -144,6 +155,7 @@ package PolyORB.CORBA_P.Policy_Management is
|
||||
-- Register CORBA Policy and define allowed policy usage.
|
||||
-- - The_Type : policy id
|
||||
-- - POA_Level : policy is allowed at POA level
|
||||
-- - Domain_Level : policy is allowed at Domain level
|
||||
-- - ORB_Level : policy is allowed at ORB level
|
||||
-- - Thread_Level : policy is allowed at thread level
|
||||
-- - Reference_Level : policy is allowed at object reference level
|
||||
|
||||
Reference in New Issue
Block a user