- #content-portlet.welcome# -
-- #content-portlet.welcome_body# -
-[[es:header_page|#content-portlet.edit_header#]] + set text [list {proc content {} { + set community_id [dotlrn_community::get_community_id] + set com_package_id [dotlrn_community::get_package_id $community_id] + set package_id [site_node_apm_integration::get_child_package_id \ + -package_id $com_package_id \ + -package_key "xowiki"] + + set wk_folder_id [::xowiki::Page require_folder -name xowiki -package_id $package_id] + if { ![db_0or1row select_instance [::xowiki::PageInstance instance_select_query \ + -folder_id $wk_folder_id -select_attributes {name} \ + -where_clause "name = 'es:header_page'"]]} { + + db_0or1row select_instance [::xowiki::PageTemplate instance_select_query \ + -folder_id $wk_folder_id -select_attributes {name} \ + -where_clause "name = 'es:Template_de_header'"] + set tmp_item_id $item_id + + set fn "[acs_root_dir]/packages/content-portlet/www/prototypes/gestemplate/GesTemplateheaderpage.page" + set standard_page "es:header_page" + if {[file readable $fn]} { + set page [source $fn] + $page configure -name $standard_page -parent_id $wk_folder_id -package_id $package_id + if {![$page exists title]} { + $page set title $template1 + } + $page set page_template $tmp_item_id + $page destroy_on_cleanup + $page set instance_attributes "Curso Curso Carrera Carrera Facultad Facultad" + $page initialize_loaded_object + $page save_new + } + } + + set user_id [ad_conn user_id] + set admin_p [dotlrn::user_can_admin_community_p -user_id $user_id -community_id [dotlrn_community::get_community_id]] + if {$admin_p} { + return { +
+ #content-portlet.welcome# +
++ #content-portlet.welcome_body# +
+[[es:header_page|#content-portlet.edit_header#]] + } + } else { + return { +
+ #content-portlet.e_welcome# +
++ #content-portlet.e_welcome_body# +
+ } + } + } + }] + + $myobject set text [lindex $text 0] + $myobject destroy_on_cleanup + $myobject save + $myobject initialize_loaded_object + ns_cache flush xotcl_object_cache ::[$myobject set item_id] + } } -} else { - return { -- #content-portlet.e_welcome# -
-- #content-portlet.e_welcome_body# -
- } } -} -}] -$myobject set text [lindex $text 0] -$myobject destroy_on_cleanup -$myobject save -$myobject initialize_loaded_object -ns_cache flush xotcl_object_cache ::[$myobject set item_id] -} -} -} - ad_proc -private content_category::up { {-wiki_package_id ""} {-level 1} } { - + set count 0 if {[empty_string_p $wiki_package_id]} { - set wiki_package_list [xowiki::Package instances] + set wiki_package_list [xowiki::Package instances] } else { - set wiki_package_list [list $wiki_package_id] + set wiki_package_list [list $wiki_package_id] } foreach wiki_package_id $wiki_package_list { - ns_log notice "inicia actualizacion de content" - set trees [category_tree::get_mapped_trees $wiki_package_id] - set tree_id [lindex [lindex $trees 0] 0] - set wiki_folder_id [::xowiki::Page require_folder \ - -name xowiki \ - -package_id $wiki_package_id] - - if {$level eq 1} { - set tree_list [content_category::get_tree_levels $tree_id] - } else { - set tree_list [content_category::get_tree_levels -only_level 2 $tree_id] - } - - set wiki_url [site_node::get_url_from_object_id \ - -object_id $wiki_package_id] - set community_id [dotlrn_community::get_community_id_from_url -url $wiki_url] - - set instructors [dotlrn_community::list_users_in_role \ - -rel_type "dotlrn_instructor_rel" $community_id] - - set instructor_id [lindex [lindex $instructors 0] 3] - - set new_tree_id [content_category::map_new_tree -object_id $wiki_package_id \ - -tree_name "Indice De Contenido." \ - -user_id $instructor_id] - - set new_tree_list [content_category::get_tree_levels \ - -only_level 2 $new_tree_id] - - - ns_log notice " Package_id $wiki_package_id $tree_list :: $new_tree_list" - foreach category $tree_list { - set cat_id [lindex $category 0] - set new_cat_id [lindex [lindex $new_tree_list $count] 0] - db_foreach select_content { - select ci.item_id, p.page_order, - ci.name, ci.content_type, category_id, xpi.page_instance_id - from category_object_map c, cr_items ci, xowiki_page p, - xowiki_page_instance xpi - where c.object_id = ci.item_id - and ci.parent_id = :wiki_folder_id - and ci.content_type not in ('::xowiki::PageTemplate') - and p.page_id = xpi.page_instance_id - and category_id = :cat_id - and xpi.page_instance_id = ci.live_revision - order by p.page_order} { - ns_log notice "--------- -object_id $item_id $new_cat_id " - category::map_object -remove_old -object_id $item_id $new_cat_id - } - incr count - } - - set count 0 - - foreach tree $trees { - set tree_id [lindex $tree 0] - category_tree::unmap -tree_id $tree_id -object_id $wiki_package_id - } - - db_0or1row select_instance [::xowiki::PageTemplate instance_select_query \ - -folder_id $wiki_folder_id \ - -select_attributes {name} \ - -where_clause "name = 'es:Template_de_ges'"] - - set template_id $item_id - - set template [xowiki::Package instantiate_page_from_id -item_id $item_id] - - set text [list { -| {{adp portlets/wiki {name header_page skin plain-include}}} | -|||||||||||||||||||||||||
| {{adp /packages/content-portlet/www/unit-navbar {page_id @revision_id@ content_id @package_id@}}} | -|||||||||||||||||||||||||
|
+ |||||||||||||||||||||||||
 |
+ {{adp /packages/content-portlet/www/complete-subnavbar {page_pos @page_order@ page_id @revision_id@ content_id @package_id@ type @object_type@}}} | + |
+ |||||||||||||||||||||||
 |
+ @contenido@ |
+  |
+ |||||||||||||||||||||||
 |
+  |
+  |
+ |||||||||||||||||||||||
} $content "\n\n" content - regsub -all {(]*>)} $content "" content - } else { - set content [ad_html_text_convert -from $format -to text/plain -- $content] - } + # + # GN: The standard conversion from "text/enhanced" to + # "text/plain" converts first from "text/enhanced" to + # "text/html" and then from "text/html" to "text/plain". This + # can take for large forums posting a long time (e.g a few + # minutes on openacs.org). Since this function is used just + # for the summarizer (when listing a short paragraph in the + # context of the search result), we can live here with a much + # simpler version, which computes the same in less than one + # ms. + # + if {$message(format) eq "text/enhanced"} { + regsub -all {
} $content "\n\n" content
+ regsub -all {(]*>)} $content "" content
+ } else {
+ set content [ad_html_text_convert -from $format -to text/plain -- $content]
+ }
append combined_content $content
# In case this text is not only used for indexing but also for display, beautify it
@@ -213,7 +213,7 @@
keywords {} \
storage_type text \
mime text/plain \
- package_id $package_id]
+ package_id $package_id]
}
ad_proc -public -callback search::url -impl forums_message {} {
@@ -272,12 +272,12 @@
The from_user_id is the user_id of the user
that will be deleted and all the *forums*
of this user will be mapped to the to_user_id.
-
+
} {
set msg "Forums items of $user_id"
ns_log Notice $msg
set result [list $msg]
-
+
set last_poster [db_list_of_lists sel_poster {} ]
set msg "Last Poster of $last_poster"
lappend result $msg
@@ -297,12 +297,12 @@
The from_user_id is the user_id of the user
that will be deleted and all the *forums*
of this user will be mapped to the to_user_id.
-
+
} {
- set msg "Merging forums"
+ set msg "Merging forums"
ns_log Notice $msg
set result [list $msg]
-
+
db_dml upd_poster {}
db_dml upd_user_id {}
@@ -314,64 +314,64 @@
# application-track callbacks
-ad_proc -callback application-track::getApplicationName -impl forums {} {
+ad_proc -callback application-track::getApplicationName -impl forums {} {
Callback implementation.
} {
return "forums"
-}
-
-ad_proc -callback application-track::getGeneralInfo -impl forums {} {
+}
+
+ad_proc -callback application-track::getGeneralInfo -impl forums {} {
Callback implementation.
} {
db_1row my_query {
- select count(f.forum_id) as result
- FROM forums_forums f, dotlrn_communities_full com
- WHERE com.community_id=:comm_id
- and apm_package__parent_id(f.package_id) = com.package_id
+ select count(f.forum_id) as result
+ FROM forums_forums f, dotlrn_communities_full com
+ WHERE com.community_id=:comm_id
+ and apm_package__parent_id(f.package_id) = com.package_id
}
-
+
return $result
}
-
-ad_proc -callback application-track::getSpecificInfo -impl forums {} {
+
+ad_proc -callback application-track::getSpecificInfo -impl forums {} {
Callback implementation.
} {
-
+
upvar $query_name my_query
upvar $elements_name my_elements
set my_query {
- SELECT f.name as name,f.thread_count as threads,
- f.last_post,
- to_char(o.creation_date, 'YYYY-MM-DD HH24:MI:SS') as creation_date
- FROM forums_forums f,dotlrn_communities_full com,acs_objects o
- WHERE com.community_id=:class_instance_id
- and f.forum_id = o.object_id
- and apm_package__parent_id(f.package_id) = com.package_id
+ SELECT f.name as name,f.thread_count as threads,
+ f.last_post,
+ to_char(o.creation_date, 'YYYY-MM-DD HH24:MI:SS') as creation_date
+ FROM forums_forums f,dotlrn_communities_full com,acs_objects o
+ WHERE com.community_id=:class_instance_id
+ and f.forum_id = o.object_id
+ and apm_package__parent_id(f.package_id) = com.package_id
}
-
+
set my_elements {
name {
label "Name"
- display_col name
- html {align center}
-
+ display_col name
+ html {align center}
+
}
threads {
label "Threads"
- display_col threads
- html {align center}
+ display_col threads
+ html {align center}
}
creation_date {
label "creation_date"
- display_col creation_date
- html {align center}
+ display_col creation_date
+ html {align center}
}
last_post {
label "last_post"
- display_col last_post
- html {align center}
- }
+ display_col last_post
+ html {align center}
+ }
}
return "OK"
Index: openacs-4/packages/logger/tcl/util-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/logger/tcl/util-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/logger/tcl/util-procs.tcl 12 Feb 2019 17:12:19 -0000 1.6
+++ openacs-4/packages/logger/tcl/util-procs.tcl 12 Feb 2019 17:28:59 -0000 1.7
@@ -1,7 +1,7 @@
ad_library {
Procedures in the logger::util namespace. Contains
helper procedures used by the package.
-
+
@creation-date 2003-04-22
@author Peter Marklund (peter@collaboraid.biz)
@cvs-id $Id$
@@ -34,7 +34,7 @@
upvar $variable_name $variable_name
set $variable_name ""
}
- }
+ }
}
ad_proc -private logger::util::lookup_ad_conn_var_name {
@@ -68,13 +68,13 @@
logger instance is set up to be integrated in project-manager.
This is set in the project-manager admin pages. Currently, this
proc assumes it is called from within logger.
-
+
@author Jade Rubick (jader@bread.com)
@creation-date 2004-05-24
-
+
@return empty string if there is no linked in project-manager
-
- @error
+
+ @error
} {
set package_id [ad_conn package_id]
@@ -87,14 +87,14 @@
-package_id:required
} {
Memoized portion of project_manager_url
-
+
@author Jade Rubick (jader@bread.com)
@creation-date 2004-05-24
@see logger::util::project_manager_url
-
- @return
-
+
+ @return
+
@error empty string if project manager is not installed
} {
@@ -107,13 +107,13 @@
ad_proc -public logger::util::project_manager_linked_p {
} {
Returns 1 if there is a project manager linked to this instance
-
+
@author Jade Rubick (jader@bread.com)
@creation-date 2004-06-03
-
- @return
-
- @error
+
+ @return
+
+ @error
} {
set url [logger::util::project_manager_url]
@@ -123,3 +123,9 @@
return 1
}
}
+
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/logger/tcl/variable-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/logger/tcl/variable-procs.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/logger/tcl/variable-procs.tcl 12 Feb 2019 17:12:19 -0000 1.12
+++ openacs-4/packages/logger/tcl/variable-procs.tcl 12 Feb 2019 17:28:59 -0000 1.13
@@ -1,7 +1,7 @@
ad_library {
Procedures in the logger::variable namespace. Those procedures
operate on logger variable objects.
-
+
@creation-date 4:th of April 2003
@author Peter Marklund (peter@collaboraid.biz)
@cvs-id $Id$
@@ -22,7 +22,7 @@
@param variable_id Any pre-generated id of the variable. Optional.
@param name The name of the new variable. Required.
- @param unit The unit of the variable, for example hours, minutes, or
+ @param unit The unit of the variable, for example hours, minutes, or
a currency code such as USD or EUR.
@param type Must be either additive (default) or non-additive.
@param pre_installed_p Indicates whether this is a variable that is comes pre-installed
@@ -33,11 +33,11 @@
@author Peter Marklund
} {
ad_assert_arg_value_in_list type {additive non-additive}
-
+
set name [lang::util::convert_to_i18n -package_key "logger" -prefix "name" -text $name]
set unit [lang::util::convert_to_i18n -package_key "logger" -prefix "unit" -text $unit]
- # Use ad_conn to initialize variables
+ # Use ad_conn to initialize variables
logger::util::set_vars_from_ad_conn {package_id creation_user creation_ip}
if { $pre_installed_p } {
@@ -53,7 +53,7 @@
-party_id [acs_magic_object registered_users] \
-object_id $variable_id \
-privilege read
- }
+ }
return $variable_id
}
@@ -76,7 +76,7 @@
@author Peter Marklund
} {
ad_assert_arg_value_in_list type {additive non-additive}
-
+
set package_id [ad_conn package_id]
db_dml update_variable {}
@@ -100,7 +100,7 @@
{-variable_id:required}
{-array:required}
} {
- Retrieve attributes of the variable with given id into an
+ Retrieve attributes of the variable with given id into an
array (using upvar) in the callers scope. The
array will contain the keys variable_id, name, unit, and type.
@@ -140,3 +140,9 @@
return $variable_id
}
+
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/news/tcl/test/news-db-test-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/news/tcl/test/news-db-test-init.tcl,v
diff -u -r1.19 -r1.20
--- openacs-4/packages/news/tcl/test/news-db-test-init.tcl 12 Feb 2019 17:12:19 -0000 1.19
+++ openacs-4/packages/news/tcl/test/news-db-test-init.tcl 12 Feb 2019 17:28:59 -0000 1.20
@@ -136,7 +136,7 @@
_news_cr_news_root_folder_id
} {
aa_export_vars {_news_cr_root_folder_id _news_cr_news_root_folder_id}
-
+
set _news_cr_root_folder_id [content::item::get_root_folder]
set p_parent_id $_news_cr_root_folder_id
set _news_cr_news_root_folder_id [db_string get-cr-news-root-folder {
@@ -163,7 +163,7 @@
news_id
} {
aa_export_vars {p_full_details p_title p_text p_package_id p_is_live
- p_approval_user p_approval_ip p_approval_date p_archive_date
+ p_approval_user p_approval_ip p_approval_date p_archive_date
news_id}
if {$p_full_details == "t"} {
set p_approval_user [ad_conn "user_id"]
@@ -224,10 +224,10 @@
Populates:
revision_id
} {
- aa_export_vars {p_item_id
+ aa_export_vars {p_item_id
p_full_details p_title p_text p_package_id p_make_active_revision_p
p_description
- p_approval_user p_approval_ip p_approval_date p_archive_date
+ p_approval_user p_approval_ip p_approval_date p_archive_date
revision_id}
if {$p_full_details == "t"} {
set p_approval_user [ad_conn "user_id"]
@@ -371,7 +371,7 @@
set retrieval_ok_p 1
if {![db_0or1row get-cr-news-row {
select package_id, archive_date,
- approval_user, approval_date, approval_ip
+ approval_user, approval_date, approval_ip
from cr_news
where news_id = :p_news_id
}]} {
@@ -646,7 +646,7 @@
db
config
} -on_error {
- The "news" object type doesn't exist, or has isn't configured correctly.
+ The "news" object type doesn't exist, or has isn't configured correctly.
The most probable cause of this is that the news package datamodel hasn't been
installed.
} "check_object_type" {
@@ -797,7 +797,7 @@
# Call the news.name function to retrieve the item name.
#
aa_log "Call news.name function to retrieve title of content revision"
- set p_news_id $news_id
+ set p_news_id $news_id
set name [db_exec_plsql news-name {}]
aa_equals "Check the return from news.name is correct" $name $p_title
}
@@ -820,7 +820,7 @@
set p_item_id $item_id
aa_call_component db-get-cr-items-row
aa_false "Check the cr_items row was deleted" {$retrieval_ok_p}
-
+
set p_revision_id $news_id
aa_call_component db-get-cr-revisions-row
aa_false "Check the cr_revisions row was deleted" {$retrieval_ok_p}
Index: openacs-4/packages/news/www/item-create-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/news/www/item-create-3.tcl,v
diff -u -r1.23 -r1.24
--- openacs-4/packages/news/www/item-create-3.tcl 12 Feb 2019 17:12:19 -0000 1.23
+++ openacs-4/packages/news/www/item-create-3.tcl 12 Feb 2019 17:28:59 -0000 1.24
@@ -36,7 +36,7 @@
#
# the news_admin or an open approval policy allow immediate publishing
#
-if { $news_admin_p == 1 || $approval_policy eq "open" } {
+if { $news_admin_p == 1 || $approval_policy eq "open" } {
set approval_user [ad_conn user_id]
set approval_ip [ad_conn peeraddr]
set approval_date [dt_sysdate]
@@ -51,7 +51,7 @@
# Allow the user to "never expire" a news item.
if {$permanent_p == "t"} {
set archive_date_ansi ""
-}
+}
# get creation_foo
set creation_date [dt_sysdate]
@@ -80,9 +80,9 @@
# case: user submitted news item, is returned to a Thank-you page
set title [_ news.News_item_submitted]
set context [list $title]
- ad_return_template item-create-thankyou
+ ad_return_template item-create-thankyou
}
-} else {
+} else {
# case: administrator returned to index page
ad_returnredirect ""
ad_script_abort
Index: openacs-4/packages/news/www/admin/approve-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/news/www/admin/approve-2.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/news/www/admin/approve-2.tcl 12 Feb 2019 17:12:19 -0000 1.10
+++ openacs-4/packages/news/www/admin/approve-2.tcl 12 Feb 2019 17:28:59 -0000 1.11
@@ -5,12 +5,12 @@
This page makes the insert of publish_date and archive_date (optionally)
into cr_revisions and cr_news(news_id) resp. without intermediate confirmation.
The administrator is redirected to return_url:localurl
-
+
@author stefan@arsdigita.com
@creation-date 2000-12-20
@cvs-id $Id$
-} {
+} {
revision_id:naturalnum,notnull
{return_url:localurl ""}
{permanent_p:boolean "f"}
@@ -32,10 +32,10 @@
set archive_date_ansi $archive_date(date)
if { [dt_interval_check $archive_date_ansi $publish_date_ansi] >= 0 } {
- ad_return_error "[_ news.Scheduling_Error]" \
- "[_ news.lt_The_archive_date_must]"
+ ad_return_error "[_ news.Scheduling_Error]" \
+ "[_ news.lt_The_archive_date_must]"
ad_script_abort
- }
+ }
}
@@ -46,9 +46,9 @@
foreach id $revision_id {
-
- db_exec_plsql news_item_approve_publish {}
+ db_exec_plsql news_item_approve_publish {}
+
}
set package_id [ad_conn package_id]
if {[rss_support::subscription_exists \
Index: openacs-4/packages/news/www/admin/revision-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/news/www/admin/revision-add-3.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/news/www/admin/revision-add-3.tcl 12 Feb 2019 17:12:19 -0000 1.17
+++ openacs-4/packages/news/www/admin/revision-add-3.tcl 12 Feb 2019 17:28:59 -0000 1.18
@@ -2,14 +2,14 @@
ad_page_contract {
- This page adds a new revision to a news item
+ This page adds a new revision to a news item
and redirects to the item page of that item
@author stefan@arsdigita.com
@creation-date 2000-12-20
@cvs-id $Id$
-} {
+} {
item_id:naturalnum,notnull
publish_title:notnull
publish_lead
@@ -26,35 +26,35 @@
if {$permanent_p == "t"} {
set archive_date_ansi ""
-}
+}
# approval foo
set approval_user [ad_conn "user_id"]
set approval_ip [ad_conn "peeraddr"]
set approval_date [dt_sysdate]
set live_revision_p "t"
-# creation foo
+# creation foo
set creation_ip [ad_conn "peeraddr"]
set creation_user [ad_conn "user_id"]
# make new revision the active revision
set active_revision_p "t"
# Insert is 2-step process, same as in item-create-3.tcl
-if {[catch {
+if {[catch {
set revision_id [db_exec_plsql create_news_item_revision {}]
set content_add [db_map content_add]
- if {![string match $content_add ""]} {
- db_dml content_add {
+ if {![string match $content_add ""]} {
+ db_dml content_add {
update cr_revisions
set content = empty_blob()
where revision_id = :revision_id
returning content into :1
} -blobs [list $publish_body]
}
-
+
} errmsg ]} {
set complaint " [_ news.lt_The_database_did_not_] \
Index: openacs-4/packages/photo-album/www/photo-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/photo-album/www/photo-add-2.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/photo-album/www/photo-add-2.tcl 12 Feb 2019 17:12:19 -0000 1.12
+++ openacs-4/packages/photo-album/www/photo-add-2.tcl 12 Feb 2019 17:28:59 -0000 1.13
@@ -17,36 +17,36 @@
{story ""}
} -validate {
valid_album -requires {album_id:integer} {
- if [string equal [pa_is_album_p $album_id] "f"] {
- ad_complain "The specified album is not valid."
- }
+ if [string equal [pa_is_album_p $album_id] "f"] {
+ ad_complain "The specified album is not valid."
+ }
}
valid_mime_type {
-
+
if { ![parameter::get -parameter ConverttoJpgorPng -package_id [ad_conn package_id] -default 1] } {
-
- if { [catch {set photo_info [pa_file_info ${upload_file.tmpfile}]} errMsg] } {
- ns_log Warning "Error parsing file data Error: $errMsg"
- ad_complain "error"
- }
-
- lassign $photo_info base_bytes base_width base_height base_type base_mime base_colors base_quantum base_sha256
-
- if {$base_mime eq ""} {
- set base_mime invalid
- }
-
- if ![regexp $base_mime [parameter::get -parameter AcceptableUploadMIMETypes -package_id [ad_conn package_id]]] {
- ad_complain "[_ photo-album._The_5]"
- ad_complain "[_ photo-album._The_6]"
- }
- }
+
+ if { [catch {set photo_info [pa_file_info ${upload_file.tmpfile}]} errMsg] } {
+ ns_log Warning "Error parsing file data Error: $errMsg"
+ ad_complain "error"
+ }
+
+ lassign $photo_info base_bytes base_width base_height base_type base_mime base_colors base_quantum base_sha256
+
+ if {$base_mime eq ""} {
+ set base_mime invalid
+ }
+
+ if ![regexp $base_mime [parameter::get -parameter AcceptableUploadMIMETypes -package_id [ad_conn package_id]]] {
+ ad_complain "[_ photo-album._The_5]"
+ ad_complain "[_ photo-album._The_6]"
+ }
+ }
}
valid_photo_id -requires {photo_id:integer} {
- # supplied photo_id must not already exist
+ # supplied photo_id must not already exist
if {[db_string check_photo_id {}]} {
- ad_complain "The photo already exists. Check if it is already in the album."
- }
+ ad_complain "The photo already exists. Check if it is already in the album."
+ }
}
}
@@ -58,16 +58,22 @@
permission::require_permission -object_id $album_id -privilege "pa_create_photo"
set new_photo_ids [pa_load_images \
- -remove 1 \
- -client_name $upload_file \
- -description $description \
- -story $story \
- -caption $caption \
- ${upload_file.tmpfile} $album_id $user_id]
+ -remove 1 \
+ -client_name $upload_file \
+ -description $description \
+ -story $story \
+ -caption $caption \
+ ${upload_file.tmpfile} $album_id $user_id]
pa_flush_photo_in_album_cache $album_id
# page used as part of redirect so user returns to the album page containing the newly uploaded photo
set page [pa_page_of_photo_in_album [lindex $new_photo_ids 0] $album_id]
ad_returnredirect "album?album_id=$album_id&page=$page"
+
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/spam/tcl/spam-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/spam/tcl/spam-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/spam/tcl/spam-procs.tcl 12 Feb 2019 17:12:19 -0000 1.3
+++ openacs-4/packages/spam/tcl/spam-procs.tcl 12 Feb 2019 17:28:59 -0000 1.4
@@ -4,36 +4,36 @@
@author Bill Schneider (bschneid@arsdigita.com)
}
-ad_proc spam_package_key {} {
+ad_proc spam_package_key {} {
returns the package key in apm_packages for the spam package;
'spam' by default
-} {
+} {
return "spam"
}
-ad_proc spam_package_id {} {
+ad_proc spam_package_id {} {
returns the package key in apm_packages for the spam package;
'spam' by default
-} {
+} {
return [db_string spam_get_package_id "
- select min(package_id) from apm_packages
- where package_key = '[spam_package_key]'
+ select min(package_id) from apm_packages
+ where package_key = '[spam_package_key]'
"]
}
-ad_proc -public spam_base {} {
+ad_proc -public spam_base {} {
returns the base URL of the spam system.
} {
return [util_memoize {
- db_string spam_base_query "
- select
- site_node.url(node_id)
- from
- site_nodes, apm_packages
- where
- object_id=package_id and package_key='[spam_package_key]'
- "}]
+ db_string spam_base_query "
+ select
+ site_node.url(node_id)
+ from
+ site_nodes, apm_packages
+ where
+ object_id=package_id and package_key='[spam_package_key]'
+ "}]
}
@@ -47,38 +47,38 @@
{-sql ""}
{-approved_p ""}
} {
- insert a new spam message into the acs_messages and spam_messages
+ insert a new spam message into the acs_messages and spam_messages
table, and indirectly into the content repository.
Requires that send_date be a string in the format
"YYYY-MM-DD HH:MI:SS AM"; nearly ANSI but 12-hour time with AM/PM
} {
- # TilmannS: add a leading zero to the time, otherwise postgresql's
- # to_timestamp chokes. The default (produced by
- # spam_timeentrywidget, which uses ns_dbformvalueput) brings us a
- # string like this: '2001-08-31 7:45:00 PM' but we need something
- # like that: '2001-08-31 07:45:00 PM'. Not the most elegant
- # solution and not meant to be final - in my opinion the
- # time_widget needs some overall improvement here (is there
- # something general in ACS for this kind of stuff?).
- regsub { (\d):} $send_date { 0\1:} send_date
+# TilmannS: add a leading zero to the time, otherwise postgresql's
+# to_timestamp chokes. The default (produced by
+# spam_timeentrywidget, which uses ns_dbformvalueput) brings us a
+# string like this: '2001-08-31 7:45:00 PM' but we need something
+# like that: '2001-08-31 07:45:00 PM'. Not the most elegant
+# solution and not meant to be final - in my opinion the
+# time_widget needs some overall improvement here (is there
+# something general in ACS for this kind of stuff?).
+regsub { (\d):} $send_date { 0\1:} send_date
set sql_proc "
begin
- :1 := spam.new (
- spam_id => :spam_id,
- send_date => to_date(:send_date, 'yyyy-mm-dd hh:mi:ss AM'),
- title => :subject,
- sql_query => :sql,
- html_text => :html,
- plain_text => :plain,
- creation_user => [ad_get_user_id],
- creation_ip => '[ad_conn peeraddr]',
- context_id => :context_id,
- approved_p => :approved_p
- );
- end;"
-
+ :1 := spam.new (
+ spam_id => :spam_id,
+ send_date => to_date(:send_date, 'yyyy-mm-dd hh:mi:ss AM'),
+ title => :subject,
+ sql_query => :sql,
+ html_text => :html,
+ plain_text => :plain,
+ creation_user => [ad_get_user_id],
+ creation_ip => '[ad_conn peeraddr]',
+ context_id => :context_id,
+ approved_p => :approved_p
+ );
+ end;"
+
set user_id [ad_get_user_id]
set peeraddr [ad_conn peeraddr]
@@ -93,22 +93,22 @@
{-html ""}
{-sql ""}
} {
- update an existing spam message into the acs_messages and spam_messages
+ update an existing spam message into the acs_messages and spam_messages
table, and indirectly into the content repository.
Requires that send_date be a string in the format
"YYYY-MM-DD HH:MI:SS AM"; nearly ANSI but 12-hour time with AM/PM
} {
set sql_proc "
begin
- spam.edit (
- spam_id => :spam_id,
- send_date => to_date(:send_date, 'yyyy-mm-dd hh:mi:ss AM'),
- title => :subject,
- sql_query => :sql,
- html_text => :html,
- plain_text => :plain
- );
- end;"
+ spam.edit (
+ spam_id => :spam_id,
+ send_date => to_date(:send_date, 'yyyy-mm-dd hh:mi:ss AM'),
+ title => :subject,
+ sql_query => :sql,
+ html_text => :html,
+ plain_text => :plain
+ );
+ end;"
# TilmannS: add a leading zero to the time, otherwise postgresql's
# to_timestamp chokes. The default (produced by
@@ -119,24 +119,24 @@
# time_widget needs some overall improvement here (is there
# something general in ACS for this kind of stuff?).
regsub { (\d):} $send_date { 0\1:} send_date
-
+
return [db_exec_plsql spam_update_message $sql_proc]
}
-ad_proc spam_send_immediate {msg_id} {
+ad_proc spam_send_immediate {msg_id} {
Sends the previously-entered spam message with id
- msg_id immediately by immediately queueing it in
+ msg_id immediately by immediately queueing it in
the outgoing acs_mail_queue_outgoing table.
} {
db_dml spam_update_for_immediate_send {
- spam_put_in_outgoing_queue $msg_id
- acs_mail_process_queue
+ spam_put_in_outgoing_queue $msg_id
+ acs_mail_process_queue
}
}
-ad_proc -private spam_put_in_outgoing_queue {spam_id} {
+ad_proc -private spam_put_in_outgoing_queue {spam_id} {
puts a single spam messages in the outgoing queue immediately.
requires approved_p to be true, which should generally be redundant
(that is, program logic should check for approval before calling
@@ -145,74 +145,74 @@
set spam_sender [ad_parameter -package_id [spam_package_id] SpamSender]
db_1row spam_get_outgoing_message {
- select body_id, send_date, sql_query, context_id,
- creation_date, creation_user, creation_ip
- from spam_messages, acs_objects, acs_mail_links
- where
- object_id = spam_id
- and mail_link_id = spam_id
- and spam_id = :spam_id
- and approved_p = 't'
- }
+ select body_id, send_date, sql_query, context_id,
+ creation_date, creation_user, creation_ip
+ from spam_messages, acs_objects, acs_mail_links
+ where
+ object_id = spam_id
+ and mail_link_id = spam_id
+ and spam_id = :spam_id
+ and approved_p = 't'
+ }
set recipients [db_list spam_get_recipients "
- select email from parties, ($sql_query) p2
- where p2.party_id = parties.party_id
+ select email from parties, ($sql_query) p2
+ where p2.party_id = parties.party_id
"]
db_transaction {
- foreach email $recipients {
+ foreach email $recipients {
set id [db_exec_plsql spam_insert_into_outgoing {
begin
:1 := acs_mail_queue_message.new (
- body_id => :body_id,
- context_id => :context_id,
- creation_date => :creation_date,
- creation_user => :creation_user,
- creation_ip => :creation_ip
- );
+ body_id => :body_id,
+ context_id => :context_id,
+ creation_date => :creation_date,
+ creation_user => :creation_user,
+ creation_ip => :creation_ip
+ );
end;
}]
- db_dml spam_set_outgoing_addresses {
- insert into acs_mail_queue_outgoing
- (message_id, envelope_from, envelope_to)
- values
- (:id, :spam_sender, :email)
- }
- }
- db_dml spam_set_sent_p {
- update spam_messages
- set sent_p = 't'
- where spam_id = :spam_id
- }
+ db_dml spam_set_outgoing_addresses {
+ insert into acs_mail_queue_outgoing
+ (message_id, envelope_from, envelope_to)
+ values
+ (:id, :spam_sender, :email)
+ }
+ }
+ db_dml spam_set_sent_p {
+ update spam_messages
+ set sent_p = 't'
+ where spam_id = :spam_id
+ }
}
}
-ad_proc spam_sweeper {} {
+ad_proc spam_sweeper {} {
sweeps the spam_messages table for spams that have been approved but
not yet been sent, but are due to be sent. All of these messages will
be inserted into the acs_mail_queue_outgoing table (once per recipient)
- and also in acs_mail_queue_messages (once total).
+ and also in acs_mail_queue_messages (once total).
} {
set spam_list [db_list spam_get_list_of_outgoing_messages {
- select spam_id
- from spam_messages
- where
- sysdate >= send_date
- and approved_p = 't'
- and sent_p = 'f'
+ select spam_id
+ from spam_messages
+ where
+ sysdate >= send_date
+ and approved_p = 't'
+ and sent_p = 'f'
}]
foreach spam_id $spam_list {
- spam_put_in_outgoing_queue $spam_id
+ spam_put_in_outgoing_queue $spam_id
}
}
ad_proc spam_p {spam_id} {
return 1 if spam_id is a valid spam message, 0 if not
} {
- return [db_string spam_p_count
- "select count(spam_id) from spam_messages where spam_id = :spam_id"
+ return [db_string spam_p_count
+ "select count(spam_id) from spam_messages where spam_id = :spam_id"
]
}
@@ -221,19 +221,21 @@
time
} {
if {$default != ""} {
- set timestamp $default
+ set timestamp $default
} else {
- set timestamp [lindex [split [ns_localsqltimestamp] " "] 1]
+ set timestamp [lindex [split [ns_localsqltimestamp] " "] 1]
}
set output " "
+