Check IFS/Server for a document

H NOMAIN EXPROPTS(*RESDECPOS)
H BNDDIR('QC2LE')
* PROGRAM - CHKIFS
* PURPOSE - verify that a full path table on iFS exists
* WRITTEN - 03/19/2020
* AUTHOR - Jamie Flanary

/copy qprcsrc,COMMAND_CP
/copy qprcsrc,CHKIFS_CP

d DoesTableExist...
d s 10i 0 inz
d ERROR_FLAG s n inz
d File_Exists...
d c Const(0)
d MyUser s 10 inz
d MyPassword s 10 inz
d MySQlString s 256 inz varying
d pointer s *

d ProcessFlag s 1 inz
d Q s 1 inz('''')
d Read_Authority...
d c Const(4)
d RecordsInError s 10i 0 inz
d serverIp s 15 inz('10.0.0.0')
d ThisFolder s 100a varying
d ThisDrawing s 100a varying
d token S 160A varying
d Write_Authority...
d c Const(2)
*
d access pr 10i 0 ExtProc('access')
d szIFSFile * Value options(*STRING)
d nAccessMode 10i 0 value

*
* Begin Procedure
*
p DoesThisTableExist...

P B export
* Procedure Interface
d DoesThisTableExist...
d pi n
d Infullpath 1000 varying
*
d RunSQLInsert pr n
d String 256a varying const
*

dstrtok PR * ExtProc('strtok')
d string * value options(*string)
d delim * Value Options(*string)
/free

Exec Sql Set Option --Naming = *Sys,
Commit = *None,
SRTSEQ = *LANGIDUNQ;
reset ProcessFlag;
// check the server first
if %subst(infullpath:1:2) = '\';
//\\rbsc-dc02 remove the server
infullpath = %subst(Infullpath:12);
// delete overrides to FTP tables
OneThousandLong = 'DLTOVR FILE(INPUT) LVL(*JOB)';
monitor;
runcommand(OneThousandLong);
on-error;
endmon;
OneThousandLong = 'DLTOVR FILE(OUTPUT) LVL(*JOB)';
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// delete the FTP tables
OneThousandLong = 'DLTF FILE(QTEMP/INPUT)';
monitor;

runcommand(OneThousandLong);
on-error;
endmon;

OneThousandLong = 'DLTF FILE(QTEMP/OUTPUT)';
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// create the ftp files
OneThousandLong = 'CRTPF FILE(QTEMP/INPUT) ' +
' RCDLEN(256)';
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// CRTDUPOBJ OBJ(OUTPUT) FROMLIB(*LIBL)
// OBJTYPE(*FILE) TOLIB(QTEMP) CST(*NO) TRG(*NO)

OneThousandLong = 'CRTDUPOBJ OBJ(OUTPUT) FROMLIB(*LIBL) ' +
'OBJTYPE(*FILE) TOLIB(QTEMP) CST(*NO) TRG(*NO)';
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// override the input table
OneThousandLong =
'OVRDBF FILE(INPUT) TOFILE(INPUT) OVRSCOPE(*JOB)';
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// override the output table
OneThousandLong =
'OVRDBF FILE(OUTPUT) TOFILE(QTEMP/OUTPUT) OVRSCOPE(*JOB)';
monitor;
runcommand(OneThousandLong);

on-error;
endmon;

// populate the input file
MySqlString = 'MyServerID    MyPassword<span style="color: #0000ff;">'</span>;
RunSQLInsert(MYSqlString);

// need to CD down to the table
//seperate out the folders from the table
// finish in morning
pointer = strtok(%trim(InFullpath) : '\');
dow (pointer &lt;&gt; *null);
token = %trim(%str(pointer));
pointer = strtok(*null: '\');
ThisFolder = %trim(token);
// write to input here if we dont find a "." in the name
if %scan('.':ThisFolder) = *zeros;
MySqlString = 'CD ' + ThisFolder;
RunSQLInsert(MYSqlString);
endif;

enddo;
ThisDrawing = ThisFolder;

// rename to itself as a test
MySqlString = 'rename ' +Q+ThisDrawing+Q+' ' +Q+ThisDrawing+Q;
RunSQLInsert(MYSqlString);

// rename to itself as a test
MySQlString = 'quit';
RunSQLInsert(MySqlString);

// start FTP

OneThousandLong = 'FTP ' +Q + %trim(ServerIP) + Q;
monitor;
runcommand(OneThousandLong);
on-error;
endmon;

// sql the output table looking for total failure
// 550 The system cannot find the file specified.
reset RecordsInError;
exec sql
select coalesce(count(*),0)
into :RecordsInError
FROM output
where substr(outputtext,1,3) = '550' ;

// set error flag if error found
if recordsInError &gt; *zeros;
DoesTableExist = 999;
else;
DoesTableExist = 0;
endif;

else;
// validate the IFS
DoesTableExist =
access(infullpath : File_Exists);

endif;

//
// * F_OK = File Exists
// * R_OK = Read Access
// * W_OK = Write Access
// * X_OK = Execute or Search
// **********************************************************************
// D F_OK C 0
// D R_OK C 4
// D W_OK C 2
// D X_OK C 1
//

if DoesTableExist = *zeros;
ProcessFlag = *off;
else;
ProcessFlag = *on;
endif;

return ProcessFlag;
/end-free
p DoesThisTableExist...
p e
*-------------------------------------------------------------
* ReadIFSTable - Subprocedure To Read The IFS File
*-------------------------------------------------------------
p RunSQLInsert b export
d RunSQLInsert pi n
d InputString 256a varying const

d Erro_Flag s n inz

reset Error_Flag;

exec sql
insert into input
values(:MySQLString);

Return Error_Flag;

*---------------------------------------------------------
p RunSQLInsert E

* CHKOIFS_CP - run a command from RPG program
d DoesThisTableExist...
d pr n
d Infullpath 1000a varying

H DFTACTGRP(*NO) OPTION(*SRCSTMT: *NODEBUGIO) BNDDIR('UTILITIES')
/copy qprcsrc,CHKIFS_CP

d MyFolderPath s 1000 varying
d MyErrorBack s n Inz

/Free
// /home/Engineering/Customer/BRAAS/R50-23114/R50-23114-1.PDF
//
reset MyErrorBack;
MyFolderPath = '/home/Engineering/Customer/' +
'BRAAS/R50-23114/R50-23114-1.PDF';
MyErrorback = DoesThisTableExist(MyFolderPath);

reset MyErrorBack;
MyFolderPath = '/home/jamie/' +
'QPRTJOB/QSECOFR/000648_000444_NLSTXT_07062018_00????.PDF';
MyErrorback = DoesThisTableExist(MyFolderPath);

// \\rbsc-dc02\Engineering\DRAWINGS\New Building\120914 LAYOUT.pdf
reset MyErrorBack;
MyFolderPath = '\\rbsc-dc02\Engineering\DRAWINGS\' +
'New Building\Racks 2013.dwg';
MyErrorback = DoesThisTableExist(MyFolderPath);

// \\rbsc-dc02\Engineering\DRAWINGS\New Building\noFound.pdf
reset MyErrorBack;
MyFolderPath = '\\rbsc-dc02\Engineering\DRAWINGS\' +
'New Building\Notfound.pdf';
MyErrorback = DoesThisTableExist(MyFolderPath);

*inlr = *on;