Add script to extract translation strings

1 files changed, 232 insertions, 0 deletions

diff --git a/tools/extract-tr.sh b/tools/extract-tr.sh
new file mode 100755
index 000000000..1a864f6a8
--- /dev/null
+++ b/tools/extract-tr.sh
@@ -0,0 +1,232 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+%%! -pa ebin
+
+main([Dir]) ->
+    Txts =
+	filelib:fold_files(
+	  Dir, ".+\.beam\$", false,
+	  fun(FileIn, Res) ->
+		  case get_forms(FileIn) of
+		      {ok, Forms} ->
+			  Tree = erl_syntax:form_list(Forms),
+			  Mod = mod(FileIn),
+			  erl_syntax_lib:fold_subtrees(
+			    fun(Form, Acc) ->
+				    case erl_syntax:type(Form) of
+					function ->
+					    case map(Form, Mod) of
+						[] ->
+						    Acc;
+						Vars ->
+						    Vars ++ Acc
+					    end;
+					_ ->
+					    Acc
+				    end
+			    end, [], Tree) ++ Res;
+		      _Err ->
+			  Res
+		  end
+	  end, []),
+    Dict = lists:foldl(
+	     fun({B, Meta}, Acc) ->
+		     dict:update(
+		       binary_to_list(B),
+		       fun(OldMeta) ->
+			       lists:usort([Meta|OldMeta])
+		       end,
+		       [Meta], Acc)
+	     end, dict:new(), Txts),
+    generate_pot(Dict).
+
+map(Tree, Mod) ->
+    Vars = erl_syntax_lib:fold(
+	     fun(Form, Acc) ->
+		     case erl_syntax:type(Form) of
+			 application ->
+			     analyze_app(Form, Mod) ++ Acc;
+			 _ ->
+			     Acc
+		     end
+	     end, [], Tree),
+    Bins = lists:flatmap(
+	     fun({Var, Pos}) when is_atom(Var) ->
+		     Res = erl_syntax_lib:fold(
+			     fun(Form, Acc) ->
+				     case process_match_expr(
+					    Form, Var, Mod) of
+					 {ok, Binary, NewPos} ->
+					     [{Binary, NewPos}|Acc];
+					 error ->
+					     Acc
+				     end
+			     end, [], Tree),
+		     case Res of
+			 [] ->
+			     log("~s:~p: unresolved variable: ~s~n",
+				 [Mod, Pos, Var]);
+			 _ ->
+			     ok
+		     end,
+		     Res;
+		({Var, Pos}) when is_binary(Var) ->
+		     [{Var, Pos}]
+	     end, lists:usort(Vars)),
+    [{B, {Mod, Pos}} || {B, Pos} <- Bins, B /= <<"">>].
+
+process_match_expr(Form, Var, Mod) ->
+    case erl_syntax:type(Form) of
+	match_expr ->
+	    Pattern = erl_syntax:match_expr_pattern(Form),
+	    Body = erl_syntax:match_expr_body(Form),
+	    {V, Expr} =
+		case {erl_syntax:type(Pattern), erl_syntax:type(Body)} of
+		    {variable, _} ->
+			{erl_syntax:variable_name(Pattern), Body};
+		    {_, variable} ->
+			{erl_syntax:variable_name(Body), Pattern};
+		    _ ->
+			{'', none}
+		end,
+	    Text = maybe_extract_tuple(Expr),
+	    if V == Var ->
+		    Pos = erl_syntax:get_pos(Text),
+		    try {ok, erl_syntax:concrete(Text), Pos}
+		    catch _:_ ->
+			    case catch erl_syntax_lib:analyze_application(Text) of
+				{_M, {Fn, 1}} when Fn == format_error;
+						   Fn == io_format_error ->
+				    error;
+				_ ->
+				    log("~s:~p: not a binary: ~s~n",
+					[Mod, Pos, erl_prettypr:format(Text)]),
+				    {ok, <<>>, Pos}
+			    end
+		    end;
+	       true ->
+		    error
+	    end;
+	_ ->
+	    error
+    end.
+
+maybe_extract_tuple(none) ->
+    none;
+maybe_extract_tuple(Form) ->
+    try
+	tuple = erl_syntax:type(Form),
+	[Text, _] = erl_syntax:tuple_elements(Form),
+	Text
+    catch _:{badmatch, _} ->
+	    Form
+    end.
+
+analyze_app(Form, Mod) ->
+    try
+	{M, {F, A}} = erl_syntax_lib:analyze_application(Form),
+	Args = erl_syntax:application_arguments(Form),
+	Txt = case {M, atom_to_list(F), A, Args} of
+		  {xmpp, "err_" ++ _, 2, [T|_]} -> T;
+		  {xmpp, "serr_" ++ _, 2, [T|_]} -> T;
+		  {xmpp, "mk_text", 2, [T|_]} -> T;
+		  {translate, "translate", 2, [_,T|_]} -> T;
+		  {translate, "mark", 1, [T]} -> T
+	      end,
+	Pos = erl_syntax:get_pos(Txt),
+	case erl_syntax:type(Txt) of
+	    binary ->
+		try [{erl_syntax:concrete(Txt), Pos}]
+		catch _:_ ->
+			Pos = erl_syntax:get_pos(Txt),
+			log("~s:~p: not a binary: ~s~n",
+			    [Mod, Pos, erl_prettypr:format(Txt)]),
+			[]
+		end;
+	    variable ->
+		[{erl_syntax:variable_name(Txt), Pos}];
+	    application ->
+		Vars = sets:to_list(erl_syntax_lib:variables(Txt)),
+		case Vars of
+		    [Var] ->
+			[{Var, Pos}];
+		    [_|_] ->
+			log("Too many variables: ~p~n", [Vars]),
+			[];
+		    [] ->
+			[]
+		end;
+	    _ ->
+		[]
+	end
+    catch _:{badmatch, _} ->
+	    [];
+	  _:{case_clause, _} ->
+	    []
+    end.
+
+generate_pot(Dict) ->
+    io:format("~s~n~n", [pot_header()]),
+    lists:foreach(
+      fun({Msg, Location}) ->
+	      S1 = format_location(Location),
+	      S2 = format_msg(Msg),
+	      io:format("~smsgstr \"\"~n~n", [S1 ++ S2])
+      end, lists:keysort(1, dict:to_list(Dict))).
+
+format_location([A, B, C|T]) ->
+    format_location_list([A,B,C]) ++ format_location(T);
+format_location([A, B|T]) ->
+    format_location_list([A,B]) ++ format_location(T);
+format_location([A|T]) ->
+    format_location_list([A]) ++ format_location(T);
+format_location([]) ->
+    "".
+
+format_location_list(L) ->
+    "#: " ++ string:join(
+	       lists:map(
+		 fun({File, Pos}) ->
+			 io_lib:format("~s:~B", [File, Pos])
+		 end, L),
+	       " ") ++ io_lib:nl().
+
+format_msg(Bin) ->
+    io_lib:format("msgid \"~s\"~n", [escape(Bin)]).
+
+escape(Bin) ->
+    lists:map(
+      fun($") -> "\\\"";
+	 (C) -> C
+      end, binary_to_list(iolist_to_binary(Bin))).
+
+pot_header() ->
+    string:join(
+      ["msgid \"\"",
+       "msgstr \"\"",
+       "\"Project-Id-Version: 15.11.127\\n\"",
+       "\"X-Language: Language Name\\n\"",
+       "\"Last-Translator: Translator name and contact method\\n\"",
+       "\"MIME-Version: 1.0\\n\"",
+       "\"Content-Type: text/plain; charset=UTF-8\\n\"",
+       "\"Content-Transfer-Encoding: 8bit\\n\""],
+      io_lib:nl()).
+
+mod(Path) ->
+    filename:rootname(filename:basename(Path)) ++ ".erl".
+
+log(Format, Args) ->
+    io:format(standard_error, Format, Args).
+
+get_forms(File) ->
+    case beam_lib:chunks(File, [abstract_code]) of
+        {ok, {_, List}} ->
+            case lists:keyfind(abstract_code, 1, List) of
+                {abstract_code, {raw_abstract_v1, Abstr}} ->
+                    {ok, Abstr};
+                _ ->
+                    error
+            end;
+        _ ->
+            error
+    end.