PageRenderTime 109ms CodeModel.GetById 9ms app.highlight 92ms RepoModel.GetById 2ms app.codeStats 0ms

/src/support/z_utils.erl

https://code.google.com/p/zotonic/
Erlang | 876 lines | 654 code | 140 blank | 82 comment | 29 complexity | 257609fd86ecd1da896b04fd319922f8 MD5 | raw file
  1%% @author Marc Worrell
  2%% @copyright 2009 Marc Worrell
  3%%
  4%% Parts are from wf_utils.erl which is Copyright (c) 2008-2009 Rusty Klophaus
  5%%
  6%% @doc Misc utility functions for zotonic
  7
  8%% Copyright 2009 Marc Worrell
  9%%
 10%% Licensed under the Apache License, Version 2.0 (the "License");
 11%% you may not use this file except in compliance with the License.
 12%% You may obtain a copy of the License at
 13%%
 14%%     http://www.apache.org/licenses/LICENSE-2.0
 15%%
 16%% Unless required by applicable law or agreed to in writing, software
 17%% distributed under the License is distributed on an "AS IS" BASIS,
 18%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 19%% See the License for the specific language governing permissions and
 20%% limitations under the License.
 21
 22-module(z_utils).
 23-include("zotonic.hrl").
 24
 25-export ([
 26	are_equal/2,
 27	assert/2,
 28    encode_value/2,
 29    decode_value/2,
 30    encode_value_expire/3,
 31    decode_value_expire/2,
 32	checksum/2,
 33	checksum_assert/3,
 34	coalesce/1,
 35	combine/2,
 36	combine_defined/2,
 37	decode/2,
 38	depickle/2,
 39	encode/2,
 40	f/1,
 41	f/2,
 42	get_seconds/0,
 43	group_by/3,
 44	group_proplists/2,
 45	hex_decode/1,
 46	hex_encode/1,
 47	index_proplist/2,
 48	nested_proplist/1,
 49	nested_proplist/2,
 50	get_nth/2,
 51	set_nth/3,
 52	is_empty/1,
 53	is_process_alive/1,
 54	is_true/1,
 55	js_escape/1,
 56	js_array/1,
 57	js_object/1,
 58	js_object/2,
 59	lib_dir/0,
 60	lib_dir/1,
 61	list_dir_recursive/1,
 62	name_for_host/2,
 63	only_digits/1,
 64	only_letters/1,
 65	is_iolist/1,
 66	is_proplist/1,
 67	os_escape/1,
 68	os_filename/1,
 69	pickle/2,
 70	prefix/2,
 71	prop_delete/2,
 72	prop_replace/3,
 73	randomize/1,
 74	randomize/2,
 75	replace1/3,
 76	split/2,
 77	split_in/2,
 78	url_path_encode/1,
 79	url_encode/1,
 80	url_decode/1,
 81	vsplit_in/2,
 82    now/0,
 83    now_msec/0,
 84    tempfile/0,
 85    url_reserved_char/1,
 86    url_unreserved_char/1,
 87    url_valid_char/1,
 88    flush_message/1,
 89    ensure_existing_module/1
 90]).
 91
 92%%% FORMAT %%%
 93
 94f(S) -> f(S, []).
 95f(S, Args) -> lists:flatten(io_lib:format(S, Args)).
 96
 97
 98%% @doc Return an abspath to a directory relative to the application root.
 99%% This is used to prevent that we have to name the root dir "zotonic".
