The R13B03 release.OTP_R13B03

1 files changed, 964 insertions, 0 deletions

diff --git a/lib/cosNotification/src/cosNotification_Filter.erl b/lib/cosNotification/src/cosNotification_Filter.erl
new file mode 100644
index 0000000000..dd3b5beb93
--- /dev/null
+++ b/lib/cosNotification/src/cosNotification_Filter.erl
@@ -0,0 +1,964 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights 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 regexp:parse/2 documentation.
+convert_wildcard([], Acc) ->
+    case regexp:parse(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 regexp:matches(Domain, WCDomain) of
+	{match, []} ->
+	    match_types(Domain, Type, T);
+	{match, [{1, L}]} ->
+	    true;
+	_->
+	    match_types(Domain, Type, T)
+    end;
+match_types(Domain, Type, [{type, Domain, WCType}|T]) ->
+    L=length(Type),
+    case catch regexp:matches(Type, WCType) of
+	{match, []} ->
+	    match_types(Domain, Type, T);
+	{match, [{1, L}]} ->
+	    true;
+	_->
+	    match_types(Domain, Type, T)
+    end;
+match_types(Domain, Type, [{both, WCDomain, WCType}|T]) ->
+    L1=length(Domain),
+    case catch regexp:matches(Domain, WCDomain) of
+	{match, []} ->
+	    match_types(Domain, Type, T);
+	{match, [{1, L1}]} ->
+	    L2=length(Type),
+	    case catch regexp:matches(Type, WCType) of
+		{match, []} ->
+		    match_types(Domain, Type, T);
+		{match, [{1, 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 ------------------------------