Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/msgio.ada

Text File | 1988-05-03 | 24.5 KB | 613 lines

-------- 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;