-----------------------------------------------------------------------
--  Security-oauth-servers-tests - Unit tests for server side OAuth
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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 Util.Test_Caller;

with Security.Auth.Tests;
with Security.OAuth.File_Registry;
package body Security.OAuth.Servers.Tests is

   use Auth.Tests;
   use File_Registry;

   package Caller is new Util.Test_Caller (Test, "Security.OAuth.Servers");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Find_Application",
                       Test_Application_Manager'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Verify",
                       Test_User_Verify'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Token",
                       Test_Token_Password'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Authenticate",
                       Test_Bad_Token'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the application manager.
   --  ------------------------------
   procedure Test_Application_Manager (T : in out Test) is
      Manager : File_Application_Manager;
      App     : Application;
   begin
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Manager.Add_Application (App);

      --  Check that we can find our application.
      declare
         A : constant Application'Class := Manager.Find_Application ("my-app-id");
      begin
         Util.Tests.Assert_Equals (T, "my-app-id", A.Get_Application_Identifier,
                                   "Invalid application returned by Find");
      end;

      --  Check that an exception is raised for an invalid client ID.
      begin
         declare
            A : constant Application'Class := Manager.Find_Application ("unkown-app-id");
         begin
            Util.Tests.Fail (T, "Found the application " & A.Get_Application_Identifier);
         end;

      exception
         when Invalid_Application =>
            null;
      end;
   end Test_Application_Manager;

   --  ------------------------------
   --  Test the user registration and verification.
   --  ------------------------------
   procedure Test_User_Verify (T : in out Test) is
      Manager : File_Realm_Manager;
      Auth    : Principal_Access;
   begin
      Manager.Add_User ("Gandalf", "Mithrandir");
      Manager.Verify ("Gandalf", "mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid password");

      Manager.Verify ("Sauron", "Mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid user");

      Manager.Verify ("Gandalf", "Mithrandir", Auth);
      T.Assert (Auth /= null, "Verify password operation failed for a good user/password");
   end Test_User_Verify;

   --  ------------------------------
   --  Test the token operation that produces an access token from user/password.
   --  RFC 6749: Section 4.3.  Resource Owner Password Credentials Grant
   --  ------------------------------
   procedure Test_Token_Password (T : in out Test) is
      use type Util.Strings.Name_Access;

      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      App        : Application;
      Grant      : Grant_Type;
      Auth_Grant : Grant_Type;
      Params     : Test_Parameters;
   begin
      --  Add one test application.
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Apps.Add_Application (App);

      --  Add one test user.
      Realm.Add_User ("Gandalf", "Mithrandir");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");

      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is missing");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "unkown-app");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is invalid");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "my-app-id");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the user/password is missing");

      Params.Set_Parameter (Security.OAuth.USERNAME, "Gandalf");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is missing");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is invalid");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "Mithrandir");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
      T.Assert (Grant.Error = null, "Expecting null error");
      T.Assert (Length (Grant.Token) > 20,
                "Expecting a token with some reasonable size");
      T.Assert (Grant.Auth /= null,
                "Expecting a non null auth principal");
      Util.Tests.Assert_Equals (T, "Gandalf", Grant.Auth.Get_Name,
                                "Invalid user name in the principal");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null, "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth, "Expecting valid auth principal");
      end loop;

      --  Verify the modified access token.
      Manager.Authenticate (To_String (Grant.Token) & "x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for the authenticate");

      Manager.Revoke (To_String (Grant.Token));

      --  Verify the access is now denied.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Revoked_Grant,
                   "Expecting Revoked_Grant for the authenticate");
      end loop;

      --  Change application token expiration time to 1 second.
      App.Expire_Timeout := 1.0;
      Apps.Add_Application (App);

      --  Make the access token.
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null,
                   "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth,
                   "Expecting valid auth principal");
      end loop;

      --  Wait for the token to expire.
      delay 2.0;
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Expired_Grant,
                   "Expecting Expired when the access token is checked");
      end loop;

   end Test_Token_Password;

   --  ------------------------------
   --  Test the access token validation with invalid tokens (bad formed).
   --  ------------------------------
   procedure Test_Bad_Token (T : in out Test) is
      Manager    : Auth_Manager;
      Auth_Grant : Grant_Type;
   begin
      Manager.Authenticate ("x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate (".", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
   end Test_Bad_Token;

end Security.OAuth.Servers.Tests;

-----------------------------------------------------------------------
--  Security-oauth-servers-tests - Unit tests for server side OAuth
--  Copyright (C) 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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 Util.Test_Caller;

with Security.Auth.Tests;
with Security.OAuth.File_Registry;
package body Security.OAuth.Servers.Tests is

   use Auth.Tests;
   use File_Registry;

   package Caller is new Util.Test_Caller (Test, "Security.OAuth.Servers");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Find_Application",
                       Test_Application_Manager'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Verify",
                       Test_User_Verify'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Token",
                       Test_Token_Password'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Authenticate",
                       Test_Bad_Token'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.File_Registry.Load",
                       Test_Load_Registry'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the application manager.
   --  ------------------------------
   procedure Test_Application_Manager (T : in out Test) is
      Manager : File_Application_Manager;
      App     : Application;
   begin
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Manager.Add_Application (App);

      --  Check that we can find our application.
      declare
         A : constant Application'Class := Manager.Find_Application ("my-app-id");
      begin
         Util.Tests.Assert_Equals (T, "my-app-id", A.Get_Application_Identifier,
                                   "Invalid application returned by Find");
      end;

      --  Check that an exception is raised for an invalid client ID.
      begin
         declare
            A : constant Application'Class := Manager.Find_Application ("unkown-app-id");
         begin
            Util.Tests.Fail (T, "Found the application " & A.Get_Application_Identifier);
         end;

      exception
         when Invalid_Application =>
            null;
      end;
   end Test_Application_Manager;

   --  ------------------------------
   --  Test the user registration and verification.
   --  ------------------------------
   procedure Test_User_Verify (T : in out Test) is
      Manager : File_Realm_Manager;
      Auth    : Principal_Access;
   begin
      Manager.Add_User ("Gandalf", "Mithrandir");
      Manager.Verify ("Gandalf", "mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid password");

      Manager.Verify ("Sauron", "Mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid user");

      Manager.Verify ("Gandalf", "Mithrandir", Auth);
      T.Assert (Auth /= null, "Verify password operation failed for a good user/password");
   end Test_User_Verify;

   --  ------------------------------
   --  Test the token operation that produces an access token from user/password.
   --  RFC 6749: Section 4.3.  Resource Owner Password Credentials Grant
   --  ------------------------------
   procedure Test_Token_Password (T : in out Test) is
      use type Util.Strings.Name_Access;

      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      App        : Application;
      Grant      : Grant_Type;
      Auth_Grant : Grant_Type;
      Params     : Test_Parameters;
   begin
      --  Add one test application.
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Apps.Add_Application (App);

      --  Add one test user.
      Realm.Add_User ("Gandalf", "Mithrandir");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");

      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is missing");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "unkown-app");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is invalid");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "my-app-id");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the user/password is missing");

      Params.Set_Parameter (Security.OAuth.USERNAME, "Gandalf");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is missing");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is invalid");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "Mithrandir");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
      T.Assert (Grant.Error = null, "Expecting null error");
      T.Assert (Length (Grant.Token) > 20,
                "Expecting a token with some reasonable size");
      T.Assert (Grant.Auth /= null,
                "Expecting a non null auth principal");
      Util.Tests.Assert_Equals (T, "Gandalf", Grant.Auth.Get_Name,
                                "Invalid user name in the principal");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null, "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth, "Expecting valid auth principal");
      end loop;

      --  Verify the modified access token.
      Manager.Authenticate (To_String (Grant.Token) & "x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for the authenticate");

      Manager.Revoke (To_String (Grant.Token));

      --  Verify the access is now denied.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Revoked_Grant,
                   "Expecting Revoked_Grant for the authenticate");
      end loop;

      --  Change application token expiration time to 1 second.
      App.Expire_Timeout := 1.0;
      Apps.Add_Application (App);

      --  Make the access token.
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null,
                   "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth,
                   "Expecting valid auth principal");
      end loop;

      --  Wait for the token to expire.
      delay 2.0;
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Expired_Grant,
                   "Expecting Expired when the access token is checked");
      end loop;

   end Test_Token_Password;

   --  ------------------------------
   --  Test the access token validation with invalid tokens (bad formed).
   --  ------------------------------
   procedure Test_Bad_Token (T : in out Test) is
      Manager    : Auth_Manager;
      Auth_Grant : Grant_Type;
   begin
      Manager.Authenticate ("x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate (".", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
   end Test_Bad_Token;

   --  ------------------------------
   --  Test the loading configuration files for the File_Registry.
   --  ------------------------------
   procedure Test_Load_Registry (T : in out Test) is
      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      Grant      : Grant_Type;
      Auth_Grant : Grant_Type;
      Params     : Test_Parameters;
   begin
      Apps.Load (Util.Tests.Get_Path ("regtests/files/user_apps.properties"), "apps");
      Realm.Load (Util.Tests.Get_Path ("regtests/files/user_apps.properties"), "users");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");
      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "app-id-1");
      Params.Set_Parameter (Security.OAuth.CLIENT_SECRET, "app-secret-1");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Params.Set_Parameter (Security.OAuth.USERNAME, "joe");
      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
   end Test_Load_Registry;