100lib_dir() ->
101	{ok, Path} = zotonic_app:get_path(),
102	Path.
103lib_dir(Dir) ->
104	{ok, Path} = zotonic_app:get_path(),
105	filename:join([Path, z_convert:to_list(Dir)]).
106
107
108%% @doc Return the current tick count
109now() ->
110    {M,S,_M} = erlang:now(),
111    M*1000000 + S.
112
113now_msec() ->
114    {M,S,Micro} = erlang:now(),
115    M*1000000000 + S*1000 + Micro div 1000.
116
117%% @doc Return the current universal time in seconds
118get_seconds() -> calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
119
120
121%% @doc Multinode is_process_alive check
122is_process_alive(Pid) ->
123	case is_pid(Pid) of
124		true ->
125			% If node(Pid) is down, rpc:call returns something other than
126			% true or false.
127			case rpc:call(node(Pid), erlang, is_process_alive, [Pid]) of
128				true -> true;
129				_ -> false
130			end;
131		_ -> false
132	end.
133	
134
135%%% HEX ENCODE and HEX DECODE
136
137hex_encode(Data) -> encode(Data, 16).
138hex_decode(Data) -> decode(Data, 16).
139
140encode(Data, Base) when is_binary(Data) -> encode(binary_to_list(Data), Base);
141encode(Data, Base) when is_list(Data) ->
142	F = fun(C) when is_integer(C) ->
143		case erlang:integer_to_list(C, Base) of
144			[C1, C2] -> [C1, C2];
145			[C1]     -> [$0, C1]
146		end
147	end,
148	[F(I) || I <- Data].
149
150decode(Data, Base) when is_binary(Data) -> decode(binary_to_list(Data), Base);
151decode(Data, Base) when is_list(Data) ->
152	inner_decode(Data, Base).
153
154inner_decode(Data, Base) when is_list(Data) ->
155	case Data of
156		[C1, C2|Rest] ->
157			I = erlang:list_to_integer([C1, C2], Base),
158			[I|inner_decode(Rest, Base)];
159		[] ->
160			[]
161	end.
162
163
164%% Encode value securely, for use in cookies.
165
166%% 50 usec on core2duo 2GHz
167encode_value(Value, Context) ->
168    Salt = z_ids:id(),
169	Secret = z_ids:sign_key(Context),
170    base64:encode(
171        term_to_binary({Value, Salt, crypto:sha_mac(Secret, term_to_binary([Value, Salt]))})
172    ).
173
174%% 23 usec on core2duo 2GHz
175decode_value(Data, Context) ->
176    Secret = z_ids:sign_key(Context),
177    {Value, Salt, Sign} = binary_to_term(base64:decode(Data)),
178    Sign = crypto:sha_mac(Secret, term_to_binary([Value, Salt])),
179    Value.
180
181encode_value_expire(Value, Date, Context) ->
182    encode_value({Value, Date}, Context).
183
184decode_value_expire(Data, Context) ->
185    {Value, Expire} = decode_value(Data, Context),
186    case Expire >= calendar:local_time() of
187        false -> {error, expired};
188        true -> {ok, Value}
189    end.
190
191%%% CHECKSUM %%%
192
193checksum(Data, Context) ->
194    Sign = z_ids:sign_key_simple(Context),
195    z_utils:hex_encode(erlang:md5([Sign,Data])).
196
197checksum_assert(Data, Checksum, Context) ->
198    Sign = z_ids:sign_key_simple(Context),
199    assert(list_to_binary(z_utils:hex_decode(Checksum)) == erlang:md5([Sign,Data]), checksum_invalid).
200
201%%% PICKLE / UNPICKLE %%%
202
203pickle(Data, Context) ->
204    BData = erlang:term_to_binary(Data),
205	Nonce = z_ids:number(1 bsl 31),
206	Sign  = z_ids:sign_key(Context),
207	SData = <<BData/binary, Nonce:32, Sign/binary>>,
208	<<C1:64,C2:64>> = erlang:md5(SData),
209	base64:encode(<<C1:64, C2:64, Nonce:32, BData/binary>>).
210
211depickle(Data, Context) ->
212    try
213        <<C1:64, C2:64, Nonce:32, BData/binary>> = base64:decode(Data),
214    	Sign  = z_ids:sign_key(Context),
215    	SData = <<BData/binary, Nonce:32, Sign/binary>>,
216    	<<C1:64, C2:64>> = erlang:md5(SData),
217    	erlang:binary_to_term(BData)
218    catch
219        _M:_E -> erlang:throw("Postback data invalid, could not depickle: "++Data)
220    end.
221
222
223%%% URL ENCODE %%%
224
225url_encode(S) -> 
226    %% @todo possible speedups for binaries
227    mochiweb_util:quote_plus(S).
228
229% hexdigit is from Mochiweb.
230
231-define(PERCENT, 37).  % $\%
232
233hexdigit(C) when C < 10 -> $0 + C;
234hexdigit(C) when C < 16 -> $A + (C - 10).
235
236%%% URL PATH ENCODE %%%
237
238%% url spec for path part
239url_path_encode(L) when is_list(L) ->
240    url_path_encode(L, []);
241url_path_encode(L) ->
242    url_path_encode(z_convert:to_list(L)).
243
244url_path_encode([], Acc) ->
245    lists:reverse(Acc);
246url_path_encode([$/|R], Acc) ->
247    url_path_encode(R, [$/|Acc]);
248url_path_encode([C|R], Acc) when (C==$: orelse C==$@ orelse C==$& orelse C==$= orelse C==$+ orelse C==$$ orelse C==$ orelse C==$;) ->
249    url_path_encode(R, [C|Acc]);
250url_path_encode([C|R], Acc)->
251    case url_unreserved_char(C) of
252        true ->
253            url_path_encode(R, [C|Acc]);
254        false ->
255            <<Hi:4, Lo:4>> = <<C>>,
256            url_path_encode(R, [hexdigit(Lo), hexdigit(Hi), ?PERCENT | Acc])
257    end.
258
259
260%% @spec os_filename(String) -> String
261%% @doc Simple escape function for filenames as commandline arguments.
262%% foo/"bar.jpg -> "foo/\"bar.jpg"; on windows "foo\\\"bar.jpg" (both including quotes!)
263os_filename(A) when is_binary(A) ->
264    os_filename(binary_to_list(A));
265os_filename(A) when is_list(A) ->
266    os_filename(lists:flatten(A), []).
267
268os_filename([], Acc) ->
269    filename:nativename([$"] ++ lists:reverse(Acc) ++ [$"]);
270os_filename([$\\|Rest], Acc) ->
271    os_filename_bs(Rest, Acc);
272os_filename([$"|Rest], Acc) ->
273    os_filename(Rest, [$", $\\ | Acc]);
274os_filename([C|Rest], Acc) ->
275    os_filename(Rest, [C|Acc]).
276
277os_filename_bs([$\\|Rest], Acc) ->
278    os_filename(Rest, [$\\,$\\|Acc]);
279os_filename_bs([$"|Rest], Acc) ->
280    os_filename(Rest, [$",$\\,$\\,$\\|Acc]);
281os_filename_bs([C|Rest], Acc) ->
282    os_filename(Rest, [C,$\\|Acc]).
283
284
285%% @spec os_escape(String) -> String
286%% @doc Simple escape function for command line arguments
287os_escape(undefined) ->
288	[];
289os_escape(A) when is_binary(A) ->
290    os_escape(binary_to_list(A));
291os_escape(A) when is_list(A) ->
292    {Family, _} = os:type(),
293    os_escape(Family, lists:flatten(A), []).
294
295os_escape(_, [], Acc) ->
296    lists:reverse(Acc);
297os_escape(unix, [C|Rest], Acc) when
298                (C >= $A andalso C =< $Z)
299         orelse (C >= $a andalso C =< $z)
300         orelse (C >= $0 andalso C =< $9)
301         orelse C == $_
302         orelse C == $.
303         orelse C == $-
304         orelse C == $+
305         orelse C == $/
306    ->
307    os_escape(unix, Rest, [C|Acc]);
308os_escape(unix, [C|Rest], Acc) when
309                C >= 32
310        orelse  C == $\r
311        orelse  C == $\n
312        orelse  C == $\t
313    ->
314    os_escape(unix, Rest, [C,$\\|Acc]);
315
316%% Win32 escaping, see: http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/ntcmds_shelloverview.mspx
317os_escape(win32, [C|Rest], Acc) when C == $&
318         orelse C == $|
319         orelse C == $;
320         orelse C == $,
321         orelse C == $%
322         orelse C == $(
323         orelse C == $)
324         orelse C == $"
325         orelse C == $'
326         orelse C == $=
327         orelse C == $^
328         orelse C == 32
329    ->
330    os_escape(win32, Rest, [C,$^|Acc]);
331os_escape(win32, [C|Rest], Acc) ->
332    os_escape(win32, Rest, [C|Acc]).
333
334
335url_decode(S) ->
336    lists:reverse(url_decode(S, [])).
337
338url_decode([], Acc) -> 
339    Acc;
340url_decode([$%, A, B|Rest], Acc) ->
341    Ch = erlang:list_to_integer([A, B], 16),
342    url_decode(Rest, [Ch|Acc]);
343url_decode([$+|Rest], Acc) ->
344    url_decode(Rest, [32|Acc]);
345url_decode([Ch|Rest], Acc) ->
346    url_decode(Rest, [Ch|Acc]).
347
348%% VALID URL CHARACTERS
349%% RFC 3986
350url_valid_char(Char) ->
351    url_reserved_char(Char) orelse url_unreserved_char(Char).
352
353url_reserved_char($!) -> true;
354url_reserved_char($*) -> true;
355url_reserved_char($") -> true;
356url_reserved_char($') -> true;
357url_reserved_char($() -> true;
358url_reserved_char($)) -> true;
359url_reserved_char($;) -> true;
360url_reserved_char($:) -> true;
361url_reserved_char($@) -> true;
362url_reserved_char($&) -> true;
363url_reserved_char($=) -> true;
364url_reserved_char($+) -> true;
365url_reserved_char($$) -> true;
366url_reserved_char($,) -> true;
367url_reserved_char($/) -> true;
368url_reserved_char($?) -> true;
369url_reserved_char($%) -> true;
370url_reserved_char($#) -> true;
371url_reserved_char($[) -> true;
372url_reserved_char($]) -> true;
373url_reserved_char(_) -> false.
374
375url_unreserved_char(Ch) when Ch >= $A andalso Ch < $Z + 1 -> true;
376url_unreserved_char(Ch) when Ch >= $a andalso Ch < $z + 1 -> true;
377url_unreserved_char(Ch) when Ch >= $0 andalso Ch < $9 + 1 -> true;
378url_unreserved_char($-) -> true;
379url_unreserved_char($_) -> true;
380url_unreserved_char($.) -> true;
381url_unreserved_char($~) -> true;
382url_unreserved_char(_)  -> false.
383
384
385
386%%% ESCAPE JAVASCRIPT %%%
387
388%% @doc Javascript escape, see also: http://code.google.com/p/doctype/wiki/ArticleXSSInJavaScript
389
390js_escape(undefined) -> [];
391js_escape([]) -> [];
392js_escape(<<>>) -> [];
393js_escape(Value) when is_integer(Value) -> integer_to_list(Value);
394js_escape(Value) when is_atom(Value) ->  js_escape(atom_to_list(Value), []);
395js_escape(Value) when is_binary(Value) -> js_escape(binary_to_list(Value), []);
396js_escape(Value) -> js_escape(Value, []).
397
398js_escape([], Acc) -> lists:reverse(Acc);
399js_escape([$\\|T], Acc) -> js_escape(T, [$\\,$\\|Acc]);
400js_escape([$\n|T], Acc) -> js_escape(T, [$n,$\\|Acc]);
401js_escape([$\r|T], Acc) -> js_escape(T, [$r,$\\|Acc]);
402js_escape([$\t|T], Acc) -> js_escape(T, [$t,$\\|Acc]);
403js_escape([$'|T], Acc) -> js_escape(T, [$7,$2,$x,$\\|Acc]);
404js_escape([$"|T], Acc) -> js_escape(T, [$2,$2,$x,$\\|Acc]);
405js_escape([$<|T], Acc) -> js_escape(T, [$c,$3,$x,$\\|Acc]);
406js_escape([$>|T], Acc) -> js_escape(T, [$e,$3,$x,$\\|Acc]);
407js_escape([$=|T], Acc) -> js_escape(T, [$d,$3,$x,$\\|Acc]);
408js_escape([$&|T], Acc) -> js_escape(T, [$6,$2,$x,$\\|Acc]);
409%% js_escape([16#85,C|T], Acc) when C >= 16#80 -> js_escape(T, [C,16#85|Acc]);
410%% js_escape([16#85|T], Acc) -> js_escape(T, [$5,$8,$0,$0,$u,$\\|Acc]);
411js_escape([16#2028|T],Acc)-> js_escape(T, [$8,$2,$0,$2,$u,$\\|Acc]);
412js_escape([16#2029|T],Acc)-> js_escape(T, [$9,$2,$0,$2,$u,$\\|Acc]);
413js_escape([16#e2,16#80,16#a8|T],Acc)-> js_escape(T, [$8,$2,$0,$2,$u,$\\|Acc]);
414js_escape([16#e2,16#80,16#a9|T],Acc)-> js_escape(T, [$9,$2,$0,$2,$u,$\\|Acc]);
415js_escape([H|T], Acc) when is_integer(H) ->
416    js_escape(T, [H|Acc]);
417js_escape([H|T], Acc) ->
418    H1 = js_escape(H),
419    js_escape(T, [H1|Acc]).
420
421%% js_escape(<<"<script", Rest/binary>>, Acc) -> js_escape(Rest, <<Acc/binary, "<scr\" + \"ipt">>);
422%% js_escape(<<"script>", Rest/binary>>, Acc) -> js_escape(Rest, <<Acc/binary, "scr\" + \"ipt>">>);
423
424js_array(L) ->
425    [ $[, combine($,,[ js_prop_value(undefined, V) || V <- L ]), $] ].
426
427%% @doc Create a javascript object from a proplist
428js_object([]) -> <<"{}">>;
429js_object(L) -> js_object(L,[]).
430
431js_object(L, []) -> js_object1(L, []);
432js_object(L, [Key|T]) -> js_object(proplists:delete(Key,L), T).
433
434%% recursively add all properties as object properties
435js_object1([], Acc) ->
436    [${, combine($,,lists:reverse(Acc)), $}];
437js_object1([{Key,Value}|T], Acc) ->
438    Prop = [atom_to_list(Key), $:, js_prop_value(Key, Value)],
439    js_object1(T, [Prop|Acc]).
440
441js_prop_value(_, undefined) -> <<"null">>;
442js_prop_value(_, true) -> <<"true">>;
443js_prop_value(_, false) -> <<"true">>;
444js_prop_value(_, Atom) when is_atom(Atom) -> [$",js_escape(erlang:atom_to_list(Atom)), $"];
445js_prop_value(pattern, [$/|T]=List) ->
446    %% Check for regexp
447    case length(T) of
448        Len when Len =< 2 ->
449            [$",js_escape(List),$"];
450        _Len ->
451            case string:rchr(T, $/) of
452                0 ->
453                    [$",js_escape(List),$"];
454                N ->
455                    {_Re, [$/|Options]} = lists:split(N-1,T),
456                    case only_letters(Options) of
457                        true -> List;
458                        false -> [$",js_escape(List),$"]
459                    end
460            end
461    end;
462js_prop_value(_, Int) when is_integer(Int) -> integer_to_list(Int);
463js_prop_value(_, Value) -> [$",js_escape(Value),$"].
464
465
466only_letters([]) ->
467    true;
468only_letters([C|T]) when (C >= $a andalso C =< $z) orelse (C >= $A andalso C =< $Z) ->
469    only_letters(T);
470only_letters(_) ->
471    false.
472
473only_digits([]) ->
474    false;
475only_digits(L) when is_list(L) ->
476    only_digits1(L);
477only_digits(B) when is_binary(B) ->
478    only_digits(binary_to_list(B)).
479
480    only_digits1([]) ->
481        true;
482    only_digits1([C|R]) when C >= $0 andalso C =< $9 ->
483        only_digits1(R);
484    only_digits1(_) ->
485        false.
486
487is_iolist(C) when is_integer(C) andalso C >= 0 andalso C =< 255 -> true;
488is_iolist(B) when is_binary(B) -> true;
489is_iolist([H|L]) -> is_iolist(H) andalso is_iolist(L);
490is_iolist(_) -> false.
491
492is_proplist([]) -> true;
493is_proplist([{K,_}|R]) when is_atom(K) -> is_proplist(R);
494is_proplist(_) -> false.
495
496
497combine_defined(Sep, List) ->
498    List2 = lists:filter(fun(X) -> X /= undefined end, List),
499    combine(Sep, List2).
500
501combine(_Sep, []) -> [];
502combine(_Sep, [A]) -> [A];
503combine(Sep, [H|T]) -> [H, prefix(Sep, T)].
504
505prefix(Sep, List) -> prefix(Sep,List,[]).
506
507prefix(_Sep, [], Acc) -> lists:reverse(Acc);
508prefix(Sep, [H|T], Acc) -> prefix(Sep, T, [H,Sep|Acc]).
509
510
511%%% COALESCE %%%
512
513coalesce([]) -> undefined;
514coalesce([H]) -> H;
515coalesce([undefined|T]) -> coalesce(T);
516coalesce([[]|T]) -> coalesce(T);
517coalesce([H|_]) -> H.
518
519
520%% @doc Check if a value is 'empty'
521is_empty(undefined) -> true;
522is_empty([]) -> true;
523is_empty(<<>>) -> true;
524is_empty(_) -> false.
525
526%% @doc Check if the parameter could represent the logical value of "true"
527is_true([$t|_T]) -> true;
528is_true([$y|_T]) -> true;
529is_true([$T|_T]) -> true;
530is_true([$Y|_T]) -> true;
531is_true("on") -> true;
532is_true("ON") -> true;
533is_true("1") -> true;
534
535is_true(<<"true">>) -> true;
536is_true(<<"yes">>) -> true;
537is_true(<<"on">>) -> true;
538is_true(<<"TRUE">>) -> true;
539is_true(<<"YES">>) -> true;
540is_true(<<"ON">>) -> true;
541is_true(<<"1">>) -> true;
542
543is_true(true) -> true;
544is_true(yes) -> true;
545is_true(on) -> true;
546
547is_true(N) when is_integer(N) andalso N /= 0 -> true;
548
549is_true(_) -> false.
550
551
552%% @spec assert(bool(), error) -> none()
553%% @doc Check if an assertion is ok or failed
554assert(false, Error) -> erlang:error(Error);
555assert(_, _) -> ok.
556
557
558%% @doc Replace a property in a proplist
559prop_replace(Prop, Value, List) ->
560    [{Prop,Value} | lists:keydelete(Prop,1,List)].
561
562prop_delete(Prop, List) ->
563    lists:keydelete(Prop, 1, List).
564
565%% @doc Given a list of proplists, make it a nested list with respect to a property, combining elements
566%% with the same property.  Assumes the list is sorted on the property you are splitting on
567%% For example:  [[{a,b}{x}], [{a,b}{z}], [{a,c}{y}]] gives:
568%%   [ {b, [[{a,b}{x}], [{a,b}{z}]]},  {c, [[{a,c}{y}]]} ]
569%% @spec group_proplists(Property, [PropList]) -> PropList
570group_proplists(_Prop, []) ->
571    [];
572group_proplists(Prop, [Item|Rest]) ->
573    PropValue = proplists:get_value(Prop, Item),
574    group_proplists(Prop, PropValue, Rest, [Item], []).
575
576group_proplists(_Prop, _PropValue, [], [], Result) ->
577    lists:reverse(Result);
578group_proplists(Prop, PropValue, [], Acc, Result) ->
579    lists:reverse(Acc),
580    group_proplists(Prop, PropValue, [], [], [{z_convert:to_atom(PropValue),Acc}|Result]);
581group_proplists(Prop, PropValue, [C|Rest], Acc, Result) ->
582    case proplists:get_value(Prop, C) of
583        PropValue ->
584            group_proplists(Prop, PropValue, Rest, [C|Acc], Result);
585        Other ->
586            group_proplists(Prop, Other, Rest, [C], [{z_convert:to_atom(PropValue),Acc}|Result])
587    end.
588
589
590%% @doc Make a property list based on the value of a property
591%% For example:  [  [{a,b}], [{a,c}] ]  gives  [{a, [{a,b}]}, {c, [[{a,c}]]}]
592%% @spec index_proplist(Property, [PropList]) -> PropList
593index_proplist(_Prop, []) ->
594    [];
595index_proplist(Prop, List) ->
596    index_proplist(Prop, List, []).
597
598index_proplist(_Prop, [], Acc) ->
599    lists:reverse(Acc);
600index_proplist(Prop, [L|Rest], Acc) ->
601    index_proplist(Prop, Rest, [{z_convert:to_atom(proplists:get_value(Prop,L)),L}|Acc]).
602
603
604%% @doc Scan the props of a proplist, when the prop is a list with a $. characters in it then split the prop.
605nested_proplist(Props) ->
606    nested_proplist(Props, []).
607
608nested_proplist([], Acc) ->
609    lists:reverse(Acc);
610nested_proplist([{K,V}|T], Acc) when is_list(K) ->
611    case string:tokens(K, ".") of
612        [K0] -> nested_proplist(T, [{K0,V}|Acc]);
613        List -> nested_proplist(T, nested_props_assign(List, V, Acc))
614    end;
615nested_proplist([H|T], Acc) ->
616    nested_proplist(T, [H|Acc]).
617
618
619    nested_props_assign([K], V, Acc) ->
620        case only_digits(K) of
621            true ->  set_nth(list_to_integer(K), V, Acc);
622            false -> prop_replace(z_convert:to_atom(K), V, Acc)
623        end;
624    nested_props_assign([H|T], V, Acc) ->
625        case only_digits(H) of
626            true -> 
627                Index = list_to_integer(H),
628                NewV = case get_nth(Index, Acc) of
629                           L when is_list(L) -> nested_props_assign(T, V, L);
630                           _ -> nested_props_assign(T, V, [])
631                       end,
632                set_nth(Index, NewV, Acc);
633            false ->
634                K = z_convert:to_atom(H),
635                NewV = case proplists:get_value(K, Acc) of
636                    L when is_list(L) -> nested_props_assign(T, V, L);
637                    _ -> nested_props_assign(T, V, [])
638                end,
639                prop_replace(K, NewV, Acc)
640        end.
641
642
643get_nth(N, L) when N >= 1 ->
644    try lists:nth(N, L) catch _:_ -> undefined end.
645
646set_nth(N, V, L) when N >= 1 ->
647    try 
648        case lists:split(N-1, L) of
649            {Pre, []} -> Pre ++ [V];
650            {Pre, [_|T]} -> Pre ++ [V|T]
651        end
652    catch _:_ ->
653        set_nth(N, V, L ++ [undefined])
654    end.
655
656
657
658%% @doc Simple randomize of a list. Not good quality, but good enough for us
659randomize(List) ->
660    {A1,A2,A3} = erlang:now(),
661    random:seed(A1, A2, A3),
662    D = lists:map(fun(A) ->
663                    {random:uniform(), A}
664             end, List),
665    {_, D1} = lists:unzip(lists:keysort(1, D)),
666    D1.
667
668randomize(N, List) ->
669    split(N, randomize(List)).
670
671split(N, L) ->
672    split(N,L,[]).
673
674split(_N, [], Acc) ->
675    {lists:reverse(Acc), []};
676split(0, Rest, Acc) ->
677    {lists:reverse(Acc), Rest};
678split(N, [A|Rest], Acc) ->
679    split(N-1, Rest, [A|Acc]).
680
681
682split_in(L, N) when N =< 1 ->
683    L;
684split_in(L, N) when is_binary(L) ->
685    split_in(binary_to_list(L), N);
686split_in(L, N) when is_list(L) ->
687    [ lists:reverse(SubList) || SubList <- split_in(L, [], split_in_acc0(N, [])) ].
688
689    split_in_acc0(0, Acc) -> Acc;
690    split_in_acc0(N, Acc) -> split_in_acc0(N-1, [[] | Acc]).
691
692    split_in([], Acc1, Acc0) ->
693        lists:reverse(Acc1) ++ Acc0;
694    split_in(L, Acc1, []) ->
695        split_in(L, [], lists:reverse(Acc1));
696    split_in([H|T], Acc1, [HA|HT]) ->
697        split_in(T, [[H|HA]|Acc1], HT).
698
699
700vsplit_in(L, N) when N =< 1 ->
701	L;
702vsplit_in(L, N) when is_binary(L) ->
703	vsplit_in(binary_to_list(L), N);
704vsplit_in(L, N) ->
705	Len = length(L),
706	RunLength = case Len rem N of
707		0 -> Len div N;
708		_ -> Len div N + 1
709	end,
710	vsplit_in(N, L, RunLength, []).
711
712	vsplit_in(1, L, _, Acc) ->
713		lists:reverse([L|Acc]);
714	vsplit_in(N, [], RunLength, Acc) ->
715		vsplit_in(N-1, [], RunLength, [[]|Acc]);
716	vsplit_in(N, L, RunLength, Acc) ->
717		{Row,Rest} = lists:split(RunLength, L),
718		vsplit_in(N-1, Rest, RunLength, [Row|Acc]).
719
720
721%% @doc Group by a property or m_rsc property, keeps the input list in the same order.
722group_by([], _, _Context) ->
723    [];
724group_by(L, Prop, Context) ->
725    LP = [ group_by_addprop(H, Prop, Context) || H <- L ],
726    Dict1 = group_by_dict(LP, dict:new()),
727    group_by_fetch_in_order(LP, [], Dict1, []).
728
729    group_by_fetch_in_order([], _, _, Acc) ->
730        lists:reverse(Acc);
731    group_by_fetch_in_order([{Key,_}|T], Ks, Dict, Acc) ->
732        case lists:member(Key, Ks) of
733            true -> group_by_fetch_in_order(T, Ks, Dict, Acc);
734            false -> group_by_fetch_in_order(T, [Key|Ks], Dict, [dict:fetch(Key, Dict)|Acc])
735        end.
736
737    group_by_dict([], Dict) ->
738        Dict;
739    group_by_dict([{Key,V}|T], Dict) ->
740        case dict:is_key(Key, Dict) of
741            true -> group_by_dict(T, dict:append(Key, V, Dict));
742            false -> group_by_dict(T, dict:store(Key, [V], Dict))
743        end.
744
745    group_by_addprop(Id, Prop, Context) when is_integer(Id) ->
746        {m_rsc:p(Id, Prop, Context), Id};
747    group_by_addprop(L, Prop, _Context) when is_list(L) ->
748        {proplists:get_value(Prop, L), L};
749    group_by_addprop(N, _Prop, _Context) ->
750        {undefined, N}.
751
752
753replace1(F, T, L) ->
754    replace1(F, T, L, []).
755replace1(_F, _T, [], Acc) ->
756    lists:reverse(Acc);
757replace1(F, T, [F|R], Acc) ->
758    replace1(F, T, R, [T|Acc]);
759replace1(F, T, [C|R], Acc) ->
760    replace1(F, T, R, [C|Acc]).
761
762
763%% @doc Return a list of all files in a directory, recursive depth first search for files not starting with a '.'
764list_dir_recursive(Dir) ->
765    case file:list_dir(Dir) of
766        {ok, Files} ->
767            list_dir_recursive(Files, Dir, []);
768        {error, _} ->
769            []
770    end.
771
772    list_dir_recursive([], _BaseDir, Acc) ->
773        Acc;
774    list_dir_recursive([[$.|_]|OtherFiles], BaseDir, Acc) ->
775        list_dir_recursive(OtherFiles, BaseDir, Acc);
776    list_dir_recursive([File|OtherFiles], BaseDir, Acc) ->
777        Path = filename:join(BaseDir, File),
778        case filelib:is_regular(Path) of
779            true ->
780                list_dir_recursive(OtherFiles, BaseDir, [File|Acc]);
781            false ->
782                case filelib:is_dir(Path) of
783                    true ->
784                        Acc1 = case file:list_dir(Path) of
785                            {ok, Files} ->
786                                NonDotFiles = lists:filter(fun([$.|_]) -> false; (_) -> true end, Files),
787                                RelFiles = [ filename:join(File, F) || F <- NonDotFiles],
788                                list_dir_recursive(RelFiles, BaseDir, Acc);
789                            {error, _} ->
790                                Acc
791                        end,
792                        list_dir_recursive(OtherFiles, BaseDir, Acc1);
793                    false ->
794                        list_dir_recursive(OtherFiles, BaseDir, Acc)
795                end
796        end.
797
798
799%% @doc Check if two arguments are equal, optionally converting them
800are_equal(Arg1, Arg2) when Arg1 =:= Arg2 ->
801    true;
802are_equal(Arg1, Arg2) when is_boolean(Arg1) ->
803    Arg1 == z_convert:to_bool(Arg2);
804are_equal(Arg1, Arg2) when is_boolean(Arg2) ->
805    Arg2 == z_convert:to_bool(Arg1);
806are_equal(Arg1, Arg2) when is_atom(Arg1) ->
807    are_equal(atom_to_list(Arg1), Arg2);
808are_equal(Arg1, Arg2) when is_atom(Arg2) ->
809    are_equal(Arg1, atom_to_list(Arg2));
810are_equal(Arg1, Arg2) when is_binary(Arg1) ->
811    are_equal(binary_to_list(Arg1), Arg2);
812are_equal(Arg1, Arg2) when is_binary(Arg2) ->
813    are_equal(Arg1, binary_to_list(Arg2));
814are_equal(Arg1, Arg2) when is_integer(Arg1) ->
815    are_equal(integer_to_list(Arg1), Arg2);
816are_equal(Arg1, Arg2) when is_integer(Arg2) ->
817    are_equal(Arg1, integer_to_list(Arg2));
818are_equal(_Arg1, _Arg2) ->
819    false.
820
821
822%% @doc Return the name used in the context of a hostname
823%% @spec name_for_host(atom(), atom()) -> atom()
824name_for_host(Name, Host) ->
825    z_convert:to_atom(z_convert:to_list(Name) ++ [$$, z_convert:to_list(Host)]).
826
827
828%% @doc Ensure that the given string matches an existing module. Used to prevent
829%%      a denial of service attack where we exhaust the atom space.
830ensure_existing_module(ModuleName) when is_list(ModuleName) ->
831    case catch list_to_existing_atom(ModuleName) of
832        {'EXIT', {badarg, _Traceback}} ->
833            case code:where_is_file(ensure_valid_modulename(ModuleName) ++ ".beam") of
834                non_existing -> {error, not_found};
835                Absname ->
836                    {module, Module} = code:load_abs(filename:rootname(Absname)),
837                    {ok, Module}
838            end;
839        M ->
840            ensure_existing_module(M)
841     end;
842ensure_existing_module(ModuleName) when is_atom(ModuleName) ->
843    case module_loaded(ModuleName) of
844        true -> 
845            {ok, ModuleName};
846        false ->
847            {module, Module} = code:ensure_loaded(ModuleName),
848            {ok, Module}
849    end;
850ensure_existing_module(ModuleName) when is_binary(ModuleName) ->
851    ensure_existing_module(binary_to_list(ModuleName)).
852
853    % Crash on a modulename that is not valid.
854    ensure_valid_modulename(Name) ->
855        lists:filter(fun ensure_valid_modulechar/1, Name).
856            
857        ensure_valid_modulechar(C) when C >= $0, C =< $9 -> true;
858        ensure_valid_modulechar(C) when C >= $a, C =< $z -> true;
859        ensure_valid_modulechar(C) when C >= $A, C =< $Z -> true;
860        ensure_valid_modulechar(C) when C == $_ -> true.
861
862
863%% @doc return a unique temporary filename.
864%% @spec tempfile() -> string()
865tempfile() ->
866    {A,B,C}=erlang:now(),
867    lists:flatten(io_lib:format("/tmp/ztmp-~p-~p.~p.~p",[node(),A,B,C])).
868    
869%% @doc Flush all incoming messages, used when receiving timer ticks to prevent multiple ticks.
870flush_message(Msg) ->
871    receive
872        Msg -> flush_message(Msg)
873    after 0 ->
874        ok
875    end.
876