-------- SIMTEL20 Ada Software Repository Prologue ------------
-- -*
-- Unit name : MESSAGE_IO
-- Version : 1.0
-- Author : Patrick Kopson
-- : Texas Instruments
-- :
-- :
-- DDN Address : WOODY%TI-EG@CSNET-RELAY
-- Copyright : (c) 1985
-- Date created : 01 APR 85
-- Release date : 03 DEC 85
-- Last update : 03 DEC 85
-- Machine/System Compiled/Run on : VAX 11/785 VMS 4.1
-- DEC Ada
-- -*
---------------------------------------------------------------
-- -*
-- Keywords : Text_Messages
----------------:
--
-- Abstract :
-- This package is used for sending messages to the defaut
-- output file. See the visible part for the details of the
-- structure of the messages. Minor changes to this package
-- (including making the length of certain fields generic
-- parameters) would make this package much more versatile.
----------------:
-- -*
------------------ Revision history ---------------------------
-- -*
-- DATE VERSION AUTHOR HISTORY
-- 12/3/85 1.0 Patrick Kopson Initial Release
-- -*
------------------ Distribution and Copyright -----------------
-- -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
-- software released to the Public Domain is not subject
-- to copyright protection).
-- Restrictions on use or distribution: NONE
-- -*
------------------ Disclaimer ---------------------------------
-- -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered. The user is advised to
-- test the software thoroughly before relying on it. The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
-- -*
-------------------END-PROLOGUE--------------------------------
package MESSAGE_IO is
-------------------------------------------------------------------------------
---- ----
-- VISIBLE TYPE DECLARATIONS --
---- ----
-------------------------------------------------------------------------------
-- Type Declarations for module name abbreviations:
type Character_Type is ( 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
'Y', 'Z', '_' );
--| Allowable characters for module names and message id's
Name_Length : constant := 6;
--| Largest number of characters per module name abbreviation
type Name_Range_Type is range 1 .. Name_Length;
--| Type for length of module name abbreviations
type Name_Array_Type is array ( Name_Range_Type ) of Character_Type;
--| Type for module name abbreviations
-- Type Declarations for message id's:
Max_Message_Id : constant := 8;
--| Largest number of characters per message id
type Message_Id_Range_Type is range 1 .. Max_Message_Id;
--| Type for lengths of message id's
type Message_Id_Array_Type is
array ( Message_Id_Range_Type ) of Character_Type;
--| Type for message id's
-- Type Declarations for priority kinds:
type Priority_Kind_Type is ( Alevel, Slevel, Tell_All );
--| Each message must have one of these priority kinds associated with it
subtype Priority_Kind_Constrained_Type is
Priority_Kind_Type range Alevel .. Slevel;
--| Constrained type of priority kinds for defining priority levels
-- Type Declarations for text line extensions:
Text_Array_Length : constant := 32767;
--| Largest number of text lines allowed
Text_Line_Length : constant := 72;
--| Largest number of characters per line of text
subtype Text_Line_Type is string ( 1 .. Text_Line_Length );
--| Type for text lines
type Text_Array_Length_Type is range 0 .. Text_Array_Length;
--| Type for length of text array
type Text_Array_Type
is array ( Text_Array_Length_Type range <> ) of Text_Line_Type;
--| Type for text line extensions
Null_Text_Array : constant Text_Array_Type ( 1 .. 0 ) :=
( 1 .. 0 => ( 1 .. Text_Line_Length => ' ' ) );
--| Constant for null text lines
-- Type Declarations for progress report headline
-- and message structure line:
Required_Text_Line_Length : constant := 40;
--| Maximum length for required text line
subtype Required_Text_Line_Type is string ( 1 .. Required_Text_Line_Length );
--| Type for required text line
type Severity_Level is ( Note, Warning, Error, Failure );
-------------------------------------------------------------------------------
---- ----
-- PACKAGE ENTRY POINTS --
---- ----
-------------------------------------------------------------------------------
procedure DISPLAY_PROGRESS ( Report_Title : in Required_Text_Line_Type;
Report_Text : in Text_Array_Type
:= Null_Text_Array;
Priority : in Severity_Level := Failure );
--| OVERVIEW
--| When the priority of the progress message, given by Priority, is
--| higher than or equal to the lowest priority defined for the Slevel
--| priority kind, this procedure outputs to the message file the
--| progress report headline given by Report_Title, the wall clock date
--| and time, and if specified, the optional extension text given by
--| Report_Text.
--| REQUIRES
--| The message file must be open.
--| EFFECTS
--| The report title, wall clock date and time is written to the
--| message file. The report text is selected for output, when
--| specified, when the priority is higher than or equal to the
--| lowest priority defined for the Slevel priority kind. The
--| format of the report output is the following:
--|
--| CONTROL: <report_title> hh:mm:ss dd-MMM-yyyy
--|
--| o [ . ]
--| p [ . ]
--| t [ . ]
--| i [ . . . <report_text> . . . ]
--| o [ . ]
--| n [ . ]
--| a [ . ]
--| l [ . ]
--|
--| RAISES
--| MSIO_MESSAGE_FILE_DISASTER
--| ERRORS
--| If the message file has not been opened, or if the capacity
--| of the message file has been exceeded, or if the output
--| operation could not be completed because of a malfunction
--| of the underlying system, then the exception
--| MSIO_MESSAGE_FILE_DISASTER will be raised.
--| NA
--| MODIFIES
procedure DISPLAY_MSG
( Module_Abbr : in Name_Array_Type;
Message_Id : in Message_Id_Array_Type;
Message_Text_Standard : in Required_Text_Line_Type;
Message_Text_Addition : in Text_Array_Type := Null_Text_Array;
Priority_Kind : in Priority_Kind_Type := Tell_All;
Priority : in Severity_Level := Note );
--| OVERVIEW
--| When the priority of the message given by Priority, is higher than
--| or equal to the lowest priority defined for the priority kind given
--| by Priority_Kind, this procedure outputs to the message file the
--| module abbreviation given by Module_Abbr, the message
--| identification given by Message_Id, the structure line, which
--| contains the required portion of the message, given by
--| Message_Text_Standard, and if specified, the optional extension
--| text given by Message_Text_Addition.
--| REQUIRES
--| The message file must be open.
--| EFFECTS
--| The module abbreviation, the message identification, the
--| priority, and the standard message text are output to the
--| message file. Messages with priority higher than or equal
--| to the lowest priority level defined for a particilar
--| priority kind are selected for output to the output file.
--| If the lowest priority is not defined, then all messages
--| will be output. If the priority kind, given by Priority_Kind,
--| is Tell_All, then the given message is output regardless of
--| priority. The format of the message output looks like the
--| following:
--|
--| <module_abbr> - <priority> - <message_id> <message_text_standard>
--|
--| o [ . ]
--| p [ . ]
--| t [ . ]
--| i [ . . . <message_text_addition> . . . ]
--| o [ . ]
--| n [ . ]
--| a [ . ]
--| l [ . ]
--|
--| RAISES
--| MSIO_MESSAGE_FILE_DISASTER
--| ERRORS
--| If the message file has not been opened, or if the capacity
--| of the message file has been exceeded, or if the output
--| operation could not be completed because of a malfunction
--| of the underlying system, then the exception
--| MSIO_MESSAGE_FILE_DISASTER will be raised.
--| NA
--| MODIFIES
procedure DEFINE_LOWEST_PRIORITY
( Priority_Kind : in Priority_Kind_Constrained_Type;
Priority_Level : in Severity_Level );
--| OVERVIEW
--| This procedure allows the lowest reportable message priority,
--| given by Priority_Level, to be defined for a priority kind,
--| given by Priority_Kind.
--| EFFECTS
--| The lowest priority for a priority kind is defined.
--| NA
--| REQUIRES, RAISES, ERRORS
procedure CLOSE_MESSAGE_FILE;
--| OVERVIEW
--| This procedure closes the message file.
--| REQUIRES
--| The message file must be open.
--| EFFECTS
--| A message indicating that the message file is closed
--| is written to the message file, then the message file
--| is closed.
--| RAISES
--| MSIO_MESSAGE_FILE_DISASTER
--| ERRORS
--| If the message file is not open, then the exception
--| MSIO_MESSAGE_FILE_DISASTER will be raised.
--| NA
--| MODIFIES
-- Exceptions raised by Message file I/O package
MSIO_MESSAGE_FILE_DISASTER : exception;
end MESSAGE_IO;
-------------------------------------------------------------------------------
---- ----
-- MESSAGE I/O PACKAGE BODY --
---- ----
-------------------------------------------------------------------------------
with TEXT_IO;
with CALENDAR;
package body MESSAGE_IO is
-------------------------------------------------------------------------------
---- ----
-- INTERNAL TYPES AND OBJECTS --
---- ----
-------------------------------------------------------------------------------
subtype Date_And_Time_Type is STRING (1 .. 22);
type Priority_Array_Type is
array (Priority_Kind_Constrained_Type) of Severity_Level;
Lowest_Priority_Array : Priority_Array_Type
:= (Severity_Level'First, Severity_Level'First);
File_Is_Closed : BOOLEAN := false;
-------------------------------------------------------------------------------
---- ----
-- INTERNAL PROCEDURES --
---- ----
-------------------------------------------------------------------------------
function Character_Equivalent_Of
(Char : in Character_Type) return Character is
--| OVERVIEW
--| This function returns the character equivalent of an item of
--| type Character_Type.
--|
--| ALGORITHM
--| Use Char as an index to an array of characters to select the result.
type Character_Array_Type is array (Character_Type) of Character;
Character_Array : Character_Array_Type := ('A', 'B', 'C', 'D', 'E', 'F', 'G',
'H', 'I', 'J', 'K', 'L', 'M', 'N',
'O', 'P', 'Q', 'R', 'S', 'T', 'U',
'V', 'W', 'X', 'Y', 'Z', '_');
begin
return Character_Array (Char);
end Character_Equivalent_Of;
function Date_And_Time return Date_And_Time_Type is
--| OVERVIEW
--| This function returns the date and time from the wall clock
--| as a STRING so that TEXT_IO can write it to the message file.
--|
--| EFFECTS
--| The date and time are returned as a string with the following format:
--| " hh:mm:ss dd-MMM-yyy".
--|
--| NA
--| REQUIRES, ERRORS, RAISES, MODIFIES
--|
--| ALGORITHM
--| After getting the Year, Month, Day and Seconds from CALENDAR
--| subprograms, derive Hour, Minute and Sec from Seconds.
--| Then insert the images of these values into the result string.
Result : STRING(1 .. 22) := " hh:mm:ss dd-MMM-yyyy";
Seconds_Per_Minute : constant := 60;
Seconds_Per_Hour : constant := 3600;
subtype Hour_Number is INTEGER range 0 .. 23;
subtype Minute_Number is INTEGER range 0 .. 59;
subtype Sec_Number is INTEGER range 0 .. 59;
Date : CALENDAR.Time;
Year : CALENDAR.Year_Number;
Month : CALENDAR.Month_Number;
Day : CALENDAR.Day_Number;
Seconds : CALENDAR.Day_Duration;
Hour : Hour_Number;
Minute : Minute_Number;
Sec : Sec_Number;
begin
Date := CALENDAR.Clock;
CALENDAR.Split (Date,
Year,
Month,
Day,
Seconds);
Hour := INTEGER(Seconds) / Seconds_Per_Hour;
Seconds := CALENDAR.Day_Duration (INTEGER(Seconds) rem Seconds_Per_Hour);
Minute := INTEGER(Seconds) / Seconds_Per_Minute;
Sec := INTEGER(Seconds) rem Seconds_Per_Minute;
Result(18 .. 22) := CALENDAR.Year_Number'IMAGE (Year);
Result(18) := '-';
case Month is
when 1 => Result(15 .. 17) := "JAN";
when 2 => Result(15 .. 17) := "FEB";
when 3 => Result(15 .. 17) := "MAR";
when 4 => Result(15 .. 17) := "APR";
when 5 => Result(15 .. 17) := "MAY";
when 6 => Result(15 .. 17) := "JUN";
when 7 => Result(15 .. 17) := "JUL";
when 8 => Result(15 .. 17) := "AUG";
when 9 => Result(15 .. 17) := "SEP";
when 10 => Result(15 .. 17) := "OCT";
when 11 => Result(15 .. 17) := "NOV";
when 12 => Result(15 .. 17) := "DEC";
end case;
if (Day < 10) then
Result(12 .. 13) := CALENDAR.Day_Number'IMAGE (Day);
Result(12) := '0';
else
Result(11 .. 13) := CALENDAR.Day_Number'IMAGE (Day);
end if;
if (Sec < 10) then
Result(8 .. 9) := Sec_Number'IMAGE (Sec);
Result(8) := '0';
else
Result(7 .. 9) := Sec_Number'IMAGE (Sec);
Result(7) := ':';
end if;
if (Minute < 10) then
Result(5 .. 6) := Minute_Number'IMAGE (Minute);
Result(5) := '0';
else
Result(4 .. 6) := Minute_Number'IMAGE (Minute);
Result(4) := ':';
end if;
if (Hour < 10) then
Result(2 .. 3) := Hour_Number'IMAGE (Hour);
Result(2) := '0';
else
Result(1 .. 3) := Hour_Number'IMAGE (Hour);
end if;
return Result;
end Date_And_Time;
-------------------------------------------------------------------------------
---- ----
-- PACKAGE ENTRY POINTS --
---- ----
-------------------------------------------------------------------------------
procedure DISPLAY_PROGRESS
( Report_Title : in Required_Text_Line_Type;
Report_Text : in Text_Array_Type := Null_Text_Array;
Priority : in Severity_Level := Failure ) is
--| OVERVIEW
--| If the priority (Priority) is higher than or equal to the lowest
--| priority defined for the Slevel priority kind, this procedure
--| outputs the progress report headline (Report_Title) and the wall
--| clock date and time to the message file on one line with the
--| optional extension text (Report_Text), if specified, on following
--| lines.
--|
--| ALGORITM
--| . . .
begin
if File_Is_Closed then
TEXT_IO.PUT
("***** MESSAGE_IO.Display_Progress called with file closed.");
raise MSIO_MESSAGE_FILE_DISASTER;
end if;
if ( Priority >= Lowest_Priority_Array(Slevel) ) then
TEXT_IO.PUT ("CONTROL: ");
TEXT_IO.PUT (Report_Title);
TEXT_IO.PUT (" ");
TEXT_IO.PUT (Date_And_Time);
TEXT_IO.NEW_LINE;
for Line in Report_Text'RANGE(1) loop
TEXT_IO.PUT (" ");
TEXT_IO.PUT ( Report_Text(Line) );
TEXT_IO.NEW_LINE;
end loop;
end if;
exception
when others => raise MSIO_MESSAGE_FILE_DISASTER;
end DISPLAY_PROGRESS;
procedure DISPLAY_MSG
( Module_Abbr : in Name_Array_Type;
Message_Id : in Message_Id_Array_Type;
Message_Text_Standard : in Required_Text_Line_Type;
Message_Text_Addition : in Text_Array_Type := Null_Text_Array;
Priority_Kind : in Priority_Kind_Type := Tell_All;
Priority : in Severity_Level := Note ) is
--| OVERVIEW
--| If the priority (Priority) is higher than or equal to the lowest
--| priority defined for the priority kind (Priority_Kind), this
--| procedure outputs the module abbreviation (Module_Abbr), the
--| priority (Priority), the message identification (Message_Id), and
--| the structure line which contains the required portion of the
--| message (Message_Text_Standard) to the message file on one line,
--| with the optional extension text (Message_Text_Addition), if
--| specified, on following lines.
--|
--| NOTES
--| The Lowest_Priority for each priority kind is initialized
--| to the lowest possible value; so there is no need to check
--| whether it is undefined (indicating that we should write the
--| message regardless of the priority).
--|
--| ALGORITHM
--| After writing the Module_Abbr, Priority, Message_ID and
--| Message_Text_Standard, we check the Priority and Priority_Kind
--| to determine whether we must write the Message_Text_Addition.
begin
if File_Is_Closed then
TEXT_IO.PUT ("***** MESSAGE_IO.Display_Msg called with file closed.");
raise MSIO_MESSAGE_FILE_DISASTER;
end if;
if ( Priority_Kind = Tell_All ) or else
( Priority >= Lowest_Priority_Array(Priority_Kind) ) then
for Char in Module_Abbr'RANGE loop
TEXT_IO.PUT ( Character_Equivalent_Of(Module_Abbr(Char)) );
end loop;
TEXT_IO.PUT (" - ");
case Priority is
when Note => TEXT_IO.PUT ( "NOTE" );
when Warning => TEXT_IO.PUT ( "WARNING" );
when Error => TEXT_IO.PUT ( "ERROR" );
when Failure => TEXT_IO.PUT ( "FAILURE" );
when others => TEXT_IO.PUT ( "OTHER" );
end case;
TEXT_IO.PUT (" - ");
for Char in Message_ID'RANGE loop
TEXT_IO.PUT ( Character_Equivalent_Of(Message_ID(Char)) );
end loop;
TEXT_IO.PUT (" - ");
TEXT_IO.PUT (Message_Text_Standard);
TEXT_IO.NEW_LINE;
for Line in Message_Text_Addition'RANGE(1) loop
TEXT_IO.PUT (" ");
TEXT_IO.PUT ( Message_Text_Addition(Line) );
TEXT_IO.NEW_LINE;
end loop;
end if;
exception
when others => raise MSIO_MESSAGE_FILE_DISASTER;
end DISPLAY_MSG;
procedure DEFINE_LOWEST_PRIORITY
( Priority_Kind : in Priority_Kind_Constrained_Type;
Priority_Level : in Severity_Level ) is
--| OVERVIEW
--| This procedure allows the lowest reportable message priority,
--| given by Priority_Level, to be defined for a priority kind,
--| given by Priority_Kind.
--|
--| ALGORITHM
--| Set the specified lowest_priprity to Priority_Level
begin
Lowest_Priority_Array (Priority_Kind) := Priority_Level;
exception
when others => raise MSIO_MESSAGE_FILE_DISASTER;
end DEFINE_LOWEST_PRIORITY;
procedure CLOSE_MESSAGE_FILE is
--| OVERVIEW
--| This procedure closes the message file.
--|
--| NOTES
--| The standard output file can not be closed!
--| Therefore, this procedure will write a closing message
--| (including the wall clock date and time) to the message file
--| and then quit.
--|
--| ALGORITHM
--| Write a closing message to the file.
--| Close the default output file if possible.
Close_File : TEXT_IO.File_Type;
begin
TEXT_IO.PUT ("Mesage File closed at ");
TEXT_IO.PUT (Date_And_Time);
TEXT_IO.NEW_LINE;
File_Is_Closed := true;
exception
when others => raise MSIO_MESSAGE_FILE_DISASTER;
end CLOSE_MESSAGE_FILE;
end MESSAGE_IO;