asn1ct_gen.erl

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

	    Name = list2name([T,check]),
	    emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
	    %% insert in ets table and do look ahead check
	    Typedef = asn1_db:dbget(M,T),
	    RefType = Typedef#typedef.typespec,
	    InType = asn1ct_gen:get_inner(RefType#type.def),
	    case insert_once(check_functions,{Name,RefType}) of
		true ->
		    lookahead_innertype([T],InType,RefType);
%		    case asn1ct_gen:type(InType) of
%			{constructed,bif} ->
%			    lookahead_innertype([T],InType,RefType);
%			#'Externaltypereference'{type=TNew} ->
%			    lookahead_innertype([TNew],InType,RefType);
%			_ ->
%			    ok
%		    end;
		_ ->
		    ok
	    end;
	{constructed,bif} ->
	    NameList = [Cname|TopType],
	    Name = list2name(NameList ++ [check]),
	    emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
	    ets:insert(check_functions,{Name,Type}),
	    %% Must look for check functions in InnerType,
	    %% that may be referenced  or internal defined 
	    %% constructed types not used elsewhere.
	    lookahead_innertype(NameList,InnerType,Type)
    end.

gen_prim_check_call(PrimType,DefaultValue,Element,Type) ->
    case unify_if_string(PrimType) of
	'BOOLEAN' ->
	    emit({"asn1rt_check:check_bool(",DefaultValue,", ",
		  Element,")"});
	'INTEGER' ->
	    NNL =
		case Type#type.def of
		    {_,NamedNumberList} -> NamedNumberList;
		    _ -> []
		end,
	    emit({"asn1rt_check:check_int(",DefaultValue,", ",
		  Element,", ",{asis,NNL},")"});
	'BIT STRING' ->
	    {_,NBL} = Type#type.def,
	    emit({"asn1rt_check:check_bitstring(",DefaultValue,", ",
		  Element,", ",{asis,NBL},")"});
	'OCTET STRING' ->
	    emit({"asn1rt_check:check_octetstring(",DefaultValue,", ",
		  Element,")"});
	'NULL' ->
	    emit({"asn1rt_check:check_null(",DefaultValue,", ",
		  Element,")"});
	'OBJECT IDENTIFIER' ->
	    emit({"asn1rt_check:check_objectidentifier(",DefaultValue,
		  ", ",Element,")"});
	'ObjectDescriptor' ->
	    emit({"asn1rt_check:check_objectdescriptor(",DefaultValue,
		  ", ",Element,")"});
	'REAL' ->
	    emit({"asn1rt_check:check_real(",DefaultValue,
		  ", ",Element,")"});
	'ENUMERATED' ->
	    {_,Enumerations} = Type#type.def,
	    emit({"asn1rt_check:check_enum(",DefaultValue,
		  ", ",Element,", ",{asis,Enumerations},")"});
	restrictedstring ->
	    emit({"asn1rt_check:check_restrictedstring(",DefaultValue,
		  ", ",Element,")"})
    end.

%% lokahead_innertype/3 traverses Type and checks if check functions
%% have to be generated, i.e. for all constructed or referenced types.
lookahead_innertype(Name,'SEQUENCE',Type) ->
    Components = (Type#type.def)#'SEQUENCE'.components,
    lookahead_components(Name,Components);
lookahead_innertype(Name,'SET',Type) ->
    Components = (Type#type.def)#'SET'.components,
    lookahead_components(Name,Components);
lookahead_innertype(Name,'CHOICE',Type) ->
    {_,Components} = Type#type.def,
    lookahead_components(Name,Components);
lookahead_innertype(Name,'SEQUENCE OF',SeqOf) ->
    lookahead_sof(Name,'SEQOF',SeqOf);
lookahead_innertype(Name,'SET OF',SeqOf) ->
    lookahead_sof(Name,'SETOF',SeqOf);
lookahead_innertype(_Name,#'Externaltypereference'{module=M,type=T},_) ->
    Typedef = asn1_db:dbget(M,T),
    RefType = Typedef#typedef.typespec,
    InType = asn1ct_gen:get_inner(RefType#type.def),
    case type(InType) of
	{constructed,bif} ->
	    NewName = list2name([T,check]),
	    case insert_once(check_functions,{NewName,RefType}) of
		true ->
		    lookahead_innertype([T],InType,RefType);
		_ ->
		    ok
	    end;
	#'Externaltypereference'{} ->
	    NewName = list2name([T,check]),
	    case insert_once(check_functions,{NewName,RefType}) of
		true ->
		    lookahead_innertype([T],InType,RefType);
		_ ->
		    ok
	    end;
	_ ->
	    ok
    end;
%    case insert_once(check_functions,{list2name(Name++[check]),Type}) of
%	true ->
%	    InnerType = asn1ct_gen:get_inner(Type#type.def),
%	    case asn1ct_gen:type(InnerType) of
%		{constructed,bif} ->
%		    lookahead_innertype([T],InnerType,Type);
%		#'Externaltypereference'{type=TNew} ->
%		    lookahead_innertype([TNew],InnerType,Type);
%		_ ->
%		    ok
%	    end;
%	_ ->
%	    ok
%    end;
lookahead_innertype(_,_,_) ->
    ok.

lookahead_components(_,[]) -> ok;
lookahead_components(Name,[C|Cs]) ->
    #'ComponentType'{name=Cname,typespec=Type} = C,
    InType = asn1ct_gen:get_inner(Type#type.def),
    case asn1ct_gen:type(InType) of
	{constructed,bif} ->
	    case insert_once(check_functions,
			     {list2name([Cname|Name] ++ [check]),Type}) of
		true ->
		    lookahead_innertype([Cname|Name],InType,Type);
		_ ->
		    ok
	    end;
	#'Externaltypereference'{module=RefMod,type=RefName} ->
	    Typedef = asn1_db:dbget(RefMod,RefName),
	    RefType = Typedef#typedef.typespec,
	    case insert_once(check_functions,{list2name([RefName,check]),
					      RefType}) of
		true ->
		    lookahead_innertype([RefName],InType,RefType);
		_ ->
		    ok
	    end;
	_ ->
	    ok
    end,
    lookahead_components(Name,Cs).

lookahead_sof(Name,SOF,SOFType) ->
    Type = case SOFType#type.def of
	       {_,_Type} -> _Type;
	       _Type -> _Type
	   end,
    InnerType = asn1ct_gen:get_inner(Type#type.def),
    case asn1ct_gen:type(InnerType) of
	{constructed,bif} ->
	    %% this is if a constructed type is defined in
	    %% the SEQUENCE OF type
	    NameList = [SOF|Name],
	    insert_once(check_functions,
			{list2name(NameList ++ [check]),Type}),
	    lookahead_innertype(NameList,InnerType,Type);
	#'Externaltypereference'{module=M,type=T} ->
	    Typedef = asn1_db:dbget(M,T),
	    RefType = Typedef#typedef.typespec,
	    InType = get_inner(RefType#type.def),
	    case insert_once(check_functions,
			     {list2name([T,check]),RefType}) of
		true ->
		    lookahead_innertype([T],InType,RefType);
		_ ->
		    ok
	    end;
	_ ->
	    ok
    end.


insert_once(Table,Object) ->
    case ets:lookup(Table,element(1,Object)) of
	[] ->
	    ets:insert(Table,Object); %returns true
	_ -> false
    end.

unify_if_string(PrimType) ->
    case PrimType of
	'NumericString' ->
	    restrictedstring;
	'PrintableString' ->
	    restrictedstring;
	'TeletexString' ->
	    restrictedstring;
	'VideotexString' ->
	    restrictedstring;
	'IA5String' ->
	    restrictedstring;
	'UTCTime' ->
	    restrictedstring;
	'GeneralizedTime' ->
	    restrictedstring;
	'GraphicString' ->
	    restrictedstring;
	'VisibleString' ->
	    restrictedstring;
	'GeneralString' ->
	    restrictedstring;
	'UniversalString' ->
	    restrictedstring;
	'BMPString' ->
	    restrictedstring;
	'UTF8String' ->
	    restrictedstring;
	Other -> Other
    end.


	
	

get_inner(A) when atom(A) -> A;    
get_inner(Ext) when record(Ext,'Externaltypereference') -> Ext;    
get_inner(Tref) when record(Tref,typereference) -> Tref;
get_inner({fixedtypevaluefield,_,Type}) ->
    if 
	record(Type,type) ->
	    get_inner(Type#type.def);
	true ->
	    get_inner(Type)
    end;
get_inner({typefield,TypeName}) ->
    TypeName;
get_inner(#'ObjectClassFieldType'{type=Type}) ->
%    get_inner(Type);
    Type;
get_inner(T) when tuple(T) -> 
    case element(1,T) of
	Tuple when tuple(Tuple),element(1,Tuple) == objectclass ->
	    case catch(lists:last(element(2,T))) of
		{valuefieldreference,FieldName} ->
		    get_fieldtype(element(2,Tuple),FieldName);
		{typefieldreference,FieldName} ->
		    get_fieldtype(element(2,Tuple),FieldName);
		{'EXIT',Reason} ->
		    throw({asn1,{'internal error in get_inner/1',Reason}})
	    end;
	_ -> element(1,T)
    end.





type(X) when record(X,'Externaltypereference') ->
    X;
type(X) when record(X,typereference) ->
    X;
type('ASN1_OPEN_TYPE') ->
    'ASN1_OPEN_TYPE';
type({fixedtypevaluefield,_Name,Type}) when record(Type,type) ->
    type(get_inner(Type#type.def));
type({typefield,_}) ->
    'ASN1_OPEN_TYPE';
type(X) ->
    %%    io:format("asn1_types:type(~p)~n",[X]),
    case catch type2(X) of
	{'EXIT',_} ->
	    {notype,X};
	Normal ->
	    Normal
    end.

type2(X) ->
    case prim_bif(X) of
	true ->
	    {primitive,bif};
	false ->
	    case construct_bif(X) of
		true ->
		    {constructed,bif};
		false ->
		    {undefined,user}
	    end
    end.

prim_bif(X) ->
    lists:member(X,['INTEGER' ,
		    'ENUMERATED',
		    'OBJECT IDENTIFIER',
		    'ANY',
		    'NULL',
		    'BIT STRING' ,
		    'OCTET STRING' ,
		    'ObjectDescriptor',
		    'NumericString',
		    'TeletexString',
		    'VideotexString',
		    'UTCTime',
		    'GeneralizedTime',
		    'GraphicString',
		    'VisibleString',
		    'GeneralString',
		    'PrintableString',
		    'IA5String',
		    'UniversalString',
		    'UTF8String',
		    'BMPString',
		    'ENUMERATED',
		    'BOOLEAN']).

construct_bif(T) ->
    lists:member(T,['SEQUENCE' ,
		    'SEQUENCE OF' ,
		    'CHOICE' ,
		    'SET' ,
		    'SET OF']).

def_to_tag(#tag{class=Class,number=Number}) ->
    {Class,Number};
def_to_tag(#'ObjectClassFieldType'{type=Type}) -> 
   case Type of
       T when tuple(T),element(1,T)==fixedtypevaluefield ->
	   {'UNIVERSAL',get_inner(Type)};
       _ ->
	   []
   end;
def_to_tag(Def) ->
    {'UNIVERSAL',get_inner(Def)}.
    

%% Information Object Class

type_from_object(X) ->
    case (catch lists:last(element(2,X))) of
	{'EXIT',_} ->
	    {notype,X};
	Normal ->
	    Normal
    end.


get_fieldtype([],_FieldName)->
    {no_type,no_name};
get_fieldtype([Field|Rest],FieldName) ->
    case element(2,Field) of
	FieldName ->
	    case element(1,Field) of
		fixedtypevaluefield ->
		    {element(1,Field),FieldName,element(3,Field)};
		_ ->
		    {element(1,Field),FieldName}
	    end;
	_  ->
	    get_fieldtype(Rest,FieldName)
    end.

get_fieldcategory([],_FieldName) ->
    no_cat;
get_fieldcategory([Field|Rest],FieldName) ->
    case element(2,Field) of
	FieldName ->
	    element(1,Field);
	_ ->
	    get_fieldcategory(Rest,FieldName)
    end.

get_typefromobject(Type) when record(Type,type) ->
    case Type#type.def of
	{{objectclass,_,_},TypeFrObj} when list(TypeFrObj) ->
	    {_,FieldName} = lists:last(TypeFrObj),
	    FieldName;
	_ ->
	    {no_field}
    end.

get_classfieldcategory(Type,FieldName) ->
    case (catch Type#type.def) of
	{{obejctclass,Fields,_},_} ->
	    get_fieldcategory(Fields,FieldName);
	{'EXIT',_} ->
	    no_cat;
	_ ->
	    no_cat
    end.
%% Information Object Class

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Convert a list of name parts to something that can be output by emit
%% 
%% used to output function names in generated code.

list2name(L) ->
    NewL = list2name1(L),
    lists:concat(lists:reverse(NewL)).

list2name1([{ptype,H1},H2|T]) ->
    [H1,"_",list2name([H2|T])];
list2name1([H1,H2|T]) ->
    [H1,"_",list2name([H2|T])];
list2name1([{ptype,H}|_T]) ->
    [H];
list2name1([H|_T]) ->
    [H];
list2name1([]) ->
    [].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Convert a list of name parts to something that can be output by emit
%% stops at {ptype,Pname} i.e Pname whill be the first part of the name
%% used to output record names in generated code.

list2rname(L) ->
    NewL = list2rname1(L),
    lists:concat(lists:reverse(NewL)).

list2rname1([{ptype,H1},_H2|_T]) ->
    [H1];
list2rname1([H1,H2|T]) ->
    [H1,"_",list2name([H2|T])];
list2rname1([{ptype,H}|_T]) ->
    [H];
list2rname1([H|_T]) ->
    [H];
list2rname1([]) ->
    [].



constructed_suffix(_,#'SEQUENCE'{pname=Ptypename}) when Ptypename =/= false ->
    {ptype, Ptypename};
constructed_suffix(_,#'SET'{pname=Ptypename}) when Ptypename =/= false ->
    {ptype,Ptypename};
constructed_suffix('SEQUENCE OF',_) -> 
    'SEQOF';
constructed_suffix('SET OF',_) -> 
    'SETOF'.

erule(ber) ->
    ber;
erule(ber_bin) ->
    ber;
erule(ber_bin_v2) ->
    ber_bin_v2;
erule(per) ->
    per;
erule(per_bin) ->
    per.

wrap_ber(ber) ->
    ber_bin;
wrap_ber(Erule) ->
    Erule.

rt2ct_suffix() ->
    Options = get(encoding_options),
    case {lists:member(optimize,Options),lists:member(per_bin,Options)} of
	{true,true} -> "_rt2ct";
	_ -> ""
    end.
rt2ct_suffix(per_bin) ->
    Options = get(encoding_options),
    case lists:member(optimize,Options) of
	true -> "_rt2ct";
	_ -> ""
    end;
rt2ct_suffix(_) -> "".

index2suffix(0) ->
    "";
index2suffix(N) ->
    lists:concat(["_",N]).

get_constraint(C,Key) ->
    case lists:keysearch(Key,1,C) of
	false ->
	     no;
	{value,{_,V}} -> 
	    V;
	{value,Cnstr} ->
	    Cnstr
    end.