about vinod kurup

Steve Yegge wrote about the expressiveness of Ruby as compared to Java. He used this simple problem as an example:

How about if we write a program that will print out all the words in the dictionary starting with the letter ‘Q’ (case-insensitive), grouped by increasing length, and sorted alphabetically within each group.

The Ruby version was about 12 lines of code and Java version about 43. Of course, the point of the exercise wasn’t simply the difference in LOCs, but in the overall simplicity of dealing with collections of data. Still, I wanted to see how Tcl would deal with the same problem. Here’s the simplest version I could come up with:

 set f [open /usr/share/dict/words r] set words [read -nonewline $f] close $f  set qwords [lsearch -all -inline [split $words \n] {[Qq]*}]  proc compare_length {a b} {     if { [string length $a] <= [string length $b] } {         return -1     } else {         return 1     } }  set sorted_qwords [lsort -command compare_length [lsort $qwords]]  set max -1 foreach qword $sorted_qwords {     if { [string length $qword] > $max } {         set max [string length $qword]         puts "Words of length $max:"     }     puts "  $qword" } 

About 19 lines and pretty simple to write and read. Can this be improved?

Automated testing is a good thing. For my running log application, I have a proc that creates a new log for a user, called rl::runner::new. If you happen to call it for a user who already has a log, it returns the already created log. When I created the proc way back when, I also created an automated test to make sure that creation worked and that redundant calls returned the orignal log.

Over time, I added some code to make sure that users are given proper permissions on their log. Anytime you make a change, you should run your tests, but of course, I didn’t Well, today I did and my test now failed.

Here is the relevant (edited) code:

 set runner_id [db_nextval acs_object_id_seq] set ret_val [db_exec_plsql new_runner {}]  permission::grant -party_id $user_id -object_id $runner_id -privilege admin permission::grant -party_id $user_id -object_id $runner_id -privilege write 

The error was happening in permission::grant. It was complaining that $runner_id wasn’t a valid acs_object. What’s going on? It looks like it should work. The problem is that I should be granting the permission on ret_val, not on runner_id. (Probably a bad choice of variable names). The first time a log is created, db_exec_plsql returns a value which happens to be the same as runner_id. The second time it’s called, it returns a value which is different and permission::grant fails.

I would never have caught this error until I tried to call rl::runner::new the second time on the same user. Which would make it one of those very difficult to track bugs. Automated testing saved me a lot of annoying debugging.

That said, I wish OpenACS’s testing facilities were better. I worked on a couple other bugs today and I’m trying really hard to write tests to expose bugs before fixing them, but it’s really a strain. Especially when you need to do a combination of black box and white box testing. I’d like to make testing easier in OpenACS, but I’m not sure if I have the brainpower

I was looking at the Tcl 8.4 man page for ’split’ and saw this example code:

    ## Split into fields on colons    set fields [split $rec ":"]     ## Assign fields to variables and print some out...    lassign $fields \          userName password uid grp longName homeDir shell 

It shows how to split a string using ‘:’ as the delimiter. The interesting part is the ‘lassign’ statement. I’d never seen that before. I’ve always done something annoying like this:

    set fields [split $rec ":"]     set userName [lindex $fields 0]    set password [lindex $fields 1]    set uid [lindex $fields 2]    set grp [lindex $fields 3]    set longName [lindex $fields 4]    set homeDir [lindex $fields 5]    set shell [lindex $fields 6] 

How could I have overlooked ‘lassign’ all these years? After berating my idiocy for a few minutes, I tried ‘lassign’ out and Tcl replied ‘invalid command name’ . Turns out I’m not as stupid as I thought. ‘lassign’ is new in Tcl 8.5 (but seems to have snuck in the backdoor of the 8.4 docs). I decided to see what else was coming in 8.5.

• Dictionaries. These are associative arrays which reportedly are better than Tcl arrays, but I’m not sure why.
• ** as an exponentiation operator
• Instead of doing: if {[lsearch -exact $list $item] != -1}, the new ‘in’ operator lets you do if {$item in $list}. There’s also a ‘ni’ operator for ‘not in’.
• Plenty of other stuff, none of which really caught my eye.

Tcl 8.5 is still alpha, so I’m sticking with 8.4 (and my annoying code) for the moment.

