IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

XML-CODE 000798818 while parsing XML in COBOL


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
dsivapradeep

New User


Joined: 06 Jul 2012
Posts: 43
Location: INDIA

PostPosted: Wed Mar 20, 2013 12:41 pm
Reply with quote

Hi all,

I'm new to COBOL XML parsing procedure and learning it from the manual. When i tried to parse an XML data which is having multiple spaces i'm getting exception 'XML-CODE = 000798818'.

See below the COBOl for accessing the below PDS member content.
Code:

<LINE>                                                                  00010000
       THIS IS LINE NO.1                                                00010000
</LINE>                                                                 00010000
<LINE>                                                                  00010000
       THIS IS LINE NO. 2.                                              00010000
</LINE>                                                                 00010000


I want output to be displayed as only 2 lines with spaces i.e.
Code:

       THIS IS LINE NO.1
       THIS IS LINE NO. 2.


For this i wrote below COBOL program,
Code:

 IDENTIFICATION DIVISION.                                           
 PROGRAM-ID. PARSE1.                                               
 ENVIRONMENT DIVISION.                                             
 INPUT-OUTPUT SECTION.                                             
 FILE-CONTROL.                                                     
      SELECT XMLDOC ASSIGN TO XMLDOC.                               
 DATA DIVISION.                                                     
 FILE SECTION.                                                     
 FD XMLDOC.                                                         
 01 XML-REC PIC X(80).                                             
 WORKING-STORAGE SECTION.                                           
*01 WS-REC PIC X(80).                                               
 01 XML-DOC PIC X(1000).                                           
 01 WS-CODE PIC X(80).                                             
 01 CURRENT-ELEMENT PIC X(30).                                     
 01 EOF PIC X(02) VALUE 'N'.                                       
 01 WS-VALUE PIC 9(5).                                             
 PROCEDURE DIVISION.                                               
 A0000-MAIN-PARA.                                                   
      OPEN INPUT XMLDOC                                             
      MOVE 1 TO WS-VALUE                                           
      PERFORM READ-DOC-PARA UNTIL EOF = 'Y'                         
      DISPLAY XML-DOC                                               
       XML PARSE XML-DOC PROCESSING PROCEDURE EVENT-HANDLER         
       ON EXCEPTION                                     
           DISPLAY 'EXCEPTION OCCURED'                 
           DISPLAY XML-EVENT                           
           DISPLAY 'XML DOC ERROR ' XML-CODE           
           DISPLAY XML-TEXT                             
           STOP RUN                                     
       NOT ON EXCEPTION                                 
           DISPLAY 'XML DOC PARSING DONE SUCCESSFULLY' 
       END-XML                                         
      STOP RUN.                                         
 READ-DOC-PARA.                                         
      READ XMLDOC INTO WS-CODE                         
           AT END MOVE 'Y' TO EOF                       
           NOT AT END PERFORM CONCAT-PARA               
      END-READ.                                         
                                                       
 CONCAT-PARA.                                           
      STRING                                           
              WS-CODE DELIMITED BY SIZE                 
             INTO XML-DOC                               
             WITH POINTER WS-VALUE                     
      .                                               
                                                     
 EVENT-HANDLER SECTION.                               
       EVALUATE XML-EVENT                             
       WHEN 'START-OF-ELEMENT'                       
*           DISPLAY 'START OF ELEMENT' XML-TEXT       
            MOVE XML-TEXT TO CURRENT-ELEMENT         
*          DISPLAY 'CURRENT ELEMENT' CURRENT-ELEMENT 
       WHEN 'CONTENT-CHARACTERS'                     
           EVALUATE CURRENT-ELEMENT                   
                WHEN 'LINE'                           
                      MOVE XML-TEXT TO WS-CODE       
           END-EVALUATE                               
       WHEN 'END-OF-ELEMENT'                         
             IF XML-TEXT = 'LINE' THEN               
                  DISPLAY WS-CODE                     
             END-IF                                   
             MOVE SPACE TO CURRENT-ELEMENT           
       END-EVALUATE                                   
       .                                             


