Menu

In GnuCOBOL, how do I communicate via file pipe

GnuCOBOL
2024-07-21
2024-08-02
  • Anderson Caldeireiro Matias

    I am a systems developer on Microfocus Server Express 5.1, I tried to do the same thing I do in my programs but I always receive status code 35.
    My program is an example of a cobol program calling a nodeJS program sending and receiving data.
    I even tried using the "ls -l" command to list files in the folder and always the same error.
    Below my program.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ENVIAR_RECEBER.
    
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SPECIAL-NAMES.
           DECIMAL-POINT IS COMMA.
    
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT PROGNODE ASSIGN TO WK-CMD-NODE
           ORGANIZATION IS SEQUENTIAL
           FILE STATUS WK-STAT.
    
       DATA DIVISION.
       FILE SECTION.
       FD PROGNODE.
       01 REGPROGNODE              PIC X(63000).
    
       WORKING-STORAGE SECTION.
       01 WK-STAT                  PIC X(02) VALUE SPACES.
      *----------------------------------------------------------------*
       01 WK-CMD-NODE.
          03 FILLER                VALUE "| ".
          03 FILLER                VALUE " ./node-run ".
          03 FILLER                VALUE " input ".
          03 FILLER                VALUE " log.input ".
      *   03 FILLER                VALUE LOW-VALUES.
      *----------------------------------------------------------------*              
       PROCEDURE DIVISION.
       INICIO.
           DISPLAY "IP" UPON ENVIRONMENT-NAME
           DISPLAY "10.30.0.1" UPON ENVIRONMENT-VALUE
           DISPLAY WK-CMD-NODE
           OPEN I-O PROGNODE
           IF WK-STAT NOT = ZEROS
              DISPLAY "ERRO EXECUCAO NODE - " WK-STAT
              GO TO FIM
           END-IF
    
           INITIALIZE REGPROGNODE
           MOVE '{"num1": 1, "num2": 2}' TO REGPROGNODE
           WRITE REGPROGNODE
    
           INITIALIZE REGPROGNODE
           READ PROGNODE
           IF REGPROGNODE = SPACES
              DISPLAY "Erro execucao programa (SPACES)"
              GO TO FIM
           END-IF
    
           IF REGPROGNODE(1:1) NOT = "0"
              DISPLAY REGPROGNODE(2:1000)
              GO TO FIM
           END-IF
    
           DISPLAY REGPROGNODE
           CLOSE PROGNODE
           .
    
       FIM.
           STOP RUN
           .
    
     
  • Michael F Gleason

    Your question was about communicating with pipe.
    As far as I know, pipe is used to present data to a program by using the ACCEPT and DISPLAY verbs. The facility provides for using a file to retrieve or send records to or from a line sequential file.

    For example, say you wish to pass a list of files to a program named PROG1. PROG1 would then open these files for whatever purpose it does. PROG1 would be executed from the command line
    PROG1 0< FILELIST.TXT
    A line sequential file named FILELIST.TXT would contain the list of files. It might look like this.

    NAMEMASTER.DAT
    ADDRESSMASTER.DAT
    PHONELIST.DAT
    ENDOFLIST

    Each file is on a line by itself. The CR LF on each record terminates an accept statement like the enter key does.

    PROG1 would get the list one record at a time by doing an ACCEPT.

    For example,

    000001 100-LOOP.
    000002     ACCEPT WS-FILE-NAME FROM CONSOLE
    000003     IF WS-FILE-NAME EQUAL "ENDOFLIST"
    000004         GO TO 105-NO-MORE-PROCESSING
    000005     END-IF
    000006     DISPLAY WS-FILE-NAME UPON CONSOLE
    000007     PERFORM 200-PROCESS-FILE
    000008     GO TO 100-LOOP
    000009     .
    000010 105-NO-MORE-PROCESSING.
    000011     GOBACK.
    

    The following is info from the programmer's guide. You may find this info by doing a search for "PIPE" in the guide.pdf.

    Pipe 0 is accessed by using an ACCEPT statement.
    CONSOLE This is the (screen-mode) display of the PC or Unix system.
    STDIN
    SYSIN
    SYSIPT

    These devices (they are all synonymous) represent standard system input
    (pipe 0). On a PC or UNIX system, this is typically the keyboard. The
    contents of a file may be delivered to a GnuCOBOL program for access
    via one of these device names by adding the sequence ‘0< filename’ to the
    end of the programs execution command.

    Pipe 1 and pipe 2 are accessed with a DISPLAY statement.
    CONSOLE
    PRINTER
    STDOUT
    SYSLIST
    SYSLST
    SYSOUT

    These devices (they are all synonymous) represent standard system output
    (pipe 1). On a PC or UNIX system, this is typically the display. Output
    sent to one of these devices by a GnuCOBOL program can be sent to a file
    by adding the sequence ‘1> filename’ to the end of the programs execution
    command.

    STDERR
    SYSERR

    These devices (they are synonymous) represent standard system error output
    (pipe 2). On a PC or UNIX system, this is typically the display.
    Output sent to one of these devices by a GnuCOBOL program can be sent
    to a file by adding the sequence ‘2> filename’ to the end of the programs
    execution command.

     

Log in to post a comment.