|
This is a multi-part message in MIME format. -- See attached text file for an example of a IFS API via COBOL. If the attachment gets drop let me know I'll send it to you. Thanx, PLA -----Original Message----- From: cobol400-l-admin@midrange.com [mailto:cobol400-l-admin@midrange.com]On Behalf Of Kelly Cookson Sent: Friday, July 12, 2002 2:37 PM To: cobol400-l@midrange.com Subject: RE: COBOL output to XML file I'd be very interested in learning how to write directly to an IFS file. Would I use CL to override to the IFS file, or would I select the IFS file using Cobol code? I'd appreciate any code snippets you might have. I'll also look around the IBM site to see what I can find. Thanks, Kelly --- Winchester Terry <terry.winchester@raymondcorp.com> wrote: > Kelly, > > You can write directly to the IFS file system (a > stream > file) with Cobol. You could try this technique with > a stub > program to see if it creates the file correctly. > > There was sample code on IBM's "code snippet" site, > but > apparently that has been discontinued (no surprise > here...) > > Somewhere I have it stored on CD... > > Terry > > > -----Original Message----- > > From: Kelly Cookson [mailto:kc62301@yahoo.com] > > Sent: Thursday, July 11, 2002 2:00 PM > > To: cobol400-l@midrange.com > > Subject: COBOL output to XML file > > > > > > I'm trying code a COBOL program that generates an > XML > > file. > > > > The COBOL program WRITEs to a physical file or > source > > file member, then I transfer the file to a PC text > > file. I've used the Client Access Express > transfer > > function, the copy to stream file (CPYTOSTMF) > command > > and the copy to PC document (CPYTOPCD) command. > In > > each case, an end-of-file label is added to the > text > > file. The end-of-file label makes the XML file > > ill-formed. (Deleting the end-of-file label with a > > text editor makes the XML file well-formed.) > > > > Can I WRITE directly to a PC text file from > COBOL400? > > Or can I set up a translation table that does not > add > > an end-of-file label to the PC text file? > > > > Thanks for any insights. > > > > Kelly > > > > __________________________________________________ > > Do You Yahoo!? > > Sign up for SBC Yahoo! Dial - First Month Free > > http://sbc.yahoo.com > > _______________________________________________ > > This is the COBOL Programming on the iSeries/AS400 > > (COBOL400-L) mailing list > > To post a message email: COBOL400-L@midrange.com > > To subscribe, unsubscribe, or change list options, > > visit: > http://lists.midrange.com/cgi-bin/listinfo/cobol400-l > > or email: COBOL400-L-request@midrange.com > > Before posting, please take a moment to review the > archives > > at http://archive.midrange.com/cobol400-l. > > > _______________________________________________ > This is the COBOL Programming on the iSeries/AS400 > (COBOL400-L) mailing list > To post a message email: COBOL400-L@midrange.com > To subscribe, unsubscribe, or change list options, > visit: > http://lists.midrange.com/cgi-bin/listinfo/cobol400-l > or email: COBOL400-L-request@midrange.com > Before posting, please take a moment to review the > archives > at http://archive.midrange.com/cobol400-l. > __________________________________________________ Do You Yahoo!? Sign up for SBC Yahoo! Dial - First Month Free http://sbc.yahoo.com _______________________________________________ This is the COBOL Programming on the iSeries/AS400 (COBOL400-L) mailing list To post a message email: COBOL400-L@midrange.com To subscribe, unsubscribe, or change list options, visit: http://lists.midrange.com/cgi-bin/listinfo/cobol400-l or email: COBOL400-L-request@midrange.com Before posting, please take a moment to review the archives at http://archive.midrange.com/cobol400-l. -- 5722WDS V5R1M0 010525 LN IBM ILE COBOL for AS/400 QGPL/GPLCBA55 HTC400 07/12/02 14:46:32 Page 1 Command . . . . . . . . . . . . . . . : CRTCBLMOD Actual Values: Module . . . . . . . . . . . . . . . : GPLCBA55 Library . . . . . . . . . . . . . : QGPL Source file . . . . . . . . . . . . : QCBLSRC Library . . . . . . . . . . . . . : QGPL CCSID . . . . . . . . . . . . . . : 37 Source member . . . . . . . . . . . : GPLCBA55 05/02/02 09:33:09 Text 'description' . . . . . . . . . : Write stream file with trailing spaces CPYTOSTMF1 Command Options: Module . . . . . . . . . . . . . . . : GPLCBA55 Library . . . . . . . . . . . . . : QGPL Source file . . . . . . . . . . . . : QCBLSRC Library . . . . . . . . . . . . . : QGPL Source member . . . . . . . . . . . : GPLCBA55 Output . . . . . . . . . . . . . . . : *PRINT Generation severity level . . . . . : 30 Text 'description' . . . . . . . . . : *SRCMBRTXT Compiler options . . . . . . . . . . : *EVENTF Conversion options . . . . . . . . . : *NONE Message limit: Number of messages . . . . . . . . : *NOMAX Message limit severity . . . . . . : 30 Debug view . . . . . . . . . . . . . : *LIST Optimize level . . . . . . . . . . . : *NONE FIPS flagging . . . . . . . . . . . : *NOFIPS *NOOBSOLETE Extended display options . . . . . . : *NONE Flagging severity . . . . . . . . . : 0 Replace module . . . . . . . . . . . : *YES Authority . . . . . . . . . . . . . : *LIBCRTAUT Link literal . . . . . . . . . . . . : *PGM Target release . . . . . . . . . . . : *CURRENT Sort sequence . . . . . . . . . . . : *HEX Library . . . . . . . . . . . . . : Language identifier . . . . . . . . : *JOBRUN Enable performance collection: Collection level . . . . . . . . . : *PEP Profiling data . . . . . . . . . . . : *NOCOL Coded character set ID . . . . . . . : *JOBRUN Arithmetic mode. . . . . . . . . . . : *NOEXTEND Padding character: Single byte to national . . . . . : NX"0020" Double byte to national . . . . . : NX"3000" National to national . . . . . . . : NX"3000" Compiler . . . . . . . . . . . . . . : IBM ILE COBOL for AS/400 5722WDS V5R1M0 010525 LN IBM ILE COBOL for AS/400 QGPL/GPLCBA55 HTC400 07/12/02 14:46:32 Page 2 S o u r c e STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 000100 PROCESS APOST NOMONOPRC. 99/09/17 1 000200 IDENTIFICATION DIVISION. 99/01/13 2 000300 PROGRAM-ID. GPLCBA55. 02/05/02 3 000400 AUTHOR. PLA. 99/01/13 4 000500 DATE-WRITTEN. 05/02/2002. 02/05/02 000600* 99/01/13 000700* Write db file to stream file 02/05/02 000801* for CPYTOSTMF1 command. 02/05/02 000802* The CPYTOSTMF1 command retains trailing 02/05/02 000803* spaces and the CPYTOSTMF command does not. 02/05/02 000804* 02/05/02 5 000900 ENVIRONMENT DIVISION. 99/01/13 6 001000 CONFIGURATION SECTION. 99/01/13 7 001001 SOURCE-COMPUTER. IBM-AS400. 99/09/17 8 001004 OBJECT-COMPUTER. IBM-AS400. 99/09/17 9 001006 SPECIAL-NAMES. 99/09/17 001007 02/05/02 10 001008 LINKAGE TYPE IS PROCEDURE FOR 'open' USING ALL DESCRIBED. 99/09/17 11 001300 INPUT-OUTPUT SECTION. 99/01/13 12 001400 FILE-CONTROL. 99/01/13 001401 02/05/02 13 001500 SELECT IPF-INPUT-FILE 02/05/02 14 001502 ASSIGN DATABASE-INPUTFILE 02/05/02 15 001507 FILE STATUS WS-FILE-STATUS. 02/05/02 001508 02/05/02 16 002400 DATA DIVISION. 99/01/13 17 002500 FILE SECTION. 99/01/13 002501 02/05/02 18 002600 FD IPF-INPUT-FILE. 02/05/02 19 002602 01 IPR-INPUT-FILE PIC X(2048). 02/05/02 002604 02/05/02 20 003500 WORKING-STORAGE SECTION. 99/01/13 003501 02/05/02 21 003502 01 WS-FILE-STATUS PIC X(02). 02/05/02 003503 02/05/02 22 003504 01 WS-EOF-INDIC PIC 1. 02/05/02 23 003505 88 END-OF-FILE VALUE B'1'. 02/05/02 24 003506 88 NOT-END-OF-FILE VALUE B'0'. 02/05/02 003507 99/09/17 003508 COPY UNIXVAR OF QGPL-QCBLSRC. 99/09/17 +004300* UNIXVAR 99/09/17 +004301* Variables for UNIX-type APIs. UNIXVAR 99/09/17 +004303* UNIXVAR 99/09/17 +004304* 02/16/2000 PLA increase fname from 50 to 132 UNIXVAR 00/02/16 +004305* added dirp, dirname UNIXVAR 00/02/16 +004306* UNIXVAR 00/02/16 25 +004307 01 oflag PIC S9(9) BINARY VALUE 0. UNIXVAR 99/09/17 +004308 UNIXVAR 99/09/17 26 +004700 01 O-TEXTDATA PIC S9(9) BINARY VALUE 16777216. UNIXVAR 99/09/17 +004701 UNIXVAR 99/09/17 27 +005500 01 O-CODEPAGE PIC S9(9) BINARY VALUE 8388608. UNIXVAR 99/09/17 +005501 UNIXVAR 99/09/17 28 +006700 01 O-RDWR PIC S9(9) BINARY VALUE 4. UNIXVAR 99/09/17 5722WDS V5R1M0 010525 LN IBM ILE COBOL for AS/400 QGPL/GPLCBA55 HTC400 07/12/02 14:46:32 Page 3 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +006701 UNIXVAR 99/09/17 29 +007100 01 O-CREAT PIC S9(9) BINARY VALUE 8. UNIXVAR 99/09/17 +007101 UNIXVAR 99/09/17 30 +008300 01 fmode PIC S9(9) BINARY VALUE 0. UNIXVAR 99/09/17 +008301 UNIXVAR 99/09/17 31 +008700 01 S-IRWXU PIC S9(9) BINARY VALUE 448. UNIXVAR 99/09/17 +008701 UNIXVAR 99/09/17 32 +009500 01 cp PIC S9(9) BINARY VALUE 819. UNIXVAR 99/09/17 +009501 UNIXVAR 99/09/17 33 +010000 01 fname PIC X(132). UNIXVAR 00/02/16 34 +010001 01 dirname PIC X(132). UNIXVAR 00/02/16 35 +010002 01 dirp PIC X(132). UNIXVAR 00/02/16 +010003 UNIXVAR 99/09/17 36 +010600 01 fd1 PIC S9(9) BINARY VALUE 0. UNIXVAR 99/09/17 +010601 UNIXVAR 99/09/17 37 +011800 01 rc PIC 9(9) BINARY VALUE 0. UNIXVAR 99/09/17 +011801 UNIXVAR 99/09/17 38 +013300 01 bufout PIC X(1000). UNIXVAR 99/09/17 +013301 UNIXVAR 99/09/17 39 +013600 01 bytes PIC S9(9) BINARY. UNIXVAR 99/09/17 003509 99/09/17 40 009100 LINKAGE SECTION. 99/01/13 009200 99/01/14 41 009301 01 LS-FILE PIC X(256). 02/05/02 009302 02/05/02 42 009303 01 LS-LENGTH COMP-3 PIC S9(10). 02/05/02 009600 99/01/14 43 009700 PROCEDURE DIVISION USING LS-FILE, LS-LENGTH. 02/05/02 009800 99/01/13 009900 OPENING-PARAGRAPH. 99/01/13 44 009911 PERFORM INITIALIZATION. 02/05/02 45 009912 PERFORM MAIN-ROUTINE 02/05/02 009913 UNTIL END-OF-FILE 02/05/02 46 009914 PERFORM CLOSE-FILES. 02/05/02 47 009915 GOBACK. 02/05/02 009916 02/05/02 009917 MAIN-ROUTINE. 02/05/02 48 009918 STRING IPR-INPUT-FILE(1:LS-LENGTH) 02/05/02 009922 DELIMITED BY SIZE 02/05/02 009923 INTO bufout 00/11/01 009924 POINTER bytes 00/11/01 009925 END-STRING. 00/11/01 49 009926 PERFORM WRITE-TO-STREAM-FILE. 00/11/01 50 009927 PERFORM READ-INPUT-FILE. 02/05/02 009960 02/05/02 009961 READ-INPUT-FILE. 02/05/02 51 009962 READ IPF-INPUT-FILE 02/05/02 52 009963 AT END SET END-OF-FILE TO TRUE 02/05/02 53 009964 NOT END SET NOT-END-OF-FILE TO TRUE 02/05/02 009965 END-READ. 02/05/02 010700 99/01/13 026578 WRITE-TO-STREAM-FILE. 99/09/17 026582 COPY UNIXWRITE OF QGPL-QCBLSRC. 99/09/17 +000100* UNIXWRITE 99/09/17 +000200* UNIX-type API for writing to a stream file. UNIXWRITE 99/09/17 5722WDS V5R1M0 010525 LN IBM ILE COBOL for AS/400 QGPL/GPLCBA55 HTC400 07/12/02 14:46:32 Page 4 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +000300* UNIXWRITE 99/09/17 54 +000400 MOVE X'0D25' TO bufout(bytes:). UNIXWRITE 00/08/10 55 +000500 ADD 1 TO bytes. UNIXWRITE 00/08/10 56 +000600 IF bytes > FUNCTION LENGTH(bufout) UNIXWRITE 99/09/29 57 +000700 DISPLAY 'Length exceeded on WRITE' UNIXWRITE 99/09/29 +000800 END-IF. UNIXWRITE 99/09/29 58 +000900 CALL PROCEDURE 'write' USING BY VALUE fd1 UNIXWRITE 99/09/29 +001000 BY REFERENCE bufout UNIXWRITE 99/09/29 +001100 BY VALUE bytes UNIXWRITE 99/09/29 +001200 GIVING rc. UNIXWRITE 99/09/29 59 +001300 MOVE SPACES TO bufout. UNIXWRITE 99/09/29 60 +001400 COMPUTE bytes = 1. UNIXWRITE 99/09/29 61 +001500 IF rc = -1 THEN UNIXWRITE 99/09/29 62 +001600 DISPLAY 'Error on write' UNIXWRITE 99/09/29 63 +001700 STOP RUN UNIXWRITE 99/09/29 +001800 END-IF. UNIXWRITE 99/09/29 026583 02/05/02 026584 CLOSE-FILES. 02/05/02 64 026585 CLOSE IPF-INPUT-FILE. 02/05/02 026586 COPY UNIXCLOSE OF QGPL-QCBLSRC. 02/05/02 +004300* UNIXCLOSE 99/09/17 +004301* UNIX-type API for closing a stream file. UNIXCLOSE 99/09/17 +004303* UNIXCLOSE 99/09/17 65 +004304 CALL PROCEDURE 'close' USING BY VALUE fd1 UNIXCLOSE 99/09/17 +004306 GIVING rc. UNIXCLOSE 99/09/17 66 +004307 IF rc = -1 THEN UNIXCLOSE 99/09/17 67 +004308 display 'error on close' UNIXCLOSE 99/09/17 68 +004309 STOP RUN UNIXCLOSE 99/09/17 +004310 END-IF. UNIXCLOSE 99/09/17 026587 02/05/02 026588 INITIALIZATION. 02/05/02 69 026589 STRING LS-FILE 02/05/02 026590 X'00' 02/05/02 026591 DELIMITED BY SPACES 02/05/02 026592 INTO fname 02/05/02 026593 END-STRING. 02/05/02 026594 COPY UNIXOPENO OF QGPL-QCBLSRC. 02/05/02 +004300* UNIXOPENO 99/09/17 +004301* UNIX-type API for opening a stream file. UNIXOPENO 99/09/17 +004303* UNIXOPENO 99/09/17 70 +004304 COMPUTE oflag = O-RDWR UNIXOPENO 99/09/17 +004306 + O-CREAT UNIXOPENO 99/09/17 +004307 + O-CODEPAGE. UNIXOPENO 99/09/17 71 +004308 COMPUTE fmode = S-IRWXU. UNIXOPENO 99/09/17 72 +004309 CALL PROCEDURE 'open' USING BY REFERENCE fname UNIXOPENO 99/09/17 +004310 BY VALUE oflag UNIXOPENO 99/09/17 +004311 BY VALUE fmode UNIXOPENO 99/09/17 +004312 BY VALUE cp UNIXOPENO 99/09/17 +004313 GIVING fd1. UNIXOPENO 99/09/17 73 +004314 IF fd1 = -1 THEN UNIXOPENO 99/09/17 74 +004315 display 'error on open' UNIXOPENO 99/09/17 75 +004316 STOP RUN UNIXOPENO 99/09/17 +004317 END-IF. UNIXOPENO 99/09/17 76 +004318 CALL PROCEDURE 'close' USING BY VALUE fd1 UNIXOPENO 99/09/17 +004319 GIVING rc. UNIXOPENO 99/09/17 5722WDS V5R1M0 010525 LN IBM ILE COBOL for AS/400 QGPL/GPLCBA55 HTC400 07/12/02 14:46:32 Page 5 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 77 +004320 IF rc = -1 THEN UNIXOPENO 99/09/17 78 +004321 display 'error on close' UNIXOPENO 99/09/17 79 +004322 STOP RUN UNIXOPENO 99/09/17 +004323 END-IF. UNIXOPENO 99/09/17 80 +004324 COMPUTE oflag = O-RDWR UNIXOPENO 99/09/17 +004325 + O-TEXTDATA. UNIXOPENO 99/09/17 81 +004326 CALL PROCEDURE 'open' USING BY REFERENCE fname UNIXOPENO 99/09/17 +004327 BY VALUE oflag UNIXOPENO 99/09/17 +004328 GIVING fd1. UNIXOPENO 99/09/17 82 +004329 IF fd1 = -1 THEN UNIXOPENO 99/09/17 83 +004330 display 'error on second open' UNIXOPENO 99/09/17 84 +004331 STOP RUN UNIXOPENO 99/09/17 +004332 END-IF. UNIXOPENO 99/09/17 85 026595 COMPUTE bytes = 1. 02/05/02 86 026596 MOVE SPACES TO bufout. 02/05/02 87 026597 OPEN INPUT IPF-INPUT-FILE. 02/05/02 88 026598 PERFORM READ-INPUT-FILE. 02/05/02 * * * * * E N D O F S O U R C E * * * * * 5722WDS V5R1M0 010525 LN IBM ILE COBOL for AS/400 QGPL/GPLCBA55 HTC400 07/12/02 14:46:32 Page 6 M e s s a g e s STMT * 72 MSGID: LNC0790 SEVERITY: 10 SEQNBR: +004310 Message . . . . : Operational descriptor not created for 'OFLAG'. Argument accepted. * 72 MSGID: LNC0790 SEVERITY: 10 SEQNBR: +004311 Message . . . . : Operational descriptor not created for 'FMODE'. Argument accepted. * 72 MSGID: LNC0790 SEVERITY: 10 SEQNBR: +004312 Message . . . . : Operational descriptor not created for 'CP'. Argument accepted. * 81 MSGID: LNC0790 SEVERITY: 10 SEQNBR: +004327 Message . . . . : Operational descriptor not created for 'OFLAG'. Argument accepted. * 88 MSGID: LNC0650 SEVERITY: 0 SEQNBR: 026598 Message . . . . : Blocking/Deblocking for file 'IPF-INPUT-FILE' will be performed by compiler-generated code. Message Summary Message totals: Information (00-04) . . . . . . . . : 1 Warning (05-19) . . . . . . . . : 4 Error (20-29) . . . . . . . . : 0 Severe (30-39) . . . . . . . . : 0 Terminal (40-99) . . . . . . . . : 0 -------------------------------------------- Total 5 * * * * * E N D O F M E S S A G E S * * * * * Statistics: Source records read . . . . . . . . : 89 Copy records read . . . . . . . . . : 91 Copy members processed . . . . . . : 4 Sequence errors . . . . . . . . . . : 0 Highest severity message issued . . : 10 LNC0899 0 Module GPLCBA55 created in library QGPL on 07/12/02 at 14:46:32. * * * * * E N D O F C O M P I L A T I O N * * * * * --
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.
midrange.com