After executing this program, i'm getting following exception :
Code:

EXCEPTION OCCURED                                                             
EXCEPTION                                                                     
XML DOC ERROR 000798818                                                       
<LINE>                                                                  0001000       THIS IS LINE NO.1                                                 00020001</LINE> 


I didn't find documentation for the '798818 ' exception and so couldn't debug the source of my exception. Kindly Help me in identifying the mistakes i made here
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Wed Mar 20, 2013 1:46 pm
Reply with quote

why not start getting rid of spurious data in cols 72-80 ?
Back to top
View user's profile Send private message
charanmsrit

New User


Joined: 25 Oct 2007
Posts: 81
Location: Australia

PostPosted: Wed Mar 20, 2013 2:04 pm
Reply with quote

Check out the link

www-01.ibm.com/support/docview.wss?uid=swg21294607
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Wed Mar 20, 2013 2:30 pm
Reply with quote

That's a good link.

I do wonder about terminology sometimes:

Link wrote:
As an example, let's decode 798768.

1. Convert it to hexadecimal - 000C 3030

2. The letter C is the return code, 12 in decimal which is fatal.


"The letter C"?
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2481
Location: Netherlands, Amstelveen

PostPosted: Wed Mar 20, 2013 3:02 pm
Reply with quote

Quote:
"The letter C"?


What is wrong with that? It is totally valid.

en.wikipedia.org/wiki/Letter_(alphabet)
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Wed Mar 20, 2013 3:06 pm
Reply with quote

It leaves me wondering why the leading "000" is not explained, which doesn't seem to be covered by your link :-)
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2481
Location: Netherlands, Amstelveen

PostPosted: Wed Mar 20, 2013 3:11 pm
Reply with quote

Then the article would have said the three-digit number 000 and the letter "C". If that would have been of importance.
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Wed Mar 20, 2013 3:53 pm
Reply with quote

Well, for a return of higher than 15 (if possible), it is important, but you'd get no clue about how to "decode" 0010 or higher. "Why does C have two values in EBCDIC?" someone will ask, decimal 12, and hexadecimal C1.
Back to top
View user's profile Send private message
dsivapradeep

New User


Joined: 06 Jul 2012
Posts: 43
Location: INDIA

PostPosted: Wed Mar 20, 2013 4:08 pm
Reply with quote

Hi Charan,
That link was very useful in debugging the xml exceptions. it is 'XRSN_CHAR_INVALID' according to the manual.

Hi enrico,
I removed the column data 73-80 and added root tag which i skipped previously.. but still getting the same exception code 000798818 (i.e. XRSN_CHAR_INVALID).
Code:

<CODE>                                                                 
<LINE>                                                                 
       THIS IS LINE NO.1                                               
</LINE>                                                                 
<LINE>                                                                 
       THIS IS LINE NO. 2.                                             
</LINE>                                                                 
</CODE>                                                                 


I'm not sure what is that whitespace or '<' character i missed here!! Help me from this exception.
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Wed Mar 20, 2013 4:44 pm
Reply with quote

This might help, once you past in the error codes from the manual:

