LBR Services, Part 2

In this article, we will complete our coverage of the code that implements the LBR_ services. Included are some services that we didn't cover in the documentation. Since that article, as I was writing the code for the Librarian, I decided that a few other LBR services needed to be added to support it. Even so, there are yet more LBR services that we will leave until a later discussion of object libraries. Also, the alert reader might wonder how the file system file will work given that multiple users may be accessing - and even updating - the file at the same time. This is handled with file locking, but that is something we haven't covered yet, so we will wait and handle that in a future article.

function Get_Data( context, line_width, routine, data, Typ, Key : int64 ) : int64 ;

var C : LBR_Context ;
    _Data : string ;
    info : TUOS_File_Info ;
    Name : string ;
    NFil : TUOS_File ;
    SRB : TSRB ;
    UEC : TUnified_Exception ;

begin
    // Sanity checks...
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    Context := Pint64( Context )^ ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;
    if( C.Sanity <> #3'LBR' ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    if( not C.Opened ) then
    begin
        Result := LBR_LIBNOTOPN ;
        exit ;
    end ;
    Name := '' ;
    if( Key <> 0 ) then
    begin
        Name := trim( Get_String( PSRB( Key )^ ) ) ;
    end ;
    if( Name = '' ) then
    begin
        Result := LBR_INVNAME ;
        exit ;
    end ;
    IF( Data <> 0 ) then
    begin
        Data := PInt64( Data )^ ;
    end ;
    if( Line_Width <> 0 ) then
    begin
        Line_Width := PInt64( Line_Width )^ ;
    end ;
    Result := 0 ;

This routine is used by two services to get data from a module. As described in the previous article's discussion of LBR services, we get the parameters, including the context. Then we validate the context.

    // Get data...
    if( Typ = 0 ) then
    begin
        Typ := C.Typ ;
    end ;
    Info := C.FS.Get_File_Info( PChar( inttostr( C.Typ ) ), 0 ) ;
    UEC := C.FS.Last_Error ;
    if( ( UEC <> nil ) and ( UEC.Get_Error <> 0 ) ) then
    begin
        Result := -1 ;
        exit ;
    end ;
    Name := inttostr( LBR_C_TYP_HLP ) + '\' + Name ;
    Info := C.FS.Get_File_Info( PChar( Name ), 0 ) ;
    if( UEC <> nil ) then
    begin
        Result := LBR_NOTFOUND ;
        exit ;
    end ;
    NFil := C.FS.Get_File( PChar( Name ) ) ;
    if( NFil = nil ) then
    begin
        Result := C.FS.Last_Error.Get_Error ;
        exit ;
    end ;
    setlength( _Data, NFil.Get_File_Size ) ;
    NFil.Read( 0, 0, length( _Data ),PChar( _Data )[ 0 ], 0 ) ;
    NFil.Free ;

Next we check for the existence of the root directory associated with the passed type. If the type is 0, we use the type specified on the call to LBR_Ini_Control. If the root directory is missing, a value of -1 is returned. Then we prefix the module name with the root directory. Next we check to see if the module exists, exiting with an error if not. Finally, we open the module as a file in the file system, read the data into a buffer, and then close the file. If there is an error opening the file, we return it.

    //TODO:break lines per Line_Width
    Set_String( _Data, SRB ) ;
    if( Routine <> 0 ) then
    begin
        LBR_Data_Callback( Routine )( Data, int64( @SRB ) ) ;
    end ;
end ; // Get_Data

The comment indicates that we haven't implemented the code to break the text into lines. The reason is that this is part of a larger issue that we will address in the future. It makes no sense to implement something temporary at this point, so we'll just leave it alone for now and the terminals can wrap the lines that are too long.
If a callback routine is specified, we call that routine with the module contents.

function LBR_Get_Help( context : int64 ; line_width : int64 = 0 ;
    routine : int64 = 0 ; data : int64 = 0 ; key : int64 = 0 ) : int64 ;

begin
    Result := Get_Data( Context, Line_Width, Routine, Data, LBR_C_TYP_HLP, Key ) ;

    if( Result = -1 ) then
    begin
        Result := LBR_NOTHLPLIB ;
        exit ;
    end ;
end ; // LBR_Get_Help


function LBR_Get_Module( context : int64 ; routine : int64 = 0 ;
    data : int64 = 0 ; key : int64 = 0 ) : int64;

begin
    Result := Get_Data( Context, 0, Routine, Data, 0, Key ) ;
end ;

These two services are nearly identical. The only difference is that LBR_Get_Help specifically looks for help data and returns a specific error if no help data is found. In the case of LBR_Get_Module, the result is the same whether or not there is any data of the type specified when LBR_Ini_Control was called. If there is no corresponding root directory, then there will be no modules in that directory so the file (module) lookup will fail and the same error (LBR_NOTFOUND) is returned. Again, this difference is to match the VMS specification.

function LBR_Module_Exists( Context, Name, Res : int64 ) : int64 ;

var C : LBR_Context ;
    Info : TUOS_File_Info ;
    _Name : string ;
    UEC : TUnified_Exception ;

begin
    // Sanity checks...
    Result := 0 ;
    if( Res = 0 ) then
    begin
        exit ;
    end ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    Context := Pint64( Context )^ ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;
    if( C.Sanity <> #3'LBR' ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    if( not C.Opened ) then
    begin
        Result := LBR_LIBNOTOPN ;
        exit ;
    end ;
    _Name := Get_String( PSRB( Name )^ ) ;
    Info := C.FS.Get_File_Info( PChar( inttostr( C.Typ ) + '\' + _Name ), 0 ) ;
    UEC := C.FS.Last_Error ;
    if( ( UEC = nil ) or ( UEC.Get_Error = 0 ) ) then
    begin
        PInt64( Res )^ := 1 ;
    end else
    begin
        PInt64( Res )^ := 0 ;
    end ;
end ; // LBR_Module_Exists

This service returns a flag indicating if the specified module exists in the library. The bulk of the function matches the previous ones: get the parameters and validate the context. Then we do a file lookup in the library file system and return the appropriate value (1 = exists, 0 = doesn't exist). Incidentally, there is no direct equivalent for this in VMS. However, I found that a quick means of checking for the existence of a module was useful, so we've added this to UOS.

function LBR_Close_Control( Context : int64 ) : int64 ;

var C : LBR_Context ;

begin
    // Sanity checks...
    Result := 0 ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    Context := Pint64( Context )^ ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;
    if( C.Sanity <> #3'LBR' ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    if( not C.Opened ) then
    begin
        Result := LBR_LIBNOTOPN ;
        exit ;
    end ;
    C.Sanity := '   ' ;
    C.Free ;
end ;

This service is used to clean up the LBR context when we are done with it. VMS doesn't have any equivalent means of cleaning up a context when you are done with it. Apparently the memory, once allocated, is there until the program ends. This seems rather sloppy, to put it kindly. In UOS, we are less sloppy. Or more obsessive. You can decide which...

type LBR_Data_Callback = procedure( Context, Data : int64 ) ; stdcall ;
     LBR_Help_Output = procedure( Data : int64 ) ; stdcall ;
     LBR_Help_Input = function() : int64 ; stdcall ;

These are the definitions used by the LBR services for callbacks.

function LBR_Output_Help( routine : int64 ; width : int64 = 0 ;
    path : int64 = 0 ; lib : int64 = 0 ; flags : int64 = 0 ;
    input : int64 = 0 ) : int64 ;

var C : LBR_Context ;
    Context : int64 ;
    Crumbs, Topics : TStringList ;
    I : integer ;
    Info : TUOS_File_Info ;
    _Lib, _Path : string ;
    NFil : TUOS_File ;
    SRB : TSRB ;
    Inp : int64 ;
    X : string ;
    WContext : pointer ;

begin
    // Setup...
    _Lib := '' ;
    if( lib <> 0 ) then
    begin
        _Lib := trim( Get_String( PSRB( lib )^ ) ) ;
    end ;
    _Path := '' ;
    if( path <> 0 ) then
    begin
        _Path := trim( Get_String( PSRB( path )^ ) ) ;
    end ;
    if( copy( _Path, 1, 1 ) = '@' ) then
    begin
        _Lib := copy( _Path, 2, length( _Path ) ) ;
        _Path := '' ;
    end ;
    Flags := PInt64( Flags )^ ;
    if( ( Flags and HLP_M_PROMPT ) = 0 ) then // We don't prompt user
    begin
        if( Input = 0 ) then // Input routine required
        begin
            Result := LBR_ILLINROU ;
            exit ;
        end ;
    end else
    begin
        Input := 0 ; // Don't use input routine
    end ;

LBR_Output_Help is the "main event", in terms of code, for the LBR services. It is the longest and most complex of the functions. If no callback routines are provided, it performs the entirety of being the help system for a program.
We start with initialization. This involves handling the "@" construct in the path, as per the documentation. If HLP_M_PROMPT is not set, we verify that an input routine was specified. If not, we exit with an error since there has to be a way to get input.

    // Parse path into crumb list...
    Crumbs := TStringList.Create ;
    while( _Path <> '' ) do
    begin
        I := pos( '\', _Path ) ;
        if( I = 0 ) then
        begin
            Crumbs.Add( _Path ) ;
            _Path := '' ;
        end else
        begin
            Crumbs.Add( trim( copy( _Path, 1, I - 1 ) ) ) ;
            _Path := trim( copy( _Path, I + 1, length( _Path ) ) ) ;
        end ;
    end ;
    for I := 0 to Crumbs.Count - 1 do
    begin
        X := Crumbs[ I ] ;
        if( ( pos( ':', X ) + pos( '*', X ) + pos( '?', X ) > 0 ) or ( X = '' ) ) then
        begin
            Result := LBR_INVPATH ;
            Crumbs.Free ;
            exit ;
        end ;
    end ;
    if( Crumbs.Count = 0 ) then // Want default topic
    begin
        Crumbs.Add( 'Index' ) ;
    end ;

    //TODO:handle HLP$LIBRARY logicals...

Next we parse the path into a string list called Crumbs. Each index in the list is one segment of the path. This allows the user to back up to a previous topic.
Also note the comment at the end of the above code. We will handle that later due to the need for an additional system service.

    // Look up (initial) topic...
    Set_String( _Lib, SRB ) ;
    Result := LBR_Ini_Control( int64( @context ), LBR_C_Read, LBR_C_TYP_HLP,
        int64( @SRB ), 0, 0, 0 ) ;
    if( Result <> 0 ) then
    begin
        Crumbs.Free ;
        exit ;
    end ;
    Result := LBR_Open( int64( @Context ), 0, 0 ) ;
    if( Result <> 0 ) then
    begin
        Crumbs.Free ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;

Now we open the library for the first topic by calling LBR_Ini_Control and LBR_Open. If there is a failure, we free the list and exit with an error.

    while( true ) do
    begin
        X := Crumbs[ Crumbs.Count - 1 ] ;
        Set_String( X, SRB ) ;
        Result := LBR_Get_Help( int64( @Context ), int64( @Width ),
            int64( @LBR_Callback ), 0, int64( @SRB ) ) ;
        if( Result = LBR_NOTFOUND ) then
        begin
            if( Routine <> 0 ) then
            begin
                break ;
            end ;
            LIB_Put_Output( 'Topic ' + X + ' not found' ) ;
            Crumbs.Delete( Crumbs.Count - 1 ) ;
            if( Crumbs.Count = 0 ) then // No topics found
            begin
                break ;
            end ;
            continue ;
        end ;
        if( Result <> 0 ) then
        begin
            break ;
        end ;

The main part of this routine is an loop that only ends under specific circumstances. We start by getting the most recent topic from the crumb list. Then we get the help text from the library with LBR_Get_Help. If the topic isn't found, we let the user know via LBR_Put_Output, remove the most recent topic from the crumb list and then, if there are no more crumbs, exit the loop. If there is any other error (Result is not zero), we also exit the loop.

        if( Routine <> 0 ) then
        begin
            Set_String( Help_Data, SRB ) ;
            LBR_Help_Output( Routine )( int64( @SRB ) ) ;
        end else
        begin
            //TODO: For now we assume the output is plain text, but later we need
            // to handle GUI, Postscript, etc.
            X := From_HTML( Help_Data, 0 ) ;
            if( copy( X, length( X ) - 1, 2 ) <> CRLF ) then
            begin
                X := X + CRLF ; // Make sure we end the last line
            end ;
            LIB_Put_Output( X ) ;

Now we are ready to output the help text to the user. If an output routine is specified, we call that routine, passing a pointer to an SRB structure that points to the help text. However, if there is no output routine supplied, we convert the HTML to plain text (note the comment that in the future we will need to address output other than plain text). If the help text doesn't end in a CRLF (new line), we append one. Then we output the text to the user.

            Topics := TStringList.Create ;
            I := pos( '<a', lowercase( Help_Data ) ) ;
            while( I > 0 ) do
            begin
                Help_Data := copy( Help_Data, I, length( Help_Data ) ) ;
                I := pos( '"', Help_Data ) ;
                if( I = 0 ) then
                begin
                    break ;
                end ;
                Help_Data := copy( Help_Data, I + 1, length( Help_Data ) ) ;
                I := pos( '"', Help_Data ) ;
                if( I = 0 ) then
                begin
                    break ;
                end ;
                if( I > 1 ) then // Not null topic
                begin
                    Topics.Add( copy( Help_Data, 1, I - 1 ) ) ;
                end ;
                Help_Data := copy( Help_Data, I + 1, length( Help_Data ) ) ;

                I := pos( '<a', lowercase( Help_Data ) ) ; // Find next topic
            end ; // while( I > 0 )
            Topics.Sort ;

Now we extract all anchor tag topic references from the HTML text, building a topic list, which we then sort.

            I := 0 ;
            if( Topics.Count > 0 ) then
            begin
                LIB_Put_Output( CRLF + 'Additional information available:' + CRLF ) ;
                while( I < Topics.Count ) do
                begin
                    if( 
                        ( I = 0 ) 
                        or 
                        ( lowercase( Topics[ I ] ) <> lowercase( Topics[ I - 1 ] ) ) 
                      ) then
                    begin
                        LIB_Put_Output( Topics[ I ] + HT ) ;
                    end ;
                end ;
                LIB_Put_Output( CRLF + CRLF ) ;
            end ;
            Topics.Free ;
        end ; // if( Routine <> 0 ) else

If we found any anchor tags, we loop through the Topics list and display them to the user after outputting "Additional information available:". Each topic name is followed by a horizontal tab and we leave it to the output device to wrap the lines. Note also that when we built the list, it is possible that there might be duplicate topics. So, in this loop we skip any topic if it is identical to the previous topic.

        if( Input <> 0 ) then
        begin
            Inp := LBR_Help_Input( Input )() ;
            if( Inp = 0 ) then
            begin
                X := '' ;
            end else
            begin
                X := Get_String( PSRB( Inp )^ ) ;
            end ;
        end else
        begin
            X := Get_Command( 'Topic? ' ) ;
        end ;

If the user provided an input routine, we call it. Otherwise we call Get_Command to query the user for the next topic. Note that a return of nil from the user-supplied input routine is treated as a null string.

        // Process user response...
        if( X = '?' ) then // Display list of topics
        begin
            X := string( C.FS.Lookup( PChar( inttostr( LBR_C_TYP_HLP ) + '\*.*' ), WContext ) ) ;
            Topics := TStringList.Create ;
            while( X <> '' ) do
            begin
                Topics.Add( X ) ;
                X := string( C.FS.Lookup( nil, WContext ) ) ;
            end ;
            Topics.Sort ;
            for I := 0 to Topics.Count - 1 do
            begin
                Put_Output( Topics[ I ] + HT ) ;
            end ;
            Topics.Free ;
        end else

Now we process the user's response. If they type a question mark (?), we display a list of topics in the help library. This is done via a file lookup loop in the file system file. Again, we output a horizontal tab after the topic name and let the output device wrap the lines for us.

        if( X = Control_Z ) then // Exit help session
        begin
            break ;
        end else
        if( X = '' ) then // Return to previously viewed topic
        begin
            if( Crumbs.Count < 2 ) then
            begin
                break ;
            end ;
            Crumbs.Delete( Crumbs.Count - 1 ) ;
        end else
        begin
            // Assume result is a module (topic) name...
            Crumbs.Add( X ) ;
        end ;
    end ; // while( true )

If the user types control-Z, we immediately exit. If the user simply presses ENTER, we return to the previous topic by deleting the most-recent topic in the crumbs list. If this was the last topic in the list, the loop will exit. Any other response from the user is assumed to be the name of a new topic. We then add that to the end of the crumbs list.

    LBR_Close( int64( @Context ) ) ;
    Crumbs.Free ;
end ; // LBR_Output_Help

Finally, after the loop ends, we close the library via LBR_Close, and free the crumbs list.

In the next article, we will look at the documentation for the LBR services that we didn't previously document, and we'll also cover the Librarian documentation.