mnesia_ext: Create schema functionality

Add ext to table/system information
Add add_backend_type

3 files changed, 300 insertions, 35 deletions

diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl
index f34129268b..6818f9a65d 100644
--- a/lib/mnesia/src/mnesia.erl
+++ b/lib/mnesia/src/mnesia.erl
@@ -82,7 +82,8 @@
 	 system_info/0,                      % Not for public use
 
 	 %% Database mgt
-	 create_schema/1, delete_schema/1,
+	 create_schema/1, create_schema/2, delete_schema/1,
+         add_backend_type/2,
 	 backup/1, backup/2, traverse_backup/4, traverse_backup/6,
 	 install_fallback/1, install_fallback/2,
 	 uninstall_fallback/0, uninstall_fallback/1,
@@ -197,6 +198,9 @@ e_has_var(X, Pos) ->
 %% Start and stop
 
 start() ->
+    start([]).
+
+start_() ->
     {Time , Res} =  timer:tc(application, start, [?APPLICATION, temporary]),
 
     Secs = Time div 1000000,
@@ -232,7 +236,7 @@ patched_start([{Env, Val} | Tail]) when is_atom(Env) ->
 patched_start([Head | _]) ->
     {error, {bad_type, Head}};
 patched_start([]) ->
-    start().
+    start_().
 
 stop() ->
     case application:stop(?APPLICATION) of
@@ -1898,6 +1902,8 @@ raw_table_info(Tab, Item) ->
 		info_reply(?ets_info(Tab, Item), Tab, Item);
 	    disc_only_copies ->
 		info_reply(dets:info(Tab, Item), Tab, Item);
+            {ext, Alias, Mod} ->
+                info_reply(catch Mod:info(Alias, Tab, Item), Tab, Item);
 	    unknown ->
 		bad_info_reply(Tab, Item)
 	end
@@ -2010,15 +2016,26 @@ display_tab_info() ->
     MasterTabs = mnesia_recover:get_master_node_tables(),
     io:format("master node tables = ~p~n", [lists:sort(MasterTabs)]),
 
+    case get_backend_types() of
+	[] -> ok;
+	Ts -> list_backend_types(Ts, "backend types      = ")
+    end,
+
+    case get_index_plugins() of
+	[] -> ok;
+	Ps -> list_index_plugins(Ps, "index plugins      = ")
+    end,
+
     Tabs = system_info(tables),
 
-    {Unknown, Ram, Disc, DiscOnly} =
-	lists:foldl(fun storage_count/2, {[], [], [], []}, Tabs),
+    {Unknown, Ram, Disc, DiscOnly, Ext} =
+	lists:foldl(fun storage_count/2, {[], [], [], [], []}, Tabs),
 
     io:format("remote             = ~p~n", [lists:sort(Unknown)]),
     io:format("ram_copies         = ~p~n", [lists:sort(Ram)]),
     io:format("disc_copies        = ~p~n", [lists:sort(Disc)]),
     io:format("disc_only_copies   = ~p~n", [lists:sort(DiscOnly)]),
+    [io:format("~-19s= ~p~n", [atom_to_list(A), Ts]) || {A,Ts} <- Ext],
 
     Rfoldl = fun(T, Acc) ->
 		     Rpat =
@@ -2026,7 +2043,7 @@ display_tab_info() ->
 			     read_only ->
 				 lists:sort([{A, read_only} || A <- val({T, active_replicas})]);
 			     read_write ->
-				 table_info(T, where_to_commit)
+				 [fix_wtc(W) || W <- table_info(T, where_to_commit)]
 			 end,
 		     case lists:keysearch(Rpat, 1, Acc) of
 			 {value, {_Rpat, Rtabs}} ->
@@ -2039,12 +2056,60 @@ display_tab_info() ->
     Rdisp = fun({Rpat, Rtabs}) -> io:format("~p = ~p~n", [Rpat, Rtabs]) end,
     lists:foreach(Rdisp, lists:sort(Repl)).
 
