Module cWebAppError.pkg
1
2// need to move into fmac
3#COMMAND WebAppFatalError R
4 !A [] $56 !1
5#ENDCOMMAND
6
7
8Use WebAppBase.pkg
9use set.pkg
10use msgbox.pkg
11Use GlobalFunctionsProcedures.pkg
12
13//integer ghoErrorSource
14//Move 0 to ghoErrorSource
15// ghoErrorSource object is expected to support this message
16//Register_Function Extended_Error_Message returns string
17
18//Use DataDict.pkg // we get error information from the DD
19// // must be added after, ghoErrorSource is defined
20
21// Include or define all useful symbols.
22#INCLUDE ERRORNUM.INC
23
24
25// The error class allows you to record all errors. The following
26// information is stored: Error Number
27// Error Message
28// Line number of error
29// File Number of Error
30// Field Number of Error
31//
32// Errors are recorded with:
33//
34// ERROR command (which Sends Error_Report)
35// Send Error_report (do not send this, Use Error command)
36// Send Set_Error iErr sMsg iLine iFile iField iType (Error command is better)
37//
38// Get ErrorCount
39// returns number of errors in queue
40//
41// Send ClearErrors
42// clears error log
43//
44// Send EnumerateErrors iMsg hObj
45// Sends iMsg to hObj for all errors
46// passes: iErr sMsg iLine iFile iField
47// This is used to retreive and report error info.
48//
49// Send ErrorReportCallback iItem iMsg hObj
50// Sends iMsg to hObj for this one error item.
51// if iItem is -1, show last error
52//
53// Send ClearError integer iItem
54// Clear error iItem from queue.
55// if iItem is -1, clear last error
56//
57// Get Function ErrorMessage integer iItem returns string
58// returns the Error message for this item
59//
60// Get FileFieldErrorItem integer iFile integer iField Returns integer
61// If error exists in queue for this file/field it will return its
62// item #, else -1 means no error found
63//
64// IMPORTANT: This is not a public class. This class is used by the
65// VDFInternetSession object. Messages should not be sent
66// directly to this class from any object.
67
68// error handler uses these messages from VDFInternetSession object
69Register_function pbQueueErrors Returns Integer
70Register_function pbAllErrorstoEventLog Returns Integer
71Register_function pbAllErrorstoLocal Returns Integer
72Register_function pbAllErrorsToHtml Returns Integer
73
74
75// Maintain a set of ignored errors, which can be used by the error handle (error_report)
76// to skip an error. This class assumes that there will only be a small number of ignored
77// errors. If you need to trap all errors or many errors you really want to build your
78// own error handler to do this.
79
80{ ClassLibrary=WebApp Visibility=Private }
81class cTrappedErrors is a Set
82
83 // Return 1 if Error is trapped, 0 otherwise.
84 function isTrapped integer iError returns integer
85 function_return (Find_Element(self,iError)=-1)
86 end_function
87
88 // Flag error as trappable
89 procedure TrapError integer iError
90 Send remove_element iError
91 end_procedure
92
93 // Flag error as non-trappable
94 procedure IgnoreError integer iError
95 Send Add_element iError
96 end_procedure
97
98 // Flag all errors as trappable
99 procedure TrapAllErrors
100 send Delete_data // this removes all ignored errors
101 end_procedure
102
103end_class
104
105
106// This error handler is marked as a private class. There is nothing you can do to this class
107// to either change it (WebApp requires a single based on this class) and there are no messages
108// you can send to it. All error handling messages are handled by public messages in other classes
109// that direct the messages here. The interface bwtween the public methods and the error class is
110// considered to be internal implementation.
111
112{ ClassLibrary=WebApp Visibility=Private }
113Class cWebAppError Is An cObject
114
115 Procedure Construct_object
116 Forward Send Construct_Object
117 set delegation_mode to no_delegate_or_error
118
119 { DesignTime=False }
120 { Visibility=Private }
121 Property Integer Current_Error_Number 0
122
123 { DesignTime=False }
124 { Visibility=Private }
125 Property Integer Error_Line_Number 0
126
127 // If set false, this makes the error handler work the old way which
128 // does not use the new unhandled dialog. Only exists for compatibility reasons
129 { Category="Error Handling" }
130 Property Boolean pbUnhandledErrorSupport True
131
132 // Flag which is sent when error is being processed. This
133 // stops error recursion.
134 { DesignTime=False }
135 { Visibility=Private }
136 Property Integer Error_Processing_State False
137
138 // this should not get set to a value until the COM object is created
139 // and is working. When set, the error handler knows it that it can
140 // send error messages to the COM handler.
141 { DesignTime=False }
142 { Visibility=Private }
143 Property Handle phoInetSession 0
144
145 // We will store Err# in the main error object
146 Object oErrorNumber Is an Array
147 End_Object
148 Object oErrorText Is An Array
149 End_Object
150 Object oFileNr Is An Array
151 End_Object
152 Object oFieldNr Is An Array
153 End_Object
154 Object oLineNr Is An Array
155 End_Object
156 object oTrappedErrors is a cTrappedErrors
157 end_object
158 End_Procedure
159
160 Procedure ClearErrors
161 Send Delete_data of oErrorNumber
162 Send Delete_Data of oErrorText
163 Send Delete_Data of oFileNr
164 Send Delete_Data of oFieldNr
165 Send Delete_Data of oLineNr
166 End_Procedure
167
168 Function ErrorCount Returns integer
169 Function_Return (Item_Count(oErrorNumber))
170 End_Function
171
172 // Pass Err Num, Error Msg, Line#, File, Field and error-type
173 Procedure Set_Error Integer iErrNr String sErrMsg integer iLineNr Integer iFileNr Integer iFieldNr
174 Integer iCount
175 Get ErrorCount To iCount
176 Set Value of oErrorNumber iCount to iErrNr
177 Set Value of oErrorText iCount to sErrMsg
178 Set Value of oLineNr iCount to iLineNr
179 Set Value of oFileNr iCount to iFileNr
180 Set Value of oFieldNr iCount to iFieldNr
181 End_Procedure
182
183 Function Error_ErrNr Integer iItem Returns Integer
184 Function_Return (Value(oErrorNumber,iItem))
185 End_Function
186
187 Function Error_LineNr Integer iItem Returns Integer
188 Function_Return (Value(oLineNr,iItem))
189 End_Function
190
191 Function Error_FileNr Integer iItem Returns Integer
192 Function_Return (Value(oFileNr,iItem))
193 End_Function
194
195 Function Error_FieldNr Integer iItem Returns Integer
196 Function_Return (Value(oFieldNr,iItem))
197 End_Function
198
199 Function Error_ErrMsg Integer iItem Returns String
200 Function_Return (Value(oErrorText,iItem))
201 End_Function
202
203 Function Error_Description integer Error# string ErrMsg returns string
204 String Full_Error_Text
205 Trim ErrMsg to ErrMsg
206 Move (trim(error_text(DESKTOP,Error#))) to Full_Error_Text
207 If ErrMsg Ne "" Begin
208 If ( ( Full_Error_Text ne "" ) AND ;
209 error_text_available( DESKTOP, Error# ) ) ;
210 append Full_Error_Text " " ErrMsg
211 else ;
212 move ErrMsg to Full_Error_Text
213 end
214 function_return Full_Error_Text
215 End_function
216
217 //** return true if an error number is critical
218 function Is_Critical integer Error# returns integer
219 function_return (".3.10.18.19.20.21.22.43.70.72.74.75.78.80.97.";
220 contains ("."+string(Error#)+"."))
221 end_function
222
223 procedure TrapError integer iError
224 send TrapError of oTrappedErrors iError
225 end_procedure
226
227 procedure IgnoreError integer iError
228 send IgnoreError of oTrappedErrors iError
229 end_procedure
230
231 procedure TrapAllErrors
232 send TrapAllerrors of oTrappedErrors
233 end_procedure
234
235 Function IsTrapped integer iError Returns Boolean
236 Function_Return (isTrapped(oTrappedErrors,iError))
237 End_Function
238
239
240 Procedure Error_Report integer iError integer iLine string ErrMsg
241 String sSystemErr sMess sLabel sFile sDtl sFullError
242 String sStack sSystemAndStack
243 Integer iErrFile iErrField
244 Boolean bCritical bQueueErrors bLogAllErrors bLocal bHtmlErrors
245 Handle hoInetSession
246 Boolean bUnhandledSupport
247 Boolean bDebugging
248
249 If (not(error_processing_state(self))) Begin
250
251 // If error is to be ignored, do nothing and return
252 If ( Not (isTrapped(self, iError)) ) begin
253 Procedure_return
254 end
255
256 Set Error_processing_State to True // prevents recursion
257
258
259
260 Set Current_Error_Number to iError
261 Set Error_Line_Number to iLine
262
263 Get phoInetSession to hoInetSession
264
265 Get Is_Critical iError to bCritical
266 Get pbUnhandledErrorSupport to bUnhandledSupport
267 Move (IsDebuggerPresent()) to bDebugging
268
269 Get Error_Description iError ErrMsg To sSystemErr
270
271 // if the error source is identified we can get extended error
272 // text for our error message. This capability is a standard part
273 // of VDF5
274 if ghoErrorSource Begin
275 // These messages were just added to the DD.
276 Get Extended_Error_file of ghoErrorSource to iErrFile
277 Get Extended_Error_Field of ghoErrorSource to iErrField
278 // we are making the assumption that ghoErrorSource is a DD object
279 // If it is not, we will have problems.....but it will be!
280 If (iErrFile>0) Begin
281 Get_Attribute DF_FILE_DISPLAY_NAME of iErrFile to sFile
282 If (iErrField>0) Begin
283 Get File_Field_Label of ghoErrorSource iErrFile iErrField DD_LABEL_LONG to sLabel
284 Move (SFormat(C_$FieldInDataFile,sLabel, sFile)) to sMess
285 End
286 Else Begin
287 Move (SFormat(C_$InDataFile,sFile)) to sMess
288 End
289 Append sSystemErr "\n" sMess
290 End
291 End
292
293 Move (SFormat(C_$VDFErrorInLine, iError, iLine)) to sDtl
294 If (iErrFile > 0) Move (sDtl * DD_FILE_TEXT * string(iErrFile)) to sDtl
295 If (iErrField > 0) Move (sDtl * DD_FIELD_TEXT * string(iErrField)) to sDtl
296 // full error is systemError + Error and line numbers
297 Move (sSystemErr + "\n" + sDtl) to sFullError
298
299 // If 0, the COM object is not yet ready to be used. If an error occurs in this
300 // condition, we consider this error to always be fatal and will notify WebApp
301 // Server of this error via WebAppFatalError command
302 If (hoInetSession=0) Begin
303
304 If bDebugging Begin
305 Send UnhandledErrorDisplay iLine sFullError
306 End
307 Else Begin
308 CallStackDump sStack
309 WebAppFatalError (Replaces("\n", (sFullError + "\n\n" + sStack) , character(13)+character(10)))
310 // we only arrive here if WebApp cannot handle the error. All we can
311 // do is abort.
312 //Send MessageBoxError sFullError 1 // might be useful for VDF debugging, but cannot be used on server
313 End
314 Abort
315 End
316 Else Begin
317
318 Get pbAllErrorstoLocal of hoInetSession to bLocal
319 Get pbQueueErrors of hoInetSession to bQueueErrors
320 Get pbAllErrorstoEventLog of hoInetSession to bLogAllErrors
321 Get pbAllErrorsToHtml of hoInetSession to bHtmlErrors
322
323 // If error is critical, we cannot go on.
324 If bCritical Begin
325 CallStackDump sStack
326 Move (Replaces(Character(13)+Character(10),sStack, "\n")) to sStack
327 Move (sSystemErr + "\n\n" + sStack) to sSystemAndStack
328 // also attempt to send message to client (html browser)
329 If bHtmlErrors Begin
330 // The option to disable stack dumps only makes sense if the developer is using html errors to report unhandled problems
331 // and for some reason the stack dump will mess up existing applications. This seems very unlikely but we are providing
332 // a way to disable this if needed via pbUnhandledSupport.
333 Send ReportError to hoInetSession iError (If(bUnhandledSupport, sSystemAndStack, sSystemErr)) iLine iErrFile iErrField
334 End
335
336 // if we are passing errors to VDF console, report the error
337 // if we we debugging, thereis no point in doing this
338 If (not(bDebugging) and bLocal) Begin
339 Send MessageBoxError (sFullError + "\n\n" + sStack) // 1 means critical
340 End
341
342 // log the critical error to the event log
343 // if debugging, this can be an unhandled error
344 If bDebugging Begin
345 Send UnhandledErrorDisplay iLine sFullError
346 End
347 Else Begin
348 Send ReportErrorEvent to hoInetSession iError sSystemAndStack iLine iErrFile iErrField
349 Send ReportErrorEvent to hoInetSession iError C_$CriticalErrorProgramHalted iLine 0 0
350 End
351 // and end it all
352 Abort
353 end
354
355 // if we are passing errors to VDF console, report the error
356 If bLocal Begin
357 Send MessageBoxError sFullError 0 // 0 means non-critical
358 End
359
360 // we make the following assumptions:
361 // If errors are queue
362 // We assume the error is expected, and controlled
363 // Write error to queue
364 // Ddo not write to Event Log unless we are logging all errors.
365 //
366 // if errors are not queued
367 // We assume the error is unexpected, and must be controlled
368 // Display HTML error to browser unless this is disabled
369 // Send to the event log (under the assumption that the error is unexpected).
370
371 If bQueueErrors Begin
372 Send Set_Error iError sSystemErr iLine iErrFile iErrField
373 If bLogAllErrors Begin
374 Send ReportErrorEvent to hoInetSession iError sSystemErr iLine iErrFile iErrField
375 End
376 End
377 Else Begin
378 CallStackDump sStack
379 Move (Replaces(Character(13)+Character(10),sStack, "\n")) to sStack
380 Move (sSystemErr + "\n\n" + sStack) to sSystemAndStack
381 If bHtmlErrors Begin
382 // The option to disable stack dumps only makes sense if the developer is using html errors to report unhandled problems
383 // and for some reason the stack dump will mess up existing applications. This seems very unlikely but we are providing
384 // a way to disable this if needed via pbUnhandledSupport.
385 Send ReportError to hoInetSession iError (If(bUnhandledSupport, sSystemAndStack, sSystemErr)) iLine iErrFile iErrField
386 End
387 If bDebugging Begin
388 Send UnhandledErrorDisplay iLine sFullError
389 End
390 Else Begin
391 Send ReportErrorEvent to hoInetSession iError sSystemAndStack iLine iErrFile iErrField
392 End
393 End
394 End
395
396 Move 0 to ghoErrorSource
397 Set Error_processing_State to False
398 End
399 End_procedure
400
401 Procedure UnhandledErrorDisplay Integer iErrorLine String sMessage
402 String sCaption
403 Move C_$UnhandledProgramError to sCaption
404 Move (Replaces("\n",sMessage,Character(13))) to sMessage
405 Move (Replaces("\"+Character(13), sMessage, "\n")) to sMessage
406 ErrorDisplay iErrorLine sMessage sCaption C_$OK C_$Copy
407 End_Procedure
408
409 Procedure MessageBoxError String sErrorText Boolean bCritical
410 integer iIcon iRet
411 Handle hoOldSelf hoFocus
412 Move (if(bCritical,MB_IconHand,MB_IconExclamation)) to iIcon
413 Move self to hoOldSelf
414 Get Focus of desktop to hoFocus
415 If (hoFocus>desktop) Move hoFocus to self
416 Get Message_Box sErrorText C_$ERROR MB_Ok iIcon to iRet
417 Move hoOldSelf to self
418 End_Procedure
419
420
421 //
422 // Enumerate all errors.
423 // For each error send iMsg to hObj passing all required error
424 // information: iErr#, sErrorMsg, iLine, iFile, iField
425 //
426 Procedure EnumerateErrors Integer iMsg integer hObj
427 Integer iCount i
428 Get ErrorCount To iCount
429 Decrement iCount
430 For i from 0 to iCount
431 Send ErrorReportCallback i iMsg hObj
432 Loop
433 End_procedure
434
435 // if item is -1 it is last error
436 Procedure ErrorReportCallback integer iItem Integer iMsg integer hObj
437 String sErrMsg
438 Integer iFileNr iFieldNr iErrNr iLineNr
439 Integer iCount
440 Get ErrorCount To iCount
441 If (iItem=-1) Move (iCount-1) to iItem // if -1, use last error
442 If (iItem>=0 AND iCount>iItem) Begin
443 Get Error_ErrNr iItem To iErrNr
444 Get Error_ErrMsg iItem To sErrMsg
445 Get Error_LineNr iItem To iLineNr
446 Get Error_FileNr iItem To iFileNr
447 Get Error_FieldNr iItem To iFieldNr
448 Send iMsg to hObj iErrNr sErrMsg iLineNr iFileNr iFieldNr
449 End
450 End_procedure
451
452 // this is used to remove a single error from the queue
453 // if iItem is -1, last error
454 Procedure ClearError integer iItem
455 Integer iCount
456 Get ErrorCount To iCount
457 If (iItem=-1) Move (iCount-1) to iItem // if -1, use last error
458 If (iItem>=0 AND iCount>iItem) Begin
459 Send Delete_Item iItem
460 Send Delete_Item to oErrorText iItem
461 Send Delete_Item to oLineNr iItem
462 Send Delete_Item to oFileNr iItem
463 Send Delete_Item to oFieldNr iItem
464 End
465 End_Procedure
466
467 Function ErrorMessage integer iItem returns string
468 String sErrMsg
469 Integer iCount
470 Get ErrorCount To iCount
471 If (iItem=-1) Move (iCount-1) to iItem // if -1, use last error
472 If (iItem>=0 AND iCount>iItem) ;
473 Get Error_ErrMsg iItem To sErrMsg
474 Function_return sErrMsg
475 End_Function
476
477 // see if error exists for this file and field. If it does, return the
478 // item number, else return -1.
479 Function FileFieldErrorItem integer iFile integer iField Returns integer
480 Integer iCount i
481 Get ErrorCount To iCount
482 Decrement iCount
483 For i from 0 to iCount
484 If (Error_FileNr(self,i)=iFile AND ;
485 Error_FieldNr(self,i)=iField) ;
486 Function_return i
487 Loop
488 Function_Return -1
489 End_Function
490
491End_Class
492
493Procedure UserError Global String sMessage
494
495 If (Error_Object_Id=0) Begin
496 Error DFERR_PROGRAM "No Error Handler"
497 Procedure_Return
498 End
499
500 Error DFERR_OPERATOR sMessage
501
502End_Procedure