Tweet
H Option( *SrcStmt: *NoDebugIo ) BndDir( 'QC2LE' ) DFTACTGRP(*No)
‚**********************************************************************
‚* Project ID Date Pgmr ID Rev Description
‚*
‚* 11/16/11 JJF 00 program written
‚* ** pulls .csv tables from directory:
‚* /home/jamie/
‚*
‚**********************************************************************
*
* Directory Entry Structure (dirent)
*
d p_dirent s *
d dirent ds based(p_dirent)
d d_reserv1 16A
d d_reserv2 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
*------------------------------------------------------------
* Open a Directory
*------------------------------------------------------------
d opendir pr * EXTPROC('opendir')
d dirname * VALUE
*------------------------------------------------------------
* Read Directory Entry
*------------------------------------------------------------
d readdir pr * EXTPROC('readdir')
d dirname * VALUE
*------------------------------------------------------------
* Close Directory
*------------------------------------------------------------
d closedir pr * EXTPROC('closedir')
d dirname * VALUE
*------------------------------------------------------------
* Open IFs table
*------------------------------------------------------------
d open pr 10i 0 ExtProc('open')
d filename * value
d openflags 10i 0 value
d mode 10u 0 value options(*nopass)
d codepage 10u 0 value options(*nopass)
*------------------------------------------------------------
* Read IFS table
*------------------------------------------------------------
d read pr 10i 0 ExtProc('read')
d filehandle 10i 0 value
d datareceived * value
d nbytes 10u 0 value
*------------------------------------------------------------
* Close IFs table
*------------------------------------------------------------
d close pr 10i 0 ExtProc('close')
d filehandle 10i 0 value
*------------------------------------------------------------
* read ifs table - internal procedure
*------------------------------------------------------------
d RdIfsFil pr 256a
d FileName 256a const
*------------------------------------------------------------
* Delay - sleep function
*------------------------------------------------------------
d sleep pr 10i 0 ExtProc( 'sleep' )
d seconds 10u 0 Value
*------------------------------------------------------------
* Command - run a command
*------------------------------------------------------------
d $command pr extpgm('QCMDEXC')
d command 256
d length 15 5
*------------------------------------------------------------
* Grab the date in LongFormat
*------------------------------------------------------------
d CEEDATE pr opdesc
d Lilian 10i 0
d picture 65535A const options(*varsize)
d OutputDate 65535A const options(*varsize)
d Feedback 12a options(*omit)
*------------------------------------------------------------
* a few local variables...
d BaseDate s d inz(D'1582-10-14')
d cmdlength s 15 5
d cmdstring s 256
d count s 3 0
d cr c Const(x'0D')
d data s 65535A
d Data_Rec s 65535A
d datasize s 5 0
d dh s *
d Eol c Const(x'0D25')
d Error_Flag s 1A INZ('0')
d File s 256
d FileName s 256 varying
d FolderNames s 256 dim(50)
d Fp s 10i 0
d KeepLooping s n inz('1')
d lf C Const(x'25')
d MyNewName s 265 varying
d N s 5 0
d nDays s 10i 0
* values for oflag parameter, used by open()
d O_RDONLY s 10i 0 inz(1)
d O_TEXTDATA s 10i 0 inz(16777216)
d Oflag s 10i 0
d Omode s 10u 0
d PathName s 26
d Q s 1 inz('''')
d R S 5 0
d Rc S 10i 0
d ReturnData s 12
d SleepSeconds s 10i 0 inz(1)
d ta s 3 0
d Today s d inz(*SYS)
// entire document stored in here
d MyData ds qualified inz
d bighunkdata 65535
d OneSlice 60 dim(1000) overlay(bighunkdata:*next)
*------------------------------------------------------
* MAIN LINE
*------------------------------------------------------
/free
// program will loop until outside force
// stops it.
dow KeepLooping;
exsr $GetFileName;
if ta > *zeros;
// read the tables one at a time
for count = 1 to ta;
filename = foldernames(count);
Error_flag = rdifsfil(Filename);
//exsr $MoveToHistory;
endfor;
endif;
// Delay job for a number of seconds then start
// the process all over again.
sleep(SleepSeconds);
enddo;
*inlr = *on;
//-------------------------------------------
// $GetFileName - get the next csv table
//-------------------------------------------
begsr $GetFileName;
clear filename;
// tables will hold all the names of the tables
clear TA;
clear folderNames;
// loop on the directory
// Step1: Open up the directory.
PathName = '/home/jamie/';
dh = opendir(%addr(PathName));
if dh <> *NULL;
// Step2: Read each entry from the directory (in a loop)
p_dirent = readdir(dh);
dow p_dirent <> *NULL;
if d_namelen < 256;
FileName = %subst(d_name:1:d_namelen);
// process only csv files
// even MT directory contains folders:
// o .
// o ..
if %scan('.csv':Filename) > *zeros;
ta+=1;
foldernames(ta) = %trim(pathname) + %trim(filename);
endif;
endif;
p_dirent = readdir(dh);
enddo;
endif;
// Step3: Close the directory to reprocess
closedir(dh);
endsr;
//-------------------------------------------
// $MoveToHistory - move processed table to
// history
//-------------------------------------------
begsr $MoveToHistory;
// ***** Rename the file *****
// RNM OBJ('/home/jamie/some.csv')
// NEWOBJ('SomeNewName.csv')
// *like: November16_2011_114547.csv
nDays = %diff(today : baseDate : *days);
ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);
MyNewName = %trim(ReturnData) +
%char(%subdt(Today:*days)) + '_' +
%char(%subdt(Today:*years)) + '_' +
%ScanRpl('.' : '' :
%char(%time())) + '.csv';
cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +
%trim(filename) + Q + ')' +
' NEWOBJ(' + Q + %trim(MyNewName) +
Q + ')';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring:cmdlength);
on-error;
// process for errors
endmon;
// ***** Move file to history *****
// MOV OBJ('/home/jamie/some.csv')
// TODIR('/home/jamie/history/')
cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +
%trim(MyNewName) + Q + ')' +
' TODIR(' + Q + %trim(PathName) + 'History/' +
Q + ')';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring:cmdlength);
on-error;
// process for errors
endmon;
endsr;
//-------------------------------------------
/end-free
*-------------------------------------------------------------
* RdIfsFil - Subprocedure To Read The IFS File
*-------------------------------------------------------------
p RdIfsFil B Export
d RdIfsFil PI 256A
d FileName 256A Const
d CharsRead S 10i 0
d CurChar S 1
d Eof C const(x'00')
/free
Oflag = O_Rdonly + O_Textdata;
// need whole path here
File = %trim(FileName) + x'00';
Fp = open(%addr(File): Oflag);
if Fp < 0;
Error_Flag = *On;
Return Error_Flag;
Endif;
R = 0;
N = 0;
dou CurChar = Eof;
exsr getChar;
R+=1;
%Subst(Data: R: 1) = CurChar;
if CurChar = X'25';
%Subst(Data: R: 1) = *blanks;
endif;
select;
when R = 256 or CurChar = X'25';
// if you find the code then we still have more data in
// memory and we need to process that remaining data.
if CurChar = X'25';
%Subst(Data: R: 1) = *blanks;
endif;
// one record is here
clear R;
clear Data;
endsl;
enddo;
Return Error_Flag;
//---------------------------------------------------------
// GetChar - Process IFS Record, One Character At A Time
//---------------------------------------------------------
begsr GetChar;
// If input buffer is empty, or all characters have been
// processed, refill the input buffer.
if N = CharsRead;
CharsRead = Read(Fp:%Addr(Data_Rec): 2560);
N = *Zero;
endif;
// Get the next character in the input buffer.
if CharsRead <= 0;
CurChar = Eof;
else;
N+=1;
CurChar = %Subst(Data_Rec: N: 1);
select;
when CurChar = *blanks or CurChar = cr or CurChar = lf;
mydata.bighunkdata = %trim(mydata.bighunkdata) + '|';
other;
mydata.Bighunkdata = %trim(mydata.bighunkdata) +
%trim(Curchar);
endsl;
endif;
endsr;
//---------------------------------------------------------
/end-free
p RdIfsFil E
H Option( *SrcStmt: *NoDebugIo ) BndDir( 'QC2LE' ) DFTACTGRP(*No)
‚**********************************************************************
‚* Project ID Date Pgmr ID Rev Description
‚*
‚* 11/16/11 JJF 00 program written
‚* ** pulls .csv tables from directory:
‚* /home/jamie/
‚*
‚**********************************************************************
*
* Directory Entry Structure (dirent)
*
d p_dirent s *
d dirent ds based(p_dirent)
d d_reserv1 16A
d d_reserv2 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
*------------------------------------------------------------
* Open a Directory
*------------------------------------------------------------
d opendir pr * EXTPROC('opendir')
d dirname * VALUE
*------------------------------------------------------------
* Read Directory Entry
*------------------------------------------------------------
d readdir pr * EXTPROC('readdir')
d dirname * VALUE
*------------------------------------------------------------
* Close Directory
*------------------------------------------------------------
d closedir pr * EXTPROC('closedir')
d dirname * VALUE
*------------------------------------------------------------
* Open IFs table
*------------------------------------------------------------
d open pr 10i 0 ExtProc('open')
d filename * value
d openflags 10i 0 value
d mode 10u 0 value options(*nopass)
d codepage 10u 0 value options(*nopass)
*------------------------------------------------------------
* Read IFS table
*------------------------------------------------------------
d read pr 10i 0 ExtProc('read')
d filehandle 10i 0 value
d datareceived * value
d nbytes 10u 0 value
*------------------------------------------------------------
* Close IFs table
*------------------------------------------------------------
d close pr 10i 0 ExtProc('close')
d filehandle 10i 0 value
*------------------------------------------------------------
* read ifs table - internal procedure
*------------------------------------------------------------
d RdIfsFil pr 256a
d FileName 256a const
*------------------------------------------------------------
* Delay - sleep function
*------------------------------------------------------------
d sleep pr 10i 0 ExtProc( 'sleep' )
d seconds 10u 0 Value
*------------------------------------------------------------
* Command - run a command
*------------------------------------------------------------
d $command pr extpgm('QCMDEXC')
d command 256
d length 15 5
*------------------------------------------------------------
* Grab the date in LongFormat
*------------------------------------------------------------
d CEEDATE pr opdesc
d Lilian 10i 0
d picture 65535A const options(*varsize)
d OutputDate 65535A const options(*varsize)
d Feedback 12a options(*omit)
*------------------------------------------------------------
* a few local variables...
d BaseDate s d inz(D'1582-10-14')
d cmdlength s 15 5
d cmdstring s 256
d count s 3 0
d cr c Const(x'0D')
d data s 65535A
d Data_Rec s 65535A
d datasize s 5 0
d dh s *
d Eol c Const(x'0D25')
d Error_Flag s 1A INZ('0')
d File s 256
d FileName s 256 varying
d FolderNames s 256 dim(50)
d Fp s 10i 0
d KeepLooping s n inz('1')
d lf C Const(x'25')
d MyNewName s 265 varying
d N s 5 0
d nDays s 10i 0
* values for oflag parameter, used by open()
d O_RDONLY s 10i 0 inz(1)
d O_TEXTDATA s 10i 0 inz(16777216)
d Oflag s 10i 0
d Omode s 10u 0
d PathName s 26
d Q s 1 inz('''')
d R S 5 0
d Rc S 10i 0
d ReturnData s 12
d SleepSeconds s 10i 0 inz(1)
d ta s 3 0
d Today s d inz(*SYS)
// entire document stored in here
d MyData ds qualified inz
d bighunkdata 65535
d OneSlice 60 dim(1000) overlay(bighunkdata:*next)
*------------------------------------------------------
* MAIN LINE
*------------------------------------------------------
/free
// program will loop until outside force
// stops it.
dow KeepLooping;
exsr $GetFileName;
if ta > *zeros;
// read the tables one at a time
for count = 1 to ta;
filename = foldernames(count);
Error_flag = rdifsfil(Filename);
//exsr $MoveToHistory;
endfor;
endif;
// Delay job for a number of seconds then start
// the process all over again.
sleep(SleepSeconds);
enddo;
*inlr = *on;
//-------------------------------------------
// $GetFileName - get the next csv table
//-------------------------------------------
begsr $GetFileName;
clear filename;
// tables will hold all the names of the tables
clear TA;
clear folderNames;
// loop on the directory
// Step1: Open up the directory.
PathName = '/home/jamie/';
dh = opendir(%addr(PathName));
if dh <> *NULL;
// Step2: Read each entry from the directory (in a loop)
p_dirent = readdir(dh);
dow p_dirent <> *NULL;
if d_namelen < 256;
FileName = %subst(d_name:1:d_namelen);
// process only csv files
// even MT directory contains folders:
// o .
// o ..
if %scan('.csv':Filename) > *zeros;
ta+=1;
foldernames(ta) = %trim(pathname) + %trim(filename);
endif;
endif;
p_dirent = readdir(dh);
enddo;
endif;
// Step3: Close the directory to reprocess
closedir(dh);
endsr;
//-------------------------------------------
// $MoveToHistory - move processed table to
// history
//-------------------------------------------
begsr $MoveToHistory;
// ***** Rename the file *****
// RNM OBJ('/home/jamie/some.csv')
// NEWOBJ('SomeNewName.csv')
// *like: November16_2011_114547.csv
nDays = %diff(today : baseDate : *days);
ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);
MyNewName = %trim(ReturnData) +
%char(%subdt(Today:*days)) + '_' +
%char(%subdt(Today:*years)) + '_' +
%ScanRpl('.' : '' :
%char(%time())) + '.csv';
cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +
%trim(filename) + Q + ')' +
' NEWOBJ(' + Q + %trim(MyNewName) +
Q + ')';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring:cmdlength);
on-error;
// process for errors
endmon;
// ***** Move file to history *****
// MOV OBJ('/home/jamie/some.csv')
// TODIR('/home/jamie/history/')
cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +
%trim(MyNewName) + Q + ')' +
' TODIR(' + Q + %trim(PathName) + 'History/' +
Q + ')';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring:cmdlength);
on-error;
// process for errors
endmon;
endsr;
//-------------------------------------------
/end-free
*-------------------------------------------------------------
* RdIfsFil - Subprocedure To Read The IFS File
*-------------------------------------------------------------
p RdIfsFil B Export
d RdIfsFil PI 256A
d FileName 256A Const
d CharsRead S 10i 0
d CurChar S 1
d Eof C const(x'00')
/free
Oflag = O_Rdonly + O_Textdata;
// need whole path here
File = %trim(FileName) + x'00';
Fp = open(%addr(File): Oflag);
if Fp < 0;
Error_Flag = *On;
Return Error_Flag;
Endif;
R = 0;
N = 0;
dou CurChar = Eof;
exsr getChar;
R+=1;
%Subst(Data: R: 1) = CurChar;
if CurChar = X'25';
%Subst(Data: R: 1) = *blanks;
endif;
select;
when R = 256 or CurChar = X'25';
// if you find the code then we still have more data in
// memory and we need to process that remaining data.
if CurChar = X'25';
%Subst(Data: R: 1) = *blanks;
endif;
// one record is here
clear R;
clear Data;
endsl;
enddo;
Return Error_Flag;
//---------------------------------------------------------
// GetChar - Process IFS Record, One Character At A Time
//---------------------------------------------------------
begsr GetChar;
// If input buffer is empty, or all characters have been
// processed, refill the input buffer.
if N = CharsRead;
CharsRead = Read(Fp:%Addr(Data_Rec): 2560);
N = *Zero;
endif;
// Get the next character in the input buffer.
if CharsRead <= 0;
CurChar = Eof;
else;
N+=1;
CurChar = %Subst(Data_Rec: N: 1);
select;
when CurChar = *blanks or CurChar = cr or CurChar = lf;
mydata.bighunkdata = %trim(mydata.bighunkdata) + '|';
other;
mydata.Bighunkdata = %trim(mydata.bighunkdata) +
%trim(Curchar);
endsl;
endif;
endsr;
//---------------------------------------------------------
/end-free
p RdIfsFil E
Comment