Purge Email Folder

This application was written to read a specific IFS directory and delete files past seven days old. It was part of an Internet Mail Delivery system written in RPG using the iSeries API's to create a text file and send a plain text email to a customer using the OS/400 SMTP server.

The text of the email was saved in a folder for reference by Customer Service for up to a week. This program reads the directory examines the text files beginning with a name starting with the character 'E'. If the date stamp of the stream file is older than seven days, the file is deleted from the directory.


      /TITLE IMD050RP: Purge Email Folder
     H BNDDIR('QC2LE')
     H BNDDIR('IFSBNDIR')
     H DFTACTGRP(*NO)
      ****************************************************************
      * PROGRAM NAME - IMD050RP                                      *
      *                                                              *
      * FUNCTION     - Read IFS folder and remove Email text files   *
      *                                                              *
      ****************************************************************
      *-----------------------------------------------------------------
      * Externally defined Data Structures
      *-----------------------------------------------------------------
     D PGMDS         ESDS                  EXTNAME(MISSTSDA)
     D DBFDS         E DS                  EXTNAME(MISDBFDA)
      *-------------------------------------------------------------------
      * Procedure prototypes
      *--------------------------------------------------------------------
      *---------------------------------------------------------------------
      * Call System Command Sub Procedure...
      *---------------------------------------------------------------------
     D System          PR            10I 0 ExtProc('system')
     D  CmdText                        *   Value Options(*string)
     D
     D ErrorCPF        S              7A   Import('_EXCP_MSGID')
     D cmd             S            256
     D
      * Open a Directory
      *--------------------------------------------------------------------
     D opendir         PR              *   EXTPROC('opendir')
     D  dirname                        *   VALUE
      *--------------------------------------------------------------------
      * Read Directory Entry
      *--------------------------------------------------------------------
     D readdir         PR              *   EXTPROC('readdir')
     D  dirp                           *   VALUE
      *--------------------------------------------------------------------
      * Retrieve Status Information
      *--------------------------------------------------------------------
     D stat            PR            10I 0 EXTPROC('stat')
     D  dirp                           *   VALUE
     D  buffer                         *   VALUE
      *--------------------------------------------------------------------
      * Change Current Directory
      *--------------------------------------------------------------------
     D chdir           PR            10I 0 EXTPROC('chdir')
     D  dirp                           *   VALUE
      *--------------------------------------------------------------------
      * Retrieve Run Type Error Message..
      *--------------------------------------------------------------------
     D strerror        PR              *   EXTPROC('strerror')
     D  errnum                       10i 0
      *--------------------------------------------------------------------
     D p_dirent        S               *
     D p_stat          S               *
     D dh              S               *
     D Path            S            256A
     D Pathx00         S            256A
     D Name            S            256A
     D Msg             S            100A
     D rc              S             10I 0
      *--------------------------------------------------------------------
     D dirent          DS                  based(p_dirent) ALIGN
     D   d_reserv1                   16A
     D   d_fileno_gen                10U 0
     D   d_fileno                    10U 0
     D   d_reclen                    10U 0
     D   d_reserv3                   10I 0
     D   d_reserv4                    8A
     D   d_nlsinfo                   12A
     D     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)
     D     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)
     D     nls_lang                   3A   OVERLAY(d_nlsinfo:7)
     D     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)
     D   d_namelen                   10U 0
     D   d_name                     640A
     D
      * Data structure for Stat()...
     D  statds         DS                  BASED(p_stat) ALIGN
     D   st_mode                     10U 0
     D   st_ino                      10U 0
     D   st_nlink                     5U 0
     D   st_uid                      10U 0
     D   st_gid                      10U 0
     D   st_size                     10I 0
     D   st_atime                    10I 0
     D   st_mtime                    10I 0
     D   st_ctime                    10I 0
     D   st_dev                      10U 0
     D   st_blksize                  10U 0
     D   st_allocsize                10U 0
     D   st_objtype                  11A
     D   st_codepage                  5U 0
     D   st_reserved                 62A
     D   st_ino_gen_i                10U 0
      *
     D  errno          s             10i 0
     D  error_p        s               *
     D  errmsg         s             80
      *-----------------------------------------------------------------
      * Constants.
      *-----------------------------------------------------------------
     D decalage        C                   const(18000)
     D #TXT            C                   '.TXT'
     D #ROOT           C                   '/'
     D #UP             C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     D #LOW            C                   'abcdefghijklmnopqrstuvwxyz'
      *-----------------------------------------------------------------
      * Work Fields.
      *-----------------------------------------------------------------
     D w$ifsext        S              4
     D w$ifsnam        S            256
     D w$ifsdte        S              8  0
     D W$POS           S              3  0
     D W$LEN           S              3  0
     D w$path          S        +     1    LIKE(p$path)
     D tPath           S        +     1    LIKE(p$path)
     D tFile           S        +     1    LIKE(p$path)
      *------------
     D $$date          S               D   INZ
     D $$today         S               D   INZ(*SYS)
     D x$date          S               D
     D w$date          S              8  0
      *------------
     D $$timestmp      S               Z   INZ
     D $$epoch         S               Z   INZ
     D epochv          S             26    INZ('1970-01-01-00.00.00.000000')
      *------------
     D                 DS
     D dstimestmp                    20S 0 INZ
     D  dsdate                 1      8
     D  dstime                 9     14
     D  dsstmp                 1     14
      *------------
     D                 DS
     D dsstmp14                      14    INZ
     D  dsdaten                1      8  0
     D  dstimen                9     14  0
      *------------------------------------------------------------------
      * Main Line.
      *------------------------------------------------------------------
     C     *ENTRY        PLIST
     C                   PARM                    p$path           30
     C                   PARM                    p$msgid           7
      * Set the file expiration date 7 days prior to today
     C                   TIME                    $$DATE                          
     C     $$DATE        SUBDUR    7:*days       x$date                          
     C     *ISO          MOVE      epochv        $$epoch
     C                   MOVEL(P)  p$path        w$path
     C                   ALLOC     512           p_stat
     C                   IF        w$path = *blanks
     C                   EVAL      w$path = '/'
     C                   ENDIF
     C                   EVAL      w$path = %trim(w$path) + x'00'
      *------------------------------------------------------------------
      * Open Specified Directory. If not found exit the program.
      *------------------------------------------------------------------
     C                   EVAL      dh = opendir(%addr(w$path))
     C                   IF        dh = *NULL
     C                   EVAL      p$msgid = 'SCT0001'
     C                   EXSR      @EXIT
     C                   ENDIF
      *------------------------------------------------------------------
      * Read Each Directory Entry...
      *------------------------------------------------------------------
     C                   DOU       p_dirent = *NULL
     C                   EVAL      p_dirent = readdir(dh)
     C                   IF        p_dirent <> *NULL
      *                                                                          
     C                   IF        d_namelen < 1024
     C                   EVAL      Name = %subst(d_name:1:d_namelen)
     C                   MOVEL(P)  Name          W$ifsnam
     C     #LOW:#UP      XLATE     W$ifsnam      W$ifsnam
      *------------------------------------------------------------------
      * Find file type; only remove text files
      *------------------------------------------------------------------
     C                   IF        %scan('.':W$ifsnam) > 1                        
     C                   EVAL      W$IFSEXT = %trim(%SUBST(W$ifsnam: +           
     C                                              %SCAN('.':W$ifsnam:1):4))    
     C                   ENDIF                                                   
      *                                                                          
     C                   IF        W$ifsext = #TXT
     C                                 AND %subst(W$ifsnam:1:1) = 'E'            
      * get object status
     C                   EVAL      tpath = %trim(p$path) + %trim(Name) + x'00'
     C                   EVAL      rc = stat(%addr(tpath):p_stat)
      *------------------------------------------------------------------
      * determine the file change date
      *------------------------------------------------------------------
     C                   sub       decalage      st_ctime                       
     C     $$epoch       adddur    st_ctime:*S   $$timestmp                     
     C                   move      $$timestmp    $$DATE                         
     C                                                                          
      *                                                                         
     C                   IF        x$date > $$date                              
     C                   EVAL      tFile = '''' + %trim(p$path) +
     C                                            %trim(Name) + ''''
     C                   EVAL      cmd = 'DEL OBJLNK(' +   %trim(tFile)  + ')'
     C                   EVAL        rc = system(cmd)                           
     C                   ENDIF                                                  
      *
     C                   ENDIF
     C                   ENDIF
      *
     C                   ENDIF
     C                   ENDDO
      *
     C                   EVAL      error_p = strerror(errno)
     C                   EVAL      errmsg  = %str(error_p)
     C                   EXSR      @EXIT
      *==================================================================
      * Exits Program.
      *==================================================================
     CSR   @EXIT         BEGSR
     C                   MOVE      *on           *inlr
     C                   RETURN
     CSR                 ENDSR