package Ada_Store.User

with Ada_Store.Log;
with Ada_Store.Station;
with Ada_Store.Trading.Department;

package Ada_Store.User is

   type Instance 	is tagged private;

   type Identifier 	is new Natural;

   type Security is ( Manager, Supervisor, Office, Cashier );

   function  Lookup
     (User_ID : in Identifier)
      return Instance;

   procedure Create_New
     (User_ID         : in Identifier;
      Name            : in Short_Description;
      In_Department   : in Trading.Department.Identifier;
      Level           : in Security := Cashier);

   procedure Remove
     (User_ID : in Identifier);

   procedure Sign_On
     (User     : in Instance;
      Password : in String);

   procedure Sign_Off
     (User : in out Instance);

   function  Name
     (User : in Instance)
      return Short_Description;

   function  Department
     (User : in Instance)
      return Trading.Department.Identifier;

   function  Level
     (User : in Instance)
      return Security;

   function  Signed_On
     (User : in Instance)
      return Boolean;

   Invalid_Identifier  	: exception;
   Sign_On_Error        : exception;

   type User_Action	is ( Sign_On, Sign_Off, Forced_Off );
   
   type User_Log (Action : User_Action) is new Ada_Store.Log.Element
      with record
	 User_ID		: Identifier;
      end record;

   function To_String(Element : User_Log) return String;

private
   type Instance is tagged 
      record
	 User_ID       	: Identifier := 0;
	 Name		: Short_Description := (others => ' ');
	 Department     : Trading.Department.Identifier := 0;
	 Level		: Security := Cashier;
      end record;
  
end Ada_Store.User;

with Ada.Direct_IO;
with Ada.IO_Exceptions;

with Ada_Store.Log;
with Ada_Store.Support.Trace;

package body Ada_Store.User is

   -- internal

   package User_IO is new Ada.Direct_IO(Instance);
   use type User_IO.Count;

   Database_Name  : String := "Users.dat";
   Database_File  : User_IO.File_Type;

   Signed_On_User : Instance;

   procedure Database_Init is
   begin
      Support.Trace.Put("User.Database_Init Started");
      begin
	 User_IO.Open(Database_File,
		      User_IO.Inout_File,
		      Database_Name);
      exception
	 when Ada.IO_Exceptions.Name_Error =>
	    User_IO.Create(Database_File,
			   User_IO.Inout_File,
			   Database_Name);
      end;
      Support.Trace.Put("User.Database_Init Done");
   end Database_Init;

   function  Database_Lookup
     (User_ID : in Identifier)
      return User_IO.Positive_Count is

      Temp_User : Instance;
      Index     : User_IO.Positive_Count := 1;
   begin
      loop
	 User_IO.Read(Database_File,
		      Temp_User,
		      Index);

	 if Temp_User.User_ID = User_ID then

	    return Index;
	 end if;

	 Index := Index + 1;
      end loop;
   exception
      when Ada.IO_Exceptions.End_Error =>
	 raise Invalid_Identifier;
   end Database_Lookup;

   -- public
   function  Lookup
     (User_ID : in Identifier)
      return Instance is

      Temp_User : Instance;
      Index     : User_IO.Positive_Count;
   begin
      if User_ID = 0 then
	 raise Invalid_Identifier;
      end if;

      Index := Database_Lookup(User_ID);

      User_IO.Read(Database_File,
		   Temp_User,
		   Index);
      return Temp_User;
   end Lookup;
   
   procedure Create_New
     (User_ID         : in Identifier;
      Name            : in Short_Description;
      In_Department   : in Trading.Department.Identifier;
      Level           : in Security := Cashier) is

      Temp_Dept : Trading.Department.Instance;
      Temp_User : Instance;
   begin
      if User_ID = 0 then
	 raise Invalid_Identifier;
      end if;

      Temp_Dept := Trading.Department.Lookup(In_Department);

      Temp_User := (User_ID,
		    Name,
		    In_Department,
		    Level);

      User_IO.Write(Database_File,
		    Temp_User,
		    User_IO.Size(Database_File) + 1);
   end Create_New;

   procedure Remove
     (User_ID : in Identifier) is

      Temp_User : Instance := (0,
			       "*Deleted*         ",
			       0,
			       Cashier);
      Index : User_IO.Count;
   begin
      if User_ID = 0 then
	 raise Invalid_Identifier;
      end if;

      Index := Database_Lookup(User_ID);

      if Index = 0 then
	 raise Invalid_Identifier;
      end if;

      User_IO.Write(Database_File,
		    Temp_User,
		    Index);
   end Remove;

   procedure Sign_On
     (User     : in Instance;
      Password : in String) is

      Sign_On_Log		: User_Log (Sign_On);
   begin
      if Signed_On_User.User_ID /= 0 then
	 raise Sign_On_Error;
      end if;

      Signed_On_User := User;
	 
      Sign_On_Log.User_ID := User.User_ID;
      Ada_Store.Log.Put(Ada_Store.Log.Element'Class(Sign_On_Log));
   end Sign_On;

   procedure Sign_Off
     (User : in out Instance)
   is

      Sign_Off_Log	: User_Log (Sign_Off);
   begin
      if Signed_On_User.User_ID = 0 then
	 raise Sign_On_Error;
      end if;

      if User = Signed_On_User then
	 Signed_On_User.User_ID := 0;
	 
	 Sign_Off_Log.User_ID := User.User_ID;
	 Ada_Store.Log.Put(Ada_Store.Log.Element'Class(Sign_Off_Log));
      else
	 raise Invalid_Identifier;
      end if;
   end Sign_Off;
   
   function  Name
     (User : in Instance)
      return Short_Description is
   begin
      return User.Name;
   end Name;

   function  Department
     (User : in Instance)
      return Ada_Store.Trading.Department.Identifier is
   begin
      return User.Department;
   end Department;

   function  Level
     (User : in Instance)
      return Security is
   begin
      return User.Level;
   end Level;

   function  Signed_On
     (User : in Instance)
      return Boolean is
   begin
      return User = Signed_On_User;
   end Signed_On;

   function To_String(Element : User_Log) return String is
      Base_String : String := Log.To_String(Log.Element(Element));
   begin
      case Element.Action is
	 when Sign_On    => return Base_String & 
	   " - User " & Identifier'Image(Element.User_ID) & " Signed on.";
	 when Sign_Off   => return Base_String & 
	   " - User " & Identifier'Image(Element.User_ID) & " Signed off.";
	 when Forced_Off => return Base_String & 
	   " - User " & Identifier'Image(Element.User_ID) & " Forcably signed off.";
      end case;
   end To_String;

begin
   Database_Init;
end Ada_Store.User;

Contents Page

Copyright © 1996 Simon Johnston &
Addison Wesley Longman