-----------------------------------------------------------------------
-- core-factory -- Factory for Core UI Components
-- Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2022 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 Ada.Exceptions;
with Ada.Strings.Maps;
with ASF.Views.Nodes;
with ASF.Locales;
with ASF.Components.Utils.Files;
with ASF.Components.Utils.Flush;
with ASF.Components.Utils.Scripts;
with ASF.Components.Utils.Escapes;
with ASF.Components.Utils.Beans;
with ASF.Components.Html.Messages;
with ASF.Applications.Main;
with Util.Log.Loggers;
with Util.Properties.Bundles;
with Util.Dates.Formats;
with Util.Dates.ISO8601;
with Util.Beans.Objects.Time;
with Util.Locales;
with Util.Encoders.SHA256;
with Util.Strings.Transforms; use Util.Strings;
package body ASF.Components.Utils.Factory is
use ASF.Components.Base;
-- The logger
Log : constant Util.Log.Loggers.Logger
:= Util.Log.Loggers.Create ("ASF.Components.Utils.Factory");
function Create_File return UIComponent_Access;
function Create_Flush return UIComponent_Access;
function Create_Script return UIComponent_Access;
function Create_Escape return UIComponent_Access;
function Create_Set return UIComponent_Access;
-- -------------------------
-- ------------------------------
-- Create a UIFile component
-- ------------------------------
function Create_File return UIComponent_Access is
begin
return new ASF.Components.Utils.Files.UIFile;
end Create_File;
-- ------------------------------
-- Create a UIFlush component
-- ------------------------------
function Create_Flush return UIComponent_Access is
begin
return new ASF.Components.Utils.Flush.UIFlush;
end Create_Flush;
-- ------------------------------
-- Create a UIScript component
-- ------------------------------
function Create_Script return UIComponent_Access is
begin
return new ASF.Components.Utils.Scripts.UIScript;
end Create_Script;
-- ------------------------------
-- Create a UIEscape component
-- ------------------------------
function Create_Escape return UIComponent_Access is
begin
return new ASF.Components.Utils.Escapes.UIEscape;
end Create_Escape;
-- ------------------------------
-- Create a UISetBean component
-- ------------------------------
function Create_Set return UIComponent_Access is
begin
return new ASF.Components.Utils.Beans.UISetBean;
end Create_Set;
use ASF.Views.Nodes;
URI : aliased constant String := "http://code.google.com/p/ada-asf/util";
ESCAPE_TAG : aliased constant String := "escape";
FILE_TAG : aliased constant String := "file";
FLUSH_TAG : aliased constant String := "flush";
SCRIPT_TAG : aliased constant String := "script";
SET_TAG : aliased constant String := "set";
-- ------------------------------
-- Register the HTML component factory.
-- ------------------------------
procedure Register (Factory : in out ASF.Factory.Component_Factory) is
begin
ASF.Factory.Register (Factory,
URI => URI'Access,
Name => ESCAPE_TAG'Access,
Tag => Create_Component_Node'Access,
Create => Create_Escape'Access);
ASF.Factory.Register (Factory,
URI => URI'Access,
Name => FILE_TAG'Access,
Tag => Create_Component_Node'Access,
Create => Create_File'Access);
ASF.Factory.Register (Factory,
URI => URI'Access,
Name => FLUSH_TAG'Access,
Tag => Create_Component_Node'Access,
Create => Create_Flush'Access);
ASF.Factory.Register (Factory,
URI => URI'Access,
Name => SCRIPT_TAG'Access,
Tag => Create_Component_Node'Access,
Create => Create_Script'Access);
ASF.Factory.Register (Factory,
URI => URI'Access,
Name => SET_TAG'Access,
Tag => Create_Component_Node'Access,
Create => Create_Set'Access);
end Register;
-- Truncate the string representation represented by Value to
-- the length specified by Size.
function Escape_Javascript (Value : EL.Objects.Object) return EL.Objects.Object;
-- Escape the string using XML escape rules.
function Escape_Xml (Value : EL.Objects.Object) return EL.Objects.Object;
-- Translate the value into an ISO8606 date.
function To_ISO8601 (Value : in EL.Objects.Object) return EL.Objects.Object;
-- Encode the string for URL.
function Url_Encode (Value : in EL.Objects.Object) return EL.Objects.Object;
-- Encode the object into a SHA256.
function SHA256 (Value : in EL.Objects.Object) return EL.Objects.Object;
function SHA256_Base64 (Value : in EL.Objects.Object) return EL.Objects.Object;
-- Format a date using the given date pattern.
function Format_Date (Date : in EL.Objects.Object;
Format : in EL.Objects.Object) return EL.Objects.Object;
-- Translate a value using a resource bundle and applying a prefix for the translation.
function Translate (Bundle : in EL.Objects.Object;
Prefix : in EL.Objects.Object;
Value : in EL.Objects.Object) return EL.Objects.Object;
procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
begin
Mapper.Set_Function (Name => "escapeJavaScript",
Namespace => URI,
Func => Escape_Javascript'Access);
Mapper.Set_Function (Name => "escapeXml",
Namespace => URI,
Func => Escape_Xml'Access);
Mapper.Set_Function (Name => "formatDate",
Namespace => URI,
Func => Format_Date'Access);
Mapper.Set_Function (Name => "iso8601",
Namespace => URI,
Func => To_ISO8601'Access);
Mapper.Set_Function (Name => "hasMessage",
Namespace => URI,
Func => ASF.Components.Html.Messages.Has_Message'Access,
Optimize => False);
Mapper.Set_Function (Name => "urlEncode",
Namespace => URI,
Func => Url_Encode'Access,
Optimize => False);
Mapper.Set_Function (Name => "translate",
Namespace => URI,
Func => Translate'Access);
Mapper.Set_Function (Name => "sha256base64",
Namespace => URI,
Func => SHA256_Base64'Access);
Mapper.Set_Function (Name => "sha256",
Namespace => URI,
Func => SHA256'Access);
end Set_Functions;
function Escape_Javascript (Value : EL.Objects.Object) return EL.Objects.Object is
Result : Ada.Strings.Unbounded.Unbounded_String;
Content : constant String := EL.Objects.To_String (Value);
begin
Transforms.Escape_Javascript (Content => Content,
Into => Result);
return EL.Objects.To_Object (Result);
end Escape_Javascript;
function Escape_Xml (Value : EL.Objects.Object) return EL.Objects.Object is
Result : Ada.Strings.Unbounded.Unbounded_String;
Content : constant String := EL.Objects.To_String (Value);
begin
Transforms.Escape_Xml (Content => Content,
Into => Result);
return EL.Objects.To_Object (Result);
end Escape_Xml;
-- ------------------------------
-- Translate the value into an ISO8606 date.
-- ------------------------------
function To_ISO8601 (Value : in EL.Objects.Object) return EL.Objects.Object is
D : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
S : constant String := Util.Dates.ISO8601.Image (D);
begin
return Util.Beans.Objects.To_Object (S);
end To_ISO8601;
-- ------------------------------
-- Format a date using the given date pattern.
-- ------------------------------
function Format_Date (Date : in EL.Objects.Object;
Format : in EL.Objects.Object) return EL.Objects.Object is
Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
Locale : constant Util.Locales.Locale := Context.Get_Locale;
Bundle : ASF.Locales.Bundle;
begin
begin
ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
Name => "asf",
Locale => Util.Locales.To_String (Locale),
Bundle => Bundle);
exception
when E : Util.Properties.Bundles.NO_BUNDLE =>
Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
end;
declare
Time : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Date);
Pattern : constant String := Util.Beans.Objects.To_String (Format);
Result : constant String := Util.Dates.Formats.Format (Pattern, Time, Bundle);
begin
return EL.Objects.To_Object (Result);
end;
end Format_Date;
-- ------------------------------
-- Translate a value using a resource bundle and applying a prefix for the translation.
-- ------------------------------
function Translate (Bundle : in EL.Objects.Object;
Prefix : in EL.Objects.Object;
Value : in EL.Objects.Object) return EL.Objects.Object is
Bean : access Util.Beans.Basic.Readonly_Bean'Class;
begin
Bean := Util.Beans.Objects.To_Bean (Bundle);
if Bean = null then
return Value;
else
return Bean.Get_Value (EL.Objects.To_String (Prefix) & EL.Objects.To_String (Value));
end if;
end Translate;
use Ada.Strings.Maps;
Conversion : constant String (1 .. 16) := "0123456789ABCDEF";
Url_Encode_Set : constant Ada.Strings.Maps.Character_Set
:= Ada.Strings.Maps.To_Set (Span => (Low => Character'Val (0),
High => ' '))
or
Ada.Strings.Maps.To_Set (Span => (Low => Character'Val (128),
High => Character'Val (255)))
or
Ada.Strings.Maps.To_Set (":/?#[]@!$&'""()*+,;=");
-- ------------------------------
-- Encode the string for URL.
-- ------------------------------
function Url_Encode (Value : in EL.Objects.Object) return EL.Objects.Object is
S : constant String := Util.Beans.Objects.To_String (Value);
T : String (1 .. S'Length * 3);
Pos : Positive := 1;
C : Character;
begin
for I in S'Range loop
C := S (I);
if Ada.Strings.Maps.Is_In (C, Url_Encode_Set) then
T (Pos) := '%';
T (Pos + 1) := Conversion (1 + Character'Pos (C) / 16);
T (Pos + 2) := Conversion (1 + Character'Pos (C) mod 16);
Pos := Pos + 3;
else
T (Pos) := C;
Pos := Pos + 1;
end if;
end loop;
return Util.Beans.Objects.To_Object (T (1 .. Pos - 1));
end Url_Encode;
-- ------------------------------
-- Encode the object into a SHA256.
-- ------------------------------
function SHA256_Base64 (Value : in EL.Objects.Object) return EL.Objects.Object is
Content : constant String := Util.Beans.Objects.To_String (Value);
Context : Util.Encoders.SHA256.Context;
Result : Util.Encoders.SHA256.Base64_Digest;
begin
Util.Encoders.SHA256.Update (Context, Content);
Util.Encoders.SHA256.Finish_Base64 (Context, Result);
return Util.Beans.Objects.To_Object (Result);
end SHA256_Base64;
-- ------------------------------
-- Encode the object into a SHA256.
-- ------------------------------
function SHA256 (Value : in EL.Objects.Object) return EL.Objects.Object is
Content : constant String := Util.Beans.Objects.To_String (Value);
Context : Util.Encoders.SHA256.Context;
Result : Util.Encoders.SHA256.Digest;
begin
Util.Encoders.SHA256.Update (Context, Content);
Util.Encoders.SHA256.Finish (Context, Result);
return Util.Beans.Objects.To_Object (Result);
end SHA256;
end ASF.Components.Utils.Factory;