// Use DataTest.utl // Full scanning of table Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes Use Spec0008.utl // Small arrays with integer Codes (Dictionaries) Use FdxIndex.utl // Index analysing functions Use OpenStat.nui // cTablesOpenStatus class (formely cFileAllFiles) Use DBMS.utl // Basic DBMS functions Use LogFile.nui // Class for handling a log file Use SetTable.utl // cSetOfTables class Use Strings.nui // String manipulation for VDF and 3.2 Use Files.nui // Utilities for handling file related stuff Use ErrorHnd.nui // cErrorHandlerRedirector class // Use index define DTPL_INDEX_RECNUM for 0 define DTPL_INDEX_RECNUM_DISCRETE for -1 define DTPL_INDEX_PRIMARY for -2 define DTPL_INDEX_ALL_INDICES for -3 object oDataTestPropertyList is a cIntegerCodeToText no_image IntegerCodeList Define_IntegerCode DTPL_USE_INDEX "Order of scanning" Define_IntegerCode DTPL_LOCK "Lock" Define_IntegerCode DTPL_INTERRUPT_CHK "User interrupt" Define_IntegerCode DTPL_SCREEN_UPD "Screen update" Define_IntegerCode DTPL_MAX_ERRORS "Max errors" End_IntegerCodeList end_object class cDataTestProperties is a cArray procedure construct_object integer liImg forward send construct_object liImg set value item DTPL_USE_INDEX to DTPL_INDEX_RECNUM set value item DTPL_LOCK to 0 set value item DTPL_INTERRUPT_CHK to 100 set value item DTPL_SCREEN_UPD to 100 set value item DTPL_MAX_ERRORS to 100 end_procedure end_class // cDataTestProperties class cFullTableScanIndices is a cArray item_property_list item_property integer piIndex.i item_property integer piIsOnline.i item_property integer piRecordsFound.i item_property integer piErrorsEncountered.i item_property number pnScanTime.i end_item_property_list cFullTableScanIndices procedure reset send delete_data end_procedure end_class // cFullTableScanIndices /DataTest.Log.Header RootName Idx #Records %Full #Found #Errs ScanTime Location ----------------------------------------------------------------------- /DataTest.Log.Body _______________ ___ _______. ___._ _______. ____. _________ _______________________________________________________________ /DataTest.Log.Total ----------------------------------------------------------------------- Total errors: _____ Total scanning time: _________ /DataTest.Err.Header Idx RecordNo Error-ID Description ----------------------------------------------------------------------------- /DataTest.Err.Body ___ ________. ________ ______________________________________________________ /* class cFullTableScan_ErrorHandlerRedirector is a cErrorHandlerRedirector procedure OnError integer liError string lsErrorText integer liErrorLine local integer liFile liRecnum get piMainFile to liFile get_field_value liFile 0 to liRecnum delegate send DoWriteError ("DF-"+string(liError)) lsErrorText liRecnum end_procedure end_class class cFullTableScan is a cArray procedure construct_object integer liImg forward send construct_object liImg property integer piMainFile public 0 property integer piUseIndex public 0 property integer piLock public 0 property integer piInterruptChk public 0 property integer piScreenUpd public 0 property integer piMaxErrors public 0 property integer piErrorCount public 0 property integer piMainLogOpen public 0 property number pnMailLogOpenTS public 0 property integer piCurrentIndex public 0 property string psRootLocation public "" property string psRootName public "" property string psLogFileName public "" // Table property integer piTrapErrors public DFTRUE object oFullTableScanIndices is a cFullTableScanIndices NO_IMAGE end_object object oTotalLogFile is a cLogFile NO_IMAGE set psFileName to "DataTest.out" set piCloseOnWrite to DFTRUE set psPurpose to "Table read test" end_object object oErrorHandler is a cFullTableScan_ErrorHandlerRedirector NO_IMAGE end_object end_procedure function sIndexText.i integer liOrdering returns string // private if liOrdering eq DTPL_INDEX_RECNUM_DISCRETE function_return "DSC" function_return (IntToStrR(liOrdering,3)) end_function procedure DoAdoptProperties integer liObj set piUseIndex to (value(liObj,DTPL_USE_INDEX)) set piLock to (value(liObj,DTPL_LOCK)) set piInterruptChk to (value(liObj,DTPL_INTERRUPT_CHK)) set piScreenUpd to (value(liObj,DTPL_SCREEN_UPD)) set piMaxErrors to (value(liObj,DTPL_MAX_ERRORS)) end_procedure //> Procedures DoLogBegin and DoLogEnd are used to turn On and Off writing //> to log file "DataTest.dts". They must be called manually. PROCEDURE DoMainLogBegin set pnMailLogOpenTS to (TS_SysTime()) send DeleteFile to (oTotalLogFile(self)) // Remove existing send DirectOutput to (oTotalLogFile(self)) // Open for output send DoWriteTimeEntry to (oTotalLogFile(self)) // Write a pretty header in it set piMainLogOpen to 1 // Signal that main log is now open send DoMainLogOutput DataTest.Log.Header.N // Write another pretty header in it blankform DataTest.Log.Total // Zero the total image corresponding to the latter header end_procedure PROCEDURE DoMainLogEnd print (TS_ConvertToStringNoDate(TS_SysTime()-pnMailLogOpenTS(self))) to DataTest.Log.Total.2 send DoMainLogOutput DataTest.Log.Total.N // Output total send CloseOutput to (oTotalLogFile(self)) // Close the stream set piMainLogOpen to 0 // Signal that main log is now closed end_procedure procedure DoMainLogWrite string lsLine if (piMainLogOpen(self)) send WriteLn to (oTotalLogFile(self)) lsLine end_procedure procedure DoMainLogOutput integer liImg if (piMainLogOpen(self)) send Output_Image to (oTotalLogFile(self)) liImg end_procedure PROCEDURE DoTableLogBegin // Simply erases the file if it's already there. local string lsLogFileName move (SEQ_ComposeAbsoluteFileName(psRootLocation(self),psRootName(self))) to lsLogFileName move (StringLeftBut(lsLogFileName,4)+".dts") to lsLogFileName if lsLogFileName ne "" erasefile lsLogFileName set psLogFileName to lsLogFileName end_procedure PROCEDURE DoTableLogEnd // Does nothing (and it shouldn't) end_procedure procedure DoTableError end_procedure procedure OnRecordFound end_procedure procedure DoWriteError string lsErrorID string lsErrorText integer liRecnum local integer liErrorCount local string lsLogFileName get piErrorCount to liErrorCount increment liErrorCount set piErrorCount to liErrorCount get psLogFileName to lsLogFileName if lsLogFileName ne "" begin print (sIndexText.i(self,piCurrentIndex(self))) to DataTest.Err.Body.1 print liRecnum to DataTest.Err.Body.2 print lsErrorID to DataTest.Err.Body.3 print lsErrorText to DataTest.Err.Body.4 if liErrorCount eq 1 send SEQ_AppendOutputImageClose lsLogFileName DataTest.Err.Header.N send SEQ_AppendOutputImageClose lsLogFileName DataTest.Err.Body.N end end_procedure procedure DoAddAllIndices local integer liFullTableScanIndicesObj liIndexRow local integer liFile liIndex liIndexType local string lsFields get piMainFile to liFile move (oFullTableScanIndices(self)) to liFullTableScanIndicesObj // Start by adding recnum to the search move 0 to liIndexRow set piIndex.i of liFullTableScanIndicesObj liIndexRow to 0 set piIsOnline.i of liFullTableScanIndicesObj liIndexRow to DFTRUE increment liIndexRow for liIndex from 1 to 15 get FDX_IndexAsFields 0 liFile liIndex to lsFields if lsFields ne "" begin set piIndex.i of liFullTableScanIndicesObj liIndexRow to liIndex get API_AttrValue_INDEX DF_INDEX_TYPE liFile liIndex to liIndexType set piIsOnline.i of liFullTableScanIndicesObj liIndexRow to (liIndexType=DF_INDEX_TYPE_ONLINE) increment liIndexRow end loop end_procedure function iMaxRecordNumber.i integer liFile returns integer local integer liRval clear liFile vfind liFile 0 LT get_field_value liFile 0 to liRval function_return liRval end_function procedure DoScreenUpdate integer liRecordCount integer liIndex end_procedure function iUserInterrupt returns integer end_function procedure DoScan // Private! local integer liFullTableScanIndicesObj local integer liFile local integer liOrdering local integer liScreenUpd // Update screen for ever X record. X=0 => No screen update local integer liScreenUpdCount // Records since last screen update local integer liUserChk // Ask if we should interrupt every X record. X=0 => No asking local integer liUserChkCount // Records since previous interrupt check local integer liMaxErrors // Maximum number of errors before scan is aborted local integer liErrorCount // Current number of errors local integer liRecordCount // Records scanned so far local integer liLock // Should we lock the table while scanning? local integer liScanMax // Number of scans to be performed local integer liScan // Number of (full) scans completed local integer liMaxRecordNumber // Highest recordnumber used when discrete recnum scanning local integer liFound // Temp thing local integer liCurrentRecnum // Used when discrete recnum scanning local integer liRecordUsed // Used when discrete recnum scanning local integer liWasInterrupted // Used to check whether the find loop was interrupted by the operator local integer liFieldNotInIndex // Used to force loading of the entire record local number lnStartTS lnEndTS // Used to calculate the time a scan took local string lsGarbage // Dummy used for retrieving value of 'FieldNotInIndex' local integer liAttrMaxRecords // Used for a little calculation in the bottom of the loop local integer liAttrCurRecords // Used for a little calculation in the bottom of the loop move (oFullTableScanIndices(self)) to liFullTableScanIndicesObj // Get main file: get piMainFile to liFile // Get ordering: get piUseIndex to liOrdering if liOrdering eq DTPL_INDEX_PRIMARY get FDX_IndexFindPrimary 0 liFile to liOrdering send reset to liFullTableScanIndicesObj // If this particular value is set we add all on-line indices if liOrdering eq DTPL_INDEX_ALL_INDICES send DoAddAllIndices else set piIndex.i of liFullTableScanIndicesObj 0 to liOrdering get piScreenUpd to liScreenUpd get piInterruptChk to liUserChk get piMaxErrors to liMaxErrors get piLock to liLock print (lowercase(psRootName(self))) to DataTest.Log.Body.1 if liLock lock get row_count of liFullTableScanIndicesObj to liScanMax for liScan from 0 to (liScanMax-1) get TS_SysTime to lnStartTS // Initialise counters move 0 to liScreenUpdCount move 0 to liUserChkCount move 0 to liErrorCount move 0 to liRecordCount set piErrorCount to 0 get piIndex.i of liFullTableScanIndicesObj liScan to liOrdering set piCurrentIndex to liOrdering move 0 to liWasInterrupted if (piTrapErrors(self)) send DoActivate to (oErrorHandler(self)) if liOrdering eq DTPL_INDEX_RECNUM_DISCRETE begin get iMaxRecordNumber.i liFile to liMaxRecordNumber clear liFile move 1 to liCurrentRecnum move (liCurrentRecnum<=liMaxRecordNumber) to liFound if liFound begin set_field_value liFile 0 to liCurrentRecnum vfind liFile 0 EQ move (found) to liRecordUsed end get FDX_FieldNotInIndex 0 liFile 0 to liFieldNotInIndex end else begin move 1 to liRecordUsed clear liFile vfind liFile liOrdering GT move (found) to liFound get FDX_FieldNotInIndex 0 liFile liOrdering to liFieldNotInIndex end while liFound if liRecordUsed begin get_field_value liFile liFieldNotInIndex to lsGarbage send OnRecordFound // Do whatever checking is needed, we do have a record here increment liRecordCount increment liScreenUpdCount increment liUserChkCount if liScreenUpd if liScreenUpdCount ge liScreenUpd begin send DoScreenUpdate liRecordCount liOrdering move 0 to liScreenUpdCount end if liUserChk if liUserChkCount ge liUserChk begin get iUserInterrupt to liFound ifnot liFound move 1 to liWasInterrupted move 0 to liUserChkCount end end if liOrdering eq DTPL_INDEX_RECNUM_DISCRETE begin increment liCurrentRecnum move (liCurrentRecnum<=liMaxRecordNumber) to liFound if liFound begin set_field_value liFile 0 to liCurrentRecnum vfind liFile 0 EQ move (found) to liRecordUsed end end else begin vfind liFile liOrdering GT move (found) to liFound end end // While if (piTrapErrors(self)) send DoDeactivate to (oErrorHandler(self)) if liScreenUpd send DoScreenUpdate liRecordCount liOrdering get TS_SysTime to lnEndTS set piRecordsFound.i of liFullTableScanIndicesObj liScan to liRecordCount get piErrorCount to liErrorCount set piErrorsEncountered.i of liFullTableScanIndicesObj liScan to liErrorCount set pnScanTime.i of liFullTableScanIndicesObj liScan to (lnEndTS-lnStartTS) print (sIndexText.i(self,liOrdering)) to DataTest.Log.Body.2 get API_AttrValue_FILE DF_FILE_RECORDS_USED 20 to liAttrCurRecords get API_AttrValue_FILE DF_FILE_MAX_RECORDS 20 to liAttrMaxRecords print liAttrCurRecords to DataTest.Log.Body.3 print (100.0*liAttrCurRecords/liAttrMaxRecords+0.05) to DataTest.Log.Body.4 // Full print liRecordCount to DataTest.Log.Body.5 print liErrorCount to DataTest.Log.Body.6 print (TS_ConvertToStringNoDate(lnEndTS-lnStartTS)) to DataTest.Log.Body.7 print (psRootLocation(self)) to DataTest.Log.Body.8 send DoMainLogOutput DataTest.Log.Body.N move (DataTest.Log.Total.1+DataTest.Log.Body.6) to DataTest.Log.Total.1 blankform DataTest.Log.Body loop // Index loop if liLock unlock end_procedure procedure DoScanTable string lsRootName local integer liOpen local string lsRoot move lsRootName to lsRoot send OpenStat_CloseAllFiles get SEQ_FindDataFileFromRootName lsRoot to lsRoot set psRootName to (SEQ_RemovePathFromFileName(lsRoot)) set psRootLocation to (SEQ_ExtractPathFromFileName(lsRoot)) send DoTableLogBegin set piMainFile to 20 move (DBMS_OpenFileAs(lsRoot,20,DF_SHARE,0)) to liOpen if liOpen begin send DoScan close 20 end else send DoMainLogWrite ("Error: Table could not be opened: "+lsRootName) send DoTableLogEnd send OpenStat_RestoreFiles end_procedure procedure DoScanFilelistEntry integer liFile local string lsRootname get API_AttrValue_FILELIST DF_FILE_ROOT_NAME liFile to lsRootname send DoScanTable lsRootName end_procedure procedure DoScanAllFilelist send DoMainLogBegin send DBMS_Callback_FilelistEntries (FLEC_ALL+FLEC_NO_ALIAS) msg_DoScanFilelistEntry self send DoMainLogEnd end_procedure end_class // cFullTableScan // class cFullSetOfTablesScan is a cFullTableScan // procedure construct_object integer liImg // forward send construct_object liImg // object cFullTableScan // end_ // end_procedure // end_class