RpgleDBG205R4 < DBG400

<verbatim>
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT) DFTACTGRP(*NO)
     H COPYRIGHT('Copyright (C) 2003  Martin Rowe   <martin@dbg400.net>')
      **********************************************************************************************
      * DBG205R4: DASD monitor
      * Copyright (C) 2003  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
      **********************************************************************************************
      * PROTOTYPES:
      **********************************************************************************************
     D RunCmd          PR             1N
     D  Command                     999    Options(*VARSIZE) Const
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
      *  Message queue array
     D P_MsgQueue      S             20    Dim(50)
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
     D                SDS
     D SDS_Pgm                       10
      *  Receiver value DS
     D RcvrDS          DS            68
     D  BytesAvail                   10I 0
     D  BytesReturned                10I 0
     D  CurDateTime                   8
     D  SystemName                    8
     D  ElapsedTime                   6
     D  RetrictState                  1
     D  Reserved1                     1
     D  PctProcUnit                  10I 0
     D  JobsInSystem                 10I 0
     D  PctPermAddr                  10I 0
     D  PctTempAddr                  10I 0
     D  SystemASP                    10I 0
     D  PctSystemASP                 10I 0
     D  TotAuxStorage                10I 0
     D  CurUnProStg                  10I 0
     D  MaxUnProStg                  10I 0
      *  Standard error code DS for API error handling
     D Error_Code      DS           272
     D  ErrBytesProvd                10I 0 Inz(0)
     D  ErrBytesAvail                10I 0 Inz(0)
     D  ErrExcept_ID                  7
     D  ErrReserved                   1
     D  ErrException                256
      * Receiver value DS for user space header info (used in first call to QUSRTVUS)
     D GenRcvrDS       DS
     D  UserArea                     64
     D  GenHdrSize                   10I 0
     D  StrucLevel                    4
     D  FormatName                    8
     D  APIUsed                      10
     D  CreateStamp                  13
     D  InfoStatus                    1
     D  SizeUsUsed                   10I 0
     D  InpParmOff                   10I 0
     D  InpParmSiz                   10I 0
     D  HeadOffset                   10I 0
     D  HeaderSize                   10I 0
     D  ListOffset                   10I 0
     D  ListSize                     10I 0
     D  ListNumber                   10I 0
     D  EntrySize                    10I 0
      * Type Definition for the JOBL0200 format.
     D ListDataDS      DS
     D  L_JobName                    10
     D  L_JobUser                    10
     D  L_JobNbr                      6
     D  L_JobIdent                   16
     D  L_Status                     10
     D  L_JobType                     1
     D  L_JobSubTy                    1
     D  L_Reserved                    2
     D  L_JobInfoSts                  1
     D  L_Reserved2                   3
     D  L_NbrFldsRtn                 10I 0
      * Repeated section for each key
     D  L_Variable                 2000
      *
     D Key1Info        DS            20
     D  L_LenInfoRtn1                10I 0
     D  L_KeyFld1                    10I 0
     D  L_DataType1                   1
     D  L_Reservedx1                  3
     D  L_LenDataRtn1                10I 0
     D  L_KeyValue1                  10I 0
      *
     D Key2Info        DS            20
     D  L_LenInfoRtn2                10I 0
     D  L_KeyFld2                    10I 0
     D  L_DataType2                   1
     D  L_Reservedx2                  3
     D  L_LenDataRtn2                10I 0
     D  L_KeyValue2                   4
      *  Message queue definition
     D                 DS
     D MsgQueue                      20
     D  MsgQueName                   10    Overlay(MsgQueue)
     D  MsgQueLib                    10    Overlay(MsgQueue:11)
      *
     D PackAsChar      DS
     D  PackedFld1                    3P 0
     D  CharFld1                      2    Overlay(PackedFld1)
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D Cumulative      S              7  4
     D CurrentEnt      S              5P 0 Inz(1)
     D DataLength      S             10I 0 Inz(140)
     D Difference      S              7  4
     D ExtendAttr      S             10    Inz('USRSPC    ')
     D FirstTime       S              1N   Inz(*On)
     D Flag            S              3
     D Format          S              8
     D Index           S             10I 0
     D InitialSiz      S             10I 0 Inz(1024)
     D InitialVal      S              1    Inz(X'00')
     D JobStatus       S             10    Inz('*ACTIVE   ')
     D JobType         S              1    Inz('*')
     D KeyOffSet       S             10I 0
     D KeysToRtn       S             10I 0 Dim(2)
     D ListFormat      S              8    Inz('JOBL0200')
     D NbrToRtn        S             10I 0 Inz(2)
     D P_DtaqData      S              1
     D P_DtaqLen       S              5  0
     D P_DtaqLib       S             10
     D P_DtaqName      S             10
     D P_DtaqWait      S              5  0
     D P_ErrorID       S              7
     D P_MsgData       S            512
     D P_MsgDtaLn      S              5  0
     D P_MsgFile       S             10
     D P_MsgID         S              7
     D P_MsgQueLn      S              5  0
     D P_MsgType       S             10
     D P_MsgfLib       S             10
     D P_RplyMsgQ      S             20
     D peDiskIncrease  S              5  2
     D peDiskUse       S              3  0
     D peFrequency     S              3  0
     D peTempStorage   S              5  0
     D Percentage      S              7  4
     D PrevDiff        S              7  4
     D PrevPercent     S              7  4
     D PublicAut       S             10    Inz('*ALL      ')
     D QualifyJob      S             26    Inz('*ALL      *ALL      *ALL  ')
     D QualJob         S             28    Varying
     D RCVRLen         S             10I 0
     D ReplaceSpc      S             10    Inz('*YES      ')
     D RstStsStat      S             10
     D SubstOffset     S             10I 0 Inz(1)
     D StartPos        S             10I 0 Inz(1)
     D TextDescrp      S             50    Inz('User space for List Job API')
     D ThresholdMb     S             10I 0
     D UserSpace       S             20    Inz('DASDMON   QTEMP     ')
     D MessageUsers    S             50    DtaAra(DASDMON)
     D WarnLevel       S              2  0
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
     D ActiveJobSts    C                   Const(0101)
     D TempStorage     C                   Const(2009)
      **********************************************************************************************
      * FIELD RENAMES:
      **********************************************************************************************
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *entry        PList
     C                   Parm                    peFrequency
     C                   Parm                    peDiskUse
     C                   Parm                    peDiskIncrease
     C                   Parm                    peTempStorage
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Set program control from input parms
     C                   Eval      WarnLevel = peDiskUse
     C                   Eval      ThresholdMb = peTempStorage
     C                   In        MessageUsers
      * Create a user space to hold the job list entries
     C                   Call      'QUSCRTUS'
     C                   Parm                    UserSpace
     C                   Parm                    ExtendAttr
     C                   Parm                    InitialSiz
     C                   Parm                    InitialVal
     C                   Parm                    PublicAut
     C                   Parm                    TextDescrp
     C                   Parm                    ReplaceSpc
     C                   Parm                    Error_Code
      *
