------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real time scheduling analysis tool. -- This program provides services to automatically check performances -- of real time architectures. -- -- Copyright (C) 2002-2010, by Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- the LISyC Team, University of Western Britanny. -- -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- This program 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 program 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 program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ----------------------------------------------------------------------------- -- Last update : -- $Rev: 431 $ -- $Date: 2011-04-24 13:35:23 +0200 (dim., 24 avr. 2011) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Text_IO; use Ada.Text_IO; with Sax.Readers; use Sax.Readers; with Sax.Exceptions; use Sax.Exceptions; with Sax.Locators; use Sax.Locators; with Sax.Attributes; use Sax.Attributes; with Unicode.CES; use Unicode.CES; with Unicode; use Unicode; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with strings; use strings; with unbounded_strings; use unbounded_strings; with Ada.Numerics.Aux; use Ada.Numerics.Aux; with Ada.Strings.Maps; use Ada.Strings.Maps; package body Xml_generic_Parsers is procedure Characters (Handler : in out Xml_Generic_Parser; Ch : Unicode.CES.Byte_Sequence) is -- A pair of index objects to keep track of the beginning and -- ending of the tokens isolated from the string -- First : Natural; Last : Positive; index : Positive; find_first_space : Boolean; -- A character set consisting of the "whitespace" characters -- that separate the tokens: -- Whitespace : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set (" "); -- The string to split -- The_Line : Unbounded_String; begin -- suppress extra blank and unprintable characters before splitting --parameters -- find_first_space := False; index := Ch'First; while index <= Ch'Last loop if (Ch (index) /= ASCII.CR) and (Ch (index) /= ASCII.LF) and (Ch (index) /= ASCII.HT) then if (Ch (index) = ' ') then if (not find_first_space) then The_Line := The_Line & Ch (index); end if; find_first_space := True; else The_Line := The_Line & Ch (index); find_first_space := False; end if; end if; index := index + 1; end loop; -- Remove blank in the beginnning/end of the string -- if Slice (The_Line, 1, 1) = " " then The_Line := To_Unbounded_String (Slice (The_Line, 2, Length (The_Line))); end if; if Slice (The_Line, Length (The_Line), Length (The_Line)) = " " then The_Line := To_Unbounded_String (Slice (The_Line, 1, Length (The_Line) - 1)); end if; -- XML tag without parameter -- if The_Line = empty_string then Handler.Parameter_List (1) := empty_string; return; end if; -- Split parameters -- loop Find_Token (The_Line, Set => Whitespace, Test => Ada.Strings.Outside, First => First, Last => Last); Handler.Parameter_List (Handler.Current_Parameter) := To_Unbounded_String (Slice (The_Line, First, Last)); Handler.Current_Parameter := Handler.Current_Parameter + 1; The_Line := To_Unbounded_String (Slice (The_Line, Last + 1, Length (The_Line))); exit when Length (The_Line) = 0; end loop; end Characters; procedure Set_Document_Locator (Handler : in out Xml_Generic_Parser; Loc : access Sax.Locators.Locator'Class) is begin Handler.Locator := Locator_Access (Loc); end Set_Document_Locator; procedure Warning (Handler : in out Xml_Generic_Parser; Except : Sax.Exceptions.Sax_Parse_Exception'Class) is begin Put_Line ("Xml parser warning (" & Get_Message (Except) & ", at " & To_String (Get_Locator (Except)) & ')'); end Warning; procedure Error (Handler : in out Xml_Generic_Parser; Except : Sax.Exceptions.Sax_Parse_Exception'Class) is begin Put_Line ("Xml parser non fatal error (" & Get_Message (Except) & ", at " & To_String (Get_Locator (Except)) & ')'); end Error; procedure Fatal_Error (Handler : in out Xml_Generic_Parser; Except : Sax.Exceptions.Sax_Parse_Exception'Class) is begin Put_Line ("Xml parser fatal error (" & Get_Message (Except) & ')'); Fatal_Error (Reader (Handler), Except); end Fatal_Error; -- Index value -- procedure End_Element( Handler : in out Xml_generic_parser; val : in out unbounded_string; Namespace_Uri : Unicode.CES.Byte_Sequence := ""; Local_Name : Unicode.CES.Byte_Sequence := ""; Qname : Unicode.CES.Byte_Sequence := "") is begin if (To_String (To_Lower (Qname)) = "index") or (To_String (To_Lower (Qname)) = "time_unit") or (To_String (To_Lower (Qname)) = "task_name") then val:=handler.parameter_list(1); end if; end End_Element; procedure End_Element( Handler : in out Xml_generic_parser; val : in out integer; Namespace_Uri : Unicode.CES.Byte_Sequence := ""; Local_Name : Unicode.CES.Byte_Sequence := ""; Qname : Unicode.CES.Byte_Sequence := "") is val_string : unbounded_string; ok : boolean; begin if (To_String (To_Lower (Qname)) = "index") or (To_String (To_Lower (Qname)) = "time_unit") or (To_String (To_Lower (Qname)) = "task_name") then val_string:=handler.parameter_list(1); to_integer (val_string, val, ok); if not ok then Put_Line ("Warning : Error on data type. From " & To_String (Handler.Locator.all)); end if; end if; end End_Element; end Xml_generic_Parsers;