/src/support/z_utils.erl
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