File : templates_parser-filter.adb
------------------------------------------------------------------------------
-- Templates Parser --
-- --
-- Copyright (C) 2003 --
-- Pascal Obry --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- $Id: templates_parser-filter.adb,v 1.1 2004/02/24 15:26:14 Jano Exp $
separate (Templates_Parser)
package body Filter is
-- Filter tokens
Multiply_Token : aliased constant String := """*""";
Plus_Token : aliased constant String := """+""";
Minus_Token : aliased constant String := """-""";
Divide_Token : aliased constant String := """/""";
Add_Token : aliased constant String := "ADD";
BR_2_LF_Token : aliased constant String := "BR_2_LF";
Capitalize_Token : aliased constant String := "CAPITALIZE";
Clean_Text_Token : aliased constant String := "CLEAN_TEXT";
Coma_2_Point_Token : aliased constant String := "COMA_2_POINT";
Contract_Token : aliased constant String := "CONTRACT";
Div_Token : aliased constant String := "DIV";
Exist_Token : aliased constant String := "EXIST";
Format_Number_Token : aliased constant String := "FORMAT_NUMBER";
Is_Empty_Token : aliased constant String := "IS_EMPTY";
LF_2_BR_Token : aliased constant String := "LF_2_BR";
Lower_Token : aliased constant String := "LOWER";
Match_Token : aliased constant String := "MATCH";
Modulo_Token : aliased constant String := "MOD";
Mult_Token : aliased constant String := "MULT";
No_Digit_Token : aliased constant String := "NO_DIGIT";
No_Letter_Token : aliased constant String := "NO_LETTER";
No_Space_Token : aliased constant String := "NO_SPACE";
Oui_Non_Token : aliased constant String := "OUI_NON";
Point_2_Coma_Token : aliased constant String := "POINT_2_COMA";
Repeat_Token : aliased constant String := "REPEAT";
Reverse_Token : aliased constant String := "REVERSE";
Size_Token : aliased constant String := "SIZE";
Slice_Token : aliased constant String := "SLICE";
Sub_Token : aliased constant String := "SUB";
Trim_Token : aliased constant String := "TRIM";
Upper_Token : aliased constant String := "UPPER";
Web_Escape_Token : aliased constant String := "WEB_ESCAPE";
Web_NBSP_Token : aliased constant String := "WEB_NBSP";
Yes_No_Token : aliased constant String := "YES_NO";
-- Filters Table
Table : constant array (Mode) of Filter_Record
:= (Multiply =>
(Multiply_Token'Access, Multiply'Access),
Plus =>
(Plus_Token'Access, Plus'Access),
Minus =>
(Minus_Token'Access, Minus'Access),
Divide =>
(Divide_Token'Access, Divide'Access),
Add =>
(Add_Token'Access, Plus'Access),
BR_2_LF =>
(BR_2_LF_Token'Access, BR_2_LF'Access),
Capitalize =>
(Capitalize_Token'Access, Capitalize'Access),
Clean_Text =>
(Clean_Text_Token'Access, Clean_Text'Access),
Coma_2_Point =>
(Coma_2_Point_Token'Access, Coma_2_Point'Access),
Contract =>
(Contract_Token'Access, Contract'Access),
Div =>
(Div_Token'Access, Divide'Access),
Exist =>
(Exist_Token'Access, Exist'Access),
Format_Number =>
(Format_Number_Token'Access, Format_Number'Access),
Is_Empty =>
(Is_Empty_Token'Access, Is_Empty'Access),
LF_2_BR =>
(LF_2_BR_Token'Access, LF_2_BR'Access),
Lower =>
(Lower_Token'Access, Lower'Access),
Match =>
(Match_Token'Access, Match'Access),
Modulo =>
(Modulo_Token'Access, Modulo'Access),
Mult =>
(Mult_Token'Access, Multiply'Access),
No_Digit =>
(No_Digit_Token'Access, No_Digit'Access),
No_Letter =>
(No_Letter_Token'Access, No_Letter'Access),
No_Space =>
(No_Space_Token'Access, No_Space'Access),
Oui_Non =>
(Oui_Non_Token'Access, Oui_Non'Access),
Point_2_Coma =>
(Point_2_Coma_Token'Access, Point_2_Coma'Access),
Repeat =>
(Repeat_Token'Access, Repeat'Access),
Invert =>
(Reverse_Token'Access, Reverse_Data'Access),
Size =>
(Size_Token'Access, Size'Access),
Slice =>
(Slice_Token'Access, Slice'Access),
Sub =>
(Sub_Token'Access, Minus'Access),
Trim =>
(Trim_Token'Access, Trim'Access),
Upper =>
(Upper_Token'Access, Upper'Access),
Web_Escape =>
(Web_Escape_Token'Access, Web_Escape'Access),
Web_NBSP =>
(Web_NBSP_Token'Access, Web_NBSP'Access),
Yes_No =>
(Yes_No_Token'Access, Yes_No'Access)
);
--------------------------
-- Check_Null_Parameter --
--------------------------
procedure Check_Null_Parameter (P : in Parameter_Data) is
begin
if P.Mode /= Void then
Exceptions.Raise_Exception
(Template_Error'Identity, "no parameter allowed in this filter");
end if;
end Check_Null_Parameter;
---------------
-- Parameter --
---------------
function Parameter (Mode : in Filter.Mode) return Parameter_Mode is
begin
case Mode is
when Match => return Regexp;
when Slice => return Slice;
when others => return Str;
end case;
end Parameter;
------------
-- Handle --
------------
function Handle (Name : in String) return Callback is
Mode : constant Filter.Mode := Mode_Value (Name);
begin
return Table (Mode).Handle;
end Handle;
function Handle (Mode : in Filter.Mode) return Callback is
begin
return Table (Mode).Handle;
end Handle;
-----------
-- Image --
-----------
function Image (P : in Parameter_Data) return String is
begin
case P.Mode is
when Void => return "";
when Str => return '(' & To_String (P.S) & ')';
when Regexp => return '(' & To_String (P.R_Str) & ')';
when Slice => return '(' & Image (P.First)
& " .. " & Image (P.Last) & ')';
end case;
end Image;
----------
-- Mode --
----------
function Mode_Value (Name : in String) return Mode is
F, L, K : Mode;
begin
F := Mode'First;
L := Mode'Last;
loop
K := Mode'Val ((Mode'Pos (F) + Mode'Pos (L)) / 2);
if Table (K).Name.all = Name then
return K;
elsif Table (K).Name.all < Name then
F := K;
if F /= Mode'Last then
F := Mode'Succ (F);
end if;
else
L := K;
if L /= Mode'First then
L := Mode'Pred (L);
end if;
end if;
exit when F = L and then F = K;
end loop;
Exceptions.Raise_Exception
(Internal_Error'Identity, "Unknown filter " & Name);
end Mode_Value;
----------
-- Name --
----------
function Name (Handle : in Callback) return String is
begin
for K in Table'Range loop
if Table (K).Handle = Handle then
return Table (K).Name.all;
end if;
end loop;
Exceptions.Raise_Exception
(Internal_Error'Identity, "Unknown filter handle");
end Name;
--
-- Filters definition start here
--
-------------
-- BR_2_LF --
-------------
function BR_2_LF
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
Result : String (S'Range);
K : Positive := Result'First;
J : Positive := S'First;
begin
Check_Null_Parameter (P);
loop
if S (J) = '<'
and then J + 3 <= S'Last
and then Characters.Handling.To_Lower (S (J .. J + 3)) = "<br>"
then
Result (K) := ASCII.LF;
K := K + 1;
J := J + 4;
else
Result (K) := S (J);
K := K + 1;
J := J + 1;
end if;
exit when J > S'Last;
end loop;
return Result (Result'First .. K - 1);
end BR_2_LF;
----------------
-- Capitalize --
----------------
function Capitalize
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String (S'Range);
Upper : Boolean := True;
begin
Check_Null_Parameter (P);
for K in Result'Range loop
if Upper then
Result (K) := Characters.Handling.To_Upper (S (K));
Upper := False;
else
Result (K) := Characters.Handling.To_Lower (S (K));
if Result (K) = ' ' or else Result (K) = '_' then
Upper := True;
end if;
end if;
end loop;
return Result;
end Capitalize;
----------------
-- Clean_Text --
----------------
function Clean_Text
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
use type Strings.Maps.Character_Set;
Result : String (S'Range);
Clean_Set : constant Strings.Maps.Character_Set
:= Strings.Maps.Constants.Letter_Set
or Strings.Maps.Constants.Decimal_Digit_Set
or Strings.Maps.To_Set (" éèêîïàôç");
begin
Check_Null_Parameter (P);
for K in S'Range loop
if Strings.Maps.Is_In (S (K), Clean_Set) then
Result (K) := S (K);
else
Result (K) := ' ';
end if;
end loop;
return Result;
end Clean_Text;
------------------
-- Coma_2_Point --
------------------
function Coma_2_Point
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String := S;
begin
Check_Null_Parameter (P);
for K in Result'Range loop
if Result (K) = ',' then
Result (K) := '.';
end if;
end loop;
return Result;
end Coma_2_Point;
--------------
-- Contract --
--------------
function Contract
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
use type Strings.Maps.Character_Set;
Result : String (S'Range);
R : Natural := 0;
Space : Boolean := False;
begin
Check_Null_Parameter (P);
for K in S'Range loop
if S (K) = ' ' then
if Space = False then
Space := True;
R := R + 1;
Result (R) := ' ';
end if;
else
Space := False;
R := R + 1;
Result (R) := S (K);
end if;
end loop;
if R = 0 then
return "";
else
return Result (Result'First .. R);
end if;
end Contract;
-----------
-- Exist --
-----------
function Exist
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
if S /= "" then
return "TRUE";
else
return "FALSE";
end if;
end Exist;
-------------------
-- Format_Number --
-------------------
function Format_Number
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
TS : constant String := Strings.Fixed.Trim (S, Both);
function Is_Number return Boolean;
-- Returns true if S is a number.
Point : Natural := 0;
function Is_Number return Boolean is
begin
for K in TS'Range loop
if TS (K) = '.' then
Point := K;
elsif not Characters.Handling.Is_Digit (TS (K)) then
return False;
end if;
end loop;
return True;
end Is_Number;
Result : String (1 .. TS'Length * 2);
K : Positive := Result'Last;
I : Natural;
Count : Natural := 0;
begin
Check_Null_Parameter (P);
if Is_Number then
if Point = 0 then
I := TS'Last;
else
I := Point - 1;
end if;
for P in reverse TS'First .. I loop
Result (K) := TS (P);
K := K - 1;
Count := Count + 1;
if Count mod 3 = 0 and then P /= TS'First then
Result (K) := ' ';
K := K - 1;
end if;
end loop;
if Point = 0 then
return Result (K + 1 .. Result'Last);
else
return Result (K + 1 .. Result'Last) & TS (Point .. TS'Last);
end if;
else
return S;
end if;
end Format_Number;
--------------
-- Is_Empty --
--------------
function Is_Empty
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
if S = "" then
return "TRUE";
else
return "FALSE";
end if;
end Is_Empty;
-------------
-- LF_2_BR --
-------------
function LF_2_BR
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
N : constant Natural
:= Fixed.Count (S, Strings.Maps.To_Set (ASCII.LF));
begin
Check_Null_Parameter (P);
if N = 0 then
-- No LF, return the original string
return S;
end if;
declare
Result : String (1 .. S'Length + N * 3);
K : Positive := S'First;
begin
for J in S'Range loop
if S (J) = ASCII.LF then
Result (K .. K + 3) := "<br>";
K := K + 4;
else
Result (K) := S (J);
K := K + 1;
end if;
end loop;
return Result (1 .. K - 1);
end;
end LF_2_BR;
-----------
-- Lower --
-----------
function Lower
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
return Characters.Handling.To_Lower (S);
end Lower;
-----------
-- Match --
------------
function Match
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
if P = No_Parameter then
Exceptions.Raise_Exception
(Template_Error'Identity, "missing parameter for MATCH filter");
end if;
if GNAT.Regexp.Match (S, P.Regexp) then
return "TRUE";
else
return "FALSE";
end if;
end Match;
--------------
-- No_Digit --
--------------
function No_Digit
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String := S;
begin
Check_Null_Parameter (P);
for K in S'Range loop
if Strings.Maps.Is_In (S (K),
Strings.Maps.Constants.Decimal_Digit_Set)
then
Result (K) := ' ';
end if;
end loop;
return Result;
end No_Digit;
---------------
-- No_Letter --
---------------
function No_Letter
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String := S;
begin
Check_Null_Parameter (P);
for K in S'Range loop
if Strings.Maps.Is_In (S (K), Strings.Maps.Constants.Letter_Set) then
Result (K) := ' ';
end if;
end loop;
return Result;
end No_Letter;
--------------
-- No_Space --
--------------
function No_Space
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String (S'Range);
L : Natural := Result'First - 1;
begin
Check_Null_Parameter (P);
for K in S'Range loop
if not (S (K) = ' ') then
L := L + 1;
Result (L) := S (K);
end if;
end loop;
return Result (Result'First .. L);
end No_Space;
-------------
-- Oui_Non --
-------------
function Oui_Non
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
if S = "TRUE" then
return "OUI";
elsif S = "true" then
return "oui";
elsif S = "True" then
return "Oui";
elsif S = "FALSE" then
return "NON";
elsif S = "false" then
return "non";
elsif S = "False" then
return "Non";
else
return S;
end if;
end Oui_Non;
------------------
-- Point_2_Coma --
------------------
function Point_2_Coma
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String := S;
begin
Check_Null_Parameter (P);
for K in Result'Range loop
if Result (K) = '.' then
Result (K) := ',';
end if;
end loop;
return Result;
end Point_2_Coma;
------------
-- Repeat --
------------
function Repeat
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
N : Natural;
begin
N := Natural'Value (To_String (P.S));
declare
R : String (1 .. N * S'Length);
begin
for K in 1 .. N loop
R (1 + (K - 1) * S'Length .. S'Length * K) := S;
end loop;
return R;
end;
exception
when Constraint_Error =>
Exceptions.Raise_Exception
(Template_Error'Identity, "repeat filter parameter error");
end Repeat;
------------------
-- Reverse_Data --
------------------
function Reverse_Data
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Result : String (S'Range);
begin
Check_Null_Parameter (P);
for K in S'Range loop
Result (Result'Last - K + Result'First) := S (K);
end loop;
return Result;
end Reverse_Data;
----------
-- Size --
----------
function Size
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
return Image (S'Length);
end Size;
-----------
-- Slice --
-----------
function Slice
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
First, Last : Natural;
begin
First := Natural'Min (P.First, S'Length + 1);
Last := Natural'Min (P.Last, S'Length);
return S (S'First + First - 1 .. S'First + Last - 1);
end Slice;
----------
-- Trim --
----------
function Trim
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
return Ada.Strings.Fixed.Trim (S, Ada.Strings.Both);
end Trim;
-----------
-- Upper --
-----------
function Upper
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
return Characters.Handling.To_Upper (S);
end Upper;
------------
-- Escape --
------------
function Web_Escape
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Max_Escape_Sequence : constant Positive := 5;
Result : String (1 .. S'Length * Max_Escape_Sequence);
Last : Natural := 0;
begin
Check_Null_Parameter (P);
for I in S'Range loop
Last := Last + 1;
case S (I) is
when '&' =>
Result (Last .. Last + 4) := "&";
Last := Last + 4;
when '>' =>
Result (Last .. Last + 3) := ">";
Last := Last + 3;
when '<' =>
Result (Last .. Last + 3) := "<";
Last := Last + 3;
when '"' =>
Result (Last .. Last + 5) := """;
Last := Last + 5;
when others =>
Result (Last) := S (I);
end case;
end loop;
return Result (1 .. Last);
end Web_Escape;
--------------
-- Web_NBSP --
--------------
function Web_NBSP
(S : in String;
P : in Parameter_Data := No_Parameter)
return String
is
Nbsp_Token : constant String := " ";
Max_Escape_Sequence : constant Positive := Nbsp_Token'Length;
Result : String (1 .. S'Length * Max_Escape_Sequence);
Last : Natural := 0;
begin
Check_Null_Parameter (P);
for I in S'Range loop
Last := Last + 1;
if S (I) = ' ' then
Result (Last .. Last + Nbsp_Token'Length - 1) := Nbsp_Token;
Last := Last + Nbsp_Token'Length - 1;
else
Result (Last) := S (I);
end if;
end loop;
return Result (1 .. Last);
end Web_NBSP;
------------
-- Yes_No --
------------
function Yes_No
(S : in String;
P : in Parameter_Data := No_Parameter)
return String is
begin
Check_Null_Parameter (P);
if S = "TRUE" then
return "YES";
elsif S = "true" then
return "yes";
elsif S = "True" then
return "Yes";
elsif S = "FALSE" then
return "NO";
elsif S = "false" then
return "no";
elsif S = "False" then
return "No";
else
return S;
end if;
end Yes_No;
----------
-- Plus --
----------
function Plus
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
N, V : Natural;
begin
begin
N := Natural'Value (To_String (P.S));
exception
when Constraint_Error =>
Exceptions.Raise_Exception
(Template_Error'Identity, """+"" filter parameter error");
end;
begin
V := Natural'Value (S);
return Image (V + N);
exception
when others =>
return "";
end;
end Plus;
-----------
-- Minus --
-----------
function Minus
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
N, V : Natural;
begin
begin
N := Natural'Value (To_String (P.S));
exception
when Constraint_Error =>
Exceptions.Raise_Exception
(Template_Error'Identity, """-"" filter parameter error");
end;
begin
V := Natural'Value (S);
return Image (V - N);
exception
when others =>
return "";
end;
end Minus;
------------
-- Divide --
------------
function Divide
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
N, V : Natural;
begin
begin
N := Natural'Value (To_String (P.S));
exception
when Constraint_Error =>
Exceptions.Raise_Exception
(Template_Error'Identity, """/"" filter parameter error");
end;
begin
V := Natural'Value (S);
return Image (V / N);
exception
when others =>
return "";
end;
end Divide;
--------------
-- Multiply --
--------------
function Multiply
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
N, V : Natural;
begin
begin
N := Natural'Value (To_String (P.S));
exception
when Constraint_Error =>
Exceptions.Raise_Exception
(Template_Error'Identity, """*"" filter parameter error");
end;
begin
V := Natural'Value (S);
return Image (V * N);
exception
when others =>
return "";
end;
end Multiply;
------------
-- Modulo --
------------
function Modulo
(S : in String; P : in Parameter_Data := No_Parameter) return String
is
N, V : Natural;
begin
begin
N := Natural'Value (To_String (P.S));
exception
when Constraint_Error =>
Exceptions.Raise_Exception
(Template_Error'Identity, "modulo filter parameter error");
end;
begin
V := Natural'Value (S);
return Image (V mod N);
exception
when others =>
return "";
end;
end Modulo;
end Filter;