-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 2016, 2020 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.Text_IO;
with Ada.Directories;

with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Filters.Variables;
with Wiki.Plugins.Templates;
with Wiki.Plugins.Conditions;
with Wiki.Plugins.Variables;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is

      use Ada.Directories;

      Result_File : constant String := To_String (T.Result);
      Dir         : constant String := Containing_Directory (Result_File);
      Doc         : Wiki.Documents.Document;
      Engine      : Wiki.Parsers.Parser;
      Toc_Filter  : aliased Wiki.Filters.TOC.TOC_Filter;
      Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
      Var_Filter  : aliased Wiki.Filters.Variables.Variable_Filter;
      Auto_Filter : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template    : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      Condition   : aliased Wiki.Plugins.Conditions.Condition_Plugin;
      Variables   : aliased Wiki.Plugins.Variables.Variable_Plugin;
      List_Vars   : aliased Wiki.Plugins.Variables.List_Variable_Plugin;
      Input       : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Output      : aliased Wiki.Streams.Html.Text_IO.Html_File_Output_Stream;

      type Test_Factory is new Wiki.Plugins.Plugin_Factory with null record;

      --  Find a plugin knowing its name.
      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access is
         pragma Unreferenced (Factory);
      begin
         if Name = "if" or Name = "else" or Name = "elsif" or Name = "end" then
            return Condition'Unchecked_Access;
         elsif Name = "set" then
            return Variables'Unchecked_Access;
         elsif Name = "list" then
            return List_Vars'Unchecked_Access;
         else
            return Template.Find (Name);
         end if;
      end Find;

      Local_Factory : aliased Test_Factory;
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Input.Open (Path => To_String (T.File),
                  Form => "WCEM=8");
      Output.Create (Result_File, "WCEM=8");
      Template.Set_Template_Path (Containing_Directory (To_String (T.File)));
      Condition.Append ("public", "");
      Condition.Append ("user", "admin");
      declare
         Time : Util.Measures.Stamp;
      begin
         Engine.Set_Syntax (T.Source);
         Engine.Set_Plugin_Factory (Local_Factory'Unchecked_Access);
         Engine.Add_Filter (Toc_Filter'Unchecked_Access);
         Engine.Add_Filter (Auto_Filter'Unchecked_Access);
         Engine.Add_Filter (Html_Filter'Unchecked_Access);
         Engine.Add_Filter (Var_Filter'Unchecked_Access);
         Engine.Parse (Input'Unchecked_Access, Doc);
         Util.Measures.Report (Time, "Parse " & To_String (T.Name));
         if T.Source = Wiki.SYNTAX_HTML or T.Is_Cvt Then
            declare
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access, T.Format);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Wiki " & To_String (T.Name));
            end;
         elsif T.Is_Html then
            declare
               Renderer : aliased Wiki.Render.Html.Html_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Set_Render_TOC (True);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render HTML " & To_String (T.Name));
            end;
         else
            declare
               Renderer : aliased Wiki.Render.Text.Text_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Text " & To_String (T.Name));
            end;
         end if;
      end;
      Input.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      procedure Add_Convert_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MARKDOWN =>
                           Tst := Create_Test (Name & ".markdown", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

      procedure Add_Convert_Tests is
         Dir         : constant String := "regtests/files/convert";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when Wiki.SYNTAX_MARKDOWN =>
                           Tst := Create_Test (Name & ".markdown", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Is_Cvt := True;
                        Tst.Source := Format;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Convert_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
      Add_Convert_Tests;
   end Add_Tests;

end Wiki.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 2016, 2020 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.Text_IO;
with Ada.Directories;

with Util.Measures;

with Wiki.Strings;
with Wiki.Render.Wiki;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Filters.Variables;
with Wiki.Plugins.Templates;
with Wiki.Plugins.Conditions;
with Wiki.Plugins.Variables;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Documents;
with Wiki.Parsers;
package body Wiki.Tests is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is

      use Ada.Directories;

      Result_File : constant String := To_String (T.Result);
      Dir         : constant String := Containing_Directory (Result_File);
      Doc         : Wiki.Documents.Document;
      Engine      : Wiki.Parsers.Parser;
      Toc_Filter  : aliased Wiki.Filters.TOC.TOC_Filter;
      Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
      Var_Filter  : aliased Wiki.Filters.Variables.Variable_Filter;
      Auto_Filter : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template    : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      Condition   : aliased Wiki.Plugins.Conditions.Condition_Plugin;
      Variables   : aliased Wiki.Plugins.Variables.Variable_Plugin;
      List_Vars   : aliased Wiki.Plugins.Variables.List_Variable_Plugin;
      Input       : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Output      : aliased Wiki.Streams.Html.Text_IO.Html_File_Output_Stream;

      type Test_Factory is new Wiki.Plugins.Plugin_Factory with null record;

      --  Find a plugin knowing its name.
      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

      overriding
      function Find (Factory : in Test_Factory;
                     Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access is
         pragma Unreferenced (Factory);
      begin
         if Name = "if" or Name = "else" or Name = "elsif" or Name = "end" then
            return Condition'Unchecked_Access;
         elsif Name = "set" then
            return Variables'Unchecked_Access;
         elsif Name = "list" then
            return List_Vars'Unchecked_Access;
         else
            return Template.Find (Name);
         end if;
      end Find;

      Local_Factory : aliased Test_Factory;
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Input.Open (Path => To_String (T.File),
                  Form => "WCEM=8");
      Output.Create (Result_File, "WCEM=8");
      Template.Set_Template_Path (Containing_Directory (To_String (T.File)));
      Condition.Append ("public", "");
      Condition.Append ("user", "admin");
      declare
         Time : Util.Measures.Stamp;
      begin
         Engine.Set_Syntax (T.Source);
         Engine.Set_Plugin_Factory (Local_Factory'Unchecked_Access);
         Engine.Add_Filter (Toc_Filter'Unchecked_Access);
         Engine.Add_Filter (Auto_Filter'Unchecked_Access);
         Engine.Add_Filter (Html_Filter'Unchecked_Access);
         Engine.Add_Filter (Var_Filter'Unchecked_Access);
         Engine.Parse (Input'Unchecked_Access, Doc);
         Var_Filter.Add_Variable (String '("file"), Wiki.Strings.To_WString (To_String (T.Name)));
         Util.Measures.Report (Time, "Parse " & To_String (T.Name));
         if T.Source = Wiki.SYNTAX_HTML or T.Is_Cvt then
            declare
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access, T.Format);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Wiki " & To_String (T.Name));
            end;
         elsif T.Is_Html then
            declare
               Renderer : aliased Wiki.Render.Html.Html_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Set_Render_TOC (True);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render HTML " & To_String (T.Name));
            end;
         else
            declare
               Renderer : aliased Wiki.Render.Text.Text_Renderer;
            begin
               Renderer.Set_Output_Stream (Output'Unchecked_Access);
               Renderer.Render (Doc);
               Output.Close;
               Util.Measures.Report (Time, "Render Text " & To_String (T.Name));
            end;
         end if;
      end;
      Input.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      procedure Add_Convert_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Wiki_Syntax;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.SYNTAX_MARKDOWN =>
                           Tst := Create_Test (Name & ".markdown", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

      procedure Add_Convert_Tests is
         Dir         : constant String := "regtests/files/convert";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Wiki_Syntax;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.SYNTAX_MEDIA_WIKI;
                  elsif Ext = "markdown" then
                     Format := Wiki.SYNTAX_MARKDOWN;
                  else
                     Format := Wiki.SYNTAX_MIX;
                  end if;

                  for Syntax in Wiki.Wiki_Syntax'Range loop
                     case Syntax is
                        when Wiki.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when Wiki.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when Wiki.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when Wiki.SYNTAX_MARKDOWN =>
                           Tst := Create_Test (Name & ".markdown", Path & "/" & Simple,
                                               Syntax, "/wiki-convert/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Is_Cvt := True;
                        Tst.Source := Format;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Convert_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
      Add_Convert_Tests;
   end Add_Tests;

end Wiki.Tests;

Add pre-defined variable in the filters

Add pre-defined variable in the filters


-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012 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.Calendar;

with Util.Log.Loggers;

with ADO.Objects;
with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Permissions;
package body AWA.Storages.Services is

   use AWA.Services;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Services");

   --  ------------------------------
   --  Get the persistent store that manages the data represented by <tt>Data</tt>.
   --  ------------------------------
   function Get_Store (Service : in Storage_Service;
                       Data    : in AWA.Storages.Models.Storage_Ref'Class)
                       return AWA.Storages.Stores.Store_Access is
   begin
      return Service.Stores (Data.Get_Storage);
   end Get_Store;

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);
      Service.Stores (AWA.Storages.Models.DATABASE) := Service.Database_Store'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class) is
      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
   begin
      if not Folder.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Folder.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Folder.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create folder permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Folder.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Folder.Is_Inserted then
         Folder.Set_Create_Date (Ada.Calendar.Clock);
      end if;
      Folder.Save (DB);
      Ctx.Commit;
   end Save_Folder;

   --  ------------------------------
   --  Load the folder identified by the given id.
   --  ------------------------------
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier) is
      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Folder.Load (Session => DB, Id => Id);
   end Load_Folder;

   --  ------------------------------
   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type) is
   begin
      Storage_Service'Class (Service).Save (Into, Data.Get_Local_Filename, Storage);
   end Save;

   --  ------------------------------
   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type) is
      use type AWA.Storages.Models.Storage_Type;
      use type Stores.Store_Access;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
      Store     : Stores.Store_Access;
   begin
      Log.Info ("Save {0} in storage space", Path);

      Into.Set_Storage (Storage);
      Store := Storage_Service'Class (Service).Get_Store (Into);
      if Store = null then
         Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Storage));
      end if;

      if not Into.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Into.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Into.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Storage.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Into.Is_Inserted then
         Into.Set_Create_Date (Ada.Calendar.Clock);
      end if;
      Into.Save (DB);
      Store.Save (DB, Into, Path);
      Into.Save (DB);
      Ctx.Commit;
   end Save;

   --  Load the storage content identified by From in a local file
   --  that will be identified by Into.
   procedure Load (Service : in Storage_Service;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in out AWA.Storages.Models.Store_Local_Ref'Class) is
   begin
      null;
   end Load;

   --  ------------------------------
   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   --  ------------------------------
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out ADO.Blob_Ref) is
      pragma Unreferenced (Service);

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (Models.Query_Storage_Get_Data);
   begin
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE'Access, DB);

      Query.Execute;
      Into := Query.Get_Result_Blob;
   end Load;

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out AWA.Storages.Models.Store_Local_Ref;
                   Mode    : in Read_Mode := READ;
                   Expire  : in Expire_Type := ONE_DAY) is
      use type Stores.Store_Access;
      use type Models.Storage_Type;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.Queries.Context;
      Found   : Boolean;
      Storage : AWA.Storages.Models.Storage_Ref;
      Store   : Stores.Store_Access;
   begin
      if Mode = READ then
         Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Local);
         Query.Bind_Param ("store_id", From);
         Query.Bind_Param ("user_id", User);
         Into.Find (DB, Query, Found);
         if Found then
            return;
         end if;
      end if;

      Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Storage);
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      Storage.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      if Storage.Get_Storage = AWA.Storages.Models.FILE then
         Into.Set_Path (String '(Storage.Get_Uri));
         return;
      end if;
      Ctx.Start;
      Store := Storage_Service'Class (Service).Get_Store (Storage);
      Store.Load (Session => DB,
                  From    => Storage,
                  Into    => Into.Get_Path);
      Ctx.Commit;
   end Load;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Id  : constant ADO.Identifier := ADO.Objects.Get_Value (Storage.Get_Key);
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Id));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Id);

      Ctx.Start;
      Storage.Delete (DB);
      Ctx.Commit;
   end Delete;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier) is
      use type Stores.Store_Access;

      Ctx  : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB   : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      S    : AWA.Storages.Models.Storage_Ref;
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (AWA.Storages.Models.Query_Storage_Delete_Local);
      Store : Stores.Store_Access;
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Storage));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Storage);

      Ctx.Start;
      S.Load (Id => Storage, Session => DB);

      Store := Storage_Service'Class (Service).Get_Store (S);
      if Store = null then
         Log.Error ("There is no store associated with storage item {0}",
                    ADO.Identifier'Image (Storage));
      else
         Store.Delete (DB, S);
      end if;

      --  Delete the local storage instances.
      Query.Bind_Param ("store_id", Storage);
      Query.Execute;
      S.Delete (DB);
      Ctx.Commit;
   end Delete;

end AWA.Storages.Services;

-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012 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.Calendar;

with Util.Log.Loggers;

with ADO.Objects;
with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Permissions;
package body AWA.Storages.Services is

   use AWA.Services;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Services");

   --  ------------------------------
   --  Get the persistent store that manages the data represented by <tt>Data</tt>.
   --  ------------------------------
   function Get_Store (Service : in Storage_Service;
                       Data    : in AWA.Storages.Models.Storage_Ref'Class)
                       return AWA.Storages.Stores.Store_Access is
   begin
      return Service.Stores (Data.Get_Storage);
   end Get_Store;

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);
      Service.Stores (AWA.Storages.Models.DATABASE) := Service.Database_Store'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class) is
      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
   begin
      if not Folder.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Folder.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Folder.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create folder permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Folder.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Folder.Is_Inserted then
         Folder.Set_Create_Date (Ada.Calendar.Clock);
      end if;
      Folder.Save (DB);
      Ctx.Commit;
   end Save_Folder;

   --  ------------------------------
   --  Load the folder identified by the given id.
   --  ------------------------------
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier) is
      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Folder.Load (Session => DB, Id => Id);
   end Load_Folder;

   --  ------------------------------
   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type) is
   begin
      Storage_Service'Class (Service).Save (Into, Data.Get_Local_Filename, Storage);
   end Save;

   --  ------------------------------
   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type) is
      use type AWA.Storages.Models.Storage_Type;
      use type Stores.Store_Access;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
      Store     : Stores.Store_Access;
   begin
      Log.Info ("Save {0} in storage space", Path);

      Into.Set_Storage (Storage);
      Store := Storage_Service'Class (Service).Get_Store (Into);
      if Store = null then
         Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Storage));
      end if;

      if not Into.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Into.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Into.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Storage.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Into.Is_Inserted then
         Into.Set_Create_Date (Ada.Calendar.Clock);
         Into.Set_Owner (Ctx.Get_User);
      end if;
      Into.Save (DB);
      Store.Save (DB, Into, Path);
      Into.Save (DB);
      Ctx.Commit;
   end Save;

   --  Load the storage content identified by From in a local file
   --  that will be identified by Into.
   procedure Load (Service : in Storage_Service;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in out AWA.Storages.Models.Store_Local_Ref'Class) is
   begin
      null;
   end Load;

   --  ------------------------------
   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   --  ------------------------------
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out ADO.Blob_Ref) is
      pragma Unreferenced (Service);

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (Models.Query_Storage_Get_Data);
   begin
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE'Access, DB);

      Query.Execute;
      Into := Query.Get_Result_Blob;
   end Load;

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out AWA.Storages.Models.Store_Local_Ref;
                   Mode    : in Read_Mode := READ;
                   Expire  : in Expire_Type := ONE_DAY) is
      use type Stores.Store_Access;
      use type Models.Storage_Type;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.Queries.Context;
      Found   : Boolean;
      Storage : AWA.Storages.Models.Storage_Ref;
      Store   : Stores.Store_Access;
   begin
      if Mode = READ then
         Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Local);
         Query.Bind_Param ("store_id", From);
         Query.Bind_Param ("user_id", User);
         Into.Find (DB, Query, Found);
         if Found then
            return;
         end if;
      end if;

      Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Storage);
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      Storage.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      if Storage.Get_Storage = AWA.Storages.Models.FILE then
         Into.Set_Path (String '(Storage.Get_Uri));
         return;
      end if;
      Ctx.Start;
      Store := Storage_Service'Class (Service).Get_Store (Storage);
      Store.Load (Session => DB,
                  From    => Storage,
                  Into    => Into.Get_Path);
      Ctx.Commit;
   end Load;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Id  : constant ADO.Identifier := ADO.Objects.Get_Value (Storage.Get_Key);
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Id));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Id);

      Ctx.Start;
      Storage.Delete (DB);
      Ctx.Commit;
   end Delete;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier) is
      use type Stores.Store_Access;

      Ctx  : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB   : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      S    : AWA.Storages.Models.Storage_Ref;
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (AWA.Storages.Models.Query_Storage_Delete_Local);
      Store : Stores.Store_Access;
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Storage));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Storage);

      Ctx.Start;
      S.Load (Id => Storage, Session => DB);

      Store := Storage_Service'Class (Service).Get_Store (S);
      if Store = null then
         Log.Error ("There is no store associated with storage item {0}",
                    ADO.Identifier'Image (Storage));
      else
         Store.Delete (DB, S);
      end if;

      --  Delete the local storage instances.
      Query.Bind_Param ("store_id", Storage);
      Query.Execute;
      S.Delete (DB);
      Ctx.Commit;
   end Delete;

end AWA.Storages.Services;

Set the storage file owner when creating the storage instance


-----------------------------------------------------------------------
--  facebook - Use Facebook Graph API
--  Copyright (C) 2012, 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.Log.Loggers;
with Util.Http.Rest;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers.Vector_Mapper;

with ASF.Sessions;
with ASF.Contexts.Faces;
with ASF.Events.Faces.Actions;

package body Facebook is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Facebook");

   type Friend_Field_Type is (FIELD_NAME, FIELD_ID);
   type Feed_Field_Type is (FIELD_ID, FIELD_NAME, FIELD_FROM, FIELD_MESSAGE,
                            FIELD_PICTURE, FIELD_LINK, FIELD_DESCRIPTION, FIELD_ICON);

   procedure Set_Member (Into : in out Friend_Info;
                         Field : in Friend_Field_Type;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into : in out Feed_Info;
                         Field : in Feed_Field_Type;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into : in out Friend_Info;
                         Field : in Friend_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

      end case;
   end Set_Member;

   procedure Set_Member (Into : in out Feed_Info;
                         Field : in Feed_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Log.Info ("Set field {0} to {1}", Feed_Field_Type'Image (Field),
                Util.Beans.Objects.To_String (Value));

      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_FROM =>
            Into.From := Value;

         when FIELD_MESSAGE =>
            Into.Message := Value;

         when FIELD_LINK =>
            Into.Link := Value;

         when FIELD_PICTURE =>
            Into.Picture := Value;

         when FIELD_ICON =>
            Into.Icon := Value;

         when FIELD_DESCRIPTION =>
            Into.Description := Value;

      end case;
   end Set_Member;

   package Friend_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Friend_Info,
                                               Element_Type_Access => Friend_Info_Access,
                                               Fields              => Friend_Field_Type,
                                               Set_Member          => Set_Member);

   package Friend_Vector_Mapper is
      new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Friend_List.Vectors,
                                                Element_Mapper => Friend_Mapper);

   package Feed_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Feed_Info,
                                               Element_Type_Access => Feed_Info_Access,
                                               Fields              => Feed_Field_Type,
                                               Set_Member          => Set_Member);

   package Feed_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Feed_List.Vectors,
                                               Element_Mapper => Feed_Mapper);

   Friend_Map        : aliased Friend_Mapper.Mapper;
   Friend_Vector_Map : aliased Friend_Vector_Mapper.Mapper;
   Feed_Map          : aliased Feed_Mapper.Mapper;
   Feed_Vector_Map   : aliased Feed_Vector_Mapper.Mapper;

   procedure Get_Friends is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Friend_Vector_Mapper);

   procedure Get_Feeds is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Feed_Vector_Mapper);

   --  ------------------------------
   --  Get the access token from the user session.
   --  ------------------------------
   function Get_Access_Token return String is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if Context = null then
         return "";
      end if;
      declare
         S : constant ASF.Sessions.Session := Context.Get_Session;
      begin
         if not S.Is_Valid then
            return "";
         end if;
         declare
            Token : constant Util.Beans.Objects.Object := S.Get_Attribute ("access_token");
         begin
            if Util.Beans.Objects.Is_Null (Token) then
               return "";
            else
               return Util.Beans.Objects.To_String (Token);
            end if;
         end;
      end;
   end Get_Access_Token;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Friend_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return From.Name;
      elsif Name = "id" then
         return From.Id;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Feed_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return From.Id;
      elsif Name = "name" then
         return From.Name;
      elsif Name = "from" then
         return From.From;
      elsif Name = "message" then
         return From.Message;
      elsif Name = "picture" then
         return From.Picture;
      elsif Name = "link" then
         return From.Link;
      elsif Name = "description" then
         return From.Description;
      elsif Name = "icon" then
         return From.Icon;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Friend_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "hasAccessToken" then
         return Util.Beans.Objects.To_Object (False);
      end if;
      return Friend_List.List_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create a Friend_List bean instance.
   --  ------------------------------
   function Create_Friends_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Friend_List_Bean_Access := new Friend_List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         Log.Info ("Getting the Facebook friends");

         Get_Friends ("https://graph.facebook.com/me/friends?access_token="
                      & Token,
                      Friend_Vector_Map'Access,
                      "/data",
                      List.List'Access);
      end if;

      return List.all'Access;
   end Create_Friends_Bean;

   --  ------------------------------
   --  Build and return a Facebook feed list.
   --  ------------------------------
   function Create_Feed_List_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Feed_List.List_Bean_Access := new Feed_List.List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         Log.Info ("Getting the Facebook feeds");

         Get_Feeds ("https://graph.facebook.com/me/home?access_token="
                    & Token,
                    Feed_Vector_Map'Access,
                    "/data",
                    List.List'Access);
      end if;

      return List.all'Access;
   end Create_Feed_List_Bean;

   --  ------------------------------
   --  Get the user information identified by the given name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Facebook_Auth;
                       Name : in String) return Util.Beans.Objects.Object is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      F    : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if F /= null and Name = "authenticate_url" then
         declare
            S      : constant ASF.Sessions.Session := F.Get_Session (True);
            Id     : constant String := S.Get_Id;
            State  : constant String := From.Get_State (Id);
            Params : constant String := From.Get_Auth_Params (State, "read_stream");
         begin
            Log.Info ("OAuth params: {0}", Params);

            return Util.Beans.Objects.To_Object ("https://www.facebook.com/dialog/oauth?"
                                                 & Params);
         end;
      elsif F /= null and Name = "isAuthenticated" then
         declare
            S      : constant ASF.Sessions.Session := F.Get_Session (False);
         begin
            if S.Is_Valid and
            then not Util.Beans.Objects.Is_Null (S.Get_Attribute ("access_token")) then
               return Util.Beans.Objects.To_Object (True);
            else
               return Util.Beans.Objects.To_Object (False);
            end if;
         end;
      end if;
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  ------------------------------
   --  Authenticate result from Facebook.
   --  ------------------------------
   procedure Authenticate (From    : in out Facebook_Auth;
                           Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      use type Security.OAuth.Clients.Access_Token_Access;

      F       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session : ASF.Sessions.Session := F.Get_Session;
      State   : constant String := F.Get_Parameter (Security.OAuth.State);
      Code    : constant String := F.Get_Parameter (Security.OAuth.Code);
   begin
      Log.Info ("Auth code {0} for state {1}", Code, State);
      if Session.Is_Valid then
         if From.Is_Valid_State (Session.Get_Id, State) then
            declare
               Acc : constant Security.OAuth.Clients.Access_Token_Access
                 := From.Request_Access_Token (Code);
            begin
               if Acc /= null then
                  Log.Info ("Access token is {0}", Acc.Get_Name);
                  Session.Set_Attribute ("access_token",
                                         Util.Beans.Objects.To_Object (Acc.Get_Name));
               end if;
            end;
         end if;
      end if;
   end Authenticate;

   package Authenticate_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Facebook_Auth,
                                                      Method => Authenticate,
                                                      Name   => "authenticate");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Authenticate_Binding.Proxy'Unchecked_Access);

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Facebook_Auth)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

