Index: openacs-4/packages/curriculum/tcl/apm-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/apm-callback-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/apm-callback-procs.tcl 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,218 @@ +ad_library { + + APM callback procedures. + + @creation-date 2003-06-03 + @author Ola Hansson (ola@polyxena.net) + @cvs-id $Id: apm-callback-procs.tcl,v 1.1 2003/06/03 10:28:20 olah Exp $ + +} + +namespace eval curriculum::apm {} + + +#### +# +# APM callbacks. +# +#### + + +ad_proc -private curriculum::apm::after_install {} { + Package installation callback proc. +} { + db_transaction { + curriculum::apm::register_implementations + curriculum::workflow_create + } +} + + +ad_proc -private curriculum::apm::before_uninstall {} { + Package un-installation callback proc. +} { + db_transaction { + curriculum::workflow_delete + curriculum::apm::unregister_implementations + } +} + + +ad_proc -private curriculum::apm::after_instantiate { + {-package_id:required} +} { + Package instantiation callback proc. +} { + curriculum::instance_workflow_create -package_id $package_id + + ### + # FIXME. We just set this up for convenience during development. + ### + + db_transaction { + + set subsite_url [curriculum::conn subsite_url] + + # Create a curriculum. + set curriculum_id [curriculum::new \ + -name "Demo Curriculum A" \ + -description Description \ + -package_id $package_id] + + # Add some elements. + foreach { url label } [list ${subsite_url}api-doc/ "API Documentation" ${subsite_url} "Home" ${subsite_url}doc/ "Package Documentation"] { + curriculum::element::new \ + -curriculum_id $curriculum_id \ + -name $label \ + -description "Description of $label." \ + -desc_format "text/html" \ + -url $url + } + + # Create a curriculum. + set curriculum_id [curriculum::new \ + -name "Demo Curriculum B" \ + -description Description \ + -package_id $package_id] + + # Add some elements. + foreach { url label } [list ${subsite_url}admin/ "Admin" ${subsite_url}acs-service-contract/ "Service Contracts" http://openacs.org "OpenACS Website"] { + curriculum::element::new \ + -curriculum_id $curriculum_id \ + -name $label \ + -description "Description of $label." \ + -desc_format "text/fixed-width" \ + -url $url + } + + } + + curriculum::elements_flush + +} + + +ad_proc -private curriculum::apm::before_uninstantiate { + {-package_id:required} +} { + Package un-instantiation callback proc. +} { + db_transaction { + # Deletes the curriculum(s) in a package instance including + # their data and associated workflow cases. + curriculum::delete_instance -package_id $package_id + + curriculum::instance_workflow_delete -package_id $package_id + } +} + + +##### +# +# Service contract implementations. +# +##### + + +ad_proc -private curriculum::apm::register_implementations {} { + db_transaction { + #curriculum::apm::register_capture_resolution_code_impl + curriculum::apm::register_curriculum_owner_impl + curriculum::apm::register_format_log_title_impl + curriculum::apm::register_curriculum_notification_info_impl + } +} + + +ad_proc -private curriculum::apm::unregister_implementations {} { + db_transaction { + + #acs_sc::impl::delete \ + -contract_name [workflow::service_contract::action_side_effect] \ + -impl_name "CurriculumCaptureResolutionCode" + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::role_default_assignees] \ + -impl_name "CurriculumOwner" + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::activity_log_format_title] \ + -impl_name "CurriculumFormatLogTitle" + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::notification_info] \ + -impl_name "CurriculumNotificationInfo" + } +} + + +#ad_proc -private curriculum::apm::register_capture_resolution_code_impl {} { +# +# set spec { +# name "CurriculumCaptureResolutionCode" +# aliases { +# GetObjectType curriculum::object_type +# GetPrettyName curriculum::capture_resolution_code::pretty_name +# DoSideEffect curriculum::capture_resolution_code::do_side_effect +# } +# } +# +# lappend spec contract_name [workflow::service_contract::action_side_effect] +# lappend spec owner [curriculum::package_key] +# +# acs_sc::impl::new_from_spec -spec $spec +#} + + +ad_proc -private curriculum::apm::register_curriculum_owner_impl {} { + + set spec { + name "CurriculumOwner" + aliases { + GetObjectType curriculum::object_type + GetPrettyName curriculum::owner::pretty_name + GetAssignees curriculum::owner::get_assignees + } + } + + lappend spec contract_name [workflow::service_contract::role_default_assignees] + lappend spec owner [curriculum::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} + + +ad_proc -private curriculum::apm::register_format_log_title_impl {} { + + set spec { + name "CurriculumFormatLogTitle" + aliases { + GetObjectType curriculum::object_type + GetPrettyName curriculum::format_log_title::pretty_name + GetTitle curriculum::format_log_title::format_log_title + } + } + + lappend spec contract_name [workflow::service_contract::activity_log_format_title] + lappend spec owner [curriculum::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} + + +ad_proc -private curriculum::apm::register_curriculum_notification_info_impl {} { + + set spec { + name "CurriculumNotificationInfo" + aliases { + GetObjectType curriculum::object_type + GetPrettyName curriculum::notification_info::pretty_name + GetNotificationInfo curriculum::notification_info::get_notification_info + } + } + + lappend spec contract_name [workflow::service_contract::notification_info] + lappend spec owner [curriculum::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} Index: openacs-4/packages/curriculum/tcl/curriculum-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/curriculum-init.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-init.tcl 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,30 @@ +ad_library { + + Curriculum Initialization + + @creation-date 2003-06-02 + @author Ola Hansson (ola@polyxena.net) + @cvs-id $Id: curriculum-init.tcl,v 1.1 2003/06/03 10:28:20 olah Exp $ + +} + +# FIXME. Most likely we should only get the package_ids that have +# curriculums which are published. +set package_ids [db_list get_all_curriculum_package_ids {*SQL*}] + +foreach package_id $package_ids { + + # Register the filter that keeps track of which elements the user has seen. + # If no "UrlPatternsToFilter" parameter is detected we register + # this filter for all urls in this curriculum instance. + + set url_patterns [parameter::get -package_id $package_id \ + -parameter UrlPatternsToFilter \ + -default *] + + foreach url_pattern [split [string trim $url_patterns]] { + ns_log Notice "Installing curriculum filter for $url_pattern in package_id $package_id" + ad_register_filter postauth GET $url_pattern curriculum::curriculum_filter + } + +} Index: openacs-4/packages/curriculum/tcl/curriculum-init.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/curriculum-init.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-init.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,11 @@ + + + + + + select distinct package_id + from cu_curriculums + + + + Index: openacs-4/packages/curriculum/tcl/curriculum-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/curriculum-procs-oracle.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-procs-oracle.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,21 @@ + + + oracle8.1.6 + + + + declare begin + cu_curriculum.del(:curriculum_id); + end; + + + + + + declare begin + :1 := workflow_case.delete(:case_id); + end; + + + + Index: openacs-4/packages/curriculum/tcl/curriculum-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/curriculum-procs-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-procs-postgresql.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,17 @@ + + + postgresql7.1 + + + + select cu_curriculum__del(:curriculum_id); + + + + + + select workflow_case__delete(:case_id); + + + + Index: openacs-4/packages/curriculum/tcl/curriculum-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/curriculum-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-procs.tcl 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,698 @@ +ad_library { + + Curriculum Library. + + @creation-date 2003-06-03 + @author Ola Hansson (ola@polyxena.net) + @cvs-id $Id: curriculum-procs.tcl,v 1.1 2003/06/03 10:28:20 olah Exp $ + +} + + +namespace eval curriculum {} +namespace eval curriculum::owner {} +namespace eval curriculum::capture_resolution_code {} +namespace eval curriculum::format_log_title {} +namespace eval curriculum::notification_info {} + + +ad_proc -public curriculum::workflow_short_name {} { + Get the short name of the workflow for curriculums +} { + return "curriculum" +} + + +ad_proc -public curriculum::package_key {} { + return "curriculum" +} + + +ad_proc -public curriculum::new { + {-curriculum_id ""} + -name:required + {-description ""} + {-desc_format "text/html"} + {-owner_id ""} + -package_id:required + {-sort_key ""} +} { + + Create a new curriculum. + + @param curriculum_id The pre-fetched object-id of the curriculum which should be created (normally not used). + @param name The name of the curriculum. + @param description Long description of the objective(s) of the curriculum. + @param desc_format The format of the description. Current formats are: text/enhanced text/plain text/html text/fixed-width + @param owner_id The party-id of the party - user or group - that is responsible for this curriculum. Defaults to the creating user. + @param package_id Package-id makes the Curriculum package subsite-aware. Defaults to [ad_conn package_id]. + @param sort_key The relative sort order of the curriculums in a package instance. + + @return The object-id of the newly created curriculum. + + @author Ola Hansson (ola@polyxena.net) + +} { + # If no owner_id is provided, we set it to the currently logged-in user. + if [empty_string_p $owner_id] { + set owner_id [ad_conn user_id] + } + + # Prepare the variables for instantiation. + set extra_vars [ns_set create] + oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {curriculum_id name description desc_format owner_id package_id sort_key} + + db_transaction { + + # Instantiate the curriculum object. + set curriculum_id [package_instantiate_object \ + -extra_vars $extra_vars cu_curriculum] + + # Start a new workflow case. + workflow::case::new \ + -workflow_id [workflow::get_id -object_id $package_id -short_name [workflow_short_name]] \ + -object_id $curriculum_id \ + -comment $description \ + -comment_mime_type "text/plain" + } + + return $curriculum_id +} + + +ad_proc -public curriculum::edit { + -curriculum_id:required + -name:required + {-description ""} + {-desc_format "text/plain"} + -owner_id:required + -action_id:required + -array:required + {-entry_id {}} +} { + + Edit a curriculum. + + @param curriculum_id The object-id of the curriculum which should be updated. + @param name The new name. + @param description The new description. + @param desc_format The format of the description. Current formats are: text/enhanced text/plain text/html text/fixed-width + @param owner_id The new owner (party_id). + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + upvar $array row + + array set assignments [list] + + set role_prefix "role_" + foreach name [array names row "${role_prefix}*"] { + set assignments([string range $name [string length $role_prefix] end]) $row($name) + unset row($name) + } + + db_transaction { + + # Update the curriculum info. + db_dml update_curriculum {*SQL*} + + set case_id [workflow::case::get_id \ + -workflow_short_name [workflow_short_name] \ + -object_id $curriculum_id] + + workflow::case::role::assign \ + -replace \ + -case_id $case_id \ + -array assignments + + workflow::case::action::execute \ + -case_id $case_id \ + -action_id $action_id \ + -comment $description \ + -comment_mime_type $desc_format \ + -entry_id $entry_id + } + + return $curriculum_id +} + + +ad_proc -public curriculum::change_owner { + -curriculum_id:required + -owner_id:required +} { + + Change the owner of a curriculum. + + @param curriculum_id The object-id of the curriculum which should change owner. + @param owner_id Party-id of the new owner. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + db_dml update_curriculum_owner {*SQL*} +} + + +ad_proc -public curriculum::get { + -curriculum_id:required + -array:required + {-action_id {}} +} { + + Retrieve info about the curriculum with given id into an + array (using upvar) in the callers scope. The + array will contain the keys: + +

