Index: openacs-4/packages/dynamic-types/lib/templates/add.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/lib/templates/Attic/add.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/dynamic-types/lib/templates/add.adp 17 Feb 2005 15:03:12 -0000 1.1.2.1 @@ -0,0 +1,7 @@ + + @page_title@ + @header_stuff@ + @context@ + @focus@ + + \ No newline at end of file Index: openacs-4/packages/dynamic-types/lib/templates/add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/lib/templates/Attic/add.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/dynamic-types/lib/templates/add.tcl 17 Feb 2005 15:03:12 -0000 1.1.2.1 @@ -0,0 +1,44 @@ +ad_page_contract { + +} -query { + id_column:integer,notnull,optional +} -properties { + page_title + context + header_stuff + focus +} + +set user_id [ad_conn user_id] +set package_id [ad_conn package_id] + +permission::require_permission \ + -party_id $user_id \ + -object_id $package_id \ + -privilege "create" + +template::form::create add + +if {[info exists id_column] && $id_column ne ""} { + dtype::form::add_elements \ + -object_id $id_column \ + -form add +} else { + dtype::form::add_elements \ + -form add \ + -object_type __object_type +} +if {[template::form::is_submission add]} { + dtype::form::process \ + -object_id $id_column \ + -form add \ + -object_type __object_type +} + +set page_title "Add pretty_name" +set context [list $page_title] +set header_stuff "" +set focus "" + +ad_return_template + Index: openacs-4/packages/dynamic-types/sql/postgresql/metadata-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/sql/postgresql/metadata-create.sql,v diff -u -N -r1.2.2.1 -r1.2.2.2 --- openacs-4/packages/dynamic-types/sql/postgresql/metadata-create.sql 17 Feb 2005 03:12:37 -0000 1.2.2.1 +++ openacs-4/packages/dynamic-types/sql/postgresql/metadata-create.sql 17 Feb 2005 15:03:13 -0000 1.2.2.2 @@ -30,6 +30,8 @@ values (''email'', ''text''); insert into dtype_db_datatypes (datatype, db_type) values (''text'', ''text''); + insert into dtype_db_datatypes (datatype, db_type) + values (''string'', ''varchar(4000)''); raise notice ''Inserting standard widget metadata...''; Index: openacs-4/packages/dynamic-types/tcl/form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/tcl/form-procs.tcl,v diff -u -N -r1.2.2.1 -r1.2.2.2 --- openacs-4/packages/dynamic-types/tcl/form-procs.tcl 17 Feb 2005 03:12:37 -0000 1.2.2.1 +++ openacs-4/packages/dynamic-types/tcl/form-procs.tcl 17 Feb 2005 15:03:13 -0000 1.2.2.2 @@ -1,3 +1,4 @@ + ad_library { A library of functions to generate forms for acs_objects from stored metadata. @@ -309,11 +310,22 @@ ns_log debug "PROCESSING: $attributes(name)" if {[info exists widgets($attributes(attribute_id))]} { ns_log debug "PROCESSING: found $attributes(name) in form" - # first check for the attribute in the submitted form - set crv_$attributes(name) [template::element::get_values \ + array set this_widget_info $widgets($attributes(attribute_id)) + switch $this_widget_info(widget) { + file {} + checkbox - + multiselect { + set crv_$attributes(name) [template::element::get_values \ + $form \ + ${prefix}$attributes(name)] + } + default { + set crv_$attributes(name) [template::element::get_value \ $form \ ${prefix}$attributes(name)] + } + } } elseif {[info exists default($attributes(name))]} { ns_log debug "PROCESSING: using supplied default for $attributes(name)" @@ -338,7 +350,6 @@ lappend missing_columns $attributes(column_name) } - if {![string equal [set crv_$attributes(name)] ""]} { lappend columns $attributes(column_name) @@ -624,13 +635,13 @@ file {} checkbox - multiselect { - return "-values $value" + return "-values \"$value\"" } date { return "-value {[template::util::date::from_ansi $value]}" } default { - return "-value $value" + return "-value \"$value\"" } } } Index: openacs-4/packages/dynamic-types/tcl/page-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/tcl/page-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/dynamic-types/tcl/page-procs.tcl 17 Feb 2005 15:03:13 -0000 1.1.2.1 @@ -0,0 +1,126 @@ +# + +ad_library { + + Procedures to generate tcl/adp pages for dynamic types + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + @arch-tag: 5f74a989-8a4f-4c28-8f8f-deb10e6f5a12 + @cvs-id $Id: page-procs.tcl,v 1.1.2.1 2005/02/17 15:03:13 daveb Exp $ +} + +namespace eval dtype::page:: {} + +ad_proc -public dtype::page::generate_pages { + -object_type + -package_key + {-overwrite "t"} + {-expand_form "t"} + {-pages {add}} +} { + Generate a set of add/edit/delete/index pages + for a dynamic type + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param object_type Object type to generate pages for + + @param package_key Package key of package to put pages under + + @param overwrite Overwrite existing pages? + + @return + + @error +} { + acs_object_type::get -object_type $object_type -array object_type_info + set id_column $object_type_info(id_column) + set pretty_name $object_type_info(pretty_name) + set dest [file join [acs_root_dir] packages dynamic-types lib ${object_type}] + if {![file exists $dest]} { + file mkdir $dest + } + foreach page $pages { + # generate add tcl page + set fd [open [tcl_template_path -page ${page}]] + set code [read $fd] + close $fd + regsub -all {id_column} $code $id_column code + regsub -all {pretty_name} $code $pretty_name code + regsub -all {__object_type} $code $object_type code + set fd [open [file join $dest ${page}.tcl] w] + puts $fd $code + close $fd + # generate add adp page + set fd [open [adp_template_path -page ${page}]] + set code [read $fd] + close $fd + if {$expand_form} { + set regexp "" + set result "[expand_form -object_type $object_type]" + regsub $regexp $code $result code + } + set fd [open [file join $dest ${page}.adp] w] + puts $fd $code + close $fd + } +} + +ad_proc -public dtype::page::tcl_template_path { + -page +} { + Path of templates + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param page + + @return + + @error +} { + return [file join [acs_root_dir] packages dynamic-types lib templates ${page}.tcl] +} + +ad_proc -public dtype::page::adp_template_path { + -page +} { + Path of templates + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param page + + @return + + @error +} { + return [file join [acs_root_dir] packages dynamic-types lib templates ${page}.adp] +} + +ad_proc -public dtype::page::expand_form { + -object_type +} { + + Generate adp for formtemplate + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param object_type + + @return + + @error +} { + set form_id __my_form + template::form::create $form_id + dtype::form::add_elements \ + -object_type $object_type \ + -form $form_id + return [template::form::template $form_id] +} Index: openacs-4/packages/dynamic-types/tcl/table-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/tcl/table-procs-postgresql.xql,v diff -u -N -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/dynamic-types/tcl/table-procs-postgresql.xql 17 Feb 2005 03:12:38 -0000 1.1.2.1 +++ openacs-4/packages/dynamic-types/tcl/table-procs-postgresql.xql 17 Feb 2005 15:03:13 -0000 1.1.2.2 @@ -15,11 +15,11 @@ - int4 integer varchar string boolean boolean numeric + int4 integer varchar text boolean boolean numeric number real number float number integer integer serial integer - money money date date timestamptz timestamp - "timestamp with time zone" timestamp - "timestamp without time zone" timestamp + money money date date timestamptz date + "timestamp with time zone" date + "timestamp without time zone" date "time without time zone" time_of_day "time with time zone" time_of_day time time_of_day "" enumeration "" url "" email "" keyword Index: openacs-4/packages/dynamic-types/tcl/table-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/tcl/table-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/dynamic-types/tcl/table-procs.tcl 17 Feb 2005 15:03:13 -0000 1.1.2.1 @@ -0,0 +1,203 @@ +# + +ad_library { + + Helper procs to infer type definition from a table definition + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + @arch-tag: 89c94863-0000-485f-a889-db6922a19187 + @cvs-id $Id: table-procs.tcl,v 1.1.2.1 2005/02/17 15:03:13 daveb Exp $ +} + +namespace eval dtype {} +namespace eval dtype::table {} + +ad_proc -public dtype::table::get_db_type_map { +} { + + List of database datatypes mapped to acs datatypes + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @return List of database_datatype acs_datatype pairs + + @error +} { + # TODO DAVEB check foreign keys to determine enumeration + # or keyword types? + return [db_map get_type_map] +} + +ad_proc -public dtype::table::get_table_array { + -table +} { + Get a list of columns and datatypes + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param table Name of table + + @return List in array get format of column name and datatype + + @error +} { + set cols_lists [db_list_of_lists get_cols ""] + set cols [list] + foreach l $cols_lists { + lappend cols [lindex $l 0] [lindex $l 1] + } + return $cols +} + +ad_proc -public dtype::table::pretty_name { + name +} { + + Generate a pretty name from database name + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param name Database name + + @return Pretty name + + @error +} { + # TODO make smarter + set name [string map {_ " "} $name] + set name [string totitle $name] + return $name +} + +ad_proc -public dtype::table::pretty_plural { + name +} { + + Generate a pretty plural name from database name + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param name Database name + + @return Pretty plural name + + @error +} { + # TODO make smarter + return [en_pl [pretty_name $name]] +} + +ad_proc -public dtype::table::id_column { + -table +} { + Get the name of the primary key column for the table + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param table Name of table + + @return Name of primary key column. If no primary key on this # + table, return empty string + + @error +} { + # TODO check if primary key is compound key + # since I have no idea how to map that to an object type! + return [db_string get_id_column "" -default ""] +} + +ad_proc -public dtype::table::supertype { + -table + -id_column +} { + Guess supertype from table definition. Find foreign key + constraint on primary key column + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-12 + + @param table Name of table + + @param id_column Primary key column + + @return Object type of supertype for table or empty string if none + + @error +} { + return [db_string get_supertype "" -default ""] +} + +ad_proc -public dtype::table::get_fk { + -table +} { + Get a list of foreign keys + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2005-02-14 + + @param table Name of table + + @return List of lists of foreign key information column name, + foreign key column name, foreign key table name, object_p where + object_p is true if foreign key table refers to an acs_object_type + + @error +} { + return [db_list_of_lists get_fk ""] +} + +ad_proc dtype::table::en_pl { + word +} { + Generate english plurals + From http://wiki.tcl.tk/2662 + + @param word Word to pluralize + + @return Plural form of word +} { + switch -- $word { + man {return men} + foot {return feet} + goose {return geese} + louse {return lice} + mouse {return mice} + ox {return oxen} + tooth {return teeth} + calf - elf - half - hoof - leaf - loaf - scarf + - self - sheaf - thief - wolf + {return [string range $word 0 end-1]ves} + knife - life - wife + {return [string range $word 0 end-2]ves} + auto - kangaroo - kilo - memo + - photo - piano - pimento - pro - solo - soprano - studio + - tattoo - video - zoo + {return ${word}s} + cod - deer - fish - offspring - perch - sheep - trout + - species + {return $word} + genus {return genera} + phylum {return phyla} + radius {return radii} + cherub {return cherubim} + mythos {return mythoi} + phenomenon {return phenomena} + formula {return formulae} + } + switch -regexp -- $word { + {[ei]x$} {return [string range $word 0 end-2]ices} + {[sc]h$} - {[soxz]$} {return ${word}es} + {[bcdfghjklmnprstvwxz]y$} {return [string range $word 0 end-1]ies} + {child$} {return ${word}ren} + {eau$} {return ${word}x} + {is$} {return [string range $word 0 end-2]es} + {woman$} {return [string range $word 0 end-2]en} + } + return ${word}s + }