-
Notifications
You must be signed in to change notification settings - Fork 20
/
QSHIFSSIZC.CLLE
110 lines (91 loc) · 5.06 KB
/
QSHIFSSIZC.CLLE
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
/* Retrieve IFS Object Size using stat64 */
/* Links: */
/* https://www.mcpressonline.com/forum/forum/x-archive-threads-started-bef */
/* ore-01-01-2002/programming-aa/15194-rpg-ile-prototype-for-ifs-api-stat- */
/* get-file-information */
/* https://blog.faq400.com/en/system-administration-en/export-source-code-to-ifs/ */
PGM PARM(&IFSFILE &SIZEDEC &ALLOCDEC &ESCONERROR)
DCL VAR(&ESCONERROR) TYPE(*CHAR) LEN(4)
DCL VAR(&IFSFILE) TYPE(*CHAR) LEN(256)
DCL VAR(&RTNVALBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&RTNVALDEC) TYPE(*DEC) LEN(5 0)
DCL VAR(&RECEIVER) TYPE(*CHAR) LEN(4096)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
DCL VAR(&SIZEDEC) TYPE(*DEC) LEN(15 0)
DCL VAR(&ALLOCDEC) TYPE(*DEC) LEN(15 0)
/* stat64 */
DCL VAR(&STATRTNVAL) TYPE(*INT) LEN(4)
DCL VAR(&STATPATH) TYPE(*CHAR) LEN(256)
DCL VAR(&STATBUFFER) TYPE(*CHAR) LEN(4096)
DCL VAR(&STATOBJSIZ) TYPE(*INT) STG(*DEFINED) +
LEN(8) DEFVAR(&STATBUFFER 17)
DCL VAR(&STATALCSIZ) TYPE(*UINT) STG(*DEFINED) +
LEN(8) DEFVAR(&STATBUFFER 49)
DCL VAR(&STATOBJTYP) TYPE(*CHAR) STG(*DEFINED) +
LEN(10) DEFVAR(&STATBUFFER 61)
DCL VAR(&IFSSIZ) TYPE(*INT) LEN(8)
DCL VAR(&IFSALC) TYPE(*INT) LEN(8)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORS))
CHGVAR VAR(&SIZEDEC) VALUE(0)
CHGVAR VAR(&ALLOCDEC) VALUE(0)
/* call stat64 to get file information */
CHGVAR VAR(&STATPATH) VALUE(&IFSFILE |< &NULL)
CALLPRC PRC('stat64') PARM((&STATPATH) +
(&STATBUFFER)) RTNVAL(&STATRTNVAL)
IF COND(&STATRTNVAL *EQ 0) THEN(DO)
CHGVAR VAR(&IFSSIZ) VALUE(&IFSSIZ + &STATOBJSIZ)
CHGVAR VAR(&IFSALC) VALUE(&IFSALC + &STATALCSIZ)
ENDDO /* COND(&STATRTNVAL *NE 0) */
/* If errors occurred */
IF COND(&STATRTNVAL *NE 0) THEN(DO)
IF COND(&ESCONERROR *EQ *YES) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
object ' |> &IFSFILE |< ' not found') +
TOPGMQ(*PRV) MSGTYPE(*ESCAPE)
ENDDO
/* Exit gracefully if not sending escape message. */
/* We will just return a negative number on error.*/
IF COND(&ESCONERROR *NE *YES) THEN(DO)
/* Set negative return code on errors and rtn diag msg */
CHGVAR VAR(&SIZEDEC) VALUE(-2)
CHGVAR VAR(&ALLOCDEC) VALUE(-2)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
object ' |> &IFSFILE |< ' not found') +
TOPGMQ(*PRV) MSGTYPE(*DIAG)
RETURN
ENDDO
ENDDO /* ENDDO when &RTNVALDEC <> 0 */
/* Send diagnostic info to the joblog */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
file' |> &IFSFILE |> 'info:') TOPGMQ(*PRV) +
MSGTYPE(*INFO)
/* Write file size to joblog */
CHGVAR VAR(&SIZEDEC) VALUE(&IFSSIZ)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('The +
number of data bytes in the file is' |> +
%CHAR(&SIZEDEC)) TOPGMQ(*PRV) MSGTYPE(*INFO)
/* Write allocated file size to joblog */
CHGVAR VAR(&ALLOCDEC) VALUE(&IFSALC)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('The +
number of bytes allocated to the file is +
' |> %CHAR(&ALLOCDEC)) TOPGMQ(*PRV) +
MSGTYPE(*INFO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
file' |> &IFSFILE |> 'size info retrieved +
successfully') TOPGMQ(*PRV) MSGTYPE(*COMP)
RETURN
ERRORS:
/* Set negative return code on errors and rtn diag msg */
CHGVAR VAR(&SIZEDEC) VALUE(-2)
CHGVAR VAR(&ALLOCDEC) VALUE(-2)
IF COND(&ESCONERROR *EQ *YES) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Error +
checking IFS file size for' |> &IFSFILE) +
TOPGMQ(*PRV) MSGTYPE(*ESCAPE)
ENDDO
IF COND(&ESCONERROR *NE *YES) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Error +
checking IFS file size for' |> &IFSFILE) +
TOPGMQ(*PRV) MSGTYPE(*DIAG)
ENDDO
ENDPGM