Index: openacs-4/packages/ams/ams.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/ams.info,v
diff -u -N -r1.7 -r1.8
--- openacs-4/packages/ams/ams.info 15 Aug 2005 09:14:08 -0000 1.7
+++ openacs-4/packages/ams/ams.info 9 Sep 2005 14:06:12 -0000 1.8
@@ -8,14 +8,14 @@
t
ams
-
+
Matthew Geddert
Store attributes via the Content Repository, and auto generate input forms
2005-05-21
AMS (Attribute Management System) helps in customizing your website. It lets you adjust what information is collected and displayed for any package that is integrated with it. AMS allows you to easily and dynamically add attributes to forms and display pages, using a Tcl API or an admin interface. AMS uses the content repository to store attribute history for any object on the system.
0
-
+
Index: openacs-4/packages/ams/sql/postgresql/ams-package-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/sql/postgresql/ams-package-create.sql,v
diff -u -N -r1.6 -r1.7
--- openacs-4/packages/ams/sql/postgresql/ams-package-create.sql 15 Aug 2005 09:14:08 -0000 1.6
+++ openacs-4/packages/ams/sql/postgresql/ams-package-create.sql 9 Sep 2005 14:06:12 -0000 1.7
@@ -203,9 +203,9 @@
------ Options
--------------------------------------------------------------------
-select define_function_args('ams_option__new','option_id,attribute_id,option,sort_order,depreacted_p;f,creation_date,creation_user,creation_ip,context_id');
+select define_function_args('ams_option__new','option_id,attribute_id,option,sort_order,depreacted_p;f,creation_date,creation_user,creation_ip,context_id,pretty_name');
-create or replace function ams_option__new (integer,integer,varchar,integer,boolean,timestamptz,integer,varchar,integer)
+create or replace function ams_option__new (integer,integer,varchar,integer,boolean,timestamptz,integer,varchar,integer,varchar)
returns integer as '
declare
p_option_id alias for $1;
@@ -217,6 +217,7 @@
p_creation_user alias for $7;
p_creation_ip alias for $8;
p_context_id alias for $9;
+ p_pretty_name alias for $10;
v_option_id integer;
v_sort_order integer;
begin
@@ -227,7 +228,9 @@
p_creation_date,
p_creation_user,
P_creation_ip,
- p_context_id
+ p_context_id,
+ ''t'',
+ p_pretty_name
);
if p_sort_order is null then
Index: openacs-4/packages/ams/tcl/ams-list-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/tcl/ams-list-procs.tcl,v
diff -u -N -r1.4 -r1.5
--- openacs-4/packages/ams/tcl/ams-list-procs.tcl 10 Jun 2005 21:50:53 -0000 1.4
+++ openacs-4/packages/ams/tcl/ams-list-procs.tcl 9 Sep 2005 14:06:12 -0000 1.5
@@ -212,7 +212,7 @@
set description_mime_type ""
}
- set pretty_name [lang::util::convert_to_i18n -prefix "ams_list" -text "$pretty_name"]
+ set pretty_name [lang::util::convert_to_i18n -message_key "ams_list.${object_type}.${list_name}" -text "$pretty_name"]
set extra_vars [ns_set create]
oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list { list_id package_key object_type list_name pretty_name description description_mime_type }
set list_id [package_instantiate_object -extra_vars $extra_vars ams_list]
Index: openacs-4/packages/ams/tcl/ams-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/tcl/ams-procs.tcl,v
diff -u -N -r1.20 -r1.21
--- openacs-4/packages/ams/tcl/ams-procs.tcl 23 Jul 2005 17:18:58 -0000 1.20
+++ openacs-4/packages/ams/tcl/ams-procs.tcl 9 Sep 2005 14:06:12 -0000 1.21
@@ -1,14 +1,13 @@
ad_library {
- Support procs for the ams package
+Support procs for the ams package
- @author Matthew Geddert openacs@geddert.com
+@author Matthew Geddert openacs@geddert.com
@creation-date 2004-09-28
@cvs-id $Id$
}
-
namespace eval attribute:: {}
namespace eval ams:: {}
namespace eval ams::attribute {}
@@ -27,7 +26,7 @@
ad_proc -public attribute::pretty_name_not_cached {
{-attribute_id:required}
} {
- get the pretty_name of an attribute
+ get the pretty_name of an attribute
} {
return [db_string get_pretty_name {} -default {}]
}
@@ -66,12 +65,12 @@
} {
create a new attribute
- @see ams::attribute::new
+@see ams::attribute::new
} {
- set pretty_name [lang::util::convert_to_i18n -message_key "${object_type}_${attribute_name}_pretty_name" -text "$pretty_name"]
- set pretty_plural [lang::util::convert_to_i18n -message_key "${object_type}_${attribute_name}_pretty_plural" -text "$pretty_plural"]
+ set pretty_name [lang::util::convert_to_i18n -message_key "ams_attribute.${object_type}.${attribute_name}.pretty_name" -text "$pretty_name"]
+ set pretty_plural [lang::util::convert_to_i18n -message_key "ams_attribute.${object_type}.${attribute_name}.pretty_plural" -text "$pretty_plural"]
- if { $if_does_not_exist_p } {
+if { $if_does_not_exist_p } {
set attribute_id [attribute::id -object_type $object_type -attribute_name $attribute_name]
if { [string is false [exists_and_not_null attribute_id]] } {
set attribute_id [db_string create_attribute {}]
@@ -91,12 +90,12 @@
return [db_string get_attribute_id {} -default {}]
}
-ad_proc -public ams::package_id {} {
-
- TODO: Get the AMS package ID, not the connection package_id
+ad_proc -public ams::package_id {
+} {
+TODO: Get the AMS package ID, not the connection package_id
Get the package_id of the ams instance
- @return package_id
+@return package_id
} {
return [ad_conn package_id]
}
@@ -105,194 +104,192 @@
-message:required
{-package_key "ams"}
} {
-
} {
if { [regsub "^${package_key}." [string trim $message "\#"] {} message_key] } {
- set edit_url [export_vars -base "[apm_package_url_from_key "acs-lang"]admin/edit-localized-message" { { locale {[ad_conn locale]} } package_key message_key { return_url [ad_return_url] } }]
- } else {
- set edit_url ""
- }
- return $edit_url
-}
+ set edit_url [export_vars -base "[apm_package_url_from_key "acs-lang"]admin/edit-localized-message" { { locale {[ad_conn locale]} } package_key message_key { return_url [ad_return_url] } }]
+ } else {
+ set edit_url ""
+ }
+ return $edit_url
+ }
-ad_proc -public ams::util::localize_and_sort_list_of_lists {
- {-list}
- {-position "0"}
-} {
- localize and sort a list of lists
-} {
- set localized_list [ams::util::localize_list_of_lists -list $list]
- return [ams::util::sort_list_of_lists -list $localized_list -position $position]
-}
+ ad_proc -public ams::util::localize_and_sort_list_of_lists {
+ {-list}
+ {-position "0"}
+ } {
+ localize and sort a list of lists
+ } {
+ set localized_list [ams::util::localize_list_of_lists -list $list]
+ return [ams::util::sort_list_of_lists -list $localized_list -position $position]
+ }
-ad_proc -public ams::util::localize_list_of_lists {
- {-list}
-} {
- localize the elements of a list_of_lists
-} {
- set list_output [list]
- foreach item $list {
- set item_output [list]
- foreach part $item {
- lappend item_output [lang::util::localize $part]
- }
- lappend list_output $item_output
- }
- return $list_output
-}
+ ad_proc -public ams::util::localize_list_of_lists {
+ {-list}
+ } {
+ localize the elements of a list_of_lists
+ } {
+ set list_output [list]
+ foreach item $list {
+ set item_output [list]
+ foreach part $item {
+ lappend item_output [lang::util::localize $part]
+ }
+ lappend list_output $item_output
+ }
+ return $list_output
+ }
-ad_proc -public ams::util::sort_list_of_lists {
- {-list}
- {-position "0"}
-} {
- sort a list_of_lists
-} {
- set sort_output [list]
- foreach item $list {
- set sort_key [string toupper [lindex $item $position]]
- # we need to replace spaces because it prevents
- # multi word sort keys from recieving curly
- # brackets during the sort, which skews results
- regsub -all " " $sort_key "_" sort_key
- lappend sort_output [list $sort_key $item]
- }
- set sort_output [lsort $sort_output]
- set list_output [list]
- foreach item $sort_output {
- lappend list_output [lindex $item 1]
- }
- return $list_output
-}
+ ad_proc -public ams::util::sort_list_of_lists {
+ {-list}
+ {-position "0"}
+ } {
+ sort a list_of_lists
+ } {
+ set sort_output [list]
+ foreach item $list {
+ set sort_key [string toupper [lindex $item $position]]
+ # we need to replace spaces because it prevents
+ # multi word sort keys from recieving curly
+ # brackets during the sort, which skews results
+ regsub -all " " $sort_key "_" sort_key
+ lappend sort_output [list $sort_key $item]
+ }
+ set sort_output [lsort $sort_output]
+ set list_output [list]
+ foreach item $sort_output {
+ lappend list_output [lindex $item 1]
+ }
+ return $list_output
+ }
+ ad_proc -public ams::object_parents {
+ -object_type:required
+ -sql:boolean
+ -hide_current:boolean
+ -show_root:boolean
+ } {
+ @param sql if selected the list will be formatted in a way suitable for inclusion in sql statements
+ @param hide_current hide the current object_type
+ @param show_root show the root object_type (the acs_object object type)
+ @return a list of the parent object_types
+ } {
+ if { [string is false $hide_current_p] } {
+ set object_types [list $object_type]
+ }
+ while { $object_type != "acs_object" } {
+ set object_type [db_string get_supertype {}]
+ if { $object_type != "acs_object" } {
+ lappend object_types $object_type
+ }
+ }
+ if { $show_root_p } {
+ lappend object_types "acs_object"
+ }
+ if { $sql_p } {
+ return "'[join $object_types "','"]'"
+ } else {
+ return $object_types
+ }
+ }
-ad_proc -public ams::object_parents {
- -object_type:required
- -sql:boolean
- -hide_current:boolean
- -show_root:boolean
-} {
- @param sql if selected the list will be formatted in a way suitable for inclusion in sql statements
- @param hide_current hide the current object_type
- @param show_root show the root object_type (the acs_object object type)
- @return a list of the parent object_types
-} {
- if { [string is false $hide_current_p] } {
- set object_types [list $object_type]
- }
- while { $object_type != "acs_object" } {
- set object_type [db_string get_supertype {}]
- if { $object_type != "acs_object" } {
- lappend object_types $object_type
- }
- }
- if { $show_root_p } {
- lappend object_types "acs_object"
- }
- if { $sql_p } {
- return "'[join $object_types "','"]'"
- } else {
- return $object_types
- }
-}
+ ad_proc -public ams::object_copy {
+ -from:required
+ -to:required
+ } {
+ } {
+ db_transaction {
+ db_dml copy_object {}
+ }
+ }
-ad_proc -public ams::object_copy {
- -from:required
- -to:required
-} {
-} {
- db_transaction {
- db_dml copy_object {}
- }
-}
+ ad_proc -public ams::object_delete {
+ {-object_id:required}
+ } {
+ delete and object that uses ams attributes
+ } {
+ return [db_dml delete_object {}]
+ }
-ad_proc -public ams::object_delete {
- {-object_id:required}
-} {
- delete and object that uses ams attributes
-} {
- return [db_dml delete_object {}]
-}
+ ad_proc -public ams::attribute::get {
+ -attribute_id:required
+ -array:required
+ } {
+ Get the info on an ams_attribute
+ } {
+ upvar 1 $array row
+ db_1row select_attribute_info {} -column_array row
+ }
+ ad_proc -public ams::attribute::new {
+ -attribute_id:required
+ {-ams_attribute_id ""}
+ -widget:required
+ {-dynamic_p "0"}
+ {-deprecated_p "0"}
+ {-context_id ""}
+ } {
+ create a new ams_attribute
-ad_proc -public ams::attribute::get {
- -attribute_id:required
- -array:required
-} {
- Get the info on an ams_attribute
-} {
- upvar 1 $array row
- db_1row select_attribute_info {} -column_array row
-}
+ @see attribute::new
+ } {
+ set existing_ams_attribute_id [db_string get_existing_ams_attribute_id {} -default {}]
-ad_proc -public ams::attribute::new {
- -attribute_id:required
- {-ams_attribute_id ""}
- -widget:required
- {-dynamic_p "0"}
- {-deprecated_p "0"}
- {-context_id ""}
-} {
- create a new ams_attribute
+ if { [exists_and_not_null existing_ams_attribute_id] } {
+ return $existing_ams_attribute_id
+ } else {
+ set extra_vars [ns_set create]
+ oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {attribute_id ams_attribute_id widget dynamic_p deprecated_p context_id}
+ set ams_attribute_id [package_instantiate_object -extra_vars $extra_vars ams_attribute]
+ return $ams_attribute_id
+ }
+ }
- @see attribute::new
-} {
- set existing_ams_attribute_id [db_string get_existing_ams_attribute_id {} -default {}]
+ ad_proc -public ams::attribute::value_save {
+ -object_id:required
+ -attribute_id:required
+ -value_id:required
+ } {
+ save and attribute value
+ } {
+ db_exec_plsql attribute_value_save {}
+ }
- if { [exists_and_not_null existing_ams_attribute_id] } {
- return $existing_ams_attribute_id
- } else {
- set extra_vars [ns_set create]
- oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {attribute_id ams_attribute_id widget dynamic_p deprecated_p context_id}
- set ams_attribute_id [package_instantiate_object -extra_vars $extra_vars ams_attribute]
- return $ams_attribute_id
- }
-}
+ ad_proc -public ams::option::new {
+ {-option_id ""}
+ -attribute_id:required
+ -option:required
+ {-sort_order ""}
+ {-deprecated_p "0"}
+ {-context_id ""}
+ } {
+ Create a new ams option for an attribute
+ } {
+ db_1row get_object_data { select object_type, attribute_name from ams_attributes where attribute_id = :attribute_id }
-ad_proc -public ams::attribute::value_save {
- -object_id:required
- -attribute_id:required
- -value_id:required
-} {
+ set option_id [db_string get_option_id { select option_id from ams_option_types where option = :option and attribute_id = :attribute_id } -default {}]
- save and attribute value
-} {
- db_exec_plsql attribute_value_save {}
-}
+ if { $option_id == "" } {
-
-
-ad_proc -public ams::option::new {
- {-option_id ""}
- -attribute_id:required
- -option:required
- {-sort_order ""}
- {-deprecated_p "0"}
- {-context_id ""}
-} {
- Create a new ams option for an attribute
-} {
- db_1row get_object_data { select object_type, attribute_name from ams_attributes where attribute_id = :attribute_id }
-
- set option [lang::util::convert_to_i18n -prefix "${object_type}_${attribute_name}" -text "$option"]
-
- set option_id [db_string get_option_id { select option_id from ams_option_types where option = :option and attribute_id = :attribute_id } -default {}]
-
- if { $option_id == "" } {
- set extra_vars [ns_set create]
- oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {option_id attribute_id option sort_order deprecated_p}
- set option_id [package_instantiate_object -extra_vars $extra_vars ams_option]
- }
-
+ set option_id [db_nextval acs_object_id_seq]
+ set pretty_name [lang::util::convert_to_i18n -message_key "${attribute_name}_$option_id" -text "$option"]
+ set extra_vars [ns_set create]
+ oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {option_id attribute_id option sort_order deprecated_p pretty_name}
+ set option_id [package_instantiate_object -extra_vars $extra_vars ams_option]
+
+ # For whatever the reason it does not insert the pretty_name,
+ # let's do it manually then...
+ db_dml update_pretty_name "update acs_objects set title = :pretty_name where object_id = :option_id"
+ }
+
return $option_id
}
-
ad_proc -public ams::option::delete {
-option_id:required
} {
Delete an ams option
- @param option_id
+@param option_id
} {
db_exec_plsql ams_option_delete {}
}
@@ -302,14 +299,12 @@
} {
Delete an ams option
- @param option_id
+@param option_id
} {
return [lang::util::localize [db_string get_option {} -default {}]]
}
-
-
-ad_proc -public ams::ad_form::save {
+ad_proc -public ams::ad_form::save {
-package_key:required
-object_type:required
-list_name:required
@@ -331,7 +326,7 @@
}
}
-ad_proc -public ams::ad_form::elements {
+ad_proc -public ams::ad_form::elements {
-package_key:required
-object_type:required
-list_name:required
@@ -341,7 +336,7 @@
} {
set list_id [ams::list::get_list_id -package_key $package_key -object_type $object_type -list_name $list_name]
- set element_list ""
+set element_list ""
if { [exists_and_not_null key] } {
lappend element_list "$key\:key"
}
@@ -355,7 +350,7 @@
return $element_list
}
-ad_proc -public ams::ad_form::values {
+ad_proc -public ams::ad_form::values {
-package_key:required
-object_type:required
-list_name:required
@@ -370,7 +365,7 @@
}
}
-ad_proc -public ams::values {
+ad_proc -public ams::values {
-package_key:required
-object_type:required
-list_name:required
@@ -415,14 +410,14 @@
@creation-date 2005-07-22
@param object_id The object for which the value is stored
-
+
@param attribute_id The attribute_id of the attribute for which the value is retrieved
-
+
@param attribute_name Alternatively the attribute_name for the attribute
-
- @return
- @error
+ @return
+
+ @error
} {
if {[exists_and_not_null attribute_id]} {
set where_clause "and aa.attribute_id = :attribute_id"
@@ -436,4 +431,108 @@
}
}
+ad_proc -public ams::attribute::save_text {
+ -object_id:required
+ {-attribute_id ""}
+ {-attribute_name ""}
+ {-object_type ""}
+ {-format "text/plain"}
+ -value
+} {
+ Save the value of an AMS text attribute for an object.
+
+ @author Malte Sussdorff (sussdorff@sussdorff.de)
+ @creation-date 2005-07-22
+
+ @param object_id The object for which the value is stored
+
+ @param attribute_id The attribute_id of the attribute for which the value is retrieved
+
+ @param attribute_name Alternatively the attribute_name for the attribute
+
+ @return
+
+ @error
+} {
+ if {[exists_and_not_null value]} {
+ if {[empty_string_p $attribute_id]} {
+ set attribute_id [attribute::id \
+ -object_type "$object_type" -attribute_name "$attribute_name"]
+ }
+ if {[exists_and_not_null attribute_id]} {
+ set value_id [ams::util::text_save \
+ -text $value \
+ -text_format "text/plain"]
+ ams::attribute::value_save -object_id $object_id -attribute_id $attribute_id -value_id $value_id
+ }
+ }
+}
+ad_proc -public ams::attribute::save_mc {
+ -object_id:required
+ {-attribute_id ""}
+ {-attribute_name ""}
+ {-object_type ""}
+ -value
+ {-format "text/plain"}
+} {
+ Save the value of an AMS multiple choice attribute like "select",
+ "radio" for an object.
+
+ @author Malte Sussdorff (sussdorff@sussdorff.de)
+ @creation-date 2005-07-22
+
+ @param object_id The object for which the value is stored
+
+ @param attribute_id The attribute_id of the attribute for which the value is retrieved
+
+ @param attribute_name Alternatively the attribute_name for the attribute
+
+ @return
+
+ @error
+} {
+ if {[exists_and_not_null value]} {
+ # map values if corresponding mapping-function
+ # exists
+
+ set proc "map_$attribute"
+
+ if {[llength [info procs $proc]] == 1} {
+ if {[exists_and_not_null value]} {
+ if {[catch {set value [eval $proc {$value}]} err]} {
+ append error_string "Contact \#$contact_count ($first_names $last_name): $err
"
+ }
+ }
+ }
+ }
+
+ if {[exists_and_not_null value]} {
+
+ if {[empty_string_p $attribute_id]} {
+ set attribute_id [attribute::id \
+ -object_type "$object_type" -attribute_name "$attribute_name"]
+ }
+
+ switch $value {
+ "TRUE" {set value "t" }
+ "FALSE" {set value "f" }
+ default {set value "#acs-translations.organization_[set attribute]_$value#"}
+ }
+ set option_id [db_string get_option {select option_id from ams_option_types where attribute_id = :attribute_id and option = :value} \
+ -default {}]
+
+ # Create the option if it no already existed.
+ if {![exists_and_not_null option_id]} {
+ set option_id [ams::option::new \
+ -attribute_id $attribute_id \
+ -option $value]
+ ns_log notice "...... CREATED OPTION $option_id: $value"
+ }
+
+ # Save the value using the option_id
+ set value_id [ams::util::options_save \
+ -options $option_id]
+ ams::attribute::value_save -object_id $object_id -attribute_id $attribute_id -value_id $value_id
+ }
+}
\ No newline at end of file
Index: openacs-4/packages/ams/tcl/ams-widget-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/tcl/ams-widget-procs-postgresql.xql,v
diff -u -N -r1.1 -r1.2
--- openacs-4/packages/ams/tcl/ams-widget-procs-postgresql.xql 18 May 2005 17:11:48 -0000 1.1
+++ openacs-4/packages/ams/tcl/ams-widget-procs-postgresql.xql 9 Sep 2005 14:06:12 -0000 1.2
@@ -4,9 +4,11 @@
select option,
- option_id
- from ams_option_types
+ option_id,
+ title as pretty_name
+ from ams_option_types aot, acs_objects ao
where attribute_id = :attribute_id
+ and aot.option_id = ao.object_id
and not deprecated_p
order by sort_order
Index: openacs-4/packages/ams/tcl/ams-widget-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/tcl/ams-widget-procs.tcl,v
diff -u -N -r1.9 -r1.10
--- openacs-4/packages/ams/tcl/ams-widget-procs.tcl 23 Jul 2005 17:17:24 -0000 1.9
+++ openacs-4/packages/ams/tcl/ams-widget-procs.tcl 9 Sep 2005 14:06:12 -0000 1.10
@@ -93,8 +93,8 @@
} {
set return_list [list]
db_foreach get_options {} {
- set option "[lang::util::localize $option $locale]"
- lappend return_list [list $option $option_id]
+ set pretty_name "[lang::util::localize $pretty_name $locale]"
+ lappend return_list [list $pretty_name $option_id]
}
return $return_list
}
Index: openacs-4/packages/ams/www/attribute.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/ams/www/attribute.tcl,v
diff -u -N -r1.6 -r1.7
--- openacs-4/packages/ams/www/attribute.tcl 15 Jun 2005 22:59:04 -0000 1.6
+++ openacs-4/packages/ams/www/attribute.tcl 9 Sep 2005 14:06:12 -0000 1.7
@@ -51,6 +51,9 @@
}
}
+ pretty_name {
+ label "[_ ams.Pretty_Name]"
+ }
sort_order {
label "[_ ams.Sort_Order]"
display_template {
@@ -78,6 +81,7 @@
layout table
row {
option {}
+ pretty_name {}
sort_order {}
actions {}
}
@@ -88,10 +92,11 @@
set sort_count 10
set sort_key_count 10000
db_multirow -extend { sort_order sort_key delete_url edit_url } options select_options {
- select option_id, option,
+ select option_id, option, title as pretty_name,
CASE WHEN ( select '1' from ams_options where ams_options.option_id = ams_option_types.option_id limit 1 ) IS NULL THEN 0 ELSE 1 END as in_use_p
- from ams_option_types
+ from ams_option_types aot, acs_objects o
where attribute_id = :attribute_id
+ and aot.option_id = o.object_id
order by sort_order
} {
set sort_order $sort_count