Document revision date: 30 March 2001

Each item in the following list corresponds to a number highlighted in Example 11-3:

1. Call LBR$INI_CONTROL, specifying that the function to be performed is update and that the library type is text.
2. Call LBR$LOOKUP_KEY to find the key that points to the module you want to extract.
3. Open an output file to receive the extracted module.
4. Initialize the variable that is to receive the extracted records to null characters.
5. Call LBR$GET_RECORD to see if there are more records in the file (module). A failure indicates that the end of the file has been reached.
6. Write the extracted record data to the output file. This record should consist only of the data up to the first null character.

Example 11-4 illustrates the deletion of library module from a Compaq Pascal program. The program is summarized in the following steps:

1. Call LBR$LOOKUP_KEY, and specify the name of the module as the second argument. LBR$LOOKUP_KEY returns the RFA of the module as the third argument; do not alter this value.
2. Call LBR$DELETE_KEY to delete the module key. Specify the name of the module as the second argument.
3. Call LBR$DELETE_DATA to delete the module itself. Specify the RFA of the module obtained in Step 1 as the second argument.

Example 11-4 Deleting a Module from a Library Using Compaq Pascal

PROGRAM deletemod(INPUT,OUTPUT); (*This program deletes a module from a library*) TYPE Rfa_Ptr = ARRAY [0..1] OF INTEGER; (*Data type of RFA of module*) VAR LBR$C_UPDATE, (*Constants for LBR$INI_CONTROL*) LBR$C_TYP_TXT, (*Defined in $LBRDEF macro*) LBR$_KEYNOTFND : [EXTERNAL] INTEGER;(*Error code for LBR$LOOKUP_KEY*) Lib_Name : VARYING [128] OF CHAR; (*Name of library receiving module*) Module_Name : VARYING [31] OF CHAR; (*Name of module to insert*) Text_Data_Record : VARYING [255] OF CHAR; (*Record in new module*) Textin : FILE OF VARYING [255] OF CHAR; (*File containing new module*) lib_index_ptr : UNSIGNED; (*Value returned in library init*) status : UNSIGNED; (*Return status for function calls*) txtrfa_ptr : Rfa_Ptr; (*For key lookup and insertion*) Key_Not_Found : BOOLEAN := FALSE; (*True if new mod not already in lib*) (*-*-*-*-Function Definitions-*-*-*-*) (*Function that returns library control index used by Librarian*) FUNCTION LBR$INI_CONTROL (VAR library_index: UNSIGNED; func: UNSIGNED; typ: UNSIGNED; VAR namblk: ARRAY[l..u:INTEGER] OF INTEGER := %IMMED 0): INTEGER; EXTERN; (*Function that creates/opens library*) FUNCTION LBR$OPEN (library_index: UNSIGNED; fns: [class_s]PACKED ARRAY[l..u:INTEGER] OF CHAR; create_options: ARRAY [l2..u2:INTEGER] OF INTEGER := %IMMED 0; dns: [CLASS_S] PACKED ARRAY [l3..u3:INTEGER] OF CHAR := %IMMED 0; rlfna: ARRAY [l4..u4:INTEGER] OF INTEGER := %IMMED 0; rns: [CLASS_S] PACKED ARRAY [l5..u5:INTEGER] OF CHAR := %IMMED 0; VAR rnslen: INTEGER := %IMMED 0): INTEGER; EXTERN; (*Function that finds a key in index*) FUNCTION LBR$LOOKUP_KEY (library_index: UNSIGNED; key_name:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF CHAR; VAR txtrfa: Rfa_Ptr): INTEGER; EXTERN; (*Function that removes a key from an index*) FUNCTION LBR$DELETE_KEY (library_index: UNSIGNED; key_name:[CLASS_S] PACKED ARRAY [l..u:INTEGER] OF CHAR): INTEGER; EXTERN;

