Intermediate revision to survey module. Better questions, fixes for e…

…ditor, result page.

modules/mod_survey/dispatch/survey

@@ -1,4 +1,7 @@
 [
-	{survey, ["survey", id],       resource_page, [ {template, "survey.tpl"}  ]},
-	{survey, ["survey", id, slug], resource_page, [ {template, "survey.tpl"} ]}
+    {survey_results, ["survey", "results", id],       resource_page, [ {template, "survey_results.tpl"} ]},
+    {survey_results, ["survey", "results", id, slug], resource_page, [ {template, "survey_results.tpl"} ]},
+
+    {survey, ["survey", id],       resource_page, [ {template, "survey.tpl"} ]},
+    {survey, ["survey", id, slug], resource_page, [ {template, "survey.tpl"} ]}
 ].

modules/mod_survey/mod_survey.erl

@@ -29,7 +29,10 @@
 -export([
     event/2,
     redraw_questions/2,
-    delete_question/3
+    delete_question/3,
+
+    question_to_props/1,
+    module_name/1
 ]).
 
 -include_lib("zotonic.hrl").
@@ -43,8 +46,26 @@ init(Context) ->
 %% @doc Handle drag/drop events from the survey admin
 event({sort, Items, {dragdrop, {survey, [{id,Id}]}, _Delegate, "survey"}}, Context) ->
     event_sort(Id, Items, Context);
+
 event({submit, {survey_submit, [{id,SurveyId}]}, FormId, _FormId}, Context) ->
-    survey_submit:submit(SurveyId, FormId, Context).
+    survey_submit:submit(SurveyId, FormId, Context);
+
+event({postback, {survey_start, [{id, SurveyId}]}, _, _}, Context) ->
+    render_next_page(SurveyId, 1, [], Context);
+
+event({submit, {survey_next, Args}, _, _}, Context) ->
+    {id, SurveyId} = proplists:lookup(id, Args),
+    {page_nr, PageNr} = proplists:lookup(page_nr, Args),
+    {answers, Answers} = proplists:lookup(answers, Args),
+    render_next_page(SurveyId, PageNr+1, Answers, Context);
+
+event({postback, {survey_back, Args}, _, _}, Context) ->
+    {id, SurveyId} = proplists:lookup(id, Args),
+    {page_nr, PageNr} = proplists:lookup(page_nr, Args),
+    {answers, Answers} = proplists:lookup(answers, Args),
+    render_next_page(SurveyId, PageNr-1, Answers, Context).
+
+
 
 %%====================================================================
 %% support functions
@@ -139,6 +160,121 @@ new_question(Type) ->
     Mod:new().
 
 
