with Ada.Text_Io;
use Ada;
package body Alphabetic is
function Image(Alphabetic : in Alphabetic_Type'Class) return String is
begin
return Alphabetic.Object.Value.all;
end Image;
procedure Print(Alphabetic : in Alphabetic_Type'Class) is
begin
Text_Io.Put( Alphabetic.Object.Value.all);
end print;
function Get_Hidden return String is
Buffer, Line : String_Access := new String ' ("" );
begin
loop
loop
declare
Char : Character;
begin
Text_Io.Get_Immediate(Char);
case Char is
when Character'Val(10) =>
Text_Io.New_Line;
return Line.all;
when Character'Val(127) =>
Buffer := new String ' (Line(Line'First..Line'Last-1));
when others =>
Buffer := new String ' (Line.all & Char);
end case;
exit;
exception
when Text_Io.End_Error =>
null;
end;
end loop;
Free(Line);
Line := new String ' (Buffer.all);
Free(Buffer);
end loop;
end Get_Hidden;
function Get_Visible return String is
Buffer, Line : String_Access := new String ' ("" );
begin
loop
loop
declare
Char : Character;
begin
Text_Io.Get_immediate(Char);
case Char is
when Character'Val(10) =>
Text_Io.New_Line;
return Line.all;
when Character'Val(127) =>
Buffer := new String ' (Line(Line'First..Line'Last-1));
Text_Io.Put(Character'Val(8) & ' ' & Character'Val(8));
when others =>
Buffer := new String ' (Line.all & Char);
Text_Io.Put(Char);
end case;
exit;
exception
when Text_Io.End_Error =>
null;
end;
end loop;
Free(Line);
Line := new String ' (Buffer.all);
Free(Buffer);
end loop;
end Get_visible;
procedure Initialize(Alphabetic : in out Alphabetic_Type'Class;Hidden : in Boolean) is
begin
if not Hidden then
Alphabetic.Object := new String_handle_Type ' (Virtual.Virtual_type with Value => new String ' (Get_visible));
else
Alphabetic.Object := new String_handle_Type ' (Virtual.Virtual_type with Value => new String ' (Get_hidden));
end if;
end Initialize;
procedure Adjust(Alphabetic : in out Alphabetic_Type'Class;Hidden : in Boolean) is
begin
null;
end Adjust;
procedure Finalize(Alphabetic : in out Alphabetic_Type'Class) is
begin
null;
end Finalize;
end Alphabetic;
with Virtual;
with Objects;
with Ada.Unchecked_Deallocation;
package Alphabetic is
type Alphabetic_Type is new Virtual.Virtual_type with private;
procedure Initialize(Alphabetic : in out Alphabetic_Type'Class;Hidden : in Boolean);
procedure Adjust(Alphabetic : in out Alphabetic_Type'Class;Hidden : in Boolean);
procedure Finalize(Alphabetic : in out Alphabetic_Type'Class);
procedure print(Alphabetic : in Alphabetic_Type'Class);
function Image(Alphabetic : in Alphabetic_Type'Class) return String;
private
type String_Access is access all String;
procedure Free is new Ada.Unchecked_Deallocation(String,
String_Access);
type String_Handle_Type Is new Virtual.Virtual_Type with
record
Value : String_Access;
end record;
package Strings_Object is new Objects(2, String_Handle_Type);
type Alphabetic_Type is new Virtual.Virtual_type with
record
Object : Strings_Object.Object_Access;
end record;
end Alphabetic;
with Ada.Text_Io;
use Ada;
package body Full_Names is
procedure Initialize(Full_Name : in out Full_Name_Type) is
begin
Text_Io.Put("Full name: " );
Full_Name.name := new Info.Info_Type(True, False);
end Initialize;
procedure print(Full_Name : in Full_Name_Type'class) is
begin
Info.Print(Full_Name.Name.All);
end Print;
function Image(Full_Name : in Full_Name_Type'Class) return String is
begin
return Full_Name.Name.Image;
end Image;
end Full_Names;
with Ada.Finalization;
with Info;
package Full_Names is
type Full_Name_Type is new Ada.Finalization.Limited_Controlled with Private;
procedure Initialize(Full_Name : in out Full_Name_Type);
private
type Info_Access is access Info.Info_Type'Class;
type Full_Name_Type is new Ada.Finalization.Limited_Controlled with
record
Name : Info_Access;
end record;
procedure print(Full_Name : in Full_Name_Type'class);
function Image(Full_Name : in Full_Name_Type'Class) return String;
end Full_Names;
with Ada.Text_Io;
use Ada;
package body Humans is
procedure Initialize(Human : in out Human_Type'Class) is
begin
Human.password.Initialize;
end Initialize;
procedure Print(Human : in Human_Type'Class) is
begin
Human.password.Print;
end Print;
end Humans;
with Ada.Finalization;
--with Full_Names;
--with Lognames;
with Passwords;
package Humans is
type Attribut_Name_Type is (Full_Name,
Logname,
Password,
Groups,
Home,
Interpreter,
Phone_Number,
Address,
Language,
Email);
type Human_Type is new Ada.Finalization.Limited_Controlled with private;
procedure Print(Human : in Human_Type'Class);
procedure Initialize(Human : in out Human_Type'Class);
private
type Human_Type is new Ada.Finalization.Limited_Controlled with
record
password : Passwords.Password_Type;
--Full_Name : Full_Names.Full_Name_Type;
end record;
end Humans;
package body Info is
function Image(Info : in Info_Type'Class) return String is
begin
return Alphabetic.Image(Info);
end Image;
procedure Print(Info : in Info_Type'Class) is
begin
if not Info.Hidden then
Alphabetic.Print(Info);
end if;
end Print;
procedure Initialize(Info : in out Info_Type) is
begin
Alphabetic.Alphabetic_Type(Info).Initialize(Info.Hidden);
end Initialize;
procedure Adjust(Info : in out Info_Type) is
begin
Alphabetic.Alphabetic_Type(Info).Adjust(Info.Hidden);
end Adjust;
procedure Finalize(Info : in out Info_Type) is
begin
Alphabetic.Alphabetic_Type(Info).Finalize;
end Finalize;
end Info;
with Virtual;
with Alphabetic;
package Info is
type Info_Type(Auto : Boolean;Hidden : Boolean) is tagged private;
procedure Print(Info : in Info_Type'Class);
function Image(Info : in Info_Type'Class) return String;
private
type Info_Type(Auto : Boolean;Hidden : Boolean) is new Alphabetic.Alphabetic_Type with null record;
procedure Initialize(Info : in out Info_Type);
procedure Adjust(Info : in out Info_Type);
procedure Finalize(Info : in out Info_Type);
end Info;
with Ada.Text_Io;
use Ada;
package body Lognames is
procedure Initialize(Logname : in out Logname_Type) is
begin
if Logname.Full_Name.Image = "" then
raise Program_Error;
end if;
Text_Io.Put("Logname: " );
Logname.logname := new Info.Info_Type(True, False);
end Initialize;
procedure print(Logname : in Logname_Type'class) is
begin
Logname.Full_Name.Print;
Info.Print(Logname.Logname.All);
end Print;
function Image(Logname : in Logname_Type'Class) return String is
begin
return Logname.Logname.Image;
end Image;
end Lognames;
with Full_Names;
with Ada.Finalization;
with Info;
package Lognames is
type Logname_Type is new Ada.Finalization.Limited_Controlled with private;
procedure Initialize(Logname : in out Logname_Type);
private
type Info_Access is access Info.Info_Type'Class;
type Logname_Type is new Ada.Finalization.Limited_Controlled with
record
Logname : Info_Access;
Full_Name : Full_names.Full_Name_Type;
end record;
procedure print(Logname : in Logname_Type'class);
function Image(Logname : in Logname_Type'Class) return String;
end lognames;
with System.Storage_Elements;
use System;
with Virtual;
generic
Max_Element : Storage_Elements.Storage_Count := 2;
type object_Type is new Virtual.Virtual_Type with private;
package Objects is
type Object_Access is access all Object_Type'Class;
end Objects;
with Ada.Text_Io;
use Ada;
package body Passwords is
procedure Initialize(Password : in out Password_Type) is
begin
if Password.Logname.Image = "" then
raise Program_Error;
end if;
Text_Io.Put("Password: " );
Password.Password := new Info.Info_Type(True, True);
end Initialize;
procedure print(Password : in Password_Type'class) is
begin
Password.Logname.Print;
Info.Print(Password.Password.All);
end Print;
function Image(Password : in Password_Type'Class) return String is
begin
return Password.Password.Image;
end Image;
end Passwords;
with Lognames;
with Ada.Finalization;
with Info;
package Passwords is
type Password_Type is new Ada.Finalization.Limited_Controlled with private;
procedure Initialize(Password : in out Password_Type);
private
type Info_Access is access Info.Info_Type'Class;
type Password_Type is new Ada.Finalization.Limited_Controlled with
record
Password : Info_Access;
Logname : Lognames.Logname_Type;
end record;
procedure print(Password : in Password_Type'class);
function Image(Password : in Password_Type'Class) return String;
end passwords;
with Ada.Finalization;
package Virtual is
type Virtual_Type is abstract new Ada.Finalization.Controlled with null record;
end Virtual;
![[:caudacien:3]](https://forum-images.hardware.fr/images/perso/3/caudacien.gif "[:caudacien:3]")
