Index: openacs-4/contrib/packages/simulation/sql/postgresql/simulation-content-types-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/sql/postgresql/Attic/simulation-content-types-create.sql,v
diff -u -r1.5 -r1.6
--- openacs-4/contrib/packages/simulation/sql/postgresql/simulation-content-types-create.sql 27 Oct 2003 07:31:55 -0000 1.5
+++ openacs-4/contrib/packages/simulation/sql/postgresql/simulation-content-types-create.sql 31 Oct 2003 08:43:15 -0000 1.6
@@ -38,6 +38,16 @@
'integer constraint sim_char_stylesheet_fk references cr_items' -- column_spec
);
+select content_type__register_relation_type (
+ 'sim_character', -- content_type
+ 'image', -- target_type
+ 'image', -- relation_tag
+ 0, -- min_n
+ 10 -- max_n
+);
+
+
+
-- sim_prop
select content_type__create_type(
Index: openacs-4/contrib/packages/simulation/www/object-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/www/Attic/object-edit.tcl,v
diff -u -r1.13 -r1.14
--- openacs-4/contrib/packages/simulation/www/object-edit.tcl 29 Oct 2003 18:48:09 -0000 1.13
+++ openacs-4/contrib/packages/simulation/www/object-edit.tcl 31 Oct 2003 08:43:15 -0000 1.14
@@ -9,6 +9,9 @@
{content_type {sim_prop}}
}
+# TODO: Joel will do something about this?
+auth::require_login
+
#---------------------------------------------------------------------
# Determine if we are in edit mode or display mode
#---------------------------------------------------------------------
@@ -88,28 +91,198 @@
}
}
+
+
#---------------------------------------------------------------------
-# Content edit/upload method
+# Define meta data for the content types and their attributes.
+#---------------------------------------------------------------------
+
+# Define the metadata in an easy format
+set content_metadata {
+ sim_character {
+ content_method richtext
+ attributes {
+ stylesheet {
+ references sim_stylesheet
+ }
+ }
+ relations {
+ image {
+ label "Image"
+ section "Related Images"
+ }
+ }
+ }
+ sim_home {
+ content_method richtext
+ attributes {
+ stylesheet {
+ references sim_stylesheet
+ }
+ }
+ }
+ sim_prop {
+ content_method richtext
+ attributes {
+ stylesheet {
+ references sim_stylesheet
+ }
+ }
+ }
+ sim_stylesheet {
+ content_method textarea
+ mime_type text/css
+ }
+ image {
+ content_method upload
+ }
+}
+
+
+# Terminology:
#
-# Add a form widget appropriate for the content attribute of the object type
+# content_type , property
+# e.g. sim_character, content_method
+#
+# content_type , entry_type, entry , property
+# e.g. sim_character, attributes, stylesheet, references
+
+
#---------------------------------------------------------------------
+# Make metadata more accessible. Should go into library.
+#---------------------------------------------------------------------
-array set content_method {
- sim_character richtext
- sim_home richtext
- sim_prop richtext
- sim_stylesheet textarea
- image upload
+# Now munge the above spec into something more efficient to use
+array set content_metadata_struct [list]
+foreach { ct ct_spec } $content_metadata {
+ foreach { prop prop_spec } $ct_spec {
+ switch $prop {
+ attributes - relations {
+ # Property with sub-properties.
+ # Has an entry for each attribute/relation/whatever, which then contains properties
+ foreach { sub sub_spec } $prop_spec {
+
+ # Mark the entry as present, even if it doesn't have any properties
+ nsv_set content_metadata_struct $ct,$prop,$sub {}
+
+ foreach { sub_prop sub_prop_spec } $sub_spec {
+ # key is content_type,attributes,attribute_name,property
+ nsv_set content_metadata_struct $ct,$prop,$sub,$sub_prop $sub_prop_spec
+ }
+ }
+ }
+ default {
+ # Single value
+ # key is content_type,property
+ nsv_set content_metadata_struct $ct,$prop $prop_spec
+ }
+ }
+ }
}
-array set content_mime_type {
- sim_stylesheet text/css
+# Define a helper proc to make it easier to get metadata properties
+ad_proc get_metadata_property {
+ -content_type:required
+ -property:required
+ -entry_type
+ -entry
+ {-default ""}
+} {
+ Get a metadata property for either a content_type or the attribute of a content_type.
+} {
+ if { [exists_and_not_null entry_type] && [exists_and_not_null entry] } {
+ set key $content_type,$entry_type,$entry,$property
+ } else {
+ set key $content_type,$property
+ }
+ if { [nsv_exists content_metadata_struct $key] } {
+ return [nsv_get content_metadata_struct $key]
+ } else {
+ return $default
+ }
}
-if { ![info exists content_method($content_type)] } {
- set content_method($content_type) "richtext"
+ad_proc get_metadata_entries {
+ -content_type:required
+ -entry_type:required
+ {-default ""}
+} {
+ Get a list of entries inside the metadata. E.g. to get the attributes with metadata for a content_type, say
+ get_metadata_keys -content_type $content_type -entry attributes
+} {
+ set key $content_type,$entry_type
+
+ set result [list]
+ set skip_len [expr [string length $key]+1]
+ foreach name [nsv_array names content_metadata_struct $key,*] {
+ # The part of name after the key
+ set extra_name [string range $name $skip_len end]
+
+ # Get the part up to the next comma
+ set one_entry [lindex [split $extra_name ,] 0]
+ if { [lsearch -exact $result $one_entry] == -1 } {
+ lappend result $one_entry
+ }
+ }
+ return $result
}
-switch $content_method($content_type) {
+
+ad_proc get_object_type_options {
+ -object_type:required
+ {-null_label "--None--"}
+} {
+ Get options for a select/radio widget of available objects of a given object_type.
+ Deals with content_types as a special-case where it'll provide a drop-down of items,
+ not revisions.
+} {
+ # We need to know if this is a CR content_type, because in that case we
+ # want to reference the item corresponding to the revision, not the revision
+ set content_type_p [db_string content_type_p {
+ select count(*)
+ from acs_object_type_supertype_map
+ where object_type = :object_type
+ and ancestor_type = 'content_revision'
+ }]
+
+ # LARS TODO: We need to be able to scope this to a package,
+ # possibly filter by other things, control the sort order,
+ # we need to be able to control what the label looks like (e.g. include email for users)
+ # and it needs to be intelligent about scaling issues
+ if { $content_type_p } {
+ set options [db_list_of_lists select_options {
+ select r.title,
+ i.item_id
+ from cr_items i, cr_revisions r
+ where i.content_type = :object_type
+ and r.revision_id = i.live_revision
+ order by r.title
+ }]
+ } else {
+ set options [db_list_of_lists select_options {
+ select acs_object__name(object_id),
+ object_id
+ from acs_objects
+ where object_type = :object_type
+ order by acs_object__name(object_id)
+ }]
+ }
+
+ if { ![empty_string_p $null_label] } {
+ set options [concat [list [list $null_label {}]] $options]
+ }
+
+ return $options
+}
+
+
+#---------------------------------------------------------------------
+# Content edit/upload method
+#
+# Add a form widget appropriate for the content attribute of the object type
+#---------------------------------------------------------------------
+
+set content_method [get_metadata_property -content_type $content_type -property content_method -default richtext]
+switch $content_method {
richtext {
ad_form -extend -name object -form {
{content_elm:richtext(richtext),optional
@@ -134,7 +307,7 @@
}
}
default {
- error "The '$content_method($content_type)' content input method has not yet been implemented"
+ error "The '$content_method' content input method has not yet been implemented"
}
}
@@ -146,6 +319,11 @@
# LARS: I'm doing this as a proof-of-concept type thing. If it works well
# enough for us, we'll want to generalize and move into acs-content-repository
+
+#---------------------------------------------------------------------
+# Internal data structures used for automated form generation. To be moved to library.
+#---------------------------------------------------------------------
+
array set form_datatype {
string text
boolean text
@@ -202,17 +380,11 @@
keyword {}
}
-array set form_references {
- sim_character.stylesheet sim_stylesheet
- sim_home.stylesheet sim_stylesheet
- sim_prop.stylesheet sim_stylesheet
-}
-
set attr_names [list]
#---------------------------------------------------------------------
-# database access for attributes
+# Select attributes and add them to the form
#---------------------------------------------------------------------
db_foreach select_attributes {
@@ -231,42 +403,10 @@
set elm_optional_p 1
set extra $form_extra($datatype)
- if { [exists_and_not_null form_references(${content_type}.${attribute_name})] } {
+ set elm_ref_type [get_metadata_property -content_type $content_type -entry_type attributes -entry $attribute_name -property references]
+ if { ![empty_string_p $elm_ref_type] } {
set elm_widget select
- set elm_ref_type $form_references(${content_type}.${attribute_name})
-
- # LARS TODO: We need to be able to scope this to a package,
- # possibly filter by other things, control the sort order,
- # we need to be able to control what the label looks like (e.g. include email for users)
- # and it needs to be intelligent about scaling issues
-
- set content_type_p [db_string content_type_p {
- select count(*)
- from acs_object_type_supertype_map
- where object_type = :elm_ref_type
- and ancestor_type = 'content_revision'
- }]
-
- if { $content_type_p } {
- set options [db_list_of_lists select_options {
- select r.title,
- i.item_id
- from cr_items i, cr_revisions r
- where i.content_type = :elm_ref_type
- and r.revision_id = i.live_revision
- order by r.title
- }]
- } else {
- set options [db_list_of_lists select_options {
- select acs_object__name(object_id),
- object_id
- from acs_objects
- where object_type = :elm_ref_type
- order by acs_object__name(object_id)
- }]
- }
-
- set options [concat {{{--None--} {}}} $options]
+ set options [get_object_type_options -object_type $elm_ref_type]
lappend extra { options \$options }
}
@@ -280,23 +420,62 @@
}
+#---------------------------------------------------------------------
+# Related objects
+#---------------------------------------------------------------------
+
+set rel_elements [list]
+db_foreach select_relations {
+ select target_type,
+ relation_tag,
+ min_n,
+ max_n
+ from cr_type_relations
+ where content_type = :content_type
+ order by relation_tag
+} {
+ set label [get_metadata_property -content_type $content_type -entry_type relations -entry $relation_tag -property label]
+ set section [get_metadata_property -content_type $content_type -entry_type relations -entry $relation_tag -property section]
+ set options [get_object_type_options -object_type $target_type]
+
+ # LARS HACK: This only works for a specific hard-coded max_n
+ # We need to generalize so it can be dynamic
+
+ for { set counter 1 } { $counter <= $max_n } { incr counter } {
+ set elm_name "rel__${relation_tag}__$counter"
+ lappend rel_elements $elm_name
+ set elm_label "$label $counter"
+
+ ad_form -extend -name object -form \
+ [list \
+ [list $elm_name:integer(select),optional \
+ {label $elm_label} \
+ {section $section} \
+ {options $options} \
+ {html {onChange "javascript:FormRefresh('object');"}} \
+ ] \
+ ]
+ }
+}
+
+
+#---------------------------------------------------------------------
+# Define the form
+#---------------------------------------------------------------------
+
ad_form -extend -name object -new_request {
# Set element values from local vars
} -on_submit {
- switch $content_method($content_type) {
+ switch $content_method {
richtext {
set content_text [template::util::richtext::get_property contents $content_elm]
set mime_type [template::util::richtext::get_property format $content_elm]
set storage_type text
}
textarea {
set content_text $content_elm
- if { [exists_and_not_null content_mime_type($content_type)] } {
- set mime_type $content_mime_type($content_type)
- } else {
- set mime_type "text/plain"
- }
+ set mime_type [get_metadata_property -content_type $content_type -property mime_type -default "text/plain"]
set storage_type text
}
upload {
@@ -314,7 +493,7 @@
}
}
default {
- error "The '$content_method($content_type)' content input method has not yet been implemented"
+ error "The '$content_method' content input method has not yet been implemented"
}
}
@@ -342,13 +521,14 @@
db_transaction {
set item_id [bcms::item::create_item \
+ -item_id $item_id \
-item_name $name \
-parent_id $parent_id \
-content_type $content_type \
-storage_type $storage_type]
- switch $content_method($content_type) {
+ switch $content_method {
upload {
set revision_id [bcms::revision::upload_file_revision \
-item_id $item_id \
@@ -373,6 +553,21 @@
bcms::revision::set_revision_status \
-revision_id $revision_id \
-status "live"
+
+ foreach elm $rel_elements {
+ # LARS HACK ALERT: This isn't a particularly pretty way to find all the related objects in the form
+ regexp {__(.+)__} $elm match relation_tag
+ regexp {__.+__(.+)$} $elm match order_n
+ set related_object_id [set $elm]
+
+ if { ![empty_string_p $related_object_id] } {
+ bcms::item::relate_item \
+ -relation_type $relation_tag \
+ -item_id $item_id \
+ -related_object_id $related_object_id \
+ -order_n $order_n
+ }
+ }
}
} -edit_request {
@@ -387,19 +582,30 @@
set attr__${content_type}__${attribute_name} $content($attribute_name)
}
- switch $content_method($content_type) {
+ switch $content_method {
richtext {
set content_elm [template::util::richtext::create $content(text) $content(mime_type)]
}
textarea {
set content_elm $content(text)
}
}
+
+ db_foreach related_objects {
+ select related_object_id,
+ relation_tag,
+ order_n
+ from cr_item_rels
+ where item_id = :item_id
+ } {
+ set "rel__${relation_tag}__${order_n}" $related_object_id
+ }
+
} -edit_data {
db_transaction {
- switch $content_method($content_type) {
+ switch $content_method {
upload {
set revision_id [bcms::revision::upload_file_revision \
-item_id $item_id \
@@ -424,9 +630,59 @@
bcms::revision::set_revision_status \
-revision_id $revision_id \
-status "live"
+
+ # LARS: The way we do this update is not very pretty: Delete all relations and re-add the new ones
+ db_dml delete_all_relations {
+ delete from cr_item_rels
+ where item_id = :item_id
+ }
+
+ foreach elm $rel_elements {
+ # LARS HACK ALERT: This isn't a particularly pretty way to find all the related objects in the form
+ regexp {__(.+)__} $elm match relation_tag
+ regexp {__.+__(.+)$} $elm match order_n
+ set related_object_id [set $elm]
+
+ ns_log Notice "LARS: $elm - $related_object_id"
+
+ if { ![empty_string_p $related_object_id] } {
+ bcms::item::relate_item \
+ -relation_type $relation_tag \
+ -item_id $item_id \
+ -related_object_id $related_object_id \
+ -order_n $order_n
+ }
+ }
}
} -after_submit {
ad_returnredirect object-list
ad_script_abort
}
+
+
+# LARS: This is a hack to get to execute code on every request, instead of only in certain cases
+# The only time we don't want this is when we
+
+foreach elm $rel_elements {
+ set elm_before_html {}
+
+ if { [exists_and_not_null $elm] } {
+ set related_object_id [set $elm]
+
+ set rel_obj_name [db_string name { select name from cr_items where item_id = :related_object_id } -default {}]
+ if { ![empty_string_p $rel_obj_name] } {
+ set thumb_url [export_vars -base "object-content/$rel_obj_name"]
+ append elm_before_html {
}
+ append elm_before_html { }
+ append elm_before_html {
}
+ }
+ } else {
+ append elm_before_html {
}
+ append elm_before_html { }
+ append elm_before_html {}
+ }
+ append elm_before_html { Choose:}
+
+ element set_properties object $elm -before_html $elm_before_html
+}
Index: openacs-4/contrib/packages/simulation/www/object-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/www/Attic/object-list.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/contrib/packages/simulation/www/object-list.tcl 29 Oct 2003 18:48:09 -0000 1.8
+++ openacs-4/contrib/packages/simulation/www/object-list.tcl 31 Oct 2003 08:43:15 -0000 1.9
@@ -74,7 +74,7 @@
set delete_url [export_vars -base "object-delete" { item_id }]
switch -glob $mime_type {
- text/* {
+ text/* - {} {
set view_url [export_vars -base "object/$name"]
}
default {
Index: openacs-4/packages/simulation/sql/postgresql/simulation-content-types-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/sql/postgresql/simulation-content-types-create.sql,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/simulation/sql/postgresql/simulation-content-types-create.sql 27 Oct 2003 07:31:55 -0000 1.5
+++ openacs-4/packages/simulation/sql/postgresql/simulation-content-types-create.sql 31 Oct 2003 08:43:15 -0000 1.6
@@ -38,6 +38,16 @@
'integer constraint sim_char_stylesheet_fk references cr_items' -- column_spec
);
+select content_type__register_relation_type (
+ 'sim_character', -- content_type
+ 'image', -- target_type
+ 'image', -- relation_tag
+ 0, -- min_n
+ 10 -- max_n
+);
+
+
+
-- sim_prop
select content_type__create_type(
Index: openacs-4/packages/simulation/www/object-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/www/Attic/object-edit.tcl,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/simulation/www/object-edit.tcl 29 Oct 2003 18:48:09 -0000 1.13
+++ openacs-4/packages/simulation/www/object-edit.tcl 31 Oct 2003 08:43:15 -0000 1.14
@@ -9,6 +9,9 @@
{content_type {sim_prop}}
}
+# TODO: Joel will do something about this?
+auth::require_login
+
#---------------------------------------------------------------------
# Determine if we are in edit mode or display mode
#---------------------------------------------------------------------
@@ -88,28 +91,198 @@
}
}
+
+
#---------------------------------------------------------------------
-# Content edit/upload method
+# Define meta data for the content types and their attributes.
+#---------------------------------------------------------------------
+
+# Define the metadata in an easy format
+set content_metadata {
+ sim_character {
+ content_method richtext
+ attributes {
+ stylesheet {
+ references sim_stylesheet
+ }
+ }
+ relations {
+ image {
+ label "Image"
+ section "Related Images"
+ }
+ }
+ }
+ sim_home {
+ content_method richtext
+ attributes {
+ stylesheet {
+ references sim_stylesheet
+ }
+ }
+ }
+ sim_prop {
+ content_method richtext
+ attributes {
+ stylesheet {
+ references sim_stylesheet
+ }
+ }
+ }
+ sim_stylesheet {
+ content_method textarea
+ mime_type text/css
+ }
+ image {
+ content_method upload
+ }
+}
+
+
+# Terminology:
#
-# Add a form widget appropriate for the content attribute of the object type
+# content_type , property
+# e.g. sim_character, content_method
+#
+# content_type , entry_type, entry , property
+# e.g. sim_character, attributes, stylesheet, references
+
+
#---------------------------------------------------------------------
+# Make metadata more accessible. Should go into library.
+#---------------------------------------------------------------------
-array set content_method {
- sim_character richtext
- sim_home richtext
- sim_prop richtext
- sim_stylesheet textarea
- image upload
+# Now munge the above spec into something more efficient to use
+array set content_metadata_struct [list]
+foreach { ct ct_spec } $content_metadata {
+ foreach { prop prop_spec } $ct_spec {
+ switch $prop {
+ attributes - relations {
+ # Property with sub-properties.
+ # Has an entry for each attribute/relation/whatever, which then contains properties
+ foreach { sub sub_spec } $prop_spec {
+
+ # Mark the entry as present, even if it doesn't have any properties
+ nsv_set content_metadata_struct $ct,$prop,$sub {}
+
+ foreach { sub_prop sub_prop_spec } $sub_spec {
+ # key is content_type,attributes,attribute_name,property
+ nsv_set content_metadata_struct $ct,$prop,$sub,$sub_prop $sub_prop_spec
+ }
+ }
+ }
+ default {
+ # Single value
+ # key is content_type,property
+ nsv_set content_metadata_struct $ct,$prop $prop_spec
+ }
+ }
+ }
}
-array set content_mime_type {
- sim_stylesheet text/css
+# Define a helper proc to make it easier to get metadata properties
+ad_proc get_metadata_property {
+ -content_type:required
+ -property:required
+ -entry_type
+ -entry
+ {-default ""}
+} {
+ Get a metadata property for either a content_type or the attribute of a content_type.
+} {
+ if { [exists_and_not_null entry_type] && [exists_and_not_null entry] } {
+ set key $content_type,$entry_type,$entry,$property
+ } else {
+ set key $content_type,$property
+ }
+ if { [nsv_exists content_metadata_struct $key] } {
+ return [nsv_get content_metadata_struct $key]
+ } else {
+ return $default
+ }
}
-if { ![info exists content_method($content_type)] } {
- set content_method($content_type) "richtext"
+ad_proc get_metadata_entries {
+ -content_type:required
+ -entry_type:required
+ {-default ""}
+} {
+ Get a list of entries inside the metadata. E.g. to get the attributes with metadata for a content_type, say
+ get_metadata_keys -content_type $content_type -entry attributes
+} {
+ set key $content_type,$entry_type
+
+ set result [list]
+ set skip_len [expr [string length $key]+1]
+ foreach name [nsv_array names content_metadata_struct $key,*] {
+ # The part of name after the key
+ set extra_name [string range $name $skip_len end]
+
+ # Get the part up to the next comma
+ set one_entry [lindex [split $extra_name ,] 0]
+ if { [lsearch -exact $result $one_entry] == -1 } {
+ lappend result $one_entry
+ }
+ }
+ return $result
}
-switch $content_method($content_type) {
+
+ad_proc get_object_type_options {
+ -object_type:required
+ {-null_label "--None--"}
+} {
+ Get options for a select/radio widget of available objects of a given object_type.
+ Deals with content_types as a special-case where it'll provide a drop-down of items,
+ not revisions.
+} {
+ # We need to know if this is a CR content_type, because in that case we
+ # want to reference the item corresponding to the revision, not the revision
+ set content_type_p [db_string content_type_p {
+ select count(*)
+ from acs_object_type_supertype_map
+ where object_type = :object_type
+ and ancestor_type = 'content_revision'
+ }]
+
+ # LARS TODO: We need to be able to scope this to a package,
+ # possibly filter by other things, control the sort order,
+ # we need to be able to control what the label looks like (e.g. include email for users)
+ # and it needs to be intelligent about scaling issues
+ if { $content_type_p } {
+ set options [db_list_of_lists select_options {
+ select r.title,
+ i.item_id
+ from cr_items i, cr_revisions r
+ where i.content_type = :object_type
+ and r.revision_id = i.live_revision
+ order by r.title
+ }]
+ } else {
+ set options [db_list_of_lists select_options {
+ select acs_object__name(object_id),
+ object_id
+ from acs_objects
+ where object_type = :object_type
+ order by acs_object__name(object_id)
+ }]
+ }
+
+ if { ![empty_string_p $null_label] } {
+ set options [concat [list [list $null_label {}]] $options]
+ }
+
+ return $options
+}
+
+
+#---------------------------------------------------------------------
+# Content edit/upload method
+#
+# Add a form widget appropriate for the content attribute of the object type
+#---------------------------------------------------------------------
+
+set content_method [get_metadata_property -content_type $content_type -property content_method -default richtext]
+switch $content_method {
richtext {
ad_form -extend -name object -form {
{content_elm:richtext(richtext),optional
@@ -134,7 +307,7 @@
}
}
default {
- error "The '$content_method($content_type)' content input method has not yet been implemented"
+ error "The '$content_method' content input method has not yet been implemented"
}
}
@@ -146,6 +319,11 @@
# LARS: I'm doing this as a proof-of-concept type thing. If it works well
# enough for us, we'll want to generalize and move into acs-content-repository
+
+#---------------------------------------------------------------------
+# Internal data structures used for automated form generation. To be moved to library.
+#---------------------------------------------------------------------
+
array set form_datatype {
string text
boolean text
@@ -202,17 +380,11 @@
keyword {}
}
-array set form_references {
- sim_character.stylesheet sim_stylesheet
- sim_home.stylesheet sim_stylesheet
- sim_prop.stylesheet sim_stylesheet
-}
-
set attr_names [list]
#---------------------------------------------------------------------
-# database access for attributes
+# Select attributes and add them to the form
#---------------------------------------------------------------------
db_foreach select_attributes {
@@ -231,42 +403,10 @@
set elm_optional_p 1
set extra $form_extra($datatype)
- if { [exists_and_not_null form_references(${content_type}.${attribute_name})] } {
+ set elm_ref_type [get_metadata_property -content_type $content_type -entry_type attributes -entry $attribute_name -property references]
+ if { ![empty_string_p $elm_ref_type] } {
set elm_widget select
- set elm_ref_type $form_references(${content_type}.${attribute_name})
-
- # LARS TODO: We need to be able to scope this to a package,
- # possibly filter by other things, control the sort order,
- # we need to be able to control what the label looks like (e.g. include email for users)
- # and it needs to be intelligent about scaling issues
-
- set content_type_p [db_string content_type_p {
- select count(*)
- from acs_object_type_supertype_map
- where object_type = :elm_ref_type
- and ancestor_type = 'content_revision'
- }]
-
- if { $content_type_p } {
- set options [db_list_of_lists select_options {
- select r.title,
- i.item_id
- from cr_items i, cr_revisions r
- where i.content_type = :elm_ref_type
- and r.revision_id = i.live_revision
- order by r.title
- }]
- } else {
- set options [db_list_of_lists select_options {
- select acs_object__name(object_id),
- object_id
- from acs_objects
- where object_type = :elm_ref_type
- order by acs_object__name(object_id)
- }]
- }
-
- set options [concat {{{--None--} {}}} $options]
+ set options [get_object_type_options -object_type $elm_ref_type]
lappend extra { options \$options }
}
@@ -280,23 +420,62 @@
}
+#---------------------------------------------------------------------
+# Related objects
+#---------------------------------------------------------------------
+
+set rel_elements [list]
+db_foreach select_relations {
+ select target_type,
+ relation_tag,
+ min_n,
+ max_n
+ from cr_type_relations
+ where content_type = :content_type
+ order by relation_tag
+} {
+ set label [get_metadata_property -content_type $content_type -entry_type relations -entry $relation_tag -property label]
+ set section [get_metadata_property -content_type $content_type -entry_type relations -entry $relation_tag -property section]
+ set options [get_object_type_options -object_type $target_type]
+
+ # LARS HACK: This only works for a specific hard-coded max_n
+ # We need to generalize so it can be dynamic
+
+ for { set counter 1 } { $counter <= $max_n } { incr counter } {
+ set elm_name "rel__${relation_tag}__$counter"
+ lappend rel_elements $elm_name
+ set elm_label "$label $counter"
+
+ ad_form -extend -name object -form \
+ [list \
+ [list $elm_name:integer(select),optional \
+ {label $elm_label} \
+ {section $section} \
+ {options $options} \
+ {html {onChange "javascript:FormRefresh('object');"}} \
+ ] \
+ ]
+ }
+}
+
+
+#---------------------------------------------------------------------
+# Define the form
+#---------------------------------------------------------------------
+
ad_form -extend -name object -new_request {
# Set element values from local vars
} -on_submit {
- switch $content_method($content_type) {
+ switch $content_method {
richtext {
set content_text [template::util::richtext::get_property contents $content_elm]
set mime_type [template::util::richtext::get_property format $content_elm]
set storage_type text
}
textarea {
set content_text $content_elm
- if { [exists_and_not_null content_mime_type($content_type)] } {
- set mime_type $content_mime_type($content_type)
- } else {
- set mime_type "text/plain"
- }
+ set mime_type [get_metadata_property -content_type $content_type -property mime_type -default "text/plain"]
set storage_type text
}
upload {
@@ -314,7 +493,7 @@
}
}
default {
- error "The '$content_method($content_type)' content input method has not yet been implemented"
+ error "The '$content_method' content input method has not yet been implemented"
}
}
@@ -342,13 +521,14 @@
db_transaction {
set item_id [bcms::item::create_item \
+ -item_id $item_id \
-item_name $name \
-parent_id $parent_id \
-content_type $content_type \
-storage_type $storage_type]
- switch $content_method($content_type) {
+ switch $content_method {
upload {
set revision_id [bcms::revision::upload_file_revision \
-item_id $item_id \
@@ -373,6 +553,21 @@
bcms::revision::set_revision_status \
-revision_id $revision_id \
-status "live"
+
+ foreach elm $rel_elements {
+ # LARS HACK ALERT: This isn't a particularly pretty way to find all the related objects in the form
+ regexp {__(.+)__} $elm match relation_tag
+ regexp {__.+__(.+)$} $elm match order_n
+ set related_object_id [set $elm]
+
+ if { ![empty_string_p $related_object_id] } {
+ bcms::item::relate_item \
+ -relation_type $relation_tag \
+ -item_id $item_id \
+ -related_object_id $related_object_id \
+ -order_n $order_n
+ }
+ }
}
} -edit_request {
@@ -387,19 +582,30 @@
set attr__${content_type}__${attribute_name} $content($attribute_name)
}
- switch $content_method($content_type) {
+ switch $content_method {
richtext {
set content_elm [template::util::richtext::create $content(text) $content(mime_type)]
}
textarea {
set content_elm $content(text)
}
}
+
+ db_foreach related_objects {
+ select related_object_id,
+ relation_tag,
+ order_n
+ from cr_item_rels
+ where item_id = :item_id
+ } {
+ set "rel__${relation_tag}__${order_n}" $related_object_id
+ }
+
} -edit_data {
db_transaction {
- switch $content_method($content_type) {
+ switch $content_method {
upload {
set revision_id [bcms::revision::upload_file_revision \
-item_id $item_id \
@@ -424,9 +630,59 @@
bcms::revision::set_revision_status \
-revision_id $revision_id \
-status "live"
+
+ # LARS: The way we do this update is not very pretty: Delete all relations and re-add the new ones
+ db_dml delete_all_relations {
+ delete from cr_item_rels
+ where item_id = :item_id
+ }
+
+ foreach elm $rel_elements {
+ # LARS HACK ALERT: This isn't a particularly pretty way to find all the related objects in the form
+ regexp {__(.+)__} $elm match relation_tag
+ regexp {__.+__(.+)$} $elm match order_n
+ set related_object_id [set $elm]
+
+ ns_log Notice "LARS: $elm - $related_object_id"
+
+ if { ![empty_string_p $related_object_id] } {
+ bcms::item::relate_item \
+ -relation_type $relation_tag \
+ -item_id $item_id \
+ -related_object_id $related_object_id \
+ -order_n $order_n
+ }
+ }
}
} -after_submit {
ad_returnredirect object-list
ad_script_abort
}
+
+
+# LARS: This is a hack to get to execute code on every request, instead of only in certain cases
+# The only time we don't want this is when we
+
+foreach elm $rel_elements {
+ set elm_before_html {}
+
+ if { [exists_and_not_null $elm] } {
+ set related_object_id [set $elm]
+
+ set rel_obj_name [db_string name { select name from cr_items where item_id = :related_object_id } -default {}]
+ if { ![empty_string_p $rel_obj_name] } {
+ set thumb_url [export_vars -base "object-content/$rel_obj_name"]
+ append elm_before_html {}
+ append elm_before_html { }
+ append elm_before_html {}
+ }
+ } else {
+ append elm_before_html {}
+ append elm_before_html { }
+ append elm_before_html {}
+ }
+ append elm_before_html { Choose:}
+
+ element set_properties object $elm -before_html $elm_before_html
+}
Index: openacs-4/packages/simulation/www/object-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/www/Attic/object-list.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/simulation/www/object-list.tcl 29 Oct 2003 18:48:09 -0000 1.8
+++ openacs-4/packages/simulation/www/object-list.tcl 31 Oct 2003 08:43:15 -0000 1.9
@@ -74,7 +74,7 @@
set delete_url [export_vars -base "object-delete" { item_id }]
switch -glob $mime_type {
- text/* {
+ text/* - {} {
set view_url [export_vars -base "object/$name"]
}
default {