Index: openacs-4/contrib/packages/forums/forums.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/Attic/forums.info,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/forums.info 23 Jan 2007 13:24:02 -0000 1.1
@@ -0,0 +1,42 @@
+
+
+
+
+ Forums
+ Forums
+ f
+ f
+
+
+ OpenACS
+ Online discussion forums.
+ 2006-05-10
+ OpenACS
+ This online discussion board software is the successor of the original bboard package. The biggest improvement is a scalable datamodel. Forums supports threaded and flat view, moderation, a stand alone search function as well as integration with the OpenACS search package and integration with the notifications package for email alerts. It also supports reply via email.
+ 0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: openacs-4/contrib/packages/forums/lib/forums-portlet-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/Attic/forums-portlet-oracle.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums-portlet-oracle.xql 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,49 @@
+
+oracle
+
+
+
+SELECT r.* FROM (
+SELECT
+ b.subject AS subject,
+ b.message_id AS thread_id,
+ a.message_id AS message_id
+FROM
+ (SELECT message_id, tree_sortkey, posting_date
+ FROM forums_messages
+ WHERE forum_id IN
+ (SELECT forum_id FROM forums_forums WHERE package_id =
+ :package_id and enabled_p = 't')
+ ORDER BY posting_date DESC) a,
+ forums_messages b
+WHERE
+ b.parent_id IS NULL
+ AND b.tree_sortkey = tree.ancestor_key(a.tree_sortkey, 1)
+ AND b.forum_id IN
+ (SELECT forum_id FROM forums_forums WHERE package_id = :package_id
+ and enabled_p = 't')
+ORDER BY a.posting_date DESC
+) r WHERE rownum <= $n
+
+
+
+
+
+SELECT r.*
+FROM
+(SELECT
+ subject, message_id
+FROM
+ forums_messages_approved
+WHERE
+ forum_id IN
+ (SELECT forum_id FROM forums_forums WHERE package_id = :package_id
+ and enabled_p = 't')
+ AND parent_id IS NULL
+ORDER BY
+ posting_date DESC) r
+WHERE rownum <= $n
+
+
+
+
\ No newline at end of file
Index: openacs-4/contrib/packages/forums/lib/forums-portlet-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/Attic/forums-portlet-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums-portlet-postgresql.xql 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,39 @@
+
+postgresql7.3
+
+
+SELECT
+ b.subject AS subject,
+ b.message_id AS thread_id,
+ a.message_id AS message_id
+FROM
+ (SELECT message_id, tree_sortkey, posting_date
+ FROM forums_messages
+ WHERE forum_id IN
+ (SELECT forum_id FROM forums_forums WHERE package_id = :package_id
+ and enabled_p = 't')
+ ORDER BY posting_date DESC LIMIT $n) a,
+ forums_messages b
+WHERE
+ b.parent_id IS NULL
+ AND b.tree_sortkey = tree_root_key(a.tree_sortkey)
+ AND b.forum_id IN
+ (SELECT forum_id FROM forums_forums WHERE package_id = :package_id
+ and enabled_p = 't');
+
+
+
+SELECT
+ subject, message_id
+FROM
+ forums_messages_approved
+WHERE
+ forum_id IN
+ (SELECT forum_id FROM forums_forums WHERE package_id = :package_id
+ and enabled_p = 't')
+ AND parent_id IS NULL
+ORDER BY
+ posting_date DESC
+LIMIT $n
+
+
\ No newline at end of file
Index: openacs-4/contrib/packages/forums/lib/forums-portlet.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/Attic/forums-portlet.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums-portlet.adp 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,36 @@
+
+
+
Include for displaying the latest threads/posts in a forums instance.
+ Note this takes the following parameters - not declared with
+ ad_page_contract because it's an include:
+
+
+
package_id - the ID of the forums instance to use
+
base_url - absolute URL of the forums instance
+
n - the maximum number of threads/posts to list (default 2)
+
class - CSS class to wrap the include in (optional)
+
id - CSS id to wrap the include in (optional)
+
cache - cache interval, seconds, 0 for no cache (default)
+
show_empty_p - if set, show even if there are no contents (default 1)
+
+}
+
+# validate args
+if { ![exists_and_not_null package_id]
+ && ![exists_and_not_null base_url] } {
+ error "package_id and/or base_url must be given"
+}
+if { [info exists n] } {
+ # need to do a type check, as this is interpolated into the PG query
+ # (PG LIMIT clause doesn't accept bind vars)
+ if { ![string is integer $n] || ![expr $n > 0] } {
+ error "n must be an integer greater than 0"
+ }
+} else {
+ set n 2
+}
+if { ![info exists cache] || [expr $cache < 0] } {
+ set cache 0
+}
+if { ![exists_and_not_null package_id] } {
+ set package_id [site_node::get_element \
+ -url $base_url -element object_id]
+}
+if { ![exists_and_not_null base_url] } {
+ set base_url [lindex [site_node::get_url_from_object_id \
+ -object_id $package_id] 0]
+}
+if { ![info exists title] } {
+ set title [apm_instance_name_from_id $package_id]
+}
+if { ![info exists show_empty_p] } {
+ set show_empty_p 1
+}
+
+
+# obtain data (use list rather than multirow, as its easier to cache)
+# identification problems (need package_id + n as part of key)
+set new_topics_script "# /packages/forums/lib/forums-portlet.tcl
+set n $n
+db_list_of_lists new_topics {} -bind { package_id $package_id }"
+set hot_topics_script "# /packages/forums/lib/forums-portlet.tcl
+set n $n
+db_list_of_lists hot_topics {} -bind { package_id $package_id }"
+set new_topics_ds [util_memoize $new_topics_script $cache]
+set hot_topics_ds [util_memoize $hot_topics_script $cache]
+
+multirow create new_topics name url
+foreach row $new_topics_ds {
+ set name [lindex $row 0]
+ set thread_id [lindex $row 1]
+ set url "${base_url}message-view?message_id=$thread_id"
+ multirow append new_topics $name $url
+}
+
+multirow create hot_topics name url
+foreach row $hot_topics_ds {
+ set name [lindex $row 0]
+ set thread_id [lindex $row 1]
+ set message_id [lindex $row 2]
+ set url "${base_url}message-view?message_id=${thread_id}\#${message_id}"
+ multirow append hot_topics $name $url
+}
+
+ad_return_template
Index: openacs-4/contrib/packages/forums/lib/forums/admin-forums-chunk.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/admin-forums-chunk.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/admin-forums-chunk.adp 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1 @@
+
Index: openacs-4/contrib/packages/forums/lib/forums/admin-forums-chunk.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/admin-forums-chunk.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/admin-forums-chunk.tcl 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,75 @@
+ad_page_contract {
+
+ Forums Administration
+
+ @author Ben Adida (ben@openforce.net)
+ @creation-date 2002-05-24
+ @cvs-id $Id: admin-forums-chunk.tcl,v 1.1 2007/01/23 13:24:03 hamiltonc Exp $
+
+}
+set subsite_url [subsite::get_element -element url -notrailing]
+
+template::list::create \
+ -name forums \
+ -multirow forums \
+ -actions [list \
+ [_ forums.Create_a_New_Forum] forum-new {} \
+ [_ forums.Parameters] [export_vars -base "$subsite_url/shared/parameters" { { return_url [ad_return_url] } { package_id {[ad_conn package_id]} } }] {} \
+ [_ acs-subsite.Permissions] [export_vars -base "permissions" { { object_id {[ad_conn package_id]} } }] {}
+ ]\
+ -elements {
+ edit {
+ label {}
+ sub_class narrow
+ display_template {
+
+ }
+ link_url_col edit_url
+ }
+ name {
+ label "#forums.Forum_Name#"
+ link_url_col view_url
+ }
+ enabled {
+ label "Enabled"
+ html { align center }
+ display_template {
+
+
+
+
+
+
+ }
+ }
+ permissions {
+ label "#acs-subsite.Permissions#"
+ display_template "#acs-subsite.Permissions#"
+ link_url_col permissions_url
+ }
+ }
+
+
+# List of forums
+set package_id [ad_conn package_id]
+db_multirow -extend {
+ view_url
+ edit_url
+ permissions_url
+ enable_url
+ disable_url
+} forums select_forums {} {
+ if { [template::util::is_true $enabled_p] } {
+ set view_url [export_vars -base "[ad_conn package_url]forum-view" { forum_id }]
+ } else {
+ set view_url {}
+ }
+ set edit_url [export_vars -base "forum-edit" { forum_id }]
+ set permissions_url [export_vars -base permissions { { object_id $forum_id } }]
+ set enable_url [export_vars -base "forum-enable" { forum_id }]
+ set disable_url [export_vars -base "forum-disable" { forum_id }]
+}
+
+if {[exists_and_not_null alt_template]} {
+ ad_return_template $alt_template
+}
Index: openacs-4/contrib/packages/forums/lib/forums/admin-forums-chunk.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/admin-forums-chunk.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/admin-forums-chunk.xql 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,13 @@
+
+
+
+
+
+select forum_id, name, posting_policy, enabled_p
+from forums_forums
+where package_id= :package_id
+order by enabled_p desc, name
+
+
+
+
Index: openacs-4/contrib/packages/forums/lib/forums/edit.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/edit.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/edit.adp 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1 @@
+
Index: openacs-4/contrib/packages/forums/lib/forums/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/edit.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/edit.tcl 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,57 @@
+ad_page_contract {
+
+ Edit a Forum
+
+ @author Ben Adida (ben@openforce.net)
+ @creation-date 2002-05-25
+ @cvs-id $Id: edit.tcl,v 1.1 2007/01/23 13:24:03 hamiltonc Exp $
+
+} {
+}
+
+form create forum
+
+element create forum return_url \
+ -datatype text -widget hidden -optional
+
+element create forum forum_id \
+ -label [_ forums.Forum_ID] -datatype integer -widget hidden
+
+forums::form::forum forum
+
+if {[form is_valid forum]} {
+ template::form get_values forum return_url forum_id name charter presentation_type posting_policy new_threads_p
+
+ forum::edit -forum_id $forum_id \
+ -name $name \
+ -charter [template::util::richtext::get_property contents $charter] \
+ -presentation_type $presentation_type \
+ -posting_policy $posting_policy
+
+ forum::posting_policy_set -posting_policy $posting_policy \
+ -forum_id $forum_id
+
+ # Users can create new threads?
+ if {$new_threads_p} {
+ forum::new_questions_allow -forum_id $forum_id
+ } else {
+ forum::new_questions_deny -forum_id $forum_id
+ }
+
+ ad_returnredirect $return_url
+ ad_script_abort
+}
+
+if { [form is_request forum] } {
+ element set_properties forum return_url -value $return_url
+ element set_properties forum forum_id -value $forum(forum_id)
+ element set_properties forum name -value $forum(name)
+ element set_properties forum charter -value [template::util::richtext create $forum(charter) "text/html"]
+ element set_properties forum presentation_type -value $forum(presentation_type)
+ element set_properties forum posting_policy -value $forum(posting_policy)
+ element set_properties forum new_threads_p -value [forum::new_questions_allowed_p -forum_id $forum(forum_id)]
+}
+
+if {[exists_and_not_null alt_template]} {
+ ad_return_template $alt_template
+}
Index: openacs-4/contrib/packages/forums/lib/forums/forums-chunk-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/forums-chunk-oracle.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/forums-chunk-oracle.xql 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,23 @@
+
+
+
+ oracle8.1.6
+
+
+
+ select forums_forums_enabled.*,
+ approved_thread_count as n_threads,
+ to_char(last_post, 'YYYY-MM-DD HH24:MI:SS') as last_post_ansi,
+ case when last_post > (sysdate - 1) then 't' else 'f' end as new_p
+ from forums_forums_enabled
+ where forums_forums_enabled.package_id = :package_id
+ and (
+ forums_forums_enabled.posting_policy = 'open'
+ or forums_forums_enabled.posting_policy = 'moderated'
+ or 't' = acs_permission.permission_p(forums_forums_enabled.forum_id, :user_id, 'forum_read')
+ )
+ order by forums_forums_enabled.name
+
+
+
+
Index: openacs-4/contrib/packages/forums/lib/forums/forums-chunk-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/forums-chunk-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/forums-chunk-postgresql.xql 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,31 @@
+
+
+
+ postgresql7.1
+
+
+
+ select f.*,
+ approved_thread_count as n_threads,
+ to_char(last_post, 'YYYY-MM-DD HH24:MI:SS') as last_post_ansi,
+ case when last_post > (now() - interval '1 day') then 't' else 'f' end as new_p,
+ (select count(*)
+ from forums_messages
+ where forums_messages.forum_id = f.forum_id) as total_message_count,
+ (select count(*)
+ from forums_messages
+ where forums_messages.forum_id = f.forum_id
+ and posting_date > (now() - interval '1 day')) as new_message_count
+ from $table_name f
+ where f.package_id = :package_id
+ and (
+ f.posting_policy = 'open'
+ or f.posting_policy = 'moderated'
+ or 't' = acs_permission__permission_p(f.forum_id, :user_id,'forum_read')
+ )
+ order by f.name
+
+
+
+
+
Index: openacs-4/contrib/packages/forums/lib/forums/forums-chunk.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/forums-chunk.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/forums-chunk.adp 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1 @@
+
Index: openacs-4/contrib/packages/forums/lib/forums/forums-chunk.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/forums-chunk.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/forums-chunk.tcl 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,120 @@
+ad_page_contract {
+
+ top level list of forums
+
+ @author Ben Adida (ben@openforce.net)
+ @creation-date 2002-05-24
+ @cvs-id $Id: forums-chunk.tcl,v 1.1 2007/01/23 13:24:03 hamiltonc Exp $
+
+}
+
+if { ! [exists_and_not_null package_id] } {
+ set package_id [ad_conn package_id]
+}
+set package_url [site_node::get_url_from_object_id -object_id $package_id]
+set user_id [ad_conn user_id]
+
+set admin_p [permission::permission_p -object_id $package_id -privilege admin]
+
+# get the colors from the params
+set table_border_color [parameter::get -parameter table_border_color]
+set table_bgcolor [parameter::get -parameter table_bgcolor]
+set table_other_bgcolor [parameter::get -parameter table_other_bgcolor]
+
+set actions [list]
+if { $admin_p && ![info exists hide_admin_buttons_p]} {
+ lappend actions [_ forums.New_Forum] "admin/forum-new" {}
+ lappend actions [_ forums.Administration] "admin/" {}
+}
+
+template::list::create \
+ -name forums \
+ -actions $actions \
+ -no_data [_ forums.No_Forums] \
+ -pass_properties {admin_p} \
+ -sub_class {forums} \
+ -elements {
+ name {
+ label {\#forums.Forum_Name\#}
+ display_template {
+
+
+ @forums.name@
+
+
+
+ @forums.charter;noquote@
+ }
+ }
+ subscribe {
+ label {[_ forums.Subscription]}
+ display_template {
+
+ UNSUBSCRIBE
+ SUBSCRIBE
+
+ }
+ html { align center }
+ }
+ n_threads {
+ label {\#forums.Threads\#}
+ display_col n_threads_pretty
+ sub_class forums-thread
+ html { align right }
+ }
+ last_post {
+ label {\#forums.Last_Post\#}
+ display_col last_modified_pretty
+ }
+ message_counts {
+ label "MESSAGES"
+ display_template {
+ @forums.new_message_count@ NEW
+ \[@forums.total_message_count@ Total\]
+ }
+ }
+ actions {
+ display_template {
+
+ EDIT
+ @forums.forum_disable_text@
+
+ }
+ }
+ }
+
+if {$admin_p} {
+ set table_name forums_forums
+} {
+ set table_name forums_forums_enabled
+}
+
+db_multirow -extend { forum_view_url last_modified_pretty n_threads_pretty forum_disable_url forum_edit_url forum_disable_text subscribed_p notif_url } forums select_forums {} {
+ set last_modified_pretty [lc_time_fmt $last_post_ansi "%x %X"]
+ set forum_view_url [export_vars -base ${package_url}forum-view { forum_id }]
+ set n_threads_pretty [lc_numeric $n_threads]
+ set return_url [ad_return_url]
+ if {$enabled_p == "t"} {
+ set forum_disable_url [export_vars -base "${package_url}admin/forum-disable" { forum_id return_url }]
+ set forum_disable_text DISABLE
+ } else {
+ set forum_disable_url [export_vars -base "${package_url}admin/forum-enable" { forum_id return_url }]
+ set forum_disable_text ENABLE
+ }
+ set forum_edit_url [export_vars -base "${package_url}admin/forum-edit" { forum_id return_url }]
+
+ set type_id [notification::type::get_type_id -short_name forums_forum_notif]
+ set request_id [notification::request::get_request_id -type_id $type_id -object_id $forum_id -user_id $user_id]
+
+ if { $request_id eq "" } {
+ set subscribed_p 0
+ set notif_url [notification::display::subscribe_url -type forums_forum_notif -object_id $forum_id -url $return_url -user_id $user_id -pretty_name $name]
+ } else {
+ set subscribed_p 1
+ set notif_url [notification::display::unsubscribe_url -request_id $request_id -url $return_url]
+ }
+}
+
+if {[exists_and_not_null alt_template]} {
+ ad_return_template $alt_template
+}
Index: openacs-4/contrib/packages/forums/lib/forums/forums-history-chunk.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/lib/forums/Attic/forums-history-chunk.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/lib/forums/forums-history-chunk.adp 23 Jan 2007 13:24:03 -0000 1.1
@@ -0,0 +1,42 @@
+
"
+
+ }
+
+ set html_version $html_version
+
+ set text_version ""
+ append text_version "
+Forum: $message(forum_name)
+Thread: $message(root_message_id)
+Author: $message(user_name)
+Posted: $message(posting_date)
+----------------------------------
+$message_text
+---------------------------------
+To post a reply to this email or view this message go to:
+${url}message-view?message_id=$message(root_message_id)
+
+To view Forum $message(forum_name) go to:
+${url}forum-view?forum_id=$message(forum_id)
+"
+ # Do the notification for the forum
+ notification::new \
+ -type_id [notification::type::get_type_id \
+ -short_name forums_forum_notif] \
+ -object_id $message(forum_id) \
+ -response_id $message(message_id) \
+ -notif_subject "\[$message(forum_name)\] $message(subject)" \
+ -notif_text $text_version \
+ -notif_html $html_version
+
+
+ # Eventually we need notification for the root message too
+ notification::new \
+ -type_id [notification::type::get_type_id \
+ -short_name forums_message_notif] \
+ -object_id $message(root_message_id) \
+ -response_id $message(message_id) \
+ -notif_subject "\[$message(forum_name)\] $message(subject)" \
+ -notif_text $text_version \
+ -notif_html $html_version
+}
+
+ad_proc -public forum::message::edit {
+ {-message_id:required}
+ {-subject:required}
+ {-content:required}
+ {-format:required}
+} {
+ Editing a message. There is no versioning here!
+ This means this function is for admins only!
+} {
+ # do the update
+ db_dml update_message {}
+ db_dml update_message_title {}
+}
+
+ad_proc -public forum::message::set_format {
+ {-message_id:required}
+ {-format:required}
+} {
+ set whether a message is HTML or not
+} {
+ # Straight update to the DB
+ db_dml update_message_format
+}
+
+ad_proc -public forum::message::get {
+ {-message_id:required}
+ {-array:required}
+} {
+ get the fields for a forum
+} {
+ # Select the info into the upvar'ed Tcl Array
+ upvar $array row
+
+ set query select_message
+
+ if {[ad_conn isconnected] && [forum::attachments_enabled_p]} {
+ set query select_message_with_attachment
+ }
+
+ if {![db_0or1row $query {} -column_array row]} {
+ if {[array exists row]} {
+ array unset row
+ }
+ } else {
+ # Convert to user's date/time format
+ set row(posting_date_ansi) [lc_time_system_to_conn $row(posting_date_ansi)]
+ set row(posting_date_pretty) [lc_time_fmt $row(posting_date_ansi) "%x %X"]
+ }
+}
+
+ad_proc -private forum::message::set_state {
+ {-message_id:required}
+ {-state:required}
+} {
+ Set the new state for a message
+ Usually used for approval
+} {
+ set var_list [list \
+ [list message_id $message_id] \
+ [list state $state]]
+ package_exec_plsql -var_list $var_list forums_message set_state
+}
+
+ad_proc -public forum::message::reject {
+ {-message_id:required}
+} {
+ Reject a message
+} {
+ set_state -message_id $message_id -state rejected
+}
+
+ad_proc -public forum::message::approve {
+ {-message_id:required}
+} {
+ approve a message
+} {
+ db_transaction {
+ set_state -message_id $message_id -state approved
+ do_notifications -message_id $message_id
+ }
+}
+
+ad_proc -public forum::message::delete {
+ {-message_id:required}
+} {
+ delete a message and obviously all of its descendents
+} {
+ db_transaction {
+ # Remove the notifications
+ notification::request::delete_all -object_id $message_id
+
+ # Remove the message
+ set var_list [list [list message_id $message_id]]
+ package_exec_plsql -var_list $var_list forums_message delete_thread
+ }
+}
+
+ad_proc -public forum::message::close {
+ {-message_id:required}
+} {
+ close a thread
+ This is not exactly a cheap operation if the thread is long
+} {
+ db_exec_plsql thread_close {}
+}
+
+ad_proc -public forum::message::open {
+ {-message_id:required}
+} {
+ reopen a thread
+ This is not exactly a cheap operation if the thread is long
+} {
+ db_exec_plsql thread_open {}
+}
+
+ad_proc -public forum::message::get_attachments {
+ {-message_id:required}
+} {
+ get the attachments for a message
+} {
+ # If attachments aren't enabled, then we stop
+ if {![forum::attachments_enabled_p]} {
+ return [list]
+ }
+
+ return [attachments::get_attachments -object_id $message_id]
+}
+
+ad_proc -public forum::message::subject_sort_filter {
+ -forum_id:required
+ -order_by:required
+} {
+ Return a piece of HTML for toggling the sort order of threads (subjects)
+ in a forum. The user can either sort by the first postings in subjects
+ (the creation date of the subjects) or the last one.
+
+ @author Peter Marklund
+} {
+ set subject_label "[_ forums.lt_First_post_in_subject]"
+ set child_label "[_ forums.Last_post_in_subject]"
+ set new_order_by [ad_decode $order_by posting_date last_child_post posting_date]
+
+ set export_vars [ad_export_vars -override [list [list order_by $new_order_by]] {order_by forum_id}]
+ set toggle_url "[ad_conn url]?${export_vars}"
+ if { [string equal $order_by posting_date] } {
+ # subject selected
+ set subject_link "$subject_label"
+ set child_link "$child_label"
+ } else {
+ # child selected
+ set subject_link "$subject_label"
+ set child_link "$child_label"
+ }
+ set sort_filter "$subject_link | $child_link"
+
+ return $sort_filter
+}
+
+ad_proc -public forum::message::initial_message {
+ {-forum_id {}}
+ {-parent {}}
+ {-message:required}
+} {
+ Create an array with values initialised for a new message.
+} {
+ upvar $message init_msg
+
+ if { [empty_string_p $forum_id] && [empty_string_p $parent] } {
+ return -code error [_ forums.lt_You_either_have_to]
+ }
+
+ if { ![empty_string_p $parent] } {
+ upvar $parent parent_msg
+
+ set init_msg(parent_id) $parent_msg(message_id)
+ set init_msg(forum_id) $parent_msg(forum_id)
+ set init_msg(subject) \
+ [forum::format::reply_subject $parent_msg(subject)]
+ } else {
+ set init_msg(forum_id) $forum_id
+ set init_msg(parent_id) ""
+ }
+}
Index: openacs-4/contrib/packages/forums/tcl/messages-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/tcl/Attic/messages-procs.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/tcl/messages-procs.xql 23 Jan 2007 13:24:06 -0000 1.1
@@ -0,0 +1,38 @@
+
+
+
+
+
+ update forums_messages
+ set format = :format
+ where message_id = :message_id
+
+
+
+
+
+ update acs_objects
+ set title = :subject
+ where object_id = :message_id and object_type = 'forums_message'
+
+
+
+
+
+ update forums_messages
+ set subject = :subject,
+ content = :content,
+ format = :format
+ where message_id = :message_id
+
+
+
+
+
+ select count(message_id)
+ from forums_messages
+ where message_id = :message_id
+
+
+
+
Index: openacs-4/contrib/packages/forums/tcl/test/forums-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/tcl/test/Attic/forums-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/tcl/test/forums-procs.tcl 23 Jan 2007 13:24:06 -0000 1.1
@@ -0,0 +1,303 @@
+ad_library {
+ Automated tests.
+
+ @author Simon Carstensen
+ @creation-date 15 November 2003
+ @author Gerardo Morales
+ @author Mounir Lallali
+ @cvs-id $Id: forums-procs.tcl,v 1.1 2007/01/23 13:24:06 hamiltonc Exp $
+}
+
+aa_register_case -cats {api smoke} forum_new {
+ Test the forum::new proc.
+} {
+
+ aa_run_with_teardown \
+ -rollback \
+ -test_code {
+
+ # Create forum
+ set forum_id [forum::new \
+ -name "foo" \
+ -package_id [ad_conn package_id]]
+
+ set success_p [db_string success_p {
+ select 1 from forums_forums where forum_id = :forum_id
+ } -default "0"]
+
+ aa_equals "forum was created succesfully" $success_p 1
+ }
+}
+
+aa_register_case -cats {api smoke} forum_message_new {
+ Test the forum::message::new proc.
+} {
+
+ aa_run_with_teardown \
+ -rollback \
+ -test_code {
+
+ # Create forum
+ set forum_id [forum::new \
+ -name "foo" \
+ -package_id [ad_conn package_id]]
+
+ # Create message
+ set message_id [forum::message::new \
+ -forum_id $forum_id \
+ -subject "foo" \
+ -content "foo"]
+
+ set success_p [db_string success_p {
+ select 1 from forums_messages where message_id = :message_id
+ } -default "0"]
+
+ aa_equals "message was created succesfully" $success_p 1
+ }
+}
+
+aa_register_case -cats {db smoke} forum_count_test {
+ Test the thread count and reply count tracking code.
+} {
+
+ aa_run_with_teardown \
+ -rollback \
+ -test_code {
+
+ # Create open forum
+ set forum_id [forum::new \
+ -name foo \
+ -package_id [ad_conn package_id]]
+
+ forum::get -forum_id $forum_id -array forum
+ aa_equals "New forum has zero approved threads" $forum(approved_thread_count) 0
+ aa_equals "New forum has zero threads" $forum(thread_count) 0
+
+ # Create message
+ set message_id [forum::message::new \
+ -forum_id $forum_id \
+ -subject foo \
+ -content foo]
+
+ forum::get -forum_id $forum_id -array forum
+ aa_equals "After post forum has one approved thread" $forum(approved_thread_count) 1
+ aa_equals "After post forum has one threads" $forum(thread_count) 1
+
+ forum::message::get -message_id $message_id -array message
+ aa_equals "New post has zero approved replies" $message(approved_reply_count) 0
+ aa_equals "New post has zero threads" $message(reply_count) 0
+
+ set reply_id [forum::message::new \
+ -forum_id $forum_id \
+ -parent_id $message_id \
+ -subject foo \
+ -content foo]
+
+ forum::get -forum_id $forum_id -array forum
+ aa_equals "After reply forum has one approved thread" $forum(approved_thread_count) 1
+ aa_equals "After reply forum has one thread" $forum(thread_count) 1
+
+ forum::message::get -message_id $message_id -array message
+ aa_equals "After reply post has one approved replies" $message(approved_reply_count) 1
+ aa_equals "After reply post has one reply" $message(reply_count) 1
+
+ # Create moderated forum
+ set forum_id [forum::new \
+ -name bar \
+ -posting_policy moderated \
+ -package_id [ad_conn package_id]]
+
+ # Create message
+ set message_id [forum::message::new \
+ -forum_id $forum_id \
+ -subject "foo" \
+ -content "foo"]
+
+ forum::get -forum_id $forum_id -array forum
+ aa_equals "After post moderated forum has zero approved threads" $forum(approved_thread_count) 0
+ aa_equals "After post moderated forum has one thread" $forum(thread_count) 1
+
+ set reply_id [forum::message::new \
+ -forum_id $forum_id \
+ -parent_id $message_id \
+ -subject "foo" \
+ -content "foo"]
+
+ forum::message::get -message_id $message_id -array message
+ aa_equals "After reply moderated post has zero approved replies" $message(approved_reply_count) 0
+ aa_equals "After reply moderated post has one reply" $message(reply_count) 1
+
+ forum::message::set_state -message_id $message_id -state approved
+
+ forum::get -forum_id $forum_id -array forum
+ aa_equals "After approval moderated forum has one approved thread" $forum(approved_thread_count) 1
+ aa_equals "After approval moderated forum has one thread" $forum(thread_count) 1
+
+ forum::message::set_state -message_id $reply_id -state approved
+
+ forum::message::get -message_id $message_id -array message
+ aa_equals "After reply approval post has one approved reply" $message(approved_reply_count) 1
+ aa_equals "After reply approval post has one reply" $message(reply_count) 1
+
+ forum::message::delete -message_id $message_id
+
+ forum::get -forum_id $forum_id -array forum
+ aa_equals "After deletion moderated forum has zero approved threads" $forum(approved_thread_count) 0
+ aa_equals "After deletion moderated forum has zero threads" $forum(thread_count) 0
+ }
+}
+
+
+aa_register_case -cats {web smoke} -libraries tclwebtest web_forum_new {
+ Testing the creation of a forum via web
+} {
+
+ aa_run_with_teardown -test_code {
+
+ tclwebtest::cookies clear
+
+ # Login user
+ array set user_info [twt::user::create -admin]
+ twt::user::login $user_info(email) $user_info(password)
+
+ # Create a new forum
+ set name [ad_generate_random_string]
+ set response [forums::twt::new "$name"]
+ aa_display_result -response $response -explanation {Webtest for the creation of a new Forum}
+
+ twt::user::logout
+ }
+
+}
+
+aa_register_case -cats {web smoke} -libraries tclwebtest web_forum_edit {
+ Testing the edition of an existing forum
+} {
+
+ aa_run_with_teardown -test_code {
+
+ tclwebtest::cookies clear
+
+ # Login user
+ array set user_info [twt::user::create -admin]
+ twt::user::login $user_info(email) $user_info(password)
+
+ # Create a forum
+ set name [ad_generate_random_string]
+ forums::twt::new "$name"
+
+ # Edit the created forum
+ set response [forums::twt::edit "$name"]
+ aa_display_result -response $response -explanation {Webtest for the edition of a forum}
+
+ twt::user::logout
+ }
+}
+
+aa_register_case -cats {web smoke} -libraries tclwebtest web_message_new {
+ Posting a new message to an existing forum
+} {
+
+
+ aa_run_with_teardown -test_code {
+
+ tclwebtest::cookies clear
+
+ # Login user
+ array set user_info [twt::user::create -admin]
+ twt::user::login $user_info(email) $user_info(password)
+
+ # Create a forum
+ set name [ad_generate_random_string]
+ forums::twt::new "$name"
+
+ # Post a message in the created forum
+ set subject [ad_generate_random_string]
+ set response [forums::twt::new_post "$name" "$subject"]
+ aa_display_result -response $response -explanation {Webtest for posting a message in a forum}
+
+ twt::user::logout
+ }
+}
+
+aa_register_case -cats {web smoke} -libraries tclwebtest web_message_edit {
+ Editing a message of a forum
+} {
+
+ aa_run_with_teardown -test_code {
+
+ tclwebtest::cookies clear
+
+ # Login user
+ array set user_info [twt::user::create -admin]
+ twt::user::login $user_info(email) $user_info(password)
+
+ # Create a forum
+ set name [ad_generate_random_string]
+ forums::twt::new "$name"
+
+ # Post a message in the created forum
+ set subject [ad_generate_random_string]
+ forums::twt::new_post "$name" "$subject"
+
+ # Edit the posted message
+ set response [forums::twt::edit_post "$name" "$subject"]
+ aa_display_result -response $response -explanation {Webtest for editing the message of a forum}
+
+ twt::user::logout
+ }
+}
+
+aa_register_case -cats {web smoke} -libraries tclwebtest web_message_reply {
+ Post a reply a message in the forum
+} {
+ aa_run_with_teardown -test_code {
+
+ tclwebtest::cookies clear
+
+ # Login user
+ array set user_info [twt::user::create -admin]
+ twt::user::login $user_info(email) $user_info(password)
+
+ # Create a forum
+ set name [ad_generate_random_string]
+ forums::twt::new "$name"
+
+ # Post a message in the created forum
+ set subject [ad_generate_random_string]
+ forums::twt::new_post "$name" "$subject"
+
+ # Edit the posted message
+ set response [forums::twt::reply_msg "$name" "$subject"]
+ aa_display_result -response $response -explanation {Webtest for posting a reply to a msg in the forum}
+
+ twt::user::logout
+ }
+}
+
+aa_register_case -cats {web smoke} -libraries tclwebtest web_message_delete {
+ Delete a message in the forum
+} {
+ aa_run_with_teardown -test_code {
+
+ tclwebtest::cookies clear
+
+ # Login user
+ array set user_info [twt::user::create -admin]
+ twt::user::login $user_info(email) $user_info(password)
+
+ # Create a forum
+ set name [ad_generate_random_string]
+ forums::twt::new "$name"
+
+ # Post a message in the created forum
+ set subject [ad_generate_random_string]
+ forums::twt::new_post "$name" "$subject"
+
+ # Edit the posted message
+ set response [forums::twt::delete_post "$name" "$subject"]
+ aa_display_result -response $response -explanation {Webtest for deleting a message posted in the forum}
+
+ twt::user::logout
+ }
+}
\ No newline at end of file
Index: openacs-4/contrib/packages/forums/tcl/test/tclwebtest-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/tcl/test/Attic/tclwebtest-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/tcl/test/tclwebtest-procs.tcl 23 Jan 2007 13:24:06 -0000 1.1
@@ -0,0 +1,273 @@
+ad_library {
+ Automated tests.
+ @author Gerardo Morales (gerardo.morales@gmail.net)
+ @author Mounir Lallali
+
+ @creation-date 14 June 2005
+
+}
+
+namespace eval forums::twt {
+
+ ad_proc new { name } {
+
+ set response 0
+
+ # The Faq Admin page url
+ set forum_admin_page [aa_get_first_url -package_key forums]
+ ::twt::do_request $forum_admin_page
+
+ # Seting the charter that would be used in the forum creation form
+ set charter "[ad_generate_random_string] [ad_generate_random_string]"
+
+ # Follows the link of New Forum
+ tclwebtest::link follow "New Forum"
+ tclwebtest::form find ~n "forum"
+ tclwebtest::field find ~n "name"
+ tclwebtest::field fill "$name"
+ tclwebtest::field find ~n "charter"
+ tclwebtest::field fill "$charter"
+ tclwebtest::form submit
+ aa_log "Forum $name just to be created"
+
+ set response_url [tclwebtest::response url]
+ aa_log $forum_admin_page
+
+ if {[string first $forum_admin_page $response_url]!=-1} {
+
+ if { [catch {tclwebtest::link find $name} testerror1] ||[catch {tclwebtest::assert text $charter} testerror2 ] } {
+ aa_error "The forum $name was not created. The forum name or the charter was not founded in the admin page of forums"
+ } else {
+ aa_log "The forum $name was succesfully created"
+ set response 1
+ }
+
+ } else {
+ aa_error "forums::twt::new failed, bad response url : $response_url"
+ }
+
+ return $response
+ }
+
+ ad_proc edit { name } {
+
+ set response 0
+
+ # Call to the faq admin page
+ set forum_admin_page [aa_get_first_url -package_key forums]
+ ::twt::do_request $forum_admin_page
+
+ # Follows the link of administration and then admin the forum
+ tclwebtest::link follow $name
+ tclwebtest::link follow "Administer"
+ aa_log "The data of the $name forum will be changed"
+
+ set charter "[ad_generate_random_string] [ad_generate_random_string 8]"
+
+ # Enter the new data and submit
+ tclwebtest::form find ~n "forum"
+ tclwebtest::field find ~n "name"
+ tclwebtest::field fill "Edited $name"
+ tclwebtest::field find ~n "charter"
+ tclwebtest::field fill "Edited $charter"
+ tclwebtest::form submit
+ aa_log "Form Submited"
+
+ # Testing the edition
+ set response_url [tclwebtest::response url]
+
+ if {[string first "forum-view" $response_url]!=-1 && [string first $forum_admin_page $response_url]!=-1 } {
+
+ ::twt::do_request $forum_admin_page
+
+ if { [catch {tclwebtest::link find "Edited $name"} testerror1] ||[catch {tclwebtest::assert text "$charter"} testerror2 ] } {
+ aa_error "The forum $name was not Edited. The forum name or the charter was not founded in the admin page of forums"
+ } else {
+ aa_log "The forum $name was succesfully edited, new name Edited $name"
+ set response 1
+ }
+
+ } else {
+ aa_error "forums::twt::edit failed, bad response url : $response_url"
+ }
+
+ return $response
+ }
+
+ ad_proc new_post {name subject} {
+
+ set response 0
+ # Seting the Subject and Body of the new post
+ set msgb "[ad_generate_random_string] [ad_generate_random_string 20]"
+
+ # Call to the faq admin page
+ set forum_admin_page [aa_get_first_url -package_key forums]
+ ::twt::do_request $forum_admin_page
+
+ # Follows the link of administration and then the Post a new message
+ tclwebtest::link follow $name
+ tclwebtest::link follow "Post a New Message"
+
+ # Enter the data and submit
+ tclwebtest::form find ~n "message"
+ tclwebtest::field find ~n "subject"
+ tclwebtest::field fill "$subject"
+ tclwebtest::field find ~n "message_body"
+ tclwebtest::field fill "$msgb"
+ tclwebtest::form submit
+ aa_log "New message form submited"
+
+ set response_url [tclwebtest::response url]
+
+ if {[string first "message-view" $response_url]!=-1 && [string first $forum_admin_page $response_url]!=-1 } {
+
+ tclwebtest::link follow "$name"
+
+ # Testing the message
+ if {[catch {tclwebtest::link follow "$subject"}]} {
+ aa_error "The messaje was not posted"
+ }
+
+ if { [catch {tclwebtest::assert text "$msgb"} testerror2 ] } {
+ aa_error "The body of the message was not correctly posted"
+ } else {
+ aa_log "The message was succesfully posted"
+ set response 1
+ }
+
+ } else {
+ aa_error "forums::twt::new_post failed, bad response url : $response_url"
+ }
+
+ return $response
+ }
+
+ ad_proc edit_post {name subject} {
+
+ set response 0
+
+ # Seting the new body of the message
+ set msgb2 "[ad_generate_random_string] [ad_generate_random_string 20]"
+
+ # Call to the faq admin page
+ set forum_admin_page [aa_get_first_url -package_key forums]
+ ::twt::do_request $forum_admin_page
+
+
+ # Follows the link of administration and then Edit the posted message
+ tclwebtest::link follow $name
+ tclwebtest::link follow $subject
+ tclwebtest::link follow Edit
+
+ # Fill and submit the form for editing
+ tclwebtest::form find ~n "message"
+ tclwebtest::field find ~n "subject"
+ tclwebtest::field fill "Edited $subject"
+ tclwebtest::field find ~n "message_body"
+ tclwebtest::field fill "$msgb2"
+ tclwebtest::form submit
+ aa_log "Edit message form submited"
+
+ set response_url [tclwebtest::response url]
+
+ if {[string first "message-view" $response_url]!=-1 && [string first $forum_admin_page $response_url]!=-1 } {
+
+ # Testing if the new text is in the message
+ if {[catch {tclwebtest::link follow "Edited $subject"}]} {
+ aa_error "The messaje was not edited"
+ }
+
+ if { [catch {tclwebtest::assert text "$msgb2"} testerror2 ] } {
+ aa_error "The body of the message was not correctly edited"
+ } else {
+ aa_log "The message $subject of the forum $name was succesfully edited"
+ set response 1
+ }
+
+ } else {
+ aa_error "forums::twt::edit_post failed, bad response url : $response_url"
+ }
+
+ return $response
+ }
+
+ ad_proc delete_post {name subject} {
+
+ set response 0
+ # Call to the faq admin page
+ set forum_admin_page [aa_get_first_url -package_key forums]
+ ::twt::do_request $forum_admin_page
+
+ # Follows the link of administration and then Edit the posted message
+ tclwebtest::link follow $name
+ tclwebtest::link follow $subject
+ tclwebtest::link follow Delete
+ tclwebtest::link follow Yes
+
+ set response_url [tclwebtest::response url]
+
+ # Testing if the the message is not in the forum
+ if {[string first "forum-view" $response_url]!=-1 && [string first $forum_admin_page $response_url]!=-1 } {
+
+ if {[catch {tclwebtest::link follow "Edited $subject"}]} {
+ aa_log "The message $subject was succesfully deleted in the forum $name"
+ set response 1
+ } else {
+ aa_error "The message $subject of the forum $name was not deleted"
+ }
+
+ } else {
+ aa_error "forums::twt::delete_post failed, bad response url : $response_url"
+ }
+
+ return $response
+ }
+
+ ad_proc reply_msg {name subject} {
+
+ set response 0
+
+ # Seting the new body of the message
+ set msgb_reply "[ad_generate_random_string] [ad_generate_random_string 20]"
+
+ # Call to the faq admin page
+ set forum_admin_page [aa_get_first_url -package_key forums]
+ ::twt::do_request $forum_admin_page
+
+
+ # Follows the link of administration and then Edit the posted message
+ tclwebtest::link follow $name
+ tclwebtest::link follow $subject
+ tclwebtest::link follow "Post a Reply"
+
+ # Fill and submit the form for editing
+ tclwebtest::form find ~n "message"
+ tclwebtest::field find ~n "message_body"
+ tclwebtest::field fill "$msgb_reply"
+ tclwebtest::form submit
+ aa_log "Reply message submitted"
+
+ set response_url [tclwebtest::response url]
+
+ # Testing if the new text is in the message
+ if {[string first "message-view" $response_url]!=-1 && [string first $forum_admin_page $response_url]!=-1 } {
+
+ if {[catch {tclwebtest::link find "Re: $subject"}]} {
+ aa_error "The reply message was not posted"
+ }
+
+ if { [catch {tclwebtest::assert text "$msgb_reply"} testerror2 ] } {
+ aa_error "The body of the replyed message was not correctly posted"
+ } else {
+ aa_log "The reply message to $subject of the forum $name was succesfully posted"
+ set response 1
+ }
+
+ } else {
+ aa_error "forums::twt::reply_msg failed, bad response url : $response_url"
+ }
+
+ return $response
+ }
+
+}
\ No newline at end of file
Index: openacs-4/contrib/packages/forums/www/forum-view.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/forums/www/Attic/forum-view.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/packages/forums/www/forum-view.adp 23 Jan 2007 13:24:06 -0000 1.1
@@ -0,0 +1,20 @@
+
+ @page_title;noquote@
+ @context;noquote@
+ @forum_id;noquote@
+
+
+
+
+
+ @ah_sources;noquote@
+
+
+
+@notification_chunk;noquote@
+
+
+
+