Forum OpenACS Development: OpenACS, XoTcl, and ActiveRecord
The inspiration is from the ActiveRecord implementation by David Heinemeier Hansson in Ruby on Rails (Ruby License, which is exlpicitly GPL compatible). See the code here:
This design makes it easy to define class that map to DB tables or ACS Object Types.
Here's an example (thanks, Guan):
class Person < ActiveRecord::Base
def self.table_name() "people" end
def self.id_column() "people_id" end
def validate()
errors.add_on_empty(%w(first_names last_name))
end
end
The 'table_name' and 'id_column' methods are both class methods, which the Person class chooses to override here. If you don't, however, there's an implementation on ActiveRecord::Base, which guesses the table_name from the class name (in this case the class name is "Person", so the table_name would be guessed to be "persons"). Neat.
Now you can say things like:
@person = Person.find(@params["person_id"])
This sets the variable "person" to an object of class Person populated by getting the row in the "people" table with ID = the "person_id" request parameter.
"find" is a class method on the Person class, which creates a new object of class Person, pre-populated with values from the row with the given primary key in the database.
(Note how parameters are naturally stored in a "params" variable instead of in local variables, like we do, so you always have a plaec to reference the query params when you need them, certain that they won't have accidentally been overwritten somewhere in your code.)
Then to update the column values from the request, you can say this:
@person.attributes = @params["person"]
(This requires that the query vars are named something like "person[first_names]" and "person[last_name]".)
Then to update the database table with the new values, simply say:
@person.save
Anyway, XoTcl is causing me some headaches.
It seems to me that you can't create class methods in XoTcl, which is what ActiveRecord relies on for "table_name", "find", and a host of other things.
You can create Meta-Classes, which seem sort-of similar, but they're not quite the same thing.
Anyway, here's the snippet that I have, and which isn't working. Maybe someone (Peter, Gustaf) can help me out and tell me how to do this, or tell me that it can't be done?
-----
package require XOTcl
Class ActiveRecord -superclass Class
ActiveRecord instproc table_name {} {
# Transforms AcsObject -> acs_object
set table_name [lindex [split [my info class] ::] end]
regsub {([a-z])([A-Z])} $table_name {\1_\2} table_name
set table_name [string tolower $table_name]
return $table_name
}
ActiveRecord instproc id_column {} {
return "[my table_name]_id"
}
ActiveRecord Person
Person proc table_name {} { return "people" }
Person proc id_column {} { return "people_id" }
ActiveRecord AcsObject
# AcsObject uses default table_name and id_column
ns_return 200 text/html "<pre>
Person table_name = [Person table_name] (expects: people)
Person id_column = [Person id_column] (expects: people_id)
AcsObject table_name = [AcsObject table_name] (expects: acs_object)
AcsObject id_column = [AcsObject id_column] (expects: acs_object_id)
</pre>"
The first one works, but the latter doesn't.
Apart from that, any comments on ActiveRecord? It seems like a very useful and quite light-weight appraoch to me - there isn't all that much code, it's not a complete persistence layer solution, and it maps beautifully to our OO data model.
Comments?
/Lars
This looks like a great idea. During the past few months I've also wondered if XOTcl and OpenACS might not make a good match.
The reason [AcsObject table_name] doesn't work is because you are getting the name of the class (AcsObject is of class ActiveRecord) instead of the name of the object itself. Your demo will work if you change [my info class] to [self] in the table_name proc.
ActiveRecord instproc table_name {} {
# Transforms AcsObject -> acs_object
set table_name [lindex [split [self] ::] end]
regsub {([a-z])([A-Z])} $table_name {\1_\2} table_name
set table_name [string tolower $table_name]
return $table_name
}
set table_name [lindex [split [self] ::] end]
Did split change? Split uses each char to do the split. If the separation chars are "::" as in a namespace, use namespace commands:
set parent [namespace qualifiers [self]] set child [namespace tail [self]]
The namespace doesn't need to exist, just a string of the correct form.
How does this all relate to persistence, is each record stored as an object? How does it persist in OpenACS?
"[split] Returns a list created by splitting string at each character that is in the splitChars argument. Each element of the result list will consist of the characters from string that lie between instances of the characters in splitChars. Empty list elements will be generated if string contains adjacent characters in splitChars, or if the first or last character of string is in splitChars. If splitChars is an empty string then each character of string becomes a separate element of the result list. SplitChars defaults to the standard white-space characters."
Therefore if I'm not mistaken:
[split [self] ::]
will attempt to split self by ':' and ':' rather than '::' which will produce an empty string between each element e.g
set self "mytcl::namespace::isgroovy"
split $self ::
gives a list of 5 elements:
mytcl {} namespace {} isgroovy
rather than a list of three elements:
mytcl namespace isgroovy
I get round this by regsubbing a safe chr inplace of the string then splitting on that chr.
I don't know if that is the desired effects - I'm just poking my nose in.
- Steve
If the string returned by [self] is a namespace, or qualified procedure name, you really should use the namespace commands to figure out what the tail is. The reason is that ':' is an allowed character in procedure names, and '::', ':::' and '::::' are all equivalent in meaning for qualified names in tcl. The resultant code is also easier to read and maintain.
One point about ActiveRecord is that you have business logic in the same class. Using the Ruby example, you might have:
class Person << ActiveRecord::Base
def send_email(subject, message)
send_email_proc(@email, subject, message)
end
def revoke_credit
@credit = 0
end
end
with the short answers, such people can skip the long answers
below:
Lars first question: i think, you questions concerning
the class name and the colon handling are sorted out.
A simple thing, to make things a little more pretty is
to define an instproc name available for all objects
(and classes) such as
Object instproc name {} {return [namespace tail [self]]}
then you can do a ... [my name] in each object or class.
---
Guan: keeping business logic in one class: you can
keep things certainly "in one class",
ActiveRecord Person -parameter {{credit 0}}
Person instproc email_addr {} {
return [namespace tail [mailto:self]]@somehost.somedomain
}
Person instproc send_email {subject message} {
puts "send_email_proc [my email_addr] $subject $message"
}
Person jeff
jeff send_email "hi" "some text"
The only separation here is that xotcl/tcl uses separate
commands to define methods/procs which can be incrementally
redefined. If you prefer a more close appearance, one
can use
ActiveRecord Person -parameter {{credit 0}} \
-proc table_name {} { return "people" } \
-proc id_column {} { return "people_id" } \
-instproc email_addr {} {
return [namespace tail [mailto:self]]@somehost.somedomain
} \
-instproc send_email {subject msg} {
puts "send_email_proc [my email_addr] $subject $msg"
}
since one can call every method via the configure call
in the creation.
---
Concering the active record example: Lars, you
might find some usage of the following code, that
i posting here, since it is not very long. I wrote
this code two years ago, which follows the idea that
one creates classes/object in xotcl and xotcl
tries to create query and update the database underneath.
This might not the best thing for usage in openacs,
where you probably want more control over the database,
use stored procedures and such, but anyhow, one can
use it as a source for ideas and code snipplets. One
can subclass the provided methods to make use
of faster queries and use the generic ones as default.
When i remember correctly, neophytos did some experiences
with the code below, and came most probably up with
something better and more clever than this little demo....
I will add this to the xotcl distro and put it
under the tcl-style open license.
Basically,
- one creates classes and objects,
- during the creation of classes, the system
checks for the existance of corresponding tables and
creates it on the fly if necessary;
- on the creation of objects, it checks for
the existance of tuples and fetches it if possible.
- The system uses write traces for variables to
maintain a dirty flag;
- when the flag is set, an update call updates the
database;
- when the object is destroyed, it performs the
update as well.
Here is a sample file. the DB_Manager defines
the linkage with the database. DB_Classes are
Classes with persistent data in the database.
The database attributes are defined via '-att',
which are embedded objects that might contain
more metadata (such the name of the attributes,
its datatype, wether it is a primary key or not, etc.)
For fun, i defined two different mapping strategies,
relational and object-relational, where the latter
one is using postgres' object relational definitions.
----
package require xotcl::store::reldb
package require xotcl::store::postgres
DB_Manager dbm1
DB_Table parameter {{dbmgr dbm1}}
DB_Class Person -superclass DB_Object \
-att {id -attname PERSON_ID -pk 1 -type integer} \
-att {count -type integer} \
-att age \
-att name
DB_Class Employee -superclass Person \
-mapping object-relational \
-att ssn
DB_Class ProjectLeader -superclass Employee -table LEADER \
-mapping object-relational \
-att {project -attname PROJECT_ID -type integer}
DB_Class Project -superclass DB_Object \
-att {id -attname PROJECT_ID -pk 1 -type integer} \
-att name \
-att {mgr -attname MANAGER}
DB_Class DevelopmentProject -superclass Project -table DEVPROJECT \
-att {product -attname PRODUCT_ID -type integer}
Person p -id 111 -age 22 -name "Gustaf" -count 0
Employee e1 -id 4711
ProjectLeader pp -id 333
Person p1 -id 111
p incr count
DevelopmentProject openacs -id 123 -name OpenACS -mgr nobody -product 222
--------------
The db mapping is defined below.
It contains the definition for
- DB_Att (database attributes)
These hold metadata about attributes, such as
name of the attribute in the database, data type,
the name of the corresponding variable in the
xotcl object, etc.)
- DB_Table (class for maintaining tables)
for the tables, subobjects are defined on the
class level (e.g. Person::table), which do all
perform the datbase logic; the tables contain
as subobjects instances of DB_ATT, which
contain the meta data about the attributes
of the table (e.g. Person::table::age)
It has methods for defining e.q.
SQL create, select or insert statements.
- DB_Class (similar do ::xotcl::Class):
a meta class providing the linkage
between application classes and DB_Tables.
- DB_Mapping (the two experimental mappings)
- DB_Object (similar to ::xotcl::Object), containing
methods avaiable to all objects with persistant
data.
--------------
package provide xotcl::store::reldb 0.9
Class DB_Att -parameter {
{type varchar(255)}
{attname {[namespace tail [self]]}}
{pk 0}
}
DB_Att instproc varname {} {
return [namespace tail [self]]
}
DB_Att instproc quoted {value} {
if {[my type] == "integer"} { return $value }
return '$value'
}
DB_Att instproc = o {
return [my attname]=[my quoted [$o set [my varname]]]
}
Class DB_Table -parameter {table inherits references}
DB_Table instproc allAtts {} {
set atts [my info children]
if {[my exists inherits]} {
set atts [concat $atts [[my inherits] allAtts]]
}
return $atts
}
DB_Table instproc pk {} {
foreach a [my info children] {if {[$a pk]} { return $a }}
if {[my exists inherits]} {return [[my set inherits] pk]}
if {[my exists references]} {return [[my set references] pk]}
return ""
}
DB_Table instproc Select {o} {
my instvar dbmgr
set dbatts [list]
set vars [list]
foreach a [my allAtts] {
lappend dbatts [$a attname]
lappend vars [$a varname]
}
if {[my exists references]} {
set r [my references]
#set rpk [$r pk]
#lappend dbatts [$rpk attname]
#lappend vars [$rpk varname]
$r Select $o
}
set cmd "SELECT [join $dbatts ,] FROM [my table] WHERE [[my pk] = $o]"
return [$dbmgr fetch "$cmd;" $o $vars]
}
DB_Table instproc Insert {o} {
my instvar dbmgr
set dbatts [list]
set values [list]
foreach a [my allAtts] {
set vn [$a varname]
if {[$o exists $vn]} {
lappend dbatts [$a attname]
lappend values [$a quoted [$o set $vn]]
}
}
if {[my exists references]} {
set r [my references]
set rpk [$r pk]
set vn [$rpk varname]
lappend dbatts [$rpk attname]
lappend values [$rpk quoted [$o set $vn]]
$r Insert $o
}
set cmd "INSERT into [my table] ([join $dbatts {, }]) \
VALUES ([join $values {, }])"
return [$dbmgr doSql "$cmd;"]
}
DB_Table instproc Create {} {
my instvar dbmgr
if {[$dbmgr tableExists [my table]]} return
set dbatts [list]
foreach a [my info children] {
set decl "[$a attname] [$a type]"
if {[$a pk]} {append decl " PRIMARY KEY"}
lappend dbatts $decl
}
set ref ""
if {[my exists references]} {
set r [my references]
set a [$r pk]
lappend dbatts "[$a attname] [$a type]"
set ref ", FOREIGN KEY([$a attname]) REFERENCES [$r table]"
}
set attspec [join $dbatts ",\n\t"]
set cmd "CREATE TABLE [my table] (\n\t$attspec$ref\n)"
if {[my exists inherits]} {
append cmd " INHERITS ([[my inherits] table])"
}
$dbmgr doSql "$cmd;"
}
DB_Table instproc Update {o} {
my instvar dbmgr
set pairs [list]
foreach a [my allAtts] {
if {[$o exists [$a varname]]} {
lappend pairs [$a = $o]
}
}
if {[my exists references]} {
set r [my references]
lappend pairs [[$r pk] = $o]
$r Update $o
}
set cmd "UPDATE [my table] SET [join $pairs ,] WHERE [[my pk] = $o]"
return [$dbmgr doSql "$cmd;"]
}
Class DB_Class -superclass Class -parameter {
{mapping relational}
{table {[namespace tail [self]]}}
}
DB_Class instproc att list {
if {![my isobject [self]::table]} {
DB_Table create [self]::table -table [my table]
}
eval DB_Att create [self]::table::$list
my parameter [lindex $list 0]
}
DB_Class instproc init {} {
my mixin DB_mapping=[my mapping]
my tableLinkage
if {[my isobject [self]::table]} {
[self]::table Create
}
}
DB_Class instproc update o {
if {[$o exists __dirty_flag__]} {
[self]::table Update $o
$o unset __dirty_flag__
}
}
DB_Class instproc instdestroy {o args} {
my update $o
set pk [[self]::table pk]
set vn [$pk varname]
if {[$o exists $vn]} {
set key [$o set $vn]
my unset keys($key)
}
catch {[[self]::table dbmgr] unset fetched($o)}
next
}
DB_Class instproc create args {
set o [next]
set pk [[self]::table pk]
set vn [$pk varname]
if {[$o exists $vn]} {
set key [$o set $vn]
if {[my exists keys($key)]} {
set obj [my set keys($key)]
puts "object of class my key $key was fetched already, returning object $obj\n"
$o destroy ;# destroy unsets keys($key)
return [my set keys($key) $obj]
} else {
if {![[self]::table Select $o]} {
[self]::table Insert $o
}
my set keys($key) $o
}
} else {
puts "no key specified"
}
return $o
}
Class DB_mapping
Class DB_mapping=relational -superclass DB_mapping
DB_mapping=relational instproc tableLinkage {} {
set sc [my info superclass]
if {[my isobject [self]::table] && $sc != "::DB_Object"} {
[self]::table references ${sc}::table
}
}
Class DB_mapping=object-relational -superclass DB_mapping
DB_mapping=object-relational instproc tableLinkage {} {
set sc [my info superclass]
if {[my isobject [self]::table] && $sc != "::DB_Object"} {
[self]::table inherits ${sc}::table
}
}
DB_Class DB_Object
DB_Object instproc vartrace {name sub op} {
if {$op == "w"} {
#puts "my set __dirty_flag__ 1"
my set __dirty_flag__ 1
}
}
-----
Below is the little postgres driver for libpgtcl
which connects to the database, queries the
table catalog and performs the real queries. The class should be replaced by something
more appropriate in openacs...
-----
package provide xotcl::store::postgres 0.9
load /usr/lib/libpgtcl.so
Class DB_Manager -parameter {
{host localhost}
{port 5432}
{dbname test}
{recreate 0}
}
DB_Manager instproc init {} {
my instvar host port dbname conn
set dbn [string tolower $dbname]
set conn [pg_connect template1 -host $host -port $port]
#set conn [pg_connect template1 -options user=postgres]
set res [pg_exec $conn "SELECT datname FROM pg_database where datname='$dbn'"]
set ntups [pg_result $res -numTuples]
pg_result $res -clear
if {$ntups == 0} {
puts "we have to create database $dbname"
set res [pg_exec $conn "CREATE DATABASE $dbname;"]
pg_result $res -clear
} else {
pg_disconnect $conn
puts "opening database $dbname"
set conn [pg_connect $dbname -host $host -port $port]
}
}
DB_Manager instproc tableExists {name} {
my instvar conn
if {[my recreate]} {
set res [pg_exec $conn "DROP TABLE $name;"]
pg_result $res -clear
return 0
}
set n [string tolower $name]
set res [pg_exec $conn \
"SELECT tablename FROM pg_tables WHERE tablename='$n';"]
set ntups [pg_result $res -numTuples]
pg_result $res -clear
return $ntups
}
DB_Manager instproc doSql {cmd} {
my instvar conn
set res [pg_exec $conn $cmd]
puts "*** doSql $cmd"
pg_result $res -clear
}
DB_Manager instproc fetch {cmd o vars} {
my instvar conn
set res [pg_exec $conn $cmd]
set ntups [pg_result $res -numTuples]
puts "$o: $cmd got $ntups tuples"
if {$ntups > 0} {
my set fetched($o) 1
foreach var $vars value [pg_result $res -getTuple 0] {
$o set $var $value
$o trace variable $var w [list $o vartrace]
}
}
pg_result $res -clear
return $ntups
}
DB_Manager instproc disconnect {} {
my instvar conn
foreach o [my array names fetched] {
[$o info class] update $o
}
puts "*** closing connection"
pg_disconnect $conn
my unset conn
}
DB_Manager instproc destroy {} {
my disconnect
}
