<commit_before>-----------------------------------------------------------------------
--  awa-blogs-beans -- Beans for blog module
--  Copyright (C) 2011, 2012, 2013, 2014 <NAME>
--  Written by <NAME> (<EMAIL>)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
with Ada.Characters.Handling;

with Util.Dates.ISO8601;
with Util.Beans.Objects.Time;

with AWA.Services.Contexts;
with AWA.Helpers.Requests;
with AWA.Helpers.Selectors;
with AWA.Tags.Modules;
with AWA.Comments.Beans;

with ADO.Utils;
with ADO.Queries;
with ADO.SQL;
with ADO.Datasets;
with ADO.Sessions;
with ADO.Sessions.Entities;

package body AWA.Blogs.Beans is

   use type ADO.Identifier;
   use Ada.Strings.Unbounded;

   BLOG_ID_PARAMETER : constant String := "blog_id";

   --  Build the URI from the post title and the post date.
   function Get_Predefined_Uri (Title : in String;
                                Date  : in Ada.Calendar.Time) return String;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if not From.Is_Null then
         return AWA.Blogs.Models.Blog_Ref (From).Get_Value (Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      elsif Name = "url" then
         From.Set_Url (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create a new blog.
   --  ------------------------------
   procedure Create (Bean    : in out Blog_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Result  : ADO.Identifier;
      pragma Unreferenced (Result);
   begin
      Bean.Module.Create_Blog (Workspace_Id => 0,
                               Title        => Bean.Get_Name,
                               Result       => Result);
   end Create;

   --  ------------------------------
   --  Create the Blog_Bean bean instance.
   --  ------------------------------
   function Create_Blog_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is

      Blog_Id : constant ADO.Identifier := AWA.Helpers.Requests.Get_Parameter (BLOG_ID_PARAMETER);
      Object  : constant Blog_Bean_Access := new Blog_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
   begin
      if Blog_Id /= ADO.NO_IDENTIFIER then
         Object.Load (Session, Blog_Id);
      end if;
      Object.Module := Module;
      return Object.all'Access;
   end Create_Blog_Bean;

   --  ------------------------------
   --  Build the URI from the post title and the post date.
   --  ------------------------------
   function Get_Predefined_Uri (Title : in String;
                                Date  : in Ada.Calendar.Time) return String is
      D      : constant String := Util.Dates.ISO8601.Image (Date);
      Result : String (1 .. Title'Length + 11);
   begin
      Result (1 .. 4) := D (1 .. 4);
      Result (5) := '/';
      Result (6 .. 7) := D (6 .. 7);
      Result (8) := '/';
      Result (9 .. 10) := D (9 .. 10);
      Result (11) := '/';
      for I in Title'Range loop
         if Ada.Characters.Handling.Is_Alphanumeric (Title (I))
           or Title (I) = '-' or Title (I) = '_' or Title (I) = '$' or Title (I) = ','
           or Title (I) = '.' or Title (I) = '+' then
            Result (I + 11) := Title (I);
         else
            Result (I + 11) := '-';
         end if;
      end loop;
      return Result;
   end Get_Predefined_Uri;

   --  ------------------------------
   --  Create or save the post.
   --  ------------------------------
   procedure Save (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Result  : ADO.Identifier;
   begin
      if String '(Bean.Get_Uri) = "" then
         Bean.Set_Uri (Get_Predefined_Uri (Bean.Get_Title, Ada.Calendar.Clock));
      end if;
      if not Bean.Is_Inserted then
         Bean.Module.Create_Post (Blog_Id => Bean.Blog_Id,
                                  Title   => Bean.Get_Title,
                                  URI     => Bean.Get_Uri,
                                  Text    => Bean.Get_Text,
                                  Comment => Bean.Get_Allow_Comments,
                                  Status  => Bean.Get_Status,
                                  Result  => Result);
      else
         Bean.Module.Update_Post (Post_Id => Bean.Get_Id,
                                  Title   => Bean.Get_Title,
                                  URI     => Bean.Get_Uri,
                                  Text    => Bean.Get_Text,
                                  Comment => Bean.Get_Allow_Comments,
                                  Status  => Bean.Get_Status);
         Result := Bean.Get_Id;
      end if;
      Bean.Tags.Update_Tags (Result);
   end Save;

   --  ------------------------------
   --  Delete a post.
   --  ------------------------------
   procedure Delete (Bean    : in out Post_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Delete_Post (Post_Id => Bean.Get_Id);
   end Delete;

   --  ------------------------------
   --  Load the post from the URI.
   --  ------------------------------
   overriding
   procedure Load (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type AWA.Comments.Beans.Comment_Bean_Access;
      use type AWA.Comments.Beans.Comment_List_Bean_Access;

      Session      : ADO.Sessions.Session := Bean.Module.Get_Session;
      Query        : ADO.SQL.Query;
      Found        : Boolean;
      Comment      : AWA.Comments.Beans.Comment_Bean_Access;
      Comment_List : AWA.Comments.Beans.Comment_List_Bean_Access;
   begin
      if not Bean.Is_Null and then Bean.Get_Id /= ADO.NO_IDENTIFIER then
         Query.Bind_Param (1, Bean.Get_Id);
         Query.Set_Filter ("o.id = ?");
      else
         Query.Bind_Param (1, String '(Bean.Get_Uri));
         Query.Set_Filter ("o.uri = ?");
      end if;
      Bean.Find (Session, Query, Found);
      if not Found then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;
      Bean.Tags.Load_Tags (Session, Bean.Get_Id);

      Comment := AWA.Comments.Beans.Get_Comment_Bean ("postNewComment");
      if Comment /= null then
         Comment.Set_Entity_Id (Bean.Get_Id);
      end if;
      Comment_List := AWA.Comments.Beans.Get_Comment_List_Bean ("postComments");
      if Comment_List /= null then
         Comment_List.Load_Comments (Bean.Get_Id);
      end if;

      --  SCz: 2012-05-19: workaround for ADO 0.3 limitation.  The lazy loading of
      --  objects does not work yet.  Force loading the user here while the above
      --  session is still open.
      declare
         A : constant String := String '(Bean.Get_Author.Get_Name);
         pragma Unreferenced (A);<commit_msg>New function Sanitize_Uri to filter invalid character from the URI before searching the post in the database.<commit_after>-----------------------------------------------------------------------
--  awa-blogs-beans -- Beans for blog module
--  Copyright (C) 2011, 2012, 2013, 2014 <NAME>
--  Written by <NAME> (<EMAIL>)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
with Ada.Characters.Handling;
with Ada.Strings.Maps;

with Util.Dates.ISO8601;
with Util.Beans.Objects.Time;

with AWA.Services.Contexts;
with AWA.Helpers.Requests;
with AWA.Helpers.Selectors;
with AWA.Tags.Modules;
with AWA.Comments.Beans;

with ADO.Utils;
with ADO.Queries;
with ADO.SQL;
with ADO.Datasets;
with ADO.Sessions;
with ADO.Sessions.Entities;

package body AWA.Blogs.Beans is

   use type ADO.Identifier;
   use type Ada.Strings.Maps.Character_Set;
   use Ada.Strings.Unbounded;

   BLOG_ID_PARAMETER : constant String := "blog_id";

   --  Build the URI from the post title and the post date.
   function Get_Predefined_Uri (Title : in String;
                                Date  : in Ada.Calendar.Time) return String;

   --  Sanitize the URI before doing a search in the database.
   --  Ignore every character that we consider to be invalid for the URL.
   function Sanitize_Uri (Uri : in String) return String;

   --  A list of character that we forbid in the URI.  This is used by the
   --  Get_Predefined_Uri to build a default URI from the post title.
   --  The '/' and '+' are allowed.
   Url_Forbidden_Set : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (Span => (Low  => Character'Val (0),
                                          High => ' '))
     or
       Ada.Strings.Maps.To_Set (Span => (Low => Character'Val (128),
                                         High => Character'Val (255)))
     or
       Ada.Strings.Maps.To_Set (":?#[]@!$&'""()*,;=%`^\<>");

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if not From.Is_Null then
         return AWA.Blogs.Models.Blog_Ref (From).Get_Value (Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      elsif Name = "url" then
         From.Set_Url (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create a new blog.
   --  ------------------------------
   procedure Create (Bean    : in out Blog_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Result  : ADO.Identifier;
      pragma Unreferenced (Result);
   begin
      Bean.Module.Create_Blog (Workspace_Id => 0,
                               Title        => Bean.Get_Name,
                               Result       => Result);
   end Create;

   --  ------------------------------
   --  Create the Blog_Bean bean instance.
   --  ------------------------------
   function Create_Blog_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is

      Blog_Id : constant ADO.Identifier := AWA.Helpers.Requests.Get_Parameter (BLOG_ID_PARAMETER);
      Object  : constant Blog_Bean_Access := new Blog_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
   begin
      if Blog_Id /= ADO.NO_IDENTIFIER then
         Object.Load (Session, Blog_Id);
      end if;
      Object.Module := Module;
      return Object.all'Access;
   end Create_Blog_Bean;

   --  ------------------------------
   --  Build the URI from the post title and the post date.
   --  ------------------------------
   function Get_Predefined_Uri (Title : in String;
                                Date  : in Ada.Calendar.Time) return String is
      D      : constant String := Util.Dates.ISO8601.Image (Date);
      Result : String (1 .. Title'Length + 11);
   begin
      Result (1 .. 4) := D (1 .. 4);
      Result (5) := '/';
      Result (6 .. 7) := D (6 .. 7);
      Result (8) := '/';
      Result (9 .. 10) := D (9 .. 10);
      Result (11) := '/';
      for I in Title'Range loop
         if not Ada.Strings.Maps.Is_In (Title (I), Url_Forbidden_Set) then
            Result (I + 11) := Title (I);
         else
            Result (I + 11) := '-';
         end if;
      end loop;
      return Result;
   end Get_Predefined_Uri;

   --  ------------------------------
   --  Create or save the post.
   --  ------------------------------
   procedure Save (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Result  : ADO.Identifier;
   begin
      if String '(Bean.Get_Uri) = "" then
         Bean.Set_Uri (Get_Predefined_Uri (Bean.Get_Title, Ada.Calendar.Clock));
      end if;
      if not Bean.Is_Inserted then
         Bean.Module.Create_Post (Blog_Id => Bean.Blog_Id,
                                  Title   => Bean.Get_Title,
                                  URI     => Bean.Get_Uri,
                                  Text    => Bean.Get_Text,
                                  Comment => Bean.Get_Allow_Comments,
                                  Status  => Bean.Get_Status,
                                  Result  => Result);
      else
         Bean.Module.Update_Post (Post_Id => Bean.Get_Id,
                                  Title   => Bean.Get_Title,
                                  URI     => Bean.Get_Uri,
                                  Text    => Bean.Get_Text,
                                  Comment => Bean.Get_Allow_Comments,
                                  Status  => Bean.Get_Status);
         Result := Bean.Get_Id;
      end if;
      Bean.Tags.Update_Tags (Result);
   end Save;

   --  ------------------------------
   --  Delete a post.
   --  ------------------------------
   procedure Delete (Bean    : in out Post_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Delete_Post (Post_Id => Bean.Get_Id);
   end Delete;

   --  ------------------------------
   --  Sanitize the URI before doing a search in the database.
   --  Ignore every character that we consider to be invalid for the URI.
   --  ------------------------------
   function Sanitize_Uri (Uri : in String) return String is
      Result : String (1 .. Uri'Length);
      Pos    : Natural := 1;
   begin
      for I in Uri'Range loop
         if not Ada.Strings.Maps.Is_In (Uri (I), Url_Forbidden_Set) then
            Result (Pos) := Uri (I);
            Pos := Pos + 1;
         end if;
      end loop;
      return Result (1 .. Pos - 1);
   end Sanitize_Uri;

   --  ------------------------------
   --  Load the post from the URI.
   --  ------------------------------
   overriding
   procedure Load (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type AWA.Comments.Beans.Comment_Bean_Access;
      use type AWA.Comments.Beans.Comment_List_Bean_Access;

      Session      : ADO.Sessions.Session := Bean.Module.Get_Session;
      Query        : ADO.SQL.Query;
      Found        : Boolean;
      Comment      : AWA.Comments.Beans.Comment_Bean_Access;
      Comment_List : AWA.Comments.Beans.Comment_List_Bean_Access;
   begin
      if not Bean.Is_Null and then Bean.Get_Id /= ADO.NO_IDENTIFIER then
         Query.Bind_Param (1, Bean.Get_Id);
         Query.Set_Filter ("o.id = ?");
      else
         Query.Bind_Param (1, Sanitize_Uri (String '(Bean.Get_Uri)));
         Query.Set_Filter ("o.uri = ?");
      end if;
      Bean.Find (Session, Query, Found);
      if not Found then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;
      Bean.Tags.Load_Tags (Session, Bean.Get_Id);

      Comment := AWA.Comments.Beans.Get_Comment_Bean ("postNewComment");
      if Comment /= null then
         Comment.Set_Entity_Id (Bean.Get_Id);
      end if;
      Comment_List := AWA.Comments.Beans.Get_Comment_List_Bean ("postComments");
      if Comment_List /= null then
         Comment_List.Load_Comments (Bean.Get_Id);
      end if;

      --  SCz: 2012-05-19: workaround for ADO 0.3 limitation.  The lazy loading of
      --  objects does not work yet.  Force loading the user here while the above
      --  session is still open.
      declare
         A : constant String := String '(Bean.Get_Author.Get_Name);
         pragma Unreferenced (A);
{'fraction_non_alphanumeric': 0.16516566599955526, 'fraction_numerical': 0.008005336891260841, 'mean_word_length': 1.4912062041268523, 'pattern_counts': {'":': 1, '<': 10, '<?xml version=': 0, '>': 50, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 26, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2549410', 'n_tokens_mistral': 5312, 'n_tokens_neox': 5008, 'n_words': 1433}