1:- dynamic subscribed/3.
2
3:- local store(ps). % stores subscriptions
4:- local store(trigger). % stores triggers
5%:- external(bitfield_add/3, p_bitfield_add).
6%:- external(bitfield_remove/3, p_bitfield_remove).
7%:- external(bitfield_union/4, p_bitfield_union).
8
9add_subscription(Storage, Id, Template, Subscriber) :-
10    Template = template(Name, AList, CList),
11    make_all_constraints(AList, CList, Constraints),
12    store_set(Storage, Id, subscription(Name, Constraints, Subscriber)),
13    bitfield_add(Storage, Constraints, Id).
14
15delete_subscription(Storage, Id, Binding) :-
16    store_get(Storage, Id, subscription(_, Constraints, Subscriber)),
17    arg(1, Subscriber, Binding),
18    store_delete(Storage, Id),
19    bitfield_remove(Storage, Constraints, Id).
20
21%% Should really use delete_subscription
22unsubscribe(Storage, Id, Binding) :-
23    store_get(Storage, Id, subscription(_, Constraints, Subscriber)),
24    arg(1, Subscriber, Binding),
25    store_delete(Storage, Id),
26    bitfield_remove(Storage, Constraints, Id),
27    writeln(Subscriber).
28
29find_subscriber(Storage, Message, Subscriber) :-
30    Message = object(Name, AList),
31    sort(AList, SAList),
32    SMessage = object(Name, SAList),
33    find_subscription_candidates(Storage, SMessage, Candidate),
34    store_get(Storage, Candidate, Subscription),
35    match_message(SMessage, Subscription),
36    Subscription = subscription(_, _, Subscriber).
37
38find_subscription_candidates(Storage, Message, Ids) :-
39    Message = object(Name, Attributes),
40    (not length(Attributes, 0) ; atom(Name)), !, % TODO
41    get_index_names(Attributes, IdxList),
42    find_next_subscriber(Storage, IdxList, Ids).
43
44find_next_subscriber(Storage, AttributeList, NextItem) :-
45    index_union_aux(Storage, AttributeList, "s", NextItem).
46
47% This makes our C predicate non-deterministic
48index_union_aux(Storage, AttributeList, OldState, Item) :-
49    bitfield_union(Storage, AttributeList, OldState, NewItem),
50    (
51        Item = NewItem
52    ;
53        index_union_aux(Storage, AttributeList, NewItem, Item)
54    ).
55
56match_message(Message, Subscription) :-
57    Message = object(MName, AList),
58    Subscription = subscription(SName, Constraints, _),
59    ( not var(SName) ->
60        ( not atom(SName) ->
61            SName = name_constraint(Value),
62            match(Value, MName, [])
63        ; SName = MName )
64    ; true ),
65    match_attributes(AList, Constraints).
66
67% Similar to match_constraints in objects code but works the other
68% way around: we match attributs against constraints
69match_attributes(_, []).
70
71% Number comparison
72match_attributes([val(Key, AValue)|Rest], [constraint(Key, Comparator, CValue)|CRest]) :-
73    number(AValue), number(CValue), !,
74    number_compare(Comparator, AValue, CValue),
75    match_attributes([val(Key, AValue)|Rest], CRest).
76
77% Regular Expression
78match_attributes([val(Key, AValue)|Rest], [constraint(Key, match, CValue)|CRest]) :-
79    !, ( (string(AValue) ; atom(AValue)), (string(CValue) ; atom(CValue)) ),
80    match(CValue, AValue, []),
81    match_attributes([val(Key, AValue)|Rest], CRest).
82
83% String comparison
84match_attributes([val(Key, AValue)|Rest], [constraint(Key, Comparator, CValue)|CRest]) :-
85    ( (string(CValue) ; atom(CValue)), (string(AValue) ; atom(AValue)) ), !,
86    string_compare(Comparator, AValue, CValue),
87    match_attributes([val(Key, AValue)|Rest], CRest).
88
89% Variable
90match_attributes([val(Key, AValue)|Rest], [constraint(Key, '==', CValue)|CRest]) :-
91    var(CValue),  !,
92    CValue = AValue,
93    match_attributes([val(Key, AValue)|Rest], CRest).
94
95% Skip to next relevant Slot in List
96match_attributes([val(AKey, AValue)|Rest], [constraint(CKey, Comparator, CValue)|SRest]) :-
97    compare(>, CKey, AKey), !,
98    match_attributes(Rest, [constraint(CKey, Comparator, CValue)|SRest]).