+%% @doc Fetch the next page from the survey, update the page view
+render_next_page(Id, 0, Answers, Context) ->
+    z_render:update("survey-question", #render{template="_survey_start.tpl", vars=[{id,Id},{answers,Answers}]}, Context);
+render_next_page(Id, PageNr, Answers, Context) ->
+    As = z_context:get_q_all_noz(Context),
+    Answers1 = lists:foldl(fun({Arg,_Val}, Acc) -> proplists:delete(Arg, Acc) end, Answers, As),
+    Answers2 = Answers1 ++ As,
+    case m_rsc:p(Id, survey, Context) of
+        {survey, QuestionIds, Questions} ->
+            Qs = [ proplists:get_value(QId, Questions) || QId <- QuestionIds ],
+            Qs1 = [ Q || Q <- Qs, Q /= undefined ],
+
+            case fetch_page(PageNr, Qs1) of
+                {L,NewPageNr} when is_list(L) ->
+                    % A new list of questions, PageNr might be another than expected
+                    Vars = [ {id, Id},
+                             {page_nr, NewPageNr},
+                             {questions, [ question_to_props(Q) || Q <- L ]},
+                             {pages, count_pages(Qs1)},
+                             {answers, Answers2}],
+                    z_render:update("survey-question", #render{template="_survey_question_page.tpl", vars=Vars}, Context);
+                last ->
+                    % That was the last page. Show a thank you and save the result.
+                    case do_submit(Id, QuestionIds, Questions, Answers2, Context) of
+                        ok ->
+                            z_render:update("survey-question", #render{template="_survey_end.tpl", vars=[{id,Id}]}, Context);
+                        {error, _Reason} ->
+                            z_render:update("survey-question", #render{template="_survey_error.tpl", vars=[{id,Id}]}, Context)
+                    end
+            end;
+        _NoSurvey ->
+            % No survey defined, show an error page.
+            z_render:update("survey-question", #render{template="_survey_empty.tpl", vars=[{id,Id}]}, Context)
+    end.
+
+
+    %% @doc Count the number of pages in the survey
+    count_pages([]) ->
+        0;
+    count_pages(L) ->
+        count_pages(L, 1).
+
+    count_pages([], N) ->
+        N;
+    count_pages([#survey_question{type=pagebreak}|L], N) ->
+        L1 = lists:dropwhile(fun(#survey_question{type=pagebreak}) -> true; (_) -> false end, L),
+        count_pages(L1, N+1);
+    count_pages([_|L], N) ->
+        count_pages(L, N).
+
+    %% @doc Fetch the Nth page.  Could return another page due to jumps in the pagebreaks.
+    fetch_page(_Nr, []) ->
+        last;
+    fetch_page(Nr, L) ->
+        fetch_page(1, Nr, L).
+
+    fetch_page(_, _, []) ->
+        last;
+    fetch_page(N, Nr, L) when N >= Nr ->
+        L1 = lists:takewhile(fun(#survey_question{type=pagebreak}) -> false; (_) -> true end, L),
+        {L1, N};
+    fetch_page(N, Nr, [#survey_question{type=pagebreak}|L]) when N < Nr ->
+        L1 = lists:dropwhile(fun(#survey_question{type=pagebreak}) -> true; (_) -> false end, L),
+        fetch_page(N+1, Nr, L1);
+    fetch_page(N, Nr, [_|L]) ->
+        fetch_page(N, Nr, L).
+
+
+%% @doc Map a question to template friendly properties
+question_to_props(Q) ->
+    [
+        {name, Q#survey_question.name},
+        {type, Q#survey_question.type},
+        {question, Q#survey_question.question},
+        {text, Q#survey_question.text},
+        {parts, Q#survey_question.parts},
+        {html, Q#survey_question.html},
+        {is_required, Q#survey_question.is_required}
+    ].
+
+
+%% @doc Collect all answers per question, save to the database.
+do_submit(SurveyId, QuestionIds, Questions, Answers, Context) ->
+    {FoundAnswers, Missing} = collect_answers(QuestionIds, Questions, Answers),
+    case Missing of
+        [] ->
+            m_survey:insert_survey_submission(SurveyId, FoundAnswers, Context),
+            ok;
+        _ -> 
+            {error, notfound}
+    end.
+
+
+%% @doc Collect all answers, report any missing answers.
+%% @type collect_answers(proplist(), Context) -> {AnswerList, MissingIdsList}
+collect_answers(QIds, Qs, Answers) ->
+    collect_answers(QIds, Qs, Answers, [], []).
+
+
+collect_answers([], _Qs, _Answers, FoundAnswers, Missing) ->
+    {FoundAnswers, Missing};
+collect_answers([QId|QIds], Qs, Answers, FoundAnswers, Missing) ->
+    Q = proplists:get_value(QId, Qs),
+    Module = module_name(Q),
+    case Module:answer(Q, Answers) of
+        {ok, none} -> collect_answers(QIds, Qs, Answers, FoundAnswers, Missing);
+        {ok, AnswerList} -> collect_answers(QIds, Qs, Answers, [{QId, AnswerList}|FoundAnswers], Missing);
+        {error, missing} -> collect_answers(QIds, Qs, Answers, FoundAnswers, [QId|Missing])
+    end.
+
+module_name(#survey_question{type=Type}) ->
+    list_to_atom("survey_q_"++atom_to_list(Type)).
+
+
+
 datamodel() ->
     [
         {categories, [

modules/mod_survey/models/m_survey.erl

@@ -47,7 +47,12 @@ m_find_value(Id, #m{value=questions}, Context) ->
             question_to_value(QuestionIds, Questions, []);
         undefined -> 
             undefined
-    end.
+    end;
+m_find_value(results, #m{value=undefined} = M, _Context) ->
+    M#m{value=results};
+m_find_value(Id, #m{value=results}, Context) ->
+    prepare_results(Id, Context).
+
 
 %% @doc Transform a m_config value to a list, used for template loops
 %% @spec m_to_list(Source, Context)
@@ -61,45 +66,79 @@ m_value(#m{value=undefined}, _Context) ->
 
 
 
-%% @doc Transform a list of survey questions to template friendly proplists
+%% @doc Transform a list of survey questions to admin template friendly proplists
 question_to_value([], _, Acc) ->
     lists:reverse(Acc);
 question_to_value([Id|Ids], Qs, Acc) ->
     Q = proplists:get_value(Id, Qs),
     question_to_value(Ids, Qs, [question_to_value1(Id, Q)|Acc]).
 
-    question_to_value1(Id, #survey_question{type=Type, name=Name, html=Html}) ->
-        {Id, [{id, Id}, {type, Type}, {name, Name}, {html, Html}]};
-    question_to_value1(Id, undefined) ->
-        {Id, [{id, Id}, {type, undefined}]}.
+    question_to_value1(Id, Q) ->
+        {Id, [{id, Id} | mod_survey:question_to_props(Q)]}.
 
 
 
-%% @doc Save a survey, connect to the current visitor and user (if any)
+%% @doc Save a survey, connect to the current user (if any)
 insert_survey_submission(SurveyId, Answers, Context) ->
     UserId = z_acl:user(Context),
     %% Delete previous answers of this user, if any
     case UserId of
-        undefined -> nop;
-        _Other -> z_db:q("delete from survey_answer where survey_id = $1 and user_id = $2", [SurveyId, UserId], Context)
+        undefined ->
+            PersistentId = z_context:persistent_id(Context),
+            z_db:q("delete from survey_answer where survey_id = $1 and persistent = $2", [SurveyId, PersistentId], Context);
+        _Other ->
+            z_db:q("delete from survey_answer where survey_id = $1 and user_id = $2", [SurveyId, UserId], Context),
+            PersistentId = undefined
     end,
-    insert_questions(SurveyId, UserId, Answers, Context).
+    insert_questions(SurveyId, UserId, PersistentId, Answers, Context).
 
-    insert_questions(_SurveyId, _UserId, [], _Context) ->
+    insert_questions(_SurveyId, _UserId, _PersistentId, [], _Context) ->
         ok;
-    insert_questions(SurveyId, UserId, [{QuestionId, Answers}|Rest], Context) ->
-        insert_answers(SurveyId, UserId, QuestionId, Answers, Context),
-        insert_questions(SurveyId, UserId, Rest, Context).
+    insert_questions(SurveyId, UserId, PersistentId, [{QuestionId, Answers}|Rest], Context) ->
+        insert_answers(SurveyId, UserId, PersistentId, QuestionId, Answers, Context),
+        insert_questions(SurveyId, UserId, PersistentId, Rest, Context).
 
-    insert_answers(_SurveyId, _UserId, _QuestionId, [], _Context) ->
+    insert_answers(_SurveyId, _UserId, _PersistentId, _QuestionId, [], _Context) ->
         ok;
-    insert_answers(SurveyId, UserId, QuestionId, [{Name, Answer}|As], Context) ->
+    insert_answers(SurveyId, UserId, PersistentId, QuestionId, [{Name, Answer}|As], Context) ->
         Args = case Answer of
-            {text, Text} -> [SurveyId, UserId, QuestionId, Name, undefined, Text];
-            Value -> [SurveyId, UserId, QuestionId, Name, z_convert:to_list(Value), undefined]
+            {text, Text} -> [SurveyId, UserId, PersistentId, QuestionId, Name, undefined, Text];
+            Value -> [SurveyId, UserId, PersistentId, QuestionId, Name, z_convert:to_list(Value), undefined]
         end,
-        z_db:q("insert into survey_answer (survey_id, user_id, question, name, value, text) values ($1, $2, $3, $4, $5, $6)", Args, Context),
-        insert_answers(SurveyId, UserId, QuestionId, As, Context).
+        z_db:q("insert into survey_answer (survey_id, user_id, persistent, question, name, value, text) 
+                values ($1, $2, $3, $4, $5, $6, $7)", 
+               Args,
+               Context),
+        insert_answers(SurveyId, UserId, PersistentId, QuestionId, As, Context).
+
+
+prepare_results(SurveyId, Context) ->
+    case m_rsc:p(SurveyId, survey, Context) of
+        {survey, QuestionIds, Questions} ->
+            Stats = survey_stats(SurveyId, Context),
+            [
+                prepare_result(proplists:get_value(QId, Questions), 
+                               proplists:get_value(z_convert:to_binary(QId), Stats)) 
+                || QId <- QuestionIds
+            ];
+        undefined -> 
+            undefined
+    end.
+
+    prepare_result(Question, Stats) ->
+        [
+         Stats,
+         prep_chart(Question, Stats),
+         mod_survey:question_to_props(Question)
+        ].
+
+
+prep_chart(_Q, undefined) ->
+    undefined;
+prep_chart(Q, Stats) ->
+    M = mod_survey:module_name(Q),
+    M:prep_chart(Q, Stats).
+
 
 
 %% @doc Fetch the aggregate answers of a survey, omitting the open text answers. 
@@ -137,6 +176,7 @@ install(Context) ->
                 #column_def{name=id, type="serial", is_nullable=false},
                 #column_def{name=survey_id, type="integer", is_nullable=false},
                 #column_def{name=user_id, type="integer", is_nullable=true},
+                #column_def{name=persistent, type="character varying", length=32, is_nullable=true},
                 #column_def{name=question, type="character varying", length=32, is_nullable=false},
                 #column_def{name=name, type="character varying", length=32, is_nullable=false},
                 #column_def{name=value, type="character varying", length=80, is_nullable=true},
@@ -153,11 +193,12 @@ install(Context) ->
     z_db:equery("alter table survey_answer add 
                 constraint fk_survey_answer_user_id foreign key (user_id) references rsc(id) 
                 on update cascade on delete cascade", Context),
-                
+
     %% For aggregating answers to survey questions (group by name)
     z_db:equery("create index survey_answer_survey_name_key on survey_answer(survey_id, name)", Context),
     z_db:equery("create index survey_answer_survey_question_key on survey_answer(survey_id, question)", Context),
     z_db:equery("create index survey_answer_survey_user_key on survey_answer(survey_id, user_id)", Context),
+    z_db:equery("create index survey_answer_survey_persistent_key on survey_answer(survey_id, persistent)", Context),
 
     ok.
 

modules/mod_survey/questions/survey_q_likert.erl

@@ -4,9 +4,11 @@
     new/0,
     question_props/1,
     render/1,
-    answer/2
+    answer/2,
+    prep_chart/2
 ]).
 
+-include("zotonic.hrl").
 -include("../survey.hrl").
 
 new() ->
@@ -54,8 +56,24 @@ render(Q) ->
             ])
     }.
 
-answer(#survey_question{name=Name}, Context) ->
-    case z_context:get_q(Name, Context) of
+answer(#survey_question{name=Name}, Answers) ->
+    case proplists:get_value(Name, Answers) of
         [C] when C >= $1, C =< $5 -> {ok, [{Name, C - $0}]};
         undefined -> {error, missing}
     end.
+
+
+prep_chart(_Q, []) ->
+    undefined;
+prep_chart(_Q, [{_, Vals}]) ->
+    Labels = [<<"1">>,<<"2">>,<<"3">>,<<"4">>,<<"5">>],
+    LabelsDisplay = [<<"Strongly agree">>,<<"Agree">>,<<"Neutral">>,<<"Disagree">>,<<"Strongly disagree">>],
+
+    Values = [ proplists:get_value(C, Vals, 0) || C <- Labels ],
+    Sum = case lists:sum(Values) of 0 -> 1; N -> N end,
+    Perc = [ round(V*100/Sum) || V <- Values ],
+    [
+        {values, lists:zip(LabelsDisplay, Values)},
+        {type, "pie"},
+        {data, lists:zip(LabelsDisplay, Perc)}
+    ].

modules/mod_survey/questions/survey_q_longanswer.erl

@@ -49,9 +49,9 @@ render(Q) ->
             ])
     }.
 
-answer(Q, Context) ->
+answer(Q, Answers) ->
     Name = Q#survey_question.name,
-    case z_context:get_q(Name, Context) of
+    case proplists:get_value(Name, Answers) of
         undefined -> {error, missing};
         Value -> case z_string:trim(Value) of
                     [] -> {error, missing};