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