Richard Suchenwirth 2007-10-20 - Now that I have TclOO both at work and home, and another weekend comes up, it's obvious that I wanted to play with it, just for finger practice. Barking dogs have been demonstrated elsewhere, but I decided to start with another classic example, a bank account.
#!/usr/bin/env tclsh85 package require TclOO namespace import oo::* catch {Account destroy} ;# in case of repeated sourcing class create Account { constructor {{ownerName undisclosed}} { my variable total overdrawLimit owner set total 0 set overdrawLimit 10 set owner $ownerName } method deposit amount { my variable total set total [expr {$total + $amount}] } method withdraw amount { my variable {*}[info object vars [self]] ;# "auto-import" all variables if {($amount - $total) > $overdrawLimit} { error "Can't overdraw - total: $total, limit: $overdrawLimit" } set total [expr {$total - $amount}] } method transfer {amount targetAccount} { my variable total my withdraw $amount $targetAccount deposit $amount set total } destructor { my variable total if {$total} {puts "remaining $total will be given to charity"} } }
if 0 {Due to the simple hierarchy of TclOO (every class is an instance of oo::class, which is an instance of oo::object), it is not very hard to add development helper methods that each object inherits:}
define oo::object method dump {{pat *}} { set res [list class [info object class [self]]] foreach i [info object vars [self] $pat] { my variable $i lappend res $i [set $i] } set res }
#-- "Test suite"
foreach cmd [split { set a [Account new "John Doe"] $a deposit 200 $a deposit 20 $a withdraw 150 $a withdraw 100 $a dump set b [Account new] $a transfer 65 $b $a dump $b dump $a transfer 1000000 $b $b destroy } \n] { catch $cmd res puts "$cmd -> $res" }
if 0 {which prints
set a [Account new "John Doe"] -> ::oo::Obj36 $a deposit 200 -> 200 $a deposit 20 -> 220 $a withdraw 150 -> 70 $a withdraw 100 -> Can't overdraw - total: 70, limit: 10 $a dump -> class ::Account total 70 overdrawLimit 10 owner {John Doe} set b [Account new] -> ::oo::Obj37 $a transfer 65 $b -> 5 $a dump -> class ::Account total 5 overdrawLimit 10 owner {John Doe} $b dump -> class ::Account total 65 overdrawLimit 10 owner undisclosed $a transfer 1000000 $b -> Can't overdraw - total: 5, limit: 10 remaining 65 will be given to charity $b destroy ->
Interactive testing is, as usual with Tcl, a good way to learn. In the following case, it shows that variables are not exactly protected from hack attacks:
% set $a\::total 1000000 1000000 % $a dump class ::Account total 1000000 overdrawLimit 10 owner {John Doe}
So better not deploy a real banking software based on this code :^) On the lighter side, introspection works as we all know and love, for easy "online help":
% class help unknown method "help": must be create, destroy or dump % Account help unknown method "help": must be create, destroy, dump or new % $a help unknown method "help": must be deposit, destroy, dump, transfer or withdraw
Another issue: member variables must be explicitly imported into methods (similar to namespace rules). If you prefer the C++ style (all member variables implicitly known), one hackish solution was demonstrated in the withdraw method above, and here's some sugar-coating if you want it more often:
proc all_my_variables {} { uplevel 1 {my variable {*}[info object vars [self]]} }
so the method can then look like
method withdraw amount { all_my_variables if {($amount - $total) > $overdrawLimit} { error "Can't overdraw - total: $total, limit: $overdrawLimit" } set total [expr {$total - $amount}] }
To distinguish members and others, one might then use the C++ convention that member names end in "_".
To summarize my first impressions, TclOO can be used well as an OO system in itself. I haven't even used all features as documented in TIP #257. So when I'll need some OO in the future, I can probably just use this, and do without incr Tcl or XOTcl ... :^)
}
The most part of the above example was also included in http://en.wikibooks.org/wiki/Tcl_Programming/Introduction#TclOO - everyone is welcome to make it better!
DKF: Well, you can go one better:
oo::class create class { superclass oo::class constructor {args} { my variable vars set vars {} next {*}$args } method global {variable {initValue {}}} { my variable vars lappend vars $variable $initValue } method constructor {args body} { my variable vars set body0 {} foreach {var val} $vars {append body0 [list variable $var $val] \;} oo::define [self] constructor $args $body0$body } method method {name args body} { my variable vars set body0 {} foreach {var val} $vars {append body0 [list variable $var] \;} oo::define [self] method $name $args $body0$body } method destructor body { my variable vars set body0 {} foreach {var val} $vars {append body0 [list variable $var] \;} oo::define [self] destructor $body0$body } } class create Account Account global total 0 Account global overdrawLimit 10 Account global owner Account constructor {{ownerName undisclosed}} { set owner $ownerName } Account method deposit amount { set total [expr {$total + $amount}] } Account method withdraw amount { if {($amount - $total) > $overdrawLimit} { error "Can't overdraw - total: $total, limit: $overdrawLimit" } set total [expr {$total - $amount}] } Account method transfer {amount targetAccount} { my withdraw $amount $targetAccount deposit $amount return $total } Account destructor { if {$total} {puts "remaining $total will be given to charity"} }
SL: Another interesting customizing on the meta-class oo::class inspired by Putting Metaclasses to Work [Ira R. Forman, Scott H. Danforth]:
Each newly created oo::object should contain a timestamp, holding the creation-time of each instance.
One implementation is called instance method:
# instance method oo::class create ctimestamped { method create {args} { next {*}$args oo::define [lindex $args 0] constructor {args} { my variable timestamp set timestamp [clock seconds] next {*}$args } oo::define [lindex $args 0] method getCreationTime {} { my variable timestamp return $timestamp } } } oo::define oo::class mixin ctimestamped ... set a [Account new] $a getCreationTime
The timestamp is located in the class instance as well as the retrieving function.
Another implementation is called class method:
oo::class create ctimestamped { method create {args} { next {*}$args oo::define [lindex $args 0] constructor {args} { my variable timestamp set timestamp [clock seconds] next {*}$args } } method getCreationTime object { set ${object}::timestamp } } oo::define oo::class mixin ctimestamped ... set a [Account new] Account getCreationTime $a
The timestamp is located in the class instance, but the retrieving function is located in the meta-class oo::class.
Category Example | Category Object orientation |
---|