aboutsummaryrefslogtreecommitdiff
path: root/src/ejabberd_sql_pt.erl
diff options
context:
space:
mode:
Diffstat (limited to 'src/ejabberd_sql_pt.erl')
-rw-r--r--src/ejabberd_sql_pt.erl197
1 files changed, 106 insertions, 91 deletions
diff --git a/src/ejabberd_sql_pt.erl b/src/ejabberd_sql_pt.erl
index 10697f692..eb7905bf0 100644
--- a/src/ejabberd_sql_pt.erl
+++ b/src/ejabberd_sql_pt.erl
@@ -28,7 +28,7 @@
%% API
-export([parse_transform/2, format_error/1]).
--export([parse/2]).
+%-export([parse/2]).
-include("ejabberd_sql_pt.hrl").
@@ -41,7 +41,8 @@
res_vars = [],
res_pos = 0,
server_host_used = false,
- used_vars = []}).
+ used_vars = [],
+ use_new_schema}).
-define(QUERY_RECORD, "sql_query").
@@ -88,26 +89,7 @@ transform(Form) ->
[Arg] ->
case erl_syntax:type(Arg) of
string ->
- S = erl_syntax:string_value(Arg),
- Pos = erl_syntax:get_pos(Arg),
- ParseRes = parse(S, Pos),
- UnusedVars =
- case ParseRes#state.server_host_used of
- {true, SHVar} ->
- case ?USE_NEW_SCHEMA of
- true -> [];
- false -> [SHVar]
- end;
- false ->
- add_warning(
- Pos, no_server_host),
- []
- end,
- set_pos(
- add_unused_vars(
- make_sql_query(ParseRes),
- UnusedVars),
- Pos);
+ transform_sql(Arg);
_ ->
throw({error, erl_syntax:get_pos(Form),
"?SQL argument must be "
@@ -123,26 +105,7 @@ transform(Form) ->
case {erl_syntax:type(TableArg),
erl_syntax:is_proper_list(FieldsArg)}of
{string, true} ->
- Table = erl_syntax:string_value(TableArg),
- ParseRes =
- parse_upsert(
- erl_syntax:list_elements(FieldsArg)),
- Pos = erl_syntax:get_pos(Form),
- case lists:keymember(
- "server_host", 1, ParseRes) of
- true ->
- ok;
- false ->
- add_warning(Pos, no_server_host)
- end,
- {ParseRes2, UnusedVars} =
- filter_upsert_sh(Table, ParseRes),
- set_pos(
- add_unused_vars(
- make_sql_upsert(Table, ParseRes2, Pos),
- UnusedVars
- ),
- Pos);
+ transform_upsert(Form, TableArg, FieldsArg);
_ ->
throw({error, erl_syntax:get_pos(Form),
"?SQL_UPSERT arguments must be "
@@ -158,26 +121,7 @@ transform(Form) ->
case {erl_syntax:type(TableArg),
erl_syntax:is_proper_list(FieldsArg)}of
{string, true} ->
- Table = erl_syntax:string_value(TableArg),
- ParseRes =
- parse_insert(
- erl_syntax:list_elements(FieldsArg)),
- Pos = erl_syntax:get_pos(Form),
- case lists:keymember(
- "server_host", 1, ParseRes) of
- true ->
- ok;
- false ->
- add_warning(Pos, no_server_host)
- end,
- {ParseRes2, UnusedVars} =
- filter_upsert_sh(Table, ParseRes),
- set_pos(
- add_unused_vars(
- make_sql_insert(Table, ParseRes2),
- UnusedVars
- ),
- Pos);
+ transform_insert(Form, TableArg, FieldsArg);
_ ->
throw({error, erl_syntax:get_pos(Form),
"?SQL_INSERT arguments must be "
@@ -226,11 +170,81 @@ top_transform(Forms) when is_list(Forms) ->
end
end, Forms).
-parse(S, Loc) ->
- parse1(S, [], #state{loc = Loc}).
-
-parse(S, ParamPos, Loc) ->
- parse1(S, [], #state{loc = Loc, param_pos = ParamPos}).
+transform_sql(Arg) ->
+ S = erl_syntax:string_value(Arg),
+ Pos = erl_syntax:get_pos(Arg),
+ ParseRes = parse(S, Pos, true),
+ ParseResOld = parse(S, Pos, false),
+ case ParseRes#state.server_host_used of
+ {true, _SHVar} ->
+ ok;
+ false ->
+ add_warning(
+ Pos, no_server_host),
+ []
+ end,
+ set_pos(
+ make_schema_check(
+ make_sql_query(ParseRes),
+ make_sql_query(ParseResOld)
+ ),
+ Pos).
+
+transform_upsert(Form, TableArg, FieldsArg) ->
+ Table = erl_syntax:string_value(TableArg),
+ ParseRes =
+ parse_upsert(
+ erl_syntax:list_elements(FieldsArg)),
+ Pos = erl_syntax:get_pos(Form),
+ case lists:keymember(
+ "server_host", 1, ParseRes) of
+ true ->
+ ok;
+ false ->
+ add_warning(Pos, no_server_host)
+ end,
+ ParseResOld =
+ filter_upsert_sh(Table, ParseRes),
+ set_pos(
+ make_schema_check(
+ make_sql_upsert(Table, ParseRes, Pos),
+ make_sql_upsert(Table, ParseResOld, Pos)
+ ),
+ Pos).
+
+transform_insert(Form, TableArg, FieldsArg) ->
+ Table = erl_syntax:string_value(TableArg),
+ ParseRes =
+ parse_insert(
+ erl_syntax:list_elements(FieldsArg)),
+ Pos = erl_syntax:get_pos(Form),
+ case lists:keymember(
+ "server_host", 1, ParseRes) of
+ true ->
+ ok;
+ false ->
+ add_warning(Pos, no_server_host)
+ end,
+ ParseResOld =
+ filter_upsert_sh(Table, ParseRes),
+ set_pos(
+ make_schema_check(
+ make_sql_insert(Table, ParseRes),
+ make_sql_insert(Table, ParseResOld)
+ ),
+ Pos).
+
+
+parse(S, Loc, UseNewSchema) ->
+ parse1(S, [],
+ #state{loc = Loc,
+ use_new_schema = UseNewSchema}).
+
+parse(S, ParamPos, Loc, UseNewSchema) ->
+ parse1(S, [],
+ #state{loc = Loc,
+ param_pos = ParamPos,
+ use_new_schema = UseNewSchema}).
parse1([], Acc, State) ->
State1 = append_string(lists:reverse(Acc), State),
@@ -274,7 +288,7 @@ parse1([$%, $( | S], Acc, State) ->
State3 =
State2#state{server_host_used = {true, Name},
used_vars = [Name | State2#state.used_vars]},
- case ?USE_NEW_SCHEMA of
+ case State#state.use_new_schema of
true ->
Convert =
erl_syntax:application(
@@ -350,7 +364,7 @@ make_var(V) ->
make_sql_query(State) ->
- Hash = erlang:phash2(State#state{loc = undefined}),
+ Hash = erlang:phash2(State#state{loc = undefined, use_new_schema = true}),
SHash = <<"Q", (integer_to_binary(Hash))/binary>>,
Query = pack_query(State#state.'query'),
EQuery =
@@ -442,7 +456,7 @@ parse_upsert_field1([], _Acc, _ParamPos, Loc) ->
"?SQL_UPSERT fields must have the "
"following form: \"[!-]name=value\""});
parse_upsert_field1([$= | S], Acc, ParamPos, Loc) ->
- {lists:reverse(Acc), parse(S, ParamPos, Loc)};
+ {lists:reverse(Acc), parse(S, ParamPos, Loc, true)};
parse_upsert_field1([C | S], Acc, ParamPos, Loc) ->
parse_upsert_field1(S, [C | Acc], ParamPos, Loc).
@@ -632,7 +646,7 @@ parse_insert_field1([], _Acc, _ParamPos, Loc) ->
"?SQL_INSERT fields must have the "
"following form: \"name=value\""});
parse_insert_field1([$= | S], Acc, ParamPos, Loc) ->
- {lists:reverse(Acc), parse(S, ParamPos, Loc)};
+ {lists:reverse(Acc), parse(S, ParamPos, Loc, true)};
parse_insert_field1([C | S], Acc, ParamPos, Loc) ->
parse_insert_field1(S, [C | Acc], ParamPos, Loc).
@@ -640,6 +654,23 @@ parse_insert_field1([C | S], Acc, ParamPos, Loc) ->
make_sql_insert(Table, ParseRes) ->
make_sql_query(make_sql_upsert_insert(Table, ParseRes)).
+make_schema_check(Tree, Tree) ->
+ Tree;
+make_schema_check(New, Old) ->
+ erl_syntax:case_expr(
+ erl_syntax:application(
+ erl_syntax:atom(ejabberd_sql),
+ erl_syntax:atom(use_new_schema),
+ []),
+ [erl_syntax:clause(
+ [erl_syntax:abstract(true)],
+ none,
+ [New]),
+ erl_syntax:clause(
+ [erl_syntax:abstract(false)],
+ none,
+ [Old])]).
+
concat_states(States) ->
lists:foldr(
@@ -711,26 +742,10 @@ set_pos(Tree, Pos) ->
end, Tree).
filter_upsert_sh(Table, ParseRes) ->
- case ?USE_NEW_SCHEMA of
- true ->
- {ParseRes, []};
- false ->
- lists:foldr(
- fun({Field, _Match, ST} = P, {Acc, Vars}) ->
- if
- Field /= "server_host" orelse Table == "route" ->
- {[P | Acc], Vars};
- true ->
- {Acc, ST#state.used_vars ++ Vars}
- end
- end, {[], []}, ParseRes)
- end.
-
-add_unused_vars(Tree, []) ->
- Tree;
-add_unused_vars(Tree, Vars) ->
- erl_syntax:block_expr(
- lists:map(fun erl_syntax:variable/1, Vars) ++ [Tree]).
+ lists:filter(
+ fun({Field, _Match, _ST}) ->
+ Field /= "server_host" orelse Table == "route"
+ end, ParseRes).
-ifdef(ENABLE_PT_WARNINGS).
generated by cgit v1.2.3 (git 2.25.1) at 2025-09-11 13:10:44 +0000