-storage_count(T, {U, R, D, DO}) ->
+get_backend_types() ->
+    case ?catch_val({schema, user_property, mnesia_backend_types}) of
+	{'EXIT', _} ->
+	    [];
+	{mnesia_backend_types, Ts} ->
+	    lists:sort(Ts)
+    end.
+
+get_index_plugins() ->
+    case ?catch_val({schema, user_property, mnesia_index_plugins}) of
+	{'EXIT', _} ->
+	    [];
+	{mnesia_index_plugins, Ps} ->
+	    lists:sort(Ps)
+    end.
+
+
+list_backend_types([{A,M} | T] = Ts, Legend) ->
+    Indent = [$\s || _ <- Legend],
+    W = integer_to_list(
+	  lists:foldl(fun({Alias,_}, Wa) ->
+			      erlang:max(Wa, length(atom_to_list(Alias)))
+		      end, 0, Ts)),
+    io:fwrite(Legend ++ "~-" ++ W ++ "s - ~s~n",
+	      [atom_to_list(A), atom_to_list(M)]),
+    [io:fwrite(Indent ++ "~-" ++ W ++ "s - ~s~n",
+	       [atom_to_list(A1), atom_to_list(M1)])
+     || {A1,M1} <- T].
+
+list_index_plugins([{N,M,F} | T] = Ps, Legend) ->
+    Indent = [$\s || _ <- Legend],
+    W = integer_to_list(
+	  lists:foldl(fun({N1,_,_}, Wa) ->
+			      erlang:max(Wa, length(pp_ix_name(N1)))
+		      end, 0, Ps)),
+    io:fwrite(Legend ++ "~-" ++ W ++ "s - ~s:~s~n",
+	      [pp_ix_name(N), atom_to_list(M), atom_to_list(F)]),
+    [io:fwrite(Indent ++ "~-" ++ W ++ "s - ~s:~s~n",
+	       [pp_ix_name(N1), atom_to_list(M1), atom_to_list(F1)])
+     || {N1,M1,F1} <- T].
+
+pp_ix_name(N) ->
+    lists:flatten(io_lib:fwrite("~w", [N])).
+
+fix_wtc({N, {ext,A,_}}) -> {N, A};
+fix_wtc({N,A}) when is_atom(A) -> {N, A}.
+
+storage_count(T, {U, R, D, DO, Ext}) ->
     case table_info(T, storage_type) of
-	unknown -> {[T | U], R, D, DO};
-	ram_copies -> {U, [T | R], D, DO};
-	disc_copies -> {U, R, [T | D], DO};
-	disc_only_copies -> {U, R, D, [T | DO]}
+	unknown -> {[T | U], R, D, DO, Ext};
+	ram_copies -> {U, [T | R], D, DO, Ext};
+	disc_copies -> {U, R, [T | D], DO, Ext};
+	disc_only_copies -> {U, R, D, [T | DO], Ext};
+        {ext, A, _} -> {U, R, D, DO, orddict:append(A, T, Ext)}
     end.
 
 system_info(Item) ->
@@ -2059,9 +2124,10 @@ system_info2(all) ->
 system_info2(db_nodes) ->
     DiscNs = ?catch_val({schema, disc_copies}),
     RamNs = ?catch_val({schema, ram_copies}),
+    ExtNs = ?catch_val({schema, external_copies}),
     if
-	is_list(DiscNs), is_list(RamNs) ->
-	    DiscNs ++ RamNs;
+	is_list(DiscNs), is_list(RamNs), is_list(ExtNs) ->
+	    DiscNs ++ RamNs ++ ExtNs;
 	true ->
 	    case mnesia_schema:read_nodes() of
 		{ok, Nodes} -> Nodes;
@@ -2165,6 +2231,7 @@ system_info2(access_module) -> mnesia_monitor:get_env(access_module);
 system_info2(auto_repair) -> mnesia_monitor:get_env(auto_repair);
 system_info2(is_running) -> mnesia_lib:is_running();
 system_info2(backup_module) -> mnesia_monitor:get_env(backup_module);
+system_info2(backend_types) -> mnesia_schema:backend_types();
 system_info2(event_module) -> mnesia_monitor:get_env(event_module);
 system_info2(debug) -> mnesia_monitor:get_env(debug);
 system_info2(dump_log_load_regulation) -> mnesia_monitor:get_env(dump_log_load_regulation);
