H NoMain H OPTION(*SRCSTMT) * ---------------------------------------------------- * Procédure SQL * Description : Liste du contenu d'une directory de l'IFS * Par : David Malle * ---------------------------------------------------- * 1) CRTRPGMOD MODULE(BIB/LSTIFSDIR) * SRCFILE(BIB/QRPGLESRC) * 2) CRTSRVPGM SRVPGM(BIB/LSTIFSDIR) * EXPORT(*ALL) * ---------------------------------------------------- D LSTIFSDIR PR D inpIfsDir 100A Varying D outName 100A Varying D outType 12A Varying // Null Indicator Input Parameters // Null Indicator Output Parameters D inpIfsDir_NI 5I 0 D outName_NI 5I 0 D outType_NI 5I 0 // DB2SQL Style Parameters D pSQLState 5 D pFunctionName 517 D pSpecificName 128 D pSQLMsgText 70 Varying // UDTF Call Type Output Parameters (columns) D pTFCallType 10I 0 * ------------ * Prototypes API / IFS * ------------ Dlstat PR 10I 0 EXTPROC('lstat') D * VALUE D * VALUE Dopendir PR * EXTPROC('opendir') D * VALUE Dreaddir PR * EXTPROC('readdir') D * VALUE Dclosedir PR 10I 0 EXTPROC('closedir') D * VALUE D*SndPgmMsg PR N D*Qmsgid 7 CONST D*Qmsgf 20 CONST D*Qmsg 128 CONST D*Qmsgtp 10 CONST OPTIONS(*NOPASS) * D* ------------ D* DS lstat() D* ------------ D StatDS DS D st_mode 10U 0 D st_ino 10U 0 D st_nlink 5U 0 D st_pad 2A 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 12A D st_codepage 5U 0 D st_reserved1 62A D st_ino_gen_id 10U 0 D* D* ------------ D* DS readdir() D* ------------ D DirEntry DS D d_reserved1 16A D d_fileno_genid 10U 0 D d_fileno 10U 0 D d_reclen 10U 0 D d_reserved3 10I 0 D d_reserved4 6A D d_reserved5 2A D d_ccsid 10I 0 D d_country_id 2A D d_language_id 3A D d_nls_reserved 3A D d_namelen 10U 0 D d_name 640A D* D* ------------ D* Variables de travail D* ------------ D MySize S 10I 0 D MyFile S 104 D MyBlksize S 10I 0 D Error S 5U 0 D MyCodePage S 5P 0 * Input Parameters D DirName S 100A D FullName S 256A D Option S 1A D Null S 1A Inz(X'00') D ReturnInt S 10I 0 D ReturnDir S * D PtrToEntry S * D RtnEntry S BASED(PtrToEntry) Like(DirEntry) // ----------------------------- // UDTF call parameter constants // ----------------------------- D UDTF_FirstCall S 10I 0 Inz(-2) D UDTF_Open S 10I 0 Inz(-1) D UDTF_Fetch S 10I 0 Inz(0) D UDTF_Close S 10I 0 Inz(1) D UDTF_LastCall S 10I 0 Inz(2) // ----------------------------- // SQL States // ----------------------------- D SQLSTATEOK C '00000' D ENDOFTABLE C '02000' D UDTF_ERROR C 'US001' // ----------------------------- // NULL Constants // ----------------------------- D ISNULL C -1 D NOTNULL C 0 // ----------------------------- // Booleen // ----------------------------- D FirstFetch s n D NullData s n // ----------------------------- // Paramètres E/S // ----------------------------- D EntryName S 120A D EntryPath S 256A * ---------------------------------------------------- * Description de procédure * ---------------------------------------------------- P LSTIFSDIR B Export D LSTIFSDIR PI D inpIfsDir 100A Varying D outName 100A Varying D outType 12A Varying D inpIfsDir_NI 5I 0 D outName_NI 5I 0 D outType_NI 5I 0 D pSQLState 5 D pFunctionName 517 D pSpecificName 128 D pSQLMsgText 70 Varying // UDTF Call Type Output Parameters (columns) D pTFCallType 10I 0 /free pSQLState=SQLStateOK; Monitor; Select; // ------------- // Function Open // ------------- When pTFCallType=UDTF_Open; FirstFetch = *on; DirName = InpIfsDir; FullName = %trimr(DirName) + Null; ReturnDir = opendir(%addr(FullName)); // ----------------------------- // Function Fetch -> Return data // ----------------------------- When pTFCallType=UDTF_Fetch; if FirstFetch; FirstFetch = *off; if ( ReturnDir = *Null ); outName_NI = ISNULL; outType_NI = ISNULL; else; outName_NI = NOTNULL; outType_NI = NOTNULL; endif; endif; // ------------------- // Lecture de l'entrée // ------------------- PtrToEntry = readdir(ReturnDir); if (PtrToEntry <> *Null); DirEntry = RtnEntry; EntryName = %str(%addr(d_name)); EntryPath = %trim(DirName) + '/' + %trimr(EntryName) + Null; ReturnInt = lstat(%addr(EntryPath): %addr(StatDS)); outName = EntryPath; outType = st_objtype; else; // -------------------- // Fermeture répertoire // -------------------- ReturnInt = closedir(ReturnDir); pSQLState=ENDOFTABLE; endif; // ------------------------- // Function Close -> CleanUp // ------------------------- When pTFCallType=UDTF_Close; *InLR=*On; EndSl; On-Error; *InLR=*On; pSQLState=UDTF_ERROR; Endmon; Return; /end-free P LSTIFSDIR E