ada/templates-parser
0
0
Fork 0
mirror of https://github.com/AdaCore/templates-parser.git synced 2026-02-12 12:29:55 -08:00
Code Issues Packages Projects Releases Wiki Activity
Files
master
templates-parser/tools/templates2ada.adb
Pascal Obry bf939d96fb Move to GPLv3. 
For L107-006.
2012-01-07 16:40:40 +01:00

775 lines
27 KiB
Ada
Raw Permalink Blame History

------------------------------------------------------------------------------
-- Templates Parser --
-- --
-- Copyright (C) 2006-2012, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This software 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 --
-- distributed with this software; see file COPYING3. If not, go --
-- to http://www.gnu.org/licenses for a complete copy of the license. --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Directories;
with Ada.Streams.Stream_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Text_IO;
with GNAT.Command_Line; use GNAT.Command_Line;
with Templates_Parser; use Templates_Parser;
with Templates_Parser.Utils; use Templates_Parser.Utils;
procedure Templates2Ada is
use Ada;
function "+" (Str : String) return Unbounded_String
renames Ada.Strings.Unbounded.To_Unbounded_String;
package String_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists
(String);
Opt_Output : Unbounded_String := +"templates.ads";
-- Output file name
Opt_Templates_Dir : Unbounded_String := +"resources/templates";
-- Name of the directory in which templates are searched. Filenames stored
-- in the generated Ada files will be relative to this directory.
Opt_Recursive : Boolean := False;
-- Whether the search for template files should be recursive
Opt_Templates_Ext : String_Lists.List;
-- List of extensions for the templates files
Opt_Template : Unbounded_String := +"templates.tads";
-- Name of the template file for the generated package.
-- This gives you the opportunity of either generating a single package
-- with nested packages (one for each template file), or a whole hierarchy
-- of packages (by running gnatchop on the generated file).
Opt_Verbose : Boolean := False;
-- If true, this will output a warning when an HTTP parameter has a name
-- made only of template parser tags, and then can't be generated in the
-- packages as a result.
HTTP_Get_Suffix : constant String := "@@";
-- Suffix added in the internal tables for HTTP parameter names to indicate
-- the ones that were defined through a HTTP_GET comment
Help : Boolean := False;
-- Set to true if -h option used
Default_Template_Extension : constant String := ".thtml";
-- The default extension used for template files
N_Word_Set : constant Strings.Maps.Character_Set :=
To_Set (ASCII.HT & ASCII.LF & " ,()");
type Template_Description is record
Filename : Unbounded_String;
Variables : Tag;
Included : Tag;
HTTP : Tag;
From_Get : Tag; -- Boolean to indicate if the corresponding
-- entry in HTTP is from a HTTP_GET parameter
URL : Tag;
Ajax_Event : Tag;
Ajax_Action : Tag;
Ajax_File : Tag;
Set_Var, Set_Val : Tag;
end record;
package Sets is new Ada.Containers.Indefinite_Ordered_Sets (String);
package Maps is new Ada.Containers.Indefinite_Ordered_Maps
(String, Template_Description);
All_Templates : Maps.Map;
All_Variables : Sets.Set;
procedure Foreach_Template (Relative_Directory : String);
-- Process each template in Directory (recursively if global options are
-- set appropriately).
procedure Process_Template (Relative_Name : String);
-- Process a given templates file
procedure Output_File;
-- Create the output file
procedure Next_Word
(Str : String;
Index : Integer;
Starts_At : out Integer;
Ends_At : out Integer);
-- Find the next word. This will skip all blank spaces at Index (and
-- update Starts_At appropriately), then move Ends_At to the last
-- non-blank character in the word.
function Next_Line (Str : String; Index : Integer) return Integer;
-- Return the first character on the next line
function Search
(Str : String;
Index : Integer;
Pattern : String;
Forward : Boolean := True) return Integer;
-- Search the first occurrence of Pattern after Index. Return Integer'First
-- if not found.
----------------------
-- Foreach_Template --
----------------------
procedure Foreach_Template (Relative_Directory : String) is
use type Directories.File_Kind;
Search : Directories.Search_Type;
Dir_Ent : Directories.Directory_Entry_Type;
C : String_Lists.Cursor;
begin
Directories.Start_Search (Search, Relative_Directory, "");
while Directories.More_Entries (Search) loop
Directories.Get_Next_Entry (Search, Dir_Ent);
if Directories.Kind (Dir_Ent) = Directories.Directory then
if Opt_Recursive
and then Directories.Simple_Name (Dir_Ent) /= "."
and then Directories.Simple_Name (Dir_Ent) /= ".."
then
Foreach_Template
(Directories.Compose
(Relative_Directory,
Directories.Simple_Name (Dir_Ent)));
end if;
elsif Directories.Kind (Dir_Ent) = Directories.Ordinary_File then
C := Opt_Templates_Ext.First;
while String_Lists.Has_Element (C) loop
declare
Simple : constant String :=
Directories.Simple_Name (Dir_Ent);
Ext : constant String := String_Lists.Element (C);
begin
if Simple'Length > Ext'Length
and then Simple
(Simple'Last - Ext'Length + 1
.. Simple'Last) = Ext
then
Process_Template
(Directories.Compose
(Relative_Directory,
Directories.Simple_Name (Dir_Ent)));
end if;
end;
String_Lists.Next (C);
end loop;
end if;
end loop;
Directories.End_Search (Search);
exception
when Text_IO.Name_Error =>
Text_IO.Put_Line
("Can't find template directory " & Relative_Directory);
end Foreach_Template;
---------------
-- Next_Line --
---------------
function Next_Line (Str : String; Index : Integer) return Integer is
Result : Integer := Index;
begin
while Result <= Str'Last
and then Str (Result) /= ASCII.LF
loop
Result := Result + 1;
end loop;
return Result + 1;
end Next_Line;
---------------
-- Next_Word --
---------------
procedure Next_Word
(Str : String;
Index : Integer;
Starts_At : out Integer;
Ends_At : out Integer) is
begin
Find_Token
(Str (Index .. Str'Last),
N_Word_Set, Strings.Outside, Starts_At, Ends_At);
if Ends_At = 0 then
Ends_At := Str'Last;
end if;
end Next_Word;
-----------------
-- Output_File --
-----------------
procedure Output_File is
use Maps, Sets;
Template : constant String := To_String (Opt_Template);
Output : Text_IO.File_Type;
T : Translate_Set;
C : Maps.Cursor := First (All_Templates);
C2 : Sets.Cursor := First (All_Variables);
Variables : Tag;
Filenames : Tag;
Bases : Tag;
Variables_List : Tag;
Includes : Tag;
HTTPS : Tag;
URLs : Tag;
From_Get : Tag;
Ajax_Event : Tag;
Ajax_Action : Tag;
Ajax_File : Tag;
Set_Var, Set_Val : Tag;
begin
while Has_Element (C) loop
Append (Variables, Element (C).Variables);
Append (Filenames, Element (C).Filename);
Append (Bases, Key (C));
Append (Includes, Element (C).Included);
Append (HTTPS, Element (C).HTTP);
Append (From_Get, Element (C).From_Get);
Append (URLs, Element (C).URL);
Append (Ajax_Event, Element (C).Ajax_Event);
Append (Ajax_Action, Element (C).Ajax_Action);
Append (Ajax_File, Element (C).Ajax_File);
Append (Set_Var, Element (C).Set_Var);
Append (Set_Val, Element (C).Set_Val);
Next (C);
end loop;
while Has_Element (C2) loop
Variables_List := Variables_List & Element (C2);
Next (C2);
end loop;
Insert (T, Assoc ("VARIABLE", Variables));
Insert (T, Assoc ("FILENAME", Filenames));
Insert (T, Assoc ("BASENAME", Bases));
Insert (T, Assoc ("VARIABLE_LIST", Variables_List));
Insert (T, Assoc ("INCLUDE", Includes));
Insert (T, Assoc ("HTTP", HTTPS));
Insert (T, Assoc ("FROM_GET", From_Get));
Insert (T, Assoc ("URL", URLs));
Insert (T, Assoc ("AJAX_EVENT", Ajax_Event));
Insert (T, Assoc ("AJAX_ACTION", Ajax_Action));
Insert (T, Assoc ("AJAX_FILE", Ajax_File));
Insert (T, Assoc ("SET_VAR", Set_Var));
Insert (T, Assoc ("SET_VAL", Set_Val));
Text_IO.Create (Output, Text_IO.Out_File, To_String (Opt_Output));
if Directories.Exists (Template) then
Text_IO.Put (Output, Parse (Template, T));
else
Text_IO.Put
(Output,
Parse (Utils.Get_Program_Directory
& ".." & Directory_Separator
& "share" & Directory_Separator
& "examples" & Directory_Separator
& "aws" & Directory_Separator
& "templates" & Directory_Separator & Template,
T));
end if;
Text_IO.Close (Output);
exception
when Text_IO.Name_Error =>
Text_IO.Put_Line
("Can't find template file : " & To_String (Opt_Template));
end Output_File;
----------------------
-- Process_Template --
----------------------
procedure Process_Template (Relative_Name : String) is
use Ada.Streams, Ada.Streams.Stream_IO;
use Sets;
Result : Unbounded_String;
File : Ada.Streams.Stream_IO.File_Type;
Seen, Include, HTTP, URL : Sets.Set;
To_Ignore : Sets.Set;
Variables, Includes, HTTPS : Tag;
URLs, From_Get : Tag;
Ajax_Event, Ajax_Action : Tag;
Ajax_File : Tag;
Set_Var, Set_Val : Tag;
C : Sets.Cursor;
Inserted : Boolean;
pragma Unreferenced (Result);
procedure Process_Tag (Str : String; S : in out Integer);
-- Process some text surrounded by @_..._@, and add it to the proper
-- output tags. S points to the "@_" in Str, and is modified to
-- point after the closing "_@".
procedure Process_Tags (Str : String; First, Last : Integer);
-- Process all tags referenced in Str (First .. Last)
-----------------
-- Process_Tag --
-----------------
procedure Process_Tag (Str : String; S : in out Integer) is
First : Integer := S + 2;
Last : Integer := First;
Parents_Nesting : Natural := 0;
Macro : Boolean := False;
begin
while Last < Str'Last loop
if Str (Last) = ':' then
First := Last + 1;
elsif Str (Last .. Last + 2) = ")_@" then
Macro := True;
exit;
elsif Str (Last .. Last + 1) = "_@" then
exit;
end if;
Last := Last + 1;
end loop;
if Macro then
-- First word is the macro name, check if this is a AWS/Ajax macro
S := S + 2;
Next_Word (Str, S, First, Last);
S := Last + 1;
if Str (First .. Last) = "JS_ACTION" then
-- First parameter is the event
Next_Word (Str, S, First, Last);
Append (Ajax_Event, Str (First .. Last));
S := Last + 1;
-- Second parameter is the action
Next_Word (Str, S, First, Last);
Append (Ajax_Action, Str (First .. Last));
S := Last + 1;
-- Record Ajax file location
Append
(Ajax_File,
Directories.Base_Name (Relative_Name));
end if;
else
-- Special case: a convention is that user-defined scripts
-- might accept arguments that reference other tags, by using
-- the syntax @_FILTER(@param):..._@, ie the parameter starts
-- with a single @ sign. In this case, we want to make sure
-- there is a entry made for the argument as well. Such
-- filters might have multiple arguments. Multiple arguments
-- must be comma-separated.
for A in S + 2 .. Last - 1 loop
if Str (A) = '(' then
Parents_Nesting := Parents_Nesting + 1;
elsif Str (A) = ')' then
Parents_Nesting := Parents_Nesting - 1;
elsif Str (A) = '@'
and then Parents_Nesting > 0
and then (Str (A - 1) = ',' or else Str (A - 1) = '(')
then
for B in A + 1 .. Last - 1 loop
if Str (B) = ',' or else Str (B) = ')' then
Insert (Seen, Str (A + 1 .. B - 1), C, Inserted);
Insert
(All_Variables, Str (A + 1 .. B - 1),
C, Inserted);
exit;
end if;
end loop;
end if;
end loop;
-- Remove attributes (can't be done in the loop above, because
-- of complex structures like ADD_PARAM(AI='...'):PARAMETERS.
for F in reverse First .. Last - 1 loop
if Str (F) = ''' then
Last := F;
exit;
end if;
end loop;
if Str (First) /= '$'
and then Str (First .. Last - 1) /= "TABLE_LINE"
and then Str (First .. Last - 1) /= "UP_TABLE_LINE"
and then Str (First .. Last - 1) /= "NUMBER_LINE"
then
Insert (Seen, Str (First .. Last - 1), C, Inserted);
Insert (All_Variables, Str (First .. Last - 1), C, Inserted);
end if;
S := Last + 2;
end if;
end Process_Tag;
------------------
-- Process_Tags --
------------------
procedure Process_Tags (Str : String; First, Last : Integer) is
S : Integer := First;
begin
while S < Last loop
if Str (S .. S + 1) = "@_" then
Process_Tag (Str, S);
else
S := S + 1;
end if;
end loop;
end Process_Tags;
begin
-- We cannot use the templates parser, since it wouldn't process
-- correctly the @@IF@@ statements, and would only see one branch of
-- them.
Open (File, In_File, Relative_Name);
declare
Last, Last_Save : Integer;
S, First : Integer;
Str : String (1 .. Integer (Size (File)));
begin
String'Read (Stream (File), Str);
S := Str'First;
while S < Str'Last loop
if S + 13 <= Str'Last
and then Str (S .. S + 13) = "@@-- HTTP_GET("
then
Next_Word (Str, S + 14, First, Last);
if not Contains (HTTP, Str (First .. Last)) then
Insert
(HTTP, Str (First .. Last) & HTTP_Get_Suffix, C, Inserted);
end if;
S := Next_Line (Str, Last + 1);
elsif S + 13 <= Str'Last
and then Str (S .. S + 13) = "@@-- HTTP_URL("
then
Next_Word (Str, S + 14, First, Last);
Insert (URL, Str (First .. Last), C, Inserted);
S := Next_Line (Str, Last + 1);
elsif S + 4 <= Str'Last
and then Str (S .. S + 3) = "@@--"
then
S := Next_Line (Str, S + 4);
elsif S + 11 <= Str'Last
and then Str (S .. S + 11) = "@@SET@@ SET_"
then
Next_Word (Str, S + 7, First, Last);
Append (Set_Var, Str (First .. Last));
S := Last + 1;
Next_Word (Str, S, First, Last);
S := Last + 1;
Next_Word (Str, S, First, Last);
Append (Set_Val, Str (First .. Last));
elsif S + 6 <= Str'Last
and then Str (S .. S + 6) = "@@SET@@"
then
Next_Word (Str, S + 7, First, Last);
Insert (To_Ignore, Str (First .. Last), C, Inserted);
-- The value of the variable could be either static or come
-- from one or more other tags. We need to parse it, as a
-- result.
S := Next_Line (Str, Last + 1);
Process_Tags (Str, Last + 1, S - 1);
elsif Str (S .. S + 1) = "@_" then
Process_Tag (Str, S);
elsif S + 10 < Str'Last
and then Str (S .. S + 10) = "@@INCLUDE@@"
then
Next_Word (Str, S + 12, First, Last);
-- We could either have "@@INCLUDE@@ static_name.html"
-- or "@@INCLUDE@@ @_TAG_@". In the latter case we need to
-- handle the tag as usual.
Process_Tags (Str, First, Last);
Insert
(Include,
Directories.Base_Name (Str (First .. Last)), C, Inserted);
S := Last + 2;
-- Check for AWS/Ajax actions. AWS/Ajax is based on include
-- files whose name is starting with "aws_action_". The first
-- parameter being the event and the second the action. We use
-- this naming scheme here.
--
-- @@INCLUDE@@ aws_action_xml.tjs (onclick, form_enter ...)
if Index (Str (First .. Last), "aws_action_") /= 0 then
-- First parameter is the event
Next_Word (Str, S, First, Last);
Append (Ajax_Event, Str (First .. Last));
S := Last + 1;
-- Second parameter is the action
Next_Word (Str, S, First, Last);
Append (Ajax_Action, Str (First .. Last));
S := Last + 1;
-- Record Ajax file location
Append
(Ajax_File,
Directories.Base_Name (Relative_Name));
end if;
elsif S + 8 < Str'Last
and then Str (S .. S + 8) = "<a name="""
then
-- Ignored, just so that we do not generate an HTTP entry for
-- it.
S := S + 9;
elsif S + 11 < Str'Last
and then Str (S .. S + 11) = "<form name="""
then
-- Ignored, just so that we do not generate an HTTP entry for
-- it.
S := S + 12;
elsif S + 5 < Str'Last
and then Str (S .. S + 5) = "name="""
then
First := S + 6;
Last := First;
while Last <= Str'Last
and then Str (Last) /= '"'
loop
Last := Last + 1;
end loop;
-- If the name contains some tags, this isn't a constant name.
-- This is generally used for checkbox names, since the names
-- need to be unique in such a case. In that case, try to find
-- a prefix or a suffix as appropriate.
Last_Save := Last - 1;
Last := Last_Save;
-- The name might be something like "@_A_@:@_B_@:name", for
-- which we will generate Name_Suffix.
while First <= Str'Last and then Str (First) = '@' loop
First := Search (Str, First, "_@") + 2;
while First in Str'Range
and then not Is_Letter (Str (First))
and then Str (First) /= '@'
loop
First := First + 1;
end loop;
end loop;
-- It might also be something like "name:@_A_@:@_B_@" for which
-- we will generate Name_Prefix.
while Last >= Str'First and then Str (Last) = '@' loop
Last := Search (Str, Last, "@_", Forward => False) - 1;
while Last in Str'Range
and then not Is_Letter (Str (Last))
and then Str (Last) /= '@'
loop
Last := Last - 1;
end loop;
end loop;
if Opt_Verbose and then Last - First < 0 then
Text_IO.Put_Line
("Can't process HTTP parameter: "
& Str (S + 6 .. Last_Save)
& " in template " & Relative_Name);
end if;
-- We do not insert the parameter in case a matching
-- HTTP_GET parameter has already been inserted otherwise
-- we end up with duplicated constants in the HTTP package.
if First in Str'Range
and then Last in Str'Range
and then Last - First >= 0
and then
not Contains (HTTP, Str (First .. Last) & HTTP_Get_Suffix)
then
Insert (HTTP, Str (First .. Last), C, Inserted);
end if;
S := Last + 2;
else
S := S + 1;
end if;
end loop;
end;
C := First (Seen);
while Has_Element (C) loop
if not Contains (To_Ignore, Element (C)) then
Variables := Variables & Element (C);
end if;
Next (C);
end loop;
C := First (Include);
while Has_Element (C) loop
Includes := Includes & Element (C);
Next (C);
end loop;
C := First (HTTP);
while Has_Element (C) loop
declare
Name : constant String := Element (C);
begin
if Name'Length > 2
and then Name (Name'Last - HTTP_Get_Suffix'Length + 1
.. Name'Last) = HTTP_Get_Suffix
then
HTTPS := HTTPS &
Name (Name'First .. Name'Last - HTTP_Get_Suffix'Length);
From_Get := From_Get & True;
else
HTTPS := HTTPS & Name;
From_Get := From_Get & False;
end if;
end;
Next (C);
end loop;
C := First (URL);
while Has_Element (C) loop
URLs := URLs & Element (C);
Next (C);
end loop;
Maps.Insert
(All_Templates, Directories.Base_Name (Relative_Name),
(+Relative_Name, Variables, Includes, HTTPS, From_Get, URLs,
Ajax_Event, Ajax_Action, Ajax_File, Set_Var, Set_Val));
exception
when Text_IO.Name_Error =>
Text_IO.Put_Line ("Can't open template file : " & Relative_Name);
end Process_Template;
------------
-- Search --
------------
function Search
(Str : String;
Index : Integer;
Pattern : String;
Forward : Boolean := True) return Integer
is
Result : Integer;
begin
if Forward then
Result := Index;
while Result <= Str'Last - Pattern'Length + 1 loop
if Str (Result .. Result + Pattern'Length - 1) = Pattern then
return Result;
end if;
Result := Result + 1;
end loop;
else
Result := Index - Pattern'Length + 1;
while Result >= Str'First loop
if Str (Result .. Result + Pattern'Length - 1) = Pattern then
return Result;
end if;
Result := Result - 1;
end loop;
end if;
return Integer'First;
end Search;
begin
loop
case Getopt ("o: d: e: t: r v h") is
when 'd' => Opt_Templates_Dir := +Parameter;
when 'o' => Opt_Output := +Parameter;
when 'e' => Opt_Templates_Ext.Append (Parameter);
when 't' => Opt_Template := +Parameter;
when 'r' => Opt_Recursive := True;
when 'v' => Opt_Verbose := True;
when 'h' => Help := True;
when others => exit;
end case;
end loop;
if Opt_Templates_Ext.Is_Empty then
Opt_Templates_Ext.Append (Default_Template_Extension);
end if;
if Help or else Ada.Command_Line.Argument_Count = 0 then
Text_IO.New_Line;
Text_IO.Put_Line ("Usage: templates2ada [options]");
Text_IO.New_Line;
Text_IO.Put_Line
(" -d dir : template directory");
Text_IO.Put_Line
(" -o file : output filename (" & To_String (Opt_Output) & ')');
Text_IO.Put_Line
(" -e ext : template filename's extension (" &
Default_Template_Extension & ')');
Text_IO.Put_Line
(" -t tmplt : template filename (" & To_String (Opt_Template) & ')');
Text_IO.Put_Line
(" -r : search for templates file recursively");
Text_IO.Put_Line
(" -v : verbose mode");
Text_IO.Put_Line
(" -h : display this help message");
Text_IO.New_Line;
else
Foreach_Template (To_String (Opt_Templates_Dir));
Output_File;
end if;
end Templates2Ada;
Reference in New Issue View Git Blame Copy Permalink