UTIUC.TABTOHTM
0001 SUBROUTINE UTIUC.TABTOHTM(WEBSET,WEBCSS,WEBSFX,WEBDATA.TBL,USOURCE,UTARGET)
0002 ** PROGRAM          : UTL.PGM UTIUC.TABTOHTM - Convert a TAB-FILE to an html table.
0003 ** SCREEN/PGM CALL  : ?
0004 ** LANGUAGE         : BASIC
0005 ** AUTHOR           : MARK C. VANDER VEEN
0006 ** DATE WRITTEN     : 06-22-07
0007 ** MODIFICATIONS    :
0008 ** 10-05-07 MCV ADD CODE TO STRIP OUT BANNER PAGES
0009 ** 12-20-07 MCV EXCEL CONVERT EAN TO SCIENTIFIC NOTATION, ADD "'"
0010 **______________________________________________________________________
0011 ** WEBSET: most of these settings are non-functional in favor of a CSS file.
0012 **   WEBSET<1>=Point Size
0013 **   WEBSET<2>=Heading Color
0014 **   WEBSET<3>=Background Color
0015 **   WEBSET<4>=Text Color
0016 **   WEBSET<5>=Table Border Size
0017 **   WEBSET<6>=Table Border Color
0018 **   WEBSET<7>=Table Background color
0019 **   WEBSET<8>=Table Cell Pad
0020 **   WEBSET<9>=Table Cell Spacing
0021 **   WEBSET<10>=Table Font "Arial"
0022 **   WEBSET<11>='Table Shadding 1st value'
0023 ** WEB.TBL:
0024 **   WEB.TBL<1,-1>='Description';Column Heading
0025 **   WEB.TBL<2,-1>=10           ;Char Length
0026 **   WEB.TBL<3,-1>=left, center, right    ;Justification
0027 **____________________________
0028 $INCLUDE UTL.PGM INP.COM
0029     FUNCTION='UTIUC.TABTOHTM'
0030     PGM.TITLE='Convert a Tab-delimited File to an html Table'
0031     ERR=''
0032     TB=CHAR(9)
0033 ** CRT PL:REVON:' Converting Tab-delimited file to Web Pages ':REVOFF:
0034     IF UNASSIGNED(WEBSET) THEN WEBSET=''
0035     IF UNASSIGNED(WEBCSS) THEN WEBCSS='' ;** '../CStyleSheets/Reports.css'
0036     IF UNASSIGNED(USOURCE) THEN USOURCE=''
0037     IF UNASSIGNED(WEBSFX) THEN WEBSFX='.xls'
0038     IF WEBSFX='' THEN
0039       WEBSFX='.xls'
0040     END ELSE
0041       IF WEBSFX[1,1]#'.' THEN WEBSFX='.':WEBSFX
0042     END
0043     IF UNASSIGNED(UTARGET) THEN
0044       UTARGET=DGNFS.PATH:OPRNO:'_':PORT:'_':TIME():WEBSFX
0045     END ELSE
0046       DOT.CNT=DCOUNT(UTARGET,'.')
0047       IF DOT.CNT<=1 THEN
0048         UTARGET:=WEBSFX
0049       END ELSE
0050         UTARGET=FIELD(UTARGET,'.',1,DOT.CNT-1)
0051         UTARGET:=WEBSFX
0052       END
0053     END
0054     WEBPT=WEBSET<1>
0055     IF WEBPT='' THEN WEBPT=7
0056     TB=CHAR(9)
0057     BEGIN CASE
0058     CASE WEBPT>=12
0059       CSIZE=10
0060     CASE WEBPT=11
0061       CSIZE=9
0062     CASE WEBPT=10
0063       CSIZE=8
0064     CASE WEBPT=9
0065       CSIZE=7
0066     CASE WEBPT=8
0067       CSIZE=6
0068     CASE WEBPT=7
0069       CSIZE=6
0070     CASE 1
0071       CSIZE=5
0072     END CASE
0073     WHCLR=WEBSET<2>
0074     IF WHCLR='' THEN WHCLR='darkred'
0075     WBGCLR=WEBSET<3>
0076     IF WBGCLR='' THEN WBGCLR='#F2F2F2' ;** palegray
0077     IF WBGCLR='' THEN WBGCLR='white'
0078     WTXTCLR=WEBSET<4>
0079     IF WTXTCLR='' THEN WEBTXTCLR="black"
0080     WTBLBORDER=WEBSET<5>
0081     IF WTBLBORDER='' THEN WTBLBORDER="1"
0082     WTBLBORDERCLR=WEBSET<6>
0083     IF WTBLBORDERCLR='' THEN WTBLBORDERCLR="#808080" ;** Med Gray
0084     WTBLBGCLR=WEBSET<7>
0085     IF WTBLBGCLR="" THEN WTBLBGCLR="white"
0086     WTBLCELLPAD=WEBSET<8>
0087     IF WTBLCELLPAD='' THEN WTBLCELLPAD=2
0088     WTBLCELLSPC=WEBSET<9>
0089     IF WTBLCELLSPC='' THEN WTBLCELLSPC=0
0090     WTBLFONT=WEBSET<10>
0091     IF WTBLFONT='' THEN WTBLFONT="Arial"
0092     WTBLGRAY1ST=WEBSET<11>
0093     WTBLALTCLR=''
0094     IF WTBLGRAY1ST='ALT' THEN WTBLALTCLR="#EBF2FE" ;** paleblue
0095 **    IF WTBLGRAY1ST='' THEN WTBLGRAY1ST="#E5E5E5"
0096     SDIR='';SFILE='';TDIR='';TFILE=''
0097     FIRST=1;WEB.TBL='';SHDG=''
0098     IF USOURCE#'' THEN
0099       GOSUB 300 ;** BUILD WEB.TBL FROM USOURCE
0100     END ELSE
0101       GOSUB 310 ;** BUILD WEB.TBL FROM WEBDATA.TBL
0102     END
0103     IF WEB.TBL='' THEN RETURN
0104     WEB.CNT=DCOUNT(WEB.TBL<1>,@VM)
0105     FOR W=1 TO WEB.CNT
0106       IF WEB.TBL<4,W>#'A' THEN WEB.TBL<3,W>='right'
0107     NEXT W
0108     TDIR.CNT=DCOUNT(UTARGET,'/')
0109     TDIR=FIELD(UTARGET,'/',1,TDIR.CNT-1)
0110     TARGETFILE=FIELD(UTARGET,'/',TDIR.CNT)
0111     UNIX.CMD='rm -f ':UTARGET
0112     EXECUTE "sh -c '":UNIX.CMD:"'" CAPTURING UNIXOUT
0113     RQM 2
0114     OPENSEQ UTARGET TO TFILE THEN ELSE NULL
0115     GOSUB 400 ;** SET UP WEB PAGE
0116     GOSUB 410 ;** BUILD PAGE
0117     RETURN
0118 *****
0119 300:** BUILD WEB.TBL FROM USOURCE
0120     SDIR.CNT=DCOUNT(USOURCE,'/')
0121     SDIR=FIELD(USOURCE,'/',1,SDIR.CNT-1)
0122     STARGETFILE=FIELD(USOURCE,'/',SDIR.CNT)
0123     OPENSEQ USOURCE TO SFILE THEN
0124       LOOP
0125         READSEQ SLINE FROM SFILE ELSE EXIT
0126         IF SLINE#'' THEN GOSUB 320 ;** PARSE DATA LINE
0127       REPEAT
0128       CLOSESEQ SFILE
0129     END
0130     RETURN
0131 *****
0132 310:** BUILD WEB.TBL FROM WEBDATA.TBL
0133     DATA.CNT=DCOUNT(WEBDATA.TBL,@AM)
0134     FOR D=1 TO DATA.CNT
0135       REMOVE SLINE FROM WEBDATA.TBL SETTING DELIMITER
0136       IF SLINE#'' THEN GOSUB 320 ;** PARSE DATA LINE
0137     NEXT D
0138     WEBDATA.TBL=WEBDATA.TBL
0139     RETURN
0140 *****
0141 320:** PARSE DATA LINE
0142     IF SLINE[1,1]=CHAR(12) THEN
0143       SLN=LEN(SLINE)
0144       SLINE=SLINE[2,SLN-1]
0145     END
0146     SLINE=CONVERT(TB,@VM,SLINE)
0147     TB.CNT=DCOUNT(SLINE,@VM)
0148     IF FIRST THEN
0149       IF TB.CNT>1 THEN
0150         WEBHDG=OPRNO:' ':OCONV(DATE(),'D4/')
0151       END ELSE
0152 ** EXPECTING - FUNCTION PGM TITLE DATE
0153         WEBHDG=SLINE
0154         FIRST=0
0155         RETURN
0156       END
0157     END
0158     IF TB.CNT>1 THEN
0159 ** ONLY FORMAT LINES WITH TABS
0160       IF WEB.TBL='' THEN
0161         FOR T=1 TO TB.CNT
0162           FDESC=SLINE<1,T>
0163           WEB.TBL<1,T>=FDESC
0164           WEB.TBL<2,T>=LEN(FDESC)
0165           WEB.TBL<3,T>='left'
0166           WEB.TBL<4,T>=''   ;** ALPHA FOUND
0167         NEXT T
0168       END ELSE
0169         FOR T=1 TO TB.CNT
0170           FDATA=SLINE<1,T>
0171           FLN=LEN(FDATA)
0172           IF FLN>WEB.TBL<2,T> THEN WEB.TBL<2,T>=FLN
0173           IF WEB.TBL<4,T>='' THEN
0174 ** ALPHA CHECK
0175             FCHK=CONVERT(',','',FDATA)
0176             IF NOT(FCHK) THEN FCHK=CONVERT('$','',FCHK)
0177             IF NOT(FCHK) THEN FCHK=CONVERT('%','',FCHK)
0178             IF NOT(NUM(FCHK)) AND FCHK#'' THEN WEB.TBL<4,T>='A'
0179           END
0180         NEXT T
0181       END
0182     END
0183     RETURN
0184 *****
0185 400:** SET UP WEB PAGE
0186     WLINE='<html>'
0187     GOSUB 490 ;** ADD LINE TO WEBPAGE
0188     WLINE='<head>'
0189     GOSUB 490 ;** ADD LINE TO WEBPAGE
0190     WLINE='<title>Chicago Distribution Services</title>'
0191     GOSUB 490 ;** ADD LINE TO WEBPAGE
0192 ** WLINE='<link rel="stylesheet" type="text/css" href="file:../CStyleSheets/Reports.css">'
0193     IF WEBCSS#'' THEN
0194       WLINE='<link rel="stylesheet" type="text/css" href="':WEBCSS:'">'
0195       GOSUB 490 ;** ADD LINE TO WEBPAGE
0196     END
0197     IF WEBHDG THEN
0198       WLINE='<h3>'
0199       GOSUB 490 ;** ADD LINE TO WEBPAGE
0200       HDGSPC.CNT=DCOUNT(WEBHDG,' ')
0201       CHKDATE=FIELD(WEBHDG,' ',HDGSPC.CNT)
0202       CHKDATE=ICONV(CHKDATE,'D')
0203       WLINE=WEBHDG
0204       IF CHKDATE='' THEN WLINE:=' ':OCONV(DATE(),'D4/')
0205       GOSUB 490 ;** ADD LINE TO WEBPAGE
0206       WLINE='</h3>'
0207       GOSUB 490 ;** ADD LINE TO WEBPAGE
0208     END
0209     WLINE='</head>'
0210     GOSUB 490 ;** ADD LINE TO WEBPAGE
0211     WLINE='<body>'
0212     GOSUB 490 ;** ADD LINE TO WEBPAGE
0213 **    bgcolor="':WBGCLR:'" text="black">'
0214 **    WLINE='<br>'
0215     WLINE= '<table border="':WTBLBORDER:'"'
0216     WLINE:=' bordercolor="':WTBLBORDERCLR:'"'
0217 ** bgcolor="':WTBLBGCLR:'"'
0218     WLINE:=' cellpadding="':WTBLCELLPAD:'"'
0219     WLINE:=' cellspacing="':WTBLCELLSPC:'"'
0220     WLINE:=' style="border-collapse: collapse;'
0221 **  WLINE:=' style="border-style: inset;'
0222 **  WLINE:=' border-color: ':WTBLBORDERCLR:';'
0223 **  WLINE:=' font-family: ':WTBLFONT:';
0224     WLINE:=' font-size: ':WEBPT:'pt" id="table1">'
0225     GOSUB 490 ;** ADD LINE TO WEBPAGE
0226     IF WEBCSS='' THEN
0227       WLINE='<thead align="left" font-weight="bold" bgcolor="#E0E0E0">'
0228     END ELSE
0229       WLINE='<thead>'
0230     END
0231     GOSUB 490 ;** ADD LINE TO WEBPAGE
0232     WLINE='  <tr>'
0233     GOSUB 490 ;** ADD LINE TO WEBPAGE
0234     WEB.CNT=DCOUNT(WEB.TBL<1>,@VM)
0235     FOR W=1 TO WEB.CNT
0236       THDG=WEB.TBL<1,W>
0237       TSIZE=WEB.TBL<2,W>
0238       IF TSIZE='' THEN
0239         TSIZE=30
0240         WEB.TBL<2,W>=TSIZE
0241       END
0242       TALIGN=WEB.TBL<3,W>
0243       IF TALIGN='' THEN
0244         TALIGN='left'
0245         WEB.TBL<3,W>=TALIGN
0246       END
0247       WLINE='  <th'
0248       IF TALIGN#'left' THEN WLINE:=' align=':TALIGN
0249 **      WLINE:=' width=':TSIZE(CSIZE)
0250       WLINE:='>':THDG:'</th>'
0251       GOSUB 490 ;** ADD LINE TO WEBPAGE
0252     NEXT W
0253     WLINE='  </tr>'
0254     GOSUB 490 ;** ADD LINE TO WEBPAGE
0255     WLINE='</thead>'
0256     GOSUB 490 ;** ADD LINE TO WEBPAGE
0257     RETURN
0258 *****
0259 410:** BUILD PAGE
0260     OVALUE='';IDVALUE='';ALTVALUE=0
0261     FIRST=1
0262     IF USOURCE#'' THEN
0263       OPENSEQ USOURCE TO SFILE ELSE RETURN
0264     END
0265     LOOP
0266       IF USOURCE#'' THEN
0267         READSEQ LINE FROM SFILE ELSE EXIT
0268       END ELSE
0269         REMOVE LINE FROM WEBDATA.TBL SETTING DELIMITER
0270         IF LINE='' THEN EXIT
0271       END
0272       IF LINE[1,1]=CHAR(12) THEN
0273         SLN=LEN(LINE)
0274         LINE=LINE[2,SLN-1]
0275       END
0276       IF LINE='' THEN CONTINUE
0277       WLINE='<tr>'
0278       TB.CNT=DCOUNT(LINE,TB)
0279       IF FIRST THEN
0280         IF TB.CNT<=1 THEN CONTINUE
0281         FIRST=0
0282         CONTINUE
0283       END
0284 ** IF TB.CNT<=1 THEN CONTINUE;THIS MAY NEED TO BE IN THIS SECTION TOO
0285       GOSUB 490 ;** ADD LINE TO WEBPAGE
0286       FOR W=1 TO WEB.CNT
0287         VALUE=FIELD(LINE,TB,W)
0288         THDG=WEB.TBL<1,W>
0289         TALIGN=WEB.TBL<3,W>
0290         IF VALUE#'' THEN
0291           IF INDEX(UPCASE(THDG),"DATE",1) AND INDEX(VALUE,'-',1) THEN
0292             OVALUE=VALUE
0293             VALUE=ICONV(VALUE,'D')
0294             IF VALUE='' THEN
0295               VALUE=OVALUE
0296             END ELSE
0297               VALUE=OCONV(VALUE,'D4/')
0298             END
0299           END
0300 ** ' IN HEADING BYPASSES ' INSERTION
0301           IF THDG[1,1]#"'" THEN
0302             BEGIN CASE
0303 ** CONVERT DATE FROM MM-DD-YY TO MM/DD/YY
0304             CASE INDEX(UPCASE(THDG),"ISBN",1) OR INDEX(UPCASE(THDG),"EAN",1) OR INDEX(UPCASE(CONVERT(' ','',THDG)),"PRODUCTNO",1)
0305               IF NUM(VALUE) THEN VALUE="'":VALUE
0306             CASE INDEX(UPCASE(CONVERT(' ','',THDG)),"OTHEREDITION",1)
0307               IF NUM(VALUE) THEN VALUE="'":VALUE
0308             CASE UPCASE(THDG)='RECP' OR UPCASE(THDG)='PAYOR' OR UPCASE(THDG)='PAYEE' OR INDEX(UPCASE(CONVERT(' ','',THDG)),"RECPNO",1)
0309               IF NUM(VALUE) THEN VALUE="'":VALUE
0310             CASE INDEX(UPCASE(THDG),"ZIP",1) OR INDEX(UPCASE(THDG),"PO ",1)
0311               IF NUM(VALUE) THEN VALUE="'":VALUE
0312             END CASE
0313           END
0314         END
0315         IF W=1 THEN IDVALUE=VALUE
0316         IF WTBLGRAY1ST AND WTBLGRAY1ST#'ALT' THEN
0317           IF OVALUE#IDVALUE THEN
0318             TBLBG=' bgcolor="':WTBLGRAY1ST:'"'
0319           END ELSE
0320 ** TBLBG=' bgcolor="':WTBLBGCLR:'"'
0321             TBLBG=''  ;** SET BY CSS
0322           END
0323         END ELSE
0324           IF WTBLGRAY1ST='ALT' THEN
0325             IF ALTVALUE THEN
0326               TBLBG=' bgcolor="':WTBLALTCLR:'"'
0327             END ELSE
0328 ** TBLBG=' bgcolor="':WTBLBGCLR:'"'
0329               TBLBG=''  ;** SET BY CSS
0330             END
0331           END ELSE
0332             TBLBG=''
0333           END
0334         END
0335         WLINE='  <td'
0336         IF TALIGN#'left' THEN WLINE:=' align=':TALIGN
0337         IF TBLBG#'' THEN WLINE:=TBLBG
0338 **        WLINE:=' width=':WEB.TBL<2,W>xCSIZE
0339         WLINE:='>':VALUE:'</td>'
0340         GOSUB 490 ;** ADD LINE TO WEBPAGE
0341       NEXT W
0342       IF WTBLGRAY1ST='ALT' THEN
0343         IF ALTVALUE THEN
0344           ALTVALUE=0
0345         END ELSE
0346           ALTVALUE=1
0347         END
0348       END
0349       OVALUE=IDVALUE
0350       WLINE='</tr>'
0351       GOSUB 490 ;** ADD LINE TO WEBPAGE
0352     REPEAT
0353 ** CLOSE WEB PAGE
0354     WLINE='</table>'
0355     GOSUB 490 ;** ADD LINE TO WEBPAGE
0356     WLINE='</body>'
0357     GOSUB 490 ;** ADD LINE TO WEBPAGE
0358     WLINE='</html>'
0359     GOSUB 490 ;** ADD LINE TO WEBPAGE
0360     CLOSESEQ TFILE
0361     IF USOURCE#'' THEN CLOSESEQ SFILE
0362     RQM 3
0363     RETURN
0364 *****
0365 490:** ADD LINE TO WEBPAGE
0366     WRITESEQ WLINE ON TFILE ELSE NULL
0367     RETURN
0368 *****
0369 590:** DISPLAY ERROR
0370     CALL DISP.ERR.MSG(MSG.TYPE,ERR,X)
0371     RETURN
0372 *****
0373 990:** SLEEP
0374     RQM 2
0375     RETURN
0376 *****
0377 999:** PROGRAM TERMINATION
0378     STOP