goldrush-0.1.9/0000755000232200023220000000000012721424410013713 5ustar debalancedebalancegoldrush-0.1.9/LICENSE0000644000232200023220000000136012721424410014720 0ustar debalancedebalanceCopyright (c) 2012, Magnus Klaar Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. goldrush-0.1.9/rebar.config0000644000232200023220000000030112721424410016167 0ustar debalancedebalance{cover_enabled, true}. {erl_opts, [ %% bin_opt_info, %% warn_missing_spec, warn_export_all, {platform_define, "18", erlang18} ]}. {edoc_opts, [{stylesheet_file, "./priv/edoc.css"}]}. goldrush-0.1.9/priv/0000755000232200023220000000000012721424410014673 5ustar debalancedebalancegoldrush-0.1.9/priv/edoc.css0000644000232200023220000000422012721424410016315 0ustar debalancedebalance/* Baseline rhythm */ body { font-size: 16px; font-family: Helvetica, sans-serif; margin: 8px; } p { font-size: 1em; /* 16px */ line-height: 1.5em; /* 24px */ margin: 0 0 1.5em 0; } h1 { font-size: 1.5em; /* 24px */ line-height: 1em; /* 24px */ margin-top: 1em; margin-bottom: 0em; } h2 { font-size: 1.375em; /* 22px */ line-height: 1.0909em; /* 24px */ margin-top: 1.0909em; margin-bottom: 0em; } h3 { font-size: 1.25em; /* 20px */ line-height: 1.2em; /* 24px */ margin-top: 1.2em; margin-bottom: 0em; } h4 { font-size: 1.125em; /* 18px */ line-height: 1.3333em; /* 24px */ margin-top: 1.3333em; margin-bottom: 0em; } .class-for-16px { font-size: 1em; /* 16px */ line-height: 1.5em; /* 24px */ margin-top: 1.5em; margin-bottom: 0em; } .class-for-14px { font-size: 0.875em; /* 14px */ line-height: 1.7143em; /* 24px */ margin-top: 1.7143em; margin-bottom: 0em; } ul { margin: 0 0 1.5em 0; } /* Customizations */ body { color: #333; } tt, code, pre { font-family: "Andale Mono", "Inconsolata", "Monaco", "DejaVu Sans Mono", monospaced; } tt, code { font-size: 0.875em } pre { font-size: 0.875em; /* 14px */ line-height: 1.7143em; /* 24px */ margin: 0 1em 1.7143em; padding: 0 1em; background: #eee; } .navbar img, hr { display: none } table { border-collapse: collapse; } h1 { border-left: 0.5em solid #fa0; padding-left: 0.5em; } h2.indextitle { font-size: 1.25em; /* 20px */ line-height: 1.2em; /* 24px */ margin: -8px -8px 0.6em; background-color: #fa0; color: white; padding: 0.3em; } ul.index { list-style: none; margin-left: 0em; padding-left: 0; } ul.index li { display: inline; padding-right: 0.75em } div.spec p { margin-bottom: 0; padding-left: 1.25em; background-color: #eee; } h3.function { border-left: 0.5em solid #fa0; padding-left: 0.5em; background: #fc9; } a, a:visited, a:hover, a:active { color: #C60 } h2 a, h3 a { color: #333 } i { font-size: 0.875em; /* 14px */ line-height: 1.7143em; /* 24px */ margin-top: 1.7143em; margin-bottom: 0em; font-style: normal; } goldrush-0.1.9/src/0000755000232200023220000000000012721424410014502 5ustar debalancedebalancegoldrush-0.1.9/src/glc_code.erl0000644000232200023220000005776012721424410016764 0ustar debalancedebalance%% @doc Code generation functions. -module(glc_code). -compile({nowarn_unused_function, {abstract_module,2}}). -compile({nowarn_unused_function, {abstract_tables,1}}). -compile({nowarn_unused_function, {abstract_reset,0}}). -compile({nowarn_unused_function, {abstract_filter,3}}). -compile({nowarn_unused_function, {abstract_filter_,4}}). -compile({nowarn_unused_function, {abstract_opfilter,6}}). -compile({nowarn_unused_function, {abstract_all,4}}). -compile({nowarn_unused_function, {abstract_any,4}}). -compile({nowarn_unused_function, {abstract_with,3}}). -compile({nowarn_unused_function, {abstract_within,3}}). -compile({nowarn_unused_function, {abstract_getkey,4}}). -compile({nowarn_unused_function, {abstract_getkey_,4}}). -compile({nowarn_unused_function, {abstract_getparam,3}}). -compile({nowarn_unused_function, {param_variable,1}}). -compile({nowarn_unused_function, {field_variable,1}}). -compile({nowarn_unused_function, {field_variable_,1}}). -compile({nowarn_unused_function, {compile_forms,2}}). -compile({nowarn_unused_function, {load_binary,2}}). -export([ compile/2 ]). -define(erl, erl_syntax). -record(module, { 'query' :: term(), tables :: [{atom(), atom()}], qtree :: term(), store :: term() }). -type syntaxTree() :: erl_syntax:syntaxTree(). -record(state, { event = undefined :: syntaxTree(), fields = [] :: [{atom(), syntaxTree()}], fieldc = 0 :: non_neg_integer(), paramvars = [] :: [{term(), syntaxTree()}], paramstab = undefined :: atom(), countstab = undefined :: atom() }). -type nextFun() :: fun((#state{}) -> [syntaxTree()]). compile(Module, ModuleData) -> {ok, forms, Forms} = abstract_module(Module, ModuleData), {ok, Module, Binary} = compile_forms(Forms, [nowarn_unused_vars]), {ok, loaded, Module} = load_binary(Module, Binary), {ok, Module}. %% abstract code generation functions %% @private Generate an abstract dispatch module. -spec abstract_module(atom(), #module{}) -> {ok, forms, list()}. abstract_module(Module, Data) -> Forms = [?erl:revert(E) || E <- abstract_module_(Module, Data)], case lists:keyfind(errors, 1, erl_syntax_lib:analyze_forms(Forms)) of false -> {ok, forms, Forms}; {_, []} -> {ok, forms, Forms}; {_, [_|_]}=Errors -> Errors end. %% @private Generate an abstract dispatch module. -spec abstract_module_(atom(), #module{}) -> [?erl:syntaxTree()]. abstract_module_(Module, #module{tables=Tables, qtree=Tree, store=Store}=Data) -> {_, ParamsTable} = lists:keyfind(params, 1, Tables), {_, CountsTable} = lists:keyfind(counters, 1, Tables), AbstractMod = [ %% -module(Module) ?erl:attribute(?erl:atom(module), [?erl:atom(Module)]), %% -export([ ?erl:attribute( ?erl:atom(export), [?erl:list([ %% get/1 ?erl:arity_qualifier( ?erl:atom(get), ?erl:integer(1)), %% info/1 ?erl:arity_qualifier( ?erl:atom(info), ?erl:integer(1)), %% reset_counters/1 ?erl:arity_qualifier( ?erl:atom(reset_counters), ?erl:integer(1)), %% table/1 ?erl:arity_qualifier( ?erl:atom(table), ?erl:integer(1)), ?erl:arity_qualifier( ?erl:atom(runjob), ?erl:integer(2)), %% handle/1 ?erl:arity_qualifier( ?erl:atom(handle), ?erl:integer(1))])]), %% ]). %% get(Name) -> Term. ?erl:function( ?erl:atom(get), abstract_get(Data) ++ [?erl:clause( [?erl:underscore()], none, [?erl:abstract({error, undefined})])]), %% info(Name) -> Term. ?erl:function( ?erl:atom(info), abstract_info(Data) ++ [?erl:clause( [?erl:underscore()], none, [abstract_apply(erlang, error, [?erl:atom(badarg)])])]), %% reset_counters(Name) -> boolean(). ?erl:function( ?erl:atom(reset_counters), abstract_reset() ++ [?erl:clause( [?erl:underscore()], none, [abstract_apply(erlang, error, [?erl:atom(badarg)])])]), %% table(Name) -> atom(). ?erl:function( ?erl:atom(table), abstract_tables(Tables) ++ [?erl:clause( [?erl:underscore()], none, [abstract_apply(erlang, error, [?erl:atom(badarg)])])]), %% handle(Event) - entry function ?erl:function( ?erl:atom(handle), [?erl:clause([?erl:variable("Event")], none, [abstract_count(input), ?erl:application(none, ?erl:atom(handle_), [?erl:variable("Event")])])]), ?erl:function( ?erl:atom(runjob), [?erl:clause([?erl:variable("Fun"), ?erl:variable("Event")], none, [abstract_count(job_input), ?erl:application(none, ?erl:atom(job_), [?erl:variable("Fun"), ?erl:variable("Event")])])]), %% input_(Node, App, Pid, Tags, Values) - filter roots ?erl:function( ?erl:atom(handle_), [?erl:clause([?erl:variable("Event")], none, abstract_filter(Tree, Data, #state{ event=?erl:variable("Event"), paramstab=ParamsTable, countstab=CountsTable}))]), ?erl:function( ?erl:atom(job_), [?erl:clause([?erl:variable("Fun"), ?erl:variable("Meta")], none, [?erl:application(none, ?erl:atom(job_result), [ ?erl:catch_expr( abstract_apply(glc_run, execute, [ ?erl:variable("Fun"), ?erl:list([?erl:variable("Meta"), ?erl:abstract(Store)]) ])), ?erl:variable("Meta")]) ] )]), ?erl:function( ?erl:atom(job_result), abstract_runjob(Data) ) ], %% Transform Term -> Key to Key -> Term gr_param:transform(ParamsTable), AbstractMod. %% @private Return the clauses of the table/1 function. abstract_tables(Tables) -> [?erl:clause( [?erl:abstract(K)], none, [?erl:abstract(V)]) || {K, V} <- Tables]. abstract_query_find(K, Store) -> case lists:keyfind(K, 1, Store) of {_, Val} -> {ok, Val}; _ -> {error, notfound} end. %% @private Return the original query as an expression. abstract_query({with, Query, _}) -> [?erl:abstract(Query)]; abstract_query([{with, _Query, _}|_] = I) -> [?erl:abstract([Query || {with, Query, _} <- I])]; %[?erl:abstract(_Query)]; abstract_query({any, [{with, _Q, _A}|_] = I}) -> Queries = glc_lib:reduce(glc:any([Q || {with, Q, _} <- I])), [?erl:abstract(Queries)]; abstract_query({all, [{with, _Q, _A}|_] = I}) -> Queries = glc_lib:reduce(glc:all([Q || {with, Q, _} <- I])), [?erl:abstract(Queries)]; abstract_query(Query) -> [?erl:abstract(Query)]. %% @private Return the clauses of the get/1 function. abstract_get(#module{'query'=_Query, store=undefined}) -> []; abstract_get(#module{'query'=_Query, store=Store}) -> [?erl:clause([?erl:abstract(K)], none, abstract_query(abstract_query_find(K, Store))) || {K, _} <- Store]. %% @private abstract_runjob(#module{'query'=_Query, store=_Store}) -> Time = abstract_apply(erlang, '/', [?erl:variable("Time"), ?erl:abstract(1000000)]), [?erl:clause([?erl:variable("JobResult"), ?erl:variable("Meta")], none, [ ?erl:case_expr(?erl:variable("JobResult"), [ ?erl:clause( [?erl:tuple([?erl:variable("Time"), ?erl:variable("Result")])], none, [?erl:case_expr(?erl:variable("Result"), [ ?erl:clause( [?erl:tuple([?erl:atom(error),?erl:variable("Reason")])], none, [abstract_count(input), abstract_count(job_error), ?erl:application(none, ?erl:atom(handle_), abstract_job(Time, [?erl:tuple([?erl:atom(error), ?erl:variable("Reason")])])), abstract_count(job_time, ?erl:variable("Time")), ?erl:tuple([?erl:variable("Time"), ?erl:tuple([?erl:atom(error), ?erl:variable("Reason")])])]), ?erl:clause( [?erl:variable("Result")], none, [abstract_count(input), abstract_count(job_run), ?erl:application(none, ?erl:atom(handle_), abstract_job(Time)), abstract_count(job_time, ?erl:variable("Time")), ?erl:tuple([?erl:variable("Time"), ?erl:variable("Result")])]) ]) ]) ]) ] )]. abstract_job(Time) -> abstract_job(Time, []). abstract_job(Time, Error) -> Pairs = abstract_apply(gre, pairs, [?erl:variable("Meta")]), Runtime = ?erl:list([?erl:tuple([?erl:atom(runtime), Time])]), [abstract_apply(gre, make, [abstract_apply(erlang, '++', [?erl:list(Error), abstract_apply(erlang, '++', [Pairs, Runtime])]), ?erl:abstract([list])])]. %% @private Return the clauses of the info/1 function. abstract_info(#module{'query'=Query}) -> [?erl:clause([?erl:abstract(K)], none, V) || {K, V} <- [ {'query', abstract_query(Query)}, {input, abstract_getcount(input)}, {filter, abstract_getcount(filter)}, {output, abstract_getcount(output)}, {job_input, abstract_getcount(job_input)}, {job_run, abstract_getcount(job_run)}, {job_time, abstract_getcount(job_time)}, {job_error, abstract_getcount(job_error)} ]]. abstract_reset() -> [?erl:clause([?erl:abstract(K)], none, V) || {K, V} <- [ {all, abstract_resetcount([input, filter, output, job_input, job_run, job_time, job_error])}, {input, abstract_resetcount(input)}, {filter, abstract_resetcount(filter)}, {output, abstract_resetcount(output)}, {job_input, abstract_resetcount(job_input)}, {job_run, abstract_resetcount(job_run)}, {job_time, abstract_resetcount(job_time)}, {job_error, abstract_resetcount(job_error)} ]]. %% @private Return a list of expressions to apply a filter. %% @todo Allow mulitple functions to be specified using `with/2'. -spec abstract_filter(glc_ops:op() | [glc_ops:op()], #module{}, #state{}) -> [syntaxTree()]. abstract_filter({Type, [{with, _Cond, _Fun}|_] = I}, Data, State) when Type =:= all; Type =:= any -> Cond = glc_lib:reduce(glc:Type([Q || {with, Q, _} <- I])), abstract_filter_(Cond, _OnMatch=fun(State2) -> Funs = [ F || {with, _, F} <- I ], [abstract_count(output)] ++ abstract_with(Funs, Data, State2) end, _OnNomatch=fun(_State2) -> [abstract_count(filter)] end, State); abstract_filter([{with, _Cond, _Fun}|_] = I, Data, State) -> OnNomatch = fun(_State2) -> [abstract_count(filter, 0)] end, Funs = lists:foldr(fun({with, Cond, Fun}, Acc) -> [{Cond, Fun, Data}|Acc] end, [], I), abstract_within(Funs, OnNomatch, State); abstract_filter({with, Cond, Fun}, Data, State) -> abstract_filter_(Cond, _OnMatch=fun(State2) -> [abstract_count(output)] ++ abstract_with(Fun, Data, State2) end, _OnNomatch=fun(_State2) -> [abstract_count(filter)] end, State); abstract_filter(Cond, _Data, State) -> abstract_filter_(Cond, _OnMatch=fun(_State2) -> [abstract_count(output)] end, _OnNomatch=fun(_State2) -> [abstract_count(filter)] end, State). %% @private Return a list of expressions to apply a filter. %% A filter expects two continuation functions which generates the expressions %% to apply when the filter matches or fails to match. The state passed to the %% functions will contain all the variable bindings of previously accessed %% fields and parameters. -spec abstract_filter_(glc_ops:op(), nextFun(), nextFun(), #state{}) -> syntaxTree(). abstract_filter_({null, true}, OnMatch, _OnNomatch, State) -> OnMatch(State); abstract_filter_({null, false}, _OnMatch, OnNomatch, State) -> OnNomatch(State); abstract_filter_({Key, '*'}, OnMatch, OnNomatch, State) -> abstract_getkey(Key, _OnMatch=fun(#state{}=State2) -> OnMatch(State2) end, _OnNomatch=fun(State2) -> OnNomatch(State2) end, State); abstract_filter_({Key, '!'}, OnMatch, OnNomatch, State) -> abstract_getkey(Key, _OnNomatch=fun(State2) -> OnNomatch(State2) end, _OnMatch=fun(#state{}=State2) -> OnMatch(State2) end, State); abstract_filter_({Key, Op, Value}, OnMatch, OnNomatch, State) when Op =:= '>'; Op =:= '='; Op =:= '!='; Op =:= '<'; Op =:= '>='; Op =:= '=<'; Op =:= '<=' -> Op2 = case Op of '=' -> '=:='; '!=' -> '=/='; '<=' -> '=<'; Op -> Op end, abstract_opfilter(Key, Op2, Value, OnMatch, OnNomatch, State); abstract_filter_({'any', Conds}, OnMatch, OnNomatch, State) -> abstract_any(Conds, OnMatch, OnNomatch, State); abstract_filter_({'all', Conds}, OnMatch, OnNomatch, State) -> abstract_all(Conds, OnMatch, OnNomatch, State). %% @private Return a branch based on a built in operator. -spec abstract_opfilter(atom(), atom(), term(), nextFun(), nextFun(), #state{}) -> [syntaxTree()]. abstract_opfilter(Key, Opname, Value, OnMatch, OnNomatch, State) -> abstract_getkey(Key, _OnMatch=fun(#state{}=State2) -> [?erl:case_expr( abstract_apply(erlang, Opname, [ ?erl:variable(field_variable(Key)), ?erl:abstract(Value) ]), [?erl:clause([?erl:atom(true)], none, OnMatch(State2)), ?erl:clause([?erl:atom(false)], none, OnNomatch(State2))])] end, _OnNomatch=fun(State2) -> OnNomatch(State2) end, State). %% @private Generate an `all' filter. %% An `all' filter is evaluated by testing all conditions that must hold. If %% any of the conditions does not hold the evaluation is short circuted at that %% point. This means that the `OnNomatch' branch is executed once for each %% condition. The `OnMatch' branch is only executed once. -spec abstract_all([glc_ops:op()], nextFun(), nextFun(), #state{}) -> [syntaxTree()]. abstract_all([H|T], OnMatch, OnNomatch, State) -> abstract_filter_(H, _OnMatch=fun(State2) -> abstract_all(T, OnMatch, OnNomatch, State2) end, OnNomatch, State); abstract_all([], OnMatch, _OnNomatch, State) -> OnMatch(State). %% @private -spec abstract_any([glc_ops:op()], nextFun(), nextFun(), #state{}) -> [syntaxTree()]. abstract_any([H|T], OnMatch, OnNomatch, State) -> abstract_filter_(H, OnMatch, _OnNomatch=fun(State2) -> abstract_any(T, OnMatch, OnNomatch, State2) end, State); abstract_any([], _OnMatch, OnNomatch, State) -> OnNomatch(State). %% @private -spec abstract_with(fun((gre:event()) -> term()), #module{}, #state{}) -> [syntaxTree()]. abstract_with([Fun0|_] = Funs, Data, State) when is_function(Fun0, 1); is_function(Fun0, 2) -> abstract_getparam(Funs, fun(#state{event=Event, paramvars=Params}) -> lists:map(fun(Fun) -> {_, Fun2} = lists:keyfind(Fun, 1, Params), abstract_with_({Fun, Fun2}, Event, Data) end, Funs) end, State); abstract_with(Fun, Data, State) when is_function(Fun, 1); is_function(Fun, 2) -> abstract_getparam(Fun, fun(#state{event=Event, paramvars=Params}) -> {_, Fun2} = lists:keyfind(Fun, 1, Params), [abstract_with_({Fun, Fun2}, Event, Data)] end, State). abstract_within([{H, Fun, Data}|T], OnNomatch, State) -> OnMatch = fun(State2) -> [abstract_count(output)] ++ abstract_with(Fun, Data, State2) ++ abstract_within(T, OnNomatch, State2) end, abstract_filter_(H, OnMatch, _OnNomatch=fun(State2) -> [abstract_count(filter)] ++ abstract_within(T, OnNomatch, State2) end, State); abstract_within([], OnNomatch, State) -> OnNomatch(State). abstract_with_({Fun, Fun2}, Event, #module{store=Store}) -> ?erl:application(none, Fun2, case Fun of _ when is_function(Fun, 1) -> [Event]; _ when is_function(Fun, 2) -> [Event, ?erl:abstract(Store)] end). %% @private Bind the value of a field to a variable. %% If the value of a field has already been bound to a variable the previous %% binding is reused over re-accessing the value. The `OnMatch' function is %% expected to access the variable stored in the state record. The `OnNomatch' %% function must not attempt to access the variable. -spec abstract_getkey(atom(), nextFun(), nextFun(), #state{}) -> [syntaxTree()]. abstract_getkey(Key, OnMatch, OnNomatch, #state{fields=Fields}=State) -> case lists:keyfind(Key, 1, Fields) of {Key, _Variable} -> OnMatch(State); false -> abstract_getkey_(Key, OnMatch, OnNomatch, State) end. -spec abstract_getkey_(atom(), nextFun(), nextFun(), #state{}) -> [syntaxTree()]. abstract_getkey_(Key, OnMatch, OnNomatch, #state{ event=Event, fields=Fields}=State) -> [?erl:case_expr( abstract_apply(gre, find, [?erl:atom(Key), Event]), [?erl:clause([ ?erl:tuple([ ?erl:atom(true), ?erl:variable(field_variable(Key))])], none, OnMatch(State#state{ fields=[{Key, ?erl:variable(field_variable(Key))} |Fields]})), ?erl:clause([ ?erl:atom(false)], none, OnNomatch(State)) ] )]. %% @private Bind the value of a parameter to a variable. %% During code generation the parameter value is used as the identity of the %% parameter. At runtime a unique integer is used as the identity. -spec abstract_getparam(term(), nextFun(), #state{}) -> [syntaxTree()]. abstract_getparam([_|_]=Terms, OnBound, #state{paramvars=_Params, fields=_Fields, paramstab=_ParamsTable}=State) when is_list(Terms) -> {Keys, Bound} = lists:foldl(fun(Term, {Acc0, #state{paramvars=Params, paramstab=ParamsTable}=State0}) -> case lists:keyfind(Term, 1, Params) of {_, _Variable} -> {Acc0, State0}; false -> Key = abstract_getparam_key(Term, ParamsTable), Lookup = abstract_apply(gr_param, lookup_element, [abstract_apply(table, [?erl:atom(params)]), ?erl:abstract(Key)]), Expr = ?erl:match_expr(param_variable(Key), Lookup), State1 = State0#state{paramvars=[{Term, param_variable(Key)}|Params]}, {[Expr|Acc0], State1} end end, {[], State}, Terms), Keys ++ OnBound(Bound); abstract_getparam(Term, OnBound, #state{paramvars=Params}=State) -> case lists:keyfind(Term, 1, Params) of {_, _Variable} -> OnBound(State); %% parameter not bound to variable in this scope. false -> abstract_getparam([Term], OnBound, State) end. abstract_getparam_key(Term, ParamsTable) -> case gr_param:lookup(ParamsTable, Term) of [{_, Key2}] -> Key2; [] -> Key2 = gr_param:info_size(ParamsTable), gr_param:insert(ParamsTable, {Term, Key2}), Key2 end. %% @private Generate a variable name for the value of a field. -spec field_variable(atom()) -> string(). field_variable(Key) -> "Field_" ++ field_variable_(atom_to_list(Key)). %% @private Escape non-alphanumeric values. -spec field_variable_(string()) -> string(). field_variable_([H|T]) when H >= $0, H =< $9 -> [H|field_variable_(T)]; field_variable_([H|T]) when H >= $A, H =< $Z -> [H|field_variable_(T)]; field_variable_([H|T]) when H >= $a, H =< $z -> [H|field_variable_(T)]; field_variable_([H|T]) -> "_" ++ integer_to_list(H, 16) ++ "_" ++ field_variable_(T); field_variable_([]) -> []. %% @private Generate a variable name for the value of a parameter. -spec param_variable(integer()) -> syntaxTree(). param_variable(Key) -> ?erl:variable("Param_" ++ integer_to_list(Key)). %% @ private Generate a list of field variable names. %% Walk the query tree and generate a safe variable name string for each field %% that is accessed by the conditions in the query. Only allow alpha-numeric. %%-spec field_variables(glc_ops:op()) -> [{atom(), string()}]. %%field_variables(Query) -> %% lists:usort(field_variables_(Query)). %%-spec field_variables(glc_ops:op()) -> [{atom(), string()}]. %%field_variables_({Key, '=', _Term}) -> %% [{Key, field_variable(Key)}]. %% @private Return an expression to increment a counter. %% @todo Pass state record. Only Generate code if `statistics' is enabled. -spec abstract_count(atom()) -> syntaxTree(). abstract_count(Counter) -> abstract_count(Counter, 1). abstract_count(Counter, Value) when is_integer(Value) -> abstract_apply(gr_counter, update_counter, [abstract_apply(table, [?erl:atom(counters)]), ?erl:abstract(Counter), ?erl:abstract({2,Value})]); abstract_count(Counter, Value) -> abstract_apply(gr_counter, update_counter, [abstract_apply(table, [?erl:atom(counters)]), ?erl:abstract(Counter), ?erl:tuple([?erl:abstract(2), Value]) ]). %% @private Return an expression to get the value of a counter. %% @todo Pass state record. Only Generate code if `statistics' is enabled. -spec abstract_getcount(atom()) -> [syntaxTree()]. abstract_getcount(Counter) when is_atom(Counter) -> abstract_getcount(?erl:abstract(Counter)); abstract_getcount(Counter) -> [abstract_apply(gr_counter, lookup_element, [abstract_apply(table, [?erl:atom(counters)]), Counter])]. %% @private Return an expression to reset a counter. -spec abstract_resetcount(atom() | [filter | input | output | job_input | job_run | job_time | job_error ]) -> [syntaxTree()]. abstract_resetcount(Counter) -> [abstract_apply(gr_counter, reset_counters, [abstract_apply(table, [?erl:atom(counters)]), ?erl:abstract(Counter)])]. %% abstract code util functions %% @private Compile an abstract module. -spec compile_forms(term(), [term()]) -> {ok, atom(), binary()}. compile_forms(Forms, Opts) -> case compile:forms(Forms, Opts) of {ok, Module, Binary} -> {ok, Module, Binary}; {ok, Module, Binary, _Warnings} -> {ok, Module, Binary}; Error -> erlang:error({compile_forms, Error}) end. %% @private Load a module binary. -spec load_binary(atom(), binary()) -> {ok, loaded, atom()}. load_binary(Module, Binary) -> case code:load_binary(Module, "", Binary) of {module, Module} -> {ok, loaded, Module}; {error, Reason} -> exit({error_loading_module, Module, Reason}) end. %% @private Apply an exported function. -spec abstract_apply(atom(), atom(), [syntaxTree()]) -> syntaxTree(). abstract_apply(Module, Function, Arguments) -> ?erl:application(?erl:atom(Module), ?erl:atom(Function), Arguments). %% @private Apply a module local function. -spec abstract_apply(atom(), [syntaxTree()]) -> syntaxTree(). abstract_apply(Function, Arguments) -> ?erl:application(?erl:atom(Function), Arguments). goldrush-0.1.9/src/gr_counter_sup.erl0000644000232200023220000000321112721424410020241 0ustar debalancedebalance%% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -module(gr_counter_sup). -behaviour(supervisor). -type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). -type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. %% API -export([start_link/0]). %% Supervisor callbacks -export([init/1]). %% =================================================================== %% API functions %% =================================================================== %% @hidden -spec start_link() -> startlink_ret(). start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). %% =================================================================== %% Supervisor callbacks %% =================================================================== %% @hidden -spec init([]) -> {ok, { {one_for_one, 50, 10}, [supervisor:child_spec()]} }. init(_Args) -> {ok, { {one_for_one, 50, 10}, []} }. goldrush-0.1.9/src/gr_manager_sup.erl0000644000232200023220000000372712721424410020210 0ustar debalancedebalance%% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Table manager supervisor for all goldrush ets process tables. %% %% Manager supervisor responsible for the {@link gr_manager:start_link/3. %% Manager} processes, which serve as heir of the %% {@link gr_counter:start_link/0. Counter} and %% {@link gr_param:start_link/0. Param} ets table processes. -module(gr_manager_sup). -behaviour(supervisor). -type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). -type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. %% API -export([start_link/0]). %% Supervisor callbacks -export([init/1]). %% =================================================================== %% API functions %% =================================================================== %% @hidden -spec start_link() -> startlink_ret(). start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). %% =================================================================== %% Supervisor callbacks %% =================================================================== %% @hidden -spec init([]) -> {ok, { {one_for_one, 50, 10}, [supervisor:child_spec()]} }. init(_Args) -> {ok, { {one_for_one, 50, 10}, []} }. goldrush-0.1.9/src/glc.erl0000644000232200023220000012733212721424410015763 0ustar debalancedebalance%% Copyright (c) 2012, Magnus Klaar %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Event filter implementation. %% %% An event query is constructed using the built in operators exported from %% this module. The filtering operators are used to specify which events %% should be included in the output of the query. The default output action %% is to copy all events matching the input filters associated with a query %% to the output. This makes it possible to construct and compose multiple %% queries at runtime. %% %% === Examples of built in filters === %% ``` %% %% Select all events where 'a' exists and is greater than 0. %% glc:gt(a, 0). %% %% Select all events where 'a' exists and is equal to 0. %% glc:eq(a, 0). %% %% Select all events where 'a' exists and is not equal to 0. %% glc:neq(a, 0). %% %% Select all events where 'a' exists and is less than 0. %% glc:lt(a, 0). %% %% Select all events where 'a' exists and is anything. %% glc:wc(a). %% %% %% Select no input events. Used as black hole query. %% glc:null(false). %% %% Select all input events. Used as passthrough query. %% glc:null(true). %% ''' %% %% === Examples of combining filters === %% ``` %% %% Select all events where both 'a' and 'b' exists and are greater than 0. %% glc:all([glc:gt(a, 0), glc:gt(b, 0)]). %% %% Select all events where 'a' or 'b' exists and are greater than 0. %% glc:any([glc:gt(a, 0), glc:gt(b, 0)]). %% ''' %% %% === Handling output events === %% %% Once a query has been composed it is possible to override the output action %% with an erlang function. The function will be applied to each output event %% from the query. The return value from the function will be ignored. %% %% ``` %% %% Write all input events as info reports to the error logger. %% glc:with(glc:null(true), fun(E) -> %% error_logger:info_report(gre:pairs(E)) end). %% ''' %% -module(glc). -export([ compile/2, compile/3, compile/4, handle/2, get/2, delete/1, reset_counters/1, reset_counters/2, start/0 ]). -export([ lt/2, lte/2, eq/2, neq/2, gt/2, gte/2, wc/1, nf/1 ]). -export([ all/1, any/1, null/1, with/2, run/3 ]). -export([ info/1, input/1, output/1, job_input/1, job_run/1, job_error/1, job_time/1, filter/1, union/1 ]). -record(module, { 'query' :: term(), tables :: [{atom(), atom()}], qtree :: term(), store :: term() }). -spec lt(atom(), term()) -> glc_ops:op(). lt(Key, Term) -> glc_ops:lt(Key, Term). -spec lte(atom(), term()) -> glc_ops:op(). lte(Key, Term) -> glc_ops:lte(Key, Term). -spec eq(atom(), term()) -> glc_ops:op(). eq(Key, Term) -> glc_ops:eq(Key, Term). -spec neq(atom(), term()) -> glc_ops:op(). neq(Key, Term) -> glc_ops:neq(Key, Term). -spec gt(atom(), term()) -> glc_ops:op(). gt(Key, Term) -> glc_ops:gt(Key, Term). -spec gte(atom(), term()) -> glc_ops:op(). gte(Key, Term) -> glc_ops:gte(Key, Term). -spec wc(atom()) -> glc_ops:op(). wc(Key) -> glc_ops:wc(Key). -spec nf(atom()) -> glc_ops:op(). nf(Key) -> glc_ops:nf(Key). %% @doc Filter the input using multiple filters. %% %% For an input to be considered valid output the all filters specified %% in the list must hold for the input event. The list is expected to %% be a non-empty list. If the list of filters is an empty list a `badarg' %% error will be thrown. -spec all([glc_ops:op()]) -> glc_ops:op(). all(Filters) -> glc_ops:all(Filters). %% @doc Filter the input using one of multiple filters. %% %% For an input to be considered valid output on of the filters specified %% in the list must hold for the input event. The list is expected to be %% a non-empty list. If the list of filters is an empty list a `badarg' %% error will be thrown. -spec any([glc_ops:op()]) -> glc_ops:op(). any(Filters) -> glc_ops:any(Filters). %% @doc Always return `true' or `false'. -spec null(boolean()) -> glc_ops:op(). null(Result) -> glc_ops:null(Result). %% @doc Apply a function to each output of a query. %% %% Updating the output action of a query finalizes it. Attempting %% to use a finalized query to construct a new query will result %% in a `badarg' error. -spec with(glc_ops:op(), fun((gre:event()) -> term())) -> glc_ops:op(). with(Query, Action) -> glc_ops:with(Query, Action). %% @doc Return a union of multiple queries. %% %% The union of multiple queries is the equivalent of executing multiple %% queries separately on the same input event. The advantage is that filter %% conditions that are common to all or some of the queries only need to %% be tested once. %% %% All queries are expected to be valid and have an output action other %% than the default which is `output'. If these expectations don't hold %% a `badarg' error will be thrown. -spec union([glc_ops:op()]) -> glc_ops:op(). union(Queries) -> glc_ops:union(Queries). %% @doc Compile a query to a module. %% %% On success the module representing the query is returned. The module and %% data associated with the query must be released using the {@link delete/1} %% function. The name of the query module is expected to be unique. %% The counters are reset by default, unless Reset is set to false -spec compile(atom(), glc_ops:op() | [glc_ops:op()]) -> {ok, atom()}. compile(Module, Query) -> compile(Module, Query, undefined, true). -spec compile(atom(), glc_ops:op() | [glc_ops:op()], boolean()) -> {ok, atom()}. compile(Module, Query, Reset) when is_boolean(Reset) -> compile(Module, Query, undefined, Reset); compile(Module, Query, undefined) -> compile(Module, Query, undefined, true); compile(Module, Query, Store) when is_list(Store) -> compile(Module, Query, Store, true). compile(Module, Query, Store, Reset) -> {ok, ModuleData} = module_data(Module, Query, Store), case glc_code:compile(Module, ModuleData) of {ok, Module} when Reset -> reset_counters(Module), {ok, Module}; {ok, Module} -> {ok, Module} end. %% @doc Handle an event using a compiled query. %% %% The input event is expected to have been returned from {@link gre:make/2}. -spec handle(atom(), list({atom(), term()}) | gre:event()) -> ok. handle(Module, Event) when is_list(Event) -> Module:handle(gre:make(Event, [list])); handle(Module, Event) -> Module:handle(Event). get(Module, Key) -> Module:get(Key). run(Module, Fun, Event) when is_list(Event) -> Module:runjob(Fun, gre:make(Event, [list])); run(Module, Fun, Event) -> Module:runjob(Fun, Event). info(Module) -> Counters = [input, filter, output, job_input, job_run, job_time, job_error], [ {C, Module:info(C)} || C <- ['query' | Counters] ]. %% @doc The number of input events for this query module. -spec input(atom()) -> non_neg_integer(). input(Module) -> Module:info(input). %% @doc The number of output events for this query module. -spec output(atom()) -> non_neg_integer(). output(Module) -> Module:info(output). %% @doc The number of filtered events for this query module. -spec filter(atom()) -> non_neg_integer(). filter(Module) -> Module:info(filter). %% @doc The number of job runs for this query module. -spec job_run(atom()) -> non_neg_integer(). job_run(Module) -> Module:info(job_run). %% @doc The number of job errors for this query module. -spec job_error(atom()) -> non_neg_integer(). job_error(Module) -> Module:info(job_error). %% @doc The number of job inputs for this query module. -spec job_input(atom()) -> non_neg_integer(). job_input(Module) -> Module:info(job_input). %% @doc The amount of time jobs took for this query module. -spec job_time(atom()) -> non_neg_integer(). job_time(Module) -> Module:info(job_time). %% @doc Release a compiled query. %% %% This releases all resources allocated by a compiled query. The query name %% is expected to be associated with an existing query module. Calling this %% function will shutdown all relevant processes and purge/delete the module. -spec delete(atom()) -> ok. delete(Module) -> Params = params_name(Module), Counts = counts_name(Module), ManageParams = manage_params_name(Module), ManageCounts = manage_counts_name(Module), _ = [ begin ok = supervisor:terminate_child(Sup, Name), ok = supervisor:delete_child(Sup, Name) end || {Sup, Name} <- [{gr_manager_sup, ManageParams}, {gr_manager_sup, ManageCounts}, {gr_param_sup, Params}, {gr_counter_sup, Counts}] ], code:soft_purge(Module), code:delete(Module), ok. %% @doc Reset all counters %% %% This resets all the counters associated with a module -spec reset_counters(atom()) -> ok. reset_counters(Module) -> Module:reset_counters(all). %% @doc Reset a specific counter %% %% This resets a specific counter associated with a module -spec reset_counters(atom(), atom()) -> ok. reset_counters(Module, Counter) -> Module:reset_counters(Counter). %% @private Map a query to a module data term. -spec module_data(atom(), term(), term()) -> {ok, #module{}}. module_data(Module, Query, Store) -> %% terms in the query which are not valid arguments to the %% erl_syntax:abstract/1 functions are stored in ETS. %% the terms are only looked up once they are necessary to %% continue evaluation of the query. %% query counters are stored in a shared ETS table. this should %% be an optional feature. enabled by defaults to simplify tests. %% the abstract_tables/1 function expects a list of name-atom pairs. %% tables are referred to by name in the generated code. the table/1 %% function maps names to registered processes response for those tables. Tables = module_tables(Module), Query2 = glc_lib:reduce(Query), {ok, #module{'query'=Query, tables=Tables, qtree=Query2, store=Store}}. %% @private Create a data managed supervised process for params, counter tables module_tables(Module) -> Params = params_name(Module), Counts = counts_name(Module), ManageParams = manage_params_name(Module), ManageCounts = manage_counts_name(Module), Counters = [{input,0}, {filter,0}, {output,0}, {job_input, 0}, {job_run,0}, {job_time, 0}, {job_error, 0}], _ = supervisor:start_child(gr_param_sup, {Params, {gr_param, start_link, [Params]}, transient, brutal_kill, worker, [Params]}), _ = supervisor:start_child(gr_counter_sup, {Counts, {gr_counter, start_link, [Counts]}, transient, brutal_kill, worker, [Counts]}), _ = supervisor:start_child(gr_manager_sup, {ManageParams, {gr_manager, start_link, [ManageParams, Params, []]}, transient, brutal_kill, worker, [ManageParams]}), _ = supervisor:start_child(gr_manager_sup, {ManageCounts, {gr_manager, start_link, [ManageCounts, Counts, Counters]}, transient, brutal_kill, worker, [ManageCounts]}), [{params,Params}, {counters, Counts}]. reg_name(Module, Name) -> list_to_atom("gr_" ++ atom_to_list(Module) ++ Name). params_name(Module) -> reg_name(Module, "_params"). counts_name(Module) -> reg_name(Module, "_counters"). manage_params_name(Module) -> reg_name(Module, "_params_mgr"). manage_counts_name(Module) -> reg_name(Module, "_counters_mgr"). start() -> ok = application:start(syntax_tools), ok = application:start(compiler), ok = application:start(goldrush). %% @todo Move comment. %% @private Map a query to a simplified query tree term. %% %% The simplified query tree is used to combine multiple queries into one %% query module. The goal of this is to reduce the filtering and dispatch %% overhead when multiple concurrent queries are executed. %% %% A fixed selection condition may be used to specify a property that an event %% must have in order to be considered part of the input stream for a query. %% %% For the sake of simplicity it is only possible to define selection %% conditions using the fields present in the context and identifiers %% of an event. The fields in the context are bound to the reserved %% names: %% %% - '$n': node name %% - '$a': application name %% - '$p': process identifier %% - '$t': timestamp %% %% %% If an event must be selected based on the runtime state of an event handler %% this must be done in the body of the handler. -ifdef(TEST). -include_lib("eunit/include/eunit.hrl"). setup_query(Module, Query) -> setup_query(Module, Query, undefined). setup_query(Module, Query, Store) -> ?assertNot(erlang:module_loaded(Module)), ?assertEqual({ok, Module}, case (catch compile(Module, Query, Store)) of {'EXIT',_}=Error -> ?debugFmt("~p", [Error]), Error; Else -> Else end), ?assert(erlang:function_exported(Module, table, 1)), ?assert(erlang:function_exported(Module, handle, 1)), {compiled, Module}. events_test_() -> {foreach, fun() -> error_logger:tty(false), application:start(syntax_tools), application:start(compiler), application:start(goldrush) end, fun(_) -> application:stop(goldrush), application:stop(compiler), application:stop(syntax_tools), error_logger:tty(true) end, [ {"null query compiles", fun() -> {compiled, Mod} = setup_query(testmod1, glc:null(false)), ?assertError(badarg, Mod:table(noexists)) end }, {"params table exists", fun() -> {compiled, Mod} = setup_query(testmod2, glc:null(false)), ?assert(is_atom(Mod:table(params))), ?assertMatch([_|_], gr_param:info(Mod:table(params))) end }, {"null query exists", fun() -> {compiled, Mod} = setup_query(testmod3, glc:null(false)), ?assert(erlang:function_exported(Mod, info, 1)), ?assertError(badarg, Mod:info(invalid)), ?assertEqual({null, false}, Mod:info('query')) end }, {"init counters test", fun() -> {compiled, Mod} = setup_query(testmod4, glc:null(false)), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(0, Mod:info(output)) end }, {"filtered events test", fun() -> %% If no selection condition is specified no inputs can match. {compiled, Mod} = setup_query(testmod5, glc:null(false)), glc:handle(Mod, gre:make([], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(0, Mod:info(output)) end }, {"nomatch event test", fun() -> %% If a selection condition but no body is specified the event %% is expected to count as filtered out if the condition does %% not hold. {compiled, Mod} = setup_query(testmod6, glc:eq('$n', 'noexists@nohost')), glc:handle(Mod, gre:make([{'$n', 'noexists2@nohost'}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(0, Mod:info(output)) end }, {"opfilter equal test", fun() -> %% If a selection condition but no body is specified the event %% counts as input to the query, but not as filtered out. {compiled, Mod} = setup_query(testmod7a, glc:eq('$n', 'noexists@nohost')), glc:handle(Mod, gre:make([{'$n', 'noexists@nohost'}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"opfilter not equal test", fun() -> {compiled, Mod} = setup_query(testmod7b, glc:neq('$n', 'noexists@nohost')), glc:handle(Mod, gre:make([{'$n', 'noexists@nohost'}], [list])), glc:handle(Mod, gre:make([{'$n', 'notexists@nohost'}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"opfilter wildcard test", fun() -> {compiled, Mod} = setup_query(testmod8, glc:wc(a)), glc:handle(Mod, gre:make([{b, 2}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(0, Mod:info(output)), glc:handle(Mod, gre:make([{a, 2}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"opfilter notfound test", fun() -> {compiled, Mod} = setup_query(testmod9, glc:nf(a)), glc:handle(Mod, gre:make([{a, 2}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(0, Mod:info(output)), glc:handle(Mod, gre:make([{b, 2}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"opfilter greater than test", fun() -> {compiled, Mod} = setup_query(testmod10a, glc:gt(a, 1)), glc:handle(Mod, gre:make([{'a', 2}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 0}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"opfilter greater than or equal to test", fun() -> {compiled, Mod} = setup_query(testmod10b, glc:gte(a, 1)), glc:handle(Mod, gre:make([{'a', 2}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 0}], [list])), ?assertEqual(3, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(2, Mod:info(output)) end }, {"opfilter less than test", fun() -> {compiled, Mod} = setup_query(testmod11a, glc:lt(a, 1)), glc:handle(Mod, gre:make([{'a', 0}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(1, Mod:info(output)), glc:handle(Mod, gre:make([{'a', 2}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"opfilter less than or equal to test", fun() -> {compiled, Mod} = setup_query(testmod11b, glc:lte(a, 1)), glc:handle(Mod, gre:make([{'a', 0}], [list])), ?assertEqual(1, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(1, Mod:info(output)), glc:handle(Mod, gre:make([{'a', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(2, Mod:info(output)), glc:handle(Mod, gre:make([{'a', 2}], [list])), ?assertEqual(3, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(2, Mod:info(output)) end }, {"allholds op test", fun() -> {compiled, Mod} = setup_query(testmod12, glc:all([glc:eq(a, 1), glc:eq(b, 2)])), glc:handle(Mod, gre:make([{'a', 1}], [list])), glc:handle(Mod, gre:make([{'a', 2}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), glc:handle(Mod, gre:make([{'b', 1}], [list])), glc:handle(Mod, gre:make([{'b', 2}], [list])), ?assertEqual(4, Mod:info(input)), ?assertEqual(4, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 1},{'b', 2}], [list])), ?assertEqual(5, Mod:info(input)), ?assertEqual(4, Mod:info(filter)), ?assertEqual(1, Mod:info(output)) end }, {"anyholds op test", fun() -> {compiled, Mod} = setup_query(testmod13, glc:any([glc:eq(a, 1), glc:eq(b, 2)])), glc:handle(Mod, gre:make([{'a', 2}], [list])), glc:handle(Mod, gre:make([{'b', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 1}], [list])), glc:handle(Mod, gre:make([{'b', 2}], [list])), ?assertEqual(4, Mod:info(input)), ?assertEqual(2, Mod:info(filter)) end }, {"with function test", fun() -> Self = self(), {compiled, Mod} = setup_query(testmod14, glc:with(glc:eq(a, 1), fun(Event) -> Self ! gre:fetch(a, Event) end)), glc:handle(Mod, gre:make([{a,1}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(1, receive Msg -> Msg after 0 -> notcalled end) end }, {"with function storage test", fun() -> Self = self(), Store = [{stored, value}], {compiled, Mod} = setup_query(testmod15, glc:with(glc:eq(a, 1), fun(Event, EStore) -> Self ! {gre:fetch(a, Event), EStore} end), Store), glc:handle(Mod, gre:make([{a,1}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(1, receive {Msg, Store} -> Msg after 0 -> notcalled end) end }, {"delete test", fun() -> {compiled, Mod} = setup_query(testmod16, glc:null(false)), ?assert(is_atom(Mod:table(params))), ?assertMatch([_|_], gr_param:info(Mod:table(params))), ?assert(is_list(code:which(Mod))), ?assert(is_pid(whereis(params_name(Mod)))), ?assert(is_pid(whereis(counts_name(Mod)))), ?assert(is_pid(whereis(manage_params_name(Mod)))), ?assert(is_pid(whereis(manage_counts_name(Mod)))), glc:delete(Mod), ?assertEqual(non_existing, code:which(Mod)), ?assertEqual(undefined, whereis(params_name(Mod))), ?assertEqual(undefined, whereis(counts_name(Mod))), ?assertEqual(undefined, whereis(manage_params_name(Mod))), ?assertEqual(undefined, whereis(manage_counts_name(Mod))) end }, {"reset counters test", fun() -> {compiled, Mod} = setup_query(testmod17, glc:any([glc:eq(a, 1), glc:eq(b, 2)])), glc:handle(Mod, gre:make([{'a', 2}], [list])), glc:handle(Mod, gre:make([{'b', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 1}], [list])), glc:handle(Mod, gre:make([{'b', 2}], [list])), ?assertEqual(4, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), ?assertEqual(2, Mod:info(output)), glc:reset_counters(Mod, input), ?assertEqual(0, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), ?assertEqual(2, Mod:info(output)), glc:reset_counters(Mod, filter), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(2, Mod:info(output)), glc:reset_counters(Mod), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(0, Mod:info(output)) end }, {"ets data recovery test", fun() -> Self = self(), {compiled, Mod} = setup_query(testmod18, glc:with(glc:eq(a, 1), fun(Event) -> Self ! gre:fetch(a, Event) end)), glc:handle(Mod, gre:make([{a,1}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(1, receive Msg -> Msg after 0 -> notcalled end), ?assertEqual(1, length(gr_param:list(Mod:table(params)))), ?assertEqual(7, length(gr_param:list(Mod:table(counters)))), true = exit(whereis(Mod:table(params)), kill), true = exit(whereis(Mod:table(counters)), kill), ?assertEqual(1, Mod:info(input)), glc:handle(Mod, gre:make([{'a', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(2, Mod:info(output)), ?assertEqual(1, length(gr_param:list(Mod:table(params)))), ?assertEqual(7, length(gr_counter:list(Mod:table(counters)))) end }, {"run timed job test", fun() -> Self = self(), Store = [{stored, value}], Runtime = 0.15, {compiled, Mod} = setup_query(testmod19, glc:gt(runtime, Runtime), Store), glc:run(Mod, fun(Event, EStore) -> timer:sleep(100), Self ! {gre:fetch(a, Event), EStore} end, gre:make([{a,1}], [list])), ?assertEqual(0, Mod:info(output)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, receive {Msg, Store} -> Msg after 0 -> notcalled end), delete(testmod19), {compiled, Mod} = setup_query(testmod19, glc:gt(runtime, Runtime), Store), glc:handle(Mod, gre:make([{'a', 1}], [list])), glc:run(Mod, fun(Event, EStore) -> timer:sleep(200), Self ! {gre:fetch(a, Event), EStore} end, gre:make([{a,2}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(2, receive {Msg, Store} -> Msg after 0 -> notcalled end) end }, {"reset job counters", fun() -> {compiled, Mod} = setup_query(testmod20, glc:any([glc:eq(a, 1), glc:gt(runtime, 0.15)])), glc:handle(Mod, gre:make([{'a', 2}], [list])), glc:handle(Mod, gre:make([{'b', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), glc:handle(Mod, gre:make([{'a', 1}], [list])), glc:handle(Mod, gre:make([{'b', 2}], [list])), ?assertEqual(4, Mod:info(input)), ?assertEqual(3, Mod:info(filter)), ?assertEqual(1, Mod:info(output)), Self = self(), glc:run(Mod, fun(Event, EStore) -> timer:sleep(100), Self ! {gre:fetch(a, Event), EStore} end, gre:make([{a,1}], [list])), ?assertEqual(2, Mod:info(output)), ?assertEqual(3, Mod:info(filter)), ?assertEqual(1, receive {Msg, undefined} -> Msg after 0 -> notcalled end), {_, Msg1} = glc:run(Mod, fun(_Event, _EStore) -> timer:sleep(200), {error, badtest} end, gre:make([{a,1}], [list])), ?assertEqual(3, Mod:info(output)), ?assertEqual(3, Mod:info(filter)), ?assertEqual(2, Mod:info(job_input)), ?assertEqual(1, Mod:info(job_error)), ?assertEqual(1, Mod:info(job_run)), ?assertEqual({error, badtest}, Msg1), {_, Msg2} = glc:run(Mod, fun(_Event, _EStore) -> timer:sleep(20), {ok, goodtest} end, gre:make([{a,2}], [list])), ?assertEqual(3, Mod:info(output)), ?assertEqual(4, Mod:info(filter)), ?assertEqual(3, Mod:info(job_input)), ?assertEqual(1, Mod:info(job_error)), ?assertEqual(2, Mod:info(job_run)), ?assertEqual({ok, goodtest}, Msg2), glc:reset_counters(Mod, input), ?assertEqual(0, Mod:info(input)), ?assertEqual(4, Mod:info(filter)), ?assertEqual(3, Mod:info(output)), ?assertEqual(3, Mod:info(job_input)), ?assertEqual(1, Mod:info(job_error)), ?assertEqual(2, Mod:info(job_run)), glc:reset_counters(Mod, filter), ?assertEqual(0, glc:input(Mod)), ?assertEqual(0, glc:filter(Mod)), ?assertEqual(3, glc:output(Mod)), ?assertEqual(3, glc:job_input(Mod)), ?assertEqual(1, glc:job_error(Mod)), ?assertEqual(2, glc:job_run(Mod)), glc:reset_counters(Mod, output), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(0, Mod:info(output)), ?assertEqual(3, Mod:info(job_input)), ?assertEqual(1, Mod:info(job_error)), ?assertEqual(2, Mod:info(job_run)), glc:reset_counters(Mod, job_input), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(0, Mod:info(output)), ?assertEqual(0, Mod:info(job_input)), ?assertEqual(1, Mod:info(job_error)), ?assertEqual(2, Mod:info(job_run)), glc:reset_counters(Mod, job_error), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(0, Mod:info(output)), ?assertEqual(0, Mod:info(job_input)), ?assertEqual(0, Mod:info(job_error)), ?assertEqual(2, Mod:info(job_run)), glc:reset_counters(Mod, job_run), ?assertEqual(0, Mod:info(input)), ?assertEqual(0, Mod:info(filter)), ?assertEqual(0, Mod:info(output)), ?assertEqual(0, Mod:info(job_input)), ?assertEqual(0, Mod:info(job_error)), ?assertEqual(0, Mod:info(job_run)) end }, {"variable storage test", fun() -> {compiled, Mod} = setup_query(testmod20a, glc:eq(a, 2), [{stream, time}]), glc:handle(Mod, gre:make([{'a', 2}], [list])), glc:handle(Mod, gre:make([{'b', 1}], [list])), ?assertEqual(2, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), glc:handle(Mod, gre:make([{'b', 2}], [list])), ?assertEqual(3, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), ?assertEqual({ok, time}, glc:get(Mod, stream)), ?assertEqual({error, undefined}, glc:get(Mod, beam)) end }, {"with multi function any test", fun() -> Self = self(), Store = [{stored, value}], G1 = glc:with(glc:eq(a, 1), fun(_Event, EStore) -> Self ! {a, EStore} end), G2 = glc:with(glc:eq(b, 2), fun(_Event, EStore) -> Self ! {b, EStore} end), {compiled, Mod} = setup_query(testmod20b, any([G1, G2]), Store), glc:handle(Mod, gre:make([{a,1}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(a, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(b, receive {Msg, _Store} -> Msg after 0 -> notcalled end) end }, {"with multi function all test", fun() -> Self = self(), Store = [{stored, value}], G1 = glc:with(glc:eq(a, 1), fun(_Event, EStore) -> Self ! {a, EStore} end), G2 = glc:with(glc:eq(b, 2), fun(_Event, EStore) -> Self ! {b, EStore} end), G3 = glc:with(glc:eq(c, 3), fun(_Event, EStore) -> Self ! {c, EStore} end), {compiled, Mod} = setup_query(testmod21, all([G1, G2, G3]), Store), glc:handle(Mod, gre:make([{a,1}], [list])), ?assertEqual(0, Mod:info(output)), ?assertEqual(1, Mod:info(filter)), glc:handle(Mod, gre:make([{a,1}, {b, 2}], [list])), ?assertEqual(0, Mod:info(output)), ?assertEqual(2, Mod:info(filter)), glc:handle(Mod, gre:make([{a,1}, {b, 2}, {c, 3}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(a, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(b, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(c, receive {Msg, _Store} -> Msg after 0 -> notcalled end) end }, {"with multi-function output match test", fun() -> Self = self(), Store = [{stored, value}], {compiled, Mod} = setup_query(testmod22, [glc:with(glc:eq(a, 1), fun(Event, _EStore) -> Self ! {a, gre:fetch(a, Event)} end), glc:with(glc:gt(b, 1), fun(Event, _EStore) -> Self ! {b, gre:fetch(b, Event)} end)], Store), glc:handle(Mod, gre:make([{a,1}, {b, 1}], [list])), ?assertEqual(1, Mod:info(output)), ?assertEqual(a, receive {a=Msg, _Store} -> Msg after 0 -> notcalled end) end }, {"with multi-function output double-match test", fun() -> Self = self(), Store = [{stored, value}], {compiled, Mod} = setup_query(testmod23, [glc:with(glc:eq(a, 1), fun(Event, _EStore) -> Self ! {a, gre:fetch(a, Event)} end), glc:with(glc:eq(b, 1), fun(Event, _EStore) -> Self ! {b, gre:fetch(b, Event)} end)], Store), glc:handle(Mod, gre:make([{a,1}, {b, 1}], [list])), ?assertEqual(2, Mod:info(output)), ?assertEqual(a, receive {a=Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(b, receive {b=Msg, _Store} -> Msg after 0 -> notcalled end) end }, {"with multi function complex match test", fun() -> Self = self(), Store = [{stored, value}], G1 = glc:with(glc:gt(r, 0.1), fun(_Event, EStore) -> Self ! {a, EStore} end), G2 = glc:with(glc:all([glc:eq(a, 1), glc:gt(r, 0.5)]), fun(_Event, EStore) -> Self ! {b, EStore} end), G3 = glc:with(glc:all([glc:eq(a, 1), glc:eq(b, 2), glc:gt(r, 0.6)]), fun(_Event, EStore) -> Self ! {c, EStore} end), {compiled, Mod} = setup_query(testmod24, [G1, G2, G3], Store), glc:handle(Mod, gre:make([{a,1}, {r, 0.7}, {b, 3}], [list])), ?assertEqual(2, Mod:info(output)), ?assertEqual(1, Mod:info(input)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(a, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(b, receive {Msg, _Store} -> Msg after 0 -> notcalled end), % glc:handle(Mod, gre:make([{a,1}, {r, 0.6}], [list])), ?assertEqual(4, Mod:info(output)), ?assertEqual(2, Mod:info(input)), ?assertEqual(2, Mod:info(filter)), ?assertEqual(a, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(b, receive {Msg, _Store} -> Msg after 0 -> notcalled end), % glc:handle(Mod, gre:make([{a,2}, {r, 0.7}, {b, 3}], [list])), ?assertEqual(5, Mod:info(output)), ?assertEqual(3, Mod:info(input)), ?assertEqual(4, Mod:info(filter)), ?assertEqual(a, receive {Msg, _Store} -> Msg after 0 -> notcalled end), glc:handle(Mod, gre:make([{a,1}, {r, 0.7}, {b, 2}], [list])), ?assertEqual(8, Mod:info(output)), ?assertEqual(4, Mod:info(input)), ?assertEqual(4, Mod:info(filter)), ?assertEqual(a, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(b, receive {Msg, _Store} -> Msg after 0 -> notcalled end), ?assertEqual(c, receive {Msg, _Store} -> Msg after 0 -> notcalled end) end }, {"with single-function run test", fun() -> Self = self(), Store = [{stored, value}], {compiled, Mod1} = setup_query(testmod25a, glc:with(glc:all([glc:gt(runtime, 0.15), glc:lt(a, 3)]), fun(Event, EStore) -> Self ! {gre:fetch(a, Event), EStore} end), Store), glc:run(Mod1, fun(_Event, _EStore) -> timer:sleep(200), ok end, gre:make([{a, 2}], [list])), ?assertEqual(1, Mod1:info(output)), ?assertEqual(2, receive {Msg, Store} -> Msg after 250 -> notcalled end), {compiled, Mod2} = setup_query(testmod25b, glc:with(glc:all([glc:gt(runtime, 0.15), glc:lt(a, 3)]), fun(Event, EStore) -> Self ! {gre:fetch(a, Event), EStore} end), Store), {_, {error, later}} = glc:run(Mod2, fun(_Event, _EStore) -> timer:sleep(200), erlang:exit(later) end, gre:make([{a, 2}], [list])), ?assertEqual(1, Mod2:info(output)), ?assertEqual(1, Mod2:info(job_error)), ?assertEqual(2, receive {Msg, Store} -> Msg after 250 -> notcalled end) end }, {"with multi-function output run error test", fun() -> Self = self(), Store = [{stored, value}], {compiled, Mod} = setup_query(testmod26, [glc:with(glc:gt(runtime, 0.15), fun(Event, _EStore) -> Self ! {a, gre:fetch(b, Event)} end), glc:with(glc:eq(c, 3), fun(Event, _EStore) -> Self ! {a, gre:fetch(a, Event)} end), glc:with(glc:eq(b, 3), fun(Event, _EStore) -> Self ! {a, gre:fetch(a, Event)} end), glc:with(glc:eq(a, 1), fun(Event, _EStore) -> receive {a, _Store} -> Self ! {b, gre:fetch(b, Event)} after 10 -> notcalled end end) ], Store), Event = gre:make([{a,1}, {b, 3}, {c, 4}], [list]), {_, {error, bye}} = glc:run(Mod, fun(_Event, _EStore) -> timer:sleep(200), erlang:error(bye) end, Event), ?assertEqual(3, Mod:info(output)), ?assertEqual(1, Mod:info(filter)), ?assertEqual(1, Mod:info(job_error)), ?assertEqual(b, receive {b=Msg, _Store} -> Msg after 0 -> notcalled end) end } ] }. union_error_test() -> ?assertError(badarg, glc:union([glc:eq(a, 1)])), done. -endif. goldrush-0.1.9/src/gr_sup.erl0000644000232200023220000000351712721424410016513 0ustar debalancedebalance%% Copyright (c) 2012, Magnus Klaar %% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Top level supervisor for goldrush. %% %% Main supervisor responsible for the {@link gr_counter_sup:start_link/0. %% Counter}, {@link gr_param_sup:start_link/0. Param} and %% their {@link gr_manager_sup:start_link/0. Manager} supervisors. -module(gr_sup). -behaviour(supervisor). -type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). -type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. -export([start_link/0]). -export([init/1]). -define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 5000, Type, [I]}). -spec start_link() -> startlink_ret(). start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). -spec init([]) -> {ok, { {one_for_one, 50, 10}, [supervisor:child_spec()]} }. init([]) -> CounterSup = ?CHILD(gr_counter_sup, supervisor), ParamSup = ?CHILD(gr_param_sup, supervisor), MgrSup = ?CHILD(gr_manager_sup, supervisor), {ok, {{one_for_one, 50, 10}, [CounterSup, ParamSup, MgrSup]}}. goldrush-0.1.9/src/gre.erl0000644000232200023220000000626512721424410015774 0ustar debalancedebalance%% Copyright (c) 2012, Magnus Klaar %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Accessor function for goldrush event terms. -module(gre). -export([ make/2, has/2, fetch/2, append/2, merge/2, find/2, keys/1, pairs/1 ]). -type event() :: {list, [{atom(), term()}]}. -export_type([event/0]). %% @doc Construct an event term. -spec make(term(), [list]) -> event(). make(Term, [Type]) -> {Type, Term}. %% @doc Check if a field exists in an event. -spec has(atom(), event()) -> boolean(). has(Key, {list, List}) -> lists:keymember(Key, 1, List). -spec append(term(), event()) -> event(). append(KeyVal, {list, List}) -> {list, [KeyVal|List]}. -spec merge(event(), event()) -> event(). merge({list, AList}, {list, BList}) -> {list, lists:merge(AList, BList)}. %% @doc Get the value of a field in an event. %% The field is expected to exist in the event. -spec fetch(atom(), event()) -> term(). fetch(Key, {list, List}=Event) -> case lists:keyfind(Key, 1, List) of {_, Value} -> Value; false -> erlang:error(badarg, [Key, Event]) end. %% @doc Find the value of a field in an event. %% This is equivalent to testing if a field exists using {@link has/2} %% before accessing the value of the field using {@link fetch/2}. -spec find(atom(), event()) -> {true, term()} | false. find(Key, {list, List}) -> case lists:keyfind(Key, 1, List) of {_, Value} -> {true, Value}; false -> false end. %% @doc Get the names of all fields in an event. -spec keys(event()) -> [atom()]. keys({list, List}) -> kv_keys_(List). %% @private Get the names of all fields in a key-value list. -spec kv_keys_([{atom(), term()}]) -> [atom()]. kv_keys_([{Key, _}|T]) -> [Key|kv_keys_(T)]; kv_keys_([]) -> []. %% @doc Get the name and value of all fields in an event. -spec pairs(event()) -> [{atom(), term()}]. pairs({list, List}) -> lists:sort(List). -ifdef(TEST). -include_lib("eunit/include/eunit.hrl"). gre_test_() -> [?_assert(gre:has(a, gre:make([{a,1}], [list]))), ?_assertNot(gre:has(b, gre:make([{a,1}], [list]))), ?_assertEqual(1, gre:fetch(a, gre:make([{a,1}], [list]))), ?_assertError(badarg, gre:fetch(a, gre:make([], [list]))), ?_assertEqual([], gre:keys(gre:make([], [list]))), ?_assertEqual([a], gre:keys(gre:make([{a,1}], [list]))), ?_assertEqual([a,b], gre:keys(gre:make([{a,1},{b,2}], [list]))), ?_assertEqual([{a,1},{b,2}], gre:pairs(gre:make([{b,2},{a,1}], [list]))) ]. -endif. goldrush-0.1.9/src/gr_param_sup.erl0000644000232200023220000000364512721424410017675 0ustar debalancedebalance%% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Second level supervisor for goldrush. %% %% Supervisor for the {@link gr_param:start_link/0. %% Param}, process table responsible for params %% {@link gr_param:start_link/0. Counter} and %% their {@link gr_counter:start_link/0. Manager} supervisors. -module(gr_param_sup). -behaviour(supervisor). -type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). -type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. %% API -export([start_link/0]). %% Supervisor callbacks -export([init/1]). %% =================================================================== %% API functions %% =================================================================== %% @hidden -spec start_link() -> startlink_ret(). start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). %% =================================================================== %% Supervisor callbacks %% =================================================================== %% @hidden -spec init([]) -> {ok, { {one_for_one, 50, 10}, [supervisor:child_spec()]} }. init(_Args) -> {ok, { {one_for_one, 50, 10}, []} }. goldrush-0.1.9/src/goldrush.app.src0000644000232200023220000000034112721424410017617 0ustar debalancedebalance{application, goldrush, [ {description, "Erlang event stream processor"}, {vsn, "0.1.8"}, {registered, []}, {applications, [kernel, stdlib, syntax_tools, compiler]}, {mod, {gr_app, []}}, {env, []} ]}. goldrush-0.1.9/src/glc_lib.erl0000644000232200023220000003327412721424410016612 0ustar debalancedebalance%% Copyright (c) 2012, Magnus Klaar %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Query processing functions. -module(glc_lib). -export([ reduce/1, matches/2, onoutput/1, onoutput/2 ]). -ifdef(TEST). -include_lib("eunit/include/eunit.hrl"). -undef(LET). -ifdef(PROPER). -include_lib("proper/include/proper.hrl"). -endif. -endif. %% @doc Return a reduced version of a query. %% %% The purpose of this function is to ensure that a query filter %% is in the simplest possible form. The query filter returned %% from this function is functionally equivalent to the original. reduce(Query) -> repeat(Query, fun(Q0) -> Q1 = repeat(Q0, fun flatten/1), Q2 = required(Q1), Q3 = repeat(Q2, fun flatten/1), Q4 = common(Q3), Q5 = repeat(Q4, fun flatten/1), Q6 = constants(Q5), Q6 end). %% @doc Test if an event matches a query. %% This function is only intended to be used for testing purposes. matches({any, Conds}, Event) -> lists:any(fun(Cond) -> matches(Cond, Event) end, Conds); matches({all, Conds}, Event) -> lists:all(fun(Cond) -> matches(Cond, Event) end, Conds); matches({null, Const}, _Event) -> Const; matches({Key, '<', Term}, Event) -> case gre:find(Key, Event) of {true, Term2} -> Term2 < Term; false -> false end; matches({Key, '=<', Term}, Event) -> case gre:find(Key, Event) of {true, Term2} -> Term2 =< Term; false -> false end; matches({Key, '=', Term}, Event) -> case gre:find(Key, Event) of {true, Term2} -> Term2 =:= Term; false -> false end; matches({Key, '!=', Term}, Event) -> case gre:find(Key, Event) of {true, Term2} -> Term2 =/= Term; false -> false end; matches({Key, '>', Term}, Event) -> case gre:find(Key, Event) of {true, Term2} -> Term2 > Term; false -> false end; matches({Key, '>=', Term}, Event) -> case gre:find(Key, Event) of {true, Term2} -> Term2 >= Term; false -> false end; matches({Key, '*'}, Event) -> case gre:find(Key, Event) of {true, _} -> true; false -> false end; matches({Key, '!'}, Event) -> not matches({Key, '*'}, Event). %% @private Repeatedly apply a function to a query. %% This is used for query transformation functions that must be applied %% multiple times to yield the simplest possible version of a query. repeat(Query, Fun) -> case Fun(Query) of Query -> Query; Query2 -> repeat(Query2, Fun) end. %% @doc Return the output action of a query. -spec onoutput(glc_ops:op()) -> output | no_return(). onoutput({_, '<', _}) -> output; onoutput({_, '=<', _}) -> output; onoutput({_, '=', _}) -> output; onoutput({_, '>', _}) -> output; onoutput({_, '>=', _}) -> output; onoutput({_, '*'}) -> output; onoutput({_, '!'}) -> output; onoutput(Query) -> erlang:error(badarg, [Query]). %% @doc Modify the output action of a query. -spec onoutput(Action :: any(), Query :: glc_ops:op()) -> no_return(). onoutput(Action, Query) -> erlang:error(badarg, [Action, Query]). %% @private Flatten a condition tree. flatten({all, [Cond]}) -> Cond; flatten({any, [Cond]}) -> Cond; flatten({all, Conds}) -> flatten_all([flatten(Cond) || Cond <- Conds]); flatten({any, [_|_]=Conds}) -> flatten_any([flatten(Cond) || Cond <- Conds]); flatten({with, Cond, Action}) -> {with, flatten(Cond), Action}; flatten([{with, _Cond, _Action}|_] = I) -> [{with, flatten(Cond), Action} || {with, Cond, Action} <- I]; flatten(Other) -> valid(Other). %% @private Flatten and remove duplicate members of an "all" filter. flatten_all(Conds) -> {all, lists:usort(flatten_tag(all, Conds))}. %% @private Flatten and remove duplicate members of an "any" filter. flatten_any(Conds) -> {any, lists:usort(flatten_tag(any, Conds))}. %% @private Common function for flattening "all" or "and" filters. flatten_tag(Tag, [{Tag, Conds}|T]) -> Conds ++ flatten_tag(Tag, T); flatten_tag(Tag, [H|T]) -> [H|flatten_tag(Tag, T)]; flatten_tag(_Tag, []) -> []. %% @private Factor out required filters. %% %% Identical conditions may occur in all sub-filters of an "any" filter. These %% filters can be tested once before testing the conditions that are unique to %% each sub-filter. %% %% Assume that the input has been flattened first in order to eliminate all %% occurances of an "any" filters being "sub-filters" of "any" filters. required({any, [H|_]=Conds}) -> Init = ordsets:from_list(case H of {all, Init2} -> Init2; H -> [H] end), case required(Conds, Init) of nonefound -> Conds2 = [required(Cond) || Cond <- Conds], {any, Conds2}; {found, Req} -> Conds2 = [required(deleteall(Cond, Req)) || Cond <- Conds], {all, [{all, Req}, {any, Conds2}]} end; required({all, Conds}) -> {all, [required(Cond) || Cond <- Conds]}; required(Other) -> Other. required([{all, Conds}|T], Acc) -> required(T, ordsets:intersection(ordsets:from_list(Conds), Acc)); required([{any, _}|_]=Cond, Acc) -> erlang:error(badarg, [Cond, Acc]); required([H|T], Acc) -> required(T, ordsets:intersection(ordsets:from_list([H]), Acc)); required([], [_|_]=Req) -> {found, Req}; required([], []) -> nonefound. %% @private Factor our common filters. %% %% Identical conditions may occur in some sub-filters of an "all" filter. These %% filters can be tested once before testing the conditions that are unique to %% each sub-filter. This is different from factoring out common sub-filters %% in an "any" filter where the only those sub-filters that exist in all %% members. %% %% Assume that the input has been flattened first in order to eliminate all %% occurances of an "any" filters being "sub-filters" of "any" filters. common({all, Conds}) -> case common_(Conds, []) of {found, Found} -> {all, [Found|[delete(Cond, Found) || Cond <- Conds]]}; nonefound -> {all, [common(Cond) || Cond <- Conds]} end; common({any, Conds}) -> {any, [common(Cond) || Cond <- Conds]}; common(Other) -> Other. common_([{any, Conds}|T], Seen) -> Set = ordsets:from_list(Conds), case ordsets:intersection(Set, Seen) of [] -> common_(T, ordsets:union(Set, Seen)); [H|_] -> {found, H} end; common_([H|T], Seen) -> case ordsets:is_element(H, Seen) of false -> common_(T, ordsets:union(ordsets:from_list([H]), Seen)); true -> {found, H} end; common_([], _Seen) -> nonefound. %% @private Delete all occurances of constants. %% %% An "all" or "any" filter may be reduced to a constant outcome when all %% sub-filters has been factored out from the filter. In these cases the %% filter can be removed from the query. constants(Query) -> delete(Query, {null, true}). %% @private Delete all occurances of a filter. %% %% Assume that the function is called because a filter is tested %% by a parent filter. It is therefore safe to replace occurances %% with a null filter that always returns true. delete({all, Conds}, Filter) -> {all, [delete(Cond, Filter) || Cond <- Conds, Cond =/= Filter]}; delete({any, Conds}, Filter) -> {any, [delete(Cond, Filter) || Cond <- Conds, Cond =/= Filter]}; delete(Filter, Filter) -> {null, true}; delete(Cond, _Filter) -> Cond. %% @private Delete all occurances of multiple filters. deleteall(Filter, [H|T]) -> deleteall(delete(Filter, H), T); deleteall(Filter, []) -> Filter. %% @private Test if a term is a valid filter. -spec is_valid(glc_ops:op()) -> boolean(). is_valid({Field, '<', _Term}) when is_atom(Field) -> true; is_valid({Field, '=<', _Term}) when is_atom(Field) -> true; is_valid({Field, '=', _Term}) when is_atom(Field) -> true; is_valid({Field, '!=', _Term}) when is_atom(Field) -> true; is_valid({Field, '>=', _Term}) when is_atom(Field) -> true; is_valid({Field, '>', _Term}) when is_atom(Field) -> true; is_valid({Field, '*'}) when is_atom(Field) -> true; is_valid({Field, '!'}) when is_atom(Field) -> true; is_valid({null, true}) -> true; is_valid({null, false}) -> true; is_valid(_Other) -> false. %% @private Assert that a term is a valid filter. %% If the term is a valid filter. The original term will be returned. %% If the term is not a valid filter. A `badarg' error is thrown. valid(Term) -> is_valid(Term) orelse erlang:error(badarg, [Term]), Term. -ifdef(TEST). -include_lib("eunit/include/eunit.hrl"). all_one_test() -> ?assertEqual(glc:eq(a, 1), glc_lib:reduce(glc:all([glc:eq(a, 1)])) ). all_sort_test() -> ?assertEqual(glc:all([glc:eq(a, 1), glc:eq(b, 2)]), glc_lib:reduce(glc:all([glc:eq(b, 2), glc:eq(a, 1)])) ). any_one_test() -> ?assertEqual(glc:eq(a, 1), glc_lib:reduce(glc:any([glc:eq(a, 1)])) ). all_two_test() -> ?assertEqual(glc_lib:reduce(glc:all([glc:wc(a), glc:nf(b)])), glc_lib:reduce(glc:any([ glc:all([glc:wc(a)]), glc:all([glc:wc(a), glc:nf(b)])])) ). any_sort_test() -> ?assertEqual(glc:any([glc:eq(a, 1), glc:eq(b, 2)]), glc_lib:reduce(glc:any([glc:eq(b, 2), glc:eq(a, 1)])) ). all_nest_test() -> ?assertEqual(glc:all([glc:eq(a, 1), glc:eq(b, 2)]), glc_lib:reduce(glc:all([glc:eq(a, 1), glc:all([glc:eq(b, 2)])])) ), ?assertEqual(glc:all([glc:eq(a, 1), glc:eq(b, 2), glc:eq(c, 3)]), glc_lib:reduce(glc:all([glc:eq(c, 3), glc:all([glc:eq(a, 1), glc:all([glc:eq(b, 2)])])])) ). any_nest_test() -> ?assertEqual(glc:any([glc:eq(a, 1), glc:eq(b, 2)]), glc_lib:reduce(glc:any([glc:eq(a, 1), glc:any([glc:eq(b, 2)])])) ), ?assertEqual(glc:any([glc:eq(a, 1), glc:eq(b, 2), glc:eq(c, 3)]), glc_lib:reduce(glc:any([glc:eq(c, 3), glc:any([glc:eq(a, 1), glc:any([glc:eq(b, 2)])])])) ). all_equiv_test() -> ?assertEqual(glc:eq(a, 1), glc_lib:reduce(glc:all([glc:eq(a, 1), glc:eq(a, 1)])) ). any_equiv_test() -> ?assertEqual(glc:eq(a, 1), glc_lib:reduce(glc:any([glc:eq(a, 1), glc:eq(a, 1)])) ). any_required_test() -> ?assertEqual( glc:all([ glc:any([glc:nf(d), glc:eq(b, 2), glc:eq(c, 3)]), glc:eq(a, 1) ]), glc_lib:reduce( glc:any([ glc:all([glc:eq(a, 1), glc:nf(d)]), glc:all([glc:eq(a, 1), glc:eq(b, 2)]), glc:all([glc:eq(a, 1), glc:eq(c, 3)])])) ). all_common_test() -> ?assertEqual( glc:all([glc:eq(a, 1), glc:eq(b, 2), glc:eq(c, 3)]), glc_lib:reduce( glc:all([ glc:any([glc:eq(a, 1), glc:eq(b, 2)]), glc:any([glc:eq(a, 1), glc:eq(c, 3)])])) ). delete_from_all_test() -> ?assertEqual( glc:all([glc:eq(b,2)]), deleteall( glc:all([glc:eq(a, 1),glc:eq(b,2)]), [glc:eq(a, 1), glc:nf(a)]) ). delete_from_any_test() -> ?assertEqual( glc:any([glc:eq(b,2)]), deleteall( glc:any([glc:eq(a, 1),glc:eq(b,2)]), [glc:eq(a, 1), glc:wc(a)]) ). default_is_output_test_() -> [?_assertEqual(output, glc_lib:onoutput(glc:lt(a, 1))), ?_assertEqual(output, glc_lib:onoutput(glc:lte(a, 1))), ?_assertEqual(output, glc_lib:onoutput(glc:eq(a, 1))), ?_assertEqual(output, glc_lib:onoutput(glc:gt(a, 1))), ?_assertEqual(output, glc_lib:onoutput(glc:gte(a, 1))), ?_assertEqual(output, glc_lib:onoutput(glc:wc(a))), ?_assertEqual(output, glc_lib:onoutput(glc:nf(a))) ]. matches_test_() -> Event = gre:make([{a, 2}], [list]), [?_assertEqual(true, glc_lib:matches(glc:lt(a, 3), Event)), ?_assertEqual(true, glc_lib:matches(glc:lte(a, 2), Event)), ?_assertEqual(true, glc_lib:matches(glc:eq(a, 2), Event)), ?_assertEqual(true, glc_lib:matches(glc:gt(a, 1), Event)), ?_assertEqual(true, glc_lib:matches(glc:gte(a, 2), Event)), ?_assertEqual(true, glc_lib:matches(glc:wc(a), Event)), ?_assertEqual(true, glc_lib:matches(glc:nf(b), Event)), ?_assertEqual(false, glc_lib:matches(glc:lt(a, 2), Event)), ?_assertEqual(false, glc_lib:matches(glc:lte(a, 1), Event)), ?_assertEqual(false, glc_lib:matches(glc:eq(a, 3), Event)), ?_assertEqual(false, glc_lib:matches(glc:gt(a, 2), Event)), ?_assertEqual(false, glc_lib:matches(glc:gte(a, 3), Event)), ?_assertEqual(false, glc_lib:matches(glc:wc(b), Event)), ?_assertEqual(false, glc_lib:matches(glc:nf(a), Event)) ]. -ifdef(PROPER). prop_reduce_returns() -> ?FORALL(Query, glc_ops:op(), returns(fun() -> glc_lib:reduce(Query) end)). reduce_returns_test() -> ?assert(proper:quickcheck(prop_reduce_returns())). prop_matches_returns_boolean() -> ?FORALL({Query, Event}, {glc_ops:op(), [{atom(), term()}]}, is_boolean(glc_lib:matches(Query, gre:make(Event, [list])))). matches_returns_boolean_test() -> ?assert(proper:quickcheck(prop_matches_returns_boolean())). returns(Fun) -> try Fun(), true catch _:_ -> false end. -endif. -endif. goldrush-0.1.9/src/gr_context.erl0000644000232200023220000000474712721424410017376 0ustar debalancedebalance%% Copyright (c) 2012, Magnus Klaar %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Runtime context for events. -module(gr_context). -export([ make/1 ]). make(Options) -> make_(undefined, undefined, undefined, undefined, Options). make_(_Node, App, Pid, Time, [{'$n', Node}|T]) -> make_(Node, App, Pid, Time, T); make_(Node, _App, Pid, Time, [{'$a', App}|T]) -> make_(Node, App, Pid, Time, T); make_(Node, App, _Pid, Time, [{'$p', Pid}|T]) -> make_(Node, App, Pid, Time, T); make_(Node, App, Pid, _Time, [{'$t', Time}|T]) -> make_(Node, App, Pid, Time, T); make_(Node, App, Pid, Time, []) -> Pid2 = case Pid of undefined -> self(); _ -> Pid end, Node2 = case Node of undefined -> node(Pid2); _ -> Node end, App2 = case App of undefined -> application(Pid2); _ -> App end, Time2 = case Time of undefined -> os:timestamp(); _ -> Time end, {Node2, App2, Pid2, Time2}. application(Pid) when Pid =:= self() -> case application:get_application(group_leader()) of {ok, App} -> App; undefined -> undefined end; application(Pid) -> {_, GroupLeader} = erlang:process_info(Pid, group_leader), case application:get_application(GroupLeader) of {ok, App} -> App; undefined -> undefined end. -ifdef(TEST). -include_lib("eunit/include/eunit.hrl"). make_defaults_test() -> {Node, App, Pid, Time} = gr_context:make([]), ?assertEqual(Node, node()), ?assertEqual(Pid, self()), ?assert(is_atom(App)), ?assertMatch({_,_,_}, Time). make_override_test() -> Pid = spawn(fun() -> ok end), {Node, App, Pid, Time} = gr_context:make([ {'$n', nodename}, {'$a', appname}, {'$p', Pid}, {'$t', timeval}]), ?assertEqual(nodename, Node), ?assertEqual(appname, App), ?assertEqual(timeval, Time). -endif. goldrush-0.1.9/src/gr_manager.erl0000644000232200023220000001475012721424410017317 0ustar debalancedebalance%% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. %% @doc Process table manager for goldrush. %% %% Manager responsible for the processes, which serve as heir of the %% {@link gr_counter:start_link/0. Counter} and %% {@link gr_param:start_link/0. Param} ets table processes. %% This process creates the table and initial data then assigns itself %% to inherit the ets table if any process responsible for it is killed. %% It then waits to give it back while that process is recreated by its %% supervisor. -module(gr_manager). -behaviour(gen_server). %% API -export([start_link/3, wait_for_pid/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -define(SERVER, ?MODULE). -record(state, {table_id :: ets:tab(), managee :: atom()}). %%%=================================================================== %%% API %%%=================================================================== %% Setup the initial data for the ets table -spec setup(atom() | pid(), term()) -> ok. setup(Name, Data) -> gen_server:cast(Name, {setup, Data}). %%-------------------------------------------------------------------- %% @doc %% Starts the server %% %% @spec start_link(Name, Managee, Data) -> {ok, Pid} | ignore | %% {error, Error} %% @end %%-------------------------------------------------------------------- start_link(Name, Managee, Data) -> gen_server:start_link({local, Name}, ?MODULE, [Managee, Data], []). %%%=================================================================== %%% gen_server callbacks %%%=================================================================== %%-------------------------------------------------------------------- %% @private %% @doc %% Initializes the server %% %% @spec init(Args) -> {ok, State} | %% {ok, State, Timeout} | %% ignore | %% {stop, Reason} %% @end %%-------------------------------------------------------------------- init([Managee, Data]) -> process_flag(trap_exit, true), setup(self(), Data), {ok, #state{managee=Managee}}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling call messages %% %% @spec handle_call(Request, From, State) -> %% {reply, Reply, State} | %% {reply, Reply, State, Timeout} | %% {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, Reply, State} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_call(_Request, _From, State) -> Reply = {error, unhandled_message}, {reply, Reply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling cast messages %% %% @spec handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_cast({setup, Data}, State = #state{managee=Managee}) -> ManageePid = whereis(Managee), link(ManageePid), TableId = ets:new(?MODULE, [set, private]), ets:insert(TableId, Data), ets:setopts(TableId, {heir, self(), Data}), ets:give_away(TableId, ManageePid, Data), {noreply, State#state{table_id=TableId}}; handle_cast(_Msg, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling all non call/cast messages %% %% @spec handle_info(Info, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_info({'EXIT', _Pid, _Reason}, State) -> {noreply, State}; handle_info({'ETS-TRANSFER', TableId, _Pid, Data}, State = #state{managee=Managee}) -> ManageePid = wait_for_pid(Managee), link(ManageePid), ets:give_away(TableId, ManageePid, Data), {noreply, State#state{table_id=TableId}}. %% @doc Wait for a registered process to be associated to a process identifier. %% @spec wait_for_pid(Managee) -> ManageePid -spec wait_for_pid(atom()) -> pid(). wait_for_pid(Managee) when is_pid(Managee) -> Managee; wait_for_pid(Managee) when is_atom(Managee), Managee =/= undefined -> case whereis(Managee) of undefined -> timer:sleep(1), wait_for_pid(Managee); ManageePid -> ManageePid end. %%-------------------------------------------------------------------- %% @private %% @doc %% This function is called by a gen_server when it is about to %% terminate. It should be the opposite of Module:init/1 and do any %% necessary cleaning up. When it returns, the gen_server terminates %% with Reason. The return value is ignored. %% %% @spec terminate(Reason, State) -> void() %% @end %%-------------------------------------------------------------------- terminate(_Reason, _State) -> ok. %%-------------------------------------------------------------------- %% @private %% @doc %% Convert process state when code is changed %% %% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} %% @end %%-------------------------------------------------------------------- code_change(_OldVsn, State, _Extra) -> {ok, State}. %%%=================================================================== %%% Internal functions %%%=================================================================== goldrush-0.1.9/src/glc_run.erl0000644000232200023220000000131112721424410016633 0ustar debalancedebalance-module(glc_run). -export([execute/2]). -ifdef(erlang18). -define(time_now(), erlang:monotonic_time()). -define(time_diff(T1, T2), erlang:convert_time_unit(T2 - T1, native, micro_seconds)). -else. -define(time_now(), os:timestamp()). -define(time_diff(T1, T2), timer:now_diff(T2, T1)). -endif. execute(Fun, [Event, Store]) -> T1 = ?time_now(), case (catch Fun(Event, Store)) of {'EXIT', {Reason, _ST}} -> T2 = ?time_now(), {?time_diff(T1, T2), {error, Reason}}; {'EXIT', Reason} -> T2 = ?time_now(), {?time_diff(T1, T2), {error, Reason}}; Else -> T2 = ?time_now(), {?time_diff(T1, T2), Else} end. goldrush-0.1.9/src/gr_app.erl0000644000232200023220000000166112721424410016462 0ustar debalancedebalance%% Copyright (c) 2012, Magnus Klaar %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -module(gr_app). -behaviour(application). -export([ start/2, stop/1 ]). start(_Type, _Args) -> gr_sup:start_link(). stop(_State) -> ok. goldrush-0.1.9/src/gr_param.erl0000644000232200023220000002135112721424410017000 0ustar debalancedebalance%% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -module(gr_param). -behaviour(gen_server). %% API -export([start_link/1, list/1, insert/2, lookup/2, lookup_element/2, info/1, info_size/1, transform/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {table_id, waiting=[]}). %%%=================================================================== %%% API %%%=================================================================== list(Server) -> case (catch gen_server:call(Server, list)) of {'EXIT', _Reason} -> list(gr_manager:wait_for_pid(Server)); Else -> Else end. info_size(Server) -> case (catch gen_server:call(Server, info_size)) of {'EXIT', _Reason} -> info_size(gr_manager:wait_for_pid(Server)); Else -> Else end. insert(Server, Term) -> case (catch gen_server:call(Server, {insert, Term})) of {'EXIT', _Reason} -> insert(gr_manager:wait_for_pid(Server), Term); Else -> Else end. lookup(Server, Term) -> case (catch gen_server:call(Server, {lookup, Term})) of {'EXIT', _Reason} -> lookup(gr_manager:wait_for_pid(Server), Term); Else -> Else end. lookup_element(Server, Term) -> case (catch gen_server:call(Server, {lookup_element, Term})) of {'EXIT', _Reason} -> lookup_element(gr_manager:wait_for_pid(Server), Term); Else -> Else end. info(Server) -> case (catch gen_server:call(Server, info)) of {'EXIT', _Reason} -> info(gr_manager:wait_for_pid(Server)); Else -> Else end. %% @doc Transform Term -> Key to Key -> Term transform(Server) -> case (catch gen_server:call(Server, transform)) of {'EXIT', _Reason} -> transform(gr_manager:wait_for_pid(Server)); Else -> Else end. %%-------------------------------------------------------------------- %% @doc %% Starts the server %% %% @spec start_link(Name) -> {ok, Pid} | ignore | {error, Error} %% @end %%-------------------------------------------------------------------- start_link(Name) -> gen_server:start_link({local, Name}, ?MODULE, [], []). %%%=================================================================== %%% gen_server callbacks %%%=================================================================== %%-------------------------------------------------------------------- %% @private %% @doc %% Initializes the server %% %% @spec init(Args) -> {ok, State} | %% {ok, State, Timeout} | %% ignore | %% {stop, Reason} %% @end %%-------------------------------------------------------------------- init([]) -> {ok, #state{}}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling call messages %% %% @spec handle_call(Request, From, State) -> %% {reply, Reply, State} | %% {reply, Reply, State, Timeout} | %% {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, Reply, State} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_call(Call, From, State) when is_atom(Call), Call =:= list; Call =:= info; Call =:= info_size; Call =:= transform -> TableId = State#state.table_id, Waiting = State#state.waiting, case TableId of undefined -> {noreply, State#state{waiting=[{Call, From}|Waiting]}}; _ when Call =:= list -> {reply, handle_list(TableId), State}; _ when Call =:= info -> {reply, handle_info(TableId), State}; _ when Call =:= info_size -> {reply, handle_info_size(TableId), State}; _ when Call =:= transform -> {reply, handle_transform(TableId), State} end; handle_call({Call, Term}, From, State) when is_atom(Call), Call =:= insert; Call =:= lookup; Call =:= lookup_element -> TableId = State#state.table_id, Waiting = State#state.waiting, case TableId of undefined -> {noreply, State#state{waiting=[{{Call, Term}, From}|Waiting]}}; _ when Call =:= insert -> {reply, handle_insert(TableId, Term), State}; _ when Call =:= lookup -> {reply, handle_lookup(TableId, Term), State}; _ when Call =:= lookup_element -> {reply, handle_lookup_element(TableId, Term), State} end; handle_call(_Request, _From, State) -> Reply = {error, unhandled_message}, {reply, Reply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling cast messages %% %% @spec handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_cast(_Msg, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling all non call/cast messages %% %% @spec handle_info(Info, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_info({'ETS-TRANSFER', TableId, _Pid, _Data}, State) -> _ = [ gen_server:reply(From, perform_call(TableId, Call)) || {Call, From} <- State#state.waiting ], {noreply, State#state{table_id=TableId, waiting=[]}}; handle_info(_Info, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% This function is called by a gen_server when it is about to %% terminate. It should be the opposite of Module:init/1 and do any %% necessary cleaning up. When it returns, the gen_server terminates %% with Reason. The return value is ignored. %% %% @spec terminate(Reason, State) -> void() %% @end %%-------------------------------------------------------------------- terminate(_Reason, _State) -> ok. %%-------------------------------------------------------------------- %% @private %% @doc %% Convert process state when code is changed %% %% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} %% @end %%-------------------------------------------------------------------- code_change(_OldVsn, State, _Extra) -> {ok, State}. %%%=================================================================== %%% Internal functions %%%=================================================================== perform_call(TableId, Call) -> case Call of list -> handle_list(TableId); info -> handle_info(TableId); info_size -> handle_info_size(TableId); transform -> handle_transform(TableId); {insert, Term} -> handle_insert(TableId, Term); {lookup, Term} -> handle_lookup(TableId, Term); {lookup_element, Term} -> handle_lookup_element(TableId, Term) end. handle_list(TableId) -> ets:tab2list(TableId). handle_info(TableId) -> ets:info(TableId). handle_info_size(TableId) -> ets:info(TableId, size). handle_transform(TableId) -> ParamsList = [{K, V} || {V, K} <- ets:tab2list(TableId)], ets:delete_all_objects(TableId), ets:insert(TableId, ParamsList). handle_insert(TableId, Term) -> ets:insert(TableId, Term). handle_lookup(TableId, Term) -> ets:lookup(TableId, Term). handle_lookup_element(TableId, Term) -> ets:lookup_element(TableId, Term, 2). goldrush-0.1.9/src/glc_ops.erl0000644000232200023220000001021412721424410016632 0ustar debalancedebalance%% @doc Built in operators. -module(glc_ops). -export([ lt/2, lte/2, eq/2, neq/2, gt/2, gte/2, wc/1, nf/1 ]). -export([ all/1, any/1, null/1, with/2 ]). -export([ union/1 ]). -type op() :: {atom(), '<', term()} | {atom(), '=<', term()} | {atom(), '=', term()} | {atom(), '!=', term()} | {atom(), '>', term()} | {atom(), '>=', term()} | {atom(), '*'} | {atom(), '!'} | {any, [op(), ...]} | {all, [op(), ...]} | {null, true|false}. -export_type([op/0]). %% @doc Test that a field value is less than a term. -spec lt(atom(), term()) -> op(). lt(Key, Term) when is_atom(Key) -> {Key, '<', Term}; lt(Key, Term) -> erlang:error(badarg, [Key, Term]). %% @doc Test that a field value is less than or equal to a term. -spec lte(atom(), term()) -> op(). lte(Key, Term) when is_atom(Key) -> {Key, '=<', Term}; lte(Key, Term) -> erlang:error(badarg, [Key, Term]). %% @doc Test that a field value is equal to a term. -spec eq(atom(), term()) -> op(). eq(Key, Term) when is_atom(Key) -> {Key, '=', Term}; eq(Key, Term) -> erlang:error(badarg, [Key, Term]). %% @doc Test that a field value is not equal to a term. -spec neq(atom(), term()) -> op(). neq(Key, Term) when is_atom(Key) -> {Key, '!=', Term}; neq(Key, Term) -> erlang:error(badarg, [Key, Term]). %% @doc Test that a field value is greater than a term. -spec gt(atom(), term()) -> op(). gt(Key, Term) when is_atom(Key) -> {Key, '>', Term}; gt(Key, Term) -> erlang:error(badarg, [Key, Term]). %% @doc Test that a field value is greater than or equal to a term. -spec gte(atom(), term()) -> op(). gte(Key, Term) when is_atom(Key) -> {Key, '>=', Term}; gte(Key, Term) -> erlang:error(badarg, [Key, Term]). %% @doc Test that a field exists. -spec wc(atom()) -> op(). wc(Key) when is_atom(Key) -> {Key, '*'}; wc(Key) -> erlang:error(badarg, [Key]). %% @doc Test that a field is not found. -spec nf(atom()) -> op(). nf(Key) when is_atom(Key) -> {Key, '!'}; nf(Key) -> erlang:error(badarg, [Key]). %% @doc Filter the input using multiple filters. %% %% For an input to be considered valid output the all filters specified %% in the list must hold for the input event. The list is expected to %% be a non-empty list. If the list of filters is an empty list a `badarg' %% error will be thrown. -spec all([op()]) -> op(). all([_|_]=Conds) -> {all, Conds}; all(Other) -> erlang:error(badarg, [Other]). %% @doc Filter the input using one of multiple filters. %% %% For an input to be considered valid output on of the filters specified %% in the list must hold for the input event. The list is expected to be %% a non-empty list. If the list of filters is an empty list a `badarg' %% error will be thrown. -spec any([op()]) -> op(). any([_|_]=Conds) -> {any, Conds}; any(Other) -> erlang:error(badarg, [Other]). %% @doc Always return `true' or `false'. -spec null(boolean()) -> op(). null(Result) when is_boolean(Result) -> {null, Result}; null(Result) -> erlang:error(badarg, [Result]). %% @doc Apply a function to each output of a query. %% %% Updating the output action of a query finalizes it. Attempting %% to use a finalized query to construct a new query will result %% in a `badarg' error. -spec with(op(), fun((gre:event()) -> term())) -> op(). with(Query, Fun) when is_function(Fun, 1); is_function(Fun, 2) -> {with, Query, Fun}; with(Query, Fun) -> erlang:error(badarg, [Query, Fun]). %% @doc Return a union of multiple queries. %% %% The union of multiple queries is the equivalent of executing multiple %% queries separately on the same input event. The advantage is that filter %% conditions that are common to all or some of the queries only need to %% be tested once. %% %% All queries are expected to be valid and have an output action other %% than the default which is `output'. If these expectations don't hold %% a `badarg' error will be thrown. -spec union([op()]) -> op(). union(Queries) -> case [Query || Query <- Queries, glc_lib:onoutput(Query) =:= output] of [] -> {union, Queries}; [_|_] -> erlang:error(badarg, [Queries]) end. goldrush-0.1.9/src/gr_counter.erl0000644000232200023220000002251112721424410017356 0ustar debalancedebalance%% Copyright (c) 2013, Pedram Nimreezi %% %% Permission to use, copy, modify, and/or distribute this software for any %% purpose with or without fee is hereby granted, provided that the above %% copyright notice and this permission notice appear in all copies. %% %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -module(gr_counter). -behaviour(gen_server). %% API -export([start_link/1, list/1, lookup_element/2, insert_counter/3, update_counter/3, reset_counters/2]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {table_id, waiting=[]}). %%%=================================================================== %%% API %%%=================================================================== list(Server) -> case (catch gen_server:call(Server, list)) of {'EXIT', _Reason} -> list(gr_manager:wait_for_pid(Server)); Else -> Else end. lookup_element(Server, Term) -> case (catch gen_server:call(Server, {lookup_element, Term})) of {'EXIT', _Reason} -> lookup_element(gr_manager:wait_for_pid(Server), Term); Else -> Else end. insert_counter(Server, Counter, Value) when is_atom(Server) -> case whereis(Server) of undefined -> insert_counter(gr_manager:wait_for_pid(Server), Counter, Value); Pid -> case erlang:is_process_alive(Pid) of true -> insert_counter(Pid, Counter, Value); false -> ServerPid = gr_manager:wait_for_pid(Server), insert_counter(ServerPid, Counter, Value) end end; insert_counter(Server, Counter, Value) when is_pid(Server) -> case (catch gen_server:call(Server, {insert_counter, Counter, Value})) of {'EXIT', _Reason} -> insert_counter(gr_manager:wait_for_pid(Server), Counter, Value); Else -> Else end. update_counter(Server, Counter, Value) when is_atom(Server) -> case whereis(Server) of undefined -> update_counter(gr_manager:wait_for_pid(Server), Counter, Value); Pid -> case erlang:is_process_alive(Pid) of true -> update_counter(Pid, Counter, Value); false -> ServerPid = gr_manager:wait_for_pid(Server), update_counter(ServerPid, Counter, Value) end end; update_counter(Server, Counter, Value) when is_pid(Server) -> gen_server:cast(Server, {update, Counter, Value}). reset_counters(Server, Counter) -> case (catch gen_server:call(Server, {reset_counters, Counter})) of {'EXIT', _Reason} -> reset_counters(gr_manager:wait_for_pid(Server), Counter); Else -> Else end. %%-------------------------------------------------------------------- %% @doc %% Starts the server %% %% @spec start_link(Name) -> {ok, Pid} | ignore | {error, Error} %% @end %%-------------------------------------------------------------------- start_link(Name) -> gen_server:start_link({local, Name}, ?MODULE, [], []). %%%=================================================================== %%% gen_server callbacks %%%=================================================================== %%-------------------------------------------------------------------- %% @private %% @doc %% Initializes the server %% %% @spec init(Args) -> {ok, State} | %% {ok, State, Timeout} | %% ignore | %% {stop, Reason} %% @end %%-------------------------------------------------------------------- init([]) -> {ok, #state{}}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling call messages %% %% @spec handle_call(Request, From, State) -> %% {reply, Reply, State} | %% {reply, Reply, State, Timeout} | %% {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, Reply, State} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_call(list=Call, From, State) -> TableId = State#state.table_id, Waiting = State#state.waiting, case TableId of undefined -> {noreply, State#state{waiting=[{Call, From}|Waiting]}}; _ -> {reply, lists:sort(handle_list(TableId)), State} end; handle_call({lookup_element, Term}=Call, From, State) -> TableId = State#state.table_id, Waiting = State#state.waiting, case TableId of undefined -> {noreply, State#state{waiting=[{Call, From}|Waiting]}}; _ -> {reply, handle_lookup_element(TableId, Term), State} end; handle_call({insert_counter, Counter, Value}, From, State) -> Term = [{Counter, Value}], Call = {insert, Term}, TableId = State#state.table_id, Waiting = State#state.waiting, case TableId of undefined -> {noreply, State#state{waiting=[{Call, From}|Waiting]}}; _ -> {reply, handle_insert(TableId, Term), State} end; handle_call({reset_counters, Counter}, From, State) -> Term = case Counter of _ when is_list(Counter) -> [{Item, 0} || Item <- Counter]; _ when is_atom(Counter) -> [{Counter, 0}] end, Call = {insert, Term}, TableId = State#state.table_id, Waiting = State#state.waiting, case TableId of undefined -> {noreply, State#state{waiting=[{Call, From}|Waiting]}}; _ -> {reply, handle_insert(TableId, Term), State} end; handle_call(_Request, _From, State) -> Reply = {error, unhandled_message}, {reply, Reply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling cast messages %% %% @spec handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_cast({update, Counter, Value}=Call, State) -> TableId = State#state.table_id, Waiting = State#state.waiting, State2 = case TableId of undefined -> State#state{waiting=[Call|Waiting]}; _ -> _ = handle_update_counter(TableId, Counter, Value), State end, {noreply, State2}; handle_cast(_Msg, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% Handling all non call/cast messages %% %% @spec handle_info(Info, State) -> {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} %% @end %%-------------------------------------------------------------------- handle_info({'ETS-TRANSFER', TableId, _Pid, _Data}, State) -> _ = [ gen_server:reply(From, perform_call(TableId, Call)) || {Call, From} <- State#state.waiting ], _ = [ handle_update_counter(TableId, Counter, Value) || {update, Counter, Value} <- State#state.waiting ], {noreply, State#state{table_id=TableId, waiting=[]}}; handle_info(_Info, State) -> {noreply, State}. %%-------------------------------------------------------------------- %% @private %% @doc %% This function is called by a gen_server when it is about to %% terminate. It should be the opposite of Module:init/1 and do any %% necessary cleaning up. When it returns, the gen_server terminates %% with Reason. The return value is ignored. %% %% @spec terminate(Reason, State) -> void() %% @end %%-------------------------------------------------------------------- terminate(_Reason, _State) -> ok. %%-------------------------------------------------------------------- %% @private %% @doc %% Convert process state when code is changed %% %% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} %% @end %%-------------------------------------------------------------------- code_change(_OldVsn, State, _Extra) -> {ok, State}. %%%=================================================================== %%% Internal functions %%%=================================================================== perform_call(TableId, Call) -> case Call of list -> handle_list(TableId); {insert, Term} -> handle_insert(TableId, Term); {lookup_element, Term} -> handle_lookup_element(TableId, Term) end. handle_list(TableId) -> ets:tab2list(TableId). handle_update_counter(TableId, Counter, Value) -> ets:update_counter(TableId, Counter, Value). handle_insert(TableId, Term) -> ets:insert(TableId, Term). handle_lookup_element(TableId, Term) -> ets:lookup_element(TableId, Term, 2). goldrush-0.1.9/Makefile0000644000232200023220000000131312721424410015351 0ustar debalancedebalance# See LICENSE for licensing information. DIALYZER = dialyzer REBAR = rebar APPNAME = goldrush all: app app: deps @$(REBAR) compile deps: @$(REBAR) get-deps clean: @$(REBAR) clean rm -f test/*.beam rm -f erl_crash.dump tests: clean app eunit ct eunit: @$(REBAR) -C rebar.test.config eunit skip_deps=true ct: @$(REBAR) -C rebar.test.config ct skip_deps=true build-plt: @$(DIALYZER) --build_plt --output_plt .$(APPNAME)_dialyzer.plt \ --apps kernel stdlib sasl inets crypto public_key ssl compiler syntax_tools dialyze: @$(DIALYZER) --src src --plt .$(APPNAME)_dialyzer.plt --no_native \ -Werror_handling -Wrace_conditions -Wunmatched_returns # -Wunderspecs docs: @$(REBAR) doc skip_deps=true goldrush-0.1.9/README.org0000644000232200023220000002144512721424410015367 0ustar debalancedebalance# Goldrush # Goldrush is a small Erlang app that provides fast event stream processing # Features # * Event processing compiled to a query module - per module private event processing statistics - query module logic can be combined for any/all filters - query module logic can be reduced to efficiently match event processing * Complex event processing logic - match input events with greater than (gt) logic - match input events with less than (lt) logic - match input events with equal to (eq) logic - match input events with wildcard (wc) logic - match input events with notfound (nf) logic - match no input events (null blackhole) logic - match all input events (null passthrough) logic * Handle output events - Once a query has been composed the output action can be overriden with one or more erlang functions. The functions will be applied to each output event from the query. * Handle low latency retrieval of compile-time stored values. - Values stored are also provided to functions called on event output. - Handle job execution and timing which can also get values stored - create input events that include runtime on successful function executions. * Handle fastest lookups of stored values. - provide state storage option to compile, caching the values in query module. * Usage To use goldrush in your application, you need to define it as a rebar dep or include it in erlang's path. Before composing modules, you'll need to define a query. The query syntax matches any number of `{erlang, terms}' and is composed as follows: * Simple Logic - Simple logic is defined as any logic matching a single event filter Select all events where 'a' exists and is greater than 0. #+BEGIN_EXAMPLE glc:gt(a, 0). #+END_EXAMPLE Select all events where 'a' exists and is greater than or equal to 0. #+BEGIN_EXAMPLE glc:gte(a, 0). #+END_EXAMPLE Select all events where 'a' exists and is equal to 0. #+BEGIN_EXAMPLE glc:eq(a, 0). #+END_EXAMPLE Select all events where 'a' exists and is not equal to 0. #+BEGIN_EXAMPLE glc:neq(a, 0). #+END_EXAMPLE Select all events where 'a' exists and is less than 0. #+BEGIN_EXAMPLE glc:lt(a, 0). #+END_EXAMPLE Select all events where 'a' exists and is less than or equal to 0. #+BEGIN_EXAMPLE glc:lte(a, 0). #+END_EXAMPLE Select all events where 'a' exists. #+BEGIN_EXAMPLE glc:wc(a). #+END_EXAMPLE Select all events where 'a' does not exist. #+BEGIN_EXAMPLE glc:nf(a). #+END_EXAMPLE Select no input events. User as a black hole query. #+BEGIN_EXAMPLE glc:null(false). #+END_EXAMPLE Select all input events. Used as a passthrough query. #+BEGIN_EXAMPLE glc:null(true). #+END_EXAMPLE * Combined Logic - Combined logic is defined as logic matching multiple event filters Select all events where both 'a' AND 'b' exists and are greater than 0. #+BEGIN_EXAMPLE glc:all([glc:gt(a, 0), glc:gt(b, 0)]). #+END_EXAMPLE Select all events where 'a' OR 'b' exists and are greater than 0. #+BEGIN_EXAMPLE glc:any([glc:gt(a, 0), glc:gt(b, 0)]). #+END_EXAMPLE Select all events where 'a' AND 'b' exists where 'a' is greater than 1 and 'b' is less than 2. #+BEGIN_EXAMPLE glc:all([glc:gt(a, 1), glc:lt(b, 2)]). #+END_EXAMPLE Select all events where 'a' OR 'b' exists where 'a' is greater than 1 and 'b' is less than 2. #+BEGIN_EXAMPLE glc:any([glc:gt(a, 1), glc:lt(b, 2)]). #+END_EXAMPLE * Reduced Logic - Reduced logic is defined as logic which can be simplified to improve efficiency. Select all events where 'a' is equal to 1, 'b' is equal to 2 and 'c' is equal to 3 and collapse any duplicate logic. #+BEGIN_EXAMPLE glc_lib:reduce( glc:all([ glc:any([glc:eq(a, 1), glc:eq(b, 2)]), glc:any([glc:eq(a, 1), glc:eq(c, 3)])])). #+END_EXAMPLE The previous example will produce and is equivalent to: #+BEGIN_EXAMPLE glc:all([glc:eq(a, 1), glc:eq(b, 2), glc:eq(c, 3)]). #+END_EXAMPLE * Composing Modules - All query modules must be compiled before use To compose a module you will take your Query defined above and compile it. #+BEGIN_EXAMPLE glc:compile(Module, Query). glc:compile(Module, Query, State). glc:compile(Module, Query, State, ResetStatistics). #+END_EXAMPLE - At this point you will be able to handle an event using a compiled query. Begin by constructing an event list. #+BEGIN_EXAMPLE Event = gre:make([{'a', 2}], [list]). #+END_EXAMPLE Now pass it to your query module to be handled. #+BEGIN_EXAMPLE glc:handle(Module, Event). #+END_EXAMPLE * Handling output events - You can override the output action with an erlang function. Write all input events as info reports to the error logger. #+BEGIN_EXAMPLE glc:with(glc:null(true), fun(E) -> error_logger:info_report(gre:pairs(E)) end). #+END_EXAMPLE Write all input events where `error_level' exists and is less than 5 as info reports to the error logger. #+BEGIN_EXAMPLE glc:with(glc:lt(error_level, 5), fun(E) -> error_logger:info_report(gre:pairs(E)) end). #+END_EXAMPLE Write all input events where `error_level' exists and is 3 or 5 as info reports to the error logger. #+BEGIN_EXAMPLE glc:any([ glc:with(glc:lt(error_level, 3), fun(E) -> error_logger:info_report(gre:pairs(E)) end), glc:with(glc:lt(error_level, 5), fun(E) -> error_logger:info_report(gre:pairs(E)) end)]). #+END_EXAMPLE # Composing Modules with stored state # To compose a module with state data you will add a third argument (orddict). #+BEGIN_EXAMPLE glc:compile(Module, Query, [{stored, value}]). #+END_EXAMPLE # Accessing stored state data # Return the stored value in this query module. #+BEGIN_EXAMPLE {ok, value} = glc:get(stored). #+END_EXAMPLE Return all stored values in this query module. #+BEGIN_EXAMPLE [...] = Module:get(). #+END_EXAMPLE * Composing Modules with stored data - You can create query modules with local state to compare to event data in `with' and `run' To compose a module with state data you will add a third argument (orddict). #+BEGIN_EXAMPLE glc:compile(Module, Query, [{stored, value}]). #+END_EXAMPLE * Accessing stored data in constant time - You can use query modules in a way similar to mochiglobal Return the stored value in this query module. #+BEGIN_EXAMPLE {ok, value} = glc:get(stored). #+END_EXAMPLE * Job processing with composed modules - You can use query modules to execute jobs, if the job errors or not, process an event. - `with' is similar to `run', the main difference is additional statistics and execution order - when a job completes in error, the event data will contain an additional {error, _} item To execute a job through the query module, inputting an event on success. #+BEGIN_EXAMPLE Event = gre:make([{'a', 2}], [list]). {ExecutionTime, Result}= glc:run(Module, fun(Event, State) -> %% do not end with {error, _} or throw an exception end, Event). #+END_EXAMPLE * Event Processing Statistics Return the number of input events for this query module. #+BEGIN_EXAMPLE glc:input(Module). #+END_EXAMPLE Return the number of output events for this query module. #+BEGIN_EXAMPLE glc:output(Module). #+END_EXAMPLE Return the number of filtered events for this query module. #+BEGIN_EXAMPLE glc:filter(Module). #+END_EXAMPLE * Job Processing Statistics Return the number of job runs for this query module. #+BEGIN_EXAMPLE glc:job_run(Module). #+END_EXAMPLE Return the number of job errors for this query module. #+BEGIN_EXAMPLE glc:job_error(Module). #+END_EXAMPLE Return the number of job inputs for this query module. #+BEGIN_EXAMPLE glc:job_input(Module). #+END_EXAMPLE Return the amount of time jobs took for this query module. #+BEGIN_EXAMPLE glc:job_time(Module). #+END_EXAMPLE * Some Tips & Tricks - This is really just a drop in the bucket. Return the average time jobs took for this query module. #+BEGIN_EXAMPLE glc:job_time(Module) / glc:job_input(Module) / 1000000. #+END_EXAMPLE Return the query combining the conditional logic of multiple modules #+BEGIN_EXAMPLE glc_lib:reduce(glc:all([Module1:info('query'), Module2:info('query')]). #+END_EXAMPLE Return all statistics from this query module. #+BEGIN_EXAMPLE glc:info(Module). #+END_EXAMPLE * Build #+BEGIN_EXAMPLE $ ./rebar compile #+END_EXAMPLE or #+BEGIN_EXAMPLE $ make #+END_EXAMPLE * CHANGELOG 0.1.9 - Add support for running jobs 0.1.8 - Add support for not equal 0.1.7 - Support multiple functions specified using `with/2` - Add support for greater than or less than operators - Add state storage option for output events or lookup 0.1.7 - Add job execution and timings - Add state storage option 0.1.7 - Add job execution and timings - Add state storage option 0.1.6 - Add notfound event matching 0.1.5 - Rewrite to make highly crash resilient - per module supervision - statistics data recovery - Add wildcard event matching - Add reset counters