Tuesday, February 21, 2012

iSeries DB2 to XML example

I managed to finish one of the two product interface programs but got distracted figuring out why the NFS server is not working on the test system. Someone changed the domain in TCPCFG and the partition was IPL'd to fix a backup issue. When the system restated none of the TCP servers started and subsystem QPGMR did not start. I tighten up a little bit and got everything working but now NFS won't start. I had to realign the test partition domain to the windows server domain and an IPL tomorrow morning will correct the issue. If not I will be chasing it down.

As for the XML output, the only real magic is coming from the C API in QC2LE binding directory and the IFSIO_H copy source. There is a lot of code and glad I did not have to write it or have to understand the details. It just works, giving me more time to focus on the business issues. I found all of the information HERE.

The code looks much better in WDSC and if you want a copy of the source just ask.

I'll post more when I can. Soon I will be parsing incoming XML documents. If you have any suggestions or questions please do not hesitate to ask.



      **************************************************************************
     h option(*nodebugio) dftactgrp(*no) bnddir('QC2LE')
      ********************** M O D I F I C A T I O N S *************************
      **                                                                      **
      **  This progam is designed to run every night and fully reloads        **
      **  Department, Class, Color and Size files from Island Pacific         **
      **  master files to MidRetail folders in QNTC IFS file system.          **
      **                                                                      **
      **  ip_color.xml -> /MIDRetailData/Color                                **
      **  ip_size.xml -> /MIDRetailData/Size                                  **
      **  ip_dept.xml -> /MIDRetailData/Hierarchy                             **
      **  ip_class.xml -> /MIDRetailData/Hierarchy                            **
      **                                                                      **
      **                                                                      **
      **                                                                      **
      **                                                                      **
      ********************** M O D I F I C A T I O N S *************************
      ** Date       Programmer   Description                                  **
      ** ---------- ------------ -------------------------------------------- **
      ** 2/20/12    Richard Bryant                                            **
      **                                                                      **
      **                                                                      **
      **                                                                      **
      **************************************************************************
     Fipcolor   if   e           k disk                                         Color
     Fipdepts   if   e           k disk                                         Departments
     Fipclass   if   e           k disk                                         Class
     Fipsizes   if   e           k disk                                         Sizes
      *
      **************************************************************************
      *
     D                SDS
     D  PRGNAM                 1     10

      /copy *libl/qrpglesrc,IFSIO_H

      * Program Constants
     d fd              s             10I 0
     d crlf            c                   x'0D25'
     d $xml            s            512a
     d @CmdStr         s            512a   inz
     d @Apostr         s              1a   inz(X'7D')                           '
     d @Dblqt          s              1a   inz(X'7F')                           "
     d @Gt             s              1a   inz(X'6E')                           >
     d @slgt           s              2a   inz(X'616E')                         />
     D B               C                   CONST('|')
     D D               C                   CONST('-')
      *
      * Color XML constants
      *
     d cstr            c                   '<Color '
     d ccde            c                   'Code='
     d cnam            c                   'Name='
     d cend            c                   '</Color>'
     d cpath           c                   '/MidRetail/ip_color.xml'
     d ctrg            c                   '/MidRetail/ip_color.xml.trg'
     d cschema         c                   '<Colors xmlns="http://tempuri.org-
     d                                     /ColorCodesLoadSchema.xsd">'
      *
      * Size XML constants
      *
     d sstr            c                   '<Size '
     d scde            c                   'Code='
     d spri            c                   'Primary='
     d scat            c                   'ProductCategory='
     d send            c                   '</Size>'
     d spath           c                   '/MidRetail/ip_size.xml'
     d strg            c                   '/MidRetail/ip_size.xml.trg'
     d sschema         c                   '<Sizes xmlns="http://tempuri.org-
     d                                     /SizeCodesLoadSchema.xsd">'
      *
      * Department & Class XML constants
      *
     d dstr            c                   '<Product '
     d dpar            c                   'Parent='
     d did             c                   'ID='
     d dnme            c                   'Name='
     d ddes            c                   'Description='
     d dend            c                   '</Product>'
     d hstr            c                   '</Hierarchy ID="BodyC">'
     d dpath           c                   '/MidRetail/ip_dept.xml'
     d dtrg            c                   '/MidRetail/ip_dept.xml.trg'
     d clpath          c                   '/MidRetail/ip_class.xml'
     d cltrg           c                   '/MidRetail/ip_class.xml.trg'
     d dschema         c                   '<Hierarchies xmlns="http://tempuri-
     d                                     .org/HierarchyLoadSchema.xsd">'
      *
     d FilePath        s            250a
     d SchemaPath      s            100a
      *
     D HSTYLE          S             13A
     D NSTYLE          S             13A
     D ASTYLE          S             13A
     D DFLAG           S              1  0
     D VENDOR          S              5  0
      *
      * Mid-Retail
     D H_ID            c                   CONST('BodyC')
      *
      *
     ***************************************************************************
      *    MainLine
      *
      /free

        exsr Color_Load;
        exsr Size_Load;
        exsr Dept_Load;
        exsr Class_Load;
        eval *inlr = *on;
        return;

       // ******************Begin sub-routines*********************************

       // Color Full Load **************************************

        begsr color_load;
        clear FilePath;
        clear SchemaPath;
        eval FilePath=cpath;
        eval SchemaPath=cschema;
        exsr ClrHdr;

        setll *loval ipcolor;
        dou %eof (ipcolor);
        read ipcolor;

        if not %eof;
        $xml = cstr
             + ccde + @Dblqt + %editc(cclr:'X')+ @Dblqt + ' '
             + cnam + @Dblqt + %trim(clrn) + @Dblqt + @gt
             + cend + crlf;

        callp write(fd: %addr($xml): %len(%trim($xml))); // Write to IFS
        endif;

        enddo;

       // Close file
        $xml = '</Colors>' + crlf;
        callp write(fd: %addr($xml): %len(%trim($xml)));
        callp close(fd);

       // Set up empty trigger file
        clear FilePath;
        eval FilePath=ctrg;
        exsr SetTrg;

        endsr;

       // Size Full Load ***************************************

        begsr size_load;
        clear FilePath;
        clear SchemaPath;
        eval FilePath=spath;
        eval SchemaPath=sschema;
        exsr ClrHdr;

        setll *loval ipsizes;
        dou %eof (ipsizes);
        read ipsizes;
        if not %eof;

        if ssiz = 0000;             // Only if size equal to zero
          eval snam = 'NOSIZE';
        endif;

        $xml = sstr
             + scde + @Dblqt + %editc(ssiz:'X')+ @Dblqt + ' '
             + spri + @Dblqt + %trim(snam) + @Dblqt + ' '
             + scat + @Dblqt + 'ALL' + @Dblqt + @gt
             + send + crlf;

        callp write(fd: %addr($xml): %len(%trim($xml)));

        endif;

        enddo;

       // Close file
        $xml = '</Sizes>' + crlf;
        callp write(fd: %addr($xml): %len(%trim($xml)));
        callp close(fd);

       // Set up empty trigger file
        clear FilePath;
        eval FilePath=strg;
        exsr SetTrg;

        endsr;

       // Class Full Load ***************************************

        begsr class_load;
        clear FilePath;
        clear SchemaPath;
        eval FilePath=clpath;
        eval SchemaPath=dschema;
        exsr ClrHdr;

       // Example output - </Hierarchy ID="BodyC">
        $xml = hstr + crlf;
        callp write(fd: %addr($xml): %len(%trim($xml)));

        setll *loval ipclass;
        dou %eof (ipclass);
        read ipclass;
        if not %eof;

        if cdpt < 18;      // Only if department less than 18

       // Example - <Product Parent="001" ID="0498" Name="Class 0498"
       //           Description="DEPT 01 DRESSES"></Product>
        $xml = dstr
             + dpar + @Dblqt + %editc(cdpt:'X') + @Dblqt + ' '
             + did + @Dblqt + %editc(ccls:'X') + @Dblqt + ' '
             + dnme + @Dblqt + 'Class ' + %editc(ccls:'X') + @Dblqt + ' '
             + ddes + @Dblqt + %trim(clnm) + @Dblqt + @gt
             + dend + crlf;

        callp write(fd: %addr($xml): %len(%trim($xml)));

        endif;
        endif;

        enddo;

       // Close file
        $xml = '</Hierarchy>' + crlf + '</Hierarchies>' + crlf;
        callp write(fd: %addr($xml): %len(%trim($xml)));
        callp close(fd);

       // Set up empty trigger file
        clear FilePath;
        eval FilePath=cltrg;
        exsr SetTrg;

        endsr;

       // Department Full Load **********************************

        begsr dept_load;
        clear FilePath;
        clear SchemaPath;
        eval FilePath=dpath;
        eval SchemaPath=dschema;
        exsr ClrHdr;

       // Example output - </Hierarchy ID="BodyC">
        $xml = hstr + crlf;
        callp write(fd: %addr($xml): %len(%trim($xml)));

        setll *loval ipdepts;
        dou %eof (ipdepts);
        read ipdepts;
        if not %eof;

        if ddpt < 18;      // Only if department less than 18

       // Example - <Product Parent="BodyC" ID="001" Name="Dept 001"
       //           Description="DRESSES"></Product>
        $xml = dstr
             + dpar + @Dblqt + H_ID + @Dblqt + ' '
             + did + @Dblqt + %editc(ddpt:'X') + @Dblqt + ' '
             + dnme + @Dblqt + 'Dept ' + %editc(ddpt:'X') + @Dblqt + ' '
             + ddes + @Dblqt + %trim(dnam) + @Dblqt + @gt
             + dend + crlf;

        callp write(fd: %addr($xml): %len(%trim($xml)));

        endif;
        endif;

        enddo;

       // Close file
        $xml = '</Hierarchy>' + crlf + '</Hierarchies>' + crlf;
        callp write(fd: %addr($xml): %len(%trim($xml)));
        callp close(fd);

       // Set up empty trigger file
        clear FilePath;
        eval FilePath=dtrg;
        exsr SetTrg;

        endsr;

       // Create or replace XML output file and header *********

       // Create XML output file in IFS
       // Variable depending on what file is be created

        begsr ClrHdr;
        fd = open(%trim(filepath)
                  : O_WRONLY+O_CREAT+O_TRUNC+O_CCSID
                  : S_IRGRP + S_IWGRP + S_IXGRP +
                     S_IRUSR + S_IWUSR + S_IXUSR
                  : 819);
        callp close(fd);
        fd = open(%trim(filepath):O_WRONLY+O_TEXTDATA);

        $xml = '<?xml version="1.0" encoding="UTF-8"?>' + crlf +
         %trim(schemapath) + crlf;

        callp write(fd: %addr($xml): %len(%trim($xml)));

        endsr;

       // Create .TRG empty file for MR ************************

        begsr SetTrg;
        fd = open(%trim(filepath)
                  : O_WRONLY+O_CREAT+O_TRUNC+O_CCSID
                  : S_IRGRP + S_IWGRP + S_IXGRP +
                     S_IRUSR + S_IWUSR + S_IXUSR
                  : 819);
        callp close(fd);
        fd = open(%trim(filepath):O_WRONLY+O_TEXTDATA);

        $xml = '<?xml version="1.0" encoding="UTF-8"?>' + crlf +
         %trim(schemapath) + crlf;

        callp write(fd: %addr($xml): %len(%trim($xml)));

        // Close file

        callp write(fd: %addr($xml): %len(%trim($xml)));
        callp close(fd);

        endsr;

      /end-free
      *
      **************************************************************************








No comments:

Post a Comment