------------------------------------------------------------------------------ -- 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) = "= 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;