Index: openacs-4/packages/edit-this-page/tcl/etp-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/edit-this-page/tcl/etp-procs.tcl,v
diff -u -r1.31 -r1.32
--- openacs-4/packages/edit-this-page/tcl/etp-procs.tcl 9 May 2018 15:33:31 -0000 1.31
+++ openacs-4/packages/edit-this-page/tcl/etp-procs.tcl 19 Aug 2024 11:50:46 -0000 1.32
@@ -1,5 +1,3 @@
-# etp-procs.tcl
-
ad_library {
Helper procedures for Edit This Page
@@ -10,710 +8,710 @@
namespace eval etp {
-set standard_attributes {
- {title Title Titles string {size="60"} "Untitled" -1}
- {description Description Descriptions string {rows=24 cols=80} "" -1}
- {content Content Content string {rows=24 cols=80} "" -1}
-}
+ set standard_attributes {
+ {title Title Titles string {size="60"} "Untitled" -1}
+ {description Description Descriptions string {rows=24 cols=80} "" -1}
+ {content Content Content string {rows=24 cols=80} "" -1}
+ }
-ad_proc -public make_content_type { content_type pretty_name pretty_plural attribute_metadata } {
- obsolete name; use define_content_type instead
-} {
- return [define_content_type $content_type $pretty_name $pretty_plural $attribute_metadata]
-}
+ ad_proc -public make_content_type { content_type pretty_name pretty_plural attribute_metadata } {
+ obsolete name; use define_content_type instead
+ } {
+ return [define_content_type $content_type $pretty_name $pretty_plural $attribute_metadata]
+ }
-ad_proc -public define_content_type { content_type pretty_name pretty_plural attribute_metadata } {
+ ad_proc -public define_content_type { content_type pretty_name pretty_plural attribute_metadata } {
- Call this at server startup time to register the
- extended page attributes for a particular content type.
- It ensures that there is a corresponding entry in
- acs_object_types for the content type, and that for
- each of the extended page attributes given there is
- an appropriate entry in acs_attributes. Also, a
- namespace variable stores all extended page attributes
- in memory data structure for quick retrieval.
-
- Extended page attribute values are stored in
- the acs_attribute_values table (so-called "generic" storage)
- to prevent the necessity of creating a table for each
- content type. This is the reason we're not using the
- attribute procs defined in the acs-subsite package, as
- they only support type-specific storage.
-
- NOTE: get the attribute metadata right the first time.
- If you decide to add a new attribute to an existing object type,
- the procedure will create it for you. But it won't
- process updates to existing attributes or remove them.
- You'll have to do that by hand.
+ Call this at server startup time to register the
+ extended page attributes for a particular content type.
+ It ensures that there is a corresponding entry in
+ acs_object_types for the content type, and that for
+ each of the extended page attributes given there is
+ an appropriate entry in acs_attributes. Also, a
+ namespace variable stores all extended page attributes
+ in memory data structure for quick retrieval.
+
+ Extended page attribute values are stored in
+ the acs_attribute_values table (so-called "generic" storage)
+ to prevent the necessity of creating a table for each
+ content type. This is the reason we're not using the
+ attribute procs defined in the acs-subsite package, as
+ they only support type-specific storage.
+
+ NOTE: get the attribute metadata right the first time.
+ If you decide to add a new attribute to an existing object type,
+ the procedure will create it for you. But it won't
+ process updates to existing attributes or remove them.
+ You'll have to do that by hand.
- @author Luke Pond
- @creation-date 2001-05-31
+ @author Luke Pond
+ @creation-date 2001-05-31
- @param content_type The content type you're registering. This name
- must be unique across all pages that must store
- extended page attributes.
- @param pretty_name The display name for the content type
- @param pretty_plural The plural form of the display name
- @param attribute_metadata A list of records describing each extended
- page attribute. Each record is a list containing the following
- values (in sequence):
- - attribute_name
-
- pretty_name
-
- pretty_plural
-
- datatype (must be one of the entries in acs_datatypes:
- string, boolean, number, integer, date, etc.)
-
- html (a string containing html attributes for the input
- control. useful attributes are "size=X" to specify
- the size of standard input controls, and "rows=X cols=X"
- to specify the size of a textarea. Textareas will be
- used only if the datatype is string and html specifies
- rows or cols.)
-
- default_value (can either be a string denoting a single default
- value, or the name of a callback function you've
- defined in the etp namespace which is used to
- provide values for select lists).
-
- # TODO: other features are needed such as making an attribute optional
- # and also specifying options for select lists.
-} {
- variable content_types
- if {![info exists content_types]} {
- array set content_types [list]
- }
+ @param content_type The content type you're registering. This name
+ must be unique across all pages that must store
+ extended page attributes.
+ @param pretty_name The display name for the content type
+ @param pretty_plural The plural form of the display name
+ @param attribute_metadata A list of records describing each extended
+ page attribute. Each record is a list containing the following
+ values (in sequence):
+ - attribute_name
+
- pretty_name
+
- pretty_plural
+
- datatype (must be one of the entries in acs_datatypes:
+ string, boolean, number, integer, date, etc.)
+
- html (a string containing html attributes for the input
+ control. useful attributes are "size=X" to specify
+ the size of standard input controls, and "rows=X cols=X"
+ to specify the size of a textarea. Textareas will be
+ used only if the datatype is string and html specifies
+ rows or cols.)
+
- default_value (can either be a string denoting a single default
+ value, or the name of a callback function you've
+ defined in the etp namespace which is used to
+ provide values for select lists).
+
+ # TODO: other features are needed such as making an attribute optional
+ # and also specifying options for select lists.
+ } {
+ variable content_types
+ if {![info exists content_types]} {
+ array set content_types [list]
+ }
- # probably should use content_type functions instead
- # DaveB
- # anyway we make sure new types are children of etp_page_revision
- # ensure an entry in acs_object_types
-
- if { ![db_0or1row object_type_exists ""] } {
- db_exec_plsql object_type_create ""
- }
+ # probably should use content_type functions instead
+ # DaveB
+ # anyway we make sure new types are children of etp_page_revision
+ # ensure an entry in acs_object_types
- set attribute_metadata_with_ids [list]
+ if { ![db_0or1row object_type_exists ""] } {
+ db_exec_plsql object_type_create ""
+ }
- # for each attribute, ensure an entry in acs_attributes
- foreach attribute $attribute_metadata {
- if {[llength $attribute] != 6} {
- ns_log Error "etp::define_content_type ($content_type) failed:
- attribute_metadata record has incorrect format"
- return
- }
+ set attribute_metadata_with_ids [list]
- lassign $attribute a_name a_pretty_name a_pretty_plural a_datatype a_html a_default
+ # for each attribute, ensure an entry in acs_attributes
+ foreach attribute $attribute_metadata {
+ if {[llength $attribute] != 6} {
+ ns_log Error "etp::define_content_type ($content_type) failed:
+ attribute_metadata record has incorrect format"
+ return
+ }
- if { ![db_0or1row attribute_exists ""] } {
- set attribute_id [db_exec_plsql attribute_create ""]
- }
- lappend attribute $attribute_id
- lappend attribute_metadata_with_ids $attribute
- }
+ lassign $attribute a_name a_pretty_name a_pretty_plural a_datatype a_html a_default
- set content_types($content_type) $attribute_metadata_with_ids
- # add service contract implementations for content_type if necessary
- # creates search service contract implementation if it doesn't
- # already exist
- etp::create_search_impl -content_type $content_type
-}
+ if { ![db_0or1row attribute_exists ""] } {
+ set attribute_id [db_exec_plsql attribute_create ""]
+ }
+ lappend attribute $attribute_id
+ lappend attribute_metadata_with_ids $attribute
+ }
-
-ad_proc -public define_application { name params } {
- TODO: Need documentation
- TODO: Check the parameters passed in
-} {
- variable application_params
- if {![info exists application_params]} {
- array set application_params [list]
+ set content_types($content_type) $attribute_metadata_with_ids
+ # add service contract implementations for content_type if necessary
+ # creates search service contract implementation if it doesn't
+ # already exist
+ etp::create_search_impl -content_type $content_type
}
- set application_params($name) $params
- ns_log debug "ETP define_application name $name is $application_params($name)"
-}
-ad_proc -public modify_application { name params } {
- TODO: Need documentation
- TODO: Check the parameters passed in
-} {
- variable application_params
- array set param_array $application_params($name)
- array set param_array $params
- set application_params($name) [array get param_array]
- ns_log debug "ETP modify_application application $name is modified to $application_params($name)"
-}
-ad_proc -public get_defined_applications { } {
- returns a list of all defined applications
-} {
- variable application_params
- return [lsort [array names application_params]]
-}
+ ad_proc -public define_application { name params } {
+ TODO: Need documentation
+ TODO: Check the parameters passed in
+ } {
+ variable application_params
+ if {![info exists application_params]} {
+ array set application_params [list]
+ }
+ set application_params($name) $params
+ ns_log debug "ETP define_application name $name is $application_params($name)"
+ }
-ad_proc -public get_application_param { param_name {app ""} } {
- NYI: Need documentation
-} {
- array set params [get_application_params $app]
+ ad_proc -public modify_application { name params } {
+ TODO: Need documentation
+ TODO: Check the parameters passed in
+ } {
+ variable application_params
+ array set param_array $application_params($name)
+ array set param_array $params
+ set application_params($name) [array get param_array]
+ ns_log debug "ETP modify_application application $name is modified to $application_params($name)"
+ }
- if { [info exists params($param_name)] } {
- return $params($param_name)
- } else {
- return ""
+ ad_proc -public get_defined_applications { } {
+ returns a list of all defined applications
+ } {
+ variable application_params
+ return [lsort [array names application_params]]
}
-}
-ad_proc -public get_application_params { {app ""} } {
- NYI: Need documentation
-} {
- variable application_params
+ ad_proc -public get_application_param { param_name {app ""} } {
+ NYI: Need documentation
+ } {
+ array set params [get_application_params $app]
- if { $app eq "" } {
- set app [parameter::get -parameter application -default "default"]
+ if { [info exists params($param_name)] } {
+ return $params($param_name)
+ } else {
+ return ""
+ }
}
- array set params $application_params(default)
+ ad_proc -public get_application_params { {app ""} } {
+ NYI: Need documentation
+ } {
+ variable application_params
- if { [info exists application_params($app)] } {
- array set params $application_params($app)
- }
+ if { $app eq "" } {
+ set app [parameter::get -parameter application -default "default"]
+ }
- return [array get params]
-}
+ array set params $application_params(default)
+ if { [info exists application_params($app)] } {
+ array set params $application_params($app)
+ }
-ad_proc -public make_page { name {title "Untitled"} {item_id ""}} {
- @author Luke Pond
- @creation-date 2001-05-31
- @param name the name of the page you wish to create
- in the current package
+ return [array get params]
+ }
- Creates a new page (content item) with the given name
- by inserting a row into the cr_items table, and creates
- an initial revision by inserting a row into the cr_revisions
- table.
-} {
- set package_id [ad_conn package_id]
+ ad_proc -public make_page { name {title "Untitled"} {item_id ""}} {
+ @author Luke Pond
+ @creation-date 2001-05-31
+ @param name the name of the page you wish to create
+ in the current package
- set content_type [etp::get_content_type $name]
+ Creates a new page (content item) with the given name
+ by inserting a row into the cr_items table, and creates
+ an initial revision by inserting a row into the cr_revisions
+ table.
- # ensure an entry in cr_items for this (package_id, name) combination
+ } {
+ set package_id [ad_conn package_id]
- if { ![db_0or1row page_exists ""] } {
- db_exec_plsql page_create ""
+ set content_type [etp::get_content_type $name]
+
+ # ensure an entry in cr_items for this (package_id, name) combination
+
+ if { ![db_0or1row page_exists ""] } {
+ db_exec_plsql page_create ""
+ }
}
-}
-ad_proc -public get_content_type { {name ""} } {
- @param name specify "index" to get the index_content_type parameter.
- otherwise returns the content_type parameter.
+ ad_proc -public get_content_type { {name ""} } {
+ @param name specify "index" to get the index_content_type parameter.
+ otherwise returns the content_type parameter.
- Returns the content_type specified in the package parameters.
-} {
- if { $name eq "index" } {
- set content_type [etp::get_application_param index_content_type]
- } else {
- set content_type [etp::get_application_param content_content_type]
+ Returns the content_type specified in the package parameters.
+ } {
+ if { $name eq "index" } {
+ set content_type [etp::get_application_param index_content_type]
+ } else {
+ set content_type [etp::get_application_param content_content_type]
+ }
+ return $content_type
}
- return $content_type
-}
-ad_proc -public get_page_attributes {
- {-package_id ""}
-} {
- @author Luke Pond
- @creation-date 2001-05-31
- @param Optionally may specify an object type containing
- extended page attributes to be returned.
- @return Creates the pa variable in the caller's context.
-
- Creates an array variable called pa in the caller's stack frame,
- containing all attributes necessary to render the current page.
- These attributes include the standard elements from the cr_revisions
- table such as title, description, and content. If the content_type
- parameter is provided, any extended page attributes that
- correspond to it will be included. See docs for etp::make_content_type
- to learn how this works.
-
- Two database accesses are required to create the array variable.
- Once created, subsequent calls to this method will find the variable
- in a cache, unless a) any of the page attributes are changed, or b)
- the page has been flushed from the cache. (flush details TBD).
-
- The complete list of standard attributes in the pa array is as follows:
-
- - item_id
-
- name
-
- revision_id
-
- title
-
- context_bar
-
- context
-
- description
-
- publish_date
-
- content
-
- extended attributes, if any, defined by etp::make_content_type
-
-} {
- # TODO: I have no idea if ns_cache automatically flushes
- # items that are out of date. Must find out or risk
- # running out of memory
+ ad_proc -public get_page_attributes {
+ {-package_id ""}
+ } {
+ @author Luke Pond
+ @creation-date 2001-05-31
+ @param Optionally may specify an object type containing
+ extended page attributes to be returned.
+ @return Creates the pa variable in the caller's context.
- set max_age [parameter::get -parameter cache_max_age -default 600]
-
- if {$package_id eq ""} {
- set package_id [ad_conn package_id]
- }
- if {![string is integer -strict $package_id]} {
- ad_log Warning "package_id <$package_id> is not an integer"
- #
- # This might happen, when no package_id could be determined
- # via [ad_conn package_id]
- #
- ns_returnnotfound
- ad_script_abort
- }
- set name [etp::get_name]
- set content_type [etp::get_content_type $name]
+ Creates an array variable called pa in the caller's stack frame,
+ containing all attributes necessary to render the current page.
+ These attributes include the standard elements from the cr_revisions
+ table such as title, description, and content. If the content_type
+ parameter is provided, any extended page attributes that
+ correspond to it will be included. See docs for etp::make_content_type
+ to learn how this works.
+
+ Two database accesses are required to create the array variable.
+ Once created, subsequent calls to this method will find the variable
+ in a cache, unless a) any of the page attributes are changed, or b)
+ the page has been flushed from the cache. (flush details TBD).
+
+ The complete list of standard attributes in the pa array is as follows:
+
+ - item_id
+
- name
+
- revision_id
+
- title
+
- context_bar
+
- context
+
- description
+
- publish_date
+
- content
+
- extended attributes, if any, defined by etp::make_content_type
+
+ } {
+ # TODO: I have no idea if ns_cache automatically flushes
+ # items that are out of date. Must find out or risk
+ # running out of memory
- upvar pa pa
+ set max_age [parameter::get -parameter cache_max_age -default 600]
- if { [catch {
- if {[empty_string_p [ad_conn -get revision_id]]} {
- # asking for the live published revision
- set code "etp::get_pa $package_id $name $content_type"
- array set pa [util_memoize $code $max_age]
- } else {
- # an admin is browsing other revisions - do not use caching.
- array set pa [etp::get_pa [ad_conn package_id] $name $content_type]
- }
- } errmsg] } {
- ns_log warning "Error from etp::get_pa was:\n$errmsg"
+ if {$package_id eq ""} {
+ set package_id [ad_conn package_id]
+ }
+ if {![string is integer -strict $package_id]} {
+ ad_log Warning "package_id <$package_id> is not an integer"
+ #
+ # This might happen, when no package_id could be determined
+ # via [ad_conn package_id]
+ #
+ ns_returnnotfound
+ ad_script_abort
+ }
+ set name [etp::get_name]
+ set content_type [etp::get_content_type $name]
- # Page not found. Redirect admins to setup page;
- # otherwise report 404 error.
- if { $name eq "index" &&
- [permission::permission_p -object_id [ad_conn package_id] -privilege admin] } {
- # set up the new content section
- ad_returnredirect "etp-setup-2"
- } else {
- ns_returnnotfound
- }
- # we're done responding to this request, so do no
- # further processing on this page
- ad_script_abort
+ upvar pa pa
+
+ if { [catch {
+ if {[empty_string_p [ad_conn -get revision_id]]} {
+ # asking for the live published revision
+ set code "etp::get_pa $package_id $name $content_type"
+ array set pa [util_memoize $code $max_age]
+ } else {
+ # an admin is browsing other revisions - do not use caching.
+ array set pa [etp::get_pa [ad_conn package_id] $name $content_type]
+ }
+ } errmsg] } {
+ ns_log warning "Error from etp::get_pa was:\n$errmsg"
+
+ # Page not found. Redirect admins to setup page;
+ # otherwise report 404 error.
+ if { $name eq "index" &&
+ [permission::permission_p -object_id [ad_conn package_id] -privilege admin] } {
+ # set up the new content section
+ ad_returnredirect "etp-setup-2"
+ } else {
+ ns_returnnotfound
+ }
+ # we're done responding to this request, so do no
+ # further processing on this page
+ ad_script_abort
+ }
+
}
-}
+ ad_proc -private get_pa { package_id name {content_type ""} } {
+ @author Luke Pond
+ @creation-date 2001-05-31
+ @param package_id The package_id for the current request
-ad_proc -private get_pa { package_id name {content_type ""} } {
- @author Luke Pond
- @creation-date 2001-05-31
- @param package_id The package_id for the current request
+ @param name The page name of the current request.
+ @return The tcl array (in list form) of page attributes.
- @param name The page name of the current request.
- @return The tcl array (in list form) of page attributes.
+ Does the real work of setting up the page-attribute array,
+ which is then fed to the cache. The (package_id name)
+ combination uniquely identifies a page.
+ } {
- Does the real work of setting up the page-attribute array,
- which is then fed to the cache. The (package_id name)
- combination uniquely identifies a page.
-} {
+ set extended_attributes [get_ext_attribute_columns $content_type]
- set extended_attributes [get_ext_attribute_columns $content_type]
+ set revision_id [ad_conn revision_id]
+ if {$revision_id eq ""} {
+ # this will throw an error if the page does not exist
+ db_1row get_page_attributes "" -column_array pa
+ } else {
+ # revision_id was set by index.vuh
+ db_1row get_page_attributes_other_revision "" -column_array pa
+ }
- set revision_id [ad_conn revision_id]
- if {$revision_id eq ""} {
- # this will throw an error if the page does not exist
- db_1row get_page_attributes "" -column_array pa
- } else {
- # revision_id was set by index.vuh
- db_1row get_page_attributes_other_revision "" -column_array pa
- }
+ if {$pa(mime_type) eq ""} {
+ set pa(mime_type) "text/html"
+ }
- if {$pa(mime_type) eq ""} {
- set pa(mime_type) "text/html"
- }
+ if {"text/html" ne $pa(mime_type) } {
+ set pa(content) [template::util::richtext get_property html_value [list $pa(content) $pa(mime_type)]]
+ }
+ # add in the context bar
+ if { $name eq "index" } {
+ set cb [ad_context_bar]
+ set context [list]
+ } else {
+ set cb [ad_context_bar $pa(title)]
+ set context [list $pa(title)]
+ }
+ # remove the "Your Workspace" link, so we can cache this context
+ # bar and it will work for everyone
- if {"text/html" ne $pa(mime_type) } {
- set pa(content) [template::util::richtext get_property html_value [list $pa(content) $pa(mime_type)]]
- }
- # add in the context bar
- if { $name eq "index" } {
- set cb [ad_context_bar]
- set context [list]
- } else {
- set cb [ad_context_bar $pa(title)]
- set context [list $pa(title)]
- }
- # remove the "Your Workspace" link, so we can cache this context
- # bar and it will work for everyone
+ regsub {^Your Workspace : } $cb "" cb
- regsub {^Your Workspace : } $cb "" cb
+ if {[lindex $cb 1] eq "Your Workspace"} {
+ set cb [lreplace $cb 0 1]
+ }
+ set pa(context_bar) $cb
+ set pa(context) $context
- if {[lindex $cb 1] eq "Your Workspace"} {
- set cb [lreplace $cb 0 1]
+ return [array get pa]
}
- set pa(context_bar) $cb
- set pa(context) $context
- return [array get pa]
-}
+ ad_proc -public get_ext_attribute_columns { content_type } {
+ Constructs some dynamic SQL to get each
+ of the extended page attributes. note
+ that the attribute values are stored for
+ each *revision*, so we look them up based
+ on the live revision id, not on the item id.
+ } {
+ set extended_attributes ""
+ if { $content_type ne "" &&
+ $content_type ne "etp_page_revision" } {
+ variable content_types
-ad_proc -public get_ext_attribute_columns { content_type } {
- Constructs some dynamic SQL to get each
- of the extended page attributes. note
- that the attribute values are stored for
- each *revision*, so we look them up based
- on the live revision id, not on the item id.
-} {
- set extended_attributes ""
- if { $content_type ne "" &&
- $content_type ne "etp_page_revision" } {
- variable content_types
+ set attributes $content_types($content_type)
- set attributes $content_types($content_type)
-
- foreach attribute_desc $attributes {
- set lookup_sql [etp::get_attribute_lookup_sql $attribute_desc]
- append extended_attributes ",\n $lookup_sql"
- }
+ foreach attribute_desc $attributes {
+ set lookup_sql [etp::get_attribute_lookup_sql $attribute_desc]
+ append extended_attributes ",\n $lookup_sql"
+ }
+ }
+ return $extended_attributes
}
- return $extended_attributes
-}
-ad_proc -public get_attribute_descriptors { content_type } {
- returns a list of attribute descriptors for the given content_type.
- this includes standard attributes as well as extended attributes.
-} {
- variable standard_attributes
- variable content_types
+ ad_proc -public get_attribute_descriptors { content_type } {
+ returns a list of attribute descriptors for the given content_type.
+ this includes standard attributes as well as extended attributes.
+ } {
+ variable standard_attributes
+ variable content_types
- if {[info exists content_types($content_type)]} {
- return [concat $standard_attributes $content_types($content_type)]
+ if {[info exists content_types($content_type)]} {
+ return [concat $standard_attributes $content_types($content_type)]
+ }
+
+ return $standard_attributes
}
- return $standard_attributes
-}
+ ad_proc -public get_attribute_desc { name content_type } {
+ returns the attribute descriptor for the given attribute.
+ works for extended attributes defined by the given content_type
+ as well as for the standard attributes (title, description, and content).
+ (the documentation for etp_make_content_type explains what's in an
+ attribute descriptor contains)
+ } {
+ # check for standard attributes first
-ad_proc -public get_attribute_desc { name content_type } {
- returns the attribute descriptor for the given attribute.
- works for extended attributes defined by the given content_type
- as well as for the standard attributes (title, description, and content).
- (the documentation for etp_make_content_type explains what's in an
- attribute descriptor contains)
-} {
- # check for standard attributes first
+ variable standard_attributes
- variable standard_attributes
+ foreach std_desc $standard_attributes {
+ if { $name == [lindex $std_desc 0] } {
+ return $std_desc
+ }
+ }
- foreach std_desc $standard_attributes {
- if { $name == [lindex $std_desc 0] } {
- return $std_desc
- }
+ variable content_types
+ if {[info exists content_types($content_type)]} {
+ set extended_attributes $content_types($content_type)
+ foreach ext_desc $extended_attributes {
+ if { $name == [lindex $ext_desc 0] } {
+ return $ext_desc
+ }
+ }
+ }
+
+ return ""
}
- variable content_types
- if {[info exists content_types($content_type)]} {
- set extended_attributes $content_types($content_type)
- foreach ext_desc $extended_attributes {
- if { $name == [lindex $ext_desc 0] } {
- return $ext_desc
- }
- }
+ ad_proc -public get_attribute_id { attribute_desc } {
+ } {
+ return [lindex $attribute_desc end]
}
- return ""
-}
+ ad_proc -public get_attribute_name { attribute_desc } {
+ } {
+ return [lindex $attribute_desc 0]
+ }
-ad_proc -public get_attribute_id { attribute_desc } {
-} {
- return [lindex $attribute_desc end]
-}
+ ad_proc -public get_attribute_pretty_name { attribute_desc {page_name ""} } {
+ } {
+ set pretty_name [lindex $attribute_desc 1]
-ad_proc -public get_attribute_name { attribute_desc } {
-} {
- return [lindex $attribute_desc 0]
-}
+ # handle customized standard attribute names
+ # which are set up with etp application parameters
+ set attr_name [lindex $attribute_desc 0]
+ if {$attr_name in { title description content }} {
+ if { $page_name eq "index" } {
+ set param_name "index_${attr_name}_attr_name"
+ } else {
+ set param_name "content_${attr_name}_attr_name"
+ }
-ad_proc -public get_attribute_pretty_name { attribute_desc {page_name ""} } {
-} {
- set pretty_name [lindex $attribute_desc 1]
+ ns_log debug "get_attribute_pretty_name: Asking for $param_name"
+ set pretty_name [etp::get_application_param $param_name]
+ }
- # handle customized standard attribute names
- # which are set up with etp application parameters
- set attr_name [lindex $attribute_desc 0]
- if {$attr_name in { title description content }} {
- if { $page_name eq "index" } {
- set param_name "index_${attr_name}_attr_name"
- } else {
- set param_name "content_${attr_name}_attr_name"
- }
+ return $pretty_name
+ }
- ns_log debug "get_attribute_pretty_name: Asking for $param_name"
- set pretty_name [etp::get_application_param $param_name]
- }
+ ad_proc -public get_attribute_data_type { attribute_desc } {
+ } {
+ return [lindex $attribute_desc 3]
+ }
- return $pretty_name
-}
+ ad_proc -public get_attribute_html { attribute_desc } {
+ } {
+ return [lindex $attribute_desc 4]
+ }
-ad_proc -public get_attribute_data_type { attribute_desc } {
-} {
- return [lindex $attribute_desc 3]
-}
+ ad_proc -public get_attribute_default { attribute_desc } {
+ } {
+ return [lindex $attribute_desc 5]
+ }
-ad_proc -public get_attribute_html { attribute_desc } {
-} {
- return [lindex $attribute_desc 4]
-}
+ ad_proc -public get_attribute_lookup_sql { attribute_desc } {
+ } {
+ set attribute_id [etp::get_attribute_id $attribute_desc]
+ set attribute_name [etp::get_attribute_name $attribute_desc]
+ set default [etp::get_attribute_default $attribute_desc]
-ad_proc -public get_attribute_default { attribute_desc } {
-} {
- return [lindex $attribute_desc 5]
-}
+ set lookup_sql [db_map lookup_sql_clause]
-ad_proc -public get_attribute_lookup_sql { attribute_desc } {
-} {
- set attribute_id [etp::get_attribute_id $attribute_desc]
- set attribute_name [etp::get_attribute_name $attribute_desc]
- set default [etp::get_attribute_default $attribute_desc]
+ # see if a select-list callback function was specified
+ if { [info commands $default] ne "" } {
+ set transformed_lookup_sql [eval $default transform_during_query $attribute_id {$lookup_sql}]
- set lookup_sql [db_map lookup_sql_clause]
+ if {$transformed_lookup_sql ne ""} {
+ set lookup_sql $transformed_lookup_sql
+ }
+ }
+ return "$lookup_sql as $attribute_name"
+ }
- # see if a select-list callback function was specified
- if { [info commands $default] ne "" } {
- set transformed_lookup_sql [eval $default transform_during_query $attribute_id {$lookup_sql}]
+ ad_proc -public get_etp_url { } {
+ @author Luke Pond
+ @creation-date 2001-05-31
- if {$transformed_lookup_sql ne ""} {
- set lookup_sql $transformed_lookup_sql
- }
- }
- return "$lookup_sql as $attribute_name"
-}
+ If the current package is an instance of Edit This Page,
+ and the user has write access, returns
+ the URL to where you can edit the current page.
+
+ This may be called either from your master template,
+ or from individual pages that are used within an ETP
+ package instance. It incurs 1 database hit to
+ do the permissions check. The package type is acquired
+ via the in-memory copy of the site-nodes layout.
-ad_proc -public get_etp_url { } {
- @author Luke Pond
- @creation-date 2001-05-31
+ } {
+ set url_stub [ns_conn url]
+ array set site_node [site_node::get -url $url_stub]
+ set urlc [regexp -all "/" $url_stub]
+ if { ($site_node(package_key) eq "edit-this-page" ||
+ $site_node(package_key) eq "acs-subsite") &&
+ [permission::permission_p -object_id [ad_conn package_id] -privilege write] } {
- If the current package is an instance of Edit This Page,
- and the user has write access, returns
- the URL to where you can edit the current page.
-
- This may be called either from your master template,
- or from individual pages that are used within an ETP
- package instance. It incurs 1 database hit to
- do the permissions check. The package type is acquired
- via the in-memory copy of the site-nodes layout.
+ set name [etp::get_name]
-} {
- set url_stub [ns_conn url]
- array set site_node [site_node::get -url $url_stub]
- set urlc [regexp -all "/" $url_stub]
- if { ($site_node(package_key) eq "edit-this-page" ||
- $site_node(package_key) eq "acs-subsite") &&
- [permission::permission_p -object_id [ad_conn package_id] -privilege write] } {
+ if { ![regexp "^etp" $name] } {
+ return [export_vars -base etp { name }]
+ }
+ }
- set name [etp::get_name]
+ return ""
- if { ![regexp "^etp" $name] } {
- return [export_vars -base etp { name }]
- }
- }
+ }
- return ""
+ ad_proc -public get_etp_link { } {
+ @author Luke Pond
+ @creation-date 2001-05-31
-}
+ If the current package is an instance of Edit This Page,
+ and the user has write access, returns
+ the html "Edit This Page" link which should be
+ displayed at the bottom of the page.
+
+ This may be called either from your master template,
+ or from individual pages that are used within an ETP
+ package instance. It incurs 1 database hit to
+ do the permissions check. The package type is acquired
+ via the in-memory copy of the site-nodes layout.
-ad_proc -public get_etp_link { } {
- @author Luke Pond
- @creation-date 2001-05-31
+ } {
+ set etp_url [get_etp_url]
+ if { $etp_url ne "" } {
+ return [subst {Edit This Page\n}]
+ }
+ return {}
+ }
- If the current package is an instance of Edit This Page,
- and the user has write access, returns
- the html "Edit This Page" link which should be
- displayed at the bottom of the page.
-
- This may be called either from your master template,
- or from individual pages that are used within an ETP
- package instance. It incurs 1 database hit to
- do the permissions check. The package type is acquired
- via the in-memory copy of the site-nodes layout.
+ ad_proc -public get_name { } {
+ @author Luke Pond
+ @creation-date 2001-06-10
-} {
- set etp_url [get_etp_url]
- if { $etp_url ne "" } {
- return [subst {Edit This Page\n}]
- }
- return {}
-}
+ Returns the canonical page name for the current request.
+ } {
+ set url_stub [ad_conn url]
+ if { [string index $url_stub end] eq "/" } {
+ set name index
+ } else {
+ set name [file rootname [file tail $url_stub]]
+ }
+ return $name
+ }
-ad_proc -public get_name { } {
- @author Luke Pond
- @creation-date 2001-06-10
+ ad_proc -public get_latest_revision_id { package_id name } {
+ @author Luke Pond
+ @creation-date 2001-06-10
- Returns the canonical page name for the current request.
-} {
- set url_stub [ad_conn url]
- if { [string index $url_stub end] eq "/" } {
- set name index
- } else {
- set name [file rootname [file tail $url_stub]]
+ Returns the latest revision id for the given content item.
+ } {
+ db_1row get_latest_revision_id ""
+ return $revision_id
}
- return $name
-}
-ad_proc -public get_latest_revision_id { package_id name } {
- @author Luke Pond
- @creation-date 2001-06-10
+ ad_proc -public get_live_revision_id { package_id name } {
+ @author Luke Pond
+ @creation-date 2001-06-10
- Returns the latest revision id for the given content item.
-} {
- db_1row get_latest_revision_id ""
- return $revision_id
-}
+ Returns the published ("live") revision id for the given content item.
+ } {
+ db_1row get_live_revision_id ""
+ return $revision_id
+ }
-ad_proc -public get_live_revision_id { package_id name } {
- @author Luke Pond
- @creation-date 2001-06-10
+ ad_proc -public get_content_items {
+ {-orderby ""}
+ {-limit ""}
+ {-where ""}
+ {-package_id ""}
+ {-result_name "content_items"}
+ args
+ } {
+ @author Luke Pond
+ @creation-date 2001-06-10
+ @param -orderby - what should appear in the ORDER BY clause
+ @param -limit - number of items to return
+ @param -where - additional query restrictions to follow the WHERE clause
+ @param -package_id - package_id to use (by default uses [ad_conn package_id])
+ @param -result_name - variable name to create in the caller's context (by default uses "content_items")
+ @param args - all remaining parameters are taken to be additional page attributes to return
+ Creates a variable named "content_items" in the caller's context.
+ This is a multirow result set suitable for passing to an index template,
+ containing all the structured data necessary to present a list of
+ links to content pages/folders/extlinks/symlinks.
- Returns the published ("live") revision id for the given content item.
-} {
- db_1row get_live_revision_id ""
- return $revision_id
-}
+ Each row always contains values for the following page attributes:
+
+ - name
+
- url (use this to generate a link to this item)
+
- title
+
- description
+
- object_type
+
- publish_date
+
- item_id
+
-ad_proc -public get_content_items {
- {-orderby ""}
- {-limit ""}
- {-where ""}
- {-package_id ""}
- {-result_name "content_items"}
- args
- } {
- @author Luke Pond
- @creation-date 2001-06-10
- @param -orderby - what should appear in the ORDER BY clause
- @param -limit - number of items to return
- @param -where - additional query restrictions to follow the WHERE clause
- @param -package_id - package_id to use (by default uses [ad_conn package_id])
- @param -result_name - variable name to create in the caller's context (by default uses "content_items")
- @param args - all remaining parameters are taken to be additional page attributes to return
- Creates a variable named "content_items" in the caller's context.
- This is a multirow result set suitable for passing to an index template,
- containing all the structured data necessary to present a list of
- links to content pages/folders/extlinks/symlinks.
-
- Each row always contains values for the following page attributes:
-
- - name
-
- url (use this to generate a link to this item)
-
- title
-
- description
-
- object_type
-
- publish_date
-
- item_id
-
+ Additionally, you may name additional attributes that will be
+ returned, either from the standard page attributes stored in
+ cr_revisions, or extended page attributes defined with
+ etp::make_content_type.
+
+ The content_items variable is created with a single db query,
+ and currently is never cached.
- Additionally, you may name additional attributes that will be
- returned, either from the standard page attributes stored in
- cr_revisions, or extended page attributes defined with
- etp::make_content_type.
-
- The content_items variable is created with a single db query,
- and currently is never cached.
+ } {
-} {
+ set content_type [etp::get_content_type]
- set content_type [etp::get_content_type]
+ if {$orderby eq ""} {
+ set orderby [db_map gci_orderby]
+ }
- if {$orderby eq ""} {
- set orderby [db_map gci_orderby]
- }
+ if {$limit ne ""} {
+ set limit_clause "limit $limit"
+ } else {
+ set limit_clause ""
+ }
- if {$limit ne ""} {
- set limit_clause "limit $limit"
- } else {
- set limit_clause ""
- }
+ if {$where ne ""} {
+ set extra_where_clauses $where
+ } else {
+ set extra_where_clauses [db_map gci_where_clause]
+ }
- if {$where ne ""} {
- set extra_where_clauses $where
- } else {
- set extra_where_clauses [db_map gci_where_clause]
- }
+ if {$package_id eq ""} {
+ set package_id [ad_conn package_id]
+ } else {
+ set app [parameter::get -package_id $package_id -parameter application -default default]
+ set content_type [etp::get_application_param content_content_type $app]
+ }
- if {$package_id eq ""} {
- set package_id [ad_conn package_id]
- } else {
- set app [parameter::get -package_id $package_id -parameter application -default default]
- set content_type [etp::get_application_param content_content_type $app]
- }
+ set columns [db_map gci_columns_clause]
+ ns_log debug "get_content_items: columns: $columns"
- set columns [db_map gci_columns_clause]
- ns_log debug "get_content_items: columns: $columns"
-
- for {set i 0} {$i < [llength $args]} {incr i} {
- set arg [lindex $args i]
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ set arg [lindex $args i]
- if {$arg in { item_id revision_id content publish_date }} {
- append columns ",\n r.$arg"
- } else {
- ns_log debug "get_content_items: extended attribute named $arg"
- set attr_desc [etp::get_attribute_desc $arg $content_type]
- if { $attr_desc ne "" } {
- ns_log debug "get_content_items: adding it"
- set lookup_sql [etp::get_attribute_lookup_sql $attr_desc]
- append columns ",\n $lookup_sql"
- }
- }
+ if {$arg in { item_id revision_id content publish_date }} {
+ append columns ",\n r.$arg"
+ } else {
+ ns_log debug "get_content_items: extended attribute named $arg"
+ set attr_desc [etp::get_attribute_desc $arg $content_type]
+ if { $attr_desc ne "" } {
+ ns_log debug "get_content_items: adding it"
+ set lookup_sql [etp::get_attribute_lookup_sql $attr_desc]
+ append columns ",\n $lookup_sql"
+ }
+ }
+ }
+
+ upvar $result_name $result_name
+ set folder_id [etp::get_folder_id $package_id]
+
+ db_multirow $result_name get_content_items ""
}
-
- upvar $result_name $result_name
- set folder_id [etp::get_folder_id $package_id]
- db_multirow $result_name get_content_items ""
-}
+ ad_proc -public get_subtopics {} {
+ @author Luke Pond
+ @creation-date 2001-06-13
-ad_proc -public get_subtopics {} {
- @author Luke Pond
- @creation-date 2001-06-13
-
- Creates a variable named "subtopics" in the caller's context.
- This is a multirow result set suitable for passing to an index template,
- containing all the structured data necessary to present a list of
- links to subtopics.
+ Creates a variable named "subtopics" in the caller's context.
+ This is a multirow result set suitable for passing to an index template,
+ containing all the structured data necessary to present a list of
+ links to subtopics.
- The columns in the "subtopics" query are:
- - name
-
- title
-
- description
-
+ The columns in the "subtopics" query are:
+ - name
+
- title
+
- description
+
-} {
- set package_id [ad_conn package_id]
- upvar subtopics subtopics
- db_multirow subtopics get_subtopics ""
-}
+ } {
+ set package_id [ad_conn package_id]
+ upvar subtopics subtopics
+ db_multirow subtopics get_subtopics ""
+ }
-ad_proc -public check_write_access {} {
- @author Luke Pond
- @creation-date 2001-08-29
- Designed to be used at the top of every ETP admin page.
- Returns an HTTP 403 Access Denied and aborts page processing
- if the user doesn't have "write" permission for the current
- package.
-} {
- if { ![permission::permission_p -object_id [ad_conn package_id] -privilege write] } {
- ad_return_forbidden "Access Denied" "Sorry, you haven't been
- given permission to work on this area of the website. Please
- contact your webmaster if you believe this to be in error."
- ad_script_abort
+ ad_proc -public check_write_access {} {
+ @author Luke Pond
+ @creation-date 2001-08-29
+ Designed to be used at the top of every ETP admin page.
+ Returns an HTTP 403 Access Denied and aborts page processing
+ if the user doesn't have "write" permission for the current
+ package.
+ } {
+ if { ![permission::permission_p -object_id [ad_conn package_id] -privilege write] } {
+ ad_return_forbidden "Access Denied" "Sorry, you haven't been
+ given permission to work on this area of the website. Please
+ contact your webmaster if you believe this to be in error."
+ ad_script_abort
+ }
}
-}
-ad_proc -public get_folder_id { package_id } {
- @param package_id
- @return content folder associated with package_id etp package instance
-} {
- return [db_exec_plsql get_folder_id ""]
-}
+ ad_proc -public get_folder_id { package_id } {
+ @param package_id
+ @return content folder associated with package_id etp package instance
+ } {
+ return [db_exec_plsql get_folder_id ""]
+ }
}
Index: openacs-4/packages/edit-this-page/www/etp-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/edit-this-page/www/etp-edit.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/edit-this-page/www/etp-edit.tcl 27 Jun 2015 20:03:21 -0000 1.17
+++ openacs-4/packages/edit-this-page/www/etp-edit.tcl 19 Aug 2024 11:50:46 -0000 1.18
@@ -1,9 +1,8 @@
-
ad_page_contract {
@author Luke Pond (dlpond@museatech.net)
@creation-date 2001-06-10
- Presents a form for editing a single page attribute
+ Presents a form for editing a single page attribute
} {
name
@@ -47,7 +46,7 @@
} else {
set widget "(textarea)"
}
-
+
} elseif {$type eq "date"} {
set widget "(date),to_sql(linear_date),from_sql(sql_date)"
set widget_extra [list format "Month DD YYYY"]
@@ -115,15 +114,15 @@
set extra_sql ""
if {[info exists datevalue]} {
ns_log notice "DAVEB! new_data datevalue = $datevalue"
-
+
# The date is given in YYYY-MM-DD. Transform to desired format.
# set date_format [etp::get_application_param date_format]
set value "[template::util::date::get_property year $datevalue]-[template::util::date::get_property month $datevalue]-[template::util::date::get_property day $datevalue]"
} elseif {$widget eq "(richtext)"} {
set value [template::util::richtext get_property contents [set $element]]
set mime_type [template::util::richtext get_property format [set $element]]
set extra_sql " , mime_type=:mime_type"
-
+
} else {
set value [set $element]
}
@@ -157,7 +156,7 @@
}
}
- # As a convenience, if you change the Title of an index page,
+ # As a convenience, if you change the Title of an index page,
# we also update the package instance name so that the context bar
# reflects the new title. Note this is something you can't do through
# the Site Map UI.