如何處理由資料庫中數字欄位含有非數字字元,所引起的程式錯誤?(Command FIXDECERR)
於執行應用程式時, 有時會遇到數字性(Decimal error), 此時程式會當掉, 這是由於
程式中的數字變數或資料庫中數字欄位含有非數字字元, 例如最常見數字變數或數字
欄位含有空白字元, 程式中的數字變數需要除蟲. 但是資料庫中的數字性錯誤要如何
解決, 因為資料庫中的資料要當程式讀到該筆錯誤資料成適當掉時,才能知道哪一筆資
料錯誤, 對於資料維護非常麻煩, 因為你不知道程式何時會當掉, 特別是當鉅量資料
需要作分析時, 若該資料可能是從其他平台轉入更為常見, 而當轉入程式寫的不周延
或該檔案擴增欄位時, 與該檔案相關程式未同時修改及編譯時, 這種數字性錯誤就會
時常發生. 那要如何掃描整個檔案資料是先查出哪幾筆資料是錯誤的呢?
1. 我先產生一個內含數字錯誤資料的測試檔.
File : QDDSSRC
Member: DAMPF
Type : PF
Usage : CRTPF DAMPF
A R DAMR TEXT('TEST 數字錯誤 ')
A CHAR 3
A NUMP 3 0
A NUMS 3S 0
2. 接著產生錯誤資料
File : QRPGLESRC
Member: DAMR
Type : RPGLE
Usage : CRTBNDRPG DAMR
CALL DAMR
H debug
FDAMPF O A F 8 Disk
D idx S 3 0
D xxa DS
D nump 3p 0
D xxxa DS
D nums 3S 0
D OutputData DS
D CHAR 3A
D XX 2A
D XXX 3A
C Eval idx = 1
C For idx =1 to 10
C Eval char = %char(idx)
C If %rem(idx:2) <> 0
C Eval nump = idx
C Eval nums = idx
C eval xx = xxa
C eval xxx = xxxa
c dump
C Else
C move ' ' xx
C move ' ' xxx
C EndIf
C WRITE DAMPF OutputData
C EndFor
C Eval *InLr = *on
3. 當呼叫上述程式後, DAMPF 已存在錯誤性數字資料, 可以下令 RUNQRY *N DAMPF
可得如下結果:
Display Report
Report width . . . . . : 18
Position to line . . . . . Shift to column . . . . . .
Line ....+....1....+...
CHAR NUMP NUMS
000001 1 1 1
000002 2 ++++ ++++
000003 3 3 3
000004 4 ++++ ++++
000005 5 5 5
000006 6 ++++ ++++
000007 7 7 7
000008 8 ++++ ++++
000009 9 9 9
000010 10 ++++ ++++
****** ******** End of report ********
其中 ++++ 即表示該數字欄位含有錯誤數字資料, 若其他應用程式讀取該錯誤資料時, 程式就會當掉,
若資料有數萬筆, 管資料的人可就累死了.
所以我提供一個工具 FIXDECERR 來解決這個問題.
File : QCLSRC
Member: DEC001CL
Type : CLP
Usage : CRTCLPGM DEC001CL
DEC001CL: +
PGM PARM(&QF &MBR &LSTERR &UPDOPT &CHKSIGNED &CHKPACKED)
DCL VAR(&CHKPACKED) TYPE(*CHAR) LEN(4)
DCL VAR(&CHKSIGNED) TYPE(*CHAR) LEN(4)
DCL VAR(&EXTDEF) TYPE(*CHAR) LEN(1)
DCL VAR(&FILNAM) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&LSTERR) TYPE(*CHAR) LEN(4)
DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
DCL VAR(&QF) TYPE(*CHAR) LEN(20)
DCL VAR(&UPDOPT) TYPE(*CHAR) LEN(7)
DCLF QAFDBASI
/* Break qualified name */
CHGVAR VAR(&FILNAM) VALUE(%SST(&QF 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&QF 11 10))
/* Check for file and member existence */
CHKOBJ OBJ(&LIB/&FILNAM) OBJTYPE(*FILE) MBR(&MBR)
MONMSG MSGID(CPF9801) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('File' *BCAT +
&FILNAM *BCAT 'not found in' *BCAT &LIB) MSGTYPE(*ESCAPE)
RETURN
ENDDO
MONMSG MSGID(CPF9810) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Library' *BCAT +
&LIB *BCAT 'not found') MSGTYPE(*ESCAPE)
RETURN
ENDDO
MONMSG MSGID(CPF9815) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Member' *BCAT +
&MBR *BCAT 'not found') MSGTYPE(*ESCAPE)
RETURN
ENDDO
/* Verify that the file is externally described */
CLRPFM FILE(QTEMP/FILEATR)
MONMSG MSGID(CPF0000)
DSPFD FILE(&LIB/&FILNAM) TYPE(*BASATR) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/FILEATR)
OVRDBF FILE(QAFDBASI) TOFILE(QTEMP/FILEATR)
/* READ FOR CHECK FILE EXTERNAL DESCRIPTED OR NOT */
RCVF
IF COND(&ATFLS *NE 'Y') THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('File' *BCAT +
&FILNAM *BCAT 'is not externally described') MSGTYPE(*ESCAPE)
RETURN
ENDDO
/* Output the file field definitions */
CLRPFM FILE(QTEMP/FILEFFD)
MONMSG MSGID(CPF0000)
DSPFFD FILE(&LIB/&FILNAM) OUTPUT(*OUTFILE) OUTFILE(QTEMP/FILEFFD)
OVRDBF FILE(QADSPFFD) TOFILE(QTEMP/FILEFFD)
OVRDBF FILE(DATAIN) TOFILE(&LIB/&FILNAM) MBR(&MBR)
CALL PGM(DEC001RGA) PARM(&CHKSIGNED &CHKPACKED &UPDOPT &LSTERR)
ENDPGM
File : QDDSSRC
Member: DEC001P1
Type : PRTF
Usage : CRTPRTF DEC001P1
A R HEADINGS SKIPB(6)
A 1DATE EDTCDE(Y)
A 14TIME EDTWRD(' . . ')
A 26'File:'
A WHFILE 10A O 32
A 47'Update Option:'
A USUPOP 7A O 62
A 77'Check S/P:'
A USSIGN 4A O 88
A USPACK 4A O 93
A 122'Page:'
A 129PAGNBR EDTCDE(3)
A SPACEA(1)
A 1'FIXDECERR'
A 24'Format:'
A WHNAME 10A O 34
A 47'Length:'
A WHRLEN 5S 0O 55EDTCDE(3)
A 77'Text:'
A WHTEXT 50O O 83
A SPACEA(2)
A 11'Field'
A 23'Start'
A 30'Length'
A 38'Field'
A SPACEA(1)
A 3'Record'
A 11'Name'
A 23'Pos.'
A 30'Bytes'
A 38'Type'
A 45'Value'
A 77'Description'
A SPACEA(2)
*
A R DETAIL SPACEA(1)
A RECNO 8S 0O 1EDTCDE(3)
A FLDNAM 10A O 11
A FLDBEG 5S 0O 23EDTCDE(3)
A FLDLEN 5S 0O 31EDTCDE(3)
A FLDTYP 1A O 40
A FLDHEX 30A O 45
A FLDDSC 50A O 77
File : QRPGLESRC
Member: DEC001RGA
Type : RPGLE
Usage : CRTBNDRPG DEC001RGA
FDATAIN UP F 9999 DISK INFDS(INFDS)
FQADSPFFD IF E DISK
FDEC001P1 O E PRINTER OFLIND(*IN99)
*
D REC S 1 DIM(9999) Input record
D REX S 1 DIM(9999) Sav Rec/Hex Dsp
D TABHEX S 2 0 DIM(16) CTDATA PERRCD(1) ASCEND Hex Cnv Tbl
D TABCHA S 1 DIM(16) ALT(TABHEX)
D INFDS DS
* Relative Record #
D RECNOX 397 400B 0
* Field information
D FLDINF DS OCCURS(300)
D FLDBEG 1 5 0
D FLDLEN 6 10 0
D FLDTYP 11 11
D FLDDSC 12 61
D FLDNAM 62 71
* Convert array to field for printer file
D DS
D HX 1 30
D DIM(30) Hex Value
D FLDHEX 1 30
* Constants
D ON C CONST('1')
D OFF C CONST('0')
*
IDATAIN NS
I 1 9999 REC
*=====================================================
C *ENTRY PLIST
C PARM USSIGN 4
C PARM USPACK 4
C PARM USUPOP 7
C PARM USLSER 4
*
C MOVE OFF ERRREC 1
C Z-ADD RECNOX RECNO 8 0
C MOVEL REC REX
*
C 1 DO S X 5 0
C X OCCUR FLDINF
C EXSR CHKNUM
C END
*
C USUPOP IFNE '*NONE'
C ERRREC ANDEQ ON
C EXCEPT UDATA
C END
*=====================================================
C CHKNUM BEGSR
* Validate Numeric Data
* ERRPOS is on if indiviudal position is in error
* and is off for the next position test
* ERRFLD is on when any error occurs in the filed test
* and is off when the next field is tested
C Z-ADD FLDBEG ST 5 0
C MOVE OFF ERRFLD 1
*
C 1 DO FLDLEN Y 5 0
C MOVEL REC(ST) WKD 1
C MOVE OFF ERRPOS 1
*
C FLDTYP IFEQ 'P'
C EXSR VALPCK
C END
*
C FLDTYP IFEQ 'S'
C EXSR VALDEC
* Initialize field position to zero - Signed decimal only
C USUPOP IFEQ '*INZDGT'
C ERRPOS ANDEQ ON
C MOVEL OFF REC(ST)
C END
C END
*
C ERRPOS IFEQ ON
C MOVE ON ERRFLD
C END
*
C ADD 1 ST
C END
* Initialize field to zeros and calculate hex value
C ERRFLD IFEQ ON
C MOVE ON ERRREC
C Z-ADD 1 H 5 0
C Z-ADD FLDBEG ST 5 0
C MOVEL *BLANKS HX
*
C 1 DO FLDLEN Y
C MOVEA REX(ST) HEXCNV 1
C EXSR HEXCNX
C H IFLE 30
C MOVEA HEXCHA HX(H)
C END
C ADD 2 H
*
C USUPOP IFEQ '*INZFLD'
C FLDTYP ANDEQ 'S'
C MOVEL OFF REC(ST)
C END
*
C USUPOP IFNE '*NONE'
C FLDTYP ANDEQ 'P'
C MOVEL X00 REC(ST)
*
C Y IFEQ FLDLEN
C MOVEL X0F REC(ST)
C END
C END
*
C ADD 1 ST
C END
C END
* Print Error Report
C USLSER IFEQ '*YES'
C ERRFLD ANDEQ ON
C *IN99 IFEQ ON
C WRITE HEADINGS
C MOVE OFF *IN99
C END
C WRITE DETAIL
C END
C ENDSR
*=====================================================
C VALDEC BEGSR
* Validate single signed numeric characters (WKD)
C WKD IFGT '9'
C WKD ORLT '0'
* Test digit portion first
C MOVEL WKD CNVDIG 1
C EXSR CNVDIX
*
C DIGIT IFGT 9
C MOVE ON ERRPOS
C END
* Test zone portion next
C MOVEL WKD CNVZON 1
C EXSR CNVZOX
*
C ZONE IFNE 15 Sign +
C ZONE ANDNE 13 Sign -
C MOVE ON ERRPOS
C END
* Sign valid on last character only
C ZONE IFEQ 13
C Y ANDNE FLDLEN
C MOVE ON ERRPOS
C END
C END
C ENDSR
*=====================================================
C VALPCK BEGSR
* Validate packed numeric characters (WKD)
* Test zone portion first
C MOVEL WKD CNVZON 1
C EXSR CNVZOX
*
C ZONE IFGT 9
C MOVE ON ERRPOS
C END
* Test digit portion next
C MOVEL WKD CNVDIG 1
C EXSR CNVDIX
* Not last digit must be value 0-9
C Y IFNE FLDLEN
C DIGIT ANDGT 9
C MOVE ON ERRPOS
C END
* Last digit must be sign value
C Y IFEQ FLDLEN
C DIGIT ANDNE 13 Sign -
C DIGIT ANDNE 15 Sign +
C MOVE ON ERRPOS
C END
C ENDSR
*=====================================================
C HEXCNX BEGSR
* Convert character to hex value (Display purposes)
C MOVEL *BLANKS HEXCHA 2
C MOVEL HEXCNV CNVZON
C EXSR CNVZOX
*
C ZONE LOOKUP TABHEX TABCHA 50
C 50 MOVEL TABCHA HEXCHA
*
C MOVEL HEXCNV CNVDIG
C EXSR CNVDIX
*
C DIGIT LOOKUP TABHEX TABCHA 50
C 50 MOVE TABCHA HEXCHA
C ENDSR
*=====================================================
C CNVDIX BEGSR
* Convert digit portion of character to number
C Z-ADD 0 DIGIT 2 0
C TESTB '4' CNVDIG 50
C 50DIGIT ADD 8 DIGIT
C TESTB '5' CNVDIG 50
C 50DIGIT ADD 4 DIGIT
C TESTB '6' CNVDIG 50
C 50DIGIT ADD 2 DIGIT
C TESTB '7' CNVDIG 50
C 50DIGIT ADD 1 DIGIT
C ENDSR
*=====================================================
C CNVZOX BEGSR
* Convert zone portion of character to number
C Z-ADD 0 ZONE 2 0
C TESTB OFF CNVZON 50
C 50ZONE ADD 8 ZONE
C TESTB ON CNVZON 50
C 50ZONE ADD 4 ZONE
C TESTB '2' CNVZON 50
C 50ZONE ADD 2 ZONE
C TESTB '3' CNVZON 50
C 50ZONE ADD 1 ZONE
C ENDSR
*=====================================================
C *INZSR BEGSR
C BITOFF '01234567' X00 1
C BITOFF '01234567' X0F 1
C BITON '4567' X0F
* Initialization - Get field definitions
C READ QWHDRFFD 40
C *IN40 DOWEQ OFF
C WHFLDT IFEQ 'S'
C USSIGN ANDEQ '*YES'
C WHFLDT OREQ 'P'
C USPACK ANDEQ '*YES'
C ADD 1 S 5 0
C S OCCUR FLDINF
C MOVEL WHFLDE FLDNAM
C MOVEL WHFLDT FLDTYP
C Z-ADD WHFLDB FLDLEN
C Z-ADD WHIBO FLDBEG
C MOVEL WHFTXT FLDDSC
C END
C READ QWHDRFFD 40
C END
C WRITE HEADINGS
C ENDSR
*=====================================================
ODATAIN E UDATA
O REC 9999
**
000
011
022
033
044
055
066
077
088
099
10A
11B
12C
13D
14E
15F
File : QCMDSRC
Member: FIXDECERR
Type : CMD
Usage : CRTCMD CMD(FIXDECERR) PGM(DEC001CL)
FIXDECERR: CMD PROMPT('Fix Decimal Data Errors')
PARM KWD(FILE) TYPE(QUAL1) MIN(1) PROMPT('File to +
check')
PARM KWD(MBR) TYPE(*NAME) DFT(*FIRST) +
SPCVAL((*FIRST)) EXPR(*YES) PROMPT('Member')
PARM KWD(LSTERR) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PROMPT('List fields in error')
PARM KWD(UPDOPT) TYPE(*CHAR) LEN(7) RSTD(*YES) +
DFT(*NONE) VALUES(*NONE *INZFLD *INZDGT) +
EXPR(*YES) PROMPT('Field update option')
PARM KWD(CHKSIGNED) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PROMPT('Check signed decimal')
PARM KWD(CHKPACKED) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PROMPT('Check packed decimal')
QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library')
FIXDECERRusage:
Fix Decimal Data Errors (FIXDECERR)
Type choices, press Enter.
File to check . . . . . . . . . DAMPF Name <== 欲修正的檔案
Library . . . . . . . . . . . *LIBL Name, *LIBL
Member . . . . . . . . . . . . . *FIRST Name, *FIRST
List fields in error . . . . . . *YES *YES, *NO <== 印出錯誤報表
Field update option . . . . . . *NONE *NONE, *INZFLD, *INZDGT
Check signed decimal . . . . . . *YES *YES, *NO
Check packed decimal . . . . . . *YES *YES, *NO
Field update option : 執行時是否修正錯誤
*NONE : 不修正
*INZDGT: 修正為 0, 保留正負號
*INZFLD: 修正為 0(建議使用此值)
星期二, 11月 07, 2023
2006-04-19 如何處理由資料庫中數字欄位含有非數字字元,所引起的程式錯誤?(Command FIXDECERR)
星期四, 10月 05, 2023
Guru: Generating XML Using SQL – The Easy Way
Guru: Generating XML Using SQL – The Easy Way
https://www.itjungle.com/2023/09/18/guru-generating-xml-using-sql-the-easy-way/
Reference function:
XMLROW
ifs_write_UTF8
SQL sample:
SELECT
xmlrow(
cusnum as "CUSNUM",
TRIM(LSTNAM) as "LASTNAME",
TRIM(INIT) as "INIT",
TRIM(street) as "ADDRESS",
CITY as "CITY",
STATE as "STATE",
cast(digits(ZIPCOD) as varchar(6)) as "ZIPCODE"
)
FROM qiws.qcustcdt;
SELECT
xmlrow(
cusnum as "CUSNUM",
TRIM(LSTNAM) as "LASTNAME",
TRIM(INIT) as "INIT",
TRIM(street) as "ADDRESS",
CITY as "CITY",
STATE as "STATE",
cast(digits(ZIPCOD) as varchar(6)) as "ZIPCODE"
OPTION ROW "CUSTOMER")
FROM qiws.qcustcdt;
RPGLE: GENXMLDEMO
**FREE
ctl-opt dftactgrp(*NO);
// ------------------------------------------------------
// How to generate XML from Db2 and save that XML content
// to the IFS as an ASCII text file.
// ------------------------------------------------------
dcl-s content SQLTYPE(CLOB:65532);
dcl-s start int(10);
dcl-s ifsXMLFile varchar(1024) INZ('/home/<usrprf>/DEMO.XML');
dcl-s ifsUser varchar(10) INZ(*USER);
dcl-s parentNode varchar(16) inz('CUSTOMERS>');
exec SQL SET OPTION commit=*NONE, NAMING=*SYS;
*INLR = *ON;
EXEC SQL DECLARE XC CURSOR for
SELECT
xmlrow(
cusnum as "CUSNUM",
TRIM(LSTNAM) as "LASTNAME",
TRIM(INIT) as "INIT",
TRIM(street) as "ADDRESS",
CITY as "CITY",
STATE as "STATE",
cast(digits(ZIPCOD) as varchar(6)) as "ZIPCODE"
OPTION ROW "CUSTOMER" )
FROM QIWS.QCUSTCDT;
EXEC SQL OPEN XC;
// Read XML into a CLOB or you'll have a learning experience.
EXEC SQL FETCH XC INTO :content;
if (SQLState < '02000');
ifsXMLFile = %SCANRPL('<usrprf>' : %TrimR(ifsUser) : ifsXMLFile);
// write out the starting/opening node to the IFS file
EXEC SQL call qsys2.ifs_write_UTF8( :ifsXMLFile,
'<' concat :parentNode );
DOW (SQLState < '02000');
// XMLROW returned via RPG IV SQL FETCH adds the tag
// We don't want that, so we skip past it using POSITION and SUBSTR
EXEC SQL VALUES POSITION('<customer>', :content) INTO :START;
EXEC SQL call qsys2.ifs_write_UTF8( :ifsXMLFile,
substr(:content,:start));
EXEC SQL FETCH XC INTO :content;
enddo;
// write out the ending/closing node to the IFS file
EXEC SQL call qsys2.ifs_write_UTF8( :ifsXMLFile,
'</' concat :parentNode );
endif;
EXEC SQL CLOSE XC;
星期一, 10月 02, 2023
訂閱：
文章 (Atom)