Object Exists

Summary

The following are the RPG/LE fully free-form definitions and instructions needed for using the Object Exists service procedure. This service procedure simply allows the caller to check if an object exists on the system.

By Dave Clark

Service Prototype

Place the following in a separate copybook for inclusion in both the caller and the service program source members.

**free

//******************************************************************************
// Uses an IBM API to determine if the specified object exists and, optionally,
// returns the object's library and/or description attributes.  The current
// job user must also have at least *USE authority to the specified object.
//******************************************************************************
dcl-pr GenUtl_ObjectExists   ind;
  pObjectName                char(10)  const;
  pObjectType                char(10);
  pLibraryName               char(10)            options(*nopass);
  pObjectDesc                likeds(QUSD0200)    options(*varsize:*nopass);
end-pr;

Service Procedure

Place the following in a service program source member.

**free
ctl-opt NoMain AlwNull(*UsrCtl) Debug Option(*SrcStmt:*NoDebugIo)
        DatFmt(*ISO) TimFmt(*ISO);

//******************************************************************************
// Uses an IBM API to determine if the specified object exists and, optionally,
// returns the object's library and/or description attributes.  The current
// job user must also have at least *USE authority to the specified object.
//******************************************************************************
dcl-proc GenUtl_ObjectExists export;
  dcl-pi *n                  ind;
    pObjectName              char(10)  const;
    pObjectType              char(10);
    pLibraryName             char(10)            options(*nopass);
    pObjectDesc              likeds(QUSD0200)    options(*varsize:*nopass);
  end-pi;

  dcl-s objExists            ind       inz(*on);
  dcl-s iLibraryName         char(10);

  if %parms() < %parmnum(pLibraryName) // if library name not supplied
  or %addr(pLibraryName) = *null       // or was omitted
  or pLibraryName <= *blanks;          // or is blank
    if pObjectType = '*AUTL';             // for authorization lists
      iLibraryName = 'QSYS';              // use QSYS library default
    else;                                 // else
      iLibraryName = '*LIBL';             // search library list by default
    endif;
  else;                                // else
    iLibraryName = pLibraryName;       // use supplied library name
  endif;

  callp IBMAPI_RtvObjDesc( QUSD0200: %len(QUSD0200): 'OBJD0200'
                         : pObjectName + iLibraryName: pObjectType
                         : ApiErrC );
  if ApiErrC.BytAvail > *zero;         // if errors...
    objExists = *off;                  // assume it does not exist
    if ApiErrC.MsgId <> 'CPF9801';     // if more than just 'not found'
      pObjectType = 'MSG' + ApiErrC.MsgId; // return exception msgid
    endif;
  else;
    if %parms >= %parmnum(pLibraryName) // if library parm passed
    and %addr(pLibraryName) <> *null;  // and was not omitted
      pLibraryName = QUSOBJLN00;       // return library where found
    endif;
    if %parms >= %parmnum(pObjectDesc) // if description parm passed
    and %addr(pObjectDesc) <> *null;   // and was not omitted
      %subst(pObjectDesc: 1: %len(QUSD0200)) = QUSD0200; // return full desc
    endif;
  endif;

  return objExists;                    // indicate existence
end-proc;

Example

See the Get Job List service procedure.

References

• API Error Code Structure (ApiErrC)
• IBMAPI_RtvObjDesc API