Home
The Toolkit for Online Communities
17303 Community Members, 0 members online, 2272 visitors today
Log In Register
OpenACS Home : Forums : OpenACS Development : OpenACS, XoTcl, and ActiveRecord

Forum OpenACS Development: OpenACS, XoTcl, and ActiveRecord

Icon of envelope Request notifications

Collapse
Posted by Lars Pind on
I've experimented a bit with implementing Martin Fowler's ActiveRecord pattern (http://www.martinfowler.com/eaaCatalog/activeRecord.html) using XoTcl, but so far my efforts have fallen short.

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:

http://rubyforge.org/cgi-bin/viewcvs/cgi/viewcvs.cgi/activerecord/lib/active_record/base.rb?rev=1.17&cvsroot=activerecord&content-type=text/vnd.viewcvs-markup

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

Collapse
Posted by Benjamin Bytheway on
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
}

Collapse
Posted by Tom Jackson on
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?

Collapse
Posted by Steve Manning on
Quoting from the TCL man:

"[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

Collapse
Posted by Tom Jackson on

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.

Collapse
Posted by Guan Yang on

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

Collapse
Posted by Jonathan Ellis on
That's still how split works in tcl 8.4.
Collapse
Posted by Jade Rubick on
I've had problems in the past with trying to split with more than one character. It typically only uses the first character, at least in my experience. You could look at the source code..
Collapse
Posted by Neophytos Demetriou on
If you need to split a string according to a multi-character sequence, check tcllib's ::textutil::splitx.

http://tcllib.sourceforge.net/doc/textutil.html

Collapse
Posted by Gustaf Neumann on
a couple of issues are mentioned above, where i start
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 [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 [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
}