end Security.OAuth.Servers.Tests;

Implement the Test_Load_Registry procedure to check the loading of applications and users in the File_Registry and verify they are recognized upon OAuth password access


-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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.Strings.Wide_Wide_Unbounded;
with Wiki.Nodes;
with Wiki.Documents;

--  == Wiki Renderer ==
--  The <tt>Wiki.Render</tt> package represents the renderer that takes a wiki document
--  and render the result either in text, HTML or another format.
package Wiki.Render is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering pass after all the wiki document nodes are rendered.
   procedure Finish (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document) is null;

   --  Render the list of nodes from the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document;
                     List   : in Wiki.Nodes.Node_List_Access);

   --  Render the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document);

end Wiki.Render;

-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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.Strings.Wide_Wide_Unbounded;
with Wiki.Nodes;
with Wiki.Documents;

--  == Wiki Renderer ==
--  The <tt>Wiki.Render</tt> package represents the renderer that takes a wiki document
--  and render the result either in text, HTML or another format.
--
--  @include wiki-render-html.ads
--  @include wiki-render-text.ads
--  @include wiki-render-wiki.ads
package Wiki.Render is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering pass after all the wiki document nodes are rendered.
   procedure Finish (Engine : in out Renderer;
                     Doc    : in Wiki.Documents.Document) is null;

   --  Render the list of nodes from the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document;
                     List   : in Wiki.Nodes.Node_List_Access);

   --  Render the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document);

