diff options
Diffstat (limited to 'lib/cosNotification/src/cosNotification_Filter.erl')
| -rw-r--r-- | lib/cosNotification/src/cosNotification_Filter.erl | 965 |
1 files changed, 0 insertions, 965 deletions
diff --git a/lib/cosNotification/src/cosNotification_Filter.erl b/lib/cosNotification/src/cosNotification_Filter.erl deleted file mode 100644 index a92c9b8d41..0000000000 --- a/lib/cosNotification/src/cosNotification_Filter.erl +++ /dev/null @@ -1,965 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% -%%---------------------------------------------------------------------- -%% File : cosNotification_Filter.erl -%% Purpose : -%%---------------------------------------------------------------------- - --module(cosNotification_Filter). - - -%%--------------- INCLUDES ----------------------------------- --include_lib("orber/include/corba.hrl"). --include_lib("orber/include/ifr_types.hrl"). -%% Application files --include("CosNotification.hrl"). --include("CosNotifyChannelAdmin.hrl"). --include("CosNotifyComm.hrl"). --include("CosNotifyFilter.hrl"). - --include("CosNotification_Definitions.hrl"). - -%%--------------- EXPORTS ------------------------------------ -%% Internal Filter Functions --export([eval/1, - eval/2, - create_filter/1, - check_types/1, - match_types/3, - validate_types/1]). - -%%--------------- DEFINES ------------------------------------ --define(EVENT_PATH, [{dotid,"header"}, {dotid,"fixed_header"}, - {dotid,"event_name"}]). --define(DOMAIN_PATH, [{dotid,"header"}, {dotid,"fixed_header"}, - {dotid,"event_type"}, {dotid,"domain_name"}]). --define(TYPE_PATH, [{dotid,"header"}, {dotid,"fixed_header"}, - {dotid,"event_type"}, {dotid,"type_name"}]). --define(VARIABLE_PATH(I), [{dotid,"header"}, {dotid,"variable_header"}, {dotid,I}]). --define(FILTERABLE_PATH(I), [{dotid,"filterable_data"}, {dotid,I}]). - - -%%------------------------------------------------------------ -%%--------------- FILTER FUNCTIONS --------------------------- -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% function : create_filter/1 -%% Arguments: String - Filter grammar -%% Returns : -%% Effect : -%%------------------------------------------------------------ -create_filter(Str) -> - {ok, Tokens} = cosNotification_Scanner:scan(Str), - case cosNotification_Grammar:parse(Tokens) of - {ok, Filter} -> - {ok, Filter}; - _-> - corba:raise(#'CosNotifyFilter_InvalidConstraint'{constr = Str}) - end. - -%%------------------------------------------------------------ -%% function : eval -%% Arguments: -%% Returns : -%% Effect : -%%------------------------------------------------------------ - -eval('$empty') -> true; -eval(Tree) -> eval(Tree, []). - - -%% Leaf expressions (literals and idents). -eval('$empty', _) -> true; -eval(Lit, _Env) when is_number(Lit) -> Lit; -eval(Lit, _Env) when is_list(Lit) -> Lit; %list == string -eval(Lit, _Env) when is_atom(Lit) -> Lit; %atom == bool -eval({component, V}, []) -> - %% Cannot evaluate variables at this stage. - throw({error, {unbound_variable, V}}); -eval({component, V}, Env) -> - case catch lookup(V, Env, undefined) of - {ok, Val} -> - Val; - _X -> - {error, {unbound_variable, V}} - end; - -%% CORBA2.3-15/26 states: -%% "The name parameters in tk_objref, tk_struct, tk_union, tk_enum, tk_alias, -%% tk_value, tk_value_box, tk_abstract_interface, tk_native and tk_except TypeCodes -%% and the member name parameters in tk_struct, tk_union, tk_enum, tk_value and -%% tk_except TypeCodes are not specified by (or significant in) GIOP. Agents should -%% not make assumptions about type equivalence based on these name values; only the -%% structural information (including RepositoryId values, if provided) is -%% significant. If provided, the strings should be the simple, unscoped names -%% supplied in the OMG IDL definition text. If omitted, they are encoded as empty -%% strings." -%% Makes it rather hard to follow the grammar 100 %. -eval({default_component, V}, Env) -> - case catch lookup(V, Env, default_component) of - {ok, false} -> - false; - {ok, true} -> - true; - _X -> - {error, {unbound_variable, V}} - end; -eval({exist_component, V}, Env) -> - case catch lookup(V, Env, exist_component) of - {ok, false} -> - false; - {ok, _} -> - true; - {error, _} -> - false; - _X -> - {error, {unbound_variable, V}} - end; -%% Arithmetic expressions. -eval({'*', X, Y}, Env) -> - eval_arith({fun(_X, _Y) -> _X*_Y end, X, Y}, Env); -eval({'/', X, Y}, Env) -> - eval_arith({fun(_X, _Y) -> _X/_Y end, X, Y}, Env); -eval({'+', X, Y}, Env) -> - eval_arith({fun(_X, _Y) -> _X+_Y end, X, Y}, Env); -eval({'-', X, Y}, Env) -> - eval_arith({fun(_X, _Y) -> _X-_Y end, X, Y}, Env); -eval({'u-', X}, Env) -> - eval_arith({fun(_X) -> -_X end, X}, Env); -%% Relational expressions. -eval({'==', X, Y}, Env) -> - eval_rel({fun(_X, _Y) -> _X == _Y end, X, Y}, Env); -eval({'!=', X, Y}, Env) -> - eval_rel({fun(_X, _Y) -> _X /= _Y end, X, Y}, Env); -eval({'<', X, Y}, Env) -> - eval_rel({fun(_X, _Y) -> _X < _Y end, X, Y}, Env); -eval({'<=', X, Y}, Env) -> - eval_rel({fun(_X, _Y) -> _X =< _Y end, X, Y}, Env); -eval({'>', X, Y}, Env) -> - eval_rel({fun(_X, _Y) -> _X > _Y end, X, Y}, Env); -eval({'>=', X, Y}, Env) -> - eval_rel({fun(_X, _Y) -> _X >= _Y end, X, Y}, Env); -eval({'~', Needle, Haystack}, Env) -> %substring match - N = eval(Needle, Env), - H = eval(Haystack, Env), - if - is_list(N) andalso is_list(H) -> - string:str(H, N) /= 0; - true -> - throw({error, {bad_type, Needle, Haystack}}) - end; -eval({'in', Needle, Haystack}, Env) -> %set membership - N = eval(Needle, Env), - H = eval(Haystack, Env), - if - is_list(H) -> - lists:member(N, H); - true -> - throw({error, {bad_type, Needle, Haystack}}) - end; -%% Boolean expressions. -eval({'and', false, _Y}, _Env) -> - false; -eval({'and', _X, false}, _Env) -> - false; -eval({'and', X, Y}, Env) -> - eval_and_bool({fun(_X, _Y) -> _X and _Y end, X, Y}, Env); - -eval({'or', true, _Y}, _Env) -> - true; -eval({'or', _X, true}, _Env) -> - true; -eval({'or', X, Y}, Env) -> - eval_or_bool({fun(_X, _Y) -> _X or _Y end, X, Y}, Env); -eval({'not', X}, Env) -> - eval_bool({fun(_X) -> not _X end, X}, Env); -%% Catch-all -eval(_T, _Env) -> - throw({error, internal}). - -eval_bool({Fun, X}, Env) -> - Xe = eval(X, Env), - if - is_atom(Xe) -> - Fun(Xe); - true -> - throw({error, {bad_type, X}}) - end. -eval_and_bool({Fun, X, Y}, Env) -> - case eval(X, Env) of - false -> - %% No need for evaluating the other expression. - false; - Xe -> - Ye = eval(Y, Env), - if - is_atom(Xe) andalso is_atom(Ye) -> - Fun(Xe, Ye); - true -> - throw({error, {bad_type, X, Y}}) - end - end. -eval_or_bool({Fun, X, Y}, Env) -> - case eval(X, Env) of - true -> - %% No need for evaluating the other expression. - true; - Xe -> - Ye = eval(Y, Env), - if - is_atom(Xe) andalso is_atom(Ye) -> - Fun(Xe, Ye); - true -> - throw({error, {bad_type, X, Y}}) - end - end. - - -%% According to issue 2203, OMG stated that arithmetic operations involving booleans -%% is allowed. TRUE equals 1 and FALSE 0. They refer to: - -%% "We at NEC like this feature, and feel it is both required and -%% standard with the way CORBA treats boolean values. We feel it's -%% required because it allows the constraint grammar to handle -%% expressions that combine the results of boolean comparisons, -%% which we feel is typically expected of a constraint grammar -%% (e.g., ($.fruit == apples) + ($.color == red) + ($.kind == macintosh) > 2) -%% Furthermore, while we have no fundamental opposition to explicitly -%% stating that TRUE=1 and FALSE=0, we don't necessarily feel it's -%% necessary because section 12.3.1 of CORBA alread states that -%% "Boolean values are encoded as single octets, where TRUE is the -%% value 1, and FALSE is 0." Essentially, we feel CORBA already -%% defines TRUE to be 1 and FALSE to be 0, however we are not -%% opposed to adding such a statement into Notification if folks -%% feel it's necessary." -%% If still valid, see: ftp://ftp.omg.org/pub/docs/telecom/99-07-06.txt - -%% The section they refer to (CORBA-2.0) merely states that TRUE and FALSE are -%% encoded as 1 and 0 in GIOP. Does not imply that booleans may be used as numeric. -%% But, they have stated that this should be the case so..... - -remap_bool(Num) when is_number(Num) -> Num; -remap_bool(true) -> 1; -remap_bool(false) -> 0; -remap_bool(X) -> throw({error, {bad_type, X}}). - -eval_arith({Fun, X}, Env) -> - Xe = remap_bool(eval(X, Env)), - Fun(Xe); -eval_arith({Fun, X, Y}, Env) -> - Xe = remap_bool(eval(X, Env)), - Ye = remap_bool(eval(Y, Env)), - Fun(Xe, Ye). - -eval_rel({Fun, X, Y}, Env) -> - Xe = eval(X, Env), - Ye = eval(Y, Env), - if - is_number(Xe) andalso is_number(Ye) -> - Fun(Xe, Ye); - is_list(Xe) andalso is_list(Ye) -> - Fun(Xe, Ye); - is_atom(Xe) andalso is_atom(Ye) -> - Fun(Xe, Ye); - true -> - throw({error, {bad_type, X, Y}}) - end. - -%%------------------------------------------------------------ -%% function : get_variable -%% Arguments: A sequence of CosNotification::Property{}, i.e., -%% name-value pairs. -%% ID - name in the Property -%% Any - remainder of body -%% Returns : Value in the Property | false -%% Comment : When searching for a variable we must start with -%% 'variable_header' followed by 'filterable_body'. -%% If not found we will then look in the 'remainder_of_body' -%%------------------------------------------------------------ - -get_variable([], ID, Any) when is_record(Any, any) -> - case {any:get_value(Any), any:get_typecode(Any)} of - {#'CosNotification_Property'{name=ID, value=A}, _} -> - any:get_value(A); - {_, TC} when is_atom(TC) -> - %% Since TC atom it must be a simple type, which don't have members. - throw({error, {bad_id, ID}}); - {Value, {tk_alias,_,ID,_}} when is_record(Value, any) -> - %% {tk_alias, IFRId, ID, TypeCode} - any:get_value(Value); - {Value, {tk_alias,_,ID,_}} -> - %% {tk_alias, IFRId, ID, TypeCode} - Value; - {Value, _TC} -> - get_variable([],ID, Value) - end; -get_variable([], ID, #'CosNotification_Property'{name=ID, value=Any}) -> - any:get_value(Any); -get_variable([], ID, [#'CosNotification_Property'{name=ID, value=Any}|_]) -> - any:get_value(Any); -get_variable([], ID, [H|T]) when is_record(H, 'CosNotification_Property') -> - get_variable([], ID, T); -get_variable([], ID, false) -> - throw({error, {bad_id, ID}}); -get_variable([], ID, Value) -> - M = element(1, Value), - case catch M:tc() of - {tk_struct,_,_,SList} -> - %% {tk_struct, Id, Name, ElementList}. - Field = get_field(ID, SList), - element(Field, Value); - {tk_union,_,_,_, DefNo, UList} -> - %% {tk_union, Id, Name, DiscrTC, Default, ElementList} - case id2switch(UList, ID) of - [default] when DefNo >= 0 -> - element(3, Value); - [default] -> - throw({error, {bad_id, "Bad Union ID supplied"}}); - Found -> - case catch lists:member(element(2, Value), Found) of - true -> - element(3, Value); - _ -> - throw({error, {bad_id, "Bad Union ID supplied"}}) - end - end; - _-> - throw({error, {bad_id, ID}}) - end; -get_variable([#'CosNotification_Property'{name=ID, value=A}|_], ID, _) -> - any:get_value(A); -get_variable([_|T], ID, Any) -> - get_variable(T, ID, Any). - -%%------------------------------------------------------------ -%% function : lookup -%% Arguments: T - A parse tree representing the grammar. -%% S - The event we want to extract data from -%% Op - which type of lookup should be done on this -%% component, e.g., 'default' or 'exist'. -%% Returns : {ok, boolean()} | -%% {error, _} -%% Comment : WARNING!!!! -%% This function uses some Orber core information to -%% extract data, e.g., TypeCode representation. Why? -%% We don't want to see the performance take a plunge -%% due to that users write constraints which they -%% can/may not know is slow. The alternative would be -%% to use the IFR. However, these shortcuts aren't -%% that frequent and we can easily update the code. -%% To update, investigate: -%% * lookup/3 cases related to '_type_id' -%% * lookup/3 cases related to unions -%% * get_variable/3 -%% * id2switch/2 -%% * switch2alias/2 -%%------------------------------------------------------------ -%% Done parsing, return the result. -lookup([],S,_) -> {ok, S}; -lookup('$empty', #'CosNotification_StructuredEvent'{remainder_of_body = Any},_) -> - {ok, any:get_value(Any)}; -lookup('$empty',S,_) when is_record(S, any) -> - {ok, any:get_value(S)}; - -%%------- varid -------- -%% CosNotification-revision-98-11-01/46 states: -%% "The following rules govern translation of a run-time variable, $variable , -%% into a specific event field. If the run-time variable is reserved -%% (e.g., $curtime) this translation takes precedence. Next, the first matching -%% translation is chosen respectively from: -%% * a simple-typed member of $.header.fixed_header, -%% * properties in $.header.variable_header, -%% and properties in $.header.filterable_data. -%% If no match is found, the translation defaults to $.variable. -%% Given these rules, an unstructured event with a $.priority member and a -%% structured event using $.header.variable_header(priority) can be specified -%% in a generic constraint using the run-time variable $priority . -%% Alternatively, a constraint can be written specifically for a structured or -%% unstructured event by avoiding the use of run-time variables." - -%% The above contains one error; $.header.filterable_data is not a part of the -%% header, but contained in the event body. - -%% For any events we must first verify that a path exist, e.g., -%% "header"->"fixed_header"->"event_type"->"domain_name", otherwise we will -%% use {dotid, "xxx"}. -lookup([{varid, "type_name"}|T], - #'CosNotification_StructuredEvent' - {header = #'CosNotification_EventHeader' - {fixed_header = #'CosNotification_FixedEventHeader' - {event_type = #'CosNotification_EventType'{type_name=TN}}}}, Op) -> - lookup(T, TN, Op); -lookup([{varid, "type_name"}|T], Any, Op) when is_record(Any, any) -> - case locate_var([?TYPE_PATH, ?VARIABLE_PATH("type_name"), - ?FILTERABLE_PATH("type_name")], Any, Op) of - {ok, Val} -> - lookup(T, Val, Op); - _ -> - lookup(T, get_variable([], "type_name", Any), Op) - end; -lookup([{varid, "domain_name"}|T], - #'CosNotification_StructuredEvent' - {header = #'CosNotification_EventHeader' - {fixed_header = #'CosNotification_FixedEventHeader' - {event_type = #'CosNotification_EventType'{domain_name=DN}}}}, Op) -> - lookup(T, DN, Op); -lookup([{varid, "domain_name"}|T], Any, Op) when is_record(Any, any) -> - case locate_var([?DOMAIN_PATH, ?VARIABLE_PATH("domain_name"), - ?FILTERABLE_PATH("domain_name")], Any, Op) of - {ok, Val} -> - lookup(T, Val, Op); - _ -> - lookup(T, get_variable([], "domain_name", Any), Op) - end; -lookup([{varid, "event_name"}|T], - #'CosNotification_StructuredEvent' - {header = #'CosNotification_EventHeader' - {fixed_header = #'CosNotification_FixedEventHeader' - {event_name = EN}}}, Op) -> - lookup(T, EN, Op); -lookup([{varid, "event_name"}|T], Any, Op) when is_record(Any, any) -> - case locate_var([?EVENT_PATH, ?VARIABLE_PATH("event_name"), - ?FILTERABLE_PATH("event_name")], Any, Op) of - {ok, Val} -> - lookup(T, Val, Op); - _ -> - lookup(T, get_variable([], "event_name", Any), Op) - end; - -lookup([{varid, ID}|T], - #'CosNotification_StructuredEvent'{header = - #'CosNotification_EventHeader'{variable_header = VS}, - filterable_data = FS, - remainder_of_body = Any}, Op) -> - lookup(T, get_variable(VS++FS, ID, Any), Op); -lookup([{varid, ID}|T], Any, Op) -> - case locate_var([?VARIABLE_PATH(ID), ?FILTERABLE_PATH(ID)], Any, Op) of - {ok, Val} -> - lookup(T, Val, Op); - _ -> - lookup(T, get_variable([], ID, Any), Op) - end; - -%%------- dotid -------- -%% First level -lookup([{dotid, "header"}|T], - #'CosNotification_StructuredEvent'{header = S}, Op) -> - lookup(T, S, Op); -lookup([{dotid, "filterable_data"}|T], - #'CosNotification_StructuredEvent'{filterable_data = S}, Op) -> - lookup(T, S, Op); - -lookup([{dotid, remainder_of_body}|T], - #'CosNotification_StructuredEvent'{remainder_of_body = S}, Op) -> - lookup(T, S, Op); -%% Second level. Previous token must have been header -lookup([{dotid, "fixed_header"}|T], - #'CosNotification_EventHeader'{fixed_header = S}, Op) -> - lookup(T, S, Op); -lookup([{dotid, "variable_header"}|T], - #'CosNotification_EventHeader'{variable_header = S}, Op) -> - lookup(T, S, Op); -%% Third level. Previous token must have been fixed_header. -lookup([{dotid, "event_type"}|T], - #'CosNotification_FixedEventHeader'{event_type = S}, Op) -> - lookup(T, S, Op); -lookup([{dotid, "event_name"}|T], - #'CosNotification_FixedEventHeader'{event_name = S}, Op) -> - lookup(T, S, Op); -%% Fourth level. Previous token must have been event_type -lookup([{dotid, "domain_name"}|T], #'CosNotification_EventType'{domain_name = S}, Op) -> - lookup(T, S, Op); -lookup([{dotid, "type_name"}|T], #'CosNotification_EventType'{type_name = S}, Op) -> - lookup(T, S, Op); - -%% Leaf expressions -lookup([{dotid, "name"}|T], #'CosNotification_Property'{name=S}, Op) -> - lookup(T, S, Op); -lookup([{dotid, "value"}|T], #'CosNotification_Property'{value=S}, Op) -> - lookup(T, S, Op); - -lookup([{dotid, ID}|T], - #'CosNotification_StructuredEvent'{remainder_of_body = Any}, Op) -> - lookup(T, get_variable([], ID, Any), Op); -lookup([{dotid, ID}|T], Any, Op) -> - lookup(T, get_variable([], ID, Any), Op); - -lookup([{associd, ID}|T], S, Op) when is_list(S) -> - %% Refers to an associative array, i.e., a list of - %% #'CosNotification_Property'{name=ID, value=A} - lookup(T, get_variable(S, ID, false), Op); - -lookup([{dotint, Position}|T], S, Op) when is_record(S, any) -> - lookup(T, element(Position+2, any:get_value(S)), Op); -lookup([{dotint, Position}|T], S, Op) -> - lookup(T, element(Position+2, S), Op); - -lookup([{uint, ID}|T], S, Op) when is_record(S, any) -> - lookup([{uint, ID}|T], any:get_value(S), Op); -lookup([{uint, ID} |T], S, Op) when is_tuple(S) -> - case catch element(2, S) of - ID -> - %% The supplied union do contain the requested discriminator. - lookup(T, element(3, S), Op); - _Other when Op == exist_component -> - throw({error, {bad_id, "Bad Union ID"}}); - Other -> - %% Check if default is allowed. - M = element(1, S), - case catch M:tc() of - {tk_union,_,_,_,DefNo, UList} -> - %% {tk_union, Id, Name, DiscrTC, Default, ElementList} - case switch2alias(UList, ID) of - {ok, [], _} -> - throw({error, {bad_id, "Bad Union ID"}}); - {ok, default, _} when DefNo >= 0 -> - lookup(T, element(3, S), Op); - {ok, List, _} -> - case lists:member(Other, List) of - true -> - lookup(T, element(3, S), Op); - _-> - throw({error, {bad_id, "Bad Union ID"}}) - end - end - end - end; -lookup([{ustr, ID}|T], S, Op) when is_record(S, any) -> - lookup([{ustr, ID}|T], any:get_value(S), Op); -lookup([{ustr, ID}|T], S, Op) when is_tuple(S) -> - M = element(1, S), - case catch M:tc() of - {tk_union,_,_,_,DefNo, UList} -> - case id2switch(UList, ID) of - [default] when DefNo >= 0 -> - lookup(T, element(3, S), Op); - [default] -> - throw({error, {bad_id, "Bad Union ID supplied"}}); - Found -> - case catch lists:member(element(2, S), Found) of - true -> - lookup(T, element(3, S), Op); - _ -> - throw({error, {bad_id, "Bad Union ID supplied"}}) - end - end - end; -lookup([default|T], S, Op) when is_record(S, any) -> - lookup([default|T], any:get_value(S), Op); -lookup([default|T], S, Op) when is_tuple(S) -> - M = element(1, S), - case catch M:tc() of - {tk_union,_,_,_,DefNo, _UList} when DefNo < 0 -> - %% {tk_union, Id, Name, DiscrTC, Default, ElementList} - throw({error, {bad_id, "No default discriminator"}}); - {tk_union,_,_,_,_DefNo, UList} -> - %% {tk_union, Id, Name, DiscrTC, Default, ElementList} - %% Check if the label really is default. - case lists:keymember(element(2, S), 1, UList) of - false -> - lookup(T, element(3, S), Op); - _-> - throw({error, {bad_id, "Bad Union"}}) - end; - _-> - throw({error, {bad_id, "Bad Union"}}) - end; - -lookup([{arrindex, Index}|T], S, Op) when is_tuple(S) -> - %% The OMG uses c/c++ index. We must add one. - lookup(T, element(Index+1,S), Op); - -%%%%%%%%%%%%%%%%%%%%%%% LEAF EXPRESSIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% got '$._length', which maps to the 'remainder_of_body' -lookup(['_length'], - #'CosNotification_StructuredEvent'{remainder_of_body = Any}, _Op) -> - {ok, length(any:get_value(Any))}; -lookup(['_length'], S, _Op) when is_record(S, any) -> - {ok, length(any:get_value(S))}; -lookup(['_length'], S, _Op) when is_list(S) -> - {ok, length(S)}; -lookup(['_length'], S, _Op) when is_tuple(S) -> - {ok, length(tuple_to_list(S))}; - -%% got '$._d', which maps to the 'remainder_of_body' -%% The discriminator may, accordiong to the CORBA specification, be (2.3/p3-37): -%% * integer_type -%% * char_type -%% * boolean_type -%% * enum_type -%% * scoped_name -lookup(['_d'], - #'CosNotification_StructuredEvent'{remainder_of_body = Any}, - default_component) -> - lookup(['_d'], any:get_value(Any), default_component); -lookup(['_d'], S, default_component) when is_record(S, any) -> - lookup(['_d'], any:get_value(S), default_component); -lookup(['_d'], S, default_component) -> - M = element(1, S), - case catch M:tc() of - {tk_union,_,_,_,DefNo,_} when DefNo < 0 -> - %% '-1' indicates that no default value may exist. - {ok, false}; - {tk_union,_,_,_,_,UList} -> - %% May be using the default setting; check if the Value is in the list. - {ok, not lists:keymember(element(2, S), 1, UList)}; - _ -> - {ok, false} - end; -lookup(['_d'], - #'CosNotification_StructuredEvent'{remainder_of_body = Any}, _Op) -> - {ok, element(2, any:get_value(Any))}; -lookup(['_d'], S, _Op) when is_record(S, any) -> - {ok, element(2, any:get_value(S))}; -lookup(['_d'], S, _Op) -> - {ok, element(2, S)}; - - -lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_StructuredEvent') -> - {ok, "StructuredEvent"}; -lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_EventHeader') -> - {ok, "EventHeader"}; -lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_FixedEventHeader') -> - {ok, "FixedEventHeader"}; -lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_EventType') -> - {ok, "EventType"}; -lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_Property') -> - {ok, "Property"}; -lookup(['_type_id'], S, _Op) when is_tuple(S) -> - M=element(1, S), - Name = case catch M:tc() of - {tk_union,_,ID,_,_,_} -> - ID; - {tk_enum, _, ID, _} -> - ID; - {tk_exception, _, ID, _} -> - ID; - {tk_alias, _, ID, _} -> - ID; - {tk_struct,_,ID,_} -> - ID - end, - {ok, Name}; - -lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_StructuredEvent') -> - {ok, 'CosNotification_StructuredEvent':id()}; -lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_EventHeader') -> - {ok, 'CosNotification_EventHeader':id()}; -lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_FixedEventHeader') -> - {ok, 'CosNotification_FixedEventHeader':id()}; -lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_EventType') -> - {ok, 'CosNotification_EventType':id()}; -lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_Property') -> - {ok, 'CosNotification_Property':id()}; -lookup(['_repos_id'], S, _Op) when is_tuple(S) -> - M = element(1, S), - {ok, M:id()}; - -lookup(_, _, _) -> - error. - - -%%------------------------------------------------------------ -%% function : locate_var -%% Arguments: Paths - A list of path-lists which tells us where -%% to search for runtime variables and in which -%% order. -%% S - Data -%% Op - se lookup/3 -%% Returns : {error, _} | -%% {ok, Val} -%%------------------------------------------------------------ -locate_var([], _S, _) -> - {error, "not found"}; -locate_var([H|T], S, Op) -> - case catch lookup(H, S, Op) of - {ok, Val} -> - {ok,Val}; - _ -> - locate_var(T, S, Op) - end. - -%%------------------------------------------------------------ -%% function : id2switch -%% Arguments: UList - The list of elements contained in the -%% Union TypeCode. -%% ID - string() eq name of element. -%% Returns : Acc - A list of switches related to given ID. -%%------------------------------------------------------------ -id2switch(UList, ID) -> - id2switch(UList, ID, [], false). -id2switch([], _, Acc, _) -> - Acc; -id2switch([{Sw, ID, _}|T], ID, Acc, _) -> - id2switch(T, ID, [Sw|Acc], true); -id2switch([_|_T], _ID, Acc, true) -> - Acc; -id2switch([_|T], ID, Acc, Found) -> - id2switch(T, ID, Acc, Found). - -%%------------------------------------------------------------ -%% function : switch2alias -%% Arguments: UList - The list of elements contained in the -%% Union TypeCode. -%% Switch - the union discriminator. -%% Returns : Acc - A list of switches that are defined with the same -%% ID - The switches common ID. -%% Comment : A union IDL code can look like: -%% union Union switch(long) { -%% case 1: -%% case 2: long ID; }; -%% In this case supplying Switch == 1 (or) the result -%% should be {ok, [1,2], "ID"} -%%------------------------------------------------------------ -switch2alias([], _Switch) -> - %% Is it really possible to define an empty union?? - {ok, [], undefined}; -switch2alias([{Sw, ID, TC}|UList], Switch) -> - switch2alias([{Sw, ID, TC}|UList], Switch, [], ID, false). - - -switch2alias([{default, ID, _}], _, _, _, false) -> - {ok, default, ID}; -switch2alias([], _, _Acc, _, false) -> - {ok, [], undefined}; -switch2alias([], _, Acc, PreviousID, _) -> - {ok, Acc, PreviousID}; - -%% Seen the ID before but just found the correct switch, e.g., -%% [... {0,"K",{tk_string,0}}, {2,"K",{tk_string,0}}...] and switch eq '2' -switch2alias([{Switch, PreviousID, _}|T], Switch, Acc, PreviousID, _Found) -> - switch2alias(T, Switch, [Switch|Acc], PreviousID, true); - -%% First time for this ID and found the correct switch -switch2alias([{Switch, ID, _}|T], Switch, _Acc, _PreviousID, false) -> - switch2alias(T, Switch, [Switch], ID, true); - -%% Seen this ID and found the correct switch before. -switch2alias([{Sw, PreviousID, _}|T], Switch, Acc, PreviousID, true) -> - switch2alias(T, Switch, [Sw|Acc], PreviousID, true); - -%% Seen this ID but not found the correct switch. -switch2alias([{Sw, PreviousID, _}|T], Switch, Acc, PreviousID, false) -> - switch2alias(T, Switch, [Sw|Acc], PreviousID, false); - -%% No more of the correct ID/Switch. Done. -switch2alias([{_, _ID, _}|_], _, Acc, PreviousID, true) -> - {ok, Acc, PreviousID}; -%% Not found correct switch and ID is updated. -switch2alias([{Sw, ID, _}|T], Switch, _Acc, _PreviousID, Found) -> - switch2alias(T, Switch, [Sw], ID, Found). - - -%%------------------------------------------------------------ -%% function : get_field -%% Arguments: ID - element name -%% List - The list of elements contained in the -%% TypeCode. -%% Returns : false | -%% offset -%%------------------------------------------------------------ -get_field(ID, List) -> - get_field(ID, List, 2). -get_field(_ID, [], _) -> - false; -get_field(ID, [ID|_], I) -> - %% Memberlists in enum. - I; -get_field(ID, [{ID,_}|_], I) -> - %% Memberlists in structs. - I; -get_field(ID, [_|T], I) -> - get_field(ID, T, I+1). - -%%------------------------------------------------------------ -%% function : check_types -%% Arguments: A sequence of CosNotification::EventType{}, i.e., -%% name-value pairs. -%% Returns : {ok, WhichType, WC} -%% WhichType - type/domain/both -%% WC - [Types using wildcard] -%%------------------------------------------------------------ -%% With check_types we try to determin if one or more EventTypes force us to check -%% all events against this constraint. For example: -%% EventType A1 has domain_name="car",type_name = "*" -%% EventType A2 has domain_name="*",type_name = "DodgeViper" -%% Since A1 says that we must test against any type_name and A2 -%% against any domain_name, we must test all events using these permutations. -%% It's better to do these test now instead of when we are up and running. But -%% if a client change the constraints VERY often it's up to them and they have -%% to accept the delay. -%%------------------------------------------------------------ - -%% If types is an empty list it means that this constraint must be used -%% for all events. -check_types([]) -> true; -check_types(Types) -> check_types(Types, both, []). -check_types([], Which, WildCard) -> {ok, Which, WildCard}; -%% The following cases means that all events matches. -check_types([#'CosNotification_EventType'{domain_name="",type_name = ""}|_T],_,_) -> - true; -check_types([#'CosNotification_EventType'{domain_name="",type_name = "*"}|_T],_,_) -> - true; -check_types([#'CosNotification_EventType'{domain_name="*",type_name = ""}|_T],_,_) -> - true; -check_types([#'CosNotification_EventType'{domain_name="*",type_name = "*"}|_T],_,_) -> - true; -%% The following cases means that all events must be tested using this constraint. -check_types([#'CosNotification_EventType'{domain_name="",type_name = Ty}|T], domain,WC) when is_list(Ty) -> - check_wildcard(T, all, WC, "", Ty); -check_types([#'CosNotification_EventType'{domain_name="*",type_name = Ty}|T], domain, WC) when is_list(Ty) -> - check_wildcard(T, all, WC, "", Ty); -check_types([#'CosNotification_EventType'{domain_name=Do,type_name = ""}|T], type,WC) when is_list(Do) -> - check_wildcard(T, all, WC, Do, ""); -check_types([#'CosNotification_EventType'{domain_name=Do,type_name = "*"}|T], type,WC) when is_list(Do) -> - check_wildcard(T, all, WC, Do, ""); -%% The following cases is used to prevent other cases from converting, -%% for example, all->type. -check_types([#'CosNotification_EventType'{domain_name="",type_name = Ty}|T], all,WC) when is_list(Ty) -> - check_wildcard(T, all, WC, "", Ty); -check_types([#'CosNotification_EventType'{domain_name="*",type_name = Ty}|T], all,WC) when is_list(Ty) -> - check_wildcard(T, all, WC, "", Ty); -check_types([#'CosNotification_EventType'{domain_name=Do,type_name = ""}|T], all,WC) when is_list(Do) -> - check_wildcard(T, all, WC, Do, ""); -check_types([#'CosNotification_EventType'{domain_name=Do,type_name = "*"}|T], all,WC) when is_list(Do) -> - check_wildcard(T, all, WC, Do, ""); -%% The following cases means that all events with matching Type must be -%% tested using this constraint. -check_types([#'CosNotification_EventType'{domain_name="",type_name = Ty}|T], _W,WC) when is_list(Ty) -> - check_wildcard(T, type, WC, "", Ty); -check_types([#'CosNotification_EventType'{domain_name="*",type_name = Ty}|T], _W,WC) when is_list(Ty) -> - check_wildcard(T, type, WC, "", Ty); -%% The following cases means that all events with matching Domain must be -%% tested using this constraint. -check_types([#'CosNotification_EventType'{domain_name=Do,type_name = ""}|T], _W,WC) when is_list(Do) -> - check_wildcard(T, domain, WC, Do, ""); -check_types([#'CosNotification_EventType'{domain_name=Do,type_name = "*"}|T], _W,WC) when is_list(Do) -> - check_wildcard(T, domain, WC, Do, ""); -%% Sorry, no shortcuts. -check_types([#'CosNotification_EventType'{domain_name=Do,type_name=Ty}|T], W,WC) when is_list(Do) andalso is_list(Ty) -> - check_wildcard(T, W, WC, Do, Ty); -check_types([H|_], _,_) when is_record(H, 'CosNotification_EventType') -> - %% Not valid. - corba:raise(#'CosNotifyComm_InvalidEventType'{type=H}); -check_types(_,_,_) -> - %% Wasn't even a correct input. - corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). - -check_wildcard(Types, Which, WC, Domain, Type) -> - NewWC = - case {string:chr(Domain, $*), string:chr(Type, $*)} of - {0, 0} -> - WC; - {0, _}-> - [{type, Domain, convert_wildcard(Type, [])}|WC]; - {_, 0}-> - [{domain, convert_wildcard(Domain, []), Type}|WC]; - _-> - [{both, convert_wildcard(Domain, []), convert_wildcard(Type, [])}|WC] - end, - check_types(Types, Which, NewWC). - -%% Change '*' to '.*', see re:compile/1 documentation. -convert_wildcard([], Acc) -> - case re:compile(lists:reverse(Acc)) of - {ok, Expr} -> - Expr; - _ -> - corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}) - end; -convert_wildcard([$*|T], Acc) -> - convert_wildcard(T, [$*, $.|Acc]); -convert_wildcard([H|T], Acc) -> - convert_wildcard(T, [H|Acc]). - -%%------------------------------------------------------------ -%% function : match_types -%% Arguments: A sequence of {Which, Domain, Type}, i.e., the same as -%% returned from cosNotification_Filter:check_types/3 -%% Returns : bolean() -%%------------------------------------------------------------ -match_types(_, _, []) -> - false; -match_types(Domain, Type, [{domain, WCDomain, Type}|T]) -> - L=length(Domain), - case catch re:run(Domain, WCDomain) of - nomatch -> - match_types(Domain, Type, T); - {match, [{0, L}]} -> - true; - _-> - match_types(Domain, Type, T) - end; -match_types(Domain, Type, [{type, Domain, WCType}|T]) -> - L=length(Type), - case catch re:run(Type, WCType) of - nomatch -> - match_types(Domain, Type, T); - {match, [{0, L}]} -> - true; - _-> - match_types(Domain, Type, T) - end; -match_types(Domain, Type, [{both, WCDomain, WCType}|T]) -> - L1=length(Domain), - case catch re:run(Domain, WCDomain) of - nomatch -> - match_types(Domain, Type, T); - {match, [{0, L1}]} -> - L2=length(Type), - case catch re:run(Type, WCType) of - nomatch -> - match_types(Domain, Type, T); - {match, [{0, L2}]} -> - true; - _ -> - match_types(Domain, Type, T) - end; - _-> - match_types(Domain, Type, T) - end; -match_types(Domain, Type, [_|T]) -> - match_types(Domain, Type, T). - -%%------------------------------------------------------------ -%% function : validate_types -%% Arguments: A sequence of CosNotification::EventType{}, i.e., -%% name-value pairs. -%% Returns : ok | -%% {'EXCEPTION', #'CosNotifyComm_InvalidEventType'{}} -%%------------------------------------------------------------ - -validate_types([]) -> - ok; -validate_types([#'CosNotification_EventType'{domain_name=Do,type_name=Ty}|T]) - when is_list(Do) andalso is_list(Ty) -> - validate_types(T); -validate_types([H|_]) - when is_record(H, 'CosNotification_EventType') -> - %% Not valid. - corba:raise(#'CosNotifyComm_InvalidEventType'{type=H}); -validate_types(_) -> - %% Wasn't even a correct input. - corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). - - -%%--------------- END OF MODULE ------------------------------ |