(*Function that deletes all the records associated with a module*) FUNCTION LBR$DELETE_DATA (library_index: UNSIGNED; txtrfa: Rfa_Ptr): INTEGER; EXTERN; (*Function that closes library*) FUNCTION LBR$CLOSE (library_index: UNSIGNED): INTEGER; EXTERN; BEGIN (* *************** DECLARATIONS COMPLETE ************************* *************** MAIN PROGRAM BEGINS HERE ********************** *) (* Get Library Name and Module to Delete *) WRITE('Library Name: '); READLN(Lib_Name); WRITE('Module Name: '); READLN(Module_Name); (*Initialize lib for update access*) status := LBR$INI_CONTROL (lib_index_ptr, (1) IADDRESS(LBR$C_UPDATE), (*Update access*) IADDRESS(LBR$C_TYP_TXT)); (*Text library*) IF NOT ODD(status) THEN (*Check error status*) WRITELN('Initialization Failed') ELSE (*Initialization was successful*) BEGIN status := LBR$OPEN (lib_index_ptr, (*Open the library*) Lib_Name); IF NOT ODD(status) THEN (*Check error status*) WRITELN('Open Not Successful') ELSE (*Open was successful*) BEGIN (2) (*Is module in the library?*) status := LBR$LOOKUP_KEY (lib_index_ptr, Module_Name, txtrfa_ptr); IF NOT ODD(status) THEN (*Check status*) WRITELN('Lookup Key Not Successful') END END; IF ODD(status) THEN (*Key was found; delete it*) BEGIN status := LBR$DELETE_KEY (lib_index_ptr, (3) Module_Name); IF NOT ODD(status) THEN WRITELN('Delete Key Routine Not Successful') ELSE (*Delete key was successful*) BEGIN (*Now delete module's data records*) status := LBR$DELETE_DATA (lib_index_ptr, (4) txtrfa_ptr); IF NOT ODD(status) THEN WRITELN('Delete Data Routine Not Successful') END END; status := LBR$CLOSE(lib_index_ptr); (*Close the library*) IF NOT ODD(status) THEN WRITELN('Close Not Successful'); END. (*of program deletemod*)

Each item in the following list corresponds to a number highlighted in Example 11-4:

1. Call LBR$INI_CONTROL, specifying that the function to be performed is update and the library type is text.
2. Call LBR$LOOKUP_KEY to find the key associated with the module you want to delete.
3. Call LBR$DELETE_KEY to delete the key associated with the module you want to delete. If more than one key points to the module, you need to call LBR$LOOKUP_KEY and LBR$DELETE_KEY for each key.
4. Call LBR$DELETE_DATA to delete the module (the module header and data) from the library.

You can point to the same module with more than one key. The keys can be in the primary index (index 1) or alternate indexes (indexes 2 through 10). The best method is to reserve the primary index for module names. In system-defined object libraries, index 2 contains the global symbols defined by the various modules.

Example 11-5 illustrates the way that keys can be associated with modules.

Example 11-5 Associating Keys with Modules

SUBROUTINE ALIAS (INDEX) ! Catalogs modules by alias INTEGER STATUS, ! Return status INDEX, ! Library index TXTRFA (2) ! RFA of module CHARACTER*31 MODNAME, ! Name of module ALIASNAME ! Name of alias INTEGER MODNAME_LEN ! Length of module name INTEGER ALIASNAME_LEN ! Length of alias name ! VMS library procedures INTEGER LBR$LOOKUP_KEY, LBR$SET_INDEX, LBR$INSERT_KEY, LIB$GET_INPUT, LIB$GET_VALUE LIB$LOCC ! Return codes EXTERNAL LBR$_KEYNOTFND, ! Key not found LBR$_DUPKEY, ! Duplicate key RMS$_EOF, ! End of text in module DOLIB_NOMOD ! No such module ! Get module name from /ALIAS on command line CALL CLI$GET_VALUE ('ALIAS', MODNAME) ! Calculate length of module name MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1 ! Look up module name in library index STATUS = LBR$LOOKUP_KEY (INDEX, MODNAME (1:MODNAME_LEN), TXTRFA) END IF ! Insert aliases if module exists IF (STATUS) THEN ! Set to index 2 STATUS = LBR$SET_INDEX (INDEX, 2) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Get alias name from /ALIAS on command line STATUS = CLI$GET_VALUE ('ALIAS', ALIASNAME) ! Insert aliases in index 2 until bad return status ! which indicates end of qualifier values DO WHILE (STATUS) ! Calculate length of alias name ALIASNAME_LEN = LIB$LOCC (' ', ALIASNAME) - 1 ! Put alias name in index STATUS = LBR$INSERT_KEY (INDEX, ALIASNAME (1:ALIASNAME_LEN), TXTRFA) IF ((.NOT. STATUS) .AND. (STATUS .NE. %LOC (LBR$_DUPKEY)) THEN CALL LIB$SIGNAL (%VAL (STATUS)) END IF ! Get another alias STATUS = CLI$GET_VALUE ('ALIAS', ALIASNAME) END DO ! Issue warning if module does not exist ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN CALL LIB$SIGNAL (DOLIB_NOMOD, %VAL (1), MODNAME (1:MODNAME_LEN)) ELSE CALL LIB$SIGNAL (%VAL (STATUS)) END IF ! Exit END

You can look up a module using any of the keys associated with it. The following code fragment checks index 2 for a key if the lookup in the primary index fails:

STATUS = LBR$SET_INDEX (INDEX, 1) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) STATUS = LBR$LOOKUP_KEY (INDEX, MODNAME (1:MODNAME_LEN), TXTRFA) IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN STATUS = LBR$SET_INDEX (INDEX, 2) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) STATUS = LBR$LOOKUP_KEY (INDEX, MODNAME (1:MODNAME_LEN), TXTRFA) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) END IF

