[Arjen Markus] (9 december 2004) I am an engineer and I like to keep away from most business stuff, as it is a territory I do not understand very well :). Nevertheless, recent activities had me involved in something close to "business logic" and I decided, inspired by [Colin McCormack], to try and set up a little business system. Be warned: it is just a mere experiment, I have no serious intentions with it. I just wanted to explore a simple approach (see the comments in the source code). In particular: * Not enough error checking * No procedure for reporting what maintenance is due (one of the things I had set as a goal, but I was too lazy) * I have not tested the replay facility yet - this was merely a thought :) ---- # business.tcl -- # A little experiment with "business objects" # # The idea is simple: we have a little company that sells # a few products to various clients. These products require # maintenance (and this is part of our income, of course). # The system we implement here keeps track of the clients, # what products they have bought and when maintenance is # due. From the data we can make reports to get a feeling # for how things are going ... # # The implementation is fairly straightforward: # - clients and products are identified by some unique ID # - each client and product can have any number of attributes # - some basic procs allow us to manipulate these "objects" # - persistence is garanteed by copying the commands to # a "replay" file (so we do not need a genuine database # in this implementation) # - using the basic procs we build higher-level procs # to create reports for instance. # namespace eval ::business { namespace export newid listids setattrib getattrib hasattrib namespace export newclient product sale reportSales reportClients variable data {} variable outfile [open "objects.sav" w] } # newid -- # Create a new ID # # Arguments: # type Type of object # name Name of the object # Result: # Unique ID (unique within this run) # proc ::business::newid {type name} { variable data variable outfile puts $outfile [list newid $type $name] set id [llength $data] lappend data [list TYPE $type NAME $name] return $id } # whichid -- # Find the ID for a name # # Arguments: # type Type of object # name Name of the object # Result: # Unique ID (unique within this run) # proc ::business::whichid {type name} { variable data set id 0 set found 0 foreach obj $data { if { [getattrib $id TYPE] == $type && [getattrib $id NAME] == $name } { set found 1 break } incr id } if { $found } { return $id } else { return -code error "No such object: $name" } } # listids -- # Return a list of all IDs of given type # # Arguments: # type Type of objects # Result: # List of all IDs of this type # proc ::business::listids {type} { variable data set ids {} set index 0 foreach obj $data { if { [lindex $obj 1] == $type } { lappend ids $index } incr index } return $ids } # setattrib -- # Set an attribute to a (new) value # # Arguments: # id ID of the object # attrib Name of the attribute # value Value for the attribute # Result: # Nothing # proc ::business::setattrib {id attrib value} { variable data variable outfile puts $outfile [list setattrib $id $attrib $value] set obj [lindex $data $id] set index 1 set found 0 foreach {a v} $obj { if { $a == $attrib } { set found 1 break } incr index 2 } if { $found } { lset obj $index $value } else { lappend obj $attrib $value } lset data $id $obj } # getattrib -- # Get the value of an attribute # # Arguments: # id ID of the object # attrib Name of the attribute # Result: # Value of the attribute # proc ::business::getattrib {id attrib} { variable data set obj [lindex $data $id] set found 0 foreach {a v} $obj { if { $a == $attrib } { set found 1 break } } if { $found } { return $v } else { return -code error "No such attribute: $attrib" } } # hasattrib -- # Check if the object has such an attribute # # Arguments: # id ID of the object # attrib Name of the attribute # Result: # 1 if there is such an attribute, 0 otherwise # proc ::business::hasattrib {id attrib} { variable data set obj [lindex $data $id] set found 0 foreach {a v} $obj { if { $a == $attrib } { set found 1 break } } return $found } # newclient -- # Define a new client # # Arguments: # name Name of the client # Result: # New ID # proc ::business::newclient {name} { newid CLIENT $name } # product -- # Define a new product # # Arguments: # name Name of the product # price Price of a single item # maintenance Maintenance period (in days) # Result: # New ID # proc ::business::product {name price maintenance} { set id [newid PRODUCT $name] setattrib $id PRICE $price setattrib $id MAINT $maintenance return $id } # sale -- # Register a sale # # Arguments: # client Name of the client # product Name of the product # date When was the sale made # Result: # Nothing # proc ::business::sale {client product date} { set cid [whichid CLIENT $client] set pid [whichid PRODUCT $product] if { [hasattrib $cid SALES] } { set sales [getattrib $cid SALES] } else { set sales {} } lappend sales [list $pid $date] setattrib $cid SALES $sales } # reportSales -- # Print a report on the sales since some date # # Arguments: # from Date from which to report # Result: # Printed report # proc ::business::reportSales {from} { set result 0 foreach pid [listids PRODUCT] { set count($pid) 0 set name($pid) [getattrib $pid NAME] } foreach cid [listids CLIENT] { set sales [getattrib $cid SALES] foreach sale $sales { foreach {pid date} $sale {break} if { $date > $from } { incr count($pid) incr result [getattrib $pid PRICE] } } } puts "Sales since $from:" puts [format "%20s %10s" Product Number] foreach pid [listids PRODUCT] { puts [format "%20s %10d" $name($pid) $count($pid)] } puts "Result: $result (monetary units)" } # reportClients -- # Print a report on the clients and how much values they represent # # Arguments: # None # Result: # Printed report # proc ::business::reportClients {} { puts "Clients:" puts [format "%20s %10s %10s" Client Number "Total value"] foreach cid [listids CLIENT] { set value 0 set count 0 set name [getattrib $cid NAME] set sales [getattrib $cid SALES] foreach sale $sales { foreach {pid date} $sale {break} incr count incr value [getattrib $pid PRICE] } puts [format "%20s %10d %10d" $name $count $value] } } # Far from finished, of course ... but let us test it anyway # namespace import ::business::* product "A-machine" 10000 365 product "B-machine" 5300 120 product "C-machine" 300 365 newclient "ABC" newclient "FF" sale ABC A-machine 2004/01/12 sale ABC B-machine 2004/01/22 sale ABC B-machine 2004/02/11 sale FF C-machine 2003/10/31 sale FF A-machine 2003/11/08 sale ABC C-machine 2004/05/25 sale FF A-machine 2004/06/03 reportSales 2004/01/01 reportClients ---- [[ [Category Example] ]]