Code:
/* REXX exec to decode z/OS XML errorcodes                            */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 2007-2012               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2012-06-08 | RAHP | Update to Version 1 Release 13 of z/OS       | *
* |------------+------+----------------------------------------------| *
* | 2011-05-05 | RAHP | Remove left-over debug info                  | *
* |------------+------+----------------------------------------------| *
* | 2011-03-14 | RAHP | Parse text cut from the PDF manual           | *
* |            |      |                                              | *
* |            |      | See the comment box before the 'init_error'  | *
* |            |      | routine for important information!           | *
* |------------+------+----------------------------------------------| *
* | 2009-07-02 | RAHP | Update to Version 1 Release 10 of z/OS       | *
* |------------+------+----------------------------------------------| *
* | 2007-05-10 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* GETXML is a REXX exec to decode the z/OS XML parser errorcodes into  *
* something mortals can understand.                                    *
************************************************************************
* Send questions, suggestions and/or bug reports to:                   *
*                                                                      *
* robert@prino.org / robert.ah.prins@gmail.com                         *
*                                                                      *
* Robert AH Prins                                                      *
* Taboralaan 46                                                        *
* 8400 Oostende                                                        *
* Belgium                                                              *
************************************************************************
* This program is free software: you can redistribute it and/or        *
* modify it under the terms of the GNU General Public License as       *
* published by the Free Software Foundation, either version 3 of       *
* the License, or (at your option) any later version.                  *
*                                                                      *
* This program is distributed in the hope that it will be useful,      *
* but WITHOUT ANY WARRANTY; without even the implied warranty of       *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         *
* GNU General Public License for more details.                         *
*                                                                      *
* You should have received a copy of the GNU General Public License    *
* along with this program. If not, see <http://www.gnu.org/licenses/>  *
***********************************************************************/
parse source source
parse value source with . . moi .

"ispexec control errors return"

arg code

zedsmsg = ''

if arg(1, 'O') then
  do
    zedlmsg = 'Please enter the 4-digit Z/OS XML parser returncode'
  end
else
  do
    call init_error

    code = right(strip(code), 4, '0')
    msg  = left('z/OS XML Parser Returncode:' code, 75)
    msg  = msg left('-', 75)

    mnem = value('xml.0m' || code)
    err  = value('xml.0e' || code)
    act  = value('xml.0a' || code)

    if mnem = '' then
      msg = msg 'This z/OS XML Parser returncode is undefined'
    else
      msg = msg err

    zedlmsg = msg
  end

"ispexec setmsg msg(ISRZ001)"
exit

/***********************************************************************
* INIT_ERROR:                                                          *
*                                                                      *
* Set up all errorcodes                                                *
*                                                                      *
* The text between the start- and end-of-comment delimiters must be    *
* copied from, for z/OS V1.13, Appendix B. of the "z/OS V1R13.0 z/OS   *
* XML User's Guide and Reference" which can (probably) be found at     *
* http://publibz.boulder.ibm.com/epubs/pdf/gxlza150.pdf                *
*                                                                      *
* The selection of text must start with the '0000' reason code and     *
* must include the last line of the 'Action' for the last reason code, *
* or optionally, the entire last line of Appendix B.                   *
*                                                                      *
* Important notes                                                      *
*                                                                      *
* - some messages may extend past column 72, and will need to be split *
*   on the last space before column 72. For z/OS 1.13 this is the case *
*   for 30 messages.                                                   *
*                                                                      *
* - for versions of z/OS other than 1.13, one (or more) of the four    *
*   "ignore" strings in the first "when" clause below must be changed, *
*   in order to correctly parse the text cut from the PDF.             *
***********************************************************************/
init_error:
signal parser

/*
-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  1842 Line(s) not Displayed
*/

parser:
  xml. = ''

  do i = sigl + 3 while substr(sourceline(i), 1, 2) \= '*' || '/'
    l = sourceline(i)

    select                  /* ....v....1....v....2....v....3.... */
      when substr(l, 5, 34) = "z/OS V1R13.0 z/OS XML User's Guide" |,
           substr(l, 1, 34) = "Appendix B. Reason Codes Listed by" |,
           left(l, 2)       = "||"                                 |,
           substr(l, 1, 21) = "© Copyright IBM Corp." then nop

      when datatype(left(l, 4)) = 'NUM' then
        do
          /*************************************************************
          * Correct typos in the z/OS 1.13 XML manual                  *
          *************************************************************/
          if right(temp, 4) = '. . ' then
            do
              temp = left(temp, length(temp) - 3)
              call value 'xml.0'mode || id, temp
            end

          p = pos(', Contact your', temp)
          if p \= 0 then
            call value 'xml.0'mode || id, overlay('c', temp, p + 2)
          /************************************************************/

          parse value(strip(l)) with id mnemonic
          call value 'xml.0i'id, id
          call value 'xml.0m'id, mnemonic

          mode = 'e'
        end

      when left(l, 8) = 'Action: ' then
        do
          call value 'xml.0a'id, strip(substr(l, 8))' '

          mode = 'a'
        end

      otherwise
        do
          temp = value('xml.0'mode || id)strip(l)' '
          call value 'xml.0'mode || id, temp
        end
    end
  end