curriculum_id, name, description, desc_format, owner_id, package_id, sort_key

+ + @param curriculum_id The id of the curriculum to retrieve information about. + @param array The name of the array in the callers scope where the information will + be stored. + + @return The return value from db_0or1row. If more than one row is returned, throws an error. + + @author Ola Hansson (ola@polyxena.net) + +} { + upvar $array row + + if { ![db_0or1row get_curriculum_data {*SQL*} -column_array row] } { + # Query did not return a row. We should probably return an error instead. + return 0 + ad_script_abort + } + + # Get the case ID, so we can get state information. + set case_id [workflow::case::get_id \ + -object_id $curriculum_id \ + -workflow_short_name [workflow_short_name]] + + # Get state information. + workflow::case::fsm::get -case_id $case_id -array case -action_id $action_id + + set row(pretty_state) $case(pretty_state) + set row(state_short_name) $case(state_short_name) + set row(hide_fields) $case(state_hide_fields) + set row(entry_id) $case(entry_id) + + return 1 +} + + +ad_proc -public curriculum::delete { + -curriculum_id:required +} { + + Delete a curriculum. + + @param curriculum_id The object-id of the curriculum which should be deleted. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + db_transaction { + + # Get the case ID. + set case_id [workflow::case::get_id \ + -object_id $curriculum_id \ + -workflow_short_name [workflow_short_name]] + + # FIXME. There should be a Tcl wrapper for this in workflow but there + # isn't yet (at least not on MAIN). + #workflow::case::delete -case_id $case_id + db_exec_plsql delete_workflow_case {*SQL*} + + db_exec_plsql delete_curriculum {*SQL*} + + } +} + + +ad_proc -private curriculum::delete_instance { + -package_id:required +} { + + Deletes curriculums in a package instance (and their data). + We thus avoid having orphan curriculum data in the database. + + @param package_id The package_id of the curriculum instance which should be deleted. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + # Get a list of all curriculums in this package instance. + set curriculum_ids [conn -nocache curriculum_ids] + + db_transaction { + + foreach curriculum_id $curriculum_ids { + ns_log Notice "curriculum::delete_instance - deleting curriculum $curriculum_id in package_id $package_id" + delete -curriculum_id $curriculum_id + } + + } +} + +#### +# +# Workflow procs. +# +#### + + +ad_proc -private curriculum::workflow_create {} { + Create the 'curriculum' workflow for curriculum. +} { + set spec { + curriculum { + pretty_name "Curriculum" + package_key "curriculum" + object_type "cu_curriculum" + callbacks { + curriculum.CurriculumNotificationInfo + } + roles { + author { + pretty_name "Author" + callbacks { + workflow.Role_DefaultAssignees_CreationUser + } + } + editor { + pretty_name "Editor" + } + publisher { + pretty_name "Publisher" + callbacks { + curriculum.CurriculumOwner + workflow.Role_PickList_CurrentAssignees + workflow.Role_AssigneeSubquery_RegisteredUsers + } + } + } + states { + authored { + pretty_name "Created" + hide_fields {} + } + edited { + pretty_name "Edited" + } + refused { + pretty_name "Refused" + } + published { + pretty_name "Published" + } + archived { + pretty_name "Archived" + } + } + actions { + create { + pretty_name "Create" + pretty_past_tense "Created" + new_state "authored" + initial_action_p t + } + comment { + pretty_name "Comment" + pretty_past_tense "Commented" + allowed_roles { author editor publisher } + privileges { read write } + always_enabled_p t + edit_fields { + description + } + } + edit { + pretty_name "Edit" + pretty_past_tense "Edited" + new_state "edited" + allowed_roles { author editor publisher } + privileges { write } + always_enabled_p t + edit_fields { + name + description + } + } + publish { + pretty_name "Publish" + pretty_past_tense "Published" + assigned_role "publisher" + enabled_states { authored edited } + assigned_states { edited } + new_state "published" + privileges { write } + edit_fields { } + } + archive { + pretty_name "Archive" + pretty_past_tense "Archived" + assigned_role "publisher" + assigned_states { published } + new_state "archived" + privileges { write } + edit_fields { } + } + } + } + } + set workflow_id [workflow::fsm::new_from_spec -spec $spec] + + return $workflow_id +} + + +ad_proc -public curriculum::workflow_short_name {} { + Get the short name of the workflow for curriculums. +} { + return "curriculum" +} + + +ad_proc -public curriculum::object_type {} { + Get the object_type of curriculum. +} { + return "cu_curriculum" +} + + +ad_proc -private curriculum::workflow_delete {} { + Delete the 'curriculum' workflow for curriculum. +} { + set workflow_id [get_package_workflow_id] + if { ![empty_string_p $workflow_id] } { + workflow::delete -workflow_id $workflow_id + } +} + + +ad_proc -public curriculum::get_package_workflow_id {} { + Return the workflow_id for the package (not instance) workflow. +} { + return [workflow::get_id \ + -short_name [workflow_short_name] \ + -package_key [package_key]] + +} + + +ad_proc -public curriculum::get_instance_workflow_id { + {-package_id {}} +} { + Return the workflow_id for the instance (not package) workflow. +} { + if { [empty_string_p $package_id] } { + set package_id [conn package_id] + } + + return [workflow::get_id \ + -short_name [workflow_short_name] \ + -object_id $package_id] +} + + +ad_proc -private curriculum::instance_workflow_create { + -package_id:required +} { + Creates a clone of the default curriculum package workflow for a + specific package instance. +} { + set workflow_id [workflow::fsm::clone \ + -workflow_id [get_package_workflow_id] \ + -object_id $package_id] + + return $workflow_id +} + + +ad_proc -private curriculum::instance_workflow_delete { + -package_id:required +} { + Deletes the instance workflow. +} { + workflow::delete -workflow_id [get_instance_workflow_id -package_id $package_id] +} + + +#### +# +# Curriculum owner. +# +#### + + +ad_proc -private curriculum::owner::pretty_name {} { + return "Curriculum owner" +} + + +ad_proc -private curriculum::owner::get_assignees { + case_id + object_id + role_id +} { + return [db_string select_curriculum_owner {*SQL*} -default {}] +} + + +#### +# +# Capture resolution code. (Useful if we need to perform side effects but not being used right now.) +# +#### + + +# FIXME +ad_proc -private curriculum::capture_resolution_code::pretty_name {} { + return "Capture resolution code in the case activity log" +} + + +ad_proc -private curriculum::capture_resolution_code::do_side_effect { + case_id + object_id + action_id + entry_id +} { + db_dml insert_resolution_code {*NOT WRITTEN YET*} +} + + +#### +# +# Format log title. +# +#### + + +ad_proc -private curriculum::format_log_title::pretty_name {} { + return "Add resolution code to log title" +} + + +ad_proc -private curriculum::format_log_title::format_log_title { + case_id + object_id + action_id + entry_id + data_arraylist +} { + array set data $data_arraylist + + if { [info exists data(resolution)] } { + return [resolution_pretty $data(resolution)] + } else { + return {WHAT?!} + } +} + + +# FIXME. Resolution ???? +ad_proc -private curriculum::resolution_get_options {} { + + return { + fixed "Fixed" + bydesign "By Design" + wontfix "Won't Fix" + postponed "Postponed" + duplicate "Duplicate" + norepro "Not Reproducable" + needinfo "Need Info" + } + +} + + +ad_proc -private curriculum::resolution_pretty { + resolution +} { + array set resolution_codes [resolution_get_options] + + if { [info exists resolution_codes($resolution)] } { + return $resolution_codes($resolution) + } else { + return {} + } +} + + +#### +# +# Notification info. +# +#### + + +ad_proc -private curriculum::notification_info::pretty_name {} { + return "Curriculum info" +} + + +# FIXME. +ad_proc -private curriculum::notification_info::get_notification_info { + case_id + object_id +} { +#### + return [list /my/test/url one_line {details_list testing} notification_subject_tag] + ad_script_abort +#### + + + bug_tracker::bug::get -bug_id $object_id -array bug + + set url "[ad_url][apm_package_url_from_id $bug(project_id)]bug?[export_vars { { bug_number $bug(bug_number) } }]" + + bug_tracker::get_pretty_names -array pretty_names + + set notification_subject_tag [db_string select_notification_tag {} -default {}] + + set one_line "$pretty_names(Bug) #$bug(bug_number): $bug(summary)" + + # Build up data structures with the form labels and values + # (Note, this is something that the metadata system should be able to do for us) + + array set label { + summary "Summary" + status "Status" + found_in_version "Found in version" + fix_for_version "Fix for version" + fixed_in_version "Fixed in version" + } + + set label(bug_number) "$pretty_names(Bug) #" + set label(component) "$pretty_names(Component)" + + set fields { + bug_number + component + } + + # keywords + foreach { category_id category_name } [bug_tracker::category_types] { + lappend fields $category_id + set value($category_id) [bug_tracker::category_heading \ + -keyword_id [cr::keyword::item_get_assigned -item_id $bug(bug_id) -parent_id $category_id] \ + -package_id $bug(project_id)] + set label($category_id) $category_name + } + + lappend fields summary status + + if { [bug_tracker::versions_p -package_id $bug(project_id)] } { + lappend fields found_in_version fix_for_version fixed_in_version + } + + set value(bug_number) $bug(bug_number) + set value(component) $bug(component_name) + set value(summary) $bug(summary) + set value(status) $bug(pretty_state) + set value(found_in_version) [ad_decode $bug(found_in_version_name) "" "Unknown" $bug(found_in_version_name)] + set value(fix_for_version) [ad_decode $bug(fix_for_version_name) "" "Undecided" $bug(fix_for_version_name)] + set value(fixed_in_version) [ad_decode $bug(fixed_in_version_name) "" "Unknown" $bug(fixed_in_version_name)] + + # Remove fields that should be hidden in this state + foreach field $bug(hide_fields) { + set index [lsearch -exact $fields $field] + if { $index != -1 } { + set fields [lreplace $fields $index $index] + } + } + + # Build up the details list + set details_list [list] + foreach field $fields { + lappend details_list $label($field) $value($field) + } + + return [list $url $one_line $details_list $notification_subject_tag] +} + + +ad_proc -public curriculum::get_watch_link { + {-curriculum_id:required} +} { + Get link for watching a curriculum. + @return 3-tuple of url, label and title. +} { + set user_id [ad_conn user_id] + set return_url [util_get_current_url] + + # Get the type id + set type "workflow_case" + set type_id [notification::type::get_type_id -short_name $type] + + # Check if subscribed + set request_id [notification::request::get_request_id \ + -type_id $type_id \ + -object_id $curriculum_id \ + -user_id $user_id] + + set subscribed_p [expr ![empty_string_p $request_id]] + + if { !$subscribed_p } { + set url [notification::display::subscribe_url \ + -type $type \ + -object_id $curriculum_id \ + -url $return_url \ + -user_id $user_id \ + -pretty_name "this curriculum"] + set label "Watch this curriculum" + set title "Request notifications for all activity on this curriculum" + } else { + set url [notification::display::unsubscribe_url -request_id $request_id -url $return_url] + set label "Stop watching this curriculum" + set title "Unsubscribe to notifications for activity on this curriculum" + } + return [list $url $label $title] +} + + +ad_proc -private curriculum::security_violation { + -user_id:required + -curriculum_id:required + -action:required +} { + ns_log Notice "$user_id doesn't have permission to '$action' on curriculum $curriculum_id" + ad_return_forbidden \ + "Security Violation" \ + "
+ You don't have permission to '$action' on this curriculum. +
+ This incident has been logged. +
" + ad_script_abort +} Index: openacs-4/packages/curriculum/tcl/curriculum-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/curriculum-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-procs.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,39 @@ + + + + + + update cu_curriculums + set name = :name, + description = :description, + desc_format = :desc_format, + owner_id = :owner_id + where curriculum_id = :curriculum_id + + + + + + update cu_curriculums + set owner_id = :owner_id + where curriculum_id = :curriculum_id + + + + + + select * + from cu_curriculums + where curriculum_id = :curriculum_id + + + + + + select owner_id + from cu_curriculums + where curriculum_id = :object_id + + + + Index: openacs-4/packages/curriculum/tcl/curriculum-security-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/Attic/curriculum-security-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/curriculum-security-procs.tcl 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,127 @@ +ad_library { + + Curriculum Security Library + + @creation-date 2003-06-03 + @author Ola Hansson (ola@polyxena.net) + @cvs-id $Id: curriculum-security-procs.tcl,v 1.1 2003/06/03 10:28:20 olah Exp $ + +} + +namespace eval curriculum::security {} + + +ad_proc -private curriculum::security::do_abort {} { + Do an abort if security violation. +} { + ad_returnredirect "not-allowed" + return -code error +} + + +ad_proc -public curriculum::security::can_read_curriculum_p { + {-user_id ""} + {-curriculum_id:required} +} { + return [permission::permission_p -party_id $user_id -object_id $curriculum_id -privilege curriculum_read] +} + + +ad_proc -public curriculum::security::require_read_curriculum { + {-user_id ""} + {-curriculum_id:required} +} { + if {![can_read_curriculum_p -user_id $user_id -curriculum_id $curriculum_id]} { + do_abort + } +} + + +ad_proc -public curriculum::security::can_create_curriculum_p { + {-user_id ""} + {-curriculum_id:required} +} { + return [permission::permission_p -party_id $user_id -object_id $curriculum_id -privilege curriculum_create] +} + + +ad_proc -public curriculum::security::require_create_curriculum { + {-user_id ""} + {-curriculum_id:required} +} { + if {![can_create_curriculum_p -user_id $user_id -curriculum_id $curriculum_id]} { + do_abort + } +} + + +ad_proc -public curriculum::security::can_create_element_p { + {-user_id ""} + {-element_id:required} +} { + return [permission::permission_p -party_id $user_id -object_id $element_id -privilege curriculum_write] +} + + +ad_proc -public curriculum::security::require_create_element { + {-user_id ""} + {-element_id:required} +} { + if {![can_create_element_p -user_id $user_id -element_id $element_id]} { + do_abort + } +} + + +ad_proc -public curriculum::security::can_write_curriculum_p { + {-user_id ""} + {-curriculum_id:required} +} { + return [permission::permission_p -party_id $user_id -object_id $curriculum_id -privilege curriculum_write] +} + + +ad_proc -public curriculum::security::require_write_curriculum { + {-user_id ""} + {-curriculum_id:required} +} { + if {![can_write_curriculum_p -user_id $user_id -curriculum_id $curriculum_id]} { + do_abort + } +} + + +ad_proc -public curriculum::security::can_write_element_p { + {-user_id ""} + {-element_id:required} +} { + return [permission::permission_p -party_id $user_id -object_id $element_id -privilege curriculum_write] +} + + +ad_proc -public curriculum::security::require_write_element { + {-user_id ""} + {-element_id:required} +} { + if {![can_write_element_p -user_id $user_id -element_id $element_id]} { + do_abort + } +} + + +ad_proc -public curriculum::security::can_admin_curriculum_p { + {-user_id ""} + {-curriculum_id:required} +} { + return [permission::permission_p -party_id $user_id -object_id $curriculum_id -privilege curriculum_write] +} + + +ad_proc -public curriculum::security::require_admin_curriculum { + {-user_id ""} + {-curriculum_id:required} +} { + if {![can_admin_curriculum_p -user_id $user_id -curriculum_id $curriculum_id]} { + do_abort + } +} Index: openacs-4/packages/curriculum/tcl/element-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/element-procs-oracle.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/element-procs-oracle.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,13 @@ + + + oracle8.1.6 + + + + declare begin + cu_element.del(:element_id); + end; + + + + Index: openacs-4/packages/curriculum/tcl/element-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/element-procs-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/element-procs-postgresql.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,11 @@ + + + postgresql7.1 + + + + select cu_element__del(:element_id); + + + + Index: openacs-4/packages/curriculum/tcl/element-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/element-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/element-procs.tcl 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,169 @@ +ad_library { + + Curriculum Element Library + + @creation-date 2003-06-03 + @author Ola Hansson (ola@polyxena.net) + @cvs-id $Id: element-procs.tcl,v 1.1 2003/06/03 10:28:20 olah Exp $ + +} + +namespace eval curriculum::element {} + +ad_proc -public curriculum::element::new { + {-element_id ""} + {-curriculum_id:required} + {-name:required} + {-description ""} + {-desc_format "text/html"} + {-url:required} + {-enabled_p t} + {-sort_key ""} +} { + + Create a new curriculum element. + + @param element_id The pre-fetched object-id of the element to create (normally not used). + @param curriculum_id The object-id of the curriculum this element belongs to. + @param name The name of the element. + @param description Long description of the element. + @param desc_format The format of the description. Current formats are: text/enhanced text/plain text/html text/fixed-width + @param url Url that this element is linked to. (URLs without "http://" are considered to be relative to the page root). + @param enabled_p Should the element be enabled or disabled (archived) upon creation? This can be toggled afterwards. + @param sort_key The relative sort order of the elements in a curriculum. + + @return The object-id of the newly created curriculum element. + + @author Ola Hansson (ola@polyxena.net) + +} { + + # Prepare the variables for instantiation. + set extra_vars [ns_set create] + oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {element_id curriculum_id name description desc_format url enabled_p sort_key} + + # Instantiate the curriculum element. + return [package_instantiate_object -extra_vars $extra_vars cu_element] +} + + +ad_proc -public curriculum::element::edit { + {-element_id:required} + {-name:required} + {-description:required} + {-desc_format:required} + {-url:required} +} { + + Edit a curriculum element. + + @param element_id The object-id of the element to update. + @param name The new name. + @param description The new description. + @param desc_format The format of the description. Current formats are: text/enhanced text/plain text/html text/fixed-width + @param url The new url. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + db_dml update_curriculum_element {*SQL*} +} + + +ad_proc -public curriculum::element::enable { + {-element_id:required} +} { + + Enable (unarchive) a curriculum element. + + @param element_id The object-id of the element to enable. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + db_dml update_element_enabled_p {*SQL*} +} + + +ad_proc -public curriculum::element::disable { + {-element_id:required} +} { + + Disable (archive) a curriculum element. + + @param element_id The object-id of the element to disable. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + db_dml update_element_disabled_p {*SQL*} +} + + +ad_proc -public curriculum::element::get { + -element_id:required + -array:required + {-action_id {}} +} { + + Retrieve info about the element with given id into an + array (using upvar) in the callers scope. The + array will contain the keys: + +

curriculum_id, name, url, description, desc_format, sort_key

+ + @param element_id The id of the element to retrieve information about. + @param array The name of the array in the callers scope where the information will + be stored. + + @return The return value from db_0or1row. If more than one row is returned, throws an error. + + @author Ola Hansson (ola@polyxena.net) + +} { + upvar $array row + + if { ![db_0or1row get_element_data {*SQL*} -column_array row] } { + # Query did not return a row. We should probably return an error instead. + return 0 + ad_script_abort + } + +# # Get the case ID, so we can get state information. +# set case_id [workflow::case::get_id \ +# -object_id $curriculum_id \ +# -workflow_short_name [workflow_short_name]] +# +# # Get state information. +# workflow::case::fsm::get -case_id $case_id -array case -action_id $action_id +# +# set row(pretty_state) $case(pretty_state) +# set row(state_short_name) $case(state_short_name) +# set row(hide_fields) $case(state_hide_fields) +# set row(entry_id) $case(entry_id) + + return 1 +} + + +ad_proc -public curriculum::element::delete { + {-element_id:required} +} { + + Delete a curriculum element. + + @param element_id The object-id of the element to delete. + + @return Nothing. + + @author Ola Hansson (ola@polyxena.net) + +} { + db_exec_plsql delete_element {*SQL*} +} Index: openacs-4/packages/curriculum/tcl/element-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/element-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/element-procs.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,39 @@ + + + + + + update cu_elements + set name = :name, + description = :description, + desc_format = :desc_format, + url = :url + where element_id = :element_id + + + + + + update cu_elements + set enabled_p = 't' + where element_id = :element_id + + + + + + update cu_elements + set enabled_p = 'f' + where element_id = :element_id + + + + + + select * + from cu_elements + where element_id = :element_id + + + + Index: openacs-4/packages/curriculum/tcl/misc-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/misc-procs-oracle.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/misc-procs-oracle.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,90 @@ + + + oracle8.1.6 + + + + insert into cu_user_element_map + (user_id, element_id, curriculum_id, package_id, completion_date) + select :user_id, + :element_id, + :curriculum_id, + :package_id, + sysdate + from dual + where not exists (select 1 + from cu_user_element_map + where user_id = :user_id + and element_id = :element_id) + + + + + + + select cee.element_id, + cee.curriculum_id, + cee.url, + cee.name + from (select curriculum_id + from cu_curriculums + where package_id = :package_id + MINUS + select curriculum_id + from cu_user_curriculum_map + where user_id = :user_id + and package_id = :package_id) desired, + workflow_cases cas, + workflow_case_fsm cfsm, + cu_curriculums cc, + cu_elements_enabled cee + where cc.package_id = :package_id + and desired.curriculum_id = cc.curriculum_id + and cc.curriculum_id = cee.curriculum_id + and cas.object_id = cc.curriculum_id + and cfsm.case_id = cas.case_id + and cfsm.current_state = :state_id + order by cc.sort_key, + cee.sort_key + + + + + + + + select published.curriculum_id, + published.name as curriculum_name, + dbms_lob.instr(published.description,1,:truncation_length) as curriculum_desc, + case when dbms_lob.getlength(published.description) > :truncation_length + then 1 else 0 end as curr_desc_trunc_p, + case when ucm.curriculum_id is null + then 0 else 1 end as undesired_p, + cee.element_id, + cee.name as element_name, + dbms_lob.instr(cee.description,1,:truncation_length) as element_desc, + case when dbms_lob.getlength(cee.description) > :truncation_length + then 1 else 0 end as elem_desc_trunc_p, + cee.url + from (select cc.* + from cu_curriculums cc, + workflow_cases cas, + workflow_case_fsm cfsm + where cc.package_id = :package_id + and cas.object_id = cc.curriculum_id + and cfsm.case_id = cas.case_id + and cfsm.current_state = :state_id + ) published, + cu_user_curriculum_map ucm, + cu_elements_enabled cee + where published.package_id = ucm.package_id(+) + and published.curriculum_id = ucm.curriculum_id(+) + and :user_id = ucm.user_id(+) + and published.curriculum_id = cee.curriculum_id + order by published.sort_key, + cee.sort_key + + + + + Index: openacs-4/packages/curriculum/tcl/misc-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/misc-procs-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/misc-procs-postgresql.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,102 @@ + + + postgresql7.1 + + + + insert into cu_user_element_map + (user_id, element_id, curriculum_id, package_id, completion_date) + select :user_id, + :element_id, + :curriculum_id, + :package_id, + current_timestamp + where not exists (select 1 + from cu_user_element_map + where user_id = :user_id + and element_id = :element_id) + + + + + + +-- +-- Rewrite this query to look more like the Oracle version. +-- + + (select cee.element_id, + cee.curriculum_id, + cee.url, + cee.name + from cu_curriculums cc left outer join + cu_elements_enabled cee using (curriculum_id), + workflow_cases cas, + workflow_case_fsm cfsm + where cc.package_id = :package_id + and cas.object_id = cc.curriculum_id + and cfsm.case_id = cas.case_id + and cfsm.current_state = :state_id + order by cc.sort_key, + cee.sort_key) + + EXCEPT + + (select cee.element_id, + cee.curriculum_id, + cee.url, + cee.name + from (cu_user_curriculum_map ucm inner join + cu_curriculums cc using (curriculum_id)) left outer join + cu_elements_enabled cee using (curriculum_id), + workflow_cases cas, + workflow_case_fsm cfsm + where cc.package_id = :package_id + and cas.object_id = cc.curriculum_id + and cfsm.case_id = cas.case_id + and cfsm.current_state = :state_id + and ucm.user_id = :user_id + order by cc.sort_key, + cee.sort_key) + + + + + + + + select published.curriculum_id, + published.name as curriculum_name, + substring(published.description from 1 for :truncation_length) as curriculum_desc, + case when length(published.description) > :truncation_length + then 1 else 0 end as curr_desc_trunc_p, + case when ucm.curriculum_id is null + then 0 else 1 end as undesired_p, + cee.element_id, + cee.name as element_name, + substring(cee.description from 1 for :truncation_length) as element_desc, + case when length(cee.description) > :truncation_length + then 1 else 0 end as elem_desc_trunc_p, + cee.url + from (select cc.* + from cu_curriculums cc, + workflow_cases cas, + workflow_case_fsm cfsm + where cc.package_id = :package_id + and cas.object_id = cc.curriculum_id + and cfsm.case_id = cas.case_id + and cfsm.current_state = :state_id + ) published left outer join + cu_user_curriculum_map ucm + on published.package_id = ucm.package_id + and published.curriculum_id = ucm.curriculum_id + and ucm.user_id = :user_id, + cu_elements_enabled cee + where published.curriculum_id = cee.curriculum_id + order by published.sort_key, + cee.sort_key + + + + + Index: openacs-4/packages/curriculum/tcl/misc-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/misc-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/misc-procs.tcl 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,730 @@ +ad_library { + + Curriculum Library (Misc Procs). + + @creation-date 2003-05-30 + @author Ola Hansson (ola@polyxena.net) + @cvs-id $Id: misc-procs.tcl,v 1.1 2003/06/03 10:28:20 olah Exp $ + +} + + +namespace eval curriculum {} + + +ad_proc -public curriculum::conn { + args +} { + set flag [lindex $args 0] + if { [string index $flag 0] != "-" } { + set var $flag + set flag "-get" + # We want the number of args to be the same as if a flag had been provided. + set args [linsert $args 0 $flag] + } else { + set var [lindex $args 1] + } + + switch -- $flag { + -set { + + set value [lindex $args 2] + return [util_memoize_seed [list $var [conn subsite_id]] $value] + + } + -flush { + # Flush the cache for key $var. + util_memoize_flush [list $var [conn subsite_id]] + } + -nocache { + # Call ourselves with the -flush flag to flush the cache. + conn -flush $var + + # Call ourselves with the -get flag and return fresh data. + conn -get $var + } + -get { + switch -- $var { + subsite_id { + # "ad_conn subsite_id" does not work when called from within a filter + # (which we do for the curriculum bar), so we use the following instead. + + return [site_node_closest_ancestor_package acs-subsite] + } + package_id - + package_url - + subsite_url { + + return [get_info -proc get_package_info -var $var] + + } + curriculum_count { + + return [get_info -proc get_curriculum_stats -var $var] + + } + curriculum_ids - + curriculum_names { + + # This block returns a list. + + set $var [list] + set list_of_ns_sets [get_curriculum_info] + foreach ns_set $list_of_ns_sets { + lappend $var [ns_set get $ns_set $var] + } + set cu_conn($var) [set $var] + return $cu_conn($var) + } + default { + error "curriculum::conn: unknown variable $var" + } + } + } + default { + error "::curriculum::conn: unknown flag $flag" + } + } +} + + +ad_proc -private curriculum::get_info { + -proc:required + -var:required +} { + set subsite_id [conn subsite_id] + +# FIXME. Bypass the cache for debugging purposes. +# if { ![empty_string_p [set value [util_memoize [list $var $subsite_id]]]] } { +# return $value +# } + + array set info [$proc] + foreach name [array names info] { + util_memoize_seed [list $name $subsite_id] $info($name) + } + + return $info($var) +} + + +# FIXME. Not used. +ad_proc -private curriculum::get_client_property { + -table + -proc + -module:required + -var:required +} { + set value [ad_get_client_property -cache_only t $module $var] + + if { ![empty_string_p $value] } { + # Return the cached value + return $value + } + + # The key $var is not cached so let's cache it and the rest of the keys in + # this block, too, while we're at it. The extra cost should be negligable. + + if { [info exists proc] } { + set result_list [$proc] + } elseif { [info exists table] } { + set result_list [get_table_info -table $table] + } else { + error "::curriculum::get_info: neither -proc nor -table specified" + } + + if { [empty_string_p $result_list] } { + return {} + } + + array set info $result_list + foreach name [array names info] { + # Call curriculum::conn and seed the cache + conn -set $name $info($name) + } + return $info($var) +} + + +##### +# +# Cached package info procs +# +##### + + +ad_proc -private curriculum::get_package_info { +} { + set subsite_id [conn subsite_id] + + set info(package_id) [get_package_id_from_subsite_id \ + -subsite_id $subsite_id] + + set info(package_url) [lindex [site_node::get_url_from_object_id \ + -object_id $info(package_id)] 0] + + set info(subsite_url) [lindex [site_node::get_url_from_object_id \ + -object_id $subsite_id] 0] + + return [array get info] +} + + +ad_proc -private curriculum::get_package_id_from_subsite_id { + -subsite_id:required +} { + # This call is what prevents us from mounting several curriculum instances + # per subsite ... Maybe that could be amended? + + if { [catch { + set package_id [site_node_apm_integration::get_child_package_id \ + -package_id $subsite_id -package_key [package_key]] + } errmsg] } { + + ad_return_error "Could not get child package_id" \ + "This could be because you have mounted more than one instance +of the Curriculum package in a subsite. Curriculum was designed to only +mount one instance per acs-subsite. It could also be a bug in the code. +

+Here is what the database said: +

+$errmsg" + ad_script_abort + + } else { + + return $package_id + } +} + + +##### +# +# Cached curriculum info procs +# +##### + + +ad_proc -private curriculum::get_curriculum_info { + {-package_id ""} +} { + if { [empty_string_p $package_id] } { + set package_id [conn package_id] + } + + return [db_list_of_ns_sets curriculum_info {*SQL*}] +} + + +##### +# +# Cached curriculum stats procs +# +##### + + +ad_proc -private curriculum::get_curriculum_stats { + {-package_id ""} +} { + if { [empty_string_p $package_id] } { + set package_id [conn package_id] + } + + db_1row curriculum_stats {*SQL*} -column_array stats + + return [array get stats] +} + + +##### +# +# Cached objective progress info procs +# +##### + +# FIXME. Not used. +ad_proc -private curriculum::get_table_info { + -table:required +} { + set user_id [ad_conn user_id] + + db_multirow -local info table_info " + select * + from $table + where user_id = :user_id + " {} if_no_rows { + + # Ack! No rows returned. Don't worry, we'll fall back on the defaults. + # If this query, too, returns nothing the "curriculum::conn ???" + # call we originated from will simply return an empty list. + + set magic_user_id [magic_user] + + db_0or1row info_fallback " + select * + from $table + where user_id = :magic_user_id + " -column_array info_fallback + + return -code return [array get info_fallback] + } + + # We have something. Convert it to array-settable list and then return it. + return [multirow_to_list_of_attrib_lists -var_name info] +} + + +##### +# +# Curriculum bar procs +# +##### + + +ad_proc -public curriculum::enabled_elements_memoized { + {-package_id ""} +} { + # "ad_conn package_id" can't be used because occasionally our proc gets + # called from a filter, and filters don't seem to handle such calls. :( + + if { [empty_string_p $package_id] } { + set package_id [conn package_id] + } + + set user_id [ad_conn user_id] + + # Cache the bar per curriculum instance and user. + return [util_memoize [list curriculum::enabled_elements -package_id $package_id -user_id $user_id]] +} + + +ad_proc -private curriculum::enabled_elements { + {-package_id ""} + -user_id:required +} { + This is designed to be called within a memoization proc. +} { + + # The list this proc returns will be cached and used for (at least) + # two purposes: A) To produce the curriculum bar multirow. B) To check + # elements against a cookie value to be able to mark if an element has + # been visited. Either way we only keep elements from curriculums in + # workflow state "published" in the list. + + # "workflow::state::fsm::get_id" doesn't return the id of state "published" if there + # is no workflow, and there isn't one in "/"... That is why we feed this proc the + # package_id "curriculum::conn" gave us, which is the package_id of the curriculum + # instance in this subsite, regardless of what node we requested within the subsite. + + if { ![empty_string_p $package_id] } { + + # During normal operation, when a curriculum instance is mounted under the current + # subsite, the given package_id should be trustworthy ... + + set workflow_id [curriculum::get_instance_workflow_id -package_id $package_id] + + set state_id [workflow::state::fsm::get_id \ + -workflow_id $workflow_id \ + -short_name published] + + } else { + + # State id "0" does not exist, hence our query won't return any rows. Just what + # we want if there's no curriculum mounted in the subsite (as indicated by the + # empty package_id). + + set state_id 0 + } + + # If the user is logged in, the "cu_user_curriculum_map" will give an indication + # as to which curriculums are UNWANTED by the user. If the user is not logged in + # we're showing all (published) curriculums in the instance (there should be no + # user_id "0" in the mapping table). + + # FIXME. The PG version ought to look more like the Oracle version. + set ns_sets [db_list_of_ns_sets element_ns_set_list {*SQL*}] + + return [util_list_of_ns_sets_to_list_of_lists -list_of_ns_sets $ns_sets] +} + + +# FIXME. Integrate with "enabled_elements" above? +ad_proc -private curriculum::user_elements { +} { + Not meant to be cached. +} { + set package_id [conn package_id] + + set workflow_id [curriculum::get_instance_workflow_id -package_id $package_id] + + # We need to get elements of published curriculums. + set state_id [workflow::state::fsm::get_id \ + -workflow_id $workflow_id \ + -short_name published] + + # We need user_id to join against the mapping table that holds information + # on what curriculums (in the package instance) the user care about. + set user_id [ad_conn user_id] + + # FIXME. Add patameter. + set truncation_length 12 + + set ns_sets [db_list_of_ns_sets user_element_ns_set_list {*SQL*}] + + return [util_list_of_ns_sets_to_list_of_lists -list_of_ns_sets $ns_sets] +} + + +ad_proc -public curriculum::elements_flush { + {-package_id ""} +} { + Flushes the memoized proc that gets the element_id, url and name for the curriculum bar(s). + Should be run upon ceation, enabling, disabling or deletion of a curriculum or an element. +} { + if { [empty_string_p $package_id] } { + set package_id [conn package_id] + } + + # Only bother to flush the cache if the bar is going to be displayed. + if { ![parameter::get -package_id $package_id -parameter ShowCurriculumBarP -default 1] } { + return {} + } + + set user_id [ad_conn user_id] + + util_memoize_flush "curriculum::enabled_elements -package_id $package_id -user_id $user_id" +} + + +ad_proc -public curriculum::get_bar { + -bar_p:required +} { + Returns a string containing the HTML for a curriculum bar that shows the amount of progress a user has made on a curriculum. +} { + set package_id [conn package_id] + + # Is the curriculum bar even activated? If not, return the empty string. + if { $bar_p && ![parameter::get -package_id $package_id -parameter ShowCurriculumBarP -default 1] } { + return {} + } + + # Check cookie to make sure this person isn't finished. + set input_cookie [ad_get_cookie [get_cookie_name]] + + if { $bar_p && [empty_string_p $input_cookie] } { + # No cookie; this person is either brand new or the browser is rejecting cookies. + # Let's not uglify all their pages with a bar that they can't use. + #return {} + } + + # We have a cookie. + if { $bar_p && [string equal "finished" $input_cookie] } { + # User has completed curriculum, don't bother showing the bar. + #return {} + } + + # Compare what the user has seen to what is in the full curriculum(s) + # to put in checkboxes; we check the output headers first and then + # the input headers, in case there is going to be a newer value. + set output_cookie [get_output_cookie] + + if { [empty_string_p $output_cookie] } { + get_bar_internal -bar_p $bar_p $input_cookie + } else { + get_bar_internal -bar_p $bar_p $output_cookie + } +} + + +ad_proc -private curriculum::get_bar_internal { + -bar_p:required + cookie_value +} { + if { $bar_p } { + + # Get the cached curriculum list for the bar. + set rows [enabled_elements_memoized] + + } else { + + # Get the NOT cached curriculum list for index page use. + set rows [user_elements] + + } + + # If the user is logged in the "cu_user_curriculum_map" will be checked + # for unwanted curriculums. OTOH, if the user is not logged in, we're + # showing all (published) curriculums. + # See "curriculum::enabled_elements" (the non-cached variant). + + if { [llength $rows] == 0 } { + # Publisher hasn't published any curriculum. + return {} + } + + set manipulated_rows {} + + foreach row $rows { + array set element_info $row + + # Check in cookie whether the element has been visited or not. + if { [lsearch -exact $cookie_value $element_info(element_id)] != -1 } { + set row [concat $row checked_p 1] + } else { + set row [concat $row checked_p 0] + } + + # FIXME. Should be performed by the db! + # Check for external URLs. + if { [string equal -length 7 "http://" $element_info(url) ] } { + set row [concat $row external_p 1] + } else { + set row [concat $row external_p 0] + } + + lappend manipulated_rows $row + } + + # DEBUG. +# if {!$bar_p} {doc_return 200 text/plain "$cookie_value"} + + # Let's turn this list into a multirow datasource in the + # template's environment. 3 levels up, that is. + template::util::list_to_multirow elements $manipulated_rows 3 + +} + + +ad_proc -public curriculum::element_visited_p { + element_id +} { + # FIXME. + # I need to think harder about the logic here. + + set survey_installed_p 0 + set survey_required_p 1 + set survey_graded_p 1 + set survey_passed_p 1 + set cookie [ad_get_cookie [get_cookie_name]] + + if { $survey_installed_p && $survey_required_p } { + if { $survey_graded_p && !$survey_passed_p} { + # indicate status "unpassed" + return -1 + } elseif { $survey_graded_p && $survey_passed_p } { + # checked + return 1 + } else { + # + } + } else { + # Has the user visited this element? + if { [lsearch -exact $cookie $element_id] == -1 } { + return 0 + } + return 1 + } +} + + +##### +# +# Cookie procs +# +##### + + +ad_proc -public curriculum::get_output_cookie { +} { + Returns the value of the CurriculumProgress cookie that will be written to the client, or empty string if none is in the outputheaders ns_set +} { + if [empty_string_p [ns_conn outputheaders]] { + return {} + } + + return [ad_get_cookie -include_set_cookies t [get_cookie_name]] +} + + +ad_proc -public curriculum::get_cookie_name { +} { + Returns the package_id-dependent name of our cookie (CurriculumProgress_****). +} { + return CurriculumProgress_[conn package_id] +} + + +ad_proc -public curriculum::curriculum_progress_cookie_value { + -package_id:required + {old_value ""} + {new_element ""} +} { + If not args are supplied, returns the initial value for the CurriculumProgress_**** cookie. + If an old value and new element are supplied, returns an appropriate new cookie value. +} { + if { [empty_string_p $old_value] && [empty_string_p $new_element] } { + return "start" + } elseif { [string equal "start" $old_value] } { + if { [llength [enabled_elements_memoized -package_id $package_id]] == 1} { + return "finished" + } else { + return [list $new_element] + } + } elseif { [string equal "reset_one_curriculum" $old_value] } { + set curriculum_id $new_element + return [reset_one_curriculum $curriculum_id] + } elseif { [string equal "finished" $old_value] } { + # If you're finished, adding a new element doesn't change that! + return "finished" + } else { + set tentative_result [lappend old_value $new_element] + if { [llength [enabled_elements_memoized -package_id $package_id]] == [llength $tentative_result] } { + return "finished" + } else { + return $tentative_result + } + } +} + + +ad_proc -private curriculum::reset_one_curriculum { + curriculum_id +} { + Restart just one specific curriculum (uncheck its checkboxes). +} { + set cookie [ad_get_cookie [get_cookie_name]] + set package_id [conn package_id] + db_foreach element_ids {*SQL*} { + if { [set cookie_index [lsearch -exact $cookie $element_id]] != -1 } { + set cookie [lreplace $cookie $cookie_index $cookie_index] + } + } + if { [empty_string_p $cookie] } { + return "start" + } else { + return $cookie + } +} + + +##### +# +# Filter procs +# +##### + + +ad_proc -public curriculum::curriculum_filter { + conn + args + why +} { + We run this filter on registered urls in conjunction with + "curriculum_bar" which gets called from the default-master. + This will be run after(?) a registered url has been served. +} { + # FIXME. Remove the row below and uncomment the catch statement when the package is published. + curriculum_filter_internal $args $why + + # we don't want an error in the script to interrupt page service + # if [catch { curriculum_filter_internal $args $why } errmsg] { + # ns_log Error "curriculum::curriculum_filter_internal coughed up $errmsg" + # } + # + + return "filter_ok" +} + + +ad_proc -private curriculum::curriculum_filter_internal { + args + why +} { + set cookie [ad_get_cookie [get_cookie_name]] + set package_id [conn package_id] + if { ![empty_string_p $cookie] } { + # We have a cookie. + if { [string equal "finished" $cookie] } { + # User has completed curriculum, nothing more to do. + return + } else { + # See what the user is looking at right now and compare + # to curriculums to consider adding to cookie. + set list_of_lists [curriculum::enabled_elements_memoized -package_id $package_id] + set current_url [ad_conn url] + + foreach list $list_of_lists { + array set info $list + # Is the user visiting this curriculum element url? + if { [string equal $current_url $info(url)] } { + # See if this element isn't already in user's cookie. + set element_id $info(element_id) + if { [lsearch -exact $cookie $element_id] == -1 } { + set cookie [curriculum_progress_cookie_value -package_id $package_id $cookie $element_id] + ad_set_cookie -replace t [get_cookie_name] $cookie + # If the user is logged in, we'll also want to record + # the additional element in the database. + if { [set user_id [ad_conn user_id]] } { + # Insert, but only if there isn't a row already there. + set curriculum_id $info(curriculum_id) + db_dml map_insert {*SQL*} + } + } + } + } + } + } else { + # No cookie. + if { [parameter::get -package_id $package_id \ + -parameter AutomaticBarActivationP -default 1] } { + ad_set_cookie -replace t \ + [get_cookie_name] [curriculum_progress_cookie_value -package_id $package_id] + } + } +} + + +##### +# +# Util procs (that perhaps should go back to the community) +# +##### + +# FIXME. Not used. +# Maybe this would be useful to the OpenACS community...? +ad_proc -public curriculum::multirow_to_list_of_attrib_lists { + -var_name:required +} { + Convert a multirow into an array-settable list of the format: + 

+    col1 {row1 row2 ...} col2 {row1 row2 ...} col3 {row1 row2 ...} ...
+
+ + @param -var_name The name of the multirow to convert + + @author Ola Hansson (ola@polyxena.net) + @creation-date January 07, 2003 +} { + upvar $var_name:rowcount rowcount $var_name:columns columns i i + + for { set i 1 } { $i <= $rowcount } { incr i } { + upvar $var_name:$i row + foreach column [set columns] { + lappend $column $row($column) + } + } + + foreach column $columns { + lappend result $column [set $column] + } + + return $result +} + + +# FIXME. Not used. +ad_proc -private curriculum::magic_user { +} { + # Magic user_id. + return [db_exec_plsql get_magic_user_id {select cu_magic_user()}] +} Index: openacs-4/packages/curriculum/tcl/misc-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/curriculum/tcl/misc-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/curriculum/tcl/misc-procs.xql 3 Jun 2003 10:28:20 -0000 1.1 @@ -0,0 +1,31 @@ + + + + + + select curriculum_id as curriculum_ids, + name as curriculum_names + from cu_curriculums + where package_id = :package_id + order by sort_key + + + + + + select element_id + from cu_elements_enabled + where curriculum_id = :curriculum_id + and package_id = :package_id + + + + + + select count(*) as curriculum_count + from cu_curriculums + where package_id = :package_id + + + +