begin
   Friend_Map.Add_Default_Mapping;
   Friend_Vector_Map.Set_Mapping (Friend_Map'Access);

   Feed_Map.Add_Mapping ("id", FIELD_ID);
   Feed_Map.Add_Mapping ("name", FIELD_NAME);
   Feed_Map.Add_Mapping ("message", FIELD_MESSAGE);
   Feed_Map.Add_Mapping ("description", FIELD_DESCRIPTION);
   Feed_Map.Add_Mapping ("from/name", FIELD_FROM);
   Feed_Map.Add_Mapping ("picture", FIELD_PICTURE);
   Feed_Map.Add_Mapping ("link", FIELD_LINK);
   Feed_Map.Add_Mapping ("icon", FIELD_ICON);
   Feed_Vector_Map.Set_Mapping (Feed_Map'Access);
end Facebook;

-----------------------------------------------------------------------
--  facebook - Use Facebook Graph API
--  Copyright (C) 2012, 2013, 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 Util.Log.Loggers;
with Util.Http.Rest.Rest_Get_Vector;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers.Vector_Mapper;

with ASF.Sessions;
with ASF.Contexts.Faces;
with ASF.Events.Faces.Actions;

package body Facebook is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Facebook");

   type Friend_Field_Type is (FIELD_NAME, FIELD_ID);
   type Feed_Field_Type is (FIELD_ID, FIELD_NAME, FIELD_FROM, FIELD_MESSAGE,
                            FIELD_PICTURE, FIELD_LINK, FIELD_DESCRIPTION, FIELD_ICON);

   procedure Set_Member (Into : in out Friend_Info;
                         Field : in Friend_Field_Type;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into : in out Feed_Info;
                         Field : in Feed_Field_Type;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into : in out Friend_Info;
                         Field : in Friend_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

      end case;
   end Set_Member;

   procedure Set_Member (Into : in out Feed_Info;
                         Field : in Feed_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Log.Info ("Set field {0} to {1}", Feed_Field_Type'Image (Field),
                Util.Beans.Objects.To_String (Value));

      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_FROM =>
            Into.From := Value;

         when FIELD_MESSAGE =>
            Into.Message := Value;

         when FIELD_LINK =>
            Into.Link := Value;

         when FIELD_PICTURE =>
            Into.Picture := Value;

         when FIELD_ICON =>
            Into.Icon := Value;

         when FIELD_DESCRIPTION =>
            Into.Description := Value;

      end case;
   end Set_Member;

   package Friend_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Friend_Info,
                                               Element_Type_Access => Friend_Info_Access,
                                               Fields              => Friend_Field_Type,
                                               Set_Member          => Set_Member);

   package Friend_Vector_Mapper is
      new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Friend_List.Vectors,
                                                Element_Mapper => Friend_Mapper);

   package Feed_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Feed_Info,
                                               Element_Type_Access => Feed_Info_Access,
                                               Fields              => Feed_Field_Type,
                                               Set_Member          => Set_Member);

   package Feed_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Feed_List.Vectors,
                                               Element_Mapper => Feed_Mapper);

   Friend_Map        : aliased Friend_Mapper.Mapper;
   Friend_Vector_Map : aliased Friend_Vector_Mapper.Mapper;
   Feed_Map          : aliased Feed_Mapper.Mapper;
   Feed_Vector_Map   : aliased Feed_Vector_Mapper.Mapper;

   procedure Get_Friends is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Friend_Vector_Mapper);

   procedure Get_Feeds is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Feed_Vector_Mapper);

   --  ------------------------------
   --  Get the access token from the user session.
   --  ------------------------------
   function Get_Access_Token return String is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if Context = null then
         return "";
      end if;
      declare
         S : constant ASF.Sessions.Session := Context.Get_Session;
      begin
         if not S.Is_Valid then
            return "";
         end if;
         declare
            Token : constant Util.Beans.Objects.Object := S.Get_Attribute ("access_token");
         begin
            if Util.Beans.Objects.Is_Null (Token) then
               return "";
            else
               return Util.Beans.Objects.To_String (Token);
            end if;
         end;
      end;
   end Get_Access_Token;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Friend_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return From.Name;
      elsif Name = "id" then
         return From.Id;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Feed_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return From.Id;
      elsif Name = "name" then
         return From.Name;
      elsif Name = "from" then
         return From.From;
      elsif Name = "message" then
         return From.Message;
      elsif Name = "picture" then
         return From.Picture;
      elsif Name = "link" then
         return From.Link;
      elsif Name = "description" then
         return From.Description;
      elsif Name = "icon" then
         return From.Icon;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Friend_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "hasAccessToken" then
         return Util.Beans.Objects.To_Object (False);
      end if;
      return Friend_List.List_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create a Friend_List bean instance.
   --  ------------------------------
   function Create_Friends_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Friend_List_Bean_Access := new Friend_List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         Log.Info ("Getting the Facebook friends");

         Get_Friends ("https://graph.facebook.com/me/friends?access_token="
                      & Token,
                      Friend_Vector_Map'Access,
                      "/data",
                      List.List'Access);
      end if;

      return List.all'Access;
   end Create_Friends_Bean;

   --  ------------------------------
   --  Build and return a Facebook feed list.
   --  ------------------------------
   function Create_Feed_List_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Feed_List.List_Bean_Access := new Feed_List.List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         Log.Info ("Getting the Facebook feeds");

         Get_Feeds ("https://graph.facebook.com/me/home?access_token="
                    & Token,
                    Feed_Vector_Map'Access,
                    "/data",
                    List.List'Access);
      end if;

      return List.all'Access;
   end Create_Feed_List_Bean;

   --  ------------------------------
   --  Get the user information identified by the given name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Facebook_Auth;
                       Name : in String) return Util.Beans.Objects.Object is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      F    : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if F /= null and Name = "authenticate_url" then
         declare
            S      : constant ASF.Sessions.Session := F.Get_Session (True);
            Id     : constant String := S.Get_Id;
            State  : constant String := From.Get_State (Id);
            Params : constant String := From.Get_Auth_Params (State, "read_stream");
         begin
            Log.Info ("OAuth params: {0}", Params);

            return Util.Beans.Objects.To_Object ("https://www.facebook.com/dialog/oauth?"
                                                 & Params);
         end;
      elsif F /= null and Name = "isAuthenticated" then
         declare
            S      : constant ASF.Sessions.Session := F.Get_Session (False);
         begin
            if S.Is_Valid and
            then not Util.Beans.Objects.Is_Null (S.Get_Attribute ("access_token")) then
               return Util.Beans.Objects.To_Object (True);
            else
               return Util.Beans.Objects.To_Object (False);
            end if;
         end;
      end if;
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  ------------------------------
   --  Authenticate result from Facebook.
   --  ------------------------------
   procedure Authenticate (From    : in out Facebook_Auth;
                           Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      use type Security.OAuth.Clients.Access_Token_Access;

      F       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session : ASF.Sessions.Session := F.Get_Session;
      State   : constant String := F.Get_Parameter (Security.OAuth.State);
      Code    : constant String := F.Get_Parameter (Security.OAuth.Code);
   begin
      Log.Info ("Auth code {0} for state {1}", Code, State);
      if Session.Is_Valid then
         if From.Is_Valid_State (Session.Get_Id, State) then
            declare
               Acc : constant Security.OAuth.Clients.Access_Token_Access
                 := From.Request_Access_Token (Code);
            begin
               if Acc /= null then
                  Log.Info ("Access token is {0}", Acc.Get_Name);
                  Session.Set_Attribute ("access_token",
                                         Util.Beans.Objects.To_Object (Acc.Get_Name));
               end if;
            end;
         end if;
      end if;
   end Authenticate;

   package Authenticate_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Facebook_Auth,
                                                      Method => Authenticate,
                                                      Name   => "authenticate");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Authenticate_Binding.Proxy'Unchecked_Access);

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Facebook_Auth)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

