|
midrange.com
On Fri, 5 Apr 2002, Joel Fritz wrote:
>
> I spent an hour or so yesterday trying to find definitions for the constants
> mentioned in the api doc. Then I had to get back to work. <g>
STRSEU QSYSINC/SYS WAIT will show you the C defs...
>
> It's one of my pet peeves that a lot of the api documentation is C oriented.
> Makes you think that no one thought anyone would want to call them from RPG.
> Some things like executable macros and functions with variable argument
> lists don't necessarily translate into RPG easily.
>
Very true. But, I think the reason that everything is C oriented is
because it is designed to work just like the Unix version. I think the
hope was that by providing lots of functions that are compatable with
Unix, they'd be able to find converts from Unix to OS/400.
C is the primary programming language on Unix systems. In fact, the
operating system itself is written in C.
At any rate, this whole thread got me really excited about QzshSystem().
(I have worked with waitpid() and the WIFxxxx macros before on FreeBSD,
which is a Unix-type OS, but had never heard of QzshSystem until you guys
mentioned it...)
To a geek like me, being able to run Unix commands in an RPG program is
an intoxicating idea :)
So, I put together an RPG program that works (more or less) the same
way as the sample C program from the Info Center manuals. While the
program itself isn't terribly useful (it does an ls, which would be better
done with the opendir() and readdir() APIs) it's good as an example of
how to execute a QSHELL command from RPG.
Naturally, you'll want to split out some of the data into /copy members
and service programs, but it's just easier to post the example as all one
member, so here it is:
H BNDDIR('QC2LE') DFTACTGRP(*NO)
* The QSHELL APIs:
*
D QzshSystem PR 10I 0 extproc('QzshSystem')
D command * value options(*string)
D QzshCheckShellCommand...
D PR 10I 0 extproc('QzshCheckShellCommand')
D command * value options(*string)
D path * value options(*string)
** IFS APIs used for simulating STDIN, STDOUT, STDERR
D open PR 10I 0 ExtProc('open')
D filename * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D codepage 10U 0 value options(*nopass)
D close PR 10I 0 ExtProc('close')
D handle 10I 0 value
D unlink PR 10I 0 ExtProc('unlink')
D path * Value options(*string)
D O_RDONLY C 1
D O_WRONLY C 2
D O_CREAT C 8
D O_TRUNC C 64
* for retrieving the C error number 'errno':
*
D @__errno PR * ExtProc('__errno')
D strerror PR * ExtProc('strerror')
D errnum 10I 0 value
D p_errno s *
D errno S 10I 0 based(p_errno)
* procedures that act like the C macros from <sys/wait.h>
*
D WIFEXITED PR 10I 0
D Status 10I 0 value
D WIFSIGNALED PR 10I 0
D Status 10I 0 value
D WIFSTOPPED PR 10I 0
D Status 10I 0 value
D WIFEXCEPTION PR 10I 0
D Status 10I 0 value
D WEXITSTATUS PR 10I 0
D Status 10I 0 value
D WSTOPSIG PR 10I 0
D Status 10I 0 value
D WTERMSIG PR 10I 0
D Status 10I 0 value
D WEXCEPTNUMBER PR 10I 0
D Status 10I 0 value
D WEXCEPTMSGID PR 7A
D Status 10I 0 value
D SDS
D dsJobNo 264 269A
* Execute an OS/400 command
D QCMDEXC PR ExtPgm('QCMDEXC')
D command 200A const
D length 15P 5 const
* actual example starts here:
D command S 100A varying
D s S 10I 0
D msg S 52A
D x S 10I 0
c exsr SetupIO
c eval command = 'ls'
c if QzshCheckShellCommand(command:*NULL) = 0
c eval s = QzshSystem(command)
* the "exit status" is an integer returned from the program we ran.
* usually, C programs (at least, on Unix systems) do a exit(0) if
* they were successful, or exit(1 or higher) if they failed.
c select
c when WIFEXITED(s) <> 0
c and WEXITSTATUS(s) = 0
c eval msg = 'Exit status = 0 (success)'
c dsply msg
c when WIFEXITED(s) <> 0
c eval msg = 'Exit status = ' +
c %editc(WEXITSTATUS(s): 'N')
c dsply msg
c when WIFSIGNALED(s) <> 0
c eval msg = 'Ended with signal ' +
c %editc(WTERMSIG(s): 'N')
c dsply msg
c when WIFEXCEPTION(s) <> 0
c eval msg = 'Ended with error ' +
c WEXCEPTMSGID(s)
c dsply msg
c endsl
c else
c eval p_errno = @__errno
c eval msg = %str(strerror(errno))
c dsply msg
c endif
c exsr CloseIO
c eval *inlr = *on
*===============================================================
* File descriptors 0, 1 & 2 are used by unix-environments for
* stdin, stdout & stderr.
*
* Here we just direct those 3 descriptors to stream files
*===============================================================
CSR SetupIO begsr
C*------------------------
C* close them if they're open
c for x = 0 to 2
c callp close(x)
c endfor
c eval Msg = *blanks
* open up 0, 1, 2 as files.
c if open('/dev/qsh-stdin-null':O_RDONLY)<>0
c eval Msg = 'unable to open a fake STDIN'
c endif
c if open('/tmp/stdout-'+dsJobNo:
c O_WRONLY+O_CREAT+O_TRUNC: 511)<>1
c eval Msg = 'unable to open a fake STDOUT'
c endif
c if open('/tmp/stderr-'+dsJobNo:
c O_WRONLY+O_CREAT+O_TRUNC: 511)<>2
c eval Msg = 'unable to open a fake STDERR'
c endif
C* Ack! Something foiled my plans!
c if Msg <> *blanks
c for x = 0 to 2
c callp close(x)
c dsply msg
c eval *inlr = *on
c return
c endfor
c endif
C*------------------------
CSR endsr
*===============================================================
* Close the descriptors opened by SetupIO
*===============================================================
CSR CloseIO begsr
C*------------------------
c for x = 0 to 2
c callp close(x)
c endfor
c callp QCMDEXC('DSPF ''/tmp/stdout-' +dsJobNo+
c '''': 200)
c callp unlink('/tmp/stdout-'+dsJobNo)
c callp unlink('/tmp/stderr-'+dsJobNo)
C*------------------------
CSR endsr
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to a non-zero value if child terminated normally.
* #define WIFEXITED(x) (((x) & 0xFFFF0000) ? 0 : 0x00010000)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WIFEXITED B export
D WIFEXITED PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c eval binary = Status
c bitoff x'FF' alpha3
c bitoff x'FF' alpha4
c if binary <> 0
c return 0
c else
c eval binary = 0
c biton x'01' alpha2
c return binary
c endif
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to a non-zero value if child terminated abnormally.
* #define WIFSIGNALED(x) ((x) & 0x00020000)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WIFSIGNALED B export
D WIFSIGNALED PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c eval binary = Status
c bitoff x'FF' alpha1
c bitoff x'FD' alpha2
c bitoff x'FF' alpha3
c bitoff x'FF' alpha4
c return binary
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to a non-zero value if status returned for a stopped
* child.
* #define WIFSTOPPED(x) ((x) & 0x00040000)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WIFSTOPPED B export
D WIFSTOPPED PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c eval binary = Status
c bitoff x'FF' alpha1
c bitoff x'FB' alpha2
c bitoff x'FF' alpha3
c bitoff x'FF' alpha4
c return binary
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to a non-zero value if status returned for a
* child process that terminated due to an error state.
* #define WIFEXCEPTION(x) ((x) & 0x00080000)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WIFEXCEPTION B export
D WIFEXCEPTION PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c eval binary = Status
c bitoff x'FF' alpha1
c bitoff x'F7' alpha2
c bitoff x'FF' alpha3
c bitoff x'FF' alpha4
c return binary
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to the low-order 8 bits from the childs exit status.
* #define WEXITSTATUS(x) (WIFEXITED(x) ? ((x) & 0x000000FF) : -1)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WEXITSTATUS B export
D WEXITSTATUS PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c if WIFEXITED(status) <> 0
c eval binary = status
c bitoff x'FF' alpha1
c bitoff x'FF' alpha2
c bitoff x'FF' alpha3
c return binary
c else
c return -1
c endif
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to the number of the signal that caused the child to stop.
* #define WSTOPSIG(x) (WIFSTOPPED(x) ? ((x) & 0x0000FFFF) : -1)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WSTOPSIG B export
D WSTOPSIG PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c if WIFSTOPPED(status) <> 0
c eval binary = status
c bitoff x'FF' alpha1
c bitoff x'FF' alpha2
c return binary
c else
c return -1
c endif
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to the number of the signal that caused the child to
* terminate.
* #define WTERMSIG(x) (WIFSIGNALED(x) ? ((x) & 0x0000FFFF) : -1)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WTERMSIG B export
D WTERMSIG PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c if WIFSIGNALED(status) <> 0
c eval binary = status
c bitoff x'FF' alpha1
c bitoff x'FF' alpha2
c return binary
c else
c return -1
c endif
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to the number of the OS/400 Exception that caused the
* child to terminate.
* #define WEXCEPTNUMBER(x) (WIFEXCEPTION(x) ? ((x) & 0x0000FFFF) : -1)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WEXCEPTNUMBER B export
D WEXCEPTNUMBER PI 10I 0
D Status 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
c if WIFEXCEPTION(status) <> 0
c eval binary = status
c bitoff x'FF' alpha1
c bitoff x'FF' alpha2
c return binary
c else
c return -1
c endif
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Evaluates to the OS/400 exception msg id for the status code.
* returns *blanks if no exception id is indicated.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P WEXCEPTMSGID B export
D WEXCEPTMSGID PI 7A
D Status 10I 0 value
* Exception numbers returned by WEXCEPTNUMBER() can be turned into
* exception id's by using the following process:
*
* If the number returned (in hex) is 0x0000wwyy, and if zz is the
* decimal conversion of ww, then the exception id is "MCHzzyy".
*
* Example: WEXCEPTNUMBER(my_status) --> 0x00002401 then the
* exception id would be "MCH3601".
D cvthc PR extproc('cvthc')
D OutputHex * value
D InputBits * value
D OutputSize 10I 0 value
D DS
D binary 1 4I 0
D alpha1 1 1A
D alpha2 2 2A
D alpha3 3 3A
D alpha4 4 4A
D DS
D cvtbin 1 2U 0 inz(0)
D cvtalpha 2 2A
D dsMsgID DS
D MCH 1 3A inz('MCH')
D first2 4 5A
D last2 6 7A
c eval binary = WEXCEPTNUMBER(status)
c if binary = -1
c return *blanks
c endif
c eval cvtalpha = alpha3
c move cvtbin first2
c callp cvthc(%addr(last2): %addr(alpha4): 2)
c return dsMsgID
P E
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
