Updated 2018-07-13 22:17:35 by pooryorick

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