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