-------- 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: hh:mm:ss dd-MMM-yyyy --| --| o [ . ] --| p [ . ] --| t [ . ] --| i [ . . . . . . ] --| 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: --| --| - - --| --| o [ . ] --| p [ . ] --| t [ . ] --| i [ . . . . . . ] --| 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;