Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 491c70447b
Fetching contributors…

Cannot retrieve contributors at this time

489 lines (414 sloc) 16.729 kb
-module(boss_db_adapter_mongodb).
-behaviour(boss_db_adapter).
-export([start/1, stop/0, init/1, terminate/1, find/2, find/7]).
-export([count/3, counter/2, incr/2, incr/3, delete/2, save_record/2]).
-export([execute/2]).
-export([push/2, pop/2]).
-define(LOG(Name, Value), io:format("DEBUG: ~s: ~p~n", [Name, Value])).
% Number of seconds between beginning of gregorian calendar and 1970
-define(GREGORIAN_SECONDS_1970, 62167219200).
% JavaScript expression formats to query MongoDB
-define(CONTAINS_FORMAT, "this.~s.indexOf('~s') != -1").
-define(NOT_CONTAINS_FORMAT, "this.~s.indexOf('~s') == -1").
start(_Options) ->
application:start(mongodb).
stop() ->
ok.
init(Options) ->
Host = proplists:get_value(db_host, Options, "localhost"),
Port = proplists:get_value(db_port, Options, 27017),
Database = proplists:get_value(db_database, Options, test),
WriteMode = proplists:get_value(db_write_mode, Options, safe),
ReadMode = proplists:get_value(db_read_mode, Options, master),
{ok, Connection} = mongo:connect({Host, Port}),
% We pass around arguments required by mongo:do/5
{ok, {WriteMode, ReadMode, Connection, Database}}.
terminate({_, _, Connection, _}) ->
mongo:disconnect(Connection).
execute({WriteMode, ReadMode, Connection, Database}, Fun) ->
mongo:do(WriteMode, ReadMode, Connection, Database, Fun).
find(Conn, Id) when is_list(Id) ->
{Type, Collection, MongoId} = infer_type_from_id(Id),
Res = execute(Conn, fun() ->
mongo:find_one(Collection, {'_id', MongoId})
end),
case Res of
{ok, {}} -> undefined;
{ok, {Doc}} -> mongo_tuple_to_record(Type, Doc);
{failure, Reason} -> {error, Reason};
{connection_failure, Reason} -> {error, Reason}
end.
find(Conn, Type, Conditions, Max, Skip, Sort, SortOrder) when is_atom(Type), is_list(Conditions),
is_integer(Max) orelse Max =:= all, is_integer(Skip),
is_atom(Sort), is_atom(SortOrder) ->
% ?LOG("find Type", Type),
% ?LOG("find Conditions", Conditions),
case boss_record_lib:ensure_loaded(Type) of
true ->
Collection = type_to_collection(Type),
Res = execute(Conn, fun() ->
Selector = build_conditions(Conditions, {Sort, pack_sort_order(SortOrder)}),
case Max of
all -> mongo:find(Collection, Selector, [], Skip);
_ -> mongo:find(Collection, Selector, [], Skip, Max)
end
end),
case Res of
{ok, Curs} ->
lists:map(fun(Row) ->
mongo_tuple_to_record(Type, Row)
end, mongo:rest(Curs));
{failure, Reason} -> {error, Reason};
{connection_failure, Reason} -> {error, Reason}
end;
false -> {error, {module_not_loaded, Type}}
end.
count(Conn, Type, Conditions) ->
Collection = type_to_collection(Type),
{ok, Count} = execute(Conn, fun() ->
C = build_conditions(Conditions),
% ?LOG("Conditions", C),
mongo:count(Collection, C)
end),
% ?LOG("Count", Count),
Count.
counter(Conn, Id) when is_list(Id) ->
Res = execute(Conn, fun() ->
mongo:find_one(boss_counters, {'name', list_to_binary(Id)})
end),
case Res of
{ok, {Doc}} ->
PropList = tuple_to_proplist(Doc),
proplists:get_value(value, PropList);
{failure, Reason} -> {error, Reason};
{connection_failure, Reason} -> {error, Reason}
end.
incr(Conn, Id) ->
incr(Conn, Id, 1).
incr(Conn, Id, Count) ->
Res = execute(Conn, fun() ->
mongo:repsert(boss_counters,
{'name', list_to_binary(Id)},
{'$inc', {value, Count}}
)
end),
case Res of
{ok, ok} -> counter(Conn, Id);
{failure, Reason} -> {error, Reason};
{connection_failure, Reason} -> {error, Reason}
end.
delete(Conn, Id) when is_list(Id) ->
{_Type, Collection, MongoId} = infer_type_from_id(Id),
Res = execute(Conn, fun() ->
mongo:delete(Collection, {'_id', MongoId})
end),
case Res of
{ok, ok} -> ok;
{failure, Reason} -> {error, Reason};
{connection_failure, Reason} -> {error, Reason}
end.
save_record(Conn, Record) when is_tuple(Record) ->
Type = element(1, Record),
Collection = type_to_collection(Type),
Res = case Record:id() of
id ->
PropList = lists:foldr(fun
({id,_}, Acc) -> Acc;
({K,V}, Acc) ->
PackedVal = case is_id_attr(K) of
true -> pack_id(V);
false -> pack_value(V)
end,
[{K, PackedVal}|Acc]
end, [], Record:attributes()),
Doc = proplist_to_tuple(PropList),
execute(Conn, fun() ->
mongo:insert(Collection, Doc)
end);
DefinedId when is_list(DefinedId) ->
PackedId = pack_id(DefinedId),
PropList = lists:map(fun
({id,_}) -> {'_id', PackedId};
({K,V}) ->
PackedVal = case is_id_attr(K) of
true -> pack_id(V);
false -> pack_value(V)
end,
{K, PackedVal}
end, Record:attributes()),
Doc = proplist_to_tuple(PropList),
execute(Conn, fun() ->
mongo:repsert(Collection, {'_id', PackedId}, Doc)
end)
end,
case Res of
{ok, ok} -> {ok, Record};
{ok, Id} ->
{ok, Record:set(id, unpack_id(Type, Id))};
{failure, Reason} -> {error, Reason};
{connection_failure, Reason} -> {error, Reason}
end.
% These 2 functions are not part of the behaviour but are required for
% tests to pass
push(_Conn, _Depth) -> ok.
pop(_Conn, _Depth) -> ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Internal functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Query generation
%%
build_conditions(Conditions) ->
proplist_to_tuple(build_conditions1(Conditions, [])).
build_conditions(Conditions, OrderBy) ->
{'query', build_conditions(Conditions), orderby, OrderBy}.
build_conditions1([], Acc) ->
Acc;
build_conditions1([{Key, 'matches', Value, Options}|Rest], Acc) ->
MongoOptions = mongo_regex_options_for_re_module_options(Options),
build_conditions1(Rest, [{Key, {regex, list_to_binary(Value), list_to_binary(MongoOptions)}}|Acc]);
build_conditions1([{Key, 'not_matches', Value, Options}|Rest], Acc) ->
MongoOptions = mongo_regex_options_for_re_module_options(Options),
build_conditions1(Rest, [{Key, {'$not', {regex, list_to_binary(Value), list_to_binary(MongoOptions)}}}|Acc]);
build_conditions1([{Key, Operator, Value}|Rest], Acc) ->
% ?LOG("Key, Operator, Value", {Key, Operator, Value}),
Condition = case {Operator, Value} of
{'not_matches', "*"++Value1} ->
[{Key, {'$not', {regex, list_to_binary(Value1), <<"i">>}}}];
{'not_matches', Value} ->
[{Key, {'$not', {regex, list_to_binary(Value), <<"">>}}}];
{'matches', "*"++Value1} ->
[{Key, {regex, list_to_binary(Value1), <<"i">>}}];
{'matches', Value} ->
[{Key, {regex, list_to_binary(Value), <<"">>}}];
{'contains', Value} ->
WhereClause = where_clause(
?CONTAINS_FORMAT, [Key, Value]),
[{'$where', WhereClause}];
{'not_contains', Value} ->
WhereClause = where_clause(
?NOT_CONTAINS_FORMAT, [Key, Value]),
[{'$where', WhereClause}];
{'contains_all', ValueList} ->
WhereClause = multiple_where_clauses(
?CONTAINS_FORMAT, Key, ValueList, "&&"),
[{'$where', WhereClause}];
{'not_contains_all', ValueList} ->
WhereClause = "!(" ++ multiple_where_clauses_string(
?CONTAINS_FORMAT, Key, ValueList, "&&") ++ ")",
[{'$where', erlang:iolist_to_binary(WhereClause)}];
{'contains_any', ValueList} ->
WhereClause = multiple_where_clauses(
?CONTAINS_FORMAT, Key, ValueList, "||"),
[{'$where', WhereClause}];
{'contains_none', ValueList} ->
WhereClause = multiple_where_clauses(
?NOT_CONTAINS_FORMAT, Key, ValueList, "&&"),
[{'$where', WhereClause}];
{'equals', Value} when is_list(Value) ->
case is_id_attr(Key) of
true ->
[{Key, pack_id(Value)}];
false ->
[{Key, list_to_binary(Value)}]
end;
{'not_equals', Value} when is_list(Value) ->
[{Key, {'$ne', list_to_binary(Value)}}];
{'equals', {{_,_,_},{_,_,_}} = Value} ->
[{Key, datetime_to_now(Value)}];
{'equals', Value} ->
[{Key, Value}];
{Operator, {{_,_,_},{_,_,_}} = Value} ->
[{Key, {boss_to_mongo_op(Operator), datetime_to_now(Value)}}];
{'in', [H|T]} ->
[{Key, {'$in', lists:map(list_pack_function(Key), [H|T])}}];
{'in', {Min, Max}} ->
[{Key, {'$gte', Min}}, {Key, {'$lte', Max}}];
{'not_in', [H|T]} ->
[{Key, {'$nin', lists:map(list_pack_function(Key), [H|T])}}];
{'not_in', {Min, Max}} ->
[{'$or', [{Key, {'$lt', Min}}, {Key, {'$gt', Max}}]}];
{Operator, Value} ->
[{Key, {boss_to_mongo_op(Operator), Value}}]
end,
% ?LOG("Condition", Condition),
build_conditions1(Rest, lists:append(Condition, Acc)).
list_pack_function(Key) ->
case is_id_attr(Key) of
true ->
fun(Id) -> pack_id(Id) end;
false ->
fun(Value) when is_list(Value) ->
list_to_binary(Value);
(Value) ->
Value
end
end.
where_clause(Format, Params) ->
erlang:iolist_to_binary(
io_lib:format(Format, Params)).
multiple_where_clauses_string(Format, Key, ValueList, Operator) ->
ClauseList = lists:map(fun(Value) ->
lists:flatten(io_lib:format(Format, [Key, Value]))
end, ValueList),
string:join(ClauseList, " " ++ Operator ++ " ").
multiple_where_clauses(Format, Key, ValueList, Operator) ->
erlang:iolist_to_binary(multiple_where_clauses_string(Format, Key,
ValueList, Operator)).
%%
%% Boss models introspection
%%
infer_type_from_id(Id) when is_list(Id) ->
[Type, _BossId] = string:tokens(Id, "-"),
{list_to_atom(Type), type_to_collection(Type), pack_id(Id)}.
is_id_attr(AttrName) ->
lists:suffix("_id", atom_to_list(AttrName)).
%%
%% Conversion between Chicago Boss en MongoDB
%%
% Find MongoDB collection from Boss type
type_to_collection(Type) ->
list_to_atom(type_to_collection_name(Type)).
type_to_collection_name(Type) when is_atom(Type) ->
type_to_collection_name(atom_to_list(Type));
type_to_collection_name(Type) when is_list(Type) ->
inflector:pluralize(Type).
% Convert a tuple return by the MongoDB driver to a Boss record
mongo_tuple_to_record(Type, Row) ->
MongoDoc = tuple_to_proplist(Row),
AttributeTypes = boss_record_lib:attribute_types(Type),
Args = lists:map(fun
(id) ->
MongoValue = attr_value(id, MongoDoc),
unpack_id(Type, MongoValue);
(AttrName) ->
MongoValue = attr_value(AttrName, MongoDoc),
ValueType = proplists:get_value(AttrName, AttributeTypes),
unpack_value(AttrName, MongoValue, ValueType)
end, boss_record_lib:attribute_names(Type)),
apply(Type, new, Args).
mongo_regex_options_for_re_module_options(Options) ->
mongo_regex_options_for_re_module_options(Options, []).
mongo_regex_options_for_re_module_options([], Acc) ->
lists:reverse(Acc);
mongo_regex_options_for_re_module_options([caseless|Rest], Acc) ->
mongo_regex_options_for_re_module_options(Rest, [$i|Acc]);
mongo_regex_options_for_re_module_options([dotall|Rest], Acc) ->
mongo_regex_options_for_re_module_options(Rest, [$s|Acc]);
mongo_regex_options_for_re_module_options([extended|Rest], Acc) ->
mongo_regex_options_for_re_module_options(Rest, [$x|Acc]);
mongo_regex_options_for_re_module_options([multiline|Rest], Acc) ->
mongo_regex_options_for_re_module_options(Rest, [$m|Acc]).
% Boss and MongoDB have a different conventions to id attributes (id vs. '_id').
attr_value(id, MongoDoc) ->
proplists:get_value('_id', MongoDoc);
attr_value(AttrName, MongoDoc) ->
proplists:get_value(AttrName, MongoDoc).
% Id conversions
pack_id(BossId) ->
try
[_, MongoId] = string:tokens(BossId, "-"),
{hex2dec(MongoId)}
catch
Error:Reason ->
error_logger:warning_msg("Error parsing Boss record id: ~p:~p~n",
[Error, Reason]),
[]
end.
unpack_id(_Type, undefined) ->
undefined;
unpack_id(Type, MongoId) ->
lists:concat([Type, "-", binary_to_list(dec2hex(element(1, MongoId)))]).
% Value conversions
pack_value({{_, _, _}, {_, _, _}} = Val) ->
datetime_to_now(Val);
pack_value(V) when is_binary(V) -> pack_value(binary_to_list(V));
pack_value([H|T]) when is_integer(H) -> list_to_binary([H|T]);
pack_value({integers, List}) -> List;
pack_value(V) -> V.
unpack_value(_AttrName, [H|T], _ValueType) when is_integer(H) ->
{integers, [H|T]};
unpack_value(AttrName, Value, ValueType) ->
case is_id_attr(AttrName) and (Value =/= "") of
true ->
IdType = id_type_from_foreign_key(AttrName),
unpack_id(IdType, Value);
false ->
boss_record_lib:convert_value_to_type(Value, ValueType)
end.
id_type_from_foreign_key(ForeignKey) ->
Tokens = string:tokens(atom_to_list(ForeignKey), "_"),
NameTokens = lists:filter(fun(Token) -> Token =/= "id" end,
Tokens),
string:join(NameTokens, "_").
% Operators
boss_to_mongo_op('not_equals') -> '$ne';
boss_to_mongo_op('gt') -> '$gt';
boss_to_mongo_op('ge') -> '$gte';
boss_to_mongo_op('lt') -> '$lt';
boss_to_mongo_op('le') -> '$lte';
boss_to_mongo_op('in') -> '$in';
boss_to_mongo_op('not_in') -> '$nin'.
% Sort clauses
pack_sort_order(ascending) -> 1;
pack_sort_order(descending) -> -1.
%%
%% Generic data structure conversions
%%
% The mongodb driver uses "associative tuples" which look like:
% {key1, Value1, key2, Value2}
tuple_to_proplist(Tuple) ->
List = tuple_to_list(Tuple),
Ret = lists:reverse(list_to_proplist(List, [])),
Ret.
proplist_to_tuple(PropList) ->
ListOfLists = lists:reverse([[K,V]||{K,V} <- PropList]),
list_to_tuple(lists:foldl(
fun([K, V], Acc) ->
[K,V|Acc]
end, [], ListOfLists)).
list_to_proplist([], Acc) -> Acc;
list_to_proplist([K,V|T], Acc) ->
list_to_proplist(T, [{K, V}|Acc]).
datetime_to_now(DateTime) ->
GSeconds = calendar:datetime_to_gregorian_seconds(DateTime),
ESeconds = GSeconds - ?GREGORIAN_SECONDS_1970,
{ESeconds div 1000000, ESeconds rem 1000000, 0}.
%%
%% Decimal to hexadecimal conversion
%%
%% Functions below copied from emongo <https://github.com/boorad/emongo>
%%
%% Copyright (c) 2009 Jacob Vorreuter <jacob.vorreuter@gmail.com>
%% Jacob Perkins <japerk@gmail.com>
%% Belyaev Dmitry <rumata-estor@nm.ru>
%% François de Metz <fdemetz@af83.com>
%%
dec2hex(Dec) ->
dec2hex(<<>>, Dec).
dec2hex(N, <<I:8,Rem/binary>>) ->
dec2hex(<<N/binary, (hex0((I band 16#f0) bsr 4)):8, (hex0((I band 16#0f))):8>>, Rem);
dec2hex(N,<<>>) ->
N.
hex2dec(Hex) when is_list(Hex) ->
hex2dec(list_to_binary(Hex));
hex2dec(Hex) ->
hex2dec(<<>>, Hex).
hex2dec(N,<<A:8,B:8,Rem/binary>>) ->
hex2dec(<<N/binary, ((dec0(A) bsl 4) + dec0(B)):8>>, Rem);
hex2dec(N,<<>>) ->
N.
dec0($a) -> 10;
dec0($b) -> 11;
dec0($c) -> 12;
dec0($d) -> 13;
dec0($e) -> 14;
dec0($f) -> 15;
dec0(X) -> X - $0.
hex0(10) -> $a;
hex0(11) -> $b;
hex0(12) -> $c;
hex0(13) -> $d;
hex0(14) -> $e;
hex0(15) -> $f;
hex0(I) -> $0 + I.
Jump to Line
Something went wrong with that request. Please try again.