From 0e7c978804be28ef8cb5c7e6904af4849e685721 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Michal=20Mal=C3=BD?= Date: Tue, 25 Nov 2014 00:47:41 +0100 Subject: [PATCH] - Store multiple problems to allow for the user to return to previous problems --- bin/templates/face_acidobazic.html | 2 + bin/templates/face_solubility_params.html | 1 + bin/templates/face_solubility_submit.html | 1 + src/face_generators/face_generator.adb | 33 ++- src/face_generators/face_generator.ads | 12 +- src/formatting_helpers.adb | 1 - src/global_types.adb | 34 ++- src/global_types.ads | 11 +- src/handlers/handler_check_answer.adb | 23 +- src/handlers/handler_next_problem.adb | 31 +- src/handlers/handler_start.adb | 15 +- src/nine_q.adb | 4 +- .../problem_generator-solubility_suite.adb | 15 +- src/problem_generators/problem_generator.adb | 14 +- src/problem_generators/problem_generator.ads | 22 +- .../problem_generator_syswides.ads | 5 + src/problem_manager.adb | 266 +++++++++++++----- src/problem_manager.ads | 43 ++- 18 files changed, 367 insertions(+), 166 deletions(-) diff --git a/bin/templates/face_acidobazic.html b/bin/templates/face_acidobazic.html index 59001ca..e36074d 100644 --- a/bin/templates/face_acidobazic.html +++ b/bin/templates/face_acidobazic.html @@ -3,6 +3,7 @@
Zadání:
Vypočítejte pH @_SUBSTANCE_@ jejíž @_PKX_@ = @_PKX_VALUE_INT_@,@_PKX_VALUE_DEC_@ a koncentrace c = @_CONCENTRATION_INT_@,@_CONCENTRATION_DEC_@ . 10@_CONCENTRATION_EXP_@ mol/L.
+
@@ -36,6 +37,7 @@
Parametry příkladů:
+
diff --git a/bin/templates/face_solubility_params.html b/bin/templates/face_solubility_params.html index 86852e2..6600b34 100644 --- a/bin/templates/face_solubility_params.html +++ b/bin/templates/face_solubility_params.html @@ -1,4 +1,5 @@ +
diff --git a/bin/templates/face_solubility_submit.html b/bin/templates/face_solubility_submit.html index c1fec58..5b2c8e3 100644 --- a/bin/templates/face_solubility_submit.html +++ b/bin/templates/face_solubility_submit.html @@ -1,4 +1,5 @@ +
diff --git a/src/face_generators/face_generator.adb b/src/face_generators/face_generator.adb index 0f9c751..8297c82 100644 --- a/src/face_generators/face_generator.adb +++ b/src/face_generators/face_generator.adb @@ -22,17 +22,19 @@ package body Face_Generator is function Generate_Face(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean is + HTML: out HTML_Code; + Pr_ID: in String; Pr_Cat: in String) return Boolean is begin return Generate_Face_With_Answer(Assignment => Assignment, Parameters => Parameters, HTML => HTML, - Answer_Message => To_UB_Text(""), Answer_Code => Problem_Generator_Syswides.Invalid_Answer); + Answer_Message => To_UB_Text(""), Answer_Code => Problem_Generator_Syswides.Invalid_Answer, + Pr_ID => Pr_ID, Pr_Cat => Pr_Cat); end Generate_Face; function Generate_Face_With_Answer(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean is + HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is use Problem_Generator_Syswides; use Problem_Generator_Syswides.Assignment_Info; @@ -45,9 +47,9 @@ package body Face_Generator is Problem_Type_Str: constant String := Assignment.Element(PROBLEM_TYPE_KEY); begin if Problem_Type_Str = PROBLEM_TYPE_ACIDOBAZIC then - return Generate_Face_Acidobazic(Assignment, Answer_Message, Answer_Code, Parameters, HTML); + return Generate_Face_Acidobazic(Assignment, Answer_Message, Answer_Code, Parameters, HTML, Pr_ID, Pr_Cat); elsif Problem_Type_Str = PROBLEM_TYPE_SOLUBILITY then - return Generate_Face_Solubility(Assignment, Answer_Message, Answer_Code, Parameters, HTML); + return Generate_Face_Solubility(Assignment, Answer_Message, Answer_Code, Parameters, HTML, Pr_ID, Pr_Cat); else return False; end if; @@ -84,7 +86,7 @@ package body Face_Generator is Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean is + HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is use AWS.Templates; use Problem_Generator_Syswides; use Problem_Generator_Syswides.Assignment_Info; @@ -102,6 +104,11 @@ package body Face_Generator is Temp := Parse(Filename => "scripts/expand_collapse.js", Cached => True); Append_HTML(Source => HTML, New_Item => Temp); + -- Mandatory hidden parameters + Insert(Translations, Assoc(RESERVED_PROBLEM_ID_KEY, RESERVED_PROBLEM_ID_KEY)); + Insert(Translations, Assoc(RESERVED_PROBLEM_ID_VAL_KEY, Pr_ID)); + Insert(Translations, Assoc(RESERVED_PROBLEM_CATEGORY_KEY, RESERVED_PROBLEM_CATEGORY_KEY)); + Insert(Translations, Assoc(RESERVED_PROBLEM_CATEGORY_VAL_KEY, Pr_Cat)); Insert(Translations, Assoc(Acidobazic_Suite.CONCENTRATION_INT_KEY, Assignment.Element(Acidobazic_Suite.CONCENTRATION_INT_KEY))); Insert(Translations, Assoc(Acidobazic_Suite.CONCENTRATION_DEC_KEY, Assignment.Element(Acidobazic_Suite.CONCENTRATION_DEC_KEY))); Insert(Translations, Assoc(Acidobazic_Suite.CONCENTRATION_EXP_KEY, Assignment.Element(Acidobazic_Suite.CONCENTRATION_EXP_KEY))); @@ -146,7 +153,7 @@ package body Face_Generator is Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean is + HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is use Ada.Strings.Unbounded; use AWS.Templates; use Problem_Generator_Syswides; @@ -155,6 +162,7 @@ package body Face_Generator is Translations_Hdr: Translate_Set; Translations_Params: Translate_Set; + Translations_Submit: Translate_Set; Translations: Translate_Set; Temp: HTML_Code; Params_Code: HTML_Code; @@ -171,10 +179,19 @@ package body Face_Generator is Add_Answer_Section(Translations, Answer_Message, Answer_Code); - Temp := Parse(Filename => "templates/face_solubility_submit.html", Cached => True); + -- Add submit section + -- - Mandatory parameters + Insert(Translations_Submit, Assoc(RESERVED_PROBLEM_ID_KEY, Pr_ID)); + Insert(Translations_Submit, Assoc(RESERVED_PROBLEM_ID_VAL_KEY, Pr_ID)); + -- + Temp := Parse(Filename => "templates/face_solubility_submit.html", Translations => Translations_Submit); Insert(Translations, Assoc("SUBMIT_FORM", HTML_To_Fixed_String(Temp))); -- Add parameters section + -- - Mandatory parameters + Insert(Translations_Params, Assoc(RESERVED_PROBLEM_CATEGORY_KEY, Pr_Cat)); + Insert(Translations, Assoc(RESERVED_PROBLEM_CATEGORY_VAL_KEY, Pr_Cat)); + -- Insert(Translations_Params, Assoc(Solubility_Suite.PARAMETER_IONIC_STRENGTH_KEY, Solubility_Suite.PARAMETER_IONIC_STRENGTH_KEY)); if Parameters.Find(Solubility_Suite.PARAMETER_IONIC_STRENGTH_KEY) /= Parameters_Info.No_Element then Insert(Translations_Params, Assoc("PARAMETER_IONIC_STRENGTH_CHECKED", "checked=""checked""")); diff --git a/src/face_generators/face_generator.ads b/src/face_generators/face_generator.ads index a758854..9db16ca 100644 --- a/src/face_generators/face_generator.ads +++ b/src/face_generators/face_generator.ads @@ -8,13 +8,15 @@ package Face_Generator is function Generate_Face(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean; + HTML: out HTML_Code; + Pr_ID: in String; Pr_Cat: in String) return Boolean; function Generate_Face_With_Answer(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean; + HTML: out HTML_Code; + Pr_ID: in String; Pr_Cat: in String) return Boolean; private procedure Add_Answer_Section(Translations: in out AWS.Templates.Translate_Set; Answer_Message: in UB_Text; @@ -24,13 +26,15 @@ private Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean; + HTML: out HTML_Code; + Pr_ID: in String; Pr_Cat: in String) return Boolean; function Generate_Face_Solubility(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean; + HTML: out HTML_Code; + Pr_ID: in String; Pr_Cat: in String) return Boolean; HEADER_CAPTION_KEY: constant String := "HEADER_CAPTION"; HINTS_SECTION_KEY: constant String := "HINTS_SECTION"; diff --git a/src/formatting_helpers.adb b/src/formatting_helpers.adb index 8163dde..2464386 100644 --- a/src/formatting_helpers.adb +++ b/src/formatting_helpers.adb @@ -29,7 +29,6 @@ package body Formatting_Helpers is end Get_Integer_Part_Int; function String_To_Float(S: in String) return FH_Float is - F: FH_Float; Idx: Natural; SS: String := S; begin diff --git a/src/global_types.adb b/src/global_types.adb index 2480115..e4c067c 100644 --- a/src/global_types.adb +++ b/src/global_types.adb @@ -1,38 +1,58 @@ package body Global_Types is procedure Append_HTML(Source: in out HTML_Code; New_Item: in HTML_Code) is + use Ada.Strings.Unbounded; begin - Ada.Strings.Unbounded.Append(Source => Source, New_Item => New_Item); + Append(Source => Source, New_Item => New_Item); end Append_HTML; procedure Append_UB_Text(Source: in out UB_Text; New_Item: in UB_Text) is + use Ada.Strings.Unbounded; begin - Ada.Strings.Unbounded.Append(Source => Source, New_Item => New_Item); + Append(Source => Source, New_Item => New_Item); end Append_UB_Text; procedure Append_UB_Text(Source: in out UB_Text; New_Item: in String) is + use Ada.Strings.Unbounded; begin - Ada.Strings.Unbounded.Append(Source => Source, New_Item => To_UB_Text(New_Item)); + Append(Source => Source, New_Item => To_Unbounded_String(New_Item)); end Append_UB_Text; function HTML_To_Fixed_String(HTML: in HTML_Code) return String is + use Ada.Strings.Unbounded; begin - return Ada.Strings.Unbounded.To_String(HTML); + return To_String(HTML); end HTML_To_Fixed_String; function To_HTML_Code(S: in String) return HTML_Code is + use Ada.Strings.Unbounded; begin - return Ada.Strings.Unbounded.To_Unbounded_String(S); + return To_Unbounded_String(S); end To_HTML_Code; function To_UB_Text(S: in String) return UB_Text is + use Ada.Strings.Unbounded; begin - return Ada.Strings.Unbounded.To_Unbounded_String(S); + return To_Unbounded_String(S); end To_UB_Text; function UB_Text_To_Fixed_String(Text: in UB_Text) return String is + use Ada.Strings.Unbounded; begin - return Ada.Strings.Unbounded.To_String(Text); + return To_String(Text); end UB_Text_To_Fixed_String; + + protected body Simple_Mutex is + entry Lock when Locked = False is + begin + Locked := True; + end Lock; + + entry Unlock when Locked is + begin + Locked := False; + end Unlock; + end Simple_Mutex; + end Global_Types; diff --git a/src/global_types.ads b/src/global_types.ads index 7e42f39..adfca9c 100644 --- a/src/global_types.ads +++ b/src/global_types.ads @@ -3,7 +3,8 @@ with Ada.Strings.Unbounded; package Global_Types is - subtype Unique_ID is Ada.Containers.Count_Type; + type Problem_ID is new Ada.Containers.Count_Type; + type Unique_ID is new Ada.Containers.Count_Type; subtype HTML_Code is Ada.Strings.Unbounded.Unbounded_String; subtype UB_Text is Ada.Strings.Unbounded.Unbounded_String; @@ -15,4 +16,12 @@ package Global_Types is function To_UB_Text(S: in String) return UB_Text; function UB_Text_To_Fixed_String(Text: in UB_Text) return String; + protected type Simple_Mutex is + entry Lock; + entry Unlock; + private + Locked: Boolean := False; + end Simple_Mutex; + type Simple_Mutex_All_Access is access all Simple_Mutex; + end Global_Types; diff --git a/src/handlers/handler_check_answer.adb b/src/handlers/handler_check_answer.adb index af41bb8..386f121 100644 --- a/src/handlers/handler_check_answer.adb +++ b/src/handlers/handler_check_answer.adb @@ -33,6 +33,7 @@ package body Handler_Check_Answer is POST_Data: constant AWS.Parameters.List := AWS.Status.Parameters(Request); Answer: Answer_Info.Map; + Pr_ID: Problem_ID; Success: Boolean; begin -- Get UID @@ -55,7 +56,27 @@ package body Handler_Check_Answer is end; end loop; - Success := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML); + -- Get problem ID + if Answer.Find(Problem_Generator_Syswides.RESERVED_PROBLEM_ID_KEY) = Answer_Info.No_Element then + Ada.Text_IO.Put_Line("Problem ID not found!"); + return AWS.Response.URL(Location => "/"); + end if; + + begin + Pr_ID := Problem_ID'Value(Answer.Element(Problem_Generator_Syswides.RESERVED_PROBLEM_ID_KEY)); + Ada.Text_IO.Put_Line("Got problem ID " & Problem_ID'Image(Pr_ID)); + exception + when Constraint_Error => + Ada.Text_IO.Put_Line("Invalid problem ID value"); + return AWS.Response.URL(Location => "/"); + end; + + Success := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML, Pr_ID); + if Success = False then + Ada.Text_IO.Put_Line("No such problem in storage"); + return AWS.Response.URL(Location => "/"); + end if; + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, Message_Body => HTML_To_Fixed_String(HTML), Status_Code => AWS.Messages.S200); diff --git a/src/handlers/handler_next_problem.adb b/src/handlers/handler_next_problem.adb index 18675dc..84119ae 100644 --- a/src/handlers/handler_next_problem.adb +++ b/src/handlers/handler_next_problem.adb @@ -6,6 +6,8 @@ with AWS.Response; with AWS.Session; with AWS.Status; +with Ada.Text_IO; + with Global_Types; with Problem_Generator_Syswides; with Problem_Manager; @@ -52,16 +54,31 @@ package body Handler_Next_Problem is end; end loop; - -- Display new problem - Success := Problem_Manager.Display_Next_Assignment(UID, Problem_Parameters, HTML); - if Success = False then - -- TODO: Handle error in a less reckless manner + -- Create a new problem + if Problem_Parameters.Find(Problem_Generator_Syswides.RESERVED_PROBLEM_CATEGORY_KEY) = Parameters_Info.No_Element then + Ada.Text_IO.Put_Line("No problem category tag"); return AWS.Response.URL(Location => "/"); end if; - return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, - Message_Body => HTML_To_Fixed_String(HTML), - Status_Code => AWS.Messages.S200); + declare + Raw_P_Cat: constant String := Problem_Parameters.Element(Problem_Generator_Syswides.RESERVED_PROBLEM_CATEGORY_KEY); + begin + Success := Problem_Manager.Prepare_Problem(UID, Raw_P_Cat, Problem_Parameters); + if Success = False then + -- TODO: Handle error in a less reckless manner + return AWS.Response.URL(Location => "/"); + end if; + -- Display new problem + Success := Problem_Manager.Display_Assignment(UID, HTML); + if Success = False then + -- TODO: Handle error in a less reckless manner + return AWS.Response.URL(Location => "/"); + end if; + + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => HTML_To_Fixed_String(HTML), + Status_Code => AWS.Messages.S200); + end; end; when others => return AWS.Response.URL(Location => "/"); diff --git a/src/handlers/handler_start.adb b/src/handlers/handler_start.adb index cd7008e..976b640 100644 --- a/src/handlers/handler_start.adb +++ b/src/handlers/handler_start.adb @@ -24,18 +24,9 @@ package body Handler_Start is when AWS.Status.GET => declare Raw_Problem_Category: constant String := AWS.Status.Parameter(Request, "problem_category"); - P_Cat: Problem_Manager.Problem_Category; UID: Unique_ID; Success: Boolean; - begin - if Raw_Problem_Category = Problem_Manager.Problem_Category'Image(Problem_Manager.Acidobazic) then - P_Cat := Problem_Manager.Acidobazic; - elsif Raw_Problem_Category = Problem_Manager.Problem_Category'Image(Problem_Manager.Solubility) then - P_Cat := Problem_Manager.Solubility; - else - return AWS.Response.URL(Location => "/"); - end if; - + begin -- Register new UID if necessary and create a first problem Success := Problem_Manager.Get_UID(Raw_UID, UID); if Success = False then @@ -52,14 +43,14 @@ package body Handler_Start is end if; -- We're all set, create a new problem - Success := Problem_Manager.Prepare_Problem(UID, P_Cat); + Success := Problem_Manager.Prepare_Problem(UID, Raw_Problem_Category); if Success = False then -- Something went wrong when generating the problem -- TODO: Print some sensible error message, for now just redirect to index return AWS.Response.URL(Location => "/"); end if; - Success := Problem_Manager.Display_New_Assignment(UID, HTML); + Success := Problem_Manager.Display_Assignment(UID, HTML); if Success = False then HTML := To_HTML_Code("Cannot display assignment"); end if; diff --git a/src/nine_q.adb b/src/nine_q.adb index a13a970..688f18f 100644 --- a/src/nine_q.adb +++ b/src/nine_q.adb @@ -15,8 +15,8 @@ begin AWS.Config.Set.Server_Host(Server_Config, "localhost"); AWS.Config.Set.Server_Port(Server_Config, 18400); - AWS.Config.Set.Session_Lifetime(1800.0); - AWS.Config.Set.Session_Cleanup_Interval(900.0); + AWS.Config.Set.Session_Lifetime(90.0); + AWS.Config.Set.Session_Cleanup_Interval(180.0); Ada.Text_IO.Put_Line("Starting server..."); AWS.Server.Start(Web_Server => Web_Server, diff --git a/src/problem_generators/problem_generator-solubility_suite.adb b/src/problem_generators/problem_generator-solubility_suite.adb index 84be063..a7db203 100644 --- a/src/problem_generators/problem_generator-solubility_suite.adb +++ b/src/problem_generators/problem_generator-solubility_suite.adb @@ -12,13 +12,9 @@ package body Solubility_Suite is -- BEGIN: Inherited funcions function Create return access Solubility_Problem is Problem: access Solubility_Problem; - Parameters: Solubility_Parameters; begin - Parameters := (Ionic_Strength => False, - P_Subtype => V_FROM_G_KS); - Problem := new Solubility_Problem; - Problem.Parameters := Parameters; + Problem.Parameters := Solubility_Parameters'(Ionic_Strength => False, P_Subtype => V_FROM_G_KS); return Problem; end; @@ -198,7 +194,6 @@ package body Solubility_Suite is begin Auto_Lock.Init(Guard, Problem.Mutex'Unchecked_Access); Guard.Lock; - -- Generate MW Reset(Gen => Float_RGen); -- Generate stochiometry of the molecul @@ -229,7 +224,7 @@ package body Solubility_Suite is case Problem.Parameters.P_Subtype is when V_FROM_G_KS => declare - MOLECULE_WEIGHT_RANGE: constant SS_Float := MOLECULE_WEIGHT_MAX - MOLECULE_WEIGHT_MIN; + MOLAR_WEIGHT_RANGE: constant SS_Float := MOLAR_WEIGHT_MAX - MOLAR_WEIGHT_MIN; SAMPLE_WEIGHT_RANGE: constant SS_Float := SAMPLE_WEIGHT_MAX - SAMPLE_WEIGHT_MIN; G: SS_Float; -- Sample weight in grams Ks: SS_Float; -- Solubility product @@ -239,7 +234,7 @@ package body Solubility_Suite is G := (SS_Float(Random(Gen => Float_RGen)) * SAMPLE_WEIGHT_RANGE) + SAMPLE_WEIGHT_MIN; G := Round_To_Valid_Nums(G, DECIMALS); Ks := Round_To_Valid_Nums(Generate_Solubility_Product, DECIMALS); - MW := (SS_Float(Random(Gen => Float_RGen)) * MOLECULE_WEIGHT_RANGE) + MOLECULE_WEIGHT_MIN; + MW := (SS_Float(Random(Gen => Float_RGen)) * MOLAR_WEIGHT_RANGE) + MOLAR_WEIGHT_MIN; MW := Round_To_Valid_Nums(MW, DECIMALS_MW); Prob_Data := (Option => V_FROM_G_KS, M => SS_Float(M), N => SS_Float(N), @@ -248,7 +243,7 @@ package body Solubility_Suite is end; when KS_FROM_G_V => declare - MOLECULE_WEIGHT_RANGE: constant SS_Float := MOLECULE_WEIGHT_MAX - MOLECULE_WEIGHT_MIN; + MOLAR_WEIGHT_RANGE: constant SS_Float := MOLAR_WEIGHT_MAX - MOLAR_WEIGHT_MIN; SAMPLE_WEIGHT_RANGE: constant SS_Float := SAMPLE_WEIGHT_MAX - SAMPLE_WEIGHT_MIN; G: SS_Float; -- Sample weight in grams MW: SS_Float; -- Molar mass @@ -256,7 +251,7 @@ package body Solubility_Suite is begin G := (SS_Float(Random(Gen => Float_RGen)) * SAMPLE_WEIGHT_RANGE) + SAMPLE_WEIGHT_MIN; G := Round_To_Valid_Nums(G, DECIMALS); - MW := (SS_Float(Random(Gen => Float_RGen)) * MOLECULE_WEIGHT_RANGE) + MOLECULE_WEIGHT_MIN; + MW := (SS_Float(Random(Gen => Float_RGen)) * MOLAR_WEIGHT_RANGE) + MOLAR_WEIGHT_MIN; MW := Round_To_Valid_Nums(MW, DECIMALS_MW); V := Round_To_Valid_Nums(Generate_Sample_Volume, DECIMALS); Prob_Data := (Option => KS_FROM_G_V, diff --git a/src/problem_generators/problem_generator.adb b/src/problem_generators/problem_generator.adb index 97c3d48..672f87f 100644 --- a/src/problem_generators/problem_generator.adb +++ b/src/problem_generators/problem_generator.adb @@ -1,19 +1,7 @@ package body Problem_Generator is - protected body Problem_Mutex is - entry Lock when Locked = False is - begin - Locked := True; - end Lock; - - entry Unlock when Locked is - begin - Locked := False; - end Unlock; - end Problem_Mutex; - package body Auto_Lock is - procedure Init(This: in out LC; Mutex: Problem_Mutex_All_Access; Auto_Unlock: in Boolean := True) is + procedure Init(This: in out LC; Mutex: Simple_Mutex_All_Access; Auto_Unlock: in Boolean := True) is begin This.Auto_Unlock := Auto_Unlock; This.Mutex := Mutex; diff --git a/src/problem_generators/problem_generator.ads b/src/problem_generators/problem_generator.ads index 2492832..63bb6a9 100644 --- a/src/problem_generators/problem_generator.ads +++ b/src/problem_generators/problem_generator.ads @@ -5,16 +5,6 @@ with Ada.Finalization; use Global_Types; use Problem_Generator_Syswides; package Problem_Generator is - - protected type Problem_Mutex is - entry Lock; - entry Unlock; - - private - Locked: Boolean := False; - end Problem_Mutex; - type Problem_Mutex_All_Access is access all Problem_Mutex; - type Chem_Problem is abstract tagged limited private; function Create return access Chem_Problem is abstract; @@ -29,23 +19,21 @@ package Problem_Generator is private type Chem_Problem is abstract tagged limited record - Mutex: aliased Problem_Mutex; + Mutex: aliased Simple_Mutex; end record; package Auto_Lock is type LC is limited new Ada.Finalization.Limited_Controlled with private; - procedure Init(This: in out LC; Mutex: Problem_Mutex_All_Access; Auto_Unlock: in Boolean := True); + procedure Init(This: in out LC; Mutex: Simple_Mutex_All_Access; Auto_Unlock: in Boolean := True); procedure Lock(This: in out LC); procedure Unlock(This: in out LC); private type LC is limited new Ada.Finalization.Limited_Controlled with record Auto_Unlock: Boolean; - Mutex: Problem_Mutex_All_Access; + Mutex: Simple_Mutex_All_Access; end record; overriding procedure Finalize(This: in out LC); - - Pragma Volatile(LC); end Auto_Lock; package Acidobazic_Suite is @@ -129,8 +117,8 @@ private ELECTROLYTE_CONCENTRATION_LOG_MAX: constant SS_Float := 0.176; ELECTROLYTE_CONCENTRATION_LOG_MIN: constant SS_Float := -4.0; - MOLECULE_WEIGHT_MAX: constant SS_Float := 450.0; - MOLECULE_WEIGHT_MIN: constant SS_Float := 45.0; + MOLAR_WEIGHT_MAX: constant SS_Float := 450.0; + MOLAR_WEIGHT_MIN: constant SS_Float := 45.0; PKS_MAX: constant SS_Float := 54.0; PKS_MIN: constant SS_Float := 10.0; SAMPLE_VOLUME_LOG_MAX: constant SS_Float := 10.0; diff --git a/src/problem_generators/problem_generator_syswides.ads b/src/problem_generators/problem_generator_syswides.ads index f058304..3694316 100644 --- a/src/problem_generators/problem_generator_syswides.ads +++ b/src/problem_generators/problem_generator_syswides.ads @@ -20,6 +20,11 @@ package Problem_Generator_Syswides is PROBLEM_TYPE_KEY: constant String := "PROBLEM_TYPE"; PROBLEM_TYPE_ACIDOBAZIC: constant String := Problem_Type'Image(Acidobazic); PROBLEM_TYPE_SOLUBILITY: constant String := Problem_Type'Image(Solubility); + -- + RESERVED_PROBLEM_ID_KEY: constant String := "RESERVED__PROBLEM_ID"; + RESERVED_PROBLEM_ID_VAL_KEY: constant String := "RESERVED__PROBLEM_ID_VAL"; + RESERVED_PROBLEM_CATEGORY_KEY: constant String := "RESERVED__PROBLEM_CATEGORY"; + RESERVED_PROBLEM_CATEGORY_VAL_KEY: constant String := "RESERVED__PROBLEM_CATEGORY_VAL"; package Acidobazic_Suite is -- What effect to ignore in calculations? diff --git a/src/problem_manager.adb b/src/problem_manager.adb index 91d3fcf..34dd950 100644 --- a/src/problem_manager.adb +++ b/src/problem_manager.adb @@ -1,92 +1,76 @@ with Ada.Text_IO; +with Ada.Unchecked_Deallocation; with Face_Generator; package body Problem_Manager is - function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code) return Boolean is + function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code; Pr_ID: in Problem_ID) return Boolean is Answer_Message: UB_Text; ARC: Problem_Generator_Syswides.Answer_RetCode; Assignment: Problem_Generator_Syswides.Assignment_Info.Map; Parameters: Problem_Generator_Syswides.Parameters_Info.Map; + Pr_Cat: Problem_Category; Success: Boolean; - USD: User_Session_Data_Access; + Stored: Stored_Problem_All_Access; begin - USD := Active_Sessions.Get_Session_Data(UID, Success); - if Success = False then + Stored := Active_Sessions.Get_Problem(UID, Pr_ID); + if Stored = null then return False; end if; - Success := USD.Problem.Get_Parameters(Parameters); + Success := Stored.Problem.Get_Parameters(Parameters); if Success = False then -- TODO: Handle error in a better way + Stored.Mutex.Unlock; return False; end if; - Success := USD.Problem.Get_Assignment(Assignment); + Success := Stored.Problem.Get_Assignment(Assignment); if Success = False then -- TODO: Handle error in a better way + Stored.Mutex.Unlock; return False; end if; - ARC := USD.Problem.Check_Answer(Answer, Answer_Message); + Ada.Text_IO.Put_Line("Checking problem ID " & Problem_ID'Image(Pr_ID)); + ARC := Stored.Problem.Check_Answer(Answer, Answer_Message); + Pr_Cat := Stored.Category; + Stored.Mutex.Unlock; return Face_Generator.Generate_Face_With_Answer(Assignment => Assignment, Answer_Message => Answer_Message, Answer_Code => ARC, HTML => HTML, - Parameters => Parameters); + Parameters => Parameters, Pr_ID => Problem_ID'Image(Pr_ID), Pr_Cat => Problem_Category'Image(Pr_Cat)); end Display_Checked_Answer; - function Display_New_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean is + function Display_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean is Assignment: Problem_Generator_Syswides.Assignment_Info.Map; Parameters: Problem_Generator_Syswides.Parameters_Info.Map; - USD: User_Session_Data_Access; + Stored: Stored_Problem_All_Access; + Pr_ID: Problem_ID; + Pr_Cat: Problem_Category; Success: Boolean; begin - USD := Active_Sessions.Get_Session_Data(UID, Success); - if Success = False then + Stored := Active_Sessions.Get_Latest_Problem_With_ID(UID, Pr_ID); + if Stored = null then return False; end if; - -- Get default problem parameters - Success := USD.Problem.Get_Parameters(Parameters); + Success := Stored.Problem.Get_Parameters(Parameters); if Success = False then + Stored.Mutex.Unlock; return False; end if; -- Get assignment - Success := USD.Problem.Get_Assignment(Assignment); - if Success = False then - return False; - end if; - - return Face_Generator.Generate_Face(Assignment => Assignment, HTML => HTML, Parameters => Parameters); - end Display_New_Assignment; - - function Display_Next_Assignment(UID: in Unique_ID; Problem_Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean is - Assignment: Problem_Generator_Syswides.Assignment_Info.Map; - Success: Boolean; - USD: User_Session_Data_Access; - begin - USD := Active_Sessions.Get_Session_Data(UID, Success); + Success := Stored.Problem.Get_Assignment(Assignment); if Success = False then + Stored.Mutex.Unlock; return False; end if; - -- Set parameters before creating a new problem - Success := USD.Problem.Set_Parameters(Problem_Parameters); - if Success = False then - -- TODO: Handle error - return False; - end if; - - -- Create new problem and display it - USD.Problem.New_Problem; - Success := USD.Problem.Get_Assignment(Assignment); - if Success = False then - -- TODO: Handle error in a better way - return False; - end if; - - return Face_Generator.Generate_Face(Assignment => Assignment, HTML => HTML, Parameters => Problem_Parameters); - end Display_Next_Assignment; + Pr_Cat := Stored.Category; + Stored.Mutex.Unlock; + return Face_Generator.Generate_Face(Assignment => Assignment, HTML => HTML, Parameters => Parameters, Pr_ID => Problem_ID'Image(Pr_ID), + Pr_Cat => Problem_Category'Image(Pr_Cat)); + end Display_Assignment; function Get_UID(Raw_UID: in String; UID: out Unique_ID) return Boolean is begin @@ -99,32 +83,59 @@ package body Problem_Manager is end; end Get_UID; - function Prepare_Problem(UID: in Unique_ID; P_Cat: in Problem_Category) return Boolean is - New_USD: User_Session_Data_Access; + function Prepare_Problem(UID: in Unique_ID; Raw_P_Cat: in String; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return Boolean is + Problem: Chem_Problem_All_Access; + Storage: Stored_Problem_All_Access; + P_Cat: Problem_Category; Success: Boolean; begin - New_USD := new User_Session_Data; - New_USD.P_Cat := P_Cat; + if Raw_P_Cat = Problem_Manager.Problem_Category'Image(Problem_Manager.Acidobazic) then + P_Cat := Problem_Manager.Acidobazic; + elsif Raw_P_Cat = Problem_Manager.Problem_Category'Image(Problem_Manager.Solubility) then + P_Cat := Problem_Manager.Solubility; + else + return False; + end if; case P_Cat is when Acidobazic => - New_USD.Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Acidobazic); + Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Acidobazic); when Solubility => - New_USD.Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Solubility); + Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Solubility); when others => return False; end case; - New_USD.Problem.New_Problem; + if Problem = null then + return False; + end if; + -- Initialize problem + if Parameters.Is_Empty = False then + Success := Problem.Set_Parameters(Parameters); + Ada.Text_IO.Put_Line("Setting problem parameters"); + if Success = False then + Free_Chem_Problem(Problem); + return False; + end if; + end if; + Problem.New_Problem; + + Storage := new Stored_Problem; + Storage.Problem := Problem; + Storage.Category := P_Cat; + Active_Sessions.Add_Problem(UID, Storage, Success); - Active_Sessions.Set_Session_Data(UID, New_USD, Success); - return Success; + if Success = False then + Free_Chem_Problem(Problem); + Free_Stored_Problem(Storage); + end if; + return True; end Prepare_Problem; function Register_UID(UID: out Unique_ID) return Boolean is Success: Boolean; begin - -- Raw UID is empty, assuming a new session Active_Sessions.Register_UID(UID, Success); return Success; end Register_UID; @@ -136,17 +147,75 @@ package body Problem_Manager is begin Success := Get_UID(Raw_UID, UID); if Success = False then - Ada.Text_IO.Put_Line("Session expired: No such session"); return; end if; Active_Sessions.Remove_Session(UID); - Ada.Text_IO.Put_Line("Session expired: Session " & Raw_UID & " data deleted"); end Session_Expired; -- BEGIN: Private functions + + procedure Free_Chem_Problem(Problem: in out Chem_Problem_All_Access) is + procedure Free_Chem_Problem_Internal is new Ada.Unchecked_Deallocation(Object => Problem_Generator.Chem_Problem'Class, Name => Chem_Problem_All_Access); + begin + Free_Chem_Problem_Internal(Problem); + end Free_Chem_Problem; + + procedure Free_Stored_Problem(Problem: in out Stored_Problem_All_Access) is + procedure Free_Stored_Problem_Internal is new Ada.Unchecked_Deallocation(Object => Stored_Problem, Name => Stored_Problem_All_Access); + begin + Free_Stored_Problem_Internal(Problem); + end Free_Stored_Problem; + protected body Active_Sessions is + procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Success: out Boolean) is + use Problem_Storage; + use Session_Keeping; + use Ada.Containers; + + C: Problem_Storage.Cursor; + USD: User_Session_All_Access; + begin + if Sessions.Find(UID) = Session_Keeping.No_Element then + Success := False; + return; + end if; + USD := Sessions.Element(UID); + + USD.Problems.Insert(USD.Last_Problem_ID, Problem, C, Success); + if Success = False then + return; + end if; + + USD.Last_Problem_ID := USD.Last_Problem_ID + 1; + -- Delete old problems + declare + Del_ID: Problem_ID; + begin + if USD.Last_Problem_ID - 1 <= MAX_STORED_PROBLEMS then + Del_ID := Problem_ID'Last - (MAX_STORED_PROBLEMS - (USD.Last_Problem_ID - 1)); + else + Del_ID := (USD.Last_Problem_ID - 1) - MAX_STORED_PROBLEMS; + end if; + + if USD.Problems.Find(Del_ID) /= Problem_Storage.No_Element then + declare + SP: Stored_Problem_All_Access := USD.Problems(Del_ID); + begin + -- Delete pointer to the problem, grab a lock to make sure that the pointer is not used + -- anywhere else while we are deleting it + SP.Mutex.Lock; + Free_Chem_Problem(SP.Problem); + SP.Mutex.Unlock; + Free_Stored_Problem(SP); + USD.Problems.Delete(Del_ID); + end; + end if; + end; + Success := True; + end Add_Problem; + function Contains(UID: in Unique_ID) return Boolean is use Session_Keeping; begin @@ -161,11 +230,18 @@ package body Problem_Manager is use Session_Keeping; C: Session_Keeping.Cursor; + NUSD: User_Session_All_Access; begin Success := False; if Sessions.Find(UID) = Session_Keeping.No_Element then -- We have a free slot - Sessions.Insert(UID, null, C, Success); + NUSD := new User_Session_Data; + if NUSD = null then + Success := False; + Stop := False; + return; + end if; + Sessions.Insert(UID, NUSD, C, Success); if Success then Last_UID := UID; -- Registration successful @@ -181,28 +257,53 @@ package body Problem_Manager is Stop := False; end Check_Free_And_Register; - function Get_Session_Data(UID: in Unique_ID; Success: out Boolean) return User_Session_Data_Access is + procedure Free_Session_Data(Data: in out User_Session_All_Access) is + procedure Free_Session_Data_Internal is new Ada.Unchecked_Deallocation(Object => User_Session_Data, Name => User_Session_All_Access); + begin + Free_Session_Data_Internal(Data); + end Free_Session_Data; + + function Get_Problem(UID: in Unique_ID; Pr_ID: in Problem_ID) return Stored_Problem_All_Access is + use Problem_Storage; use Session_Keeping; + + USD: User_Session_All_Access; + S: Stored_Problem_All_Access; begin if Sessions.Find(UID) = Session_Keeping.No_Element then - Success := False; return null; - else - Success := True; - return Sessions.Element(UID); end if; - end Get_Session_Data; + USD := Sessions.Element(UID); + + if USD.Problems.Find(Pr_ID) = Problem_Storage.No_Element then + return null; + end if; - procedure Set_Session_Data(UID: in Unique_ID; USD: in User_Session_Data_Access; Success: out Boolean) is + + S := USD.Problems.Element(Pr_ID); + -- Check if the problem has not been deleted + if S = null then + return null; + end if; + if S.Problem = null then + return null; + end if; + + S.Mutex.Lock; + return S; + end Get_Problem; + + function Get_Latest_Problem_With_ID(UID: in Unique_ID; Pr_ID: out Problem_ID) return Stored_Problem_All_Access is use Session_Keeping; + begin if Sessions.Find(UID) = Session_Keeping.No_Element then - Success := False; - else - Sessions.Replace(UID, USD); - Success := True; + return null; end if; - end Set_Session_Data; + + Pr_ID := Sessions.Element(UID).Last_Problem_ID - 1; + return Get_Problem(UID, Pr_ID); + end Get_Latest_Problem_With_ID; procedure Register_UID(UID: out Unique_ID; Success: out Boolean) is Stop: Boolean; @@ -230,8 +331,31 @@ package body Problem_Manager is end Register_UID; procedure Remove_Session(UID: in Unique_ID) is + use Problem_Storage; use Session_Keeping; + + USD: User_Session_All_Access; begin + if Sessions.Find(UID) = Session_Keeping.No_Element then + return; + end if; + + USD := Sessions.Element(UID); + + while USD.Problems.Is_Empty = False loop + declare + SP: Stored_Problem_All_Access := USD.Problems.First_Element; + begin + SP.Mutex.Lock; + Free_Chem_Problem(SP.Problem); + SP.Mutex.Unlock; + Free_Stored_Problem(SP); + USD.Problems.Delete_First; + end; + end loop; + + Free_Session_Data(USD); + Sessions.Delete(UID); end Remove_Session; diff --git a/src/problem_manager.ads b/src/problem_manager.ads index 57cfed5..542d731 100644 --- a/src/problem_manager.ads +++ b/src/problem_manager.ads @@ -9,38 +9,57 @@ package Problem_Manager is type Problem_Category is (Invalid, Acidobazic, Solubility); - function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code) return Boolean; - function Display_New_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean; - function Display_Next_Assignment(UID: in Unique_ID; - Problem_Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code) return Boolean; + function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code; + Pr_ID: in Problem_ID) return Boolean; + function Display_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean; + --function Display_Next_Assignment(UID: in Unique_ID; + -- Problem_Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + -- HTML: out HTML_Code) return Boolean; function Get_UID(Raw_UID: in String; UID: out Unique_ID) return Boolean; - function Prepare_Problem(UID: in Unique_ID; P_Cat: in Problem_Category) return Boolean; + function Prepare_Problem(UID: in Unique_ID; Raw_P_Cat: in String; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return Boolean; function Register_UID(UID: out Unique_ID) return Boolean; procedure Session_Expired(SID: AWS.Session.ID); private + type Chem_Problem_All_Access is access all Problem_Generator.Chem_Problem'Class; + procedure Free_Chem_Problem(Problem: in out Chem_Problem_All_Access); + + type Stored_Problem is + record + Mutex: Simple_Mutex; + Problem: Chem_Problem_All_Access; + Category: Problem_Category; + end record; + type Stored_Problem_All_Access is access all Stored_Problem; + procedure Free_Stored_Problem(Problem: in out Stored_Problem_All_Access); + + package Problem_Storage is new Ada.Containers.Ordered_Maps(Key_Type => Problem_ID, Element_Type => Stored_Problem_All_Access); + type User_Session_Data is record - P_Cat: Problem_Category; - Problem: access Problem_Generator.Chem_Problem'Class; + Problems: Problem_Storage.Map; + Last_Problem_ID: Problem_ID := Problem_ID'First; end record; - type User_Session_Data_Access is access all User_Session_Data; + type User_Session_All_Access is access all User_Session_Data; - package Session_Keeping is new Ada.Containers.Ordered_Maps(Key_Type => Unique_ID, Element_Type => User_Session_Data_Access); + package Session_Keeping is new Ada.Containers.Ordered_Maps(Key_Type => Unique_ID, Element_Type => User_Session_All_Access); protected Active_Sessions is + procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Success: out Boolean); function Contains(UID: in Unique_ID) return Boolean; - function Get_Session_Data(UID: in Unique_ID; Success: out Boolean) return User_Session_Data_Access; - procedure Set_Session_Data(UID: in Unique_ID; USD: in User_Session_Data_Access; Success: out Boolean); + function Get_Problem(UID: in Unique_ID; Pr_ID: in Problem_ID) return Stored_Problem_All_Access; + function Get_Latest_Problem_With_ID(UID: in Unique_ID; Pr_ID: out Problem_ID) return Stored_Problem_All_Access; procedure Register_UID(UID: out Unique_ID; Success: out Boolean); procedure Remove_Session(UID: in Unique_ID); private procedure Check_Free_And_Register(UID: in Unique_ID; Success: out Boolean; Stop: out Boolean); + procedure Free_Session_Data(Data: in out User_Session_All_Access); Sessions: Session_Keeping.Map; Last_UID: Unique_ID := Unique_ID'First; end Active_Sessions; + MAX_STORED_PROBLEMS: Problem_ID := 20; end Problem_Manager; -- 2.43.5