Gem #19: XML streaming of Ada objects
by Pascal Obry —EDF R&D
Let's get started…
Since Ada 95 it has been possible to stream any object. Using 'Input/'Output or 'Read/'Write attributes, any object (tagged or not) can be streamed using a binary representation. This means that objects can be written into a file or sent over a socket, for example.
Let's take a simple object hierarchy to illustrate this feature. We'll have a Point (x and y coordinate) and a Pixel (a Point with a color).
package Object is
type Point is tagged record
X, Y : Float;
end record;
type Color_Name is (Red, Green, Blue);
type Pixel is new Point with record
Color : Color_Name;
end record;
end Object;
When writing a Point or a Pixel the first bytes in the stream are the tag external representation then the object's attribute values.
declare
File : File_Type;
P : Point'Class := ...;
begin
Create (File, Out_File, "streamed.data");
Point'Class'Output (Text_Streams.Stream (File), P);
Close (File);
end;
The stream will contain something like (where is the character hexadecimal code):
<01> <00> <00> <00> <0C> <00> <00> <00> O B J E C T . P I X E L <9A> <99> <99> <3f> <66> <66> <06> <41> <00>
The tag is an important part as it will be used to be able to create the proper object instance out of the stream.
P := constant Point'Class :=
Point'Class'Input (Text_Streams.Stream (File));
All is well! No, there is a little missing feature. There is no way to control how the external tag is streamed. In fact, it is a string and the bounds (lower and upper) are first output into the stream. These bounds are plain numbers written in binary.
In the above example we have the four first bytes for lower bound (equal to 1) and the four following bytes for the upper bound (equal to 12) then the twelve bytes for the external tag full name OBJECT.PIXEL.
In Ada 95 there is no way to stream a textual representation of objects!
But the good news is... Ada 2005 can do this. Ada 2005 goes further by adding support to control finely the external representation of any objects. This means that it is now possible to create a textual representation of such an object using the 'Class'Input and 'Class'Output attributes.
Let's put in place the missing pieces.
First the 'Read and 'Write attributes to output or read the XML representation of a Point or a Pixel.
with Ada.Streams;
package Object is
type Point is ...
procedure Read (S : access Root_Stream_Type'Class; O : out Point);
for Point'Read use Read;
procedure Write
(S : access Root_Stream_Type'Class; O : in Point);
for Point'Write use Write;
type Pixel is ...
procedure Read (S : access Root_Stream_Type'Class; O : out Pixel);
for Pixel'Read use Read;
procedure Write
(S : access Root_Stream_Type'Class; O : in Pixel);
for Pixel'Write use Write;
The Read routines could be implemented using a full featured XML parser like XML/Ada. For conciseness, we will use two very simple XML oriented routines:
procedure Skip_Tag
(S : access Ada.Streams.Root_Stream_Type'Class;
Ending : in Character := '>');
-- Skip the next tag on stream S, returns when Ending is found
function Get_Value
(S : access Ada.Streams.Root_Stream_Type'Class) return String;
-- Returns the current value read on stream S
Using those routines the 'Read and 'Write implementation are straightforward. Here is the implementation for a Point:
procedure Read (S : access Root_Stream_Type'Class; O : out Point) is
begin
Skip_Tag (S); O.X := Float'Value (Get_Value (S)); Skip_Tag (S, ASCII.LF);
Skip_Tag (S); O.Y := Float'Value (Get_Value (S)); Skip_Tag (S, ASCII.LF);
end Read;
procedure Write (S : access Root_Stream_Type'Class; O : in Point) is
begin
String'Write (S, " <x>" & Float'Image (O.X) & "</x>" & ASCII.LF);
String'Write (S, " <y>" & Float'Image (O.Y) & "</y>" & ASCII.LF);
end Write;
The last missing piece is the handing of the tag. We want the tag to be simply: <point> and <pixel> (no bound and just the name of the object instead of the full name prefixed by the enclosing package name). To set the proper tag name we use the External_Tag attribute:
package Object is
type Point is ...
for Point'External_Tag use "point";
type Pixel is ...
for Pixel'External_Tag use "pixel";
Then we want to plug in our own XML oriented implementation of the 'Class'Input and 'Class'Output attributes. This is necessary only for the root type Point:
package Object is
type Point is ...
for Point'External_Tag use "point";
procedure Class_Output
(S : access Ada.Streams.Root_Stream_Type'Class; O : in Point'Class);
for Point'Class'Output use Class_Output;
function Class_Input
(S : access Ada.Streams.Root_Stream_Type'Class) return Point'Class;
for Point'Class'Input use Class_Input;
The Class_Output routine must output the opening XML tag, output the object itself and then the closing XML tag. Quite simple to do; the following is the commented code:
procedure Class_Output
(S : access Ada.Streams.Root_Stream_Type'Class; O : in Point'Class) is
begin
-- Write the opening tag
Character'Write (S, '<');
String'Write (S, Ada.Tags.External_Tag (O'Tag));
String'Write (S, '>' & ASCII.LF);
-- Write the object, dispatching call to Point/Pixel'Write
Point'Output (S, O);
-- Write the closing tag
Character'Write (S, '<');
Character'Write (S, '/');
String'Write (S, Ada.Tags.External_Tag (O'Tag));
String'Write (S, '>' & ASCII.LF);
end Class_Output;
And now the final part using Ada.Tags.Generic_Dispatching_Constructor which will create an object out of a stream given the object's tag. This must do the exact opposite of the Class_Output routine. The opening XML tag is read, then the object using Generic_Dispatching_Constructor and finally the closing XML tag.
function Class_Input
(S : access Ada.Streams.Root_Stream_Type'Class) return Point'Class
is
function Dispatching_Input is
new Ada.Tags.Generic_Dispatching_Constructor
(T => Point,
Parameters => Ada.Streams.Root_Stream_Type'Class,
Constructor => Point'Input);
Input : String (1 .. 20);
Input_Len : Natural := 0;
begin
-- On the stream we have , we want to get "tag_name"
-- Read first character, must be '<'
Character'Read (S, Input (1));
if Input (1) /= '<' then
raise Ada.Tags.Tag_Error with "starting with " & Input (1);
end if;
-- Read the tag name
Input_Len := 0;
for I in Input'range loop
Character'Read (S, Input (I));
Input_Len := I;
exit when Input (I) = '>';
end loop;
-- Check ending tag
if Input (Input_Len) /= '>'
or else Input_Len <= 1
then -- Empty tag
raise Ada.Tags.Tag_Error with "empty tag";
else
Input_Len := Input_Len - 1;
end if;
declare
External_Tag : constant String := Input (1 .. Input_Len);
O : constant Point'Class := Dispatching_Input
(Ada.Tags.Internal_Tag (External_Tag), S);
-- Dispatches to appropriate Point/Pixel'Input depending on
-- the tag name.
begin
-- Skip closing object tag
Skip_Tag (S); Skip_Tag (S, ASCII.LF);
return O;
end;
end Class_Input;
At this point the code shown at the start will still work without modification. The fact that the object is streamed using an XML representation is transparent to the users of the Object package.
As a final note, for conciseness, the code as-is does not output conformant XML documents as there is no XML header and there are multiple root nodes. This is left as an exercise to the reader.
Related Source Code
Ada Gems example files are distributed by AdaCore and may be used or modified for any purpose without restrictions.
gem_19.ada