1# ----------------------------------------------------------------------
2#  PURPOSE:  Tracking for hazardous products manufactured by the
3#            "toaster" company.
4#
5#   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
6#            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
7#
8#      RCS:  $Id: Hazard.tcl,v 1.1 1998/07/27 18:41:30 stanton Exp $
9# ----------------------------------------------------------------------
10#               Copyright (c) 1993  AT&T Bell Laboratories
11# ======================================================================
12# Permission to use, copy, modify, and distribute this software and its
13# documentation for any purpose and without fee is hereby granted,
14# provided that the above copyright notice appear in all copies and that
15# both that the copyright notice and warranty disclaimer appear in
16# supporting documentation, and that the names of AT&T Bell Laboratories
17# any of their entities not be used in advertising or publicity
18# pertaining to distribution of the software without specific, written
19# prior permission.
20#
21# AT&T disclaims all warranties with regard to this software, including
22# all implied warranties of merchantability and fitness.  In no event
23# shall AT&T be liable for any special, indirect or consequential
24# damages or any damages whatsoever resulting from loss of use, data or
25# profits, whether in an action of contract, negligence or other
26# tortuous action, arising out of or in connection with the use or
27# performance of this software.
28# ======================================================================
29
30itcl_class HazardRec {
31	constructor {cname} {
32		set class $cname
33	}
34	method change {var inc} {
35		if {![info exists $var]} {
36			error "bad field \"$var\""
37		}
38		incr $var $inc
39	}
40	method report {} {
41		return "$class: $total produced, $actives active, $accidents accidents"
42	}
43	protected class {}
44	protected total 0
45	protected actives 0
46	protected accidents 0
47}
48
49itcl_class Hazard {
50
51	constructor {} {
52		set class [virtual info class]
53		if {![info exists recs($class)]} {
54			set recs($class) [HazardRec #auto $class]
55		}
56		$recs($class) change total +1
57		$recs($class) change actives +1
58	}
59	destructor {
60		set class [virtual info class]
61		$recs($class) change actives -1
62	}
63
64	method accident {mesg} {
65		set class [virtual info class]
66		$recs($class) change accidents +1
67		puts stderr $mesg
68	}
69
70	proc report {class} {
71		if {[info exists recs($class)]} {
72			return [$recs($class) report]
73		} else {
74			error "no information for class \"$class\""
75		}
76	}
77    common recs
78}
79