The scripting language used in most of OpenACS is Tcl. It doesn’t receive a lot of press. When people talk about scripting languages, they mean Perl or Python (and now Ruby). Tcl is not considered in the same category, but it should be. I’m not smart enough to explain why, but Salvatore Sanfilippo is and has written a gentle introduction to both the basic and powerful features of Tcl.

I created a very simple blog application using the OpenACS Content Repository (CR). When I say simple, I mean simple, probably to the point of being useless. I just wanted to try writing something as quickly as possible using the CR. Here’s a quick run-through of the code, in case it might help someone else understand how to use the CR. I’m not including much commentary; email me (or comment) if you’d like me to expound more.

blog.info

 <?xml version="1.0"?> <!-- Generated by the OpenACS Package Manager -->  <package key="blog" url="http://openacs.org/repository/apm/packages/blog" type="apm_application">     <package-name>Blog</package-name>     <pretty-plural>Blogs</pretty-plural>     <initial-install-p>f</initial-install-p>     <singleton-p>f</singleton-p>          <version name="0.1d" url="http://openacs.org/repository/download/apm/blog-0.1d.apm">         <owner url="mailto:admin@localhost">Admin User</owner>         <summary>A blog application.</summary>         <description format="text/html">A simple Blog application using the Content Repository.</description>         <maturity>0</maturity>          <provides url="blog" version="0.1d"/>         <requires url="acs-content-repository" version="5.2.2"/>          <callbacks>             <callback type="after-install"  proc="blog::apm::after_install"/>             <callback type="after-instantiate"  proc="blog::apm::after_instantiate"/>             <callback type="before-uninstantiate"  proc="blog::apm::before_uninstantiate"/>             <callback type="before-uninstall"  proc="blog::apm::before_uninstall"/>         </callbacks>         <parameters>         <!-- No version parameters -->         </parameters>      </version> </package>  

tcl/blog-apm-procs.tcl

 namespace eval blog::apm {}  ad_proc -private blog::apm::after_install {} {      Install the blog datamodel. } {     content::type::new -content_type blog_post \         -pretty_name "Blog Post" \         -pretty_plural "Blog Posts" \         -table_name "cr_blog_posts" \         -id_column "post_id" }  ad_proc -private blog::apm::after_instantiate {     -package_id } {     Setup one instance of a blog. Creates a content folder and associate     blog_posts with it. } {     set folder_id [content::folder::new \                        -name $package_id \                        -label "Blog Folder $package_id" \                        -package_id $package_id \                        -context_id $package_id]      content::folder::register_content_type \         -folder_id $folder_id \         -content_type "blog_post" \         -include_subtypes "t" }  ad_proc -private blog::apm::before_uninstantiate {     -package_id } {     Remove 1 instance of blog application. } {     set folder_id [blog::folder_id $package_id]     content::folder::delete -folder_id $folder_id -cascade_p t     content::type::delete -content_type blog_post \         -drop_children_p t \         -drop_table_p t }  ad_proc -private blog::apm::before_uninstall {} {     Drop the application. } {     content::type::delete -content_type blog_post \         -drop_children_p t \         -drop_table_p t } 

tcl/blog-procs.tcl

 namespace eval blog {}  ad_proc -public blog::folder_id {package_id} {     Return the CR folder_id associated with this package_id      @param package_id Current package_id } {     return [db_string get_folder_id "select folder_id from cr_folders where package_id=:package_id"] } 

www/index.tcl

 ad_page_contract {      List posts      @author Vinod Kurup [vinod@kurup.com]      @creation-date Tue Feb 14 20:56:24 2006      @cvs-id $Id:$ } { }  set package_id [ad_conn package_id]  db_multirow posts posts "   select i.item_id,           r.title,          r.content,          to_char(o.creation_date,'YYYY-MM-DD HH24:MI:SS') as creation_date,          o.creation_user     from cr_blog_posts p, cr_items i, cr_revisions r, acs_objects o    where i.item_id=o.object_id      and p.post_id=r.revision_id      and o.package_id=:package_id       and i.live_revision=p.post_id    order by creation_date desc" 

www/index.adp

 <master>  <p><a href="post/ae">Add Post</a></p>  <multiple name="posts">   <include src="../lib/one-post"             item_id="@posts.item_id@"             title="@posts.title@"             content="@posts.content@"             creation_user="@posts.creation_user@"             creation_date="@posts.creation_date@" /> </multiple> 

www/post/ae.tcl

 ad_page_contract {      Add or edit a post      @author Vinod Kurup [vinod@kurup.com]      @creation-date Tue Feb 14 20:39:39 2006      @cvs-id $Id:$ } {     item_id:integer,optional }  set package_id [ad_conn package_id] set user_id [ad_conn user_id] set ip_addr [ad_conn peeraddr]  permission::require_permission -object_id $package_id -privilege write  set context [list "Add/Edit Post"]  ad_form -name add_post -form {     item_id:key(t_acs_object_id_seq)     title:text(text)     content:text(textarea) } -select_query {     select r.title, r.content        from cr_items i, cr_revisions r       where i.item_id=:item_id         and i.live_revision=r.revision_id } -edit_data {     content::revision::new -item_id $item_id \         -title $title \         -content $content \         -package_id $package_id \         -is_live t      ns_returnredirect .. } -new_data {     content::item::new -name "Post $item_id" \         -item_id $item_id \         -creation_user $user_id \         -text $content \         -package_id $package_id \         -parent_id [blog::folder_id $package_id] \         -creation_ip $ip_addr \         -content_type "blog_post" \         -title $title      ns_returnredirect .. } 

www/post/ae.adp

 <master> <property name="title">Add/Edit Post</property> <property name="context">@context;noquote@</property>  <formtemplate id="add_post"></formtemplate> 

www/post/del.tcl

 ad_page_contract {      Delete a post      @author Vinod Kurup [vinod@kurup.com]      @creation-date Tue Feb 14 22:49:11 2006      @cvs-id $Id:$ } {     item_id:integer }  permission::require_permission -object_id $item_id -privilege write  content::item::delete -item_id $item_id  ns_returnredirect .. 

www/post/view.tcl

 ad_page_contract {      View one post      @author Vinod Kurup [vinod@kurup.com]      @creation-date Wed Feb 15 20:24:32 2006      @cvs-id $Id:$ } {     item_id:integer }  set package_id [ad_conn package_id] set package_url [ad_conn package_url]  db_0or1row post " select i.item_id,         r.title,        r.content,        to_char(o.creation_date,'YYYY-MM-DD HH24:MI:SS') as creation_date,        o.creation_user   from cr_blog_posts p, cr_items i, cr_revisions r, acs_objects o  where i.item_id=o.object_id    and p.post_id=r.revision_id    and o.package_id=:package_id     and i.live_revision=p.post_id    and i.item_id=:item_id"   set context [list $title] 

www/post/view.adp

 <master> <property name="context">@context;noquote@</property> <property name="title">@title@</property>  <include src="../../lib/one-post"           item_id="@item_id@"           title="@title@"           content="@content@"           creation_user="@creation_user@"           creation_date="@creation_date@" /> 

lib/one-post.tcl

 set package_url [ad_conn package_url]  set now [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]  set creation_date_pretty [util::age_pretty \                               -timestamp_ansi $creation_date \                               -sysdate_ansi $now]  set author [acs_community_member_link -user_id $creation_user] set write_p [permission::permission_p -object_id $item_id -privilege write] set perm_url [export_vars -base "${package_url}post/view" {item_id}] 

lib/one-post.adp

 <div class="post">   <h2><a href="@perm_url@">@title@</a></h2>   <p class="byline">     Posted by @author;noquote@     <span class="date">@creation_date_pretty@</span>   </p>   <div class="content">     @content;noquote@   </div>   <p class="actions">     <if @write_p@>      <a href="@package_url@post/ae?item_id=@item_id@">Edit</a> |     <a href="@package_url@post/del?item_id=@item_id@">Delete</a>     </if>   </p> </div> 

Notes

You’ll notice that there are no SQL datamodel files. Since I’m using the CR, all of the datamodel is created by using the CR TCL API (specifically content::type::new). This package is subsite aware meaning you can install apps on multiple subsites and the data in each subsite will remain isolated from other subsites. It should uninstall itself cleanly since I’ve written callbacks for before-uninstantiate and before-uninstall.

Like I said, this is very simplistic. You can create, read, update and delete posts, but that’s about it. No commenting. No tags or categories. No RSS feeds. No search. But, since we’ve used the CR as our base, I think it would be very easy to extend the app to do all those things. I’m going to work on that, just for fun, of course. Thanks to Dave Bauer for writing the TCL interface to the CR and for writing the wiki package which made me see the light about the benefits of using the CR.

I’ve been using emacs for 7 years and I just learned today that you can edit files as root while you’re logged into emacs as an unprivileged user. Using sudo, of course. The details are here.