B001 C                   Do        *hival
      * Do system status check first
     C                   Call      'QWCRSSTS'                           90
     C                   Parm                    RcvrDS
     C                   Parm      68            RCVRLen
     C                   Parm      'SSTS0200'    Format
     C                   Parm      '*NO'         RstStsStat
     C                   Parm                    Error_Code
      * Set prev values for first time through (no need to warn in that case)
B002 C                   If        FirstTime
     C                   Eval      PrevPercent = PctSystemASP / 10000
     C                   Eval      FirstTime = *Off
E002 C                   EndIf

     C                   Eval      Percentage = PctSystemASP / 10000
     C                   Eval      Difference = Percentage - PrevPercent
     C                   Eval      Cumulative = PrevDiff + Difference
B002 C                   If        Cumulative > peDiskIncrease
     C                             Or Difference > (peDiskIncrease / 2)
     C                   Eval      Flag = '***'
X002 C                   Else
     C                   Eval      Flag = '   '
E002 C                   EndIf
     C                   Eval      P_MsgData =  'System DASD used: ' +
     C                             %Trim(%EditC(Percentage:'P')) +
     C                             '%.  Change since last check: ' +
     C                             %Trim(%EditC(Difference:'P')) + '%' + Flag
      * Place current DASD % and increase/decrease since last check in the audit log
     C                   Clear                   P_MsgQueue
     C                   Eval      MsgQueName = 'DASDMON'
     C                   Eval      MsgQueLib = '*LIBL'
     C                   Eval      P_MsgQueue(1) = MsgQueue
     C                   Eval      P_MsgQueLn = 1
     C                   ExSr      Inform
      * Warn if significant rise since last time