return
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA

PostPosted: Wed Mar 20, 2013 4:47 pm
Reply with quote

I suspect the problem is the / in the </CODE> line due to problem number 1 below. However, there are a number of problems I see:
1. your root problem is that your STRING is completely replacing XML-DOC instead of concatenating WS-CODE to the end.
2. where is your ?XML defining the encoding?
3. the invalid character could be due to incorrect encoding.
Back to top
View user's profile Send private message
dsivapradeep

New User


Joined: 06 Jul 2012
Posts: 43
Location: INDIA

PostPosted: Wed Mar 20, 2013 6:28 pm
Reply with quote

Robert, I don't think its compulsory to have ?XML while parsing using COBOL. I've tried the same COBOL using XML data in working storage instead of file. See below for the modifications i made in my previous code in working-storage and removing the STRING statements:
Code:

01 XML-DOC.                                               
  05 XML-1 PIC X(80) VALUE '<CODE>'.                     
  05 XML-2 PIC X(80) VALUE '<LINE>    THIS IS 1 </LINE>'.
  05 XML-3 PIC X(80) VALUE '<LINE>     THIS IS 2 </LINE>'.
  05 XML-4 PIC X(80) VALUE '</CODE>'.                     
01 XML-DOC-NEW  PIC X(320).     
.............................................
A0000-MAIN-PARA.                                             
      MOVE XML-DOC     TO XML-DOC-NEW                         
      XML PARSE XML-DOC-NEW PROCESSING PROCEDURE EVENT-HANDLER
............                         


Output is as expected i.e.
Code:

********************************* TOP OF DATA **
    THIS IS 1                                   
     THIS IS 2                                 
XML DOC PARSING DONE SUCCESSFULLY               
******************************** BOTTOM OF DATA


So there's no problem in the way my XML data is present.. the only problem might be with my file accessing statements or STRING verb usage.


Quote:

your root problem is that your STRING is completely replacing XML-DOC instead of concatenating WS-CODE to the end.

But Robert because of POINTER usage it was concatenated at the end. I displayed the data too after string which is having all the records data present in a single XML-DOC variable.
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA

PostPosted: Wed Mar 20, 2013 7:02 pm
Reply with quote

OK, so you don't have a problem, then. Good luck with your XML efforts.
Back to top
View user's profile Send private message
dsivapradeep

New User


Joined: 06 Jul 2012
Posts: 43
Location: INDIA

PostPosted: Wed Mar 20, 2013 7:22 pm
Reply with quote

Problem not there when I hard coded the data in working storage and parsed like in my second example.

But if i try to access the data present in the pds member and string in to a variable then i'm getting the 798818 exception. Not able to figure out the reason for this exception.
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA

PostPosted: Wed Mar 20, 2013 11:52 pm
Reply with quote

I took your code and data as you posted it, tweaked it appropriately, and got it working with no XML exceptions. So there is something you are doing in your JCL or data that you have not posted but which is causing the exception.

Be aware, however, that your desired output will not be what you get since the whitespace between <LINE> and </LINE> is considered part of the data element and hence your posted file data will cause about 80 spaces to appear before THIS IS LINE NO.1.
Back to top
View user's profile Send private message
dsivapradeep

New User


Joined: 06 Jul 2012
Posts: 43
Location: INDIA

PostPosted: Thu Mar 21, 2013 10:31 am
Reply with quote

