?? RIGHT := 110 ??
?? NEWTITLE := 'INSTALL_SOFTWARE Utility: $DEFERRED_SUBPRODUCTS Function.' ??
MODULE ram$deferred_subproducts_func;

{ PURPOSE:
{   This module contains the SCL interface that determines if there are
{   any deferred subproducts in the IDB directory.
{
{ DESIGN:
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$work_area_overflow
*copyc clt$work_area
*copyc clt$data_value
*copyc ost$status
*copyc pmt$condition
*copyc rac$idb_directory_name
*copyc rae$install_software_cc
*copyc rat$idb_directory_types
?? POP ??
*copyc amp$get_segment_pointer
*copyc clp$evaluate_parameters
*copyc clp$make_boolean_value
*copyc fsp$close_file
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc rap$access_directory_for_read
*copyc rav$installation_defaults

?? OLDTITLE, NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
?? OLDTITLE, NEWTITLE := '[XDCL] rap$deferred_subproducts_func', EJECT ??

{ PURPOSE:
{   This interface checks the IDB directory and returns a boolean indicating
{   if there are any deferred subproducts in the directory.
{
{ DESIGN:
{   This procedure is set up as a standard SCL function.
{
{   Access the directory, whose location is determined via the current
{   installation defaults.  Once accessed, return the current value
{   of the field in the directory header which indicates if deferred
{   subproducts are contained in the directory.
{ NOTES:
{   The boolean in the header is assumed to be accurate, it is not checked
{   against each subproduct record in the directory.

  PROCEDURE [XDCL] rap$deferred_subproducts_func
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);


{ FUNCTION $deferred_products()

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [88, 8, 11, 16, 46, 5, 116],
    clc$function, 0, 0, 0, 0, 0, 0, 0, '$DEFERRED_PRODUCTS']];

?? POP ??

    VAR
      directory_pointers: rat$idb_directory_pointers,
      local_status: ost$status,
      idb_fid: amt$file_identifier,
      idb_opened: boolean;

?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If the directory has been openned, it is closed before the
{   the procedure returns.
{
    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF idb_opened THEN
        fsp$close_file (idb_fid, ignore_status)
      IFEND

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    idb_opened := FALSE;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL,
        {No PVT} NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

      rap$access_directory_for_read (rav$installation_defaults.installation_database, directory_pointers,
            idb_fid, idb_opened, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      clp$make_boolean_value ((directory_pointers.header_p^.deferred_count > 0), clc$true_false_boolean,
            work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '$deferred_subroducts', status);
        RETURN;
      IFEND;

    END /main/;

    IF idb_opened THEN
      fsp$close_file (idb_fid, local_status);
    IFEND;

    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$deferred_subproducts_func;
MODEND ram$deferred_subproducts_func;