B002 C                   If        Cumulative > peDiskIncrease
     C                             Or Difference > (peDiskIncrease / 2)
     C                   Eval      P_MsgData = 'System storage use is ' +
     C                             'increasing. DSPMSG DASDMON to check.'
     C                   ExSr      SetMsgUsers
     C                   ExSr      Inform
E002 C                   EndIf
      * Warn if over xx% storage
B002 C                   If        Percentage > WarnLevel
     C                   Eval      P_MsgData = 'System storage over ' +
     C                             %Char(WarnLevel) +
     C                             '%. DSPMSG DASDMON to review history.'
     C                   ExSr      SetMsgUsers
     C                   ExSr      Inform
E002 C                   EndIf

     C                   Eval      PrevPercent = Percentage
     C                   Eval      PrevDiff = Difference
      * Monitor for any jobs using too much temporary storage
     C                   Eval      KeysToRtn(1) = TempStorage
     C                   Eval      KeysToRtn(2) = ActiveJobSts
      * List all the *ACTIVE jobs on the system
     C                   Call      'QUSLJOB'
     C                   Parm                    UserSpace
     C                   Parm                    ListFormat
     C                   Parm                    QualifyJob
     C                   Parm                    JobStatus
     C                   Parm                    Error_Code
     C                   Parm                    JobType
     C                   Parm                    NbrToRtn
     C                   Parm                    KeysToRtn
      * Get the header info for this space
     C                   Call      'QUSRTVUS'
     C                   Parm                    UserSpace
     C                   Parm                    StartPos
     C                   Parm                    DataLength
     C                   Parm                    GenRcvrDS
     C                   Parm                    Error_Code
      * Check to see how many entries returned (ie. number of active jobs)
B002 C                   If        ListNumber > 0
      * Set the initial offset for the start of the list entries
     C                   Eval      ListOffset = ListOffset + 1
     C                   Eval      CurrentEnt = 1
      * Loop through the entries held in the list section of the user space
B003 C                   DoW       CurrentEnt <= ListNumber
      * Get the header info for this space
     C                   Call      'QUSRTVUS'
     C                   Parm                    UserSpace
     C                   Parm                    ListOffset
     C                   Parm                    EntrySize
     C                   Parm                    ListDataDS
     C                   Parm                    Error_Code
      * Get first key data
     C                   Eval      KeyOffSet = 1
     C                   Eval      Key1Info = %SubSt(L_Variable :
     C                                        KeyOffSet : 20)
      * Get second key data
     C                   Eval      KeyOffSet = KeyOffSet + L_LenInfoRtn1
     C                   Eval      Key2Info = %SubSt(L_Variable :
     C                                        KeyOffSet : 20)
      *
B004 C                   If        L_KeyValue1 > ThresholdMb
     C                   Eval      QualJob = L_JobNbr + '/' +
     C                             %Trim(L_JobUser) + '/' + %Trim(L_JobName)
      * Hold job if using more than xxxx temp storage
B005 C                   If        L_KeyValue2 <> 'HLD '
     C                   CallP     RunCmd('HLDJOB JOB(' + QualJob + ')')
     C                   Eval      P_MsgData = 'Job ' + L_JobNbr + '/' +
     C                             %Trim(L_JobUser) + '/' + %Trim(L_JobName) +
     C                             ' held.'
     C                   ExSr      SetMsgUsers
     C                   ExSr      Inform
E005 C                   EndIf

     C                   Eval      P_MsgData = 'Job ' + L_JobNbr + '/' +
     C                             %Trim(L_JobUser) + '/' + %Trim(L_JobName) +
     C                             ' has temporary storage of ' +
     C                             %Trim(%EditC(L_KeyValue1: 'Z')) + 'Mb. '
     C                   ExSr      SetMsgUsers
     C                   ExSr      Inform