begin
   Friend_Map.Add_Default_Mapping;
   Friend_Vector_Map.Set_Mapping (Friend_Map'Access);

   Feed_Map.Add_Mapping ("id", FIELD_ID);
   Feed_Map.Add_Mapping ("name", FIELD_NAME);
   Feed_Map.Add_Mapping ("message", FIELD_MESSAGE);
   Feed_Map.Add_Mapping ("description", FIELD_DESCRIPTION);
   Feed_Map.Add_Mapping ("from/name", FIELD_FROM);
   Feed_Map.Add_Mapping ("picture", FIELD_PICTURE);
   Feed_Map.Add_Mapping ("link", FIELD_LINK);
   Feed_Map.Add_Mapping ("icon", FIELD_ICON);
   Feed_Vector_Map.Set_Mapping (Feed_Map'Access);
end Facebook;

Fix compilation of Facebook example

Fix compilation of Facebook example


-----------------------------------------------------------------------
--  security-contexts -- Context to provide security information and verify permissions
--  Copyright (C) 2011, 2012 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.Task_Attributes;

with Security.Controllers;
package body Security.Contexts is

   package Task_Context is new Ada.Task_Attributes
     (Security_Context_Access, null);

   --  ------------------------------
   --  Get the application associated with the current service operation.
   --  ------------------------------
   function Get_User_Principal (Context : in Security_Context'Class)
                                return Security.Principal_Access is
   begin
      return Context.Principal;
   end Get_User_Principal;

   --  ------------------------------
   --  Get the permission manager.
   --  ------------------------------
   function Get_Permission_Manager (Context : in Security_Context'Class)
                                    return Security.Policies.Policy_Manager_Access is
   begin
      return Context.Manager;
   end Get_Permission_Manager;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in Security.Permissions.Permission_Index;
                             Result     : out Boolean) is
      use type Security.Policies.Controller_Access;
      use type Security.Policies.Policy_Manager_Access;
   begin
      if Context.Manager = null then
         Result := False;
         return;
      end if;
      declare
         C : constant Policies.Controller_Access := Context.Manager.Get_Controller (Permission);
      begin
         if C = null then
            Result := False;
         else
            --              Result := C.Has_Permission (Context);
            Result := False;
         end if;
      end;
   end Has_Permission;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in String;
                             Result     : out Boolean) is
      Index : constant Permissions.Permission_Index
        := Permissions.Get_Permission_Index (Permission);
   begin
      Security_Context'Class (Context).Has_Permission (Index, Result);
   end Has_Permission;

   --  ------------------------------
   --  Initializes the service context.  By creating the Security_Context variable,
   --  the instance will be associated with the current task attribute.  If the current task
   --  already has a security context, the new security context is installed, the old one
   --  being kept.
   --  ------------------------------
   overriding
   procedure Initialize (Context : in out Security_Context) is
   begin
      Context.Previous := Task_Context.Value;
      Task_Context.Set_Value (Context'Unchecked_Access);
   end Initialize;

   --  ------------------------------
   --  Finalize the security context releases any object.  The previous security context is
   --  restored to the current task attribute.
   --  ------------------------------
   overriding
   procedure Finalize (Context : in out Security_Context) is
   begin
      Task_Context.Set_Value (Context.Previous);
   end Finalize;

   --  ------------------------------
   --  Add a context information represented by Value under the name identified by
   --  Name in the security context Context.
   --  ------------------------------
   procedure Add_Context (Context   : in out Security_Context;
                          Name      : in String;
                          Value     : in String) is
   begin
      Context.Context.Include (Key      => Name,
                               New_Item => Value);
   end Add_Context;

   --  ------------------------------
   --  Get the context information registered under the name Name in the security
   --  context Context.
   --  Raises Invalid_Context if there is no such information.
   --  ------------------------------
   function Get_Context (Context  : in Security_Context;
                         Name     : in String) return String is
      Pos : constant Util.Strings.Maps.Cursor := Context.Context.Find (Name);
   begin
      if Util.Strings.Maps.Has_Element (Pos) then
         return Util.Strings.Maps.Element (Pos);
      else
         raise Invalid_Context;
      end if;
   end Get_Context;

   --  ------------------------------
   --  Returns True if a context information was registered under the name Name.
   --  ------------------------------
   function Has_Context (Context : in Security_Context;
                         Name    : in String) return Boolean is
      use type Util.Strings.Maps.Cursor;
   begin
      return Context.Context.Find (Name) /= Util.Strings.Maps.No_Element;
   end Has_Context;

   --  ------------------------------
   --  Set the current application and user context.
   --  ------------------------------
   procedure Set_Context (Context   : in out Security_Context;
                          Manager   : in Security.Policies.Policy_Manager_Access;
                          Principal : in Security.Principal_Access) is
   begin
      Context.Manager   := Manager;
      Context.Principal := Principal;
   end Set_Context;

   --  ------------------------------
   --  Get the current security context.
   --  Returns null if the current thread is not associated with any security context.
   --  ------------------------------
   function Current return Security_Context_Access is
   begin
      return Task_Context.Value;
   end Current;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   function Has_Permission (Permission : in Permissions.Permission_Index) return Boolean is
      Result  : Boolean;
      Context : constant Security_Context_Access := Current;
   begin
      if Context = null then
         return False;
      else
         Context.Has_Permission (Permission, Result);
         return Result;
      end if;
   end Has_Permission;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   function Has_Permission (Permission : in String) return Boolean is
      Result  : Boolean;
      Context : constant Security_Context_Access := Current;
   begin
      if Context = null then
         return False;
      else
         Context.Has_Permission (Permission, Result);
         return Result;
      end if;
   end Has_Permission;

end Security.Contexts;

-----------------------------------------------------------------------
--  security-contexts -- Context to provide security information and verify permissions
--  Copyright (C) 2011, 2012 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.Task_Attributes;

package body Security.Contexts is

   package Task_Context is new Ada.Task_Attributes
     (Security_Context_Access, null);

   --  ------------------------------
   --  Get the application associated with the current service operation.
   --  ------------------------------
   function Get_User_Principal (Context : in Security_Context'Class)
                                return Security.Principal_Access is
   begin
      return Context.Principal;
   end Get_User_Principal;

   --  ------------------------------
   --  Get the permission manager.
   --  ------------------------------
   function Get_Permission_Manager (Context : in Security_Context'Class)
                                    return Security.Policies.Policy_Manager_Access is
   begin
      return Context.Manager;
   end Get_Permission_Manager;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in Security.Permissions.Permission_Index;
                             Result     : out Boolean) is
      use type Security.Policies.Controller_Access;
      use type Security.Policies.Policy_Manager_Access;
   begin
      if Context.Manager = null then
         Result := False;
         return;
      end if;
      declare
         C : constant Policies.Controller_Access := Context.Manager.Get_Controller (Permission);
      begin
         if C = null then
            Result := False;
         else
            --              Result := C.Has_Permission (Context);
            Result := False;
         end if;
      end;
   end Has_Permission;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   procedure Has_Permission (Context    : in out Security_Context;
                             Permission : in String;
                             Result     : out Boolean) is
      Index : constant Permissions.Permission_Index
        := Permissions.Get_Permission_Index (Permission);
   begin
      Security_Context'Class (Context).Has_Permission (Index, Result);
   end Has_Permission;

   --  ------------------------------
   --  Initializes the service context.  By creating the Security_Context variable,
   --  the instance will be associated with the current task attribute.  If the current task
   --  already has a security context, the new security context is installed, the old one
   --  being kept.
   --  ------------------------------
   overriding
   procedure Initialize (Context : in out Security_Context) is
   begin
      Context.Previous := Task_Context.Value;
      Task_Context.Set_Value (Context'Unchecked_Access);
   end Initialize;

   --  ------------------------------
   --  Finalize the security context releases any object.  The previous security context is
   --  restored to the current task attribute.
   --  ------------------------------
   overriding
   procedure Finalize (Context : in out Security_Context) is
   begin
      Task_Context.Set_Value (Context.Previous);
   end Finalize;

   --  ------------------------------
   --  Add a context information represented by Value under the name identified by
   --  Name in the security context Context.
   --  ------------------------------
   procedure Add_Context (Context   : in out Security_Context;
                          Name      : in String;
                          Value     : in String) is
   begin
      Context.Context.Include (Key      => Name,
                               New_Item => Value);
   end Add_Context;

   --  ------------------------------
   --  Get the context information registered under the name Name in the security
   --  context Context.
   --  Raises Invalid_Context if there is no such information.
   --  ------------------------------
   function Get_Context (Context  : in Security_Context;
                         Name     : in String) return String is
      Pos : constant Util.Strings.Maps.Cursor := Context.Context.Find (Name);
   begin
      if Util.Strings.Maps.Has_Element (Pos) then
         return Util.Strings.Maps.Element (Pos);
      else
         raise Invalid_Context;
      end if;
   end Get_Context;

   --  ------------------------------
   --  Returns True if a context information was registered under the name Name.
   --  ------------------------------
   function Has_Context (Context : in Security_Context;
                         Name    : in String) return Boolean is
      use type Util.Strings.Maps.Cursor;
   begin
      return Context.Context.Find (Name) /= Util.Strings.Maps.No_Element;
   end Has_Context;

   --  ------------------------------
   --  Set the current application and user context.
   --  ------------------------------
   procedure Set_Context (Context   : in out Security_Context;
                          Manager   : in Security.Policies.Policy_Manager_Access;
                          Principal : in Security.Principal_Access) is
   begin
      Context.Manager   := Manager;
      Context.Principal := Principal;
   end Set_Context;

   --  ------------------------------
   --  Get the current security context.
   --  Returns null if the current thread is not associated with any security context.
   --  ------------------------------
   function Current return Security_Context_Access is
   begin
      return Task_Context.Value;
   end Current;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   function Has_Permission (Permission : in Permissions.Permission_Index) return Boolean is
      Result  : Boolean;
      Context : constant Security_Context_Access := Current;
   begin
      if Context = null then
         return False;
      else
         Context.Has_Permission (Permission, Result);
         return Result;
      end if;
   end Has_Permission;

   --  ------------------------------
   --  Check if the permission identified by Permission is allowed according to
   --  the current security context.  The result is cached in the security context and
   --  returned in Result.
   --  ------------------------------
   function Has_Permission (Permission : in String) return Boolean is
      Result  : Boolean;
      Context : constant Security_Context_Access := Current;
   begin
      if Context = null then
         return False;
      else
         Context.Has_Permission (Permission, Result);
         return Result;
      end if;
   end Has_Permission;

end Security.Contexts;

Remove unused with clause

Remove unused with clause