-- with system, text_io, calendar, GLOBAL_CONSTANTS, LOGICAL_NAME_PROCESSOR; use text_io, calendar, GLOBAL_CONSTANTS, LOGICAL_NAME_PROCESSOR; with DYNAMIC_STRING, ENVIRONMENT_CONTROL, COMMAND_PARSER, FILE_ACCESS; use DYNAMIC_STRING, ENVIRONMENT_CONTROL, COMMAND_PARSER, FILE_ACCESS; with SYSTEM_LIBRARY, MISC_ROUTINES; use SYSTEM_LIBRARY, MISC_ROUTINES; -- package body COMMAND_PROCESSOR is --+---------------------------------------------------------------------- -- -- Unit Type : PACKAGE BODY -- Unit Name : COMMAND_PROCESSOR -- Version : V01.0F -- -- Author : Stephen R. Rainier Date : 11/25/85 -- -- Purpose : To execute the basic APSE commands. -- -- Parameters : -- -- Name Mode(I,O,IO) Type/Subtype Description -- ---- ------------ ------------ ------------ -- CMD IO COMMAND_BLOCK command info -- ENV_BLK IO ENVIRONMENT_BLOCK status info -- -- Modifications : -- -- Name Date Description of Change -- ---- ---- --------------------- -- -- -- Packages "WITH"ed : system, DYNAMIC_STRING, ENVIRONMENT_CONTROL, -- COMMAND_PARSER, FILE_ACCESS, text_io, calendar, -- GLOBAL_CONSTANTS, LOGIGAL_NAME_PROCESSOR, -- SYSTEM_LIBRARY, MISC_ROUTINES -- -- Procedure/Function "CALL"s : COMMAND_EXECUTE, CONFIG_EXECUTE -- CREATE_SOURCE -- -- Exceptions : -- -- Name Handled/Raised Description -- ---- -------------- ----------- -- name_error H non-existent file -- FILE_UNAVAILABLE H/R file already checked out -- DATA_FILE_ERROR R missing or bad file -- ACE_ERROR H ACL entry error -- -- Side Effects : -- -- -- Comments : -- --%---------------------------------------------------------------------- -- -- Local (Invisible) Declarations -- FILE_UNAVAILABLE : exception; procedure CREATE_SOURCE(FILE : in out DYN_STRING; EXT : in out DYN_STRING; UNIT_ID : in string; DIR : in string) is separate; function CHECK_OUT(FILE : in DYN_STRING; TEST_BED_DIR : in string; DEST : in string := ""; SET_FLAG : in boolean := false) return boolean is NEW_LOG_FILE, LOG_FILE : file_type; FOUND_FLAG, SKIP_FLAG : boolean := false; COUNT : integer := 0; LINE, LOC : DYN_STRING; CHAR : character; TIM_STR : DYN_STRING := D_STRING(""); CURRENT_TIME : time; SECS : day_duration; DAYS, MONS, YRS, HRS, MINS : string(1..2); begin LOC := D_STRING(TEST_BED_DIR); open(LOG_FILE, IN_FILE, STR(LOC) & CHECKOUT_FILE); reset(LOG_FILE); if SET_FLAG then -- need to create new version to update -- create(NEW_LOG_FILE, OUT_FILE, STR(LOC) & CHECKOUT_FILE); ASCII_TIME(YRS, MONS, DAYS, HRS, MINS); TIM_STR:=D_STRING(MONS & "/" & DAYS & "/" & YRS & " " & HRS & ":" & MINS); put_line(NEW_LOG_FILE, CHK_OUT_HDR_ONE & STR(LOC) & "]"); put_line(NEW_LOG_FILE, CHK_OUT_HDR_TWO & STR(TIM_STR)); new_line(NEW_LOG_FILE,1); end if; while not end_of_file(LOG_FILE) loop -- read the old log file -- LINE := D_STRING(""); CHAR := ' '; SKIP_FLAG := false; while not end_of_line(LOG_FILE) loop -- line by line -- get(LOG_FILE,CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(LOG_FILE); if (LENGTH(LINE) = 0) or (INDEX(LINE,D_STRING(CHK_OUT_HDR_ONE),1) >= 1) or (INDEX(LINE,D_STRING(CHK_OUT_HDR_TWO),1) >= 1) then -- skip over HDR -- SKIP_FLAG := true; end if; if INDEX(LINE, D_STRING(CHK_OUT_EMPTY),1) = 1 then exit; end if; -- done -- if INDEX(LINE, FILE, 1) >= 1 then FOUND_FLAG := true;exit;end if; --got it-- if SET_FLAG and not SKIP_FLAG then -- copy lines if updating and not HDR -- put_line(NEW_LOG_FILE, STR(LINE)); COUNT := COUNT + 1; end if; end loop; if not SET_FLAG then -- just checking status; return results -- close(LOG_FILE); return FOUND_FLAG; end if; if not FOUND_FLAG then -- if not there, then we must be adding it -- put_line(NEW_LOG_FILE,STR(FILE) &" to "& DEST & "] on " & STR(TIM_STR)); else if COUNT = 0 then -- deleting an entry, and it was the only one -- put_line(NEW_LOG_FILE, CHK_OUT_EMPTY); else while not end_of_file(LOG_FILE) loop -- read rest of old log file -- LINE := D_STRING(""); CHAR := ' '; while not end_of_line(LOG_FILE) loop -- line by line -- get(LOG_FILE,CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(LOG_FILE); if INDEX(LINE, D_STRING(CHK_OUT_EMPTY),1) = 1 then exit; end if; put_line(NEW_LOG_FILE, STR(LINE)); end loop; end if; end if; close(LOG_FILE); close(NEW_LOG_FILE); return true; exception when name_error | use_error => raise DATA_FILE_ERROR; end CHECK_OUT; procedure MAIL(LOC : in DYN_STRING; FILE : in DYN_STRING; NAME : in string; DEST : in DYN_STRING := D_STRING("")) is MAIL_FILE : file_type; LINE : DYN_STRING; begin create(MAIL_FILE, OUT_FILE, NAME & ".MAI"); put_line(MAIL_FILE, "FILE " & STR(FILE) & " is being returned from " & STR(LOC) & "] to " & STR(DEST) & "]"); close(MAIL_FILE); LINE := D_STRING(MAIL_CMD1) & ROOT & D_STRING(MAIL_CMD2 & NAME & ".MAI ") & MANAGERS; SET_POS; DO_CMD(LINE); LINE := D_STRING(DEL & NAME & ".MAI;*"); DO_CMD(LINE); RESET_POS; exception when others => raise; end MAIL; procedure EXTRACT_SOURCE(UNIT : in DYN_STRING; FILE : in out DYN_STRING; RENAME_FLAG : boolean := true) is TMP_FILE : file_type; LINE : DYN_STRING; begin LINE := D_STRING("ACS GET/NOLOG ") & UNIT; SET_POS; DO_CMD(LINE); RESET_POS; begin open(TMP_FILE, IN_FILE, STR(UNIT) & ADA_EXT); -- test for success -- close(TMP_FILE); exception when others => raise; end; if RENAME_FLAG then -- If true, rename the file -- FILE := UNIT; LINE := D_STRING("RENAME ") & UNIT & D_STRING("*" & ADA_EXT & " *.TMP"); SET_POS; DO_CMD(LINE); RESET_POS; if INDEX(UNIT, D_STRING('_'), LENGTH(UNIT)-1) >= 1 then -- if request spec LINE := D_STRING(DEL) & FILE & D_STRING(".TMP;*"); DO_CMD(LINE); FILE := FILE & D_STRING('_'); end if; end if; exception when others => raise; end EXTRACT_SOURCE; -- -- Global (Visible) Declarations -- procedure COMMAND_EXECUTE(CMD : in out COMMAND_BLOCK; ENV_BLK : in out ENVIRONMENT_BLOCK) is EXT, LINE, FILENAME : DYN_STRING := D_STRING(""); ABBREV : string(1..3) := (1..3 => ' '); START : integer := 0; FILE_FLG, TMP_FLG, HDR_FLG : boolean := false; CHAR : character; ONE_STR : string(1..1) := " "; CUR_TIME : time; HEADER, TMP_FILE : file_type; OLD_CODE : COMMAND_ID; LEVEL : ENV_LEVEL; STATUS : system.unsigned_longword := 0; begin case CMD.CODE is -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when BUI => -- ADA Batch compile -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then ERROR_MSG(EXT_ERR); -- no extension allowed on lib unit else LINE := D_STRING("ACS CMP") & CMD.SWITCH & D_STRING(COMPILE_STR & GET_ENVIRON(ENV_BLK) & LIST_DIR & " ") & CMD.P2; SET_POS; DO_CMD(LINE); -- submit the mass compilation RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CHE => -- ACS Check unit -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then ERROR_MSG(EXT_ERR); -- no extension allowed on lib unit else LINE := D_STRING("ACS CHE") & CMD.SWITCH & D_STRING(' ') & CMD.P2; SET_POS; DO_CMD(LINE); RESET_POS; -- issue an "ACS CHECK" end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CFO => -- ACS COPY FOREIGN unit -- if LENGTH(CMD.P2) = 0 or LENGTH(CMD.P3) = 0 then -- must specify -- ERROR_MSG(CMD_ERR); -- error if no file or unit name -- else if INDEX(CMD.P2, D_STRING('['), 1) < 1 then -- check for UIC -- CMD.P2 := D_STRING(GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.P2; end if; LINE := D_STRING("ACS FOR") & CMD.SWITCH & D_STRING(' ') & CMD.P2 & D_STRING(' ') & CMD.P3; SET_POS; DO_CMD(LINE); RESET_POS; -- issue an "ACS COPY FOREIGN" end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CMP => -- ADA compile -- if "." & STR(ENV_BLK.FACILITY) & "]" /= SOURCE_DIR then ERROR_MSG(SRCE_ERR); -- only allow compiles from source dir. else if LENGTH(CMD.P2) = 0 or STR(CMD.P2) = "*" then CMD.P2 := ENV_BLK.MODULE; -- use default unit name end if; STRIP_SEARCH(CMD.P2,EXT); SET_POS; if LENGTH(CMD.SWITCH) > 0 then -- Is it another compiler? -- if LENGTH(CMD.SWITCH) >= 4 then -- name is normal length -- ABBREV := STR(CMD.SWITCH)(2..4); else -- unusually short command -- ABBREV(1) := ' '; ABBREV(2..3) := STR(CMD.SWITCH)(2..3); end if; LINE := D_STRING(ABBREV & "/LIST=" & GET_ENVIRON(ENV_BLK) & LIST_DIR & "/OBJ=" & GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.SUBSWITCH & D_STRING(' ') & CMD.P2 & EXT; else LINE := D_STRING(ADA_CMD) & CMD.SUBSWITCH & D_STRING(COMPILE_STR & GET_ENVIRON(ENV_BLK) & LIST_DIR & " ") & CMD.P2; end if; DO_CMD(LINE, ECHO_FLAG => true); -- execute the compile command -- RESET_POS; CMD.CMP_COUNT := CMD.CMP_COUNT + 1; -- count the compile -- end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when ADE => -- Delete an ADA unit -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then ERROR_MSG(EXT_ERR); -- no extension allowed on lib unit else LINE := D_STRING(DEL & GET_ENVIRON(ENV_BLK) & SOURCE_DIR) & CMD.P2 & D_STRING(ADA_EXT & ";*"); SET_POS; DO_CMD(LINE, ECHO_FLAG => true); -- delete sources -- LINE := D_STRING(DEL & GET_ENVIRON(ENV_BLK) & LIST_DIR) & CMD.P2 & D_STRING(".*;*"); DO_CMD(LINE, ECHO_FLAG => true); -- Delete listings and maps -- LINE := D_STRING(DEL & GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.P2 & D_STRING(".*;*"); DO_CMD(LINE, ECHO_FLAG => true); -- Delete Misc. -- LINE := D_STRING(DEL & GET_ENVIRON(ENV_BLK) & EXE_DIR) & CMD.P2 & D_STRING(EXE_EXT & ";*"); DO_CMD(LINE, ECHO_FLAG => true); -- Delete executeables -- LINE := D_STRING("ACS ADE ") & CMD.P2; DO_CMD(LINE); RESET_POS; -- delete the Ada library entry -- if CHECK_OUT(CMD.P2,GET_ENVIRON(ENV_BLK, TEST_BED)) then MAIL(D_STRING(GET_ENVIRON(ENV_BLK)), CMD.P2, STR(ENV_BLK.PROCESS_NAME)); end if; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when DIS => -- display module header -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2, EXT); if (STR(EXT) /= "") and (STR(EXT) /= ADA_EXT) then ERROR_MSG(EXT_ERR); -- no extension allowed on lib unit else begin LEVEL := ENV_LEVEL'value(STR(CMD.P3)); -- determine level to look -- exception when others => LEVEL := ENVIRONMENT; -- if problem use environment -- end; begin STATUS := CREATE_LOGICAL(LIB_LOGICAL, GET_ENVIRON(ENV_BLK,LEVEL) & LIB_DIR); EXTRACT_SOURCE(CMD.P2, FILENAME); STATUS := CREATE_LOGICAL(LIB_LOGICAL, GET_ENVIRON(ENV_BLK) & LIB_DIR); SET_POS; -- use the lower part of screen -- open(HEADER, IN_FILE, STR(FILENAME) & ".TMP"); reset(HEADER); HDR_FLG := false; --signal start of header -- while not end_of_file(HEADER) loop -- read the header -- LINE := D_STRING(""); while not end_of_line(HEADER) loop -- read in each line -- get(HEADER, CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(HEADER); -- got a line from module -- if INDEX(LINE, D_STRING("--+"),1) = 1 then HDR_FLG := true; end if; if HDR_FLG then put_line(STR(LINE)); end if; -- display header -- if INDEX(LINE, D_STRING("--%"),1) = 1 then exit; end if; end loop; close(HEADER); LINE := D_STRING(DEL) & FILENAME & D_STRING("*.TMP;*"); DO_CMD(LINE); exception when name_error => ERROR_MSG(MISSING_FILE); when others => raise DATA_FILE_ERROR; end; RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when EDT => -- Edit a file -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); SET_POS(1); CREATE_SOURCE(CMD.P2, EXT, STR(CMD.P3), GET_ENVIRON(ENV_BLK) & "]"); -- Invoke the editor -- RESTORE_POS; ENV_REPORT.UPDATE(ENV_BLK); -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when ENT => -- allow us to grab library pointer -- if LENGTH(CMD.P2) = 0 then -- the ADA library spec -- ERROR_MSG(CMD_ERR); else if LENGTH(CMD.P3) = 0 then CMD.P3 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P3, EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING("ACS ENT") & CMD.SWITCH & D_STRING(' ') & CMD.P2 & D_STRING(' ') & CMD.P3; SET_POS; DO_CMD(LINE, ECHO_FLAG => true); RESET_POS; end if; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when EXP => -- ACS EXPORT unit -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING("ACS EXP/OBJ=" & GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.SWITCH & D_STRING(' ') & CMD.P2; SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when GET => -- check out a module -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) = "" then EXT := D_STRING(ADA_EXT); end if; if STR(EXT) = ADA_EXT then -- if Ada, then in library (.ADC) -- begin LEVEL := ENV_LEVEL'value(STR(CMD.P3)); -- determine level to look -- exception when others => LEVEL := TEST_BED; -- if problem use Test_bed -- end; begin STATUS := CREATE_LOGICAL(LIB_LOGICAL, GET_ENVIRON(ENV_BLK,LEVEL) & LIB_DIR); EXTRACT_SOURCE(CMD.P2, FILENAME, false); STATUS := CREATE_LOGICAL(LIB_LOGICAL, GET_ENVIRON(ENV_BLK) & LIB_DIR); exception when name_error | use_error => ERROR_MSG(NO_FILE); end; else -- otherwise, located in source dir -- FILENAME := D_STRING(GET_ENVIRON(ENV_BLK, LEVEL) & SOURCE_DIR) & CMD.P2 & EXT; end if; begin open(TMP_FILE, IN_FILE, STR(FILENAME)); -- is it there? -- close(TMP_FILE); if CHECK_OUT(CMD.P2&EXT, GET_ENVIRON(ENV_BLK,TEST_BED)) then -- out? -- raise FILE_UNAVAILABLE; end if; LINE := D_STRING(COPY) & FILENAME & D_STRING(" " & GET_ENVIRON(ENV_BLK) & SOURCE_DIR) & CMD.P2 & EXT; SET_POS; DO_CMD(LINE); -- grab a copy of the source -- TMP_FLG := CHECK_OUT(CMD.P2 & EXT, GET_ENVIRON(ENV_BLK,TEST_BED), GET_ENVIRON(ENV_BLK), true); LINE := D_STRING(PURGE & GET_ENVIRON(ENV_BLK, TEST_BED)) & D_STRING(CHECKOUT_FILE); DO_CMD(LINE); RESET_POS; -- mark it as checked out -- exception when FILE_UNAVAILABLE | name_error => ERROR_MSG(NO_FILE); end; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when HEL => -- Print out Help files -- if LENGTH(CMD.P2) >= 3 then ABBREV := STR(CMD.P2)(1..3); -- check 1st three for TAPSE help -- else ABBREV := " "; -- otherwise, assume nothing -- end if; if ABBREV = "VER" then LINE := D_STRING(HELP_DIR_CMD) & ROOT & D_STRING("]V*.DIR"); SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "TES" then LINE := D_STRING(HELP_DIR_CMD & GET_ENVIRON(ENV_BLK,VERSION) & "]TEST*.DIR"); SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "ENV" then LINE := D_STRING(HELP_DIR_CMD & GET_ENVIRON(ENV_BLK,TEST_BED) & "]*.DIR"); SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "FAC" then LINE := D_STRING(HELP_DIR_CMD & GET_ENVIRON(ENV_BLK) & "]*.DIR"); SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "TRE" then LINE := D_STRING('@') & ROOT & D_STRING(TREE & " ") & CMD.P3 & D_STRING(' ') & CMD.P4; SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "HEL" then LINE := D_STRING(TTY_PRINT & DOC_LOGICAL & ":HELP_HEL*.DOC"); SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "MOD" then LINE := D_STRING(TTY_PRINT & DOC_LOGICAL & ":HELP_MOD*.DOC"); SET_POS; DO_CMD(LINE); RESET_POS; elsif ABBREV = "DIR" then LINE := D_STRING(TTY_PRINT & DOC_LOGICAL & ":HELP_DIR*.DOC"); SET_POS; DO_CMD(LINE); RESET_POS; else LINE := D_STRING("HELP ") & CMD.P2 & D_STRING(' ') & CMD.P3 & D_STRING(' ') & CMD.P4 & D_STRING(' ') & CMD.P5 & D_STRING(' ') & CMD.P6; SET_POS(1); DO_CMD(LINE); RESTORE_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when HOM => -- Put us back at "home" -- NEW_ENV_BLK(ENV_BLK,VERSION,""); -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when INC => -- display units using this module -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING(INC_SEARCH) & CMD.SWITCH & D_STRING(" " & GET_ENVIRON(ENV_BLK) & SOURCE_DIR & "*" & ADA_EXT & " ") & D_STRING('"') & D_STRING("WITH") & D_STRING('"') & D_STRING(',') & D_STRING('"') & CMD.P2 & D_STRING('"'); SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when INDIRECT => START := INDEX(CMD.LINE, CMD.NAME, 1); if INDEX(CMD.LINE, D_STRING('.'),1) = START + LENGTH(CMD.NAME) then CMD.NAME := CMD.NAME & CMD.P2; end if; if INDEX(CMD.NAME, D_STRING('.'), 1) < 1 then -- make sure got extension CMD.NAME := CMD.NAME & D_STRING(COM_EXT); end if; CMD.IN_FILE := D_STRING(GET_ENVIRON(ENV_BLK) & COM_DIR) & CMD.NAME; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when LIB => -- ACS Show library unit -- if LENGTH(CMD.P2) = 0 then CMD.P2 := D_STRING("*"); end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING("ACS LIB") & CMD.SUBSWITCH & D_STRING(' ') & CMD.P2; SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when LIS => -- print module listing on TTY -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2, EXT); if (STR(EXT) /= "") then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING(TTY_PRINT & GET_ENVIRON(ENV_BLK) & LIST_DIR) & CMD.P2 & D_STRING("*" & LIS_EXT); SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when LNK => -- ADA task build (LINK) -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING("ACS LNK") & CMD.SWITCH & D_STRING("/EXECUTABLE=" & GET_ENVIRON(ENV_BLK) & EXE_DIR & " ") & CMD.P2; if LENGTH(CMD.P3) > 0 then -- handle extra object files -- if INDEX(CMD.P3, D_STRING('['), 1) < 1 then -- make sure has UIC -- CMD.P3 := D_STRING(GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.P3; end if; LINE := LINE & D_STRING(' ') & CMD.P3; end if; SET_POS; DO_CMD(LINE, ECHO_FLAG => true); RESET_POS; CMD.LNK_COUNT := CMD.LNK_COUNT + 1; -- count link command -- end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when MSG => -- Send a notice to the managers -- if LENGTH(CMD.P2) = 0 then -- must pass filename -- ERROR_MSG(CMD_ERR); else SET_POS; LINE := D_STRING("MAIL ") & CMD.SWITCH & CMD.P2 & D_STRING(' ') & MANAGERS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when PRT => -- print module listing on LP -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2, EXT); if (STR(EXT) /= "") then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING(LP_PRINT) & CMD.SWITCH & D_STRING(' ') & D_STRING(GET_ENVIRON(ENV_BLK) & LIST_DIR) & CMD.P2 & D_STRING("*" & LIS_EXT); SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when APU => -- Purge an ADA unit -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING(PURGE & GET_ENVIRON(ENV_BLK) & SOURCE_DIR) & CMD.P2 & D_STRING("*" & ADA_EXT); SET_POS; DO_CMD(LINE, ECHO_FLAG => true); LINE := D_STRING(PURGE & GET_ENVIRON(ENV_BLK) & LIST_DIR) & CMD.P2 & D_STRING("*.*"); DO_CMD(LINE, ECHO_FLAG => true); LINE := D_STRING(PURGE & GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.P2 & D_STRING("*.*"); DO_CMD(LINE, ECHO_FLAG => true); LINE := D_STRING(PURGE & GET_ENVIRON(ENV_BLK) & EXE_DIR) & CMD.P2 & D_STRING("*" & EXE_EXT); DO_CMD(LINE, ECHO_FLAG => true); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when PUT => -- check in a module -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) = "" then EXT := D_STRING(ADA_EXT); end if; CMD.P3 := D_STRING(GET_ENVIRON(ENV_BLK, TEST_BED)); MAIL(D_STRING(GET_ENVIRON(ENV_BLK)), CMD.P2, STR(ENV_BLK.PROCESS_NAME), CMD.P3); -- copy files to [-.integ] for later handling by configuration manager -- LINE := D_STRING(RENAME & GET_ENVIRON(ENV_BLK) & SOURCE_DIR) & CMD.P2 & EXT & D_STRING(' ') & CMD.P3 & D_STRING(INTEG_DIR); SET_POS; DO_CMD(LINE); LINE := D_STRING(RENAME & GET_ENVIRON(ENV_BLK) & LIST_DIR) & CMD.P2 & D_STRING(LIS_EXT & " ") & CMD.P3 & D_STRING(INTEG_DIR); DO_CMD(LINE); LINE := D_STRING(RENAME & GET_ENVIRON(ENV_BLK) & EXE_DIR) & CMD.P2 & D_STRING(EXE_EXT & " ") & CMD.P3 & D_STRING(INTEG_DIR); DO_CMD(LINE); RESET_POS; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when REC => -- ADA Recompile -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit ERROR_MSG(EXT_ERR); else LINE := D_STRING("ACS REC") & CMD.SWITCH & D_STRING(COMPILE_STR & GET_ENVIRON(ENV_BLK) & LIST_DIR & " ") & CMD.P2; SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when REF => -- ACS Show Program units -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING("ACS REF") & CMD.SWITCH & D_STRING(' ') & CMD.P2; SET_POS; DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when REG => -- Regress back up one level -- LINE := D_STRING(GET_ENVIRON(ENV_BLK)); if STR(LINE) /= GET_ENVIRON(ENV_BLK,FACILITY) then -- got facility? -- NEW_ENV_BLK(ENV_BLK, FACILITY, ""); elsif STR(LINE) /= GET_ENVIRON(ENV_BLK,TEST_BED) then -- got environ? -- NEW_ENV_BLK(ENV_BLK, ENVIRONMENT, ""); elsif STR(LINE) /= GET_ENVIRON(ENV_BLK,VERSION) then -- got test_bed? -- NEW_ENV_BLK(ENV_BLK, TEST_BED, ""); elsif STR(LINE) /= STR(ROOT) then -- got version? -- NEW_ENV_BLK(ENV_BLK, VERSION, ""); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when REP => RESET_SCREEN; -- Repaint the screen -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when ARU => -- ADA Image execution -- if LENGTH(CMD.P2) = 0 then CMD.P2 := ENV_BLK.MODULE; end if; STRIP_SEARCH(CMD.P2,EXT); if STR(EXT) /= "" then -- no extension expected for lib unit -- ERROR_MSG(EXT_ERR); else LINE := D_STRING("RUN") & CMD.SWITCH & D_STRING(' ') & D_STRING(GET_ENVIRON(ENV_BLK) & EXE_DIR) & CMD.P2; SET_POS; DO_CMD(LINE, ECHO_FLAG => true); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when ASE => -- Search sources for string -- LINE := D_STRING("SEARCH") & CMD.SWITCH & D_STRING(" " & GET_ENVIRON(ENV_BLK) & SOURCE_DIR & " ") & D_STRING('"') & CMD.P2; if LENGTH(CMD.P3) > 0 then LINE := LINE & D_STRING(' ') & CMD.P3; end if; if LENGTH(CMD.P4) > 0 then LINE := LINE & D_STRING(' ') & CMD.P4; end if; if LENGTH(CMD.P5) > 0 then LINE := LINE & D_STRING(' ') & CMD.P5; end if; if LENGTH(CMD.P6) > 0 then LINE := LINE & D_STRING(' ') & CMD.P6; end if; LINE := LINE & D_STRING('"'); SET_POS; DO_CMD(LINE); RESET_POS; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when STA => -- display checkout status for level -- LINE := D_STRING(TTY_PRINT & GET_ENVIRON(ENV_BLK, TEST_BED)) & D_STRING(CHECKOUT_FILE); SET_POS; DO_CMD(LINE); RESET_POS; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when TID => -- TAPSE IDentification command -- SET_POS; put(" -- Process Name = "); put(STR(ENV_BLK.PROCESS_NAME)); new_line; put(" Owner UIC = "); put(STR(ENV_BLK.PROCESS_UIC)); new_line; put(" Priviledge = "); put(PRIVILEDGE_ID'image(ENV_BLK.PRIVILEDGE)); new_line; put(" Default Unit = "); put(STR(ENV_BLK.MODULE)); new_line; RESET_POS; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when VER => -- ACS Verify Ada library -- LINE := D_STRING("ACS VER") & CMD.SWITCH & D_STRING(' ') & CMD.P2; SET_POS; DO_CMD(LINE); RESET_POS; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when VERS | TEST | ENV | FAC => OLD_CODE := UNKNOWN; if CMD.CODE = VERS then -- handle new version; check test_bed -- NEW_ENV_BLK(ENV_BLK,VERSION,STR(CMD.NAME)); OLD_CODE := CMD.CODE; if STR(CMD.P2) /= "" then SHIFT_CMD(CMD);ID_CMD(CMD,false); end if; end if; if CMD.CODE = TEST then -- handle new test_bed; check environ -- NEW_ENV_BLK(ENV_BLK,TEST_BED,STR(CMD.NAME)); OLD_CODE := CMD.CODE; if STR(CMD.P2) /= "" then SHIFT_CMD(CMD);ID_CMD(CMD,false); end if; end if; if CMD.CODE = ENV then -- handle new environment; check fac -- NEW_ENV_BLK(ENV_BLK,ENVIRONMENT,STR(CMD.NAME)); OLD_CODE := CMD.CODE; if STR(CMD.P2) /= "" then SHIFT_CMD(CMD);ID_CMD(CMD,false); end if; end if; if CMD.CODE = FAC then -- handle new facility -- NEW_ENV_BLK(ENV_BLK,FACILITY,STR(CMD.NAME)); end if; LINE := D_STRING("ACS ASE/NOLOG"); -- set up Ada library pointer -- if OLD_CODE = VERS then -- do we need to restrict access? -- if ENV_BLK.PRIVILEDGE > VERSION_CONTROLLER then -- restrict -- LINE := LINE & D_STRING("/READ_ONLY"); end if; end if; if OLD_CODE = TEST then -- do we need to restrict access? -- if ENV_BLK.PRIVILEDGE > TEST_DIRECTOR then -- restrict -- LINE := LINE & D_STRING("/READ_ONLY"); end if; end if; if OLD_CODE = ENV then -- do we need to restrict access? -- if ENV_BLK.PRIVILEDGE > TEST_DIRECTOR then -- restrict -- LINE := LINE & D_STRING("/EXCLUSIVE"); end if; end if; LINE := LINE & D_STRING(" " & LIB_LOGICAL); SET_POS; DO_CMD(LINE); RESET_POS; -- set the Ada library properly -- if CMD.CODE = UNKNOWN then -- got something we don't recognize -- ERROR_MSG(ENV_ERR); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when UNI => -- Default Module Declaration -- NEW_ENV_BLK(ENV_BLK,MODULE,STR(CMD.P2)); -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when UNKNOWN => -- LINK is one special case -- SET_POS; if STR(CMD.NAME)(1..3) = "LIN" then if INDEX(CMD.P2, D_STRING('['), 1) < 1 then -- make sure has UIC -- FILENAME := D_STRING(GET_ENVIRON(ENV_BLK) & INTEG_DIR) & CMD.P2; end if; LINE := CMD.NAME & CMD.SWITCH & D_STRING("/EXECUTABLE=" & GET_ENVIRON(ENV_BLK) & EXE_DIR & " ") & FILENAME; if LENGTH(CMD.P3) > 0 then LINE := LINE & D_STRING(',') & CMD.P3;end if; if LENGTH(CMD.P4) > 0 then LINE := LINE & D_STRING(',') & CMD.P4;end if; if LENGTH(CMD.P5) > 0 then LINE := LINE & D_STRING(',') & CMD.P5;end if; if LENGTH(CMD.P6) > 0 then LINE := LINE & D_STRING(',') & CMD.P6;end if; else LINE := CMD.LINE; end if; DO_CMD(LINE, ECHO_FLAG => true); RESET_POS; -- handle DCL cmd -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when others => ERROR_MSG(NOT_IMP); -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- end case; exception when BAD_FILE => ERROR_MSG(MISSING_FILE); when ACE_ERROR => ERROR_MSG(ACL_ERR); end COMMAND_EXECUTE; procedure CREATE_FACILITIES is TMP_FILE : file_type; LINE : DYN_STRING; CHAR : character; begin open(TMP_FILE, IN_FILE, FAC_FILE); reset(TMP_FILE); SET_POS; while not end_of_file(TMP_FILE) loop LINE := D_STRING(""); CHAR := ' '; while (not end_of_line(TMP_FILE)) and (CHAR /= '!') loop get(TMP_FILE, CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(TMP_FILE); if STR(LINE)(1) /= '!' then -- skip the comment lines -- LINE := D_STRING("CREATE/DIR/LOG [.") & LINE & D_STRING(']'); DO_CMD(LINE); end if; end loop; RESET_POS; close(TMP_FILE); exception when name_error => ERROR_MSG(DAT_ERR); end CREATE_FACILITIES; procedure CREATE_ENV(ENV_BLK : in out ENVIRONMENT_BLOCK; ENV : in string; WRITERS : in DYN_STRING) is LINE : DYN_STRING; FINISH, NEXT : integer; begin SET_POS; LINE := D_STRING("CREATE/DIR [." & ENV & "]"); DO_CMD(LINE); -- create the env. dir. -- -- Determine the access rights for this environment -- NEXT := 1; LINE := WRITERS; while NEXT > 0 loop -- modify the ACL list -- FINISH := NEXT; NEXT := INDEX(LINE ,D_STRING('/'),FINISH); -- Search thru list of users -- if NEXT >= 1 then -- got another user -- ADD_WRITE_ACCESS(ENV & DIRECTORY_FILE, STR(SUBSTRING(LINE, FINISH, NEXT - FINISH))); NEXT := NEXT + 1; -- skip the separator character -- end if; end loop; LINE := D_STRING("ACS CSUB [."& ENV & LIB_DIR); -- create the Ada sublibrary-- DO_CMD(LINE); NEW_ENV_BLK(ENV_BLK, ENVIRONMENT, ENV); -- Set us at this env. -- LINE := D_STRING(COPY) & ROOT & D_STRING("]" & EDT_INIT_FILE & " []"); DO_CMD(LINE); -- copy the edtini to env. -- RESET_POS; CREATE_FACILITIES; -- create facilities for env -- NEW_ENV_BLK(ENV_BLK, TEST_BED, STR(ENV_BLK.TEST_BED)); -- back to t.b. -- exception when constraint_error => ERROR_MSG(CMD_ERR); when ACE_ERROR => ERROR_MSG(ACL_ERR); end CREATE_ENV; procedure CREATE_ENVIRONS(ENV_BLK : in out ENVIRONMENT_BLOCK) is TMP_FILE : file_type; ENV, REST, LINE : DYN_STRING; CHAR : character; NEXT, FINISH : integer; begin open(TMP_FILE, IN_FILE, ENV_FILE); reset(TMP_FILE); while not end_of_file(TMP_FILE) loop LINE := D_STRING(""); CHAR := ' '; while (not end_of_line(TMP_FILE)) and (CHAR /= '!') loop get(TMP_FILE, CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(TMP_FILE); FINISH := INDEX(LINE, D_STRING('/'), 1); -- Separate env. and users -- if FINISH >= 1 then -- make sure a legal string -- ENV := SUBSTRING(LINE, 1, FINISH - 1); REST := SUBSTRING(LINE, FINISH + 1, LENGTH(LINE) - FINISH); CREATE_ENV(ENV_BLK, STR(ENV), REST); end if; end loop; close(TMP_FILE); exception when name_error => ERROR_MSG(DAT_ERR); when status_error => null; end CREATE_ENVIRONS; procedure CREATE_TB(ENV_BLK : in out ENVIRONMENT_BLOCK; TEST : in string) is LINE : DYN_STRING; NEXT, FINISH : integer; begin SET_POS; LINE := D_STRING("CREATE/DIR [." & TEST & "]"); DO_CMD(LINE); -- create the tb. dir. -- -- Determine the access rights for this environment -- NEXT := 1; for I in 1..MAX_ACL loop -- create an ACL list -- FINISH := NEXT; NEXT := INDEX(USERS,D_STRING(':'),FINISH); -- Search thru list of users -- if NEXT >= 1 then -- got another user -- if STR(SUBSTRING(USERS,NEXT+1,1)) /= "R" then -- is it read only user? -- ADD_WRITE_ACCESS(TEST & DIRECTORY_FILE, STR(SUBSTRING(USERS, FINISH, NEXT - FINISH))); end if; NEXT := NEXT + 3; else exit; end if; end loop; LINE := D_STRING("ACS CSUB [."& TEST & LIB_DIR); -- create Ada sublibrary -- DO_CMD(LINE); NEW_ENV_BLK(ENV_BLK, TEST_BED, TEST); -- Set us at this TB -- LINE := D_STRING(COPY) & ROOT & D_STRING("]" & EDT_INIT_FILE & " []"); DO_CMD(LINE); -- copy the edtini to tb. -- RESET_POS; CREATE_FACILITIES; -- create facilities for TB -- CREATE_ENVIRONS(ENV_BLK); -- create the environments under TB -- NEW_ENV_BLK(ENV_BLK, VERSION, STR(ENV_BLK.VERSION)); -- back to version -- exception when ACE_ERROR => ERROR_MSG(ACL_ERR); end CREATE_TB; procedure CREATE_TEST_BEDS(ENV_BLK : in out ENVIRONMENT_BLOCK) is TMP_FILE : file_type; LINE : DYN_STRING; CHAR : character; begin open(TMP_FILE, IN_FILE, TEST_FILE); reset(TMP_FILE); while not end_of_file(TMP_FILE) loop LINE := D_STRING(""); CHAR := ' '; while (not end_of_line(TMP_FILE)) and (CHAR /= '!') loop get(TMP_FILE, CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(TMP_FILE); if STR(LINE)(1) /= '!' then -- skip over the comment lines -- CREATE_TB(ENV_BLK, STR(LINE)); end if; end loop; close(TMP_FILE); exception when name_error => ERROR_MSG(DAT_ERR); when status_error => null; end CREATE_TEST_BEDS; procedure CREATE_VER(ENV_BLK : in out ENVIRONMENT_BLOCK; VERS : in string) is LINE : DYN_STRING; NEXT, FINISH : integer; begin SET_POS; LINE := D_STRING("CREATE/DIR [." & VERS & "]"); DO_CMD(LINE); -- create the version dir. -- -- Determine the access rights for this environment -- NEXT := 1; for I in 1..MAX_ACL loop -- create an ACL list -- FINISH := NEXT; NEXT := INDEX(USERS,D_STRING(':'),FINISH); -- Search thru list of users -- if NEXT >= 1 then -- got another user -- if STR(SUBSTRING(USERS,NEXT+1,1)) = "V" then -- is it Version_control? -- ADD_WRITE_ACCESS(VERS & DIRECTORY_FILE, STR(SUBSTRING(USERS, FINISH, NEXT - FINISH))); end if; NEXT := NEXT + 3; else exit; end if; end loop; LINE := D_STRING("ACS CSUB [."& VERS & LIB_DIR); -- create Ada sublibrary -- DO_CMD(LINE); NEW_ENV_BLK(ENV_BLK, VERSION, VERS); -- Set us at this version -- LINE := D_STRING(COPY) & ROOT & D_STRING("]" & EDT_INIT_FILE & " []"); DO_CMD(LINE); -- copy the edtini to version -- RESET_POS; CREATE_FACILITIES; -- create facilities for Version -- CREATE_TEST_BEDS(ENV_BLK); -- create the test_beds for Version -- NEW_ENV_BLK(ENV_BLK, VERSION, ""); -- back to root -- exception when ACE_ERROR => ERROR_MSG(ACL_ERR); end CREATE_VER; procedure CREATE_VERSIONS(ENV_BLK : in out ENVIRONMENT_BLOCK) is TMP_FILE : file_type; LINE : DYN_STRING; CHAR : character; begin open(TMP_FILE, IN_FILE, VERS_FILE); reset(TMP_FILE); while not end_of_file(TMP_FILE) loop LINE := D_STRING(""); CHAR := ' '; while (not end_of_line(TMP_FILE)) and (CHAR /= '!') loop get(TMP_FILE, CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(TMP_FILE); if STR(LINE)(1) /= '!' then -- skip over the comment lines -- CREATE_VER(ENV_BLK, STR(LINE)); end if; end loop; close(TMP_FILE); exception when name_error => ERROR_MSG(DAT_ERR); when status_error => null; end CREATE_VERSIONS; procedure ADD_LEVEL(NAME : in string; FILE : in string) is OLD_FILE, NEW_FILE : file_type; CHAR : character; LINE : DYN_STRING; FOUND_FLG : boolean := false; begin open(OLD_FILE, IN_FILE, FILE); reset(OLD_FILE); create(NEW_FILE, OUT_FILE, FILE); while not end_of_file(OLD_FILE) loop LINE := D_STRING(""); CHAR := ' '; while (not end_of_line(OLD_FILE)) loop get(OLD_FILE, CHAR); LINE := LINE & D_STRING(CHAR); end loop; skip_line(OLD_FILE); if STR(LINE) = NAME then -- make sure doesn't exist -- FOUND_FLG := true; end if; put_line(NEW_FILE, STR(LINE)); -- copy over to new file -- end loop; if not FOUND_FLG then put_line(NEW_FILE, NAME); end if; -- add new name -- close(OLD_FILE); close(NEW_FILE); LINE := D_STRING(PURGE & FILE); SET_POS; DO_CMD(LINE); RESET_POS; end ADD_LEVEL; procedure DELETE_LEVEL(NAME : in string; FILE : in string) is OLD_FILE, NEW_FILE : file_type; CHAR : character; LINE : DYN_STRING; begin open(OLD_FILE, IN_FILE, FILE); reset(OLD_FILE); create(NEW_FILE, OUT_FILE, FILE); while not end_of_file(OLD_FILE) loop LINE := D_STRING(""); CHAR := ' '; while (not end_of_line(OLD_FILE)) loop get(OLD_FILE, CHAR); if CHAR = '/' then exit; end if; LINE := LINE & D_STRING(CHAR); end loop; skip_line(OLD_FILE); if STR(LINE) /= NAME then -- make sure doesn't exist no more -- put_line(NEW_FILE, STR(LINE)); -- copy over to new file -- end if; end loop; close(OLD_FILE); close(NEW_FILE); LINE := D_STRING(PURGE & FILE); SET_POS; DO_CMD(LINE); RESET_POS; end DELETE_LEVEL; procedure CONFIG_EXECUTE(CMD : in out COMMAND_BLOCK; ENV_BLK : in out ENVIRONMENT_BLOCK) is LINE : DYN_STRING; CODE : CONFIG_COMMAND_ID; begin CODE := CONFIG_COMMAND_ID'value(STR(CMD.NAME)); case CODE is -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when ACL => -- Clean up ACL's on files -- if LENGTH(CMD.P2) = 0 then CMD.P2 := D_STRING("*.*;*"); end if; CREATE_INIT_ACCESS(STR(CMD.P2)); -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when AEN => -- Add an environment level -- if LENGTH(CMD.P2) = 0 or LENGTH(CMD.SUBSWITCH) = 0 then ERROR_MSG(CMD_ERR); -- must specify a new name -- else ADD_LEVEL(STR(CMD.P2 & CMD.SUBSWITCH), ENV_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when AFA => -- Add a facility level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a new name -- else ADD_LEVEL(STR(CMD.P2), FAC_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when ATE => -- Add a test_bed level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a new name -- else ADD_LEVEL(STR(CMD.P2), TEST_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when AVE => -- Add a version level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a new name -- else ADD_LEVEL(STR(CMD.P2), VERS_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CEN => -- create an environment -- if LENGTH(CMD.P2) = 0 or LENGTH(CMD.P3) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else CREATE_ENV(ENV_BLK, STR(CMD.P2), CMD.P3); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CFA => -- create a facility -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else SET_POS; LINE := D_STRING("CREATE/DIR [.") & CMD.P2 & D_STRING(']'); DO_CMD(LINE); RESET_POS; end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CON => -- Configure TAPSE tree structure -- null; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CTE => -- create a test_bed -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else CREATE_TB(ENV_BLK, STR(CMD.P2)); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CUT => -- Cut the directory from the tree -- null; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when CVE => -- create a version -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else CREATE_VER(ENV_BLK, STR(CMD.P2)); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when DEN => -- Delete an environment level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else DELETE_LEVEL(STR(CMD.P2), ENV_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when DFA => -- Delete a facility level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else DELETE_LEVEL(STR(CMD.P2), FAC_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when DTE => -- Delete a Test_bed level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else DELETE_LEVEL(STR(CMD.P2), TEST_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when DVE => -- Delete a version level -- if LENGTH(CMD.P2) = 0 then ERROR_MSG(CMD_ERR); -- must specify a name -- else DELETE_LEVEL(STR(CMD.P2), VERS_FILE); end if; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when PRE => -- Display previous commands -- SET_POS; for I in 1..5 loop put(" *** LINE ["); put(integer'image(I)); put("] = "); put(STR(COMMAND_ARRAY(I).LINE)); new_line; end loop; put(" Ptr = ");put(integer'image(CMD_ARRAY_PTR)); new_line; RESET_POS; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when TRA => -- Transfer contents of an environment null; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when UPD => -- Merge a source into the next level null; -- use /nodebug for version and root -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- when others => ERROR_MSG(NOT_IMP); end case; end CONFIG_EXECUTE; begin Null; end COMMAND_PROCESSOR;