There are two ways to identify the keys associated with a module:

• Use the LBR$LOOKUP_KEY routine to look up the module using one of the keys.
• Use LBR$SEARCH to search applicable indexes for the keys. LBR$SEARCH calls a user-written routine each time it retrieves a key. The routine must be an integer function defined as external that returns a success (odd number) or failure (even number) status. LBR$SEARCH stops processing on a return status of failure.

Example 11-6 Listing Keys Associated with a Module

. . . SUBROUTINE SHOWAL (INDEX) ! Lists aliases for a module INTEGER STATUS, ! Return status INDEX, ! Library index TXTRFA (2) ! RFA for module text CHARACTER*31 MODNAME ! Name of module INTEGER MODNAME_LEN ! Length of module name ! VMS library procedures INTEGER LBR$LOOKUP_KEY, LBR$SEARCH, LIB$LOCC ! Return codes EXTERNAL LBR$_KEYNOTFND, ! Key not found DOLIB_NOMOD ! No such module ! Search routine EXTERNAL SEARCH INTEGER SEARCH ! Get module name and calculate length CALL CLI$GET_VALUE ('SHOWALIAS', MODNAME) MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1 ! Look up module in index 1 STATUS = LBR$LOOKUP_KEY (INDEX, MODNAME (1:MODNAME_LEN), TXTRFA) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Search for alias names in index 2 STATUS = LBR$SEARCH (INDEX, 2, TXTRFA, SEARCH) END INTEGER FUNCTION SEARCH (ALIASNAME, RFA) ! Function called for each alias name pointing to MODNAME ! Displays the alias name INTEGER STATUS_OK, ! Good return status RFA (2) ! RFA of module PARAMETER (STATUS_OK = 1) ! Odd number CHARACTER*(*) ALIASNAME ! Name of module ! Display module name TYPE *, MODNAME ! Exit SEARCH = STATUS_OK END

11.2.6 Accessing Module Headers

You can store user information in the header of each module up to the total size of the header specified at library creation time in the CRE$L_UHDMAX option. The total size of each header in bytes is the value of MHD$B_USRDAT plus the value assigned to the CRE$L_UHDMAX option. The value of MHD$B_USRDAT is defined by the macro $MHDDEF; the default value is 16 bytes.

To put user data into a module header, first locate the module with LBR$LOOKUP_KEY; then move the data to the module header by invoking LBR$SET_MODULE, specifying the first argument (index value returned by LBR$INI_CONTROL), the second argument (RFA returned by LBR$LOOKUP_KEY), and the fifth argument (character string containing the user data).

To read user data from a module header, first locate the module with LBR$LOOKUP_KEY; then, retrieve the entire module header by invoking LBR$SET_MODULE, specifying the first, second, third (character string to receive the contents of the module header), and fourth (length of the module header) arguments. The user data starts at the byte offset defined by MHD$B_USRDAT. Convert this value to a character string subscript by adding 1.

Example 11-7 displays the user data portion of module headers on SYS$OUTPUT and applies updates from SYS$INPUT.

Example 11-7 Displaying the Module Header

