245 lines
7.6 KiB
Ada
245 lines
7.6 KiB
Ada
with
|
|
ada.unchecked_Conversion,
|
|
ada.unchecked_Deallocation,
|
|
interfaces.C.Strings,
|
|
system.Storage_Elements;
|
|
|
|
|
|
package body XML.Reader
|
|
is
|
|
|
|
package C renames Interfaces.C;
|
|
package S renames Interfaces.C.Strings;
|
|
|
|
|
|
type XML_Char is new C.unsigned_short;
|
|
type XML_Char_Ptr is access all XML_Char;
|
|
type Char_Ptr_Ptr is access all S.chars_ptr;
|
|
|
|
|
|
|
|
|
|
procedure XML_SetUserData (XML_Parser : in XML_Parser_Ptr;
|
|
Parser_Ptr : in Parser);
|
|
|
|
pragma Import (C, XML_SetUserData, "XML_SetUserData");
|
|
|
|
|
|
|
|
procedure Internal_Start_Handler (My_Parser : in Parser;
|
|
Name : in S.chars_ptr;
|
|
AttAdd : in System.Address);
|
|
|
|
pragma Convention (C, Internal_Start_Handler);
|
|
|
|
procedure Internal_Start_Handler (My_Parser : in Parser;
|
|
Name : in S.chars_ptr;
|
|
AttAdd : in System.Address)
|
|
is
|
|
|
|
use S, System, System.Storage_Elements;
|
|
|
|
procedure Free is new ada.Unchecked_Deallocation (Attributes_t, Attributes_view);
|
|
function To_CP is new ada.unchecked_Conversion (System.Address, Char_Ptr_Ptr);
|
|
|
|
AA_Size : Storage_Offset;
|
|
|
|
the_Attribute_Array : Attributes_view;
|
|
N_Atts : Natural;
|
|
Atts : System.Address;
|
|
|
|
begin
|
|
-- Calculate the size of a single attribute (name or value) pointer.
|
|
--
|
|
AA_Size := S.Chars_Ptr'Size / System.Storage_Unit;
|
|
|
|
-- Count the number of attributes by scanning for a null pointer.
|
|
--
|
|
N_Atts := 0;
|
|
Atts := AttAdd;
|
|
|
|
while To_CP (Atts).all /= S.Null_Ptr
|
|
loop
|
|
N_Atts := N_Atts + 1;
|
|
Atts := Atts + (AA_Size * 2);
|
|
end loop;
|
|
|
|
-- Allocate a new attribute array of the correct size.
|
|
--
|
|
the_Attribute_Array := new Attributes_t (1 .. N_Atts);
|
|
|
|
-- Convert the attribute strings to unbounded_String.
|
|
--
|
|
Atts := AttAdd;
|
|
|
|
for Att in 1 .. N_Atts
|
|
loop
|
|
the_Attribute_Array (Att).Name := to_unbounded_String (S.Value (To_CP (Atts).all));
|
|
Atts := Atts + AA_Size;
|
|
the_Attribute_Array (Att).Value := to_unbounded_String (S.Value (To_CP (Atts).all));
|
|
Atts := Atts + AA_Size;
|
|
end loop;
|
|
|
|
-- Call the user's handler.
|
|
--
|
|
My_Parser.Start_Handler (to_unbounded_String (S.Value (Name)),
|
|
the_Attribute_Array);
|
|
|
|
-- Give back the attribute array.
|
|
--
|
|
Free (the_Attribute_Array);
|
|
end Internal_Start_Handler;
|
|
|
|
|
|
|
|
|
|
procedure Internal_End_Handler (My_Parser : in Parser;
|
|
Name : in S.chars_ptr);
|
|
|
|
pragma Convention (C, Internal_End_Handler);
|
|
|
|
procedure Internal_End_Handler (My_Parser : in Parser;
|
|
Name : in S.chars_ptr)
|
|
is
|
|
begin
|
|
My_Parser.End_Handler (to_unbounded_String (S.Value (Name)));
|
|
end Internal_End_Handler;
|
|
|
|
|
|
|
|
|
|
procedure Internal_CD_Handler (My_Parser : in Parser;
|
|
Data : in S.chars_ptr;
|
|
Len : in C.int);
|
|
|
|
pragma Convention (C, Internal_CD_Handler);
|
|
|
|
procedure Internal_CD_Handler (My_Parser : in Parser;
|
|
Data : in S.chars_ptr;
|
|
Len : in C.int)
|
|
is
|
|
the_Data : constant unbounded_String := to_unbounded_String (S.Value (Data, c.size_t (Len)));
|
|
|
|
begin
|
|
if the_Data /= ""
|
|
then
|
|
My_Parser.CD_Handler (the_Data);
|
|
end if;
|
|
end Internal_CD_Handler;
|
|
|
|
|
|
|
|
|
|
function Create_Parser return Parser
|
|
is
|
|
function XML_ParserCreate (Encoding: in XML_Char_Ptr) return XML_Parser_Ptr;
|
|
pragma Import (C, XML_ParserCreate, "XML_ParserCreate");
|
|
|
|
begin
|
|
return new Parser_Rec' (XML_ParserCreate (null),
|
|
null,
|
|
null,
|
|
null);
|
|
end Create_Parser;
|
|
|
|
|
|
|
|
|
|
procedure Set_Element_Handler (The_Parser : in Parser;
|
|
Start_Handler : in Start_Element_Handler;
|
|
End_Handler : in End_Element_Handler)
|
|
is
|
|
type Internal_Start_Element_Handler is access procedure (My_Parser : in Parser;
|
|
Name : in S.chars_ptr;
|
|
AttAdd : in System.Address);
|
|
pragma Convention (C, Internal_Start_Element_Handler);
|
|
|
|
|
|
type Internal_End_Element_Handler is access procedure (My_Parser : in Parser;
|
|
Name : in S.chars_ptr);
|
|
pragma Convention (C, Internal_End_Element_Handler);
|
|
|
|
|
|
procedure XML_SetElementHandler (XML_Parser : in XML_Parser_Ptr;
|
|
Start_Handler : in Internal_Start_Element_Handler;
|
|
End_Handler : in Internal_End_Element_Handler);
|
|
pragma Import (C, XML_SetElementHandler, "XML_SetElementHandler");
|
|
|
|
begin
|
|
XML_SetUserData (The_Parser.XML_Parser,
|
|
The_Parser);
|
|
|
|
The_Parser.Start_Handler := Start_Handler;
|
|
The_Parser.End_Handler := End_Handler;
|
|
|
|
XML_SetElementHandler (The_Parser.XML_Parser, Internal_Start_Handler'Access,
|
|
Internal_End_Handler 'Access);
|
|
end Set_Element_Handler;
|
|
|
|
|
|
|
|
|
|
procedure Set_Character_Data_Handler (The_Parser : in Parser;
|
|
CD_Handler : in Character_Data_Handler)
|
|
is
|
|
|
|
type Internal_Character_Data_Handler is access procedure (My_Parser : in Parser;
|
|
Data : in S.chars_ptr;
|
|
Len : in C.int);
|
|
pragma Convention (C, Internal_Character_Data_Handler);
|
|
|
|
procedure XML_SetCharacterDataHandler (XML_Parser : in XML_Parser_Ptr;
|
|
CD_Handler : in Internal_Character_Data_Handler);
|
|
pragma Import (C, XML_SetCharacterDataHandler, "XML_SetCharacterDataHandler");
|
|
|
|
begin
|
|
XML_SetUserData (The_Parser.XML_Parser, The_Parser);
|
|
The_Parser.CD_Handler := CD_Handler;
|
|
XML_SetCharacterDataHandler (The_Parser.XML_Parser, Internal_CD_Handler'Access);
|
|
end Set_Character_Data_Handler;
|
|
|
|
|
|
|
|
|
|
procedure Parse (The_Parser : in Parser;
|
|
XML : in String;
|
|
Is_Final : in Boolean)
|
|
is
|
|
function XML_Parse (XML_Parser : in XML_Parser_Ptr;
|
|
XML : in S.chars_ptr;
|
|
Len : in C.int;
|
|
Is_Final : in C.int) return C.int;
|
|
pragma Import (C, XML_Parse, "XML_Parse");
|
|
|
|
use C;
|
|
|
|
XML_STATUS_ERROR : constant C.int := 0;
|
|
pragma Unreferenced (XML_STATUS_ERROR);
|
|
XML_STATUS_OK : constant C.int := 1;
|
|
|
|
Final_Flag : C.int;
|
|
Status : C.int;
|
|
XML_Data : S.chars_ptr;
|
|
|
|
begin
|
|
if Is_Final
|
|
then Final_Flag := 1;
|
|
else Final_Flag := 0;
|
|
end if;
|
|
|
|
XML_Data := S.New_Char_Array (C.To_C (XML));
|
|
Status := XML_Parse (The_Parser.XML_Parser,
|
|
XML_Data,
|
|
C.int (XML'Length),
|
|
Final_Flag);
|
|
S.Free (XML_Data);
|
|
|
|
if Status /= XML_STATUS_OK
|
|
then
|
|
raise XML_Parse_Error;
|
|
end if;
|
|
end Parse;
|
|
|
|
|
|
end XML.Reader;
|