iop_ior.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,532 行 · 第 1/5 页

	false ->
	    create(Version, Mod:typeID(), orber:host(), orber:iiop_port(),
		   orber:iiop_ssl_port(),
		   {Mod, Type, Key, UserDef, OrberDef, Flags}, 
		   MC, Flags, EnvFlags);
	true ->
	    create(Version, Mod:typeID(), orber:nat_host(), 
		   orber:nat_iiop_port(), orber:nat_iiop_ssl_port(),
		   {Mod, Type, Key, UserDef, OrberDef, Flags}, 
		   MC, Flags, EnvFlags)
    
    end.

add_component_ior(#'IOP_IOR'{profiles=P} = IOR, Component) ->
    case add_component_ior_helper(P, Component, false, []) of
	{false, _} ->
	    orber:dbg("[~p] iop_ior:add_component_ior(~p);~n"
		      "The IOR do not contain a valid IIOP-version for the supplied component.", 
		      [?LINE, Component], ?DEBUG_LEVEL),
	    corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
	{_, NewProfiles} ->
	    IOR#'IOP_IOR'{profiles=NewProfiles}
    end.

add_component_ior_helper([], _Component, Status, Acc) ->
    {Status, Acc};
add_component_ior_helper([#'IOP_TaggedProfile'
			  {tag=?TAG_INTERNET_IOP, 
			   profile_data=#'IIOP_ProfileBody_1_1'
			   {iiop_version= #'IIOP_Version'{minor=1}}}|T], 
			 #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS} 
			 = Component, Status, Acc) ->
    %% 'ALTERNATE_IIOP_ADDRESS' may only be added to IIOP-1.2 IOR's.
    add_component_ior_helper(T, Component, Status, Acc);
add_component_ior_helper([#'IOP_TaggedProfile'
			  {tag=?TAG_INTERNET_IOP, 
			   profile_data=#'IIOP_ProfileBody_1_1'
			   {object_key=Objkey,
			    components=Components} = PB} = H|T], 
			 Component, _Status, Acc) when tuple(Objkey) ->
    %% The objectkey must be a tuple if it's a local object. We cannot(!!) add components
    %% to an external IOR.
    add_component_ior_helper(T, Component, true, 
			     [H#'IOP_TaggedProfile'
			      {profile_data=PB#'IIOP_ProfileBody_1_1'
			       {components = [Component|Components]}}|Acc]);
add_component_ior_helper([_|T], Component, Status, Acc) ->
    add_component_ior_helper(T, Component, Status, Acc).

%%-----------------------------------------------------------------
%% Func: get_alt_addr/1
%%-----------------------------------------------------------------
%% TAG_ALTERNATE_IIOP_ADDRESS may only occur in IIOP-1.2 IOR's.
get_alt_addr(#'IOP_TaggedProfile'
	     {tag=?TAG_INTERNET_IOP, 
	      profile_data=#'IIOP_ProfileBody_1_1'{iiop_version=
						   #'IIOP_Version'{minor=2},
						   components=Components}}) ->
    get_alt_addr_helper(Components, []);
get_alt_addr(_) ->
    [].

get_alt_addr_helper([], Acc) -> Acc;
get_alt_addr_helper([#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS, 
					    component_data=#'ALTERNATE_IIOP_ADDRESS'
					    {'HostID'=Host, 'Port'=Port}}|T], Acc) ->
    get_alt_addr_helper(T, [{Host, Port}|Acc]);
get_alt_addr_helper([_|T], Acc) ->
    get_alt_addr_helper(T, Acc).

%%-----------------------------------------------------------------
%% Func: get_typeID/1
%%-----------------------------------------------------------------
get_typeID(#'IOP_IOR'{type_id=TypeID}) ->
    TypeID;
get_typeID({Mod, _Type, _Key, _UserDef, _OrberDef, _Flags}) ->
    Mod:typeID().

%%-----------------------------------------------------------------
%% Func: get_objkey/1
%%-----------------------------------------------------------------
get_objkey(#'IOP_IOR'{profiles=P}) ->
    get_objkey_1(P);
get_objkey({Id, Type, Key, UserDef, OrberDef, Flags}) ->
    {Id, Type, Key, UserDef, OrberDef, Flags}.

get_objkey_1([]) ->
    orber:dbg("[~p] iop_ior:get_objkey_1([]); bad object key, profile not found.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
get_objkey_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} |_]) ->
    [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
    ObjectKey;
get_objkey_1([_ | P]) ->
    get_objkey_1(P).

%%-----------------------------------------------------------------
%% Func: get_privfield/1
%%-----------------------------------------------------------------
get_privfield(#'IOP_IOR'{profiles=P}) ->
    get_privfield_1(P);
get_privfield({_Id, _Type, _Key, UserDef, _OrberDef, _Flags}) ->
    UserDef.

get_privfield_1([]) ->
    orber:dbg("[~p] iop_ior:get_privfield_1([]); bad object key, profile not found.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
get_privfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
    [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
    case ObjectKey of
	{_Id, _Type, _Key, UserDef, _OrberDef, _Flags} ->
	    UserDef;
	_ ->
	    orber:dbg("[~p] iop_ior:get_privfield_1(~p); bad object key.", 
				    [?LINE, ObjectKey], ?DEBUG_LEVEL),
	    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
    end;
get_privfield_1([_| P]) ->
    get_privfield_1(P).
    
%%-----------------------------------------------------------------
%% Func: set_privfield/2
%%-----------------------------------------------------------------
set_privfield(#'IOP_IOR'{type_id=Id, profiles=P}, UserData) ->
    #'IOP_IOR'{type_id=Id, profiles=set_privfield_1(P, UserData)};
set_privfield({Id, Type, Key, _, OrberDef, Flags}, UserData) ->
	    {Id, Type, Key, UserData, OrberDef, Flags}.

set_privfield_1([], _) ->
    orber:dbg("[~p] iop_ior:set_privfield_1([]); bad object key, profile not found or external object.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
set_privfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|P], UserData) ->
    [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
    case ObjectKey of
	{Id, Type, Key, _, OrberDef, Flags} ->
	    [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
				  profile_data=list_to_tuple([RecName,
							      Version, Host,
							      IIOP_port,
							      {Id, Type, Key, UserData, OrberDef, Flags}|
							      Rest])} |
	     set_privfield_1(P, UserData)];
	_ ->
	    [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_privfield_1(P, UserData)]
    end;
set_privfield_1([PB| P], UserData) ->
    [PB | set_privfield_1(P, UserData)].

%%-----------------------------------------------------------------
%% Func: get_orbfield/1
%%-----------------------------------------------------------------
get_orbfield(#'IOP_IOR'{profiles=P}) ->
    get_orbfield_1(P);
get_orbfield({_Id, _Type, _Key, _UserDef, OrberDef, _Flags}) ->
    OrberDef.

get_orbfield_1([]) ->
    orber:dbg("[~p] iop_ior:get_orbfield_1([]);~n"
	      "bad object key, profile not found.", [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
get_orbfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
    [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
    case ObjectKey of
	{_Id, _Type, _Key, _UserDef, OrberDef, _Flags} ->
	    OrberDef;
	_ ->
	    orber:dbg("[~p] iop_ior:get_orbfield_1(~p);~n"
		      "bad object key.", [?LINE, ObjectKey], ?DEBUG_LEVEL),
	    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
    end;
get_orbfield_1([_| P]) ->
    get_orbfield_1(P).
    
%%-----------------------------------------------------------------
%% Func: set_orbfield/2
%%-----------------------------------------------------------------
set_orbfield(#'IOP_IOR'{type_id=Id, profiles=P}, OrberDef) ->
    #'IOP_IOR'{type_id=Id, profiles=set_orbfield_1(P, OrberDef)};
set_orbfield({Id, Type, Key, Priv, _, Flags}, OrberDef) ->
	    {Id, Type, Key, Priv, OrberDef, Flags}.

set_orbfield_1([], _) ->
    orber:dbg("[~p] iop_ior:set_orbfield_1([]);~n"
	      "bad object key, profile not found or external object.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
set_orbfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}| P], OrberDef) ->
    [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
    case ObjectKey of
	{Id, Type, Key, Priv, _, Flags} ->
	    [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
				  profile_data=list_to_tuple([RecName,
							      Version, Host,
							      IIOP_port,
							      {Id, Type, Key, Priv, OrberDef, Flags}|
							      Rest])} |
	     set_orbfield_1(P, OrberDef)];
	_ ->
	    [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_orbfield_1(P, OrberDef)]
    end;
set_orbfield_1([PB| P], OrberDef) ->
    [PB | set_orbfield_1(P, OrberDef)].

%%-----------------------------------------------------------------
%% Func: get_flagfield/1
%%-----------------------------------------------------------------
get_flagfield(#'IOP_IOR'{profiles=P}) ->
    get_flagfield_1(P);
get_flagfield({_Id, _Type, _Key, _UserDef, _OrberDef, Flags}) ->
    Flags.

get_flagfield_1([]) ->
    orber:dbg("[~p] iop_ior:get_flagfield_1([]); bad object key, profile not found.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
get_flagfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
    [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
    case ObjectKey of
	{_Id, _Type, _Key, _UserDef, _OrberDef, Flags} ->
	    Flags;
	_ ->
	    orber:dbg("[~p] iop_ior:get_flagfield_1(~p); bad object key.", 
		      [?LINE, ObjectKey], ?DEBUG_LEVEL),
	    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
    end;
get_flagfield_1([_| P]) ->
    get_flagfield_1(P).
    
%%-----------------------------------------------------------------
%% Func: set_flagfield/2
%%-----------------------------------------------------------------
set_flagfield(#'IOP_IOR'{type_id=Id, profiles=P}, Flags) ->
    #'IOP_IOR'{type_id=Id, profiles=set_flagfield_1(P, Flags)};
set_flagfield({Id, Type, Key, Priv, OrberDef, _}, Flags) ->
	    {Id, Type, Key, Priv, OrberDef, Flags}.

set_flagfield_1([], _) ->
    orber:dbg("[~p] iop_ior:set_flagfield_1([]); bad object key, profile not found or external object.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
set_flagfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}| P], Flags) ->
    [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
    case ObjectKey of
	{Id, Type, Key, Priv, OrberDef, _} ->
	    [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
				  profile_data=list_to_tuple([RecName,
							      Version, Host,
							      IIOP_port,
							      {Id, Type, Key, Priv, OrberDef, Flags}|
							      Rest])} |
	     set_flagfield_1(P, Flags)];
	_ ->
	    [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_flagfield_1(P, Flags)]
    end;
set_flagfield_1([PB| P], Flags) ->
    [PB | set_flagfield_1(P, Flags)].

%%-----------------------------------------------------------------
%% Func: check_nil/1
%%-----------------------------------------------------------------
check_nil(#'IOP_IOR'{type_id="", profiles=[]}) ->
    true;
check_nil({Id, _, _, _, _, _}) when atom(Id) ->
    false;
check_nil({Id, _, _, _, _, _}) ->  
    case binary_to_list(Id) of
	"" ->
	    true; 
	_ ->
	    false
    end;
check_nil(_) ->
    false.



%%----------------------------------------------------------------------
%% Function   : print
%% Arguments  : An object represented as one of the following:
%%               - local (tuple)
%%               - IOR
%%               - stringified IOR
%%               - corbaloc- or corbaname-schema
%%              IoDevice - the same as the io-module defines.
%% Returns    : 
%% Description: Prints the object's components.
%%----------------------------------------------------------------------
print(Object) ->
    print(undefined, Object).
print(IoDevice, #'IOP_IOR'{type_id="", profiles=[]}) ->
    print_it(IoDevice, 
	     "================== IOR ====================~n"
	     "NIL Object Reference.~n"
	     "================== END ====================~n");
print(IoDevice, IORStr) when list(IORStr) ->
    IOR = corba:string_to_object(IORStr),
    print_helper(IoDevice, IOR);
print(IoDevice, IOR) when record(IOR, 'IOP_IOR') ->
    print_helper(IoDevice, IOR);
print(IoDevice, {Mod, Type, Key, UserDef, OrberDef, Flags}) ->
    EnvFlags = orber:get_flags(),
    MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
	     true ->
		 [];
	     false ->