. . . SUBROUTINE MODHEAD (INDEX) ! Modifies module headers INTEGER STATUS, ! Return status INDEX, ! Library index TXTRFA (2) ! RFA of module CHARACTER*31 MODNAME ! Name of module INTEGER MODNAME_LEN ! Length of module name CHARACTER*80 HEADER ! Module header INTEGER HEADER_LEN ! Length of module header INTEGER USER_START ! Start of user data in header CHARACTER*64 USERDATA ! User data part of header INTEGER*2 USERDATA_LEN ! Length of user data ! VMS library procedures INTEGER LBR$LOOKUP_KEY, LBR$SET_MODULE, LIB$GET_INPUT, LIB$PUT_OUTPUT, CLI$GET_VALUE, LIB$LOCC ! Offset to user data --- defined in $MHDDEF EXTERNAL MHD$B_USRDAT ! Return codes EXTERNAL LBR$_KEYNOTFND, ! Key not found DOLIB_NOMOD ! No such module ! Calculate start of user data in header USER_START = %LOC (MHD$B_USRDAT) + 1 ! Get module name from /MODHEAD on command line STATUS = CLI$GET_VALUE ('MODHEAD', MODNAME) ! Get module headers until bad return status ! which indicates end of qualifier values DO WHILE (STATUS) ! Calculate length of module name MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1 ! Look up module name in library index STATUS = LBR$LOOKUP_KEY (INDEX, MODNAME (1:MODNAME_LEN), TXTRFA) ! Get header if module exists IF (STATUS) THEN STATUS = LBR$SET_MODULE (INDEX, TXTRFA, HEADER, HEADER_LEN) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Display header and solicit replacement STATUS = LIB$PUT_OUTPUT ('User data for module '//MODNAME (1:MODNAME_LEN)//':') IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) STATUS = LIB$PUT_OUTPUT (HEADER (USER_START:HEADER_LEN)) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) STATUS = LIB$PUT_OUTPUT ('Enter replacement text below or just hit return:') IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) STATUS = LIB$GET_INPUT (USERDATA,, USERDATA_LEN) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Replace user data IF (USERDATA_LEN .GT. 0) THEN STATUS = LBR$SET_MODULE (INDEX, TXTRFA,,, USERDATA (1:USERDATA_LEN)) END IF ! Issue warning if module does not exist ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN CALL LIB$SIGNAL (DOLIB_NOMOD, %VAL (1), MODNAME (1:MODNAME_LEN)) ELSE CALL LIB$SIGNAL (%VAL (STATUS)) END IF ! Get another module name STATUS = CLI$GET_VALUE ('MODHEAD', MODNAME) END DO ! Exit END

11.2.7 Reading Library Headers

Call LBR$GET_HEADER to obtain general information concerning the library. Pass the value returned by LBR$INI_CONTROL as the first argument. LBR$GET_HEADER returns the information to the second argument, which must be an array of 128 longwords. The LHI symbols identify the significant longwords of the array by their byte offsets into the array. Convert these values to subscripts by dividing by 4 and adding 1.

Example 11-8 reads the library header and displays some information from it.

Example 11-8 Reading Library Headers

. . . SUBROUTINE TYPEINFO (INDEX) ! Types the type, major ID, and minor ID ! of a library to SYS$OUTPUT INTEGER STATUS ! Return status INDEX, ! Library index HEADER (128), ! Structure for header information TYPE, ! Subscripts for header structure MAJOR_ID, MINOR_ID CHARACTER*8 MAJOR_ID_TEXT, ! Display info in character format MINOR_ID_TEXT ! VMS library procedures INTEGER LBR$GET_HEADER, LIB$PUT_OUTPUT ! Offsets for header --- defined in $LHIDEF EXTERNAL LHI$L_TYPE, LHI$L_MAJORID, LHI$L_MINORID ! Library type values --- defined in $LBRDEF EXTERNAL LBR$C_TYP_OBJ, LBR$C_TYP_MLB, LBR$C_TYP_HLP, LBR$C_TYP_TXT ! Get header information STATUS = LBR$GET_HEADER (INDEX, HEADER) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Calculate subscripts for header structure TYPE = %LOC (LHI$L_TYPE) / 4 + 1 MAJOR_ID = %LOC (LHI$L_MAJORID) / 4 + 1 MINOR_ID = %LOC (LHI$L_MINORID) / 4 + 1 ! Display library type IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_OBJ)) THEN STATUS = LIB$PUT_OUTPUT ('Library type: object') ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_MLB)) THEN STATUS = LIB$PUT_OUTPUT ('Library type: macro') ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_HLP)) THEN STATUS = LIB$PUT_OUTPUT ('Library type: help') ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_TXT)) THEN STATUS = LIB$PUT_OUTPUT ('Library type: text') ELSE STATUS = LIB$PUT_OUTPUT ('Library type: unknown') END IF IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Convert and display major ID WRITE (UNIT=MAJOR_ID_TEXT, FMT='(I)') HEADER (MAJOR_ID) STATUS = LIB$PUT_OUTPUT ('Major ID: '//MAJOR_ID_TEXT) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Convert and display minor ID WRITE (UNIT=MINOR_ID_TEXT, FMT='(I)') HEADER (MINOR_ID) STATUS = LIB$PUT_OUTPUT ('Minor ID: '//MINOR_ID_TEXT) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Exit END

11.2.8 Displaying Help Text

You can display text from a help library by calling the LBR$OUTPUT_HELP routine and specifying the output routine, the keywords, and the name of the library. You must also specify the input routine if the prompting mode flag is set or if the flags argument is omitted.

You can use the LIB$PUT_OUTPUT and LIB$GET_INPUT routines to specify the output routine and the input routine. (If you use your own routines, make sure the argument lists are the same as for LIB$PUT_OUTPUT and LIB$GET_INPUT.) Do not call LBR$INI_CONTROL and LBR$OPEN before calling LBR$OUTPUT_HELP.

Example 11-9 solicits keywords from SYS$INPUT and displays the text associated with those keywords on SYS$OUTPUT, thus inhibiting the prompting facility.

Example 11-9 Displaying Text from a Help Library

PROGRAM GET_HELP ! Prints help text from a help library CHARACTER*31 LIBSPEC ! Library name CHARACTER*15 KEYWORD ! Keyword in help library INTEGER*2 LIBSPEC_LEN, ! Length of name KEYWORD_LEN ! Length of keyword INTEGER FLAGS, ! Help flags STATUS ! Return status ! VMS library procedures INTEGER LBR$OUTPUT_HELP, LIB$GET_INPUT, LIB$PUT_OUTPUT EXTERNAL LIB$GET_INPUT, LIB$PUT_OUTPUT ! Error codes EXTERNAL RMS$_EOF, ! End-of-file LIB$_INPSTRTRU ! Input string truncated ! Flag values --- defined in $HLPDEF EXTERNAL HLP$M_PROMPT, HLP$M_PROCESS, HLP$M_GROUP, HLP$M_SYSTEM, HLP$M_LIBLIST, HLP$M_HELP ! Get library name STATUS = LIB$GET_INPUT (LIBSPEC, 'Library: ', LIBSPEC_LEN) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) IF (LIBSPEC_LEN .EQ. 0) THEN LIBSPEC = 'HELPLIB' LIBSPEC_LEN = 7 END IF ! Set flags for no prompting FLAGS = %LOC (HLP$_PROCESS) + %LOC (HLP$_GROUP) + %LOC (HLP$_SYSTEM) ! Get first keyword STATUS = LIB$GET_INPUT (KEYWORD, 'Keyword or Ctrl/Z: ', KEYWORD_LEN) IF ((.NOT. STATUS) .AND. (STATUS .NE. %LOC (LIB$_INPSTRTRU)) .AND. (STATUS .NE. %LOC (RMS$_EOF))) THEN CALL LIB$SIGNAL (%VAL (STATUS)) END IF ! Display text until end-of-file DO WHILE (STATUS .NE. %LOC (RMS$_EOF)) STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT,, KEYWORD (1:KEYWORD_LEN), LIBSPEC (1:LIBSPEC_LEN), FLAGS, LIB$GET_INPUT) IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) ! Get another keyword STATUS = LIB$GET_INPUT (KEYWORD, 'Keyword or Ctrl/Z: ', KEYWORD_LEN) IF ((.NOT. STATUS) .AND. (STATUS .NE. %LOC (LIB$_INPSTRTRU)) .AND. (STATUS .NE. %LOC (RMS$_EOF))) THEN CALL LIB$SIGNAL (%VAL (STATUS)) END IF END DO ! Exit END

	privacy and legal statement
4493PRO_021.HTML