end Wiki.Render;

Declare the To_Char function

Declare the To_Char function


-----------------------------------------------------------------------
--  awa-tags-modules-tests -- Unit tests for tags module
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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 Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Tags.Modules");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);
         Util.Tests.Assert_Equals (T, 2, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

-----------------------------------------------------------------------
--  awa-tags-modules-tests -- Unit tests for tags module
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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 Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Tags.Modules");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);
         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

Fix the tags unit test

Fix the tags unit test


-----------------------------------------------------------------------
--  ado-testsuite -- Testsuite for ADO
--  Copyright (C) 2009, 2010 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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 ADO.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

   Tests : aliased AUnit.Test_Suites.Test_Suite;

   function Suite return AUnit.Test_Suites.Access_Test_Suite is
      Ret : constant AUnit.Test_Suites.Access_Test_Suite := Tests'Access;
   begin
--        ADO.Objects.Tests.Add_Tests (Ret);
--        ADO.Tests.Add_Tests (Ret);
--        ADO.Schemas.Tests.Add_Tests (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

-----------------------------------------------------------------------
--  ado-testsuite -- Testsuite for ADO
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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 ADO.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

   Tests : aliased AUnit.Test_Suites.Test_Suite;

   function Suite return AUnit.Test_Suites.Access_Test_Suite is
      Ret : constant AUnit.Test_Suites.Access_Test_Suite := Tests'Access;
   begin
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

Add the new unit tests

Add the new unit tests


-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with ASF.Helpers.Beans;

with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Components.Wikis;

package AWA.Wikis.Beans is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wiki_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Wiki_Links_Bean;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Wiki_Links_Bean;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   type Wiki_View_Bean is new AWA.Wikis.Models.Wiki_View_Info with record
      --  The wiki module instance.
      Module        : Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;

      --  List of tags associated with the wiki page.
      Tags          : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean     : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read page counter associated with the wiki page.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.WIKI_PAGE_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki page links.
      Links         : aliased Wiki_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_View_Bean_Access is access all Wiki_View_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_View_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_View_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the information about the wiki page to display it.
   overriding
   procedure Load (Bean    : in out Wiki_View_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_View_Bean bean instance.
   function Create_Wiki_View_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Wiki_View_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Wiki_View_Bean,
                                     Element_Access => Wiki_View_Bean_Access);

   --  Get a select item list which contains a list of wiki formats.
   function Create_Format_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Module    : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki space information.
   overriding
   procedure Load (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Page Bean
   --  ------------------------------
   --  The <tt>Wiki_Page_Bean</tt> is used to edit a wiki page.  The model type inherit from
   --  the <tt>Wiki_Page</tt> and the wiki page text is hold in the <tt>Content</tt> member.
   --  When a new content is updated, the <tt>Set_Value</tt> procedure sets it in the
   --  <tt>New_Content</tt> member.  It is compared to the current wiki text to decide whether
   --  we have to create a new version or not.
   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Module     : Modules.Wiki_Module_Access := null;

      --  The page content.
      Content     : Models.Wiki_Content_Ref;
      Has_Content : Boolean := False;
      New_Content : Ada.Strings.Unbounded.Unbounded_String;
      New_Comment : Ada.Strings.Unbounded.Unbounded_String;

      Wiki_Space  : Wiki_Space_Bean;

      --  List of tags associated with the wiki page.
      Tags        : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean   : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Returns True if the wiki page has a new text content and requires
   --  a new version to be created.
   function Has_New_Content (Bean : in Wiki_Page_Bean) return Boolean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki page.
   overriding
   procedure Load (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki List Bean
   --  ------------------------------
   --  The Wiki_List_Bean gives a list of visible wikis to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Wiki_List_Bean is new AWA.Wikis.Models.Wiki_Page_List_Bean with record
      Module     : Modules.Wiki_Module_Access := null;
      Pages      : aliased AWA.Wikis.Models.Wiki_Page_Info_List_Bean;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Pages_Bean : AWA.Wikis.Models.Wiki_Page_Info_List_Bean_Access;
   end record;
   type Wiki_List_Bean_Access is access all Wiki_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Wiki_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of pages.  If a tag was set, filter the list of pages with the tag.
   procedure Load_List (Into : in out Wiki_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Version List Bean
   --  ------------------------------
   type Wiki_Version_List_Bean is new AWA.Wikis.Models.Wiki_Version_List_Bean with record
      Module        : Modules.Wiki_Module_Access := null;
      Versions      : aliased AWA.Wikis.Models.Wiki_Version_Info_List_Bean;
      Versions_Bean : AWA.Wikis.Models.Wiki_Version_Info_List_Bean_Access;
   end record;
   type Wiki_Version_List_Bean_Access is access all Wiki_Version_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Version_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Version_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (Into    : in out Wiki_Version_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_Version_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                           return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_WIKI_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Wiki_Admin_Bean is used for the administration of a wiki.  It gives the
   --  list of wikis and pages that are created, published or not.
   type Wiki_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Wikis.Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Wiki_List        : aliased AWA.Wikis.Models.Wiki_Info_List_Bean;
      Wiki_List_Bean   : AWA.Wikis.Models.Wiki_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Wiki_Admin_Bean_Access is access all Wiki_Admin_Bean;

   --  Get the wiki space identifier.
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of wikis.
   procedure Load_Wikis (List : in Wiki_Admin_Bean);

   --  Create the Wiki_Admin_Bean bean instance.
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  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.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with ASF.Helpers.Beans;

with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Components.Wikis;

package AWA.Wikis.Beans is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wiki_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Wiki_Links_Bean;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Wiki_Links_Bean;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   type Wiki_View_Bean is new AWA.Wikis.Models.Wiki_View_Info with record
      --  The wiki module instance.
      Module        : Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;

      --  List of tags associated with the wiki page.
      Tags          : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean     : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read page counter associated with the wiki page.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.WIKI_PAGE_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki page links.
      Links         : aliased Wiki_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_View_Bean_Access is access all Wiki_View_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_View_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_View_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the information about the wiki page to display it.
   overriding
   procedure Load (Bean    : in out Wiki_View_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_View_Bean bean instance.
   function Create_Wiki_View_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Wiki_View_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Wiki_View_Bean,
                                     Element_Access => Wiki_View_Bean_Access);

   --  Get a select item list which contains a list of wiki formats.
   function Create_Format_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Module    : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki space information.
   overriding
   procedure Load (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Page Bean
   --  ------------------------------
   --  The <tt>Wiki_Page_Bean</tt> is used to edit a wiki page.  The model type inherit from
   --  the <tt>Wiki_Page</tt> and the wiki page text is hold in the <tt>Content</tt> member.
   --  When a new content is updated, the <tt>Set_Value</tt> procedure sets it in the
   --  <tt>New_Content</tt> member.  It is compared to the current wiki text to decide whether
   --  we have to create a new version or not.
   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Module     : Modules.Wiki_Module_Access := null;

      --  The page content.
      Content     : Models.Wiki_Content_Ref;
      Has_Content : Boolean := False;
      Format      : AWA.Wikis.Models.Format_Type := AWA.Wikis.Models.FORMAT_CREOLE;
      New_Content : Ada.Strings.Unbounded.Unbounded_String;
      New_Comment : Ada.Strings.Unbounded.Unbounded_String;

      Wiki_Space  : Wiki_Space_Bean;

      --  List of tags associated with the wiki page.
      Tags        : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean   : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Returns True if the wiki page has a new text content and requires
   --  a new version to be created.
   function Has_New_Content (Bean : in Wiki_Page_Bean) return Boolean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki page.
   overriding
   procedure Load (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Setup the wiki page for the creation.
   overriding
   procedure Setup (Bean    : in out Wiki_Page_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki List Bean
   --  ------------------------------
   --  The Wiki_List_Bean gives a list of visible wikis to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Wiki_List_Bean is new AWA.Wikis.Models.Wiki_Page_List_Bean with record
      Module     : Modules.Wiki_Module_Access := null;
      Pages      : aliased AWA.Wikis.Models.Wiki_Page_Info_List_Bean;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Pages_Bean : AWA.Wikis.Models.Wiki_Page_Info_List_Bean_Access;
   end record;
   type Wiki_List_Bean_Access is access all Wiki_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Wiki_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of pages.  If a tag was set, filter the list of pages with the tag.
   procedure Load_List (Into : in out Wiki_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Version List Bean
   --  ------------------------------
   type Wiki_Version_List_Bean is new AWA.Wikis.Models.Wiki_Version_List_Bean with record
      Module        : Modules.Wiki_Module_Access := null;
      Versions      : aliased AWA.Wikis.Models.Wiki_Version_Info_List_Bean;
      Versions_Bean : AWA.Wikis.Models.Wiki_Version_Info_List_Bean_Access;
   end record;
   type Wiki_Version_List_Bean_Access is access all Wiki_Version_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Version_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Version_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (Into    : in out Wiki_Version_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_Version_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                           return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_WIKI_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Wiki_Admin_Bean is used for the administration of a wiki.  It gives the
   --  list of wikis and pages that are created, published or not.
   type Wiki_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Wikis.Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Wiki_List        : aliased AWA.Wikis.Models.Wiki_Info_List_Bean;
      Wiki_List_Bean   : AWA.Wikis.Models.Wiki_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Wiki_Admin_Bean_Access is access all Wiki_Admin_Bean;

   --  Get the wiki space identifier.
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of wikis.
   procedure Load_Wikis (List : in Wiki_Admin_Bean);

   --  Create the Wiki_Admin_Bean bean instance.
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

Define the Setup procedure

Define the Setup procedure


-----------------------------------------------------------------------
--  bkp-stores-local -- Store management for local files
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  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.Directories;
with Ada.Strings.Unbounded;
with Ada.Streams.Stream_IO;
with Interfaces.C.Strings;
with System.OS_Constants;

with Util.Log.Loggers;
with Util.Files;
with Util.Systems.Os;
with Util.Streams.Raw;
with Interfaces;
package body Babel.Stores.Local is

   function Errno return Integer;
   pragma Import (C, errno, "__get_errno");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Babel.Stores.Local");

   function Get_File_Size (Ent : in Ada.Directories.Directory_Entry_Type) return Ada.Directories.File_Size is
      Size : Ada.Directories.File_Size;
   begin
      Size := Ada.Directories.Size (Ent);
      return Size;

   exception
      when Constraint_Error =>
         return Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
   end Get_File_Size;

   --  ------------------------------
   --  Get the absolute path to access the local file.
   --  ------------------------------
   function Get_Absolute_Path (Store : in Local_Store_Type;
                               Path  : in String) return String is
   begin
      if Ada.Strings.Unbounded.Length (Store.Root_Dir) = 0 then
         return Path;
      else
         return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Store.Root_Dir), Path);
      end if;
   end Get_Absolute_Path;

   procedure Read (Store : in out Local_Store_Type;
                   Path  : in String;
                   Into  : in out Babel.Files.Buffers.Buffer) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File     : Ada.Streams.Stream_IO.File_Type;
      Abs_Path : constant String := Store.Get_Absolute_Path (Path);
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.In_File, Abs_Path);
      Ada.Streams.Stream_IO.Read (File, Into.Data, Into.Last);
      Ada.Streams.Stream_IO.Close (File);
      Log.Info ("Read {0} -> {1}", Abs_Path, Ada.Streams.Stream_Element_Offset'Image (Into.Last));
   end Read;

   procedure Open (Store  : in out Local_Store_Type;
                   Stream : in out Util.Streams.Raw.Raw_Stream;
                   Path   : in String) is
      use Util.Systems.Os;
      use type Interfaces.C.int;

      File : Util.Systems.Os.File_Type;
      Name : Util.Systems.Os.Ptr := Interfaces.C.Strings.New_String (Path);
   begin
      File := Util.Systems.Os.Sys_Open (Name, O_CREAT + O_WRONLY, 8#644#);
      if File < 0 then
         if Errno = System.OS_Constants.ENOENT then
            declare
               Dir : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Ada.Directories.Create_Path (Dir);
            end;
            File := Util.Systems.Os.Sys_Open (Name, O_CREAT + O_WRONLY, 8#644#);
         end if;
      end if;
      if File < 0 then
         raise Ada.Streams.Stream_IO.Name_Error with "Cannot create " & Path;
      end if;
      Stream.Initialize (File);
      Interfaces.C.Strings.Free (Name);
   end Open;

   procedure Write (Store : in out Local_Store_Type;
                    Path  : in String;
                    Into  : in Babel.Files.Buffers.Buffer) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      Abs_Path : constant String := Store.Get_Absolute_Path (Path);
      Stream   : Util.Streams.Raw.Raw_Stream;
   begin
      Log.Info ("Write {0}", Abs_Path);

      Store.Open (Stream, Abs_Path);
      Stream.Write (Into.Data (Into.Data'First .. Into.Last));
      Stream.Close;
   end Write;

   procedure Scan (Store  : in out Local_Store_Type;
                   Path   : in String;
                   Into   : in out Babel.Files.File_Container'Class;
                   Filter : in Babel.Filters.Filter_Type'Class) is
      use Ada.Directories;
      use type Babel.Files.Directory_Vector_Access;

      Search_Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                               Ada.Directories.Directory => True,
                                                               Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
      New_File : Babel.Files.File;
      Child    : Babel.Files.Directory;
   begin
      Log.Info ("Scan directory {0}", Path);

      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Search_Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
         begin
            if Kind = Ordinary_File then
               if Filter.Is_Accepted (Kind, Path, Name) then
                  New_File.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
                  New_File.Path := Ada.Strings.Unbounded.To_Unbounded_String (Path);
                  New_File.Size := Get_File_Size (Ent);
                  Into.Add_File (Path, New_File);
               end if;
            elsif Name /= "." and Name /= ".." and Filter.Is_Accepted (Kind, Path, Name) then
--                 if Into.Children = null then
--                    Into.Children := new Babel.Files.Directory_Vector;
--                 end if;
--                 Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
--                 Into.Children.Append (Child);
--                 Into.Tot_Dirs := Into.Tot_Dirs + 1;
               Into.Add_Directory (Path, Name);
            end if;
         end;
      end loop;

   exception
      when E : others =>
         Log.Error ("Exception ", E);
   end Scan;

   --  ------------------------------
   --  Set the root directory for the local store.
   --  ------------------------------
   procedure Set_Root_Directory (Store : in out Local_Store_Type;
                                 Path  : in String) is
   begin
      Store.Root_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Path);
   end Set_Root_Directory;

end Babel.Stores.Local;

-----------------------------------------------------------------------
--  bkp-stores-local -- Store management for local files
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  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.Directories;
with Ada.Strings.Unbounded;
with Ada.Streams.Stream_IO;
with Interfaces.C.Strings;
with System.OS_Constants;

with Util.Log.Loggers;
with Util.Files;
with Util.Systems.Os;
with Util.Streams.Raw;
with Interfaces;
package body Babel.Stores.Local is

   function Errno return Integer;
   pragma Import (C, errno, "__get_errno");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Babel.Stores.Local");

   function Get_File_Size (Ent : in Ada.Directories.Directory_Entry_Type) return Ada.Directories.File_Size is
      Size : Ada.Directories.File_Size;
   begin
      Size := Ada.Directories.Size (Ent);
      return Size;

   exception
      when Constraint_Error =>
         return Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
   end Get_File_Size;

   --  ------------------------------
   --  Get the absolute path to access the local file.
   --  ------------------------------
   function Get_Absolute_Path (Store : in Local_Store_Type;
                               Path  : in String) return String is
   begin
      if Ada.Strings.Unbounded.Length (Store.Root_Dir) = 0 then
         return Path;
      else
         return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Store.Root_Dir), Path);
      end if;
   end Get_Absolute_Path;

   procedure Read (Store : in out Local_Store_Type;
                   Path  : in String;
                   Into  : in out Babel.Files.Buffers.Buffer) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File     : Ada.Streams.Stream_IO.File_Type;
      Abs_Path : constant String := Store.Get_Absolute_Path (Path);
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.In_File, Abs_Path);
      Ada.Streams.Stream_IO.Read (File, Into.Data, Into.Last);
      Ada.Streams.Stream_IO.Close (File);
      Log.Info ("Read {0} -> {1}", Abs_Path, Ada.Streams.Stream_Element_Offset'Image (Into.Last));
   end Read;

   procedure Open (Store  : in out Local_Store_Type;
                   Stream : in out Util.Streams.Raw.Raw_Stream;
                   Path   : in String) is
      use Util.Systems.Os;
      use type Interfaces.C.int;

      File : Util.Systems.Os.File_Type;
      Name : Util.Systems.Os.Ptr := Interfaces.C.Strings.New_String (Path);
   begin
      File := Util.Systems.Os.Sys_Open (Name, O_CREAT + O_WRONLY, 8#644#);
      if File < 0 then
         if Errno = System.OS_Constants.ENOENT then
            declare
               Dir : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Ada.Directories.Create_Path (Dir);
            end;
            File := Util.Systems.Os.Sys_Open (Name, O_CREAT + O_WRONLY, 8#644#);
         end if;
      end if;
      if File < 0 then
         raise Ada.Streams.Stream_IO.Name_Error with "Cannot create " & Path;
      end if;
      Stream.Initialize (File);
      Interfaces.C.Strings.Free (Name);
   end Open;

   procedure Write (Store : in out Local_Store_Type;
                    Path  : in String;
                    Into  : in Babel.Files.Buffers.Buffer) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      Abs_Path : constant String := Store.Get_Absolute_Path (Path);
      Stream   : Util.Streams.Raw.Raw_Stream;
   begin
      Log.Info ("Write {0}", Abs_Path);

      Store.Open (Stream, Abs_Path);
      Stream.Write (Into.Data (Into.Data'First .. Into.Last));
      Stream.Close;
   end Write;

   procedure Scan (Store  : in out Local_Store_Type;
                   Path   : in String;
                   Into   : in out Babel.Files.File_Container'Class;
                   Filter : in Babel.Filters.Filter_Type'Class) is
      use Ada.Directories;

      Search_Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                               Ada.Directories.Directory => True,
                                                               Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
   begin
      Log.Info ("Scan directory {0}", Path);

      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Search_Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
            File : Babel.Files.File_Type;
         begin
            if Kind = Ordinary_File then
               if Filter.Is_Accepted (Kind, Path, Name) then
                  File := Into.Find (Name);
                  if File = null then
                     File := Into.Create (Name);
                  end if;
                  Babel.Files.Set_Size (Get_File_Size (Ent));
                  Into.Add_File (Path, New_File);
               end if;
            elsif Name /= "." and Name /= ".." and Filter.Is_Accepted (Kind, Path, Name) then
               Child := Info.Find (Name);
               if Child = null then
                  Child := Into.Create (Name);
               end if;
               Into.Add_Directory (Child);
--                 if Into.Children = null then
--                    Into.Children := new Babel.Files.Directory_Vector;
--                 end if;
--                 Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
--                 Into.Children.Append (Child);
--                 Into.Tot_Dirs := Into.Tot_Dirs + 1;
               Into.Add_Directory (Path, Name);
            end if;
         end;
      end loop;

   exception
      when E : others =>
         Log.Error ("Exception ", E);
   end Scan;

   --  ------------------------------
   --  Set the root directory for the local store.
   --  ------------------------------
   procedure Set_Root_Directory (Store : in out Local_Store_Type;
                                 Path  : in String) is
   begin
      Store.Root_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Path);
   end Set_Root_Directory;

end Babel.Stores.Local;

Use the File_Container interface to create and populate the container instance when we scan a directory