Arjen Markus 2004-12-09: 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 guaranteed 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
