|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
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⟧
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;