@@ -2201,6 +2268,7 @@ system_info_items(yes) ->
     [
      access_module,
      auto_repair,
+     backend_types,
      backup_module,
      checkpoints,
      db_nodes,
@@ -2294,11 +2362,17 @@ load_mnesia_or_abort() ->
 %% Database mgt
 
 create_schema(Ns) ->
-    mnesia_bup:create_schema(Ns).
+    create_schema(Ns, []).
+
+create_schema(Ns, Properties) ->
+    mnesia_bup:create_schema(Ns, Properties).
 
 delete_schema(Ns) ->
     mnesia_schema:delete_schema(Ns).
 
+add_backend_type(Alias, Module) ->
+    mnesia_schema:add_backend_type(Alias, Module).
+
 backup(Opaque) ->
     mnesia_log:backup(Opaque).
 
diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl
index 8b1143a352..2c756b1c75 100644
--- a/lib/mnesia/src/mnesia_bup.erl
+++ b/lib/mnesia/src/mnesia_bup.erl
@@ -28,6 +28,7 @@
          fallback_exists/0,
          tm_fallback_start/1,
          create_schema/1,
+	 create_schema/2,
          install_fallback/1,
          install_fallback/2,
          uninstall_fallback/0,
@@ -262,7 +263,7 @@ convert_0_1(Schema) ->
             Cs = mnesia_schema:list2cs(List),
             convert_0_1(Schema2, [], Cs);
         false ->
-            List = mnesia_schema:get_initial_schema(disc_copies, [node()]),
+            List = mnesia_schema:get_initial_schema(disc_copies, [node()], []),
             Cs = mnesia_schema:list2cs(List),
             convert_0_1(Schema, [], Cs)
     end.
@@ -310,16 +311,19 @@ schema2bup({schema, Tab, TableDef}) ->
 %% Create schema on the given nodes
 %% Requires that old schemas has been deleted
 %% Returns ok | {error, Reason}
-create_schema([]) ->
-    create_schema([node()]);
-create_schema(Ns) when is_list(Ns) ->
+create_schema(Nodes) ->
+    create_schema(Nodes, []).
+
+create_schema([], Props) ->
+    create_schema([node()], Props);
+create_schema(Ns, Props) when is_list(Ns), is_list(Props) ->
     case is_set(Ns) of
         true ->
-            create_schema(Ns, mnesia_schema:ensure_no_schema(Ns));
+            create_schema(Ns, mnesia_schema:ensure_no_schema(Ns), Props);
         false ->
             {error, {combine_error, Ns}}
     end;
-create_schema(Ns) ->
+create_schema(Ns, _Props) ->
     {error, {badarg, Ns}}.
 
 is_set(List) when is_list(List) ->
@@ -327,7 +331,7 @@ is_set(List) when is_list(List) ->
 is_set(_) ->
     false.
 
-create_schema(Ns, ok) ->
+create_schema(Ns, ok, Props) ->
     %% Ensure that we access the intended Mnesia
     %% directory. This function may not be called
     %% during startup since it will cause the
@@ -346,7 +350,7 @@ create_schema(Ns, ok) ->
                             Str = mk_str(),
                             File = mnesia_lib:dir(Str),
                             file:delete(File),
-                            try make_initial_backup(Ns, File, Mod) of
+                            try make_initial_backup(Ns, File, Mod, Props) of
                                 {ok, _Res} ->
                                     case do_install_fallback(File, Mod) of
                                         ok ->
@@ -363,9 +367,9 @@ create_schema(Ns, ok) ->
         {error, Reason} ->
             {error, Reason}
     end;
-create_schema(_Ns, {error, Reason}) ->
+create_schema(_Ns, {error, Reason}, _) ->
     {error, Reason};
-create_schema(_Ns, Reason) ->
+create_schema(_Ns, Reason, _) ->
     {error, Reason}.
 
 mk_str() ->
@@ -373,7 +377,10 @@ mk_str() ->
     lists:concat([node()] ++ Now ++ ".TMP").
 
 make_initial_backup(Ns, Opaque, Mod) ->
-    Orig = mnesia_schema:get_initial_schema(disc_copies, Ns),
+    make_initial_backup(Ns, Opaque, Mod, []).
+
+make_initial_backup(Ns, Opaque, Mod, Props) ->
+    Orig = mnesia_schema:get_initial_schema(disc_copies, Ns, Props),
     Modded = proplists:delete(storage_properties, proplists:delete(majority, Orig)),
     Schema = [{schema, schema, Modded}],
     O2 = do_apply(Mod, open_write, [Opaque], Opaque),
diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl
index 76a9dbf26c..1aebd8f762 100644
--- a/lib/mnesia/src/mnesia_schema.erl
+++ b/lib/mnesia/src/mnesia_schema.erl
@@ -29,6 +29,11 @@
 -module(mnesia_schema).
 
 -export([
+         add_backend_type/2,
+	 do_add_backend_type/2,
+	 delete_backend_type/1,
+	 do_delete_backend_type/1,
+	 backend_types/0,
          add_snmp/2,
          add_table_copy/3,
          add_table_index/2,
@@ -55,11 +60,12 @@
          dump_tables/1,
          ensure_no_schema/1,
 	 get_create_list/1,
-         get_initial_schema/2,
+         get_initial_schema/3,
 	 get_table_properties/1,
          info/0,
          info/1,
          init/1,
+	 init_backends/0,
          insert_cstruct/3,
 	 is_remote_member/1,
          list2cs/1,
@@ -143,7 +149,24 @@ init(IgnoreFallback) ->
     set({schema, where_to_read}, node()),
     set({schema, load_node}, node()),
     set({schema, load_reason}, initial),
-    mnesia_controller:add_active_replica(schema, node()).
+    mnesia_controller:add_active_replica(schema, node()),
+    init_backends().
+
+
+init_backends() ->
+    Backends = lists:foldl(fun({Alias, Mod}, Acc) ->
+				   orddict:append(Mod, Alias, Acc)
+			   end, orddict:new(), get_ext_types()),
+    [init_backend(Mod, Aliases) || {Mod, Aliases} <- Backends],
+    ok.
+
+init_backend(Mod, [_|_] = Aliases) ->
+    case Mod:init_backend() of
+	ok ->
+	    Mod:add_aliases(Aliases);
+	Error ->
+	    mnesia:abort({backend_init_error, Error})
+    end.
 
 exit_on_error({error, Reason}) ->
     exit(Reason);
@@ -525,9 +548,14 @@ do_read_disc_schema(Fname, Keep) ->
     Res.
 
 get_initial_schema(SchemaStorage, Nodes) ->
+    get_initial_schema(SchemaStorage, Nodes, []).
+
+get_initial_schema(SchemaStorage, Nodes, Properties) ->	%
+    UserProps = initial_schema_properties(Properties),
     Cs = #cstruct{name = schema,
 		  record_name = schema,
-		  attributes = [table, cstruct]},
+		  attributes = [table, cstruct],
+		  user_properties = UserProps},
     Cs2 =
 	case SchemaStorage of
         ram_copies -> Cs#cstruct{ram_copies = Nodes};
@@ -535,6 +563,30 @@ get_initial_schema(SchemaStorage, Nodes) ->
     end,
     cs2list(Cs2).
 
+initial_schema_properties(Props0) ->
+    DefaultProps = remove_duplicates(mnesia_monitor:get_env(schema)),
+    Props = lists:foldl(
+	      fun({K,V}, Acc) ->
+		      lists:keystore(K, 1, Acc, {K,V})
+	      end, DefaultProps, remove_duplicates(Props0)),
+    initial_schema_properties_(Props).
+
+initial_schema_properties_([{backend_types, Types}|Props]) ->
+    lists:foreach(fun({Name, Module}) ->
+			  verify_backend_type(Name, Module)
+		  end, Types),
+    [{mnesia_backend_types, Types}|initial_schema_properties_(Props)];
+initial_schema_properties_([P|_Props]) ->
+    mnesia:abort({bad_schema_property, P});
+initial_schema_properties_([]) ->
+    [].
+
+remove_duplicates([{K,_} = H|T]) ->
+    [H | remove_duplicates([X || {K1,_} = X <- T,
+				 K1 =/= K])];
+remove_duplicates([]) ->
+    [].
+
 read_cstructs_from_disc() ->
     %% Assumptions:
     %% - local schema lock in global
@@ -783,6 +835,25 @@ pick(Tab, Key, List, Default) ->
 	    mnesia:abort({bad_type, Tab, BadArg})
     end.
 
+get_ext_types() ->
+    get_schema_user_property(mnesia_backend_types).
+
+get_schema_user_property(Key) ->
+    Tab = schema,
+    %% Must work reliably both within transactions and outside of transactions
+    Res = case get(mnesia_activity_state) of
+	      undefined ->
+		  dirty_read_table_property(Tab, Key);
+	      _ ->
+		  do_read_table_property(Tab, Key)
+	  end,
+    case Res of
+	undefined ->
+	    [];
+	{_, Types} ->
+	    Types
+    end.
+
 %% Convert attribute name to integer if neccessary
 attr_tab_to_pos(_Tab, Pos) when is_integer(Pos) ->
     Pos;
@@ -1039,6 +1110,103 @@ check_active([{badrpc, Reason} | _Replies], Expl, Tab) ->
 check_active([], _Expl, _Tab) ->
     ok.
 
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function for definining an external backend type
+
+add_backend_type(Name, Module) ->
+    case schema_transaction(fun() -> do_add_backend_type(Name, Module) end) of
+	{atomic, NeedsInit} ->
+	    case NeedsInit of
+		true ->
+		    Module:init_backend();
+		false ->
+		    ignore
+	    end,
+	    Module:add_aliases([Name]),
+	    {atomic, ok};
+	Other ->
+	    Other
+    end.
+
+do_add_backend_type(Name, Module) ->
+    verify_backend_type(Name, Module),
+    Types = case do_read_table_property(schema, mnesia_backend_types) of
+		undefined ->
+		    [];
+		{_, Ts} ->
+		    case lists:keymember(Name, 1, Ts) of
+			true ->
+			    mnesia:abort({backend_type_already_exists, Name});
+			false ->
+			    Ts
+		    end
+	    end,
+    ModuleRegistered = lists:keymember(Module, 2, Types),
+    do_write_table_property(schema, {mnesia_backend_types,
+				     [{Name, Module}|Types]}),
+    ModuleRegistered.
+
+delete_backend_type(Name) ->
+    schema_transaction(fun() -> do_delete_backend_type(Name) end).
+
+do_delete_backend_type(Name) ->
+    case do_read_table_property(schema, mnesia_backend_types) of
+	undefined ->
+	    [];
+	{_, Ts} ->
+	    case lists:keyfind(Name, 1, Ts) of
+		{_, Mod} ->
+		    case using_backend_type(Name, Mod) of
+			[_|_] = Tabs ->
+			    mnesia:abort({backend_in_use, {Name, Tabs}});
+			[] ->
+			    do_write_table_property(
+			      schema, {mnesia_backend_types,
+				       lists:keydelete(Name, 1, Ts)})
+		    end;
+		false ->
+		    mnesia:abort({no_such_backend, Name})
+	    end
+    end.
+
+using_backend_type(Name, Mod) ->
+    Ext = ets:select(mnesia_gvar,
+		     [{ {{'$1',external_copies},'$2'}, [], [{{'$1','$2'}}] }]),
+    Entry = {Name, Mod},
+    [T || {T,C} <- Ext,
+	  lists:keymember(Entry, 1, C)].
+
+verify_backend_type(Name, Module) ->
+    case legal_backend_name(Name) of
+	false ->
+	    mnesia:abort({bad_type, {backend_type,Name,Module}});
+	true ->
+	    ok
+    end,
+    ExpectedExports = mnesia_backend_type:behaviour_info(callbacks),
+    Exports = try Module:module_info(exports)
+              catch
+                  error:_ ->
+                      mnesia:abort({undef_backend, Module})
+              end,
+    case ExpectedExports -- Exports of
+        [] ->
+	    ok;
+        _Other ->
+	    io:fwrite(user, "Missing backend_type exports: ~p~n", [_Other]),
+            mnesia:abort({bad_type, {backend_type,Name,Module}})
+    end.
+
+legal_backend_name(Name) ->
+    is_atom(Name) andalso
+                    (not lists:member(Name, record_info(fields, cstruct))).
+
+%% Used e.g. by mnesia:system_info(backend_types).
+backend_types() ->
+    [ram_copies, disc_copies, disc_only_copies |
+     [T || {T,_} <- get_ext_types()]].
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Here's the real interface function to create a table
 
@@ -1711,22 +1879,38 @@ do_read_table_property(Tab, Key) ->
     {_, _, Ts} = TidTs,
     Store = Ts#tidstore.store,
     Props = ets:foldl(
-	      fun({op, create_table, [{name, T}|Opts]}, _Acc)
-		 when T==Tab ->
+	      fun({op, announce_im_running,_,Opts,_,_}, _Acc) when Tab==schema ->
+		      find_props(Opts);
+		 ({op, create_table, [{name, T}|Opts]}, _Acc)
+		    when T==Tab ->
 		      find_props(Opts);
 		 ({op, Op, [{name,T}|Opts], _Prop}, _Acc)
-		 when T==Tab, Op==write_property; Op==delete_property ->
+		 when T==Tab, Op==write_property;
+		      T==Tab, Op==delete_property ->
 		      find_props(Opts);
 		 ({op, delete_table, [{name,T}|_]}, _Acc)
 		 when T==Tab ->
 		      [];
 		 (_Other, Acc) ->
 		      Acc
-	      end, [], Store),
-    case lists:keysearch(Key, 1, Props) of
-	{value, Property} ->
-	    Property;
-	false ->
+	      end, undefined, Store),
+    case Props of
+        undefined ->
+            get_tid_ts_and_lock(Tab, read),
+	    dirty_read_table_property(Tab, Key);
+        _ when is_list(Props) ->
+            case lists:keyfind(Key, 1, Props) of
+		false ->
+		    undefined;
+		Other ->
+		    Other
+            end
+    end.
+
+dirty_read_table_property(Tab, Key) ->
+    try ets:lookup_element(mnesia_gvar, {Tab,user_property,Key}, 2)
+    catch
+	error:_ ->
 	    undefined
     end.