Contents

• Abstract
• Persistent Object Package
• Usage of the persistent object Package
• Implementation Details
• Remarks
• Restrictions
• Download

Abstract

A requirement which arises often in smaller applications is the persistence of the application state, which means upon termination of the application the state has to be saved and restored upon the next time the application is started.
In the  typical implementation during startup of the application the state is reconstructed from the information stored in the file. As a result code has to be added to store and retrieve data from the sate file.
Based on the finalization/initialize mechanism of Ada95 a small package provides a simple and efficient alternative to implement this requirement.
 

Persistent Objects Package

The persistent object package (name: ASCL.OB.Persitant ) provides an abstract data type which may be extended by the application components as it is required.

type Object_ID is new Integer;

type Object( this : Object_ID ) is abstract
                  new Controlled with private;

type Handle is access Object'Class;

The object identifier (Object_ID) has to be specified in order to identify the object during instanciation. The value should be unique through the whole application.

Additionally the following methods are provided:

• function Open( Name,  ...... ) return Pool_ID

  
  This function opens the files where the object contents is written. Every file is identified by a so called Pool_ID which is returned by this function.
   

• Close(  pool : Pool_ID )

  
  A storage file is closed.
   

• Add ( pool : Pool_ID;  name :  Tag .... )

  
  This procedure assigns the given Tag to a pool, which means all instances of  the class denoted by the tag will be maintained in the file which is identified by the pool identifier.

Usage of the Persistent Object Package

Each persistent object is identified by a so called object identifier (Object_ID), which is simply a number. This number is used as a key under which the object contents is stored in the object file.
The implementation of a persistent class requires the extension of the base type with the object data and the implementation of a read and a write procedure. These procedures are used to perform the i/o-operations towards the object file.

The following example implements a persistent object which has only one component which can be set/queried by the Value procedure/function.

   type Object is new OB.Persistant.Object with private;

   function Value( this : in Object ) return Integer;
   procedure Value( this : in out Object; value : in Integer );

Additionally contains the Package specification the procedures read/write which are required by the abstract type ASCL.OB.Persistant.Object.

   procedure Read(  this : in out Object; s : in Stream_Access );
   procedure Write( this : in out Object; s : in Stream_Access );

The following fragments shows how to use the Test.Persistent.Object data type defined previously:

First the components have to be invoked in the application:

   with ASCL.OB.Persistant;      use ASCL.OB.Persistant;
   with Test.Persistant;         use Test.Persistant;

