3.9. Example of renaming and deleting IFS objects

To demonstrate the use of the unlink() and rename() APIs, here's a sample program that can be used to either rename or delete a stream file.

What it does is ask for two parameters. The first is the current pathname of an IFS object. The second parameter is either the new pathname, or the special value *DELETE.

If *DELETE is specified, our program will bring up a window asking for confirmation before actually calling the unlink() API.

Here's the command source:

             CMD        PROMPT('Rename or Delete an IFS object')
             PARM       KWD(OLD) TYPE(*CHAR) LEN(640) +
                          PROMPT('Original (OLD) Object Name')
             PARM       KWD(NEW) TYPE(*CHAR) LEN(640) +
                          CHOICE('Character or *DELETE') +
                          PROMPT('New Object Name or *DELETE')

Here's the DDS for the Window that it pops up:

     A                                      DSPSIZ(24 80 *DS3)
     A          R DUMMYREC
     A                                      ASSUME
     A                                  1  2' '
     A          R RENDELS1
     A                                      WINDOW(9 30 6 20)
     A                                  2  1'File:'
     A            SCFILE        14   O  2  7
     A                                  3  1'Size:'
     A            SCSIZE        10Y 0O  3  7EDTCDE(L)
     A                                  5  1'Really? Delete it?'
     A            SCREALLY       1   I  5 20

Here's the RPG code that makes it all work:

      * CH3RENDEL: Example of deleting/renaming objects in the IFS
      *  (From Chap 3)
      *
      * To compile:
      *   CRTBNDRPG CH3RENDEL SRCFILE(xxx/QRPGLESRC) DBGVIEW(*LIST)
      *
     H DFTACTGRP(*NO) ACTGRP(*NEW) BNDDIR('QC2LE')

     FCH3RENDELSCF   E             WORKSTN

     D/copy IFSEBOOK/QRPGLESRC,IFSIO_H
     D/copy IFSEBOOK/QRPGLESRC,ERRNO_H

     D upper           C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     D lower           C                   'abcdefghijklmnopqrstuvwxyz'

     D Path            S            640A
     D NewPath         S            640A
     D LowerNewPath    S            640A
     D MyStat          S                   like(statds)
     D Len             S             10I 0
     D Pos             S             10I 0

      ** Warning:  call this program from the command.  If you call
      **       it directly, because "Path" is larger than 32 bytes.
      **       See http://faq.midrange.com/data/cache/70.html
      **

     C     *entry        plist
     c                   parm                    Path
     c                   parm                    NewPath

     c     upper:lower   xlate     NewPath       LowerNewPath

     c                   if        LowerNewPath = '*delete'
     c                   exsr      KillIt
     c                   else
     c                   exsr      NewIdentity
     c                   endif

     c                   eval      *inlr = *on


     C**************************************************************
     C* Kill off the file (Delete it from the IFS)
     C**************************************************************
     CSR   KillIt        begsr
     C*-------------------------
     C* Retrieve current file stats:
     c                   if        stat(%trimr(path): %addr(mystat)) < 0
     c                   callp     die(%str(strerror(errno)))
     c                   endif

     C* Get file size from stats
     c                   eval      p_statds = %addr(mystat)
     c                   eval      scSize = st_size

     C* Strip directory names from front of pathname:
     c                   eval      Len = %len(%trimr(path))
     c                   eval      Pos = Len
     c                   dow       Pos > 0
     c                   if        %subst(path:Pos:1) = '/'
     c                   leave
     c                   endif
     c                   eval      Pos = Pos -1
     c                   enddo
     c                   if        Pos<Len and %subst(path:Pos:1) = '/'
     c                   eval      scFile = %subst(path:Pos+1)
     c                   else
     c                   eval      scFile = path
     c                   endif

     C* Ask user if he/she REALLY wants to delete it?
     c                   exfmt     RENDELS1

     C* Then ignore his choice and delete it anyway.
     C* (just kidding)
     c                   if        scReally = 'Y'
     c                   if        unlink(%trimr(path)) < 0
     c                   callp     die(%str(strerror(errno)))
     c                   endif
     c                   endif
     C*-------------------------
     CSR                 endsr


     C**************************************************************
     C* Give the file a new identity.  A new purpose in life!
     C* (okay, rename it...)
     C**************************************************************
     CSR   NewIdentity   begsr
     C*-------------------------
     c                   if        rename(%trimr(Path): %trimr(NewPath))<0
     c                   callp     die(%str(strerror(errno)))
     c                   endif
     C*-------------------------
     CSR                 endsr


      /DEFINE ERRNO_LOAD_PROCEDURE
      /COPY IFSEBOOK/QRPGLESRC,ERRNO_H