I missed that case. My ws-code is having all the whitespace characters between <line> and </line>. I noticed it and changed the XML data to avoid unnecessary whitespace data. And now the desired output came.

But the source for this exception is parser not able to identify the END-OF-DOCUMENT event. When it's coming to this event, exception is getting generated.

See below.
JCL:
Code:

//STEP1 EXEC PGM=XMLPARSE                                 
//XMLDOC DD *                                             
<CODE>                                                     
 <LINE>THIS IS 1.</LINE>                                   
 <LINE>THIS IS 2.</LINE>                                   
</CODE>                                                   
/*                                                         
//SYSOUT DD SYSOUT=*                                       


event-handler section:
Code:

       DISPLAY XML-EVENT ' AND ' XML-TEXT             
       EVALUATE XML-EVENT                             
       WHEN 'START-OF-ELEMENT'                         
*           DISPLAY 'START OF ELEMENT' XML-TEXT       
            MOVE XML-TEXT TO CURRENT-ELEMENT           
*          DISPLAY 'CURRENT ELEMENT' CURRENT-ELEMENT   
       WHEN 'CONTENT-CHARACTERS'                       
           EVALUATE CURRENT-ELEMENT                   
                WHEN 'LINE'                           
                      MOVE XML-TEXT TO WS-CODE         
           END-EVALUATE                               
       WHEN 'END-OF-ELEMENT'                           
             IF XML-TEXT = 'LINE' THEN                 
                  DISPLAY WS-CODE                     
             END-IF                                   
             MOVE SPACE TO CURRENT-ELEMENT             
       END-EVALUATE                                   
       .                                               


Output:
Code:

START-OF-DOCUMENT              AND           
START-OF-ELEMENT               AND CODE       
CONTENT-CHARACTERS             AND           
START-OF-ELEMENT               AND LINE       
CONTENT-CHARACTERS             AND THIS IS 1.
END-OF-ELEMENT                 AND LINE       
THIS IS 1.                                   
CONTENT-CHARACTERS             AND           
START-OF-ELEMENT               AND LINE       
CONTENT-CHARACTERS             AND THIS IS 2.
END-OF-ELEMENT                 AND LINE       
THIS IS 2.                                   
CONTENT-CHARACTERS             AND           
END-OF-ELEMENT                 AND CODE       
EXCEPTION                      AND                                                                            <LIN
E>THIS IS 1.</LINE>                                                         <LINE>THIS IS 2.</LINE>                     
                                   </CODE>                                                                             


So what i've noticed is END-OF-DOCUMENT event is not getting recognized and this might be the reason for exception cause even though START-OF-DOCUMENT was recognized!!

but for my example-2 (i.e.XML hardcoded in working-storage), END-OF-DOCUMENT event was recognized and so the XML-CODE = 0.

Robert, I believe i've used the same XML data that you've provided in my JCL's DD * (previously i had this XML data in a member)
Back to top
View user's profile Send private message
dsivapradeep

New User


Joined: 06 Jul 2012
Posts: 43
Location: INDIA

PostPosted: Fri Mar 22, 2013 10:21 am
Reply with quote

Understood my mistake and rectified it now.
The manual says X'000C3062' is when a whitespace data is expected but not found in the data.

The only possiblity where i can detect this reason is at the end of my variable unused space i.e. after END-OF-DOCUMENT event. I didn't move SPACES initially to this variable. So this unused space which is a non-whitespace data was triggering the exception.

I initialized the XML-DOC variable with SPACES in working-storage section and the the exception was resolved icon_smile.gif
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Replace each space in cobol string wi... COBOL Programming 2
No new posts COBOL -Linkage Section-Case Sensitive COBOL Programming 1
No new posts run rexx code with jcl CLIST & REXX 15
No new posts COBOL ZOS Web Enablement Toolkit HTTP... COBOL Programming 0
No new posts Compile rexx code with jcl CLIST & REXX 6
Search our Forums:

Back to Top