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;
Copyright ©
1996 Simon Johnston &
Addison Wesley Longman