DataMuseum.dk

top - download

    Length: 3640 (0xe38)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦bb25a46d4⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦bb25a46d4⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦bb25a46d4⟧ 
            └─⟦this⟧ 

TextFile

with LOG;
with PROFILE;
package body LOGGER is

   package CMVCE renames CMVC_IMPLEMENTATION_ERRORS;
   package DIR renames DIRECTORY;

   function FORMAT (S : in STRING) return STRING is
      OFFSET : constant := CHARACTER'POS ('a') - CHARACTER'POS ('A');
      RESULT : STRING (S'RANGE);
   begin
      for I in S'RANGE loop
         case S (I) is

            when 'A' .. 'Z' =>
               RESULT (I) := CHARACTER'VAL (CHARACTER'POS (S (I)) + OFFSET);

            when '_' =>
               RESULT (I) := ' ';

            when others =>
               RESULT (I) := S (I);
         end case;
      end loop;  
      return RESULT;
   end FORMAT;

   function STRIP (S : in STRING) return STRING is
      RESULT : STRING (S'RANGE) := S;
   begin
      for I in S'RANGE loop
         if S (I) not in ' ' .. '~' then
            RESULT (I) := ' ';
         end if;
      end loop;
      return RESULT;
   end STRIP;

   procedure STATUS (S : in SIMPLE_STATUS.CONDITION;  
                     INTERACTIVE : in BOOLEAN := FALSE) is
   begin
      case SIMPLE_STATUS.SEVERITY (S) is

         when SIMPLE_STATUS.NORMAL =>
            null;

         when SIMPLE_STATUS.WARNING =>
            if INTERACTIVE then
               DEBUG (SIMPLE_STATUS.DISPLAY_MESSAGE (S));
            else
               WARNING (SIMPLE_STATUS.DISPLAY_MESSAGE (S));
            end if;

         when SIMPLE_STATUS.PROBLEM =>
            NEGATIVE (SIMPLE_STATUS.DISPLAY_MESSAGE (S));

         when SIMPLE_STATUS.FATAL =>
            ERROR (SIMPLE_STATUS.DISPLAY_MESSAGE (S));
      end case;
   end STATUS;

   procedure STATUS (S : in DIRECTORY.ERROR_STATUS) is
      use DIR;
   begin
      if S /= DIR.SUCCESSFUL then
         LOGGER.ERROR ("Directory operation failed because of " &
                       FORMAT (DIR.ERROR_STATUS'IMAGE (S)));
      end if;
   end STATUS;

   procedure STATUS (S : in DIRECTORY.NAMING.NAME_STATUS) is
      use DIR.NAMING;
   begin
      if S /= DIR.NAMING.SUCCESSFUL then
         LOGGER.ERROR ("Name resolution failed because of " &
                       FORMAT (DIR.NAMING.NAME_STATUS'IMAGE (S)));
      end if;
   end STATUS;

   procedure STATUS (S : in CMVC_STATUS) is
   begin
      if CMVCE.IS_BAD (S) then
         LOGGER.ERROR (CMVCE.MESSAGE (S));
      end if;
   end STATUS;


   procedure AUXILIARY (MESSAGE : in STRING) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.AUXILIARY_MSG);
   end AUXILIARY;

   procedure DEBUG (MESSAGE : in STRING) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.DEBUG_MSG);
   end DEBUG;

   procedure NEGATIVE (MESSAGE : in STRING; RAISE_ERROR : in BOOLEAN := TRUE) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.NEGATIVE_MSG);
      if RAISE_ERROR then
         raise PROFILE.ERROR;
      end if;
   end NEGATIVE;

   procedure ERROR (MESSAGE : in STRING; RAISE_ERROR : in BOOLEAN := TRUE) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.ERROR_MSG);
      if RAISE_ERROR then
         raise PROFILE.ERROR;
      end if;
   end ERROR;

   procedure NOTE (MESSAGE : in STRING) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.NOTE_MSG);
   end NOTE;

   procedure POSITION (MESSAGE : in STRING) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.POSITION_MSG);
   end POSITION;

   procedure POSITIVE (MESSAGE : in STRING) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.POSITIVE_MSG);
   end POSITIVE;

   procedure WARNING (MESSAGE : in STRING) is
   begin
      LOG.PUT_LINE (STRIP (MESSAGE), KIND => PROFILE.WARNING_MSG);
   end WARNING;

end LOGGER;