Skip to content

Instantly share code, notes, and snippets.

@MikeWills

MikeWills/callingpgmsnipit.rpgle Secret

Created January 19, 2012 05:26
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save MikeWills/8bf191a4c9d4456cad16 to your computer and use it in GitHub Desktop.
Save MikeWills/8bf191a4c9d4456cad16 to your computer and use it in GitHub Desktop.
Download ZIP
IFS wrapper subprocedure
Raw
callingpgmsnipit.rpgle
P*--------------------------------------------------
P* Procedure name: CreateCsvHeader
P* Purpose:
P* Returns:
P*--------------------------------------------------
P CreateCsvHeader...
P B
D CreateCsvHeader...
D PI
D file S 256A varying
D mode S 3A
D flags S 3A
D string S 2048A
/free
file = '/tmp/customersbysalesperson.csv';
fileId = InitFile(file:'777':'W':*on);
string = '"Salesperson","Customer Name","Address 1", "Address 2", ' +
'"City", "State", "Zip", "Phone", "Email"' + CRLF;
WriteBuffer(fileId:%addr(string));
return;
/end-free
P CreateCsvHeader...
P E
P*--------------------------------------------------
P* Procedure name: CreateCsvRecord
P* Purpose:
P* Returns:
P*--------------------------------------------------
P CreateCsvRecord...
P B
D CreateCsvRecord...
D PI
D string S 2048A
/free
string = '"' + PrintHead.PSalesPer + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PName) + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PAddr1) + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PAddr2) + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PCity) + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PState) + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PZip) + '"';
string = %trim(string) + ',"' +
%editw(PrintDetail.PPhone:' - - ') + '"';
string = %trim(string) + ',"' + %trim(PrintDetail.PEmail) + '"';
string = %trim(string) + CRLF;
WriteBuffer(fileId:%addr(string));
return;
/end-free
P CreateCsvRecord...
P E
Raw
ifs.rpgle
H nomain option(*srcstmt:*nodebugio)
//*************************************************************************
// Program . . . . . IFS
//
// Created on . . . 01/06/2011
// by . . . Michael N. Wills
//
// Description . . .
//
// To Compile:
// *> CRTRPGMOD MODULE(&O/&ON) SRCFILE(&L/&F) SRCMBR(&N) DBGVIEW(*SOURCE)
// *> CRTSRVPGM SRVPGM(&O/&ON) OPTION(*DUPPROC)
// *> DLTSPLF FILE(&ON) SPLNBR(*LAST)
//
// CHANGE LOG:
// Date | Name | Description
// -----------------------------------------------------------------------
// | |
// | |
// | |
//*************************************************************************
// Prototypes
/copy QSRVSRC,IFS_H
/copy IFSEBOOK/QRPGLESRC,IFSIO_H
// **********************************************************************
// Global Definitions
D fd S 10I 0
D*--------------------------------------------------
D* Procedure name: BuildFileMode
D* Purpose:
D* Returns:
D* Parameter: mode
D*--------------------------------------------------
D BuildFileMode PR 10I 0
D mode 3A CONST
D*--------------------------------------------------
D* Procedure name: BuildFileOFlag
D* Purpose:
D* Returns:
D*--------------------------------------------------
D BuildFileOFlag PR 10I 0
D flags 3A const
D overwrite N const
// **********************************************************************
P*--------------------------------------------------
P* Procedure name: InitFile
P* Purpose: Initialize the file and prepare for writting the file
P* Returns: *ON if open error
P* Parameter: path
P* Parameter: file
P* Parameter: options => Pass options on how to open the file
P* Parameter: overwrite
P*--------------------------------------------------
P InitFile B EXPORT
D InitFile PI 10I 0
D path 512A VARYING
D CONST
D mode 3A CONST
D flags 3A CONST
D overwrite N CONST
D OPTIONS(*NOPASS)
D UTF8 c const(1208)
D JOB c const(0)
/free
callp unlink(%trim(path));
return open(%trim(path):
BuildFileOFlag(flags:overwrite):
BuildFileMode(mode):UTF8);
/end-free
P InitFile E
P*--------------------------------------------------
P* Procedure name: CloseFile
P* Purpose:
P* Returns:
P*--------------------------------------------------
P CloseFile B EXPORT
D CloseFile PI
D fileDesc 10I 0 VALUE
/free
callp close(fileDesc);
/end-free
P CloseFile E
P*--------------------------------------------------
P* Procedure name: WriteBuffer
P* Purpose:
P* Returns: Number of bytes written
P* Parameter: buffer
P*--------------------------------------------------
P WriteBuffer B EXPORT
D WriteBuffer PI 10I 0
D fileDesc 10I 0 VALUE
D buffer * VALUE
D* Local fields
D retField S 10I 0
/free
return write(fd: %addr(buffer):%size(buffer));
/end-free
P WriteBuffer E
P*--------------------------------------------------
P* Procedure name: ReadBuffer
P* Purpose:
P* Returns: number of bytes read
P* Parameter: buffer
P*--------------------------------------------------
P ReadBuffer B EXPORT
D ReadBuffer PI 10I 0
D fileDesc 10I 0 VALUE
D buffer * VALUE
D* Local fields
D retField S 10I 0
/free
retField = read(fd: %addr(buffer): %size(buffer));
return retField;
/end-free
P ReadBuffer E
P*--------------------------------------------------
P* Procedure name: DeleteFile
P* Purpose:
P* Returns: Success = *on
P* Parameter: path
P*--------------------------------------------------
P DeleteFile B EXPORT
D DeleteFile PI 10I 0
D path 512A VARYING
D CONST
/free
return unlink(path);
/end-free
P DeleteFile E
P*--------------------------------------------------
P* Procedure name: BuildFileMode
P* Purpose:
P* Returns:
P* Parameter: mode
P*--------------------------------------------------
P BuildFileMode B
D BuildFileMode PI 10I 0
D mode 3A CONST
D* Local fields
D retField S 10I 0
/free
retField = 0;
//
// User
// No Permission
if (%subst(mode:1:1) = '0');
retField += 0;
endif;
// Execute
if (%subst(mode:1:1) = '1');
retField += S_IXUSR;
endif;
// Write
if (%subst(mode:1:1) = '2');
retField += S_IWUSR;
endif;
// Write & Execute
if (%subst(mode:1:1) = '3');
retField += S_IWUSR + S_IXUSR;
endif;
// Read
if (%subst(mode:1:1) = '4');
retField += S_IRUSR;
endif;
// Read & Execute
if (%subst(mode:1:1) = '5');
retField += S_IRUSR + S_IXUSR;
endif;
// Read & Write
if (%subst(mode:1:1) = '6');
retField += S_IRUSR + S_IWUSR;
endif;
// Read, Write & Execute
if (%subst(mode:1:1) = '7');
retField += S_IRWXU;
endif;
//
// Group
// No Permission
if (%subst(mode:2:1) = '0');
retField += 0;
endif;
// Execute
if (%subst(mode:2:1) = '1');
retField += S_IXGRP;
endif;
// Write
if (%subst(mode:2:1) = '2');
retField += S_IWGRP;
endif;
// Write & Execute
if (%subst(mode:2:1) = '3');
retField += S_IWGRP + S_IXGRP;
endif;
// Read
if (%subst(mode:2:1) = '4');
retField += S_IRGRP;
endif;
// Read & Execute
if (%subst(mode:2:1) = '5');
retField += S_IRGRP + S_IXGRP;
endif;
// Read & Write
if (%subst(mode:2:1) = '6');
retField += S_IRGRP + S_IWGRP;
endif;
// Read, Write & Execute
if (%subst(mode:2:1) = '7');
retField += S_IRWXG;
endif;
//
// Other
// No Permission
if (%subst(mode:3:1) = '0');
retField += 0;
endif;
// Execute
if (%subst(mode:3:1) = '1');
retField += S_IXOTH;
endif;
// Write
if (%subst(mode:3:1) = '2');
retField += S_IWOTH;
endif;
// Write & Execute
if (%subst(mode:3:1) = '3');
retField += S_IWOTH + S_IXOTH;
endif;
// Read
if (%subst(mode:3:1) = '4');
retField += S_IROTH;
endif;
// Read & Execute
if (%subst(mode:3:1) = '5');
retField += S_IROTH + S_IXOTH;
endif;
// Read & Write
if (%subst(mode:3:1) = '6');
retField += S_IROTH + S_IWOTH;
endif;
// Read, Write & Execute
if (%subst(mode:3:1) = '7');
retField += S_IRWXO;
endif;
return retField;
/end-free
P BuildFileMode E
P*--------------------------------------------------
P* Procedure name: BuildFileOFlag
P* Purpose:
P* Returns:
P*--------------------------------------------------
P BuildFileOFlag B
D BuildFileOFlag PI 10I 0
D flags 3A const
D overwrite N const
D* Local fields
D retField S 10I 0
/free
retField = O_CREAT + O_CCSID + O_TEXTDATA + O_EXCL + O_TEXT_CREAT;
select;
when flags = 'R';
retField += O_RDONLY;
when flags = 'W';
retField += O_WRONLY;
when flags = 'RW';
retField += O_RDWR;
endsl;
if (overwrite);
retField += O_TRUNC;
else;
retField += O_APPEND;
endif;
return retField;
/end-free
P BuildFileOFlag E
Raw
ifs_h.rpgle
// **********************************************************************
// Copybook for IFS
D fileDescription...
D S 10I 0
D fileResponce S 10I 0
D CRLF C const(x'0d25')
D*--------------------------------------------------
D* Procedure name: Init
D* Purpose: Initialize the file and prepare for writting the file
D* Returns:
D* Parameter: path
D* Parameter: file
D* Parameter: options => Pass options on how to open the file
D* Parameter: overwrite
D*--------------------------------------------------
D InitFile PR 10I 0
D path 512A VARYING
D CONST
D mode 3A CONST
D flags 3A CONST
D overwrite N CONST
D OPTIONS(*NOPASS)
D*--------------------------------------------------
D* Procedure name: CloseFile
D* Purpose:
D* Returns:
D*--------------------------------------------------
D CloseFile PR
D fileDesc 10I 0 VALUE
D*--------------------------------------------------
D* Procedure name: WriteBuffer
D* Purpose:
D* Returns: Number of bytes written
D* Parameter: buffer
D*--------------------------------------------------
D WriteBuffer PR 10I 0
D fileDesc 10I 0 VALUE
D buffer * VALUE
D*--------------------------------------------------
D* Procedure name: ReadBuffer
D* Purpose:
D* Returns:
D* Parameter: buffer
D*--------------------------------------------------
D ReadBuffer PR 10I 0
D fileDesc 10I 0 VALUE
D buffer * VALUE
D*--------------------------------------------------
D* Procedure name: DeleteFile
D* Purpose:
D* Returns: Success = *on
D* Parameter: path
D*--------------------------------------------------
D DeleteFile PR 10I 0
D path 512A VARYING
D CONST
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment