Forum OpenACS Q&A: Using [Incr Tcl] to generate OpenACS code

I want to know if the OpenACS community would consider this useful enough to add to the repository. I'd also like to know if anybody else is doing any work similar to this.

I had some code which I've begun to adapt to generating OpenACS code. Specifically, it:

Generates the package-create.sql script including:
- create and call the function to call acs_object_type__create_type
- create the table, including foreign key references
- create object__new and object__delete functions.
Generates the package-drop.sql script.
Generates an add-edit.tcl page including the calls to ad_page_contract and all the calls to create a form, ala the notes package, including calls to template::element create for all the columns in the table.

I wrote this (actually re-purposed some old code) because I've spent hours chasing down stupid problems where a comma or a single quote was missing somewhere. I also hate repetitive work. This approach eliminates that problem completely, giving the novice or experienced OpenACS programmer a jumpstart on application development. A single Tcl script is given all the information needed in a compact form, and is able to generate all of the above items correctly. Then you can customize as you desire.

I was working on a "promises" table, and used that to write and debug the code generator. Here's what the definition of my new object for OpenACS looks like:

First, create the attributes:

ACS_Object_Id   promise_id
IntData         owner_id        -references {user user_id}
IntData         promisor        -references {person person_id} 
				-useselect 1 
                                -title "Promised by"
DateData        promise_made
DateData        promise_due
IntData         promise_to      -references {party party_id} 
				-useselect 1 
                                -optionselect {select party_name, 
				    party_id
                                    from party_names 
                                    where party_name is not null}
TextData        promise_what
TextData        promise_status  -widget select -options 
                                {{Incomplete I} {Complete C} {Revoked
R}}

TextData        promise_notes

Now, create the table object:

Table Promise -colnames [list 
            promise_id owner_id promisor promise_made promise_due 
            promise_to promise_what promise_status promise_notes]

To generate code, basically what is done is, start the tool, source in the above code, then execute one of these methods in the Promise object:

Promise acs_create_sql
Promise acs_create_form
Promise acs_drop_sql

Each returns a script. Here are the results:

promise-create.sql

create function promises_0 ()
returns integer as '
begin
    PERFORM acs_object_type__create_type (
        ''promise'',            -- object_type
        ''Promise'',    -- pretty_name
        ''Promises'',   -- pretty_plural
        ''acs_object'',         -- supertype
        ''promises'',   -- table_name
        ''promise_id'', -- id_column
        null,   -- package_name
        ''f'',  -- abstract_p
        null,   -- type_extension_table
        ''promise__name''       -- name_method
        );
    return 0;
end;' language 'plpgsql';

select promises_0 ();

drop function promises_0 ();

create table promises (
        promise_id integer primary key references
acs_objects(object_id),
        owner_id integer references users(user_id),
        promisor integer references persons(person_id),
        promise_made date,
        promise_due date,
        promise_to integer references parties(party_id),
        promise_what text,
        promise_status text,
        promise_notes text
);

create or replace function promise__new
(integer,integer,integer,date,date,integer,varchar,varchar,varchar,timestamp,integer,varchar,integer)
returns integer as '
declare
  p_promise_id          alias for $1;
  p_owner_id            alias for $2;
  p_promisor            alias for $3;
  p_promise_made                alias for $4;
  p_promise_due         alias for $5;
  p_promise_to          alias for $6;
  p_promise_what                alias for $7;
  p_promise_status              alias for $8;
  p_promise_notes               alias for $9;
  p_creation_date                       alias for $10;
  p_creation_user                       alias for $11;
  p_creation_ip                 alias for $12;
  p_context_id                  alias for $13;

  v_promise_id          promises.promise_id%TYPE;

begin
        v_promise_id := acs_object__new (
                p_promise_id,
                ''promise'',
                p_creation_date,
                p_creation_user,
                p_creation_ip,
                p_context_id
        );

        insert into promises
          (promise_id, owner_id, promisor, promise_made, promise_due,
promise_to, promise_what, promise_status, promise_notes)
        values
          (v_promise_id, p_owner_id, p_promisor, p_promise_made,
p_promise_due, p_promise_to, p_promise_what, p_promise_status,
p_promise_notes);

        raise NOTICE ''Creating promise'';
        return v_promise_id;

end;' language 'plpgsql';

create or replace function promise__delete (integer)
returns integer as '
declare
  p_promise_id                             alias for $1;
begin
        delete from acs_permissions
                where object_id = p_promise_id;

        delete from depts
                where promise_id = p_promise_id;

        raise NOTICE ''Deleting promise...'';
        PERFORM acs_object__delete(p_promise_id);

        return 0;

end;' language 'plpgsql';

add-edit.tcl

ad_page_contract {

  @author randy@randallkunkee.com
  @creation-date 2002-06-06
  @cvs-id $Id$
} {
        promise_id:integer,optional
        {owner_id:integer {}}
        {promisor:integer {}}
        {promise_made:date {}}
        {promise_due:date {}}
        {promise_to:integer {}}
        {promise_what {}}
        {promise_status {}}
        {promise_notes {}}
} -properties {
        context_bar:onevalue
}

set package_id [ad_conn package_id]

if {[info exists promise_id]} {
        ad_require_permission $promise_id write

        set context_bar [ad_context_bar Centers "Edit Center"]
} else {
        ad_require_permission $package_id write

        set context_bar [ad_context_bar Centers "New Center"]
}

template::form create promise_form

if {[template::form is_request promise_form] && [info exists
promise_id]} {

  template::element create promise_form promise_id 
      -widget hidden 
      -datatype integer 
      -value $promise_id

  db_1row promise_select {
    select *
    from promises
    where promise_id = :promise_id
  }
}


template::element create promise_form owner_id
    -datatype integer
    -label {Owner id}
    -value $owner_id

template::element create promise_form promisor
    -widget select
    -datatype integer
    -label {Promised by}
    -options [db_list_of_lists promise_form_promisor_options {select
person__name(person_id),person_id from persons}]
    -value $promisor

template::element create promise_form promise_made
    -datatype date
    -label {Promise made}
    -value $promise_made

template::element create promise_form promise_due
    -datatype date
    -label {Promise due}
    -value $promise_due

template::element create promise_form promise_to
    -widget select
    -datatype integer
    -label {Promise to}
    -options [db_list_of_lists promise_form_promise_to_options {select
party_name, party_id from party_names  where party_name is not null}]
    -value $promise_to

template::element create promise_form promise_what
    -datatype text
    -label {Promise what}
    -value $promise_what

template::element create promise_form promise_status
    -widget select
    -datatype text
    -label {Promise status}
    -options {{Incomplete I} {Complete C} {Revoked R}}
    -value $promise_status

template::element create promise_form promise_notes
    -datatype text
    -label {Promise notes}
    -value $promise_notes
if [template::form is_valid promise_form] {
  set user_id [ad_conn user_id]
  set peeraddr [ad_conn peeraddr]

  if [info exists promise_id] {
    db_dml promise_update {
      update promises set
                owner_id = :owner_id,
                promisor = :promisor,
                promise_made = :promise_made,
                promise_due = :promise_due,
                promise_to = :promise_to,
                promise_what = :promise_what,
                promise_status = :promise_status,
                promise_notes = :promise_notes
      where promise_id = :promise_id
    }
  } else {
      set promise_id [db_null]
      db_1row new_promise {select promise__new(
        :promise_id,
        :owner_id,
        :promisor,
        :promise_made,
        :promise_due,
        :promise_to,
        :promise_what,
        :promise_status,
        :promise_notes,
        now(),
        :user_id,
        :peeraddr,
        :package_id);}
  }
  ad_returnredirect "."
}

promise-drop.sql


-- promises
-- drop script
--

--drop functions
drop function promise__new
(integer,integer,integer,date,date,integer,varchar,varchar,varchar,timestamp,integer,varchar,integer);
drop function promise__delete (integer);

--drop permissions
delete from acs_permissions where object_id in (select promise_id from
promises);

--drop objects
create function inline_0 ()
returns integer as '
declare
        object_rec              record;
begin
        for object_rec in select object_id from acs_objects where
object_type=''promise''
        loop
                perform acs_object__delete( object_rec.object_id );
        end loop;

        return 0;
end;' language 'plpgsql';

select inline_0();
drop function inline_0();

--drop table
drop table promises;

-- drop attributes

--drop type
select acs_object_type__drop_type(
           'promise',
           't'
);

The above code nearly works out of the box. In in fact, you should get a nice form, provided you write an add-edit.adp. My understanding of how to use the date widget is lacking and my implementation doesn't work. Nevertheless, I think this is very useful stuff.

Some shortcomings, or things it doesn't handle well (at least not yet) are:

The class names are still the old names from the old tool. A better version would be updated to use OpenACS datatypes as defined in the templating system.
It needs more compatibility with acs_templates. For example, they use -label and I use -title. There's no reason for a difference, I just haven't changed that yet.
It doesn't generate the individual attribute types, only the object type.
It calls acs_object_type__create_type with a name_method parameter, but it doesn't write one.
It runs completely outside of the web server (it needs Itcl). A later one might run using nsd, allowing the existing base of object and attribute types to be automatically loaded, and thus render code based on that.
It assumes that all tables have a table_name__new function that returns a name of an object given its object_id, which is certainly not always true.
It doesn't do anything about permissions.
It doesn't generate the .adp file. I don't see that it ever will.
It doesn't generate portable SQL, only Postgresql code at this point. For example, I call db_1row to execute the table_name__new function. Pushing queries into .xql files can be added by the programmer later. At my level of experience with how those work, I waste a lot of time trying to do this up front.
There may be places where I should be doing things differently. For example, in my call to acs_object__new, I've hard-coded the type, when it may well be that it should be soft-coded, so that sub-types of my objects could be created. Here I at the limits of my present understanding of the OpenACS object model.
My understanding of how to use the date widget is lacking and my implementation doesn't work.

If anybody wants this code, contact me and I'll put it on-line somehow (or someone tell me how to upload it to the OpenACS website).