Open the file where the objects will be stored in and assign the test class to the storage pool.

   Pool : Pool_ID;
 

   Pool := Open( "Objects", D);
   Add( Pool, Test.Persistant.Object'Tag );

Upon entering the context where the instances 1 and 2  of  Test.Persitant.Object are used the  following declaration will pop up the data of the objects. In the case below the first time, when the object is not reread from the object store, the Object 1 will be zero. Then the object will be set to one.

   declare
      O   : Test.Persistant.Object(1);
      P   : Test.Persistant.Object(2);
   begin

      .....

      if Value( O ) = 0 then
         Value( O, 1 );
      else
         Trace( D, "Value = " & Integer'Image( Value(O) ) );
      end if;

   end;

When leaving the context the objects 1 and 2 will be written back into the file assigned by the Add procedure above. When entering the context a second time, the trace output will be generated, because the object 1 is restored and the Value function will return one.
Upon termination of the application the object pool has to be written back to disk. This is done by calling the procedure close.

   Close( Pool );
 

Implementation Details

The object data is stored in two files. One file contains the list of all  objects identifiers and the corresponding locations in the data file where the actual object data is written to. The data file has the name <name.ob and the object table file the name <name.ot.

The  package is based upon the  Finalization type of Ada 95. Every time an instance of an persistent object type is created, the Initialize procedure of the package ASCL.OB.Persistant is called. This procedure checks if there is an object with the specified object identifier in the pool which belongs to the type available. If so, the data is read from the data file. If not a new entry is generated in the data file. Upon finalization the object data is written back to the data file.
 

Remarks

• The key information in this package is the object identification. In the example above explicit numbers are used. This should not be done. It is always a wise idea to use constants with reasonable names.
• The current status of this package is that it has been tested for the straight forward cases. Before using this package please try some tests. I will use the package in the future and there by remove most of the bugs, but if you find some bugs please inform me.
• Never forget the Close at the end. If you forget it, the object tree will not match any more the object data file. This will for sure corrupt your data.

Restrictions

Migration is not supported. This means if  layout of an persistent object changes, there will be no migration of the old data into the newer one! Normally you have to delete the object storage files which means all old data will be lost!
 
 

The Test package specification:

package Test.Persistant is

   type Object is new OB.Persistant.Object with private;

   function Value( this : in Object ) return Integer;
   procedure Value( this : in out Object; value : in Integer );

   procedure Read(  this : in out Object; s : in Stream_Access );
   procedure Write( this : in out Object; s : in Stream_Access );

private
   type Object_Data;
   type Object_Data_Access is access Object_Data;

   function Initialize return Object_Data_Access;

   type Object is new OB.Persistant.Object with record
         data : Object_Data_Access := Initialize;
      end record;

end Test.Persistant;
 

The test package body

with Ada.Exceptions;               use Ada.Exceptions;
with Unchecked_Deallocation;

with ASCL.Debugging_Support;
use  ASCL;
 

package body Test.Persistant is

   --|
   --| This is the instance of the component internal data.
   --|
   type Object_Data is record
         debug   : Debugging_Support.Handle := null;
         value   : Integer := 0;
      end record;

   function Initialize return Object_Data_Access is
      Result : Object_Data_Access := new Object_Data;
   begin
      return Result;
   end Initialize;

   ---=====================--------=============================---
   ---===       A T T R I B U T E    F U N C T I O N S       ===---
   ---==========================================================---
   function Value( this : in Object ) return Integer is
      data : Object_Data_Access := this.data;
   begin
      return data.value;
   end Value;
 

   procedure Value( this : in out Object; value : Integer ) is
      data : Object_Data_Access := this.data;
   begin
      data.value := value;
   end Value;

   ---=========================================================---
   ---===            M E T H O D S                          ===---
   ---=========================================================---
   procedure Read( this : in out Object; S : in Stream_Access ) is
      data : Object_Data_Access := this.data;
   begin
      if data = null then
         raise Not_Initialized;
      end if;

      Integer'Read( s, data.value );

   exception
      when The_Error : Others =
         Error( this, Exception_Identity( The_Error ), ".Read" );
         raise;
   end Read;
 

   procedure Write( this : in out Object; S : in Stream_Access ) is
      data : Object_Data_Access := this.Data;
   begin

      Integer'Write( s, data.value );

   exception
      when The_Error : Others =
         Error( this, Exception_Identity( The_Error ), ".Read" );
         raise;
   end Write;

end Test.Persistant;

ASCL.OB.Persistant

--|
--| Filename        : $Source:/home/......../RCS/ascl-ob-persistant.ads,v $
--| Description     : Persistant Objects Base Class
--| Author          : Michael Erdmann
--| Created On      : 25.3.1999
--| Last Modified By: $Author: erdmann $
--| Last Modified On: $Date: 1999/08/21 20:05:23 $
--| Status          : $State: Exp $
--|
--| Functional Description
--| ======================
--| Persistant objects are restored from a file upon instanciation
--| and automaticaly saved into the same file during finalization
--| of the instance.
--| In order to read and store an object from/into the file
--| the procedures Read and Write have to be supplied by the implementation
--| of the object.
--| The file which contains the data is opend by the Open call. It
--| returns a so called pool identifier.
--| Each derived type has to be assgined to such a pool by using
--| the Add method.
--|
--| Example:
--|    The example below shos the life cycle of a persistant object
--|    assuming, that Test.Persistant class has been drived from the
--|    persitant object class which supports the attribute functions
--|    Value.
--|
--|
--| procedure Main is
--|   Pool : Pool_ID;
--| begin
--|
--|   Pool := Open( "Objects", D);    -- Open the object sore
--|                                   -- Add an object clas to the pool
--|   Add( Pool, Test.Persistant.Object'Tag );
--|
--|   declare
--|      O   : Test.Persistant.Object(1);  -- Object 1
--|      P   : Test.Persistant.Object(2);  -- OBject 2
--|   begin
--|      if Value( O ) = 0 then
--|         Value( O, 1 );
--|      else
--|         Trace( D, "Value = " & Integer'Image( Value(O) ) );
--|      end if;
--|   end;
--|
--|   Close( Pool );                 -- close the storage
--|
--| End Main;
--|
--| Component Data
--| ==============
--| Object_ID      - Object identifier supplied by the application.
--|
--|
--| Error Handling
--| ==============
--|
--| Extension
--| =========
--|
--| Restrictions
--| ============
--| Tasking: yes/no
--| Y2K    :
--|
--| References
--| ==========
--| #$-DOCUMENT: Class specification -$#
--|
--| History
--| =======
--| $Log: persistent.html,v $
--| Revision 1.1 1999/08/21 20:05:23 erdmann
--| Initial revision
--|
--| Revision 1.5  1999/08/21 15:06:34  erdmann
--| Test finished
--|
--| Revision 1.4  1999/08/14 12:26:17  erdmann
--| No comments
--|
--| Revision 1.3  1999/08/08 16:22:00  erdmann
--| Test Version
--|
--| Revision 1.2  1999/08/08 09:51:55  erdmann
--| intermidiate version, dont use
--|
--| Revision 1.1  1999/08/04 20:05:27  erdmann
--| compiled & not tested
--|
--|
with Ada.Finalization;            use Ada.Finalization;
with Ada.Tags;                    use Ada.Tags;
with Ada.Streams.Stream_IO;       use Ada.Streams.Stream_IO;
with Ada.Finalization;            use Ada.Finalization;

with ASCL.Debugging_Support;
use  ASCL;
 

package ASCL.OB.Persistant is

   ---=====================================================================---
   ---===             C O M P O N E N T   I N T E R F A C E             ===---
   ---=====================================================================---
   type Object_ID is new Integer;

   type Object( this : Object_ID ) is abstract new Controlled with private;
   type Handle is access Object'Class;

   type Pool_ID is private;
   Pool_ID_Null : constant Pool_ID;
 

   ---=====================================================================---
   ---===                  A T T R I B U T E S                       ===---
   ---=====================================================================---

   ---------------------------------------------------------------------------
   --| Description    :
   --|      Query the Object identifier
   --| Preconditions  :
   --|      none
   --| Postconditions :
   --|      none
   --| Exceptions     :
   --| Note           :
   ---------------------------------------------------------------------------
   function Id( this : in Object'Class ) return Object_ID;

   ---=====================================================================---
   ---===                     M E T H O D S                             ===---
   ---=====================================================================---

   ---------------------------------------------------------------------------
   --| Description    :
   --|     Open a new object pool. This will create or open
   --|     the following files <name.ot and <name.ob. The function
   --|     returns a pool identifier which has to be used later
   --|     on in all pool related commands.
   --| Preconditions  :
   --|     The name has to be a valid file name.
   --| Postconditions :
   --| Exceptions     :
   --|     Out_of_Memory - Pool table full.
   --| Note           :
   ---------------------------------------------------------------------------
   function Open( name  : in String;
                  debug : in Debugging_Support.Handle := null ) return Pool_ID;

   ---------------------------------------------------------------------------
   --| Description    :
   --|    Close the named pool
   --| Preconditions  :
   --|    The Pool_ID has to be allocated previously by means of the
   --|    open call.
   --| Postconditions :
   --| Exceptions     :
   --| Note           :
   ---------------------------------------------------------------------------
   procedure Close( pool : in Pool_ID );

   ---------------------------------------------------------------------------
   --| Description    :
   --|    Add a class to a storage pool.
   --| Preconditions  :
   --|    The pool identified by the pool id has to be open.
   --| Postconditions :
   --| Exceptions     :
   --|    Out_Of_Memory    - No more classes possible
   --| Note           :
   ---------------------------------------------------------------------------
   procedure Add( pool  : in Pool_ID;
                  name  : in Tag;
                  debug : in Debugging_Support.Handle := null );

   ---=====================================================================---
   ---===                   E X T E N S I O N                           ===---
   ---=====================================================================---
   procedure Write( this : in out Object; stream : Stream_Access ) is abstract;
   procedure Read(  this : in out Object; stream : Stream_Access ) is abstract;

   ---=====================================================================---
private

   type Object( this : Object_ID ) is abstract new Controlled with record
         id      : Object_ID := this;
      end record;

   procedure Initialize( this : in out Object );
   procedure Finalize( this : in out Object );

   type Pool_ID is new Integer range 0..1024;

   Pool_ID_Null : constant Pool_ID := 0;

end ASCL.OB.Persistant;