PageRenderTime 107ms CodeModel.GetById 12ms app.highlight 73ms RepoModel.GetById 12ms app.codeStats 1ms

/lib/rdbms/src/rdbms_props.erl

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