PageRenderTime 48ms CodeModel.GetById 13ms RepoModel.GetById 0ms app.codeStats 1ms

/lib/rdbms/src/rdbms_props.erl

http://github.com/gebi/jungerl
Erlang | 967 lines | 651 code | 131 blank | 185 comment | 26 complexity | 71678930c768c913cee59d4286731782 MD5 | raw file
Possible License(s): AGPL-1.0, JSON, LGPL-2.1, BSD-3-Clause
  1. %%%
  2. %%% The contents of this file are subject to the Erlang Public License,
  3. %%% Version 1.0, (the "License"); you may not use this file except in
  4. %%% compliance with the License. You may obtain a copy of the License at
  5. %%% http://www.erlang.org/license/EPL1_0.txt
  6. %%%
  7. %%% Software distributed under the License is distributed on an "AS IS"
  8. %%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  9. %%% the License for the specific language governing rights and limitations
  10. %%% under the License.
  11. %%%
  12. %%% The Original Code is rdbms-1.2.
  13. %%%
  14. %%% The Initial Developer of the Original Code is Ericsson Telecom
  15. %%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
  16. %%% Telecom AB. All Rights Reserved.
  17. %%%
  18. %%% Contributor(s): ______________________________________.
  19. %%%----------------------------------------------------------------------
  20. %%% #0. BASIC INFORMATION
  21. %%%----------------------------------------------------------------------
  22. %%%-------------------------------------------------------------------
  23. %%% File : rdbms_props.erl
  24. %%% Author : Ulf Wiger <ulf.wiger@ericsson.com>
  25. %%% Description : rdbms property handling
  26. %%%
  27. %%% Created : 14 Dec 2005 by Ulf Wiger
  28. %%%-------------------------------------------------------------------
  29. -module(rdbms_props).
  30. -export([
  31. attr_property/3, attr_property/4,
  32. table_property/2, table_property/3,
  33. global_property/1, global_property/2,
  34. global_typedefs/0,
  35. attr_references/2,
  36. tab_references/1,
  37. indexes/1
  38. ]).
  39. %%% metadata queries when inside a schema transaction
  40. -export([
  41. schema_table_property/2, schema_table_property/3,
  42. schema_attr_property/3, schema_attr_property/4,
  43. schema_global_property/1, schema_global_property/2,
  44. schema_table_info/2,
  45. schema_global_typedefs/0
  46. ]).
  47. %%% attribute metadata accessors
  48. -export([%bounds/2, % (Tab, Attr)
  49. default/2, % (Tab, Attr)
  50. references/2, % (Tab, Attr)
  51. required/2, % (Tab, Attr)
  52. key_type/2, % (Tab, Attr)
  53. access/1, % (Tab, Attr)
  54. type/2]). % (Tab, Attr)
  55. %%% Table metadata accessors
  56. -export([attributes/1]).
  57. %%% Modifying metadata
  58. -export([set_property/3,
  59. do_set_property/3,
  60. %%% set_global_type/3,
  61. %%% do_set_global_type/3,
  62. drop_references/1,
  63. do_drop_references/1]).
  64. -export([make_rec_type/1, % (Tab)
  65. normalize_type/1, % (Type)
  66. normalize/1, % ([Type])
  67. global_typedefs_used/1, % (Tab)
  68. schema_global_typedefs_used/1, % (Tab)
  69. users_of_global_typedef/1 % (GlobalType)
  70. ]).
  71. -export([a_includes_b/2]).
  72. -include("rdbms.hrl").
  73. -import(lists, [foreach/2]).
  74. type(Tab, Attr) ->
  75. attr_property(Tab, Attr, type).
  76. %%% bounds(Tab, Attr) ->
  77. %%% attr_property(Tab, Attr, bounds).
  78. default(Tab, Attr) ->
  79. case attr_property(Tab, Attr, default) of
  80. undefined ->
  81. case attr_property(Tab, Attr, type) of
  82. oid ->
  83. {node(), erlang:now()};
  84. _ ->
  85. ?NULL
  86. end;
  87. {value, Value} ->
  88. Value;
  89. {auto, M, F} ->
  90. M:F(Tab, Attr)
  91. end.
  92. attributes(Tab) ->
  93. try mnesia:table_info(Tab, attributes)
  94. catch
  95. error:_ ->
  96. global_property({record, Tab, attributes})
  97. end.
  98. references(Tab, Attr) ->
  99. attr_references(Tab, Attr).
  100. required(Tab, Attr) ->
  101. attr_property(Tab, Attr, required).
  102. key_type(Tab, Attr) ->
  103. attr_property(Tab, Attr, key_type).
  104. access(Tab) ->
  105. case table_property(Tab, acl) of
  106. undefined ->
  107. undefined;
  108. Name when is_atom(Name) ->
  109. global_property({acl, Name});
  110. L when is_list(L) ->
  111. L
  112. end.
  113. attr_property(Tab, Attr, Prop) ->
  114. table_property(Tab, {attr, Attr, Prop}, undefined).
  115. attr_property(Tab, Attr, Prop, Default) ->
  116. table_property(Tab, {attr, Attr, Prop}, Default).
  117. table_property(Tab, Prop) ->
  118. table_property(Tab, Prop, undefined).
  119. table_property(Tab, Prop, Default) ->
  120. case catch mnesia:read_table_property(Tab, Prop) of
  121. {'EXIT', _} ->
  122. Default;
  123. {_, Value} ->
  124. Value
  125. end.
  126. global_property(Prop) ->
  127. table_property(schema, Prop, undefined).
  128. global_property(Prop, Default) ->
  129. table_property(schema, Prop, Default).
  130. %%% schema_xxxx(...) functions
  131. %%% These are intended for use within schema transactions
  132. schema_table_info(Tab) ->
  133. mnesia_schema:do_read_table_info(Tab).
  134. schema_table_info(Tab, size) ->
  135. [_|_] = mnesia_schema:do_read_table_info(Tab), % assertion
  136. {_, Tid, Ts} = get(mnesia_activity_state),
  137. try mnesia_frag:table_info(Tid, Ts, Tab, size)
  138. catch
  139. error:_ ->
  140. %% table exists, but has not yet been created (i.e. visible
  141. %% only within the schema transaction as metadata. 'size' is
  142. %% a dynamic property (so is 'memory', but why would one want
  143. %% to check that within a schema transaction?)
  144. 0
  145. end;
  146. schema_table_info(Tab, Item) ->
  147. Info = mnesia_schema:do_read_table_info(Tab),
  148. if Item == all -> Info;
  149. true ->
  150. case lists:keysearch(Item, 1, Info) of
  151. {value, {_, Value}} ->
  152. Value;
  153. false ->
  154. mnesia:abort({no_exists,Tab,Item})
  155. end
  156. end.
  157. schema_table_property(Tab, Prop) ->
  158. schema_table_property(Tab, Prop, undefined).
  159. schema_table_property(Tab, Prop, Default) ->
  160. Props = schema_table_info(Tab, user_properties),
  161. case lists:keysearch(Prop, 1, Props) of
  162. {value, {_, Value}} ->
  163. Value;
  164. false ->
  165. Default
  166. end.
  167. schema_attr_property(Tab, Attr, Prop) ->
  168. schema_attr_property(Tab, Attr, Prop, undefined).
  169. schema_attr_property(Tab, Attr, Prop, Default) ->
  170. Props = schema_table_info(Tab, user_properties),
  171. case lists:keysearch({attr,Attr,Prop}, 1, Props) of
  172. {value, {_, Value}} ->
  173. Value;
  174. false ->
  175. Default
  176. end.
  177. schema_global_property(Prop) ->
  178. schema_table_property(schema, Prop, undefined).
  179. schema_global_property(Prop, Default) ->
  180. schema_table_property(schema, Prop, Default).
  181. %%% schema_global_typedefs() ->
  182. %%% Props = schema_table_info(schema, user_properties),
  183. %%% [{T,V} || {{typedef, T}, V} <- Props].
  184. attr_references(Tab, Attr) ->
  185. %%% case attr_property(Tab, Attr, type) of
  186. %%% {global, GlobalType} ->
  187. %%% global_references(GlobalType);
  188. %%% _ ->
  189. case tab_references(Tab) of
  190. [] ->
  191. [];
  192. [_|_] = AllRefs ->
  193. lists:foldr(
  194. fun({attr, A, _} = R, Acc) when A==Attr ->
  195. [R|Acc];
  196. ({attr, As, _} = R, Acc) when is_list(As) ->
  197. case lists:member(Attr, As) of
  198. true ->
  199. [R|Acc];
  200. false ->
  201. Acc
  202. end;
  203. (_, Acc) -> Acc
  204. end, [], AllRefs)
  205. end.
  206. %%% global_references(Attr) when is_atom(Attr) ->
  207. %%% case global_property({attr, Attr, references}) of
  208. %%% undefined ->
  209. %%% [];
  210. %%% Refs when is_list(Refs) ->
  211. %%% Refs
  212. %%% end.
  213. indexes(Tab) ->
  214. table_property(Tab, indexes, []).
  215. %%% set_global_type(Class, Name, Opts) ->
  216. %%% F = fun() ->
  217. %%% do_set_global_type(Class, Name, Opts)
  218. %%% end,
  219. %%% mnesia_schema:schema_transaction(F).
  220. %%% do_set_global_type(acl, Name, Opts) ->
  221. %%% do_set_property(schema, {acl,Name}, Opts);
  222. %%% do_set_global_type(Class, Name, Opts) ->
  223. %%% mnesia_schema:verify(true, lists:member(Class, [attr, record, acl]),
  224. %%% {bad_global_type, Class, Name}),
  225. %%% lists:foreach(
  226. %%% fun({K,V}) ->
  227. %%% do_set_property(schema, {Class,Name,K}, V)
  228. %%% end, Opts).
  229. set_property(Tab, Key, Value) ->
  230. F = fun() ->
  231. do_set_property(Tab, Key, Value)
  232. end,
  233. mnesia_schema:schema_transaction(F).
  234. do_set_property(Tab, Key, Value) when Tab =/= schema ->
  235. case Key of
  236. references ->
  237. Refs = check_ref_props(Tab, Value),
  238. do_write_property(Tab, {references, Refs});
  239. add_references ->
  240. OldRefs = schema_table_property(Tab, references, []),
  241. AddRefs = check_ref_props(Tab, Value),
  242. NewRefs = merge_refs(AddRefs, OldRefs),
  243. do_write_property(Tab, {references, NewRefs});
  244. drop_references ->
  245. OldRefs = schema_table_property(Tab, references, []),
  246. NewRefs = drop_refs(Value, OldRefs),
  247. do_write_property(Tab, {references, NewRefs});
  248. indexes ->
  249. lists:foreach(fun(#index{}) -> true;
  250. (Other) -> mnesia:abort({invalid_index_record,
  251. [Tab, Other]})
  252. end, Value),
  253. do_write_property(Tab, {indexes, Value});
  254. write_filter ->
  255. try ets:match_spec_compile(Value) of
  256. _ ->
  257. do_write_property(Tab, {write_filter, Value})
  258. catch
  259. error:_ ->
  260. mnesia:abort({bad_filter, [write, Tab, Value]})
  261. end;
  262. read_filter ->
  263. try ets:match_spec_compile(Value) of
  264. _ ->
  265. do_write_property(Tab, {read_filter, Value})
  266. catch
  267. error:_ ->
  268. mnesia:abort({bad_filter, [read, Tab, Value]})
  269. end;
  270. acl ->
  271. Acl = check_acl(Value, [read, write, delete, '_']),
  272. do_write_property(Tab, {acl, Acl});
  273. %%% verify ->
  274. %%% case Value of
  275. %%% {M, F} when is_atom(M), is_atom(F) ->
  276. %%% do_write_property(Tab, {verify, {M,F}});
  277. %%% _Other ->
  278. %%% mnesia:abort({invalid_property, [Tab, Key, Value]})
  279. %%% end;
  280. {typedef, Name} ->
  281. Type = check_typedef(Tab, Name, Value),
  282. do_write_property(Tab, {{typedef,Name}, Type});
  283. {attr, Attr, type} ->
  284. Type = check_typedef(Tab, Attr, Value),
  285. do_write_property(Tab, {{attr, Attr, type}, Type}),
  286. RecType = make_rec_type(Tab),
  287. io:format(user,"RecType= ~p~n", [RecType]),
  288. io:format("rec_type(~p) = ~p~n", [Tab, RecType]),
  289. do_write_property(Tab, {rec_type, RecType});
  290. {attr, Attr, Prop} ->
  291. set_attr_prop(Tab, Attr, Prop, Value)
  292. end;
  293. do_set_property(schema, Key, Value) ->
  294. case Key of
  295. {acl, Name} when is_atom(Name) ->
  296. Acl = check_acl(Value, [read, write, delete, '_']),
  297. do_write_property(schema, {{acl,Name}, Acl});
  298. %%% acl ->
  299. %%% Acl = check_acl(Value, [write, delete]),
  300. %%% do_write_property(schema, {acl, Acl});
  301. %%% {attr, Attr, Prop} ->
  302. %%% set_attr_prop(schema, Attr, Prop, Value);
  303. {typedef, Name} ->
  304. Type = check_typedef(schema, Name, Value),
  305. do_write_property(schema, {{typedef,Name}, Type})
  306. end.
  307. check_typedef(Tab, Name, Def) ->
  308. Props = schema_table_info(Tab, user_properties),
  309. GlobalProps = if Tab == schema -> [];
  310. true -> schema_table_info(schema, user_properties)
  311. end,
  312. Fail = fun() ->
  313. mnesia:abort({bad_typedef, [Tab, Name]})
  314. end,
  315. check_type(Def, Props, GlobalProps, Fail),
  316. %% currently no optimizations
  317. Def.
  318. check_type(Def, Props, GlobalProps, Fail) ->
  319. Check = fun(D) ->
  320. check_type(D, Props, GlobalProps, Fail)
  321. end,
  322. case Def of
  323. undefined -> true;
  324. {tuple, Arity, Ts} when is_integer(Arity), Arity > 0 ->
  325. lists:foreach(Check, Ts);
  326. {tuple, Arity} when is_integer(Arity), Arity > 0 ->
  327. true;
  328. {function, Arity} when is_integer(Arity), Arity > 0 ->
  329. true;
  330. {list, T} -> Check(T);
  331. {type, T} ->
  332. case lists:keymember({typedef,T}, Props) orelse
  333. lists:keymember({typedef, T}, GlobalProps) of
  334. true -> true;
  335. false -> Fail()
  336. end;
  337. {'and', Ts} when is_list(Ts) -> lists:foreach(Check, Ts);
  338. {'or', Ts} when is_list(Ts) -> lists:foreach(Check, Ts);
  339. {enum, Vs} when is_list(Vs) -> true;
  340. %%% {'andalso', Ts} when is_list(Ts) -> lists:foreach(Check, Ts);
  341. %%% {'orelse', Ts} when is_list(Ts) -> lists:foreach(Check, Ts);
  342. {'not', A} -> Check(A);
  343. {'<', _} -> true;
  344. {'>', _} -> true;
  345. {'==', _} -> true;
  346. {'=/=', _} -> true;
  347. {'>=', _} -> true;
  348. {'=<', _} -> true;
  349. Bool when is_boolean(Bool) -> true;
  350. Simple when is_atom(Simple) ->
  351. case lists:member(Simple, simple_builtin_types()) of
  352. true ->
  353. true;
  354. false ->
  355. Fail()
  356. end
  357. end.
  358. set_attr_prop(Tab, Attr, Prop, Value) ->
  359. valid_attr(Tab, Attr),
  360. Invalid = fun() ->
  361. mnesia:abort(
  362. {invalid_attr_property, [Tab,Attr,Prop,Value]})
  363. end,
  364. case Prop of
  365. %%% type -> valid_attr_type(Tab, Attr, Value);
  366. %%% bounds -> valid_bounds(Tab, Attr, Value);
  367. required when is_boolean(Value) -> ok;
  368. key_type when Value==primary;
  369. Value==secondary;
  370. Value==none -> ok;
  371. default ->
  372. case Value of
  373. {value, _Term} -> ok;
  374. {auto, {M, F}} when is_atom(M), is_atom(F) -> ok;
  375. _ ->
  376. Invalid()
  377. end;
  378. _ ->
  379. Invalid()
  380. end,
  381. do_write_property(Tab, {{attr,Attr,Prop}, Value}),
  382. case Tab of
  383. schema ->
  384. if Prop == type ->
  385. re_normalize(Attr);
  386. %%% Prop == bounds ->
  387. %%% Tabs = users_of_global_type(Attr),
  388. %%% lists:foreach(
  389. %%% fun(Tab1) ->
  390. %%% BR = make_bounds_rec(Tab1),
  391. %%% do_write_property(Tab1, {bounds_rec, BR})
  392. %%% end, Tabs);
  393. true ->
  394. ok
  395. end;
  396. _ ->
  397. ok
  398. end.
  399. %%% valid_attribute(Tab, Attr) ->
  400. %%% Info = mnesia_schema:do_read_table_info(Tab),
  401. %%% {value, {_,Attrs}} = lists:keysearch(attributes, 1, Info),
  402. %%% case lists:member(Attr, Attrs) of
  403. %%% false ->
  404. %%% mnesia:abort({invalid_attribute, {Tab, Attr}});
  405. %%% true ->
  406. %%% true
  407. %%% end.
  408. %%% valid_attr_type(Tab, Attr, Type) ->
  409. %%% Invalid = fun() ->
  410. %%% mnesia:abort({invalid_attribute_type, [Tab,Attr,Type]})
  411. %%% end,
  412. %%% case Type of
  413. %%% {alt, AltTypes} ->
  414. %%% valid_elem_types(Tab, [Attr, {alt, AltTypes}], AltTypes);
  415. %%% {tuple, Arity, ElemTypes}
  416. %%% when is_integer(Arity), Arity > 0, length(ElemTypes)==Arity ->
  417. %%% valid_elem_types(Tab, [Attr, {tuple, ElemTypes}], ElemTypes);
  418. %%% {tuple, Arity} when is_integer(Arity), Arity > 0 ->
  419. %%% true;
  420. %%% {function, Arity} when is_integer(Arity), Arity > 0 ->
  421. %%% true;
  422. %%% {list, ElemTypes} ->
  423. %%% valid_elem_types(Tab, [Attr, {list, ElemTypes}], ElemTypes);
  424. %%% {global, GlobalType} ->
  425. %%% case lists:member(GlobalType, schema_global_typedefs()) of
  426. %%% true -> true;
  427. %%% false ->
  428. %%% Invalid()
  429. %%% end;
  430. %%% {const, _Value} ->
  431. %%% true;
  432. %%% {function, Arity} when is_integer(Arity), Arity >= 0 ->
  433. %%% true;
  434. %%% _ ->
  435. %%% case lists:member(Type, simple_builtin_types()) of
  436. %%% true ->
  437. %%% true;
  438. %%% false ->
  439. %%% Invalid()
  440. %%% end
  441. %%% end.
  442. simple_builtin_types() ->
  443. [any, undefined, atom, integer, float, number, string, text, list,
  444. nil, tuple, pid, port, reference, binary, oid, function].
  445. %%% valid_elem_types(Tab, ParentType, Types) ->
  446. %%% lists:foreach(
  447. %%% fun(T) ->
  448. %%% valid_attr_type(Tab, ParentType ++ [T], T)
  449. %%% end, Types).
  450. re_normalize(GlobalType) ->
  451. lists:foreach(
  452. fun(Tab) ->
  453. TypeRec = make_rec_type(Tab),
  454. do_write_property(Tab, {rec_type, TypeRec})
  455. end, users_of_global_typedef(GlobalType)).
  456. global_typedefs() ->
  457. global_typedefs(mnesia:table_info(schema, user_properties)).
  458. schema_global_typedefs() ->
  459. global_typedefs(schema_table_info(schema, user_properties)).
  460. global_typedefs(Props) when is_list(Props) ->
  461. [{Name, Type} || {typedef, Name, Type} <- Props].
  462. global_typedefs_used(Tab) when Tab =/= schema ->
  463. global_typedefs_used(mnesia:table_info(Tab, all), global_typedefs()).
  464. schema_global_typedefs_used(Tab) when Tab =/= schema ->
  465. global_typedefs_used(schema_table_info(Tab, all), schema_global_typedefs()).
  466. global_typedefs_used(TI, Globals) ->
  467. Attrs = proplists:get_value(attributes, TI),
  468. TP = proplists:get_value(user_properties, TI),
  469. case lists:foldl(
  470. fun(Attr, Acc) ->
  471. Type = proplists:get_value({attr,Attr,type}, TP),
  472. uses_global_typedef(Type, Acc)
  473. end, ordsets:new(), Attrs) of
  474. [] ->
  475. %% probably a common case
  476. [];
  477. Ts ->
  478. Dict = dict:from_list(Globals),
  479. lists:foldr(
  480. fun(T, Acc) ->
  481. case dict:find(T, Dict) of
  482. {ok, Def} ->
  483. [{T,Def}|Acc];
  484. error ->
  485. Acc
  486. end
  487. end, [], Ts)
  488. end.
  489. uses_global_typedef({type, T}, Acc) ->
  490. ordsets:add_element(T,Acc);
  491. uses_global_typedef({Tag, Ts}, Acc) when Tag==list; Tag=='and'; Tag=='or' ->
  492. lists:foldl(
  493. fun(T, Acc1) ->
  494. uses_global_typedef(T, Acc1)
  495. end, Acc, Ts);
  496. uses_global_typedef({tuple, _, Ts}, Acc) ->
  497. lists:foldl(
  498. fun(T, Acc1) ->
  499. uses_global_typedef(T, Acc1)
  500. end, Acc, Ts);
  501. uses_global_typedef(_, Acc) ->
  502. Acc.
  503. users_of_global_typedef(GlobalType) ->
  504. lists:filter(
  505. fun(Tab) ->
  506. lists:member(GlobalType, global_typedefs_used(Tab))
  507. end,
  508. mnesia:system_info(tables) -- [schema]). % TODO: schema_ version
  509. %%% make_bounds_rec(Tab) when Tab =/= schema ->
  510. %%% Attrs = schema_table_info(Tab, attributes),
  511. %%% list_to_tuple([bounds | [schema_attr_property(Tab, Attr, bounds) ||
  512. %%% Attr <- Attrs]]).
  513. make_rec_type(Tab) when Tab =/= schema ->
  514. Info = schema_table_info(Tab),
  515. Attrs = proplists:get_value(attributes, Info),
  516. RecName = proplists:get_value(record_name, Info),
  517. TabProps = proplists:get_value(user_properties, Info),
  518. TabTypeDefs = [{N,D} || {{typedef,N},D} <- TabProps],
  519. GlobTypeDefs = [{N,D} || {{typedef,N},D} <-
  520. schema_table_info(schema, user_properties)],
  521. TypeDefs = TabTypeDefs ++ GlobTypeDefs,
  522. {tuple, length(Attrs)+1,
  523. [{'==', RecName}|
  524. [normalize_type(type_of(Tab, Attr, TabProps, TypeDefs)) ||
  525. Attr <- Attrs]]}.
  526. type_of(_Tab, Attr, TP, TD) ->
  527. type_of(proplists:get_value({attr,Attr,type}, TP, no_type), TD).
  528. type_of({type, T}, TD) ->
  529. type_of(proplists:get_value(T, TD), TD);
  530. type_of({Op,Ts},TD) when Op=='or';Op=='and' ->
  531. {Op,[type_of(T,TD) || T <- Ts]};
  532. type_of({'not', T}, TD) ->
  533. {'not', type_of(T, TD)};
  534. type_of({tuple,A,Ts},TD) ->
  535. {tuple,A,[type_of(T,TD) || T <- Ts]};
  536. type_of({list, T},TD) ->
  537. {list, type_of(T,TD)};
  538. type_of(T, _) ->
  539. T.
  540. normalize_type({Op, Ts}) when Op=='or' ->
  541. case normalize(Ts) of
  542. [] ->
  543. no_type;
  544. [T] ->
  545. T;
  546. [_|_] = Ts1 ->
  547. {Op, Ts1};
  548. T ->
  549. T
  550. end;
  551. normalize_type({Op, Ts}) when Op=='and' ->
  552. case normalize(Ts) of
  553. [] ->
  554. no_type;
  555. [T] ->
  556. T;
  557. [_|_] = Ts1 ->
  558. case lists:member(false, Ts1) of
  559. true -> false;
  560. false ->
  561. {Op, Ts1}
  562. end;
  563. T ->
  564. T
  565. end;
  566. normalize_type({list, LT}) ->
  567. case normalize_type(LT) of
  568. false ->
  569. nil;
  570. undefined ->
  571. list;
  572. LT1 ->
  573. {list, LT1}
  574. end;
  575. normalize_type({tuple, Arity, TTs}) ->
  576. TTs1 = [normalize_type(T) || T <- TTs],
  577. case lists:all(fun(any) -> true;
  578. (undefined) -> true;
  579. (_) -> false
  580. end, TTs1) of
  581. true ->
  582. {tuple, Arity};
  583. false ->
  584. {tuple, Arity, TTs1}
  585. end;
  586. normalize_type(T) ->
  587. T.
  588. normalize(Ts) ->
  589. Ts1 = [normalize_type(T) || T <- Ts],
  590. case prune(Ts1) of
  591. [] -> any;
  592. [T] -> T;
  593. [_|_] = Ts2 ->
  594. Ts2
  595. end.
  596. prune(Ts) ->
  597. prune(Ts, []).
  598. prune([T|Ts], Acc) ->
  599. Acc1 = lists:filter(
  600. fun(Tx) when Tx == T ->
  601. false;
  602. (Tx) -> not(a_includes_b(T, Tx))
  603. end, Acc),
  604. prune(Ts, [T|Acc1]);
  605. prune([], Acc) ->
  606. lists:reverse(Acc).
  607. a_includes_b(_, no_type) -> true;
  608. a_includes_b(any,_) -> true;
  609. a_includes_b(A, B) ->
  610. case orddict:find(A, ts()) of
  611. {ok, SubTypes} ->
  612. lists:member(t_alias(B), SubTypes);
  613. error ->
  614. false
  615. end.
  616. %% an orddict
  617. ts() ->
  618. [{boolean, [true, false]},
  619. {function,[{function}]},
  620. {list,[{list},nil]},
  621. {number,[integer,float]},
  622. {text,[atom,string,binary]},
  623. {tuple,[{tuple}]}].
  624. t_alias(T) when is_tuple(T) ->
  625. {element(1,T)};
  626. t_alias(T) ->
  627. T.
  628. do_write_property(Tab, Prop) ->
  629. mnesia_schema:do_write_table_property(Tab, Prop).
  630. check_acl(L, ValidOps) ->
  631. F = fun({Op, Rhs}, {Good, Bad}) ->
  632. case lists:member(Op, ValidOps)
  633. andalso valid_acl_rhs(Rhs) of
  634. true ->
  635. {[{Op, Rhs}|Good], Bad};
  636. false ->
  637. {Good, [{Op, Rhs}|Bad]}
  638. end;
  639. (Other, {Good, Bad}) ->
  640. {Good, [Other|Bad]}
  641. end,
  642. case lists:foldr(F, {[], []}, L) of
  643. {Good, []} ->
  644. _Sorted = lists:foldr(
  645. fun(Op, Acc) ->
  646. case lists:keysearch(Op, 1, Good) of
  647. {value, Found} ->
  648. [Found|Acc];
  649. false ->
  650. Acc
  651. end
  652. end, [], ValidOps);
  653. {_, Bad} ->
  654. mnesia:abort({illegal_acl, Bad})
  655. end.
  656. valid_acl_rhs(Rhs) when is_boolean(Rhs) ->
  657. true;
  658. valid_acl_rhs({M,F}) when is_atom(M), is_atom(F) ->
  659. %% assume M:F(Tab, Op, Rec) exists and returns boolean()
  660. true;
  661. valid_acl_rhs(Other) ->
  662. mnesia:abort({invalid_acl_rhs, Other}).
  663. %%% valid_bounds(_Tab, _Attr, {inclusive, A, B}) when A =< B -> true;
  664. %%% valid_bounds(_Tab, _Attr, {exclusive, A, B}) when A =< B -> true;
  665. %%% valid_bounds(Tab, Attr, Other) ->
  666. %%% mnesia:abort({invalid_bounds_type, [Tab,Attr,Other]}).
  667. %%% The Acl list is read from top to bottom, so the first
  668. %%% matching entry is accepted. To simplify the code generation,
  669. %%% we remove redundant entries. We could also flag an error if
  670. %%% there are duplicates...
  671. %%% remove_redundant([]) ->
  672. %%% [];
  673. %%% remove_redundant([{Op,_} = H | T]) ->
  674. %%% [H|remove_redundant([H1 || {Op1,_}=H1 <- T,
  675. %%% Op1 =/= Op])].
  676. tab_references(Tab) ->
  677. table_property(Tab, references, []).
  678. drop_references(ToTab) ->
  679. mnesia_schema:schema_transaction(
  680. fun() ->
  681. do_drop_references(ToTab)
  682. end).
  683. do_drop_references(ToTab) ->
  684. foreach(
  685. fun(Tab) ->
  686. case schema_table_property(Tab, references, []) of
  687. [] ->
  688. ok;
  689. [_|_] = OldRefs ->
  690. NewRefs =
  691. lists:foldr(
  692. fun({Type,Key,Rs}, Acc) ->
  693. case lists:foldr(
  694. fun({Tab2,_Attr2,_Actions}, Acc2)
  695. when Tab2 == ToTab ->
  696. Acc2;
  697. (Other, Acc2) ->
  698. [Other|Acc2]
  699. end, [], Rs) of
  700. [] ->
  701. Acc;
  702. [_|_] = Rs1 ->
  703. [{Type,Key,Rs1}|Acc]
  704. end
  705. end, [], OldRefs),
  706. if NewRefs == OldRefs ->
  707. ok;
  708. true ->
  709. do_write_property(Tab, {references, NewRefs})
  710. end
  711. end
  712. %% shouldn't use system_info here - tables could've been added/deleted
  713. end, mnesia:system_info(tables)).
  714. %% Referential integrity rules are stored as metadata in the following way:
  715. %% {attr, {Tab, Attr}, [{Tab2, Attr2, RefActions}]}, where
  716. %% Tab : the referencing table
  717. %% Attr : the referencing attribute
  718. %% Tab2 : the referenced table
  719. %% Attr2 : the referenced attribute(s) -
  720. %% atom() | {atom()} | function(Object, Value)
  721. %% RefActions : {Match, DeleteAction : Action, UpdateAction : Action}
  722. %% Match : handling of null values - partial | full
  723. %% Action : referential action -
  724. %% no_action | cascade | set_default | set_null | return | ignore
  725. check_ref_props(Tab, Refs) when is_list(Refs) ->
  726. Attrs = schema_table_info(Tab, attributes),
  727. lists:map(
  728. fun({attr, Attr, Rs}) when is_list(Rs) ->
  729. valid_attr(Tab, Attr, Attrs),
  730. {attr, Attr, [check_ref_prop(R) || R <- Rs]};
  731. ({index, Ix, Rs}) when is_list(Rs) ->
  732. %% TODO: check that Ix is a valid index
  733. case rdbms_index:valid_index(Tab, Ix) of
  734. true -> ok;
  735. false ->
  736. mnesia:abort({invalid_index, [Tab,Ix]})
  737. end,
  738. {index, Ix, [check_ref_prop(R) || R <- Rs]};
  739. ({eval, {_M,_F,_XArgs} = Fn, Rs}) when is_list(Rs) ->
  740. {eval, Fn, [check_ref_prop(R) || R <- Rs]};
  741. (Other) ->
  742. mnesia:abort({bad_references,
  743. [Tab, Refs,
  744. {unknown_format, Other}]})
  745. end, Refs);
  746. check_ref_props(Tab, Refs) ->
  747. mnesia:abort({bad_references, [Tab, Refs,
  748. unknown_format]}).
  749. merge_refs(R1, R2) ->
  750. merge_refs(R1, R2, []).
  751. merge_refs([{Type,Key,Actions}=R | Refs], Old, Acc) ->
  752. case [{T,K,RA} || {T,K,RA} <- Old,
  753. T == Type,
  754. K == Key] of
  755. [] ->
  756. merge_refs(Refs, Old, [R|Acc]);
  757. [R] ->
  758. %% duplicate -- not a problem
  759. merge_refs(Refs, Old, Acc);
  760. [{_,_,As}] ->
  761. exit({reference_conflict, {Type,Key,Actions,As}})
  762. end;
  763. merge_refs([], Old, Acc) ->
  764. Old ++ lists:reverse(Acc).
  765. drop_refs(DropRefs, OldRefs) ->
  766. [{Type,Key,Rs} || {Type,Key,Rs} <- OldRefs,
  767. not(lists:member({Type,Key}, DropRefs))].
  768. %%% check_ref_props(Tab, Attr, [P|Props]) ->
  769. %%% [check_ref_prop(P)|check_ref_props(Tab, Attr, Props)];
  770. %%% check_ref_props(_, _, []) -> [].
  771. check_ref_prop({Tab2, {via_index, _Ix}=Via, RefActions}) ->
  772. %%% case rdbms_index:valid_index(Tab2, Ix) of
  773. %%% true -> ok;
  774. %%% false ->
  775. %%% mnesia:abort({invalid_index, [Tab2, Ix]})
  776. %%% end,
  777. Actions = check_ref_actions(RefActions, [full]),
  778. {Tab2, Via, Actions};
  779. check_ref_prop({Tab2, Attr2, RefActions}) ->
  780. ?dbg("check_ref_prop(~p)~n", [{Tab2, Attr2, RefActions}]),
  781. %%% valid_attr(Tab2, Attr2),
  782. ValidMatches = if is_list(Attr2) -> [full, partial];
  783. is_atom(Attr2) -> [full]
  784. end,
  785. Actions = check_ref_actions(RefActions, ValidMatches),
  786. {Tab2, Attr2, Actions}.
  787. check_ref_actions({Match, DelActions, UpdateActions}, ValidMatches) ->
  788. ?dbg("check_ref_actions(~p)~n", [{Match, DelActions, UpdateActions}]),
  789. valid_match_option(Match, ValidMatches),
  790. valid_delete_option(DelActions),
  791. valid_update_option(UpdateActions),
  792. {Match, DelActions, UpdateActions};
  793. check_ref_actions(RefActions, ValidMatches) when list(RefActions) ->
  794. ?dbg("check_ref_actions(~p)~n", [RefActions]),
  795. Match = get_opt(match, RefActions, full),
  796. DelActions = get_opt(delete, RefActions, no_action),
  797. UpdateActions = get_opt(update, RefActions, no_action),
  798. valid_match_option(Match, ValidMatches),
  799. valid_delete_option(DelActions),
  800. valid_update_option(UpdateActions),
  801. {Match, DelActions, UpdateActions}.
  802. valid_match_option(Match, Valid) ->
  803. valid_option(match, Match, Valid).
  804. valid_delete_option(DelActions) ->
  805. valid_option(delete, DelActions,
  806. [no_action, cascade, set_default, set_null, ignore]).
  807. valid_update_option(UpdateActions) ->
  808. valid_option(update, UpdateActions,
  809. [no_action, cascade, set_default, set_null, ignore]).
  810. valid_option(Context, Opt, Valid) ->
  811. case lists:member(Opt, Valid) of
  812. true -> ok;
  813. false ->
  814. mnesia:abort({invalid_option, {Context, Opt}})
  815. end.
  816. get_opt(Key, [{Key, Val}|_], _) -> Val;
  817. get_opt(Key, [_H|T], Default) -> get_opt(Key, T, Default);
  818. get_opt(_, [], Default) -> Default.
  819. valid_attr(Tab, A) ->
  820. valid_attr(Tab, A, schema_table_info(Tab, attributes)).
  821. valid_attr(Tab, A, Attrs) ->
  822. IsValid =
  823. fun(A1) ->
  824. case lists:member(A1, Attrs) of
  825. true -> ok;
  826. false ->
  827. mnesia:abort({invalid_attr, [Tab,A1]})
  828. end
  829. end,
  830. if is_list(A) ->
  831. lists:foreach(IsValid, A);
  832. is_atom(A) ->
  833. IsValid(A);
  834. true ->
  835. mnesia:abort({invalid_attr, [Tab,A]})
  836. end.