E004 C                   EndIf
      * Bump up the counter & offset for the next entry
     C                   Eval      ListOffset = ListOffset + EntrySize
     C                   Eval      CurrentEnt = CurrentEnt + 1
E003 C                   EndDo
E002 C                   EndIf
      * Wait x minutes before taking the next snapshot unless exit request received
     C                   Eval      P_DtaqWait = peFrequency * 60
     C                   Call      'QRCVDTAQ'
     C                   Parm      'DASDMON'     P_DtaqName
     C                   Parm      '*LIBL'       P_DtaqLib
     C                   Parm      1             P_DtaqLen
     C                   Parm      *blanks       P_DtaqData
     C                   Parm                    P_DtaqWait
      * Quit if requested
B002 C                   If        P_DtaqData = 'Y'
     C                   Leave
E002 C                   EndIf

E001 C                   EndDo

     C                   Eval      *INLR = *On
     C                   Return
      **********************************************************************************************
      * SetMsgUsers: Set up the list of message queues to receive storage alerts
      **********************************************************************************************
     C     SetMsgUsers   BegSr
      * Send alert messages to DASDMON & QSYSOPR by default
     C                   Eval      MsgQueName = 'DASDMON'
     C                   Eval      MsgQueLib = '*LIBL'
     C                   Eval      P_MsgQueue(1) = MsgQueue
     C                   Eval      P_MsgQueLn = 1
     C                   Eval      MsgQueName = 'QSYSOPR'
     C                   Eval      MsgQueLib = '*USER'
     C                   Eval      P_MsgQueue(2) = MsgQueue
     C                   Eval      P_MsgQueLn = 2
      * Check for any other users to send alert messages to
B001 C                   Do        6             Index
B002 C                   If        %SubSt(MessageUsers : SubstOffset : 10)
     C                              <> *blanks
     C                   Eval      MsgQueName = %SubSt(MessageUsers :
     C                              SubstOffset : 10)
     C                   Eval      MsgQueLib = '*USER'
     C                   Eval      P_MsgQueue(Index + 2) = MsgQueue
     C                   Eval      P_MsgQueLn = P_MsgQueLn + 1
     C                   Eval      SubstOffset = SubstOffset + 10
E002 C                   EndIf
E001 C                   EndDo
      *
     C                   EndSr
      **********************************************************************************************
      * Inform: Send Non-Program Message
      **********************************************************************************************
     C     Inform        BegSr
      *
     C                   Call      'DBG045R3'
     C                   Parm      'CPF9898'     P_MsgID
     C                   Parm      'QCPFMSG   '  P_MsgFile
     C                   Parm      '*LIBL     '  P_MsgfLib
     C                   Parm                    P_MsgData
     C                   Parm      512           P_MsgDtaLn
     C                   Parm      '*INFO'       P_MsgType
     C                   Parm                    P_MsgQueue
     C                   Parm                    P_MsgQueLn
     C                   Parm                    P_RplyMsgQ
     C                   Parm      '       '     P_ErrorID
      *
     C                   EndSr
      **********************************************************************************************
      * PROCEDURES:
      **********************************************************************************************
      **********************************************************************************************
      * RunCmd: Run a command via QCMDEXC & return the error flag
      **********************************************************************************************
     P RunCmd          B

     D RunCmd          PI             1N
     D  Command                     999    Options(*VARSIZE) Const

     D RunCmdError     S              1N
     D P#CmdString     S            999
     D P#CmdLength     S             15  5

     C                   Eval      P#CmdLength = %Len(%TrimR(Command))
     C                   Call (E)  'QCMDEXC'
     C                   Parm      Command       P#CmdString
     C                   Parm                    P#CmdLength

     C                   Eval      RunCmdError = %ERROR

     C                   Return    RunCmdError

     P                 E
      **********************************************************************************************
</verbatim>
This topic: DBG400 > SourceCodeList > RpgleSource > RpgleDBG205R4
Topic revision: r1 - 26 May 2005 - 19:58:03 - MartinRowe
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback