Delete members based on numbers of days old

Don't waste your time searching, call this utility program to remove file members based on numbers of days old.

Don't waste your time searching, call this utility program to remove file members based on numbers of days old.

 
     h DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DATFMT(*ISO)
     h DFTACTGRP(*NO) ACTGRP('ILE')

    ‚‚*--------------------------------------------------------------------
    ‚‚* Utility to Remove Members based on Numbers Days Old
    ‚‚*--------------------------------------------------------------------

      *--------------------------------------------------------------------
      * EX: CALL PGM(MBRDLT) PARM('EDILOGF' '*LIBL' '0014' ' ')
      *--------------------------------------------------------------------
      * THIS WILL DELETE ALL MEMBERS FROM THE FILE EDILOGF THAT ARE
      * 14 DAYS AND OLDER. (THIS UTILITY DOES NOT DELETE THE MEMBER NAME
      * NOTE: THIS UTILITY DOES NOT DELETE THE MEMBER NAME SAME AS FILE
      *--------------------------------------------------------------------

     d/COPY QSYSINC/QRPGLESRC,QUSRUSAT
     d/COPY QSYSINC/QRPGLESRC,QUSGEN
     d/COPY QSYSINC/QRPGLESRC,QUSLMBR
     d/COPY QSYSINC/QRPGLESRC,QUSRMBRD

     d  CrtUsrSpc      PR              *
     d   CrtSpcName                  20    const

     d SpacePtr        s               *
     d UserSpace       s             20    inz('MBRLST    QTEMP')

     d FormatList      s              8A   Inz('MBRL0200')
     d FormatMbr       s              8A   Inz('MBRD0200')
     d AllMbrs         s             10A   Inz('*ALL      ')
     d OvrDbf          s              1A   Inz('1')
     d Member          s             10

     d GenLen          s              9B 0
     d StrPos          s              9B 0
     d RtvLen          s              9B 0
     d RcvLen          s              9B 0
     d Count           s             15  0

     d Command         s             80a   INZ
     d CommandLen      s             15p 5 INZ(80)
     d SQuote          c                   ''''
     d ObjNamLib       ds
     d   ObjNam                      10    OVERLAY(ObjNamLib)
     d   ObjLib                      10    OVERLAY(ObjNamLib:11)

     d Days            ds
     d NDays                          4  0 OVERLAY(Days)
     d ADays                          4    OVERLAY(Days)

      *--------------------------------------------------------------------
      * Standard Error Code data structure
      *--------------------------------------------------------------------
     dError            ds           116
     d QUSBPRV                 1      4B 0          inz(116)
     d QUSBAVL                 5      8B 0
     d MessageId               9     15
     d MessageDta             17    116

      *--------------------------------------------------------------------
      * Member Date data structure   - Alpha 13
      *--------------------------------------------------------------------
     dQusDte           ds
     d QusCC                   1      1
     d QusYMD                  2      7
     d QusTim                  8     13

      *--------------------------------------------------------------------
      * Member Date data structure   - Alpha 8
      *--------------------------------------------------------------------
     d MbrDtCrt        ds
     d   MbrCY                        4    OVERLAY(MbrDtCrt)
     d   MbrMM                        2    OVERLAY(MbrDtCrt:5)
     d   MbrDD                        2    OVERLAY(MbrDtCrt:7)

      *----------------------------------------------------------------
      * DATE DATA STRUCTURE  (*ISO 'ccyy-mm-dd')
      *----------------------------------------------------------------
     d                 ds                  INZ
     d  NewDat                         D   DATFMT(*ISO) INZ
     d   NewCY                        4    OVERLAY(NewDat)
     d   NewMM                        2    OVERLAY(NewDat:6)
     d   NewDD                        2    OVERLAY(NewDat:9)

      *----------------------------------------------------------------
      * ISO DATES            (*ISO 'ccyy-mm-dd')
      *----------------------------------------------------------------
     d Today           s               D   Inz(*SYS)
     d CompDat         s               D   Inz(*SYS)

      *--------------------------------------------------------------------
      *  Receive Parms for Object Name, Library, Days, MsgId
      *--------------------------------------------------------------------
     c     *Like         Define    ObjNam        pmObjNam
     c     *Like         Define    ObjLib        pmObjLib
     c     *Like         Define    ADays         pmDays
     c     *Like         Define    MessageId     pmMsgId

     c     *entry        plist
     c                   parm                    pmObjNam
     c                   parm                    pmObjLib
     c                   parm                    pmDays
     c                   parm                    pmMsgId

     c                   Eval      ObjNam = pmObjNam
     c                   Eval      ObjLib = pmObjLib
     c                   Eval      ADays  = pmDays

      *--------------------------------------------------------------------
      *  Calculate new Comparison Date based on Number Days Old
      *--------------------------------------------------------------------
     c     Today         subdur    NDays:*DAYS   CompDat

      *--------------------------------------------------------------------
      *  Create User Space for Member List Information
      *--------------------------------------------------------------------
     c                   Eval      SpacePtr = CrtUsrSpc(UserSpace)

      *--------------------------------------------------------------------
      *  Create Member List in User Space
      *--------------------------------------------------------------------
     c                   Call      'QUSLMBR'
     c                   Parm                    UserSpace
     c                   Parm                    FormatList
     c                   Parm                    ObjNamLib
     c                   Parm                    AllMbrs
     c                   Parm                    OvrDbf
     c                   Parm                    Error

      *--------------------------------------------------------------------
      * Continue if no Errors
      *--------------------------------------------------------------------
     c                   Eval      pmMsgId = MessageId
     c                   if        MessageId = *blanks

      *--------------------------------------------------------------------
      * Set Values for Generic Header
      *--------------------------------------------------------------------
     c                   Eval      GenLen = 140
     c                   Eval      StrPos = 1

      *--------------------------------------------------------------------
      * Retreive Number of Entries, Offset, and the size of each entry
      *--------------------------------------------------------------------
     c                   Call      'QUSRTVUS'
     c                   Parm                    UserSpace
     c                   Parm                    StrPos
     c                   Parm                    GenLen
     c                   Parm                    QUSH0100
     c                   Parm                    Error

      *--------------------------------------------------------------------
      * Check the Generic Header data structure for number of list entry
      * offset to list entries, and size of each list entry
      *--------------------------------------------------------------------
     c                   Eval      StrPos = ( QUSOLD + 1 )
     c                   Eval      RtvLen = QUSSEE
     c                   Eval      RcvLen = 209
     c                   Eval      Count = 1

      *--------------------------------------------------------------------
      *  Process Members
      *--------------------------------------------------------------------
     c                   DoW       Count <= QUSNBRLE

     c                   Call      'QUSRTVUS'
     c                   Parm                    UserSpace
     c                   Parm                    StrPos
     c                   Parm                    RtvLen
     c                   Parm                    QUSL0200
     c                   Parm                    Error

     c                   Eval      StrPos = QUSSEE + StrPos
     c                   Eval      Count = Count + 1

     c                   movel(p)  QUSMN01       Member

      *--------------------------------------------------------------------
      *  Get Member Information
      *--------------------------------------------------------------------
     c                   Call      'QUSRMBRD'
     c                   Parm                    QusM0200
     c                   Parm                    GenLen
     c                   Parm                    FormatMbr
     c                   Parm                    ObjNamLib
     c                   Parm                    Member
     c                   Parm                    OvrDbf
     c                   Parm                    Error

      *--------------------------------------------------------------------
      *  Remove Member if not same as File Name and Member Create Date
      *  is Less/Equal to new comparison Date
      *--------------------------------------------------------------------
     c                   if        Member <> ObjNam

     c                   eval      QusDte = QusCD03

     c                   if        QusCC = '1'
     c                   eval      MbrDtCrt = '20' + QusYMD
     c                   else
     c                   eval      MbrDtCrt = '19' + QusYMD
     c                   endif

     c                   eval      NewCY = MbrCY
     c                   eval      NewMM = MbrMM
     c                   eval      NewDD = MbrDD

     c                   if        NewDat <= CompDat

     c                   eval      Command = 'RMVM FILE('          +
     c                                        %trimr(ObjLib)       +
     c                                        '/' + %trimr(ObjNam) +
     c                                        ') MBR('             +
     c                                        %trimr(Member) + ')'
     c                   call      'QCMDEXC'
     c                   parm                    Command
     c                   parm                    CommandLen

     c                   endif

     c                   endif

e01  c                   EndDo

      *--------------------------------------------------------------------
      *  End Program
      *--------------------------------------------------------------------
     c                   endif

     c                   eval      *inlr = *on

      *====================================================================
      *  Procedure to create extendable user space, return pointer to it.
      *====================================================================
     p  CrtUsrSpc      B                   export
     d  CrtUsrSpc      PI              *
     d   CrtSpcName                  20    const

      * Local Variables
     d PasSpcName      DS            20
     d  SLib                  11     20
     d ChgAttrDs       DS            13
     d  NumberAttr                    9B 0 inz(1)
     d  KeyAttr                       9B 0 inz(3)
     d  DataSize                      9B 0 inz(1)
     d  AttrData                      1    inz('1')
     d ListPtr         S               *
     d SpaceAttr       S             10    inz
     d SpaceAuth       S             10    INZ('*CHANGE')
     d SpaceLen        S              9B 0 INZ(2048)
     d SpaceReplc      S             10    INZ('*YES')
     d SpaceText       S             50
     d SpaceValue      S              1

      * Create the user space
     c                   move      CrtSpcName    PasSpcName
     c                   CALL      'QUSCRTUS'
     c                   PARM                    PasSpcName
     c                   PARM                    SpaceAttr
     c                   PARM                    SpaceLen
     c                   PARM                    SpaceValue
     c                   PARM                    SpaceAuth
     c                   PARM                    SpaceText
     c                   PARM      '*YES'        SpaceReplc
     c                   PARM                    Error

      * Get pointer to user space
     c                   CALL      'QUSPTRUS'
     c                   PARM                    PasSpcName
     c                   PARM                    ListPtr

      * Change user space to be extendable
     c                   CALL      'QUSCUSAT'
     c                   PARM                    Slib
     c                   PARM                    PasSpcName
     c                   PARM                    ChgAttrDs
     c                   PARM                    Error

     c                   return    ListPtr

     p  CrtUsrSpc      E
  
  


This was first published in April 2005

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close