Index: openacs-4/contrib/obsolete-packages/library/library.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/library.info,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/library.info 2 Jul 2003 12:19:40 -0000 1.1
@@ -0,0 +1,390 @@
+<?xml version="1.0"?>
+<!-- Generated by the ACS Package Manager -->
+
+<package key="library" url="http://www.arsdigita.com/acs-repository/apm/packages/library" type="apm_application">
+ <package-name>Library</package-name>
+ <pretty-plural>Libraries</pretty-plural>
+ <initial-install-p>f</initial-install-p>
+ <singleton-p>f</singleton-p>
+
+ <version name="0.1d" url="http://www.arsdigita.com/acs-repository/download/apm/library-0.1d.apm">
+ <database-support>
+ <database>oracle</database>
+ <database>postgresql</database>
+ </database-support>
+ <owner url="mailto:dirk@arsdigita.com">Dirk Gomez</owner>
+ <summary>Red Hat Knowledge Library for ACS4.0</summary>
+ <description format="text/plain">Red Hat Knowledge Library for ACS4.0</description>
+
+ <provides url="library" version="0.1d"/>
+ <requires url="acs-workflow" version="4.0"/>
+ <requires url="bookmarks" version="4.1.1b"/>
+ <requires url="categories" version="0.1d"/>
+ <requires url="doubleclick" version="0.1d"/>
+ <requires url="general-feedback" version="0.1"/>
+
+ <files>
+ <file type="package_spec" path="library.info"/>
+ <file type="data_model_create" db_type="oracle" path="sql/oracle/library-create.sql"/>
+ <file type="data_model_drop" db_type="oracle" path="sql/oracle/library-drop.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-functions.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-package-bodies.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-packages.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-temp-tables.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-triggers.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-workflow-create.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-workflow-drop.sql"/>
+ <file type="data_model" db_type="oracle" path="sql/oracle/library-workflow-packages.sql"/>
+ <file type="tcl_procs" path="tcl/km-00-defs-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-access-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-admin-lib-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-branch-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-browse-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-callback-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-categories-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-display-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-feedback-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-links-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-object-data-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-psn-procs.tcl"/>
+ <file type="tcl_procs" path="tcl/km-users-procs.tcl"/>
+ <file type="tcl_init" path="tcl/library-init.tcl"/>
+ <file path="wf-templates/clarify.adp"/>
+ <file path="wf-templates/object-info.adp"/>
+ <file type="tcl_util" path="wf-templates/object-info.tcl"/>
+ <file path="wf-templates/review.adp"/>
+ <file path="wf-templates/verify.adp"/>
+ <file type="content_page" path="www/add-sharenet-ref.tcl"/>
+ <file type="content_page" path="www/add-web-ref-2.tcl"/>
+ <file type="content_page" path="www/add-web-ref.adp"/>
+ <file type="content_page" path="www/add-web-ref.tcl"/>
+ <file type="content_page" path="www/admin/add-description.tcl"/>
+ <file type="content_page" path="www/admin/add-end-date.tcl"/>
+ <file type="content_page" path="www/admin/add-linked-question.tcl"/>
+ <file type="content_page" path="www/admin/add-option-2.tcl"/>
+ <file type="content_page" path="www/admin/add-option.adp"/>
+ <file type="content_page" path="www/admin/add-option.tcl"/>
+ <file type="content_page" path="www/admin/add-public-until.tcl"/>
+ <file type="content_page" path="www/admin/add-start-date.tcl"/>
+ <file type="content_page" path="www/admin/approval-process-toggle-2.tcl"/>
+ <file type="content_page" path="www/admin/approval-process-toggle.adp"/>
+ <file type="content_page" path="www/admin/approval-process-toggle.tcl"/>
+ <file type="content_page" path="www/admin/branch-tree.adp"/>
+ <file type="content_page" path="www/admin/branch-tree.tcl"/>
+ <file type="content_page" path="www/admin/categories/index-template.adp"/>
+ <file type="content_page" path="www/admin/categories/index-template.tcl"/>
+ <file type="content_page" path="www/admin/categories/index.vuh"/>
+ <file type="content_page" path="www/admin/choose-category-2.tcl"/>
+ <file type="content_page" path="www/admin/choose-category.adp"/>
+ <file type="content_page" path="www/admin/choose-category.tcl"/>
+ <file type="content_page" path="www/admin/choose-object-type.adp"/>
+ <file type="content_page" path="www/admin/choose-object-type.tcl"/>
+ <file type="content_page" path="www/admin/choose-presentation-type-2.tcl"/>
+ <file type="content_page" path="www/admin/choose-presentation-type.adp"/>
+ <file type="content_page" path="www/admin/choose-presentation-type.tcl"/>
+ <file type="content_page" path="www/admin/choose-questions.adp"/>
+ <file type="content_page" path="www/admin/choose-questions.tcl"/>
+ <file type="content_page" path="www/admin/communities-with-admin-rights.adp"/>
+ <file type="content_page" path="www/admin/communities-with-admin-rights.tcl"/>
+ <file type="content_page" path="www/admin/copy-object-type-2.tcl"/>
+ <file type="content_page" path="www/admin/copy-object-type-structure-2.tcl"/>
+ <file type="content_page" path="www/admin/copy-object-type-structure.adp"/>
+ <file type="content_page" path="www/admin/copy-object-type-structure.tcl"/>
+ <file type="content_page" path="www/admin/copy-object-type.adp"/>
+ <file type="content_page" path="www/admin/copy-object-type.tcl"/>
+ <file type="content_page" path="www/admin/create-object-type-2.tcl"/>
+ <file type="content_page" path="www/admin/create-object-type.adp"/>
+ <file type="content_page" path="www/admin/create-object-type.tcl"/>
+ <file type="content_page" path="www/admin/delete-branch.tcl"/>
+ <file type="content_page" path="www/admin/delete-object-type-2.tcl"/>
+ <file type="content_page" path="www/admin/delete-object-type.adp"/>
+ <file type="content_page" path="www/admin/delete-object-type.tcl"/>
+ <file type="content_page" path="www/admin/delete-option-2.tcl"/>
+ <file type="content_page" path="www/admin/delete-option.adp"/>
+ <file type="content_page" path="www/admin/delete-option.tcl"/>
+ <file type="content_page" path="www/admin/delete-question-2.tcl"/>
+ <file type="content_page" path="www/admin/delete-question.adp"/>
+ <file type="content_page" path="www/admin/delete-question.tcl"/>
+ <file type="content_page" path="www/admin/edit-all-questions.tcl"/>
+ <file type="content_page" path="www/admin/edit-branch-2.tcl"/>
+ <file type="content_page" path="www/admin/edit-branch.adp"/>
+ <file type="content_page" path="www/admin/edit-branch.tcl"/>
+ <file type="content_page" path="www/admin/edit-category.tcl"/>
+ <file type="content_page" path="www/admin/edit-object-type-2.tcl"/>
+ <file type="content_page" path="www/admin/edit-object-type.adp"/>
+ <file type="content_page" path="www/admin/edit-object-type.tcl"/>
+ <file type="content_page" path="www/admin/edit-option-2.tcl"/>
+ <file type="content_page" path="www/admin/edit-option.adp"/>
+ <file type="content_page" path="www/admin/edit-option.tcl"/>
+ <file type="content_page" path="www/admin/edit-question-2.adp"/>
+ <file type="content_page" path="www/admin/edit-question-2.tcl"/>
+ <file type="content_page" path="www/admin/edit-question.adp"/>
+ <file type="content_page" path="www/admin/edit-question.tcl"/>
+ <file type="content_page" path="www/admin/error.adp"/>
+ <file type="content_page" path="www/admin/feedback-category-options-2.tcl"/>
+ <file type="content_page" path="www/admin/feedback-category-options.adp"/>
+ <file type="content_page" path="www/admin/feedback-category-options.tcl"/>
+ <file type="content_page" path="www/admin/index.adp"/>
+ <file type="content_page" path="www/admin/index.tcl"/>
+ <file type="content_page" path="www/admin/map-composite-questions.tcl"/>
+ <file type="content_page" path="www/admin/map-link-question.tcl"/>
+ <file type="content_page" path="www/admin/master.adp"/>
+ <file type="content_page" path="www/admin/move-object-type-2.tcl"/>
+ <file type="content_page" path="www/admin/move-object-type.adp"/>
+ <file type="content_page" path="www/admin/move-object-type.tcl"/>
+ <file type="content_page" path="www/admin/reindex.tcl"/>
+ <file type="content_page" path="www/admin/remove-approval-coordinator.tcl"/>
+ <file type="content_page" path="www/admin/set-composed-short-name-2.tcl"/>
+ <file type="content_page" path="www/admin/set-composed-short-name.adp"/>
+ <file type="content_page" path="www/admin/set-composed-short-name.tcl"/>
+ <file type="content_page" path="www/admin/set-default-branch.tcl"/>
+ <file type="content_page" path="www/admin/sort-keys.tcl"/>
+ <file type="content_page" path="www/admin/toggle.tcl"/>
+ <file type="content_page" path="www/admin/unset-default-branch.tcl"/>
+ <file type="content_page" path="www/admin/user-search.adp"/>
+ <file type="content_page" path="www/admin/view-branches.adp"/>
+ <file type="content_page" path="www/admin/view-branches.tcl"/>
+ <file type="content_page" path="www/admin/view-composite.adp"/>
+ <file type="content_page" path="www/admin/view-composite.tcl"/>
+ <file type="content_page" path="www/admin/view-options.adp"/>
+ <file type="content_page" path="www/admin/view-options.tcl"/>
+ <file type="content_page" path="www/admin/view-questions.adp"/>
+ <file type="content_page" path="www/admin/view-questions.tcl"/>
+ <file type="content_page" path="www/admin/view-sample-form.adp"/>
+ <file type="content_page" path="www/admin/view-sample-form.tcl"/>
+ <file type="content_page" path="www/admin/xchange-categories.adp"/>
+ <file type="content_page" path="www/admin/xchange-categories.tcl"/>
+ <file type="content_page" path="www/alert-categories.adp"/>
+ <file type="content_page" path="www/alert-categories.tcl"/>
+ <file type="content_page" path="www/alert-instance.adp"/>
+ <file type="content_page" path="www/alert-instance.tcl"/>
+ <file type="content_page" path="www/alert-types.adp"/>
+ <file type="content_page" path="www/alert-types.tcl"/>
+ <file type="content_page" path="www/alert.adp"/>
+ <file type="content_page" path="www/alert.tcl"/>
+ <file type="content_page" path="www/browse-one-category.adp"/>
+ <file type="content_page" path="www/browse-one-category.tcl"/>
+ <file type="content_page" path="www/browse-one-type.adp"/>
+ <file type="content_page" path="www/browse-one-type.tcl"/>
+ <file type="content_page" path="www/category-action.adp"/>
+ <file type="content_page" path="www/comment-add-2.adp"/>
+ <file type="content_page" path="www/comment-add-2.tcl"/>
+ <file type="content_page" path="www/comment-add-3.adp"/>
+ <file type="content_page" path="www/comment-add-3.tcl"/>
+ <file type="content_page" path="www/comment-add-4.tcl"/>
+ <file type="content_page" path="www/comment-add.adp"/>
+ <file type="content_page" path="www/comment-add.tcl"/>
+ <file type="content_page" path="www/comment-delete-2.tcl"/>
+ <file type="content_page" path="www/comment-delete.adp"/>
+ <file type="content_page" path="www/comment-delete.tcl"/>
+ <file type="content_page" path="www/comment-edit-2.tcl"/>
+ <file type="content_page" path="www/comment-edit.adp"/>
+ <file type="content_page" path="www/comment-edit.tcl"/>
+ <file type="content_page" path="www/content-link-add.tcl"/>
+ <file type="content_page" path="www/content-link-delete-2.tcl"/>
+ <file type="content_page" path="www/content-link-delete.adp"/>
+ <file type="content_page" path="www/content-link-delete.tcl"/>
+ <file type="content_page" path="www/date-filter.adp"/>
+ <file type="content_page" path="www/date-filter.tcl"/>
+ <file type="content_page" path="www/delete-audit-trail.tcl"/>
+ <file type="documentation" path="www/doc/cvs-information.html"/>
+ <file type="documentation" path="www/doc/datamodel-changes.html"/>
+ <file type="documentation" path="www/doc/index.html"/>
+ <file type="documentation" path="www/doc/km-library-data-model.html"/>
+ <file type="documentation" path="www/doc/km-library.html"/>
+ <file type="documentation" path="www/doc/pages/index.html"/>
+ <file type="documentation" path="www/doc/psn-general.html"/>
+ <file type="documentation" path="www/doc/workflow-visualized.gif"/>
+ <file type="documentation" path="www/doc/workflow.html"/>
+ <file type="content_page" path="www/download/index.vuh"/>
+ <file type="content_page" path="www/file-delete-2.tcl"/>
+ <file type="content_page" path="www/file-delete.adp"/>
+ <file type="content_page" path="www/file-delete.tcl"/>
+ <file type="content_page" path="www/form.css"/>
+ <file type="content_page" path="www/graphics/arrow.gif"/>
+ <file type="content_page" path="www/graphics/check-gray.gif"/>
+ <file type="content_page" path="www/graphics/check.gif"/>
+ <file type="content_page" path="www/groupadmin/index-template.adp"/>
+ <file type="content_page" path="www/groupadmin/index-template.tcl"/>
+ <file type="content_page" path="www/groupadmin/index.vuh"/>
+ <file type="content_page" path="www/index.adp"/>
+ <file type="content_page" path="www/index.tcl"/>
+ <file type="content_page" path="www/km-checkbox-tag.adp"/>
+ <file type="content_page" path="www/km-checkbox-tag.tcl"/>
+ <file type="content_page" path="www/km-content-link-table.adp"/>
+ <file type="content_page" path="www/km-content-link-table.tcl"/>
+ <file type="content_page" path="www/km-date-tag.adp"/>
+ <file type="content_page" path="www/km-date-tag.tcl"/>
+ <file type="content_page" path="www/km-display-child-object.adp"/>
+ <file type="content_page" path="www/km-display-child-object.tcl"/>
+ <file type="content_page" path="www/km-display-composite.adp"/>
+ <file type="content_page" path="www/km-display-composite.tcl"/>
+ <file type="content_page" path="www/km-display-file.adp"/>
+ <file type="content_page" path="www/km-display-file.tcl"/>
+ <file type="content_page" path="www/km-display-nephew-object.adp"/>
+ <file type="content_page" path="www/km-display-nephew-object.tcl"/>
+ <file type="content_page" path="www/km-display-question-answer.adp"/>
+ <file type="content_page" path="www/km-display-question-answer.tcl"/>
+ <file type="content_page" path="www/km-form.adp"/>
+ <file type="content_page" path="www/km-form.tcl"/>
+ <file type="content_page" path="www/km-input-tag.adp"/>
+ <file type="content_page" path="www/km-input-tag.tcl"/>
+ <file type="content_page" path="www/km-linked-object-list.adp"/>
+ <file type="content_page" path="www/km-linked-object-list.tcl"/>
+ <file type="content_page" path="www/km-object-type-img.adp"/>
+ <file type="content_page" path="www/km-object-type-img.tcl"/>
+ <file type="content_page" path="www/km-radio-tag.adp"/>
+ <file type="content_page" path="www/km-radio-tag.tcl"/>
+ <file type="content_page" path="www/km-ref-buttons.adp"/>
+ <file type="content_page" path="www/km-ref-buttons.tcl"/>
+ <file type="content_page" path="www/km-select-tag.adp"/>
+ <file type="content_page" path="www/km-select-tag.tcl"/>
+ <file type="content_page" path="www/km-submit-button.adp"/>
+ <file type="content_page" path="www/km-submit-button.tcl"/>
+ <file type="content_page" path="www/km-text-select.adp"/>
+ <file type="content_page" path="www/km-text-select.tcl"/>
+ <file type="content_page" path="www/km-textarea-tag.adp"/>
+ <file type="content_page" path="www/km-textarea-tag.tcl"/>
+ <file type="content_page" path="www/km-user-link-table.adp"/>
+ <file type="content_page" path="www/km-user-link-table.tcl"/>
+ <file type="content_page" path="www/km-yes-no.adp"/>
+ <file type="content_page" path="www/km-yes-no.tcl"/>
+ <file type="content_page" path="www/link-delete-2.tcl"/>
+ <file type="content_page" path="www/link-delete.adp"/>
+ <file type="content_page" path="www/link-delete.tcl"/>
+ <file type="content_page" path="www/link-reason-add.adp"/>
+ <file type="content_page" path="www/link-reason-add.tcl"/>
+ <file type="content_page" path="www/link-reason-edit-2.tcl"/>
+ <file type="content_page" path="www/link-reason-edit.adp"/>
+ <file type="content_page" path="www/link-reason-edit.tcl"/>
+ <file type="content_page" path="www/linking/index-template.adp"/>
+ <file type="content_page" path="www/linking/index-template.tcl"/>
+ <file type="content_page" path="www/linking/index.vuh"/>
+ <file type="content_page" path="www/linking/link-2.tcl"/>
+ <file type="content_page" path="www/linking/link.adp"/>
+ <file type="content_page" path="www/linking/link.tcl"/>
+ <file type="content_page" path="www/master.adp"/>
+ <file type="content_page" path="www/master.tcl"/>
+ <file type="content_page" path="www/object-access-add-2.tcl"/>
+ <file type="content_page" path="www/object-access-add.adp"/>
+ <file type="content_page" path="www/object-access-add.tcl"/>
+ <file type="content_page" path="www/object-access-change.tcl"/>
+ <file type="content_page" path="www/object-access.adp"/>
+ <file type="content_page" path="www/object-access.tcl"/>
+ <file type="content_page" path="www/object-archive-2.tcl"/>
+ <file type="content_page" path="www/object-archive.adp"/>
+ <file type="content_page" path="www/object-archive.tcl"/>
+ <file type="content_page" path="www/object-audit-trail.adp"/>
+ <file type="content_page" path="www/object-audit-trail.tcl"/>
+ <file type="content_page" path="www/object-copy-2.adp"/>
+ <file type="content_page" path="www/object-copy-2.tcl"/>
+ <file type="content_page" path="www/object-copy-3.tcl"/>
+ <file type="content_page" path="www/object-copy.adp"/>
+ <file type="content_page" path="www/object-copy.tcl"/>
+ <file type="content_page" path="www/object-delete-2.tcl"/>
+ <file type="content_page" path="www/object-delete.adp"/>
+ <file type="content_page" path="www/object-delete.tcl"/>
+ <file type="content_page" path="www/object-deleted.adp"/>
+ <file type="content_page" path="www/object-deleted.tcl"/>
+ <file type="content_page" path="www/object-edit-2.tcl"/>
+ <file type="content_page" path="www/object-edit.adp"/>
+ <file type="content_page" path="www/object-edit.tcl"/>
+ <file type="content_page" path="www/object-indexed.tcl"/>
+ <file type="content_page" path="www/object-link-2.tcl"/>
+ <file type="content_page" path="www/object-link.adp"/>
+ <file type="content_page" path="www/object-link.tcl"/>
+ <file type="content_page" path="www/object-propose-public-2.tcl"/>
+ <file type="content_page" path="www/object-propose-public.adp"/>
+ <file type="content_page" path="www/object-propose-public.tcl"/>
+ <file type="content_page" path="www/object-publish-2.tcl"/>
+ <file type="content_page" path="www/object-publish.adp"/>
+ <file type="content_page" path="www/object-publish.tcl"/>
+ <file type="content_page" path="www/object-unarchive-2.tcl"/>
+ <file type="content_page" path="www/object-unarchive.adp"/>
+ <file type="content_page" path="www/object-unarchive.tcl"/>
+ <file type="content_page" path="www/object-unpublish-2.tcl"/>
+ <file type="content_page" path="www/object-unpublish.adp"/>
+ <file type="content_page" path="www/object-unpublish.tcl"/>
+ <file type="content_page" path="www/object-view-linked.adp"/>
+ <file type="content_page" path="www/object-view-linked.tcl"/>
+ <file type="content_page" path="www/object-view-toolbar.adp"/>
+ <file type="content_page" path="www/object-view-toolbar.tcl"/>
+ <file type="content_page" path="www/object-view.adp"/>
+ <file type="content_page" path="www/object-view.tcl"/>
+ <file type="content_page" path="www/object-xml.tcl"/>
+ <file type="content_page" path="www/one-question-edit-2.tcl"/>
+ <file type="content_page" path="www/one-question-edit.adp"/>
+ <file type="content_page" path="www/one-question-edit.tcl"/>
+ <file type="content_page" path="www/owner-change-2.tcl"/>
+ <file type="content_page" path="www/owner-change.adp"/>
+ <file type="content_page" path="www/owner-change.tcl"/>
+ <file type="content_page" path="www/private-group-create.tcl"/>
+ <file type="content_page" path="www/publisher-change-2.tcl"/>
+ <file type="content_page" path="www/publisher-change.adp"/>
+ <file type="content_page" path="www/publisher-change.tcl"/>
+ <file type="content_page" path="www/question-field-category.adp"/>
+ <file type="content_page" path="www/question-field-category.tcl"/>
+ <file type="content_page" path="www/question-field-child-object.adp"/>
+ <file type="content_page" path="www/question-field-child-object.tcl"/>
+ <file type="content_page" path="www/question-field-composite.adp"/>
+ <file type="content_page" path="www/question-field-composite.tcl"/>
+ <file type="content_page" path="www/question-field-content-link.adp"/>
+ <file type="content_page" path="www/question-field-content-link.tcl"/>
+ <file type="content_page" path="www/question-field-date.adp"/>
+ <file type="content_page" path="www/question-field-date.tcl"/>
+ <file type="content_page" path="www/question-field-file.adp"/>
+ <file type="content_page" path="www/question-field-file.tcl"/>
+ <file type="content_page" path="www/question-field-integer.adp"/>
+ <file type="content_page" path="www/question-field-integer.tcl"/>
+ <file type="content_page" path="www/question-field-nephew-object.adp"/>
+ <file type="content_page" path="www/question-field-nephew-object.tcl"/>
+ <file type="content_page" path="www/question-field-object-link.adp"/>
+ <file type="content_page" path="www/question-field-object-link.tcl"/>
+ <file type="content_page" path="www/question-field-option.adp"/>
+ <file type="content_page" path="www/question-field-option.tcl"/>
+ <file type="content_page" path="www/question-field-other-category.adp"/>
+ <file type="content_page" path="www/question-field-other-category.tcl"/>
+ <file type="content_page" path="www/question-field-text.adp"/>
+ <file type="content_page" path="www/question-field-text.tcl"/>
+ <file type="content_page" path="www/question-field-user-link.adp"/>
+ <file type="content_page" path="www/question-field-user-link.tcl"/>
+ <file type="content_page" path="www/question-state.adp"/>
+ <file type="content_page" path="www/question-state.tcl"/>
+ <file type="content_page" path="www/questions.adp"/>
+ <file type="content_page" path="www/questions.tcl"/>
+ <file type="content_page" path="www/resource-application-add-2.tcl"/>
+ <file type="content_page" path="www/resource-application-add.adp"/>
+ <file type="content_page" path="www/resource-application-add.tcl"/>
+ <file type="content_page" path="www/resource-application-attach-2.tcl"/>
+ <file type="content_page" path="www/resource-application-attach.adp"/>
+ <file type="content_page" path="www/resource-application-attach.tcl"/>
+ <file type="content_page" path="www/resource-application-edit.tcl"/>
+ <file type="content_page" path="www/resource-application-save.tcl"/>
+ <file type="content_page" path="www/resource-application-send-2.tcl"/>
+ <file type="content_page" path="www/resource-application-send.adp"/>
+ <file type="content_page" path="www/resource-application-send.tcl"/>
+ <file type="content_page" path="www/resource-application.adp"/>
+ <file type="content_page" path="www/result-pages.adp"/>
+ <file type="content_page" path="www/result-pages.tcl"/>
+ <file type="content_page" path="www/send-page-ref-2.adp"/>
+ <file type="content_page" path="www/send-page-ref-2.tcl"/>
+ <file type="content_page" path="www/send-page-ref-3.tcl"/>
+ <file type="content_page" path="www/send-page-ref.adp"/>
+ <file type="content_page" path="www/send-page-ref.tcl"/>
+ <file type="content_page" path="www/show-descriptions.adp"/>
+ <file type="content_page" path="www/show-descriptions.tcl"/>
+ <file type="content_page" path="www/user-link-add.tcl"/>
+ <file type="content_page" path="www/user-link-delete-2.tcl"/>
+ <file type="content_page" path="www/user-link-delete.adp"/>
+ <file type="content_page" path="www/user-link-delete.tcl"/>
+ <file type="content_page" path="www/user-search.adp"/>
+ <file type="content_page" path="www/util.js"/>
+ </files>
+ <parameters>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="FilePath" description="Directory where attachments are stored."/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="ApprovalProcessP" default="f" description="ApprovalProcessP"/>
+ <parameter datatype="number" min_n_values="1" max_n_values="1" name="CategoryCountTimeout" default="300" description="How long do we cache (per user) category counts in library"/>
+ </parameters>
+
+ </version>
+</package>
Index: openacs-4/contrib/obsolete-packages/library/license.txt
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/license.txt,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/license.txt 2 Jul 2003 12:19:40 -0000 1.1
@@ -0,0 +1,340 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
Index: openacs-4/contrib/obsolete-packages/library/readme.txt
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/readme.txt,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/readme.txt 2 Jul 2003 12:19:40 -0000 1.1
@@ -0,0 +1,6 @@
+Knowledge Management Package
+
+This package is based on the commercial acs version from the year 2000.
+You can define different knowledge objects, questions and link the information variable.
+It is not tested with the openacs version 4.6.3.
+
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-create.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-create.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,994 @@
+
+--
+-- packages/library/sql/library-create.sql
+--
+-- Credit for the ACS 3 version of this module goes to:
+-- @author Branimir Dolicki (branimir@arsdigita.com)
+-- @author Carsten Clasohm (carsten@arsdigita.com)
+-- @author Sarah Arnold (zylonne@web.de)
+--
+-- The upgrade of this module to ACS 4 was done by
+-- @author Dirk Gomez (dirk@arsdigita.com)
+-- in June/July 2001.
+--
+-- @creation-date 22-June 2001
+-- @cvs-id $Id: library-create.sql,v 1.1 2003/07/02 12:19:42 peterm Exp $
+
+-- Changes, (at least those made by me) in reverse chronological order
+
+-- (bran 006) 2001-09-18 Moved everything having to do with linking to a --
+-- separate package - sn_links. So basically changes 001, 002, 004 and 005 are
+-- there and not here but in packages/sn-links/sql/oracle/sn-links.
+
+-- (bran 005) 2001-09-12 As we are using the low-tech approach w/o objects we
+-- need a sequence to generate link_id's.
+
+-- (bran 004) 2001-09-10 There ain't gonna be any stinkin' objects here. Links
+-- are just rows in a table. Period. Removed acs_object_type.create_type. Same
+-- goes for acs_rel_type.create_role and friends
+
+-- (bran 003) 2001-09-10 Removed question_id from sn_links because it is
+-- library-specific. We have a new table in library:
+-- sn_question_link_map
+
+-- (bran 002) 2001-09-10 Removed the sn_link_comments table and put that stuff
+-- into sn_links. Finally we admit that it doesn't make sense to have one comment
+-- on two links!
+
+-- (bran 001) 2001-09-10 Removed the link_type_id column from sn_link_types.
+-- We are now refering to link types by link_type and not by link_type_id.
+
+------------------------------------------------------------------------------
+-- The questions table holds all of the data about the kinds of
+-- questions that can be asked about a knowledge object.
+
+create table sn_questions (
+ question_id
+ integer
+ constraint sn_questions_question_id_fk
+ references acs_objects (object_id)
+ constraint sn_questions_question_id_pk
+ primary key,
+ pretty_name
+ varchar(4000),
+ abstract_data_type
+ varchar(50)
+ constraint sn_questions_abstract_data_nn not null,
+ presentation_type
+ varchar(100)
+ constraint sn_questions_presentation_t_nn not null,
+ -- for all questions which display lists
+ order_by
+ varchar(100),
+ -- default for input forms
+ default_value
+ varchar(4000),
+ entry_explanation
+ varchar(4000),
+ tag_width
+ integer,
+ tag_height
+ integer,
+ help_text
+ varchar(4000),
+ -- for object_link: which type to link to
+ target_object_type_id
+ integer,
+ -- that is merged in from a change I (and Carsten ;) already did in
+ -- 7.1
+ defaults_question_id
+ integer default null
+ constraint sn_questions_defaults_qu_id_fk
+ references sn_questions(question_id),
+ references_question_id
+ integer
+ constraint sn_questions_referenc_qu_id_fk
+ references sn_questions(question_id),
+ -- for question of data type category
+ tree_id
+ integer
+ constraint sn_questions_tree_ref references generic_trees,
+ node_id
+ integer
+ constraint sn_questions_node_ref references sw_category_dim,
+ browse_p
+ varchar(1) default 't'
+ constraint sn_questions_browse_p_ck
+ check (browse_p in ('t','f')),
+ -- This is only used during data migration from ShareNet 7.
+ category_id
+ integer,
+ max_categories
+ integer default null,
+ -- this is only for abstract_data_type date to specify what years
+ -- should be in the select box in respect to the default date.
+ year_from
+ integer default -5,
+ year_to
+ integer default 5
+);
+
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'sn_question',
+ pretty_name => 'Question',
+ pretty_plural => 'Questions',
+ table_name => 'SN_QUESTIONS',
+ id_column => 'QUESTION_ID'
+ );
+end;
+/
+show errors
+
+insert into sn_questions (question_id, pretty_name, abstract_data_type, presentation_type)
+select object_id, name, 'dummy', 'dummy' from
+acs_magic_objects where name = 'km_dummy_object';
+
+------------------------------------------------------------------------------
+-- Together with sn_question_object_type_map, table sn_object_types defines
+-- the possible types of knowledge objects.
+
+create table sn_types_map_short_name (
+ object_type_id
+ integer,
+ short_description
+ integer
+ constraint sn_types_map_short_desc_id_fk
+ references sn_questions (question_id),
+ position
+ integer,
+ constraint sn_types_map_short_name_pk
+ primary key (object_type_id, short_description)
+);
+
+create table sn_object_types (
+ object_type_id
+ integer
+ constraint sn_object_types_pk
+ primary key,
+ context_id
+ constraint sn_object_types_context_id_fk
+ references apm_packages (package_id)
+ on delete cascade,
+ short_name
+ varchar(100),
+ pretty_name
+ varchar(100)
+ constraint sn_object_types_pretty_name_nn not null,
+ pretty_plural
+ varchar(100),
+ -- filename for the graphic icon. This is always
+ -- $object_type_id.extension
+ graphic
+ varchar(200),
+ graphic_p
+ char(1)
+ default 'f'
+ constraint sn_object_types_graphic_p_nn not null,
+ constraint sn_object_types_graphic_p_ck
+ check (graphic_p in ('t', 'f')),
+ deleted_p
+ char(1)
+ default 'f'
+ constraint sn_object_types_deleted_p_nn not null,
+ constraint sn_object_types_deleted_p_ck
+ check (deleted_p in ('t', 'f')),
+ browse_p
+ char(1)
+ default 't'
+ constraint sn_object_types_browse_p_nn not null,
+ constraint sn_object_types_browse_p_ck
+ check (browse_p in ('t', 'f')),
+ -- If the object type is not public, consult sn_object_type_access
+ -- to determine if a user may access this type.
+ public_p
+ char(1) default 't'
+ constraint sn_object_types_public_p_nn not null,
+ constraint sn_object_types_public_p_ck
+ check (public_p in ('t','f')),
+ -- to be able to prevent standalone objects of this object type
+ -- (meaning objects which didnt created as child or nephew)
+ -- needed this for people sharenet - demand descriptions
+ create_p
+ char(1) default 't'
+ constraint sn_object_types_create_p_nn not null,
+ constraint sn_object_types_create_p_ck
+ check (create_p in ('t','f')),
+ sort_key
+ integer,
+ -- The admin can define which question is the name, overview or
+ -- public_until date for this object type:
+ short_description
+ integer
+ constraint sn_object_typ_short_desc_id_fk
+ references sn_questions (question_id),
+ long_description
+ integer
+ constraint sn_object_type_long_desc_id_fk
+ references sn_questions (question_id),
+ public_until
+ integer
+ constraint sn_object_t_public_until_id_fk
+ references sn_questions (question_id),
+ -- these two links to date questions have been added for
+ -- people sharenet (project start/end date):
+ start_date
+ integer
+ constraint sn_object_t_start_date_id_fk
+ references sn_questions (question_id),
+ end_date
+ integer
+ constraint sn_object_t_end_date_id_fk
+ references sn_questions (question_id),
+ -- that is merged in from a change I (and Carsten ;) already did in
+ -- 7.1
+ linked_question_id
+ integer
+ constraint sn_object_t_linked_quest_id_fk
+ references sn_questions(question_id),
+ default_age_filter
+ integer default 365,
+ -- can objects of this type be archived?
+ archive_p
+ char(1)
+ default 'f'
+ constraint sn_object_types_archive_p_nn not null,
+ constraint sn_object_types_archive_p_ck
+ check (archive_p in ('t', 'f')),
+ -- are you allowed to copy objects of this type?
+ copy_p
+ char(1)
+ default 'f'
+ constraint sn_object_types_copy_p_nn not null,
+ constraint sn_object_types_copy_p_ck
+ check (copy_p in ('t', 'f')),
+ -- which sweeper should be checking for old objects?
+ -- outdated: objects haven't been modified for a certain time
+ -- expired: public_until date has been exceeded
+ sweeper
+ varchar(10)
+ default 'none'
+ constraint sn_object_types_sweeper_nn not null,
+ constraint sn_object_types_sweeper_ck
+ check (sweeper in ('none','outdated','expired')),
+ -- action to be performed on the objects by the sweeper
+ sweeper_action
+ varchar(10)
+ default 'private'
+ constraint sn_object_types_sw_action_nn not null,
+ constraint sn_object_types_sw_action_ck
+ check (sweeper_action in ('private','archive')),
+ -- if >0 a warning email will be sent if the object is outdated/expired
+ -- specifies the amount of days the action should be performed after
+ -- the warning email
+ sweeper_warning_time
+ integer
+ default 0
+ constraint sn_object_types_warning_nn not null,
+ -- specified the amount of days after which an unchanged objects is
+ -- regarded as outdated
+ sweeper_outdated_time
+ integer
+ default 30
+);
+
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'sn_object_type',
+ pretty_name => 'Object Type',
+ pretty_plural => 'Object Types',
+ table_name => 'SN_OBJECT_TYPES',
+ id_column => 'OBJECT_TYPE_ID'
+ );
+end;
+/
+show errors
+
+-- We can only add this foreign key after creating the object_type_table.
+alter table sn_questions
+ add constraint sn_questions_object_type_id_fk
+ foreign key (target_object_type_id)
+ references sn_object_types(object_type_id);
+
+alter table sn_types_map_short_name
+ add constraint sn_types_map_object_type_id
+ foreign key (object_type_id)
+ references sn_object_types(object_type_id);
+
+
+------------------------------------------------------------------------------
+-- This table holds the objects.
+
+create table sn_objects (
+ object_id
+ integer
+ constraint sn_objects_id_pk
+ primary key,
+ object_type_id
+ integer
+ constraint sn_objects_object_type_id_fk
+ references sn_object_types (object_type_id),
+ -- objects should be subsite-aware as well
+ context_id
+ constraint sn_objects_context_id_fk
+ references apm_packages (package_id)
+ on delete cascade,
+ one_line_description
+ varchar(4000),
+ overview
+ varchar(4000),
+ overview_html_p
+ char(1)
+ constraint sn_objects_overview_html_p_ck
+ check (overview_html_p in ('t','f')),
+ creation_date
+ date,
+ original_author_id
+ integer
+ constraint sn_objects_orig_author_id_fk
+ references users (user_id),
+ last_modified
+ date,
+ last_modifying_user_id
+ integer
+ constraint sn_objects_last_mod_user_id_fk
+ references users (user_id),
+ user_checkoff_date date,
+ -- id of last publisher (user with km_publish permission) (BPM)
+ publisher_id
+ integer
+ constraint sn_objects_publisher_id_fk
+ references users (user_id),
+ expiration_date
+ date default '9999-12-31'
+ constraint sn_objects_expiration_date_nn not null,
+ public_until date,
+ -- these two dates got added for people sharenet:
+ start_date date,
+ end_date date,
+ public_p
+ char(1) default 'f'
+ constraint sn_objects_public_p_ck
+ check (public_p in ('t','f')),
+ archived_p
+ char(1) default 'f'
+ constraint sn_objects_archived_p_ck
+ check (archived_p in ('t','f')),
+ -- to mark object (i.e. nephews) that should be reviewd (BPM)
+ in_review_p
+ char(1) default 'f'
+ constraint sn_objects_in_review_p_ck
+ check (in_review_p in ('t','f')),
+ access_total integer default 0,
+ access_month integer default 0,
+ -- date the object got archived
+ archiving_date
+ date
+ default null,
+ -- date a warning email got sent that object is outdated
+ outdated_warning_date
+ date
+ default null,
+ -- date a warning email got sent that object is expired (public_until)
+ expired_warning_date
+ date
+ default null
+);
+
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'sn_object',
+ pretty_name => 'Library Object',
+ pretty_plural => 'Library Objects',
+ table_name => 'SN_OBJECTS',
+ id_column => 'OBJECT_ID'
+ ); end;
+/
+show errors
+
+
+-- Create some indexes for performance.
+
+create index sn_objects_expiration_date_ix on sn_objects (expiration_date);
+
+create index sn_objects_public_until_ix on sn_objects (public_until);
+
+create index sn_objects_start_date_ix on sn_objects (start_date);
+
+create index sn_objects_end_date_ix on sn_objects (end_date);
+
+create index sn_objects_checkoff_date_ix on sn_objects (user_checkoff_date);
+
+create index sn_objects_last_modified_ix on sn_objects (last_modified);
+
+create index sn_objects_new_stuff_ix on sn_objects (last_modified,
+user_checkoff_date, expiration_date, object_type_id);
+
+create index sn_objects_type_id_ix on sn_objects (object_type_id);
+
+create index sn_objects_browse_ix on sn_objects (object_type_id, context_id, expiration_date, last_modified, public_p, archived_p, object_id);
+
+create index sn_objects_one_line_desc_ix on sn_objects (substr(upper(one_line_description),1,1));
+
+create index sn_objects_archived_p_ix on sn_objects (archived_p);
+
+create index sn_objects_o_warning_date_ix on sn_objects (outdated_warning_date);
+
+create index sn_objects_e_warning_date_ix on sn_objects (expired_warning_date);
+
+create index sn_object_publisher_id_ix on sn_objects (publisher_id);
+
+------------------------------------------------------------------------------
+-- This defines the set of questions associated with a given object
+-- type. Questions can be used in common between object types and grouped
+-- together under one parent_question_id for composite questions.
+create table sn_question_object_type_map (
+ question_id
+ integer
+ constraint sn_question_otm_question_id_fk
+ references sn_questions (question_id),
+ object_type_id
+ integer
+ constraint sn_question_otm_object_t_id_fk
+ references sn_object_types (object_type_id),
+ sort_key
+ integer,
+ form_number
+ integer,
+ mandatory_p
+ char(1)
+ constraint sn_question_otm_mandatory_p_ck
+ check (mandatory_p in ('t','f')),
+ question_state
+ varchar(100)
+ constraint sn_question_otm_question_st_ck
+ check(question_state in
+ ('active','deprecated','read-only','invisible')),
+ -- used for composite and branches
+ -- -50 is the magic object from acs_magic_objects where name='km_dummy_object'. Don't change it!
+ parent_question_id
+ integer
+ default -50
+ constraint sn_question_otm_parent_q_id_nn not null
+ constraint sn_question_otm_parent_q_id_fk
+ references sn_questions (question_id),
+ -- t if this question itself is a branch, NOT if this question LEADS to branches
+ branch_p
+ char(1)
+ constraint sn_question_otm_branch_p_ck
+ check (branch_p in ('t','f')),
+ -- applies to the question as the parent node of a branch
+ branch_operator
+ varchar(4000),
+ -- the answers apply to the child nodes
+ branch_answer
+ varchar(4000),
+ -- can reference categories or sn_answer_options
+ branch_answer_foreign_key
+ integer,
+ default_branch
+ integer
+ constraint sn_question_otm_default_bra_fk
+ references sn_questions (question_id),
+ constraint sn_question_object_type_map_pk
+ primary key (question_id, object_type_id)
+);
+
+------------------------------------------------------------------------------
+-- ***** Object Data *****
+
+-- This table stores the content of the one-to-one questions having abstract
+-- data type "text" for any given object.
+
+-- The questions_id shows which question the content answers. If a single
+-- question has more than one answer, then that data belongs in the
+-- multiple-choice answers tables (sn_answer_options and sn_object_option_map)
+-- having the abstract data type "multiple_choice" or should be constructed as
+-- composite question having the abstract data type "composite".
+
+create table sn_content (
+ object_id
+ integer
+ constraint sn_content_object_id_fk
+ references sn_objects(object_id),
+ question_id
+ integer
+ constraint sn_content_question_id_fk
+ references sn_questions(question_id),
+ content
+ clob,
+ html_p
+ char(1)
+ constraint sn_content_html_p_ck
+ check (html_p in ('t', 'f')),
+ constraint sn_content_pk
+ primary key (object_id, question_id)
+);
+
+------------------------------------------------------------------------------
+-- ***** Auditing *****
+-- Whenever the content of an object is changed then we store it here. We
+-- don't store changes in the categorization, linking or multiple choice
+-- questions.
+
+create table sn_audit_table (
+ object_id
+ integer
+ constraint sn_audit_table_object_id_fk
+ references sn_objects(object_id),
+ question_id
+ integer
+ constraint sn_audit_table_question_id_fk
+ references sn_questions(question_id),
+ --this refers to the question being modified
+ last_modified
+ date
+ constraint sn_audit_table_last_modifie_nn not null,
+ last_modifying_user_id
+ integer
+ constraint sn_audit_table_last_mo_u_id_fk
+ references users (user_id),
+ content
+ varchar(4000)
+);
+
+create index audit_table_ix on sn_audit_table(object_id);
+
+-- The ShareNet admins want to give a reason for object deletion to supervise
+-- the incentive system more efficiently.
+
+create table sn_object_delete_reasons (
+ object_id
+ integer
+ constraint sn_object_delete_rea_obj_id_fk
+ references sn_objects(object_id)
+ constraint sn_object_delete_reasons_pk
+ primary key,
+ reason_for_deleting
+ varchar(4000),
+ deleted_on
+ date default sysdate
+);
+
+-- For the archive
+
+create table sn_object_archive_reasons (
+ object_id
+ integer
+ constraint sn_object_archive_re_obj_id_fk
+ references sn_objects(object_id),
+ reason_for_archiving
+ varchar(4000),
+ archived_on
+ date default sysdate,
+ constraint sn_object_archive_reasons_pk
+ primary key (object_id, archived_on)
+);
+
+------------------------------------------------------------------------------
+-- This table holds the answers to multiple choice questions
+create table sn_answer_options (
+ option_id
+ integer
+ constraint sn_answer_options_option_id_pk
+ primary key,
+ question_id
+ integer
+ constraint sn_answer_options_questi_id_fk
+ references sn_questions(question_id),
+ answer_option
+ varchar(4000),
+ sort_key
+ integer
+);
+
+------------------------------------------------------------------------------
+-- This table links multiple-choice answers to objects
+create table sn_object_option_map (
+ object_id
+ integer
+ constraint sn_object_option_map_obj_id_fk
+ references sn_objects(object_id),
+ option_id
+ integer
+ constraint sn_object_option_map_opt_id_fk
+ references sn_answer_options(option_id)
+);
+
+------------------------------------------------------------------------------
+-- (bran 003)
+-- When linking was library-specific thing we
+-- had question_id column in the sn_links table.
+-- Now we have a special table which answers the
+-- question: "Given a link_id, to which question
+-- was the user answering when he created that link?"
+create table sn_question_link_map (
+ link_id
+ integer
+ constraint sn_question_link_ma_link_id_fk
+ references sn_links (link_id)
+ on delete cascade
+ constraint sn_question_link_map_pk
+ primary key,
+ question_id
+ integer
+ constraint sn_question_lin_question_id_fk
+ references sn_questions (question_id)
+ constraint sn_question_lin_question_id_nn
+ not null
+);
+
+create index sn_question_link_ma_q_id_ix on sn_question_link_map (question_id);
+
+------------------------------------------------------------------------------
+-- Excursions & Navigation
+
+create table km_path (
+ path_id
+ integer
+ constraint km_path_pk
+ primary key
+ constraint km_path_path_id_nn not null ,
+ last_path_id
+ integer,
+ action
+ varchar(100),
+ values_list
+ varchar(4000),
+ return_to
+ varchar(4000),
+ start_time
+ date
+);
+
+------------------------------------------------------------------------------
+-- access counting
+create table sn_access_counts (
+ object_id
+ integer
+ constraint sn_access_counts_object_id_fk
+ references sn_objects(object_id),
+ access_count
+ integer,
+ access_date
+ date,
+ constraint sn_access_counts_pk
+ primary key (object_id,access_date)
+);
+
+create index sn_access_counts_composite_ix on sn_access_counts (object_id,access_date,access_count);
+
+------------------------------------------------------------------------------
+-- For backwards compatibility. Old-style URLs looked like this:
+-- /library/browse-one-type.tcl?object_type=market
+-- and they need to be converted to /library/browse-one-type.tcl?object_type_id
+
+create table sn_table_name_map (
+ object_type_id
+ integer
+ constraint sn_table_name_map_pk
+ primary key,
+ context_id
+ constraint sn_table_name_map_cont_id_fk
+ references apm_packages (package_id)
+ on delete cascade,
+ object_type_name varchar(100)
+);
+
+------------------------------------------------------------------------------
+-- We're maintaining km_flat_object_hierarchy with triggers that fire
+-- on insert or delete from sn_links for link type parent_child.
+-- Since it's not allowed to access sn_links from triggers defined on it
+-- (table is mutating etc etc), we keep the copy of the relevant data in
+-- flat_object_hierarchy itself. Suppose we have following hierarchy:
+
+-- --------------
+-- 102
+-- 106
+-- 107
+-- 141
+-- 121
+-- --------------
+--
+-- From source sn_links table:
+
+-- SITE_WIDE_ID_A SITE_WIDE_ID_B
+-- ------------------ -----------------
+-- 102 106
+-- 106 107
+-- 141 121
+-- 102 141
+
+
+-- ... we arrive on flat_object_hierarchy
+
+
+-- PARENT CHILD DISTANCE
+-- --------- ---------- --------
+-- 141 121 1
+-- 102 121 2
+-- 102 141 1
+-- 102 106 1
+-- 102 107 2
+-- 106 107 1
+
+
+create table km_flat_object_hierarchy (
+ object_hierarchy_id
+ integer
+ constraint km_flat_object_hierarchy_id_pk
+ primary key,
+ parent
+ integer
+ constraint km_flat_object_hier_parent_nn not null
+ constraint km_flat_object_hier_parent_fk
+ references acs_objects (object_id),
+ child
+ integer
+ constraint km_flat_object_hier_child_nn not null
+ constraint km_flat_object_hier_child_fk
+ references acs_objects (object_id),
+ distance
+ integer,
+ link_type
+ varchar2(100),
+ constraint km_flat_object_hier_unique unique (parent, child)
+);
+
+create index km_flat_object_hier_child_ix on km_flat_object_hierarchy(child);
+
+
+------------------------------------------------------------------------------
+-- This table is pretty damn useful if you want to track long-running
+-- transaction. It is being filled by a pl/sql procedure that commits
+-- within a autonomous transaction.
+
+create table km_logger_table (
+ log_date
+ date
+ default sysdate,
+ who_is_logging
+ varchar2(4000),
+ log_text
+ varchar2(4000)
+);
+
+
+-----------------------------------------------------------------------------
+-- This table is for the library sweeper proc that takes care of outdated
+-- or expired objects and sets them to private or archive them if
+-- the user didn't take action after a warning email
+
+create table km_sweeper (
+ user_id
+ integer
+ constraint km_sweeper_user_id_fk
+ references users,
+ package_id
+ integer
+ constraint km_sweeper_package_id_fk
+ references apm_packages,
+ object_type_id
+ integer
+ constraint km_sweeper_obj_type_id_fk
+ references sn_object_types,
+ object_id
+ integer
+ constraint km_sweeper_object_id_fk
+ references sn_objects,
+ object_name
+ varchar2(4000),
+ content
+ varchar2(4000),
+ primary key (user_id, object_id)
+);
+
+-- this table holds the library sweeper emails for publishers
+create table km_sweeper_publisher (
+ user_id
+ integer
+ constraint km_sweeper_publ_user_id_fk
+ references users,
+ package_id
+ integer
+ constraint km_sweeper_publ_package_id_fk
+ references apm_packages,
+ object_type_id
+ integer
+ constraint km_sweeper_publ_obj_type_id_fk
+ references sn_object_types,
+ object_id
+ integer
+ constraint km_sweeper_publ_object_id_fk
+ references sn_objects,
+ object_name
+ varchar2(4000),
+ content
+ varchar2(4000),
+ primary key (user_id, object_id)
+);
+
+
+------------------------------------------------------------------------------
+create table km_library_searches (
+ km_library_searches_id
+ integer
+ constraint km_library_searches_id_pk
+ primary key,
+ user_id
+ integer
+ constraint km_library_searches_user_id_fk
+ references users (user_id),
+ name
+ varchar(200),
+ url_params
+ clob,
+ creation_date
+ date
+ default sysdate
+);
+
+create table km_advanced_search_settings (
+ search_id
+ integer
+ constraint km_advanced_ss_search_id_fk
+ references km_library_searches(km_library_searches_id),
+ parameter_key
+ varchar(4000),
+ parameter_value
+ clob
+);
+
+------------------------------------------------------------------------------
+create table sn_owner_history (
+ object_id
+ integer
+ constraint sn_own_hist_object_id_fk
+ references sn_objects(object_id),
+ change_user_id
+ integer
+ constraint sn_own_hist_change_user_id_fk
+ references users(user_id),
+ old_user_id
+ integer
+ constraint sn_own_hist_old_user_id_fk
+ references users(user_id),
+ new_user_id
+ integer
+ constraint sn_own_hist_new_user_id_fk
+ references users(user_id),
+ change_date
+ date,
+ reason
+ varchar(4000)
+);
+
+------------------------------------------------------------------------------
+-- th 2001-10-22 tables added for people sharenet: application form
+------------------
+create table psn_res_applications (
+ application_id integer primary key,
+ object_id constraint psn_res_app_object_id_fk references sn_objects on delete cascade,
+ resource_req_id constraint psn_res_app_res_req_id_fk references sn_objects on delete cascade,
+ user_id constraint psn_res_app_user_id_fk references users,
+ creation_date date default sysdate,
+ application_date date default null,
+ sent_p char(1) default 'f' constraint psn_res_app_sent_p_ck check (sent_p in ('t','f')),
+ recipient varchar2(4000),
+ subject varchar2(1000),
+ contact_data varchar2(4000),
+ nationality varchar2(4000),
+ manager_email varchar2(4000),
+ working_area varchar2(4000),
+ role_other varchar2(1000),
+ first_language varchar2(1000),
+ second_language_id integer,
+ third_language_id integer,
+ first_language_prof_id integer,
+ second_language_prof_id integer,
+ third_language_prof_id integer,
+ other_language varchar2(4000),
+ from_date date,
+ to_date date,
+ strengths varchar2(4000),
+ leadership varchar2(4000),
+ intercultural varchar2(4000),
+ comments varchar2(4000),
+ conditions varchar2(4000)
+);
+
+create index psn_res_app_object_idx on psn_res_applications (object_id);
+
+create index psn_res_app_res_idx on psn_res_applications (resource_req_id);
+
+create index psn_res_app_user_idx on psn_res_applications (user_id);
+
+create table psn_res_application_roles (
+ application_id integer constraint psn_res_app_roles_app_fk references psn_res_applications on delete cascade,
+ role_id integer,
+ primary key (application_id, role_id)
+);
+
+create table psn_category_trees (
+ package_id integer primary key,
+ role_magic_id constraint psn_cat_trees_role_fk references acs_objects (object_id) on delete set null,
+ language_magic_id constraint psn_cat_trees_lang_fk references acs_objects (object_id) on delete set null,
+ proficiency_magic_id constraint psn_cat_trees_prof_fk references acs_objects (object_id) on delete set null
+);
+
+create table psn_attachments (
+ attachment_id integer primary key,
+ application_id constraint psn_attach_appl_id_fk references psn_res_applications on delete cascade,
+ title varchar2(1000),
+ mime_type varchar2(200) default 'text/plain',
+ filename varchar2(200),
+ attachment blob default empty_blob()
+);
+
+create index psn_attach_appl_id_idx on psn_attachments(application_id);
+
+create sequence psn_attachment_id_seq start with 1;
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'psn_tree_object',
+ pretty_name => 'Demand Application Form',
+ pretty_plural => 'Demand Application Forms',
+ table_name => 'PSN_CATEGORY_TREES'
+ );
+end;
+/
+show errors
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'psn_application',
+ pretty_name => 'Demand Application',
+ pretty_plural => 'Demand Applications',
+ table_name => 'PSN_RES_APPLICATIONS',
+ id_column => 'APPLICATION_ID'
+ );
+end;
+/
+show errors
+
+
+create table approval_coordinators (
+ package_id integer
+ constraint sn_approval_coord_packag_id_fk
+ references apm_packages (package_id)
+ on delete cascade,
+ coordinator_id
+ integer
+ constraint sn_approval_coord_coord_id_fk
+ references users (user_id),
+ constraint approval_coordinators_pk
+ primary key (package_id, coordinator_id)
+);
+
+------------------------------------------------------------------------------
+-- now go on and create the packages
+
+@@library-temp-tables
+@@library-packages
+@@library-package-bodies
+@@library-triggers
+@@library-workflow-create
+@@library-workflow-packages
+
+begin
+ acs_privilege.create_privilege('km_publish');
+ acs_privilege.add_child('km_publish','read');
+ acs_privilege.add_child('km_publish','write');
+ acs_privilege.add_child('km_publish','delete');
+end;
+/
+show errors
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-drop.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-drop.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,146 @@
+--
+-- packages/library/sql/library-drop.sql
+--
+-- Credit for the ACS 3 version of this module goes to:
+-- @author Branimir Dolicki (branimir@arsdigita.com)
+-- @author Carsten Clasohm (carsten@arsdigita.com)
+-- @author Sarah Arnold (no idea)
+--
+-- The upgrade of this module to ACS 4 was done by
+-- @author Dirk Gomez (dirk@arsdigita.com)
+-- @author Jens Kordsmeier (jak@arsdigita.com)
+-- in June/July 2000.
+--
+-- @creation-date 22-June 2001
+-- @cvs-id $Id
+
+-- Delete all library question objects and corresponding acs objects
+
+-- declare
+-- cursor c_question_id
+-- is
+-- select question_id
+-- from sn_questions
+-- where parent_id not in (select question_id from sn_questions);
+-- begin
+-- for v_question_id in c_question_id loop
+-- question.delete(v_question_id.question_id);
+-- end loop;
+-- end;
+-- /
+-- show errors
+
+-- delete acs_permissions
+-- Drop permission metadata
+delete from acs_permissions
+ where privilege in
+ ('km_instance_admin','km_object_type_read',
+ 'km_object_type_create','km_object_read',
+ 'km_object_write','km_publish');
+
+delete from acs_privilege_hierarchy
+ where privilege in
+ ('km_instance_admin','km_object_type_read',
+ 'km_object_type_create','km_object_read',
+ 'km_object_write','km_publish');
+
+delete from acs_privilege_hierarchy
+ where child_privilege in
+ ('km_instance_admin','km_object_type_read',
+ 'km_object_type_create','km_object_read',
+ 'km_object_write','km_publish');
+
+delete from acs_privileges
+ where privilege in
+ ('km_instance_admin','km_object_type_read',
+ 'km_object_type_create','km_object_read',
+ 'km_object_write','km_publish');
+
+
+declare
+ cursor c1 is
+ select package_id from apm_packages where package_key='library';
+begin
+ for pac_rec in c1 loop
+ object_type.delete_all_object_types(pac_rec.package_id);
+ end loop;
+end;
+/
+
+alter table sn_questions
+ drop constraint sn_questions_object_type_id_fk;
+drop table psn_attachments;
+drop table psn_category_trees;
+drop table psn_res_application_roles;
+drop table psn_res_applications;
+drop table km_sweeper;
+drop table km_sweeper_publisher;
+drop table sn_object_archive_reasons;
+drop table km_advanced_search_settings;
+drop table km_library_searches;
+drop table km_logger_table;
+drop table km_flat_object_hierarchy;
+drop table sn_question_link_map;
+drop table sn_table_name_map;
+drop table sn_access_counts;
+drop table sn_object_option_map;
+drop table sn_answer_options;
+drop table sn_object_delete_reasons;
+drop table km_object_archive_reasons;
+drop table sn_audit_table;
+drop table sn_content;
+drop table sn_question_object_type_map;
+drop table sn_objects;
+drop table sn_object_types;
+drop table sn_questions;
+drop table km_path;
+
+delete from bm_bookmarkable_types where object_type = 'sn_object';
+
+delete from subsite_callbacks where object_type = 'sn_object';
+
+delete from acs_objects_description where object_id in (select object_id from acs_objects where object_type='sn_object');
+
+delete from acs_permissions where object_id in (select object_id from acs_objects where object_type='sn_object');
+
+-- Yeah I know it's stupid. But it works.
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+delete from acs_objects o where object_type='sn_object' and not exists (select 1 from acs_objects i where context_id = o.object_id);
+
+-- This is even more...
+delete from acs_objects where object_type='sn_comment' and context_id in (select object_id from acs_objects where object_type='sn_object');
+
+delete from acs_objects where object_type = 'sn_object_type';
+delete from acs_objects where object_type = 'sn_question';
+delete from acs_objects where object_type = 'psn_tree_object';
+delete from acs_objects where object_type = 'psn_application';
+
+begin
+ acs_object_type.drop_type ('sn_object');
+ acs_object_type.drop_type ('sn_object_type');
+ acs_object_type.drop_type ('sn_question');
+ acs_object_type.drop_type ('psn_tree_object');
+ acs_object_type.drop_type ('psn_application');
+end;
+/
+show errors
+
+------------------------------------------------------------------------------
+------------------------------------------------------------------------------
+------------------------------------------------------------------------------
+-- Those procedures will be deleted one after another once the analog ACS4
+-- stuff is done.
+
+
+drop table sn_links;
+drop table sn_link_types;
+drop sequence sn_links_seq;
+drop sequence psn_attachment_id_seq;
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-functions.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-functions.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-functions.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,13 @@
+create or replace function sn_check_type (p_object_id integer,
+ p_object_type_id integer)
+return integer
+as
+ result integer;
+begin
+ select decode(object_type_id, p_object_type_id, 1, 0) into result
+ from sn_objects
+ where object_id=p_object_id;
+ return result;
+end;
+/
+show errors
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-package-bodies.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-package-bodies.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-package-bodies.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,1736 @@
+create or replace package body library
+as
+ procedure copy (
+ src_package_id in apm_packages.package_id%TYPE,
+ dst_package_id in apm_packages.package_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE,
+ creation_ip in acs_objects.creation_ip%TYPE
+ )
+ is
+ begin
+ object_type.copy_all_object_types (
+ src_package_id => src_package_id,
+ dst_package_id => dst_package_id,
+ creation_user => creation_user,
+ creation_ip => creation_ip
+ );
+
+ psn_res_application.copy (
+ src_package_id => src_package_id,
+ dst_package_id => dst_package_id,
+ creation_user => creation_user,
+ creation_ip => creation_ip
+ );
+
+ end copy;
+
+end library;
+/
+show errors
+
+create or replace package body object_type
+as
+ procedure copy_all_object_types (
+ src_package_id in acs_objects.context_id%TYPE,
+ dst_package_id in acs_objects.context_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE,
+ creation_ip in acs_objects.creation_ip%TYPE
+ )
+ is
+ cursor c_questions (src_package_id integer) is
+ select question_id, pretty_name, abstract_data_type, presentation_type,
+ order_by, entry_explanation, tag_width, tag_height, help_text,
+ target_object_type_id, references_question_id, tree_id, node_id,
+ category_id, year_from, year_to, default_value, max_categories,
+ defaults_question_id
+ from sn_questions
+ where question_id in
+ (select map.question_id
+ from sn_question_object_type_map map, sn_object_types ot
+ where map.object_type_id = ot.object_type_id
+ and ot.context_id = src_package_id);
+
+ cursor c_object_types (src_package_id integer) is
+ select object_type_id, short_name, pretty_name, pretty_plural, graphic,
+ graphic_p, deleted_p, browse_p, public_p, create_p, sort_key,
+ q1.new_id as new_short_description, q2.new_id as new_long_description,
+ q3.new_id as new_public_until, q4.new_id as new_linked_question_id,
+ default_age_filter, dst_package_id, archive_p, copy_p,
+ sweeper, sweeper_action, sweeper_warning_time, sweeper_outdated_time,
+ start_date, end_date
+ from sn_object_types ot, km_temp_questions q1, km_temp_questions q2,
+ km_temp_questions q3, km_temp_questions q4
+ where ot.context_id = src_package_id
+ and q1.old_id(+) = ot.short_description
+ and q2.old_id(+) = ot.long_description
+ and q3.old_id(+) = ot.public_until
+ and q4.old_id(+) = ot.linked_question_id;
+
+ cursor c_answer_options is
+ select option_id, tq.new_id as new_question_id, answer_option, sort_key
+ from sn_answer_options ao, km_temp_questions tq
+ where ao.question_id = tq.old_id;
+ v_new_question_id sn_questions.question_id%type;
+ v_new_object_type_id sn_object_types.object_type_id%type;
+ v_new_answer_option_id sn_answer_options.option_id%type;
+ v_count integer;
+ v_new_target_object_type_id integer;
+ begin
+ -- Clean up data from previous call in this transaction.
+ delete from km_temp_questions;
+ delete from km_temp_object_types;
+ delete from km_temp_answer_options;
+
+ -- copy the questions
+ for c1 in c_questions(src_package_id) loop
+ v_new_question_id := question.insert_question (
+ v_pretty_name => c1.pretty_name,
+ v_abstract_data_type => c1.abstract_data_type,
+ v_order_by => c1.order_by,
+ v_default_value => c1.default_value,
+ v_entry_explanation => c1.entry_explanation,
+ v_creation_user => creation_user,
+ v_creation_ip => creation_ip,
+ v_references_q_id => null);
+
+ update sn_questions
+ set presentation_type=c1.presentation_type, tag_width=c1.tag_width,
+ tag_height = c1.tag_height, help_text = c1.help_text, tree_id =
+ c1.tree_id, node_id = c1.node_id, category_id = c1.category_id,
+ year_from = c1.year_from, year_to = c1.year_to,
+ target_object_type_id = c1.target_object_type_id,
+ max_categories = c1.max_categories,
+ defaults_question_id = c1.defaults_question_id
+ where question_id=v_new_question_id;
+ insert into km_temp_questions
+ (old_id, new_id)
+ values
+ (c1.question_id, v_new_question_id);
+ end loop;
+
+ -- correct references_question_id
+ update sn_questions q
+ set references_question_id = (select new_id
+ from km_temp_questions
+ where old_id = q.references_question_id )
+ where question_id in
+ (select old_id from km_temp_questions);
+
+ -- correct defaults_question_id
+ update sn_questions q
+ set defaults_question_id = (select new_id
+ from km_temp_questions
+ where old_id = q.defaults_question_id )
+ where question_id in
+ (select old_id from km_temp_questions);
+
+ for c2 in c_object_types(src_package_id) loop
+ -- create the new object type
+ v_new_object_type_id := acs_object.new (
+ object_type => 'sn_object_type',
+ creation_date => sysdate,
+ creation_user => creation_user,
+ creation_ip => creation_ip,
+ context_id => dst_package_id
+ );
+
+ insert into sn_object_types
+ (object_type_id, short_name, pretty_name, pretty_plural, graphic,
+ graphic_p, deleted_p, browse_p, public_p, create_p, sort_key,
+ short_description, long_description, public_until, linked_question_id,
+ default_age_filter, context_id, archive_p, copy_p, sweeper,
+ sweeper_action, sweeper_warning_time, sweeper_outdated_time,
+ start_date, end_date)
+ values
+ (v_new_object_type_id, c2.short_name, c2.pretty_name, c2.pretty_plural, c2.graphic,
+ c2.graphic_p, c2.deleted_p, c2.browse_p, c2.public_p, c2.create_p, c2.sort_key,
+ c2.new_short_description, c2.new_long_description,
+ c2.new_public_until, c2.new_linked_question_id,
+ c2.default_age_filter, c2.dst_package_id, c2.archive_p,
+ c2.copy_p, c2.sweeper, c2.sweeper_action, c2.sweeper_warning_time,
+ c2.sweeper_outdated_time, c2.start_date, c2.end_date);
+
+ insert into km_temp_object_types
+ (old_id, new_id)
+ values
+ (c2.object_type_id, v_new_object_type_id);
+ end loop;
+
+ -- now map the shortname
+ for c3 in (select tot.new_id as object_type_id, tq.new_id as short_description, map.position
+ from sn_types_map_short_name map, km_temp_questions tq,
+ km_temp_object_types tot
+ where map.short_description = tq.old_id
+ and map.object_type_id = tot.old_id)
+ loop
+ begin
+ insert into sn_types_map_short_name
+ (object_type_id, short_description, position)
+ values
+ (c3.object_type_id, c3.short_description, c3.position );
+ exception
+ when others then
+ null;
+ end;
+ end loop;
+
+ -- map the answer options
+ for c4 in c_answer_options loop
+ select acs_object_id_seq.nextval into v_new_answer_option_id from dual;
+ insert into sn_answer_options
+ (option_id, question_id, answer_option, sort_key)
+ values
+ (v_new_answer_option_id, c4.new_question_id, c4.answer_option,
+ c4.sort_key);
+ insert into km_temp_answer_options
+ (old_id, new_id)
+ values
+ (c4.option_id, v_new_answer_option_id);
+ end loop;
+
+ -- -50 is the dummy question id
+ insert into km_temp_questions values (-50,-50);
+
+ -- and now map the frigging questions to the more frigging object type
+ for c5 in (select tq1.new_id as new_question_id, tot.new_id as new_object_type_id,
+ sort_key, form_number, mandatory_p, question_state, tq2.new_id as
+ new_parent_question_id, branch_p, branch_operator, branch_answer,
+ tao.new_id as new_branch_answer_foreign_key, tq3.new_id as
+ new_default_branch
+ from sn_question_object_type_map map, km_temp_questions tq1,
+ km_temp_questions tq2, km_temp_questions tq3, km_temp_answer_options tao,
+ km_temp_object_types tot
+ where map.question_id = tq1.old_id
+ and map.object_type_id = tot.old_id
+ and map.parent_question_id = tq2.old_id(+)
+ and map.default_branch = tq3.old_id(+)
+ and map.branch_answer_foreign_key = tao.old_id(+)) loop
+
+ begin
+ insert into sn_question_object_type_map
+ (question_id, object_type_id, sort_key, form_number, mandatory_p,
+ question_state, parent_question_id, branch_p, branch_operator,
+ branch_answer, branch_answer_foreign_key, default_branch)
+ values
+ (c5.new_question_id, c5.new_object_type_id,
+ c5.sort_key, c5.form_number, c5.mandatory_p, c5.question_state,
+ c5.new_parent_question_id, c5.branch_p, c5.branch_operator, c5.branch_answer,
+ c5.new_branch_answer_foreign_key, c5.new_default_branch);
+ exception
+ when others then
+ null;
+ end;
+ end loop;
+ -- and correct the target object type ids
+ for c6 in (
+ select q2.target_object_type_id, q1.question_id
+ from sn_questions q1, sn_questions q2,
+ km_temp_questions tq
+ where q1.question_id = tq.new_id
+ and q2.question_id = tq.old_id
+ and q2.target_object_type_id is not null
+ and q1.question_id in
+ (select new_id from km_temp_questions)
+ ) loop
+ select new_id
+ into v_new_target_object_type_id
+ from km_temp_object_types tot
+ where tot.old_id = c6.target_object_type_id;
+
+ update sn_questions q
+ set target_object_type_id = v_new_target_object_type_id
+ where question_id = c6.question_id;
+ end loop;
+ end copy_all_object_types;
+
+ procedure copy_object_type (
+ v_object_type_id in sn_object_types.object_type_id%TYPE,
+ v_target_context_id in acs_objects.context_id%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE,
+ v_creation_ip in acs_objects.creation_ip%TYPE
+ )
+ is
+ cursor c_questions (v_object_type_id integer) is
+ select question_id, pretty_name, abstract_data_type, presentation_type,
+ order_by, entry_explanation, tag_width, tag_height, help_text,
+ target_object_type_id, references_question_id, tree_id, node_id,
+ category_id, year_from, year_to, default_value, max_categories,
+ defaults_question_id
+ from sn_questions
+ where question_id in
+ (select map.question_id
+ from sn_question_object_type_map map
+ where map.object_type_id = v_object_type_id);
+ cursor c_answer_options is
+ select option_id, tq.new_id as new_question_id, answer_option, sort_key
+ from sn_answer_options ao, km_temp_questions tq
+ where ao.question_id = tq.old_id;
+ v_new_question_id sn_questions.question_id%TYPE;
+ v_new_object_type_id sn_object_types.object_type_id%TYPE;
+ v_new_answer_option_id sn_answer_options.option_id%TYPE;
+ v_count integer;
+ begin
+ -- Clean up data from previous call in this transaction.
+ delete from km_temp_questions;
+ delete from km_temp_answer_options;
+
+ -- copy the questions
+ -- target_object_type_id has to be nullified as it doesn't exist
+ -- in the target community
+ for c1 in c_questions(v_object_type_id) loop
+ v_new_question_id := question.insert_question (
+ v_pretty_name => c1.pretty_name,
+ v_abstract_data_type => c1.abstract_data_type,
+ v_order_by => c1.order_by,
+ v_default_value => c1.default_value,
+ v_entry_explanation => c1.entry_explanation,
+ v_creation_user => v_creation_user,
+ v_creation_ip => v_creation_ip,
+ v_references_q_id => null);
+ update sn_questions
+ set presentation_type=c1.presentation_type, tag_width=c1.tag_width,
+ tag_height = c1.tag_height, help_text = c1.help_text, tree_id =
+ c1.tree_id, node_id = c1.node_id, category_id = c1.category_id,
+ year_from = c1.year_from, year_to = c1.year_to,
+ max_categories = c1.max_categories,
+ defaults_question_id = c1.defaults_question_id
+ where question_id=v_new_question_id;
+ insert into km_temp_questions
+ (old_id, new_id)
+ values
+ (c1.question_id, v_new_question_id);
+ end loop;
+
+ -- correct references_question_id
+ update sn_questions q
+ set references_question_id = (select new_id
+ from km_temp_questions
+ where old_id = q.references_question_id )
+ where question_id in
+ (select old_id from km_temp_questions);
+
+ -- correct defaults_question_id
+ update sn_questions q
+ set defaults_question_id = (select new_id
+ from km_temp_questions
+ where old_id = q.defaults_question_id )
+ where question_id in
+ (select old_id from km_temp_questions);
+
+ -- create the new object type
+ v_new_object_type_id := acs_object.new (
+ object_type => 'sn_object_type',
+ creation_date => sysdate,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => v_target_context_id
+ );
+
+ insert into sn_object_types
+ (object_type_id, short_name, pretty_name, pretty_plural, graphic,
+ graphic_p, deleted_p, browse_p, public_p, create_p, sort_key,
+ short_description, long_description, public_until, linked_question_id,
+ default_age_filter, context_id, archive_p, copy_p, sweeper,
+ sweeper_action, sweeper_warning_time, sweeper_outdated_time,
+ start_date, end_date)
+ (select v_new_object_type_id, short_name, pretty_name, pretty_plural, graphic,
+ graphic_p, deleted_p, browse_p, public_p, create_p, sort_key,
+ q1.new_id as new_short_description, q2.new_id as new_long_description,
+ q3.new_id as new_public_until, q4.new_id as new_linked_question_id,
+ default_age_filter, v_target_context_id, archive_p, copy_p, sweeper,
+ sweeper_action, sweeper_warning_time, sweeper_outdated_time,
+ start_date, end_date
+ from sn_object_types ot, km_temp_questions q1, km_temp_questions q2,
+ km_temp_questions q3, km_temp_questions q4
+ where ot.object_type_id = v_object_type_id
+ and q1.old_id(+) = ot.short_description
+ and q2.old_id(+) = ot.long_description
+ and q3.old_id(+) = ot.public_until
+ and q4.old_id(+) = ot.linked_question_id);
+
+ -- now map the shortname
+ insert into sn_types_map_short_name
+ (object_type_id, short_description, position )
+ (select v_new_object_type_id, tq.new_id, map.position
+ from sn_types_map_short_name map, km_temp_questions tq
+ where map.short_description = tq.old_id);
+
+ -- map the answer options
+ for c3 in c_answer_options loop
+ select acs_object_id_seq.nextval into v_new_answer_option_id from dual;
+ insert into sn_answer_options
+ (option_id, question_id, answer_option, sort_key)
+ values
+ (v_new_answer_option_id, c3.new_question_id, c3.answer_option,
+ c3.sort_key);
+ insert into km_temp_answer_options
+ (old_id, new_id)
+ values
+ (c3.option_id, v_new_answer_option_id);
+ end loop;
+
+ -- -50 is the dummy question id
+ insert into km_temp_questions values (-50,-50);
+
+ -- and now map the frigging questions to the more frigging object type
+ insert into sn_question_object_type_map
+ (question_id, object_type_id, sort_key, form_number, mandatory_p,
+ question_state, parent_question_id, branch_p, branch_operator,
+ branch_answer, branch_answer_foreign_key, default_branch)
+ (select tq1.new_id as new_question_id, v_new_object_type_id,
+ sort_key, form_number, mandatory_p, question_state, tq2.new_id as
+ new_parent_question_id, branch_p, branch_operator, branch_answer,
+ tao.new_id as new_branch_answer_foreign_key, tq3.new_id as
+ new_default_branch
+ from sn_question_object_type_map map, km_temp_questions tq1,
+ km_temp_questions tq2, km_temp_questions tq3, km_temp_answer_options tao
+ where map.question_id = tq1.old_id
+ and map.parent_question_id = tq2.old_id(+)
+ and map.default_branch = tq3.old_id(+)
+ and map.branch_answer_foreign_key = tao.old_id(+));
+ end copy_object_type;
+
+ procedure delete_all_object_types (
+ v_context_id in acs_objects.context_id%TYPE default null
+ )
+ is
+ cursor c_delete_all_object_types is
+ select object_type_id
+ from sn_object_types
+ where context_id = v_context_id;
+ begin
+ for v_delete_all_object_types in c_delete_all_object_types loop
+ object_type.delete_object_type(v_delete_all_object_types.object_type_id);
+ end loop;
+ end delete_all_object_types;
+
+ function insert_object_type (
+ v_pretty_name in sn_object_types.pretty_name%TYPE,
+ v_pretty_plural in sn_object_types.pretty_plural%TYPE,
+ v_graphic in sn_object_types.graphic%TYPE,
+ v_deleted_p in sn_object_types.deleted_p%TYPE,
+ v_browse_p in sn_object_types.browse_p%TYPE,
+ v_public_p in sn_object_types.public_p%TYPE,
+ v_sort_key in sn_object_types.sort_key%TYPE,
+ v_short_description in sn_object_types.short_description%TYPE,
+ v_long_description in sn_object_types.long_description%TYPE,
+ v_linked_question_id in sn_object_types.linked_question_id%TYPE,
+ v_public_until in sn_object_types.public_until%TYPE,
+ v_default_age_filter in sn_object_types.default_age_filter%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE,
+ v_short_name in sn_object_types.short_name%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_object_types.object_type_id%TYPE
+ is
+ v_return_object_type_id acs_objects.object_id%TYPE;
+ begin
+ v_return_object_type_id := acs_object.new (
+ object_type => 'sn_object_type',
+ creation_date => v_insertion_date,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => v_context_id
+ );
+
+ insert into sn_object_types
+ (object_type_id,pretty_name, pretty_plural, graphic, deleted_p,
+ browse_p, public_p, sort_key, long_description,
+ public_until, default_age_filter,context_id, short_name )
+ values (v_return_object_type_id,v_pretty_name, v_pretty_plural,
+ v_graphic, v_deleted_p, v_browse_p, v_public_p, v_sort_key,
+ v_long_description, v_public_until,
+ v_default_age_filter, v_context_id, v_short_name);
+
+ -- this function is _only_ used by the migration scripts. In the past
+ -- we didn't have composite short descriptions. Hence the hack here is
+ -- more than okay.
+
+ if v_short_description is not null then
+ insert into sn_types_map_short_name
+ (object_type_id, short_description, position)
+ values
+ (v_return_object_type_id, v_short_description, 1);
+ end if;
+ return v_return_object_type_id;
+ end insert_object_type;
+
+
+ function insert_object_type (
+ v_pretty_name in sn_object_types.pretty_name%TYPE,
+ v_pretty_plural in sn_object_types.pretty_plural%TYPE,
+ v_browse_p in sn_object_types.browse_p%TYPE,
+ v_default_age_filter in sn_object_types.default_age_filter%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null,
+ v_short_name in sn_object_types.short_name%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_object_types.object_type_id%TYPE
+ is
+ v_return_object_type_id acs_objects.object_id%TYPE;
+ begin
+ v_return_object_type_id := acs_object.new (
+ object_type => 'sn_object_type',
+ creation_date => v_insertion_date,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => v_context_id
+ );
+
+ insert into sn_object_types
+ (object_type_id,pretty_name, pretty_plural,
+ browse_p, default_age_filter, context_id, short_name )
+ values (v_return_object_type_id,v_pretty_name, v_pretty_plural,
+ v_browse_p, v_default_age_filter, v_context_id, v_short_name);
+
+ return v_return_object_type_id;
+ end insert_object_type;
+
+ procedure delete_object_type (
+ v_object_type_id in sn_object_types.object_type_id%TYPE
+ )
+ is
+ cursor cur_question_object_type_map is
+ select question_id
+ from sn_question_object_type_map
+ where object_type_id = v_object_type_id;
+ begin
+ object.delete_all_objects_of_a_type(v_object_type_id);
+
+ update sn_object_types set
+ long_description = null,
+ linked_question_id = null,
+ public_until = null
+ where object_type_id = v_object_type_id;
+
+ update sn_questions
+ set target_object_type_id = null
+ where target_object_type_id = v_object_type_id;
+
+ for v_question_object_type_map in cur_question_object_type_map loop
+ question.delete_question(v_question_object_type_map.question_id);
+ end loop;
+
+ delete from sn_types_map_short_name where object_type_id = v_object_type_id;
+ delete from sn_table_name_map where object_type_id = v_object_type_id;
+ delete from acs_permissions where object_id = v_object_type_id;
+ acs_object.delete(v_object_type_id);
+ delete from sn_object_types where object_type_id=v_object_type_id;
+ end delete_object_type;
+
+end object_type;
+/
+show errors
+
+-- @cvs-id $Id: library-package-bodies.sql,v 1.1 2003/07/02 12:19:42 peterm Exp $
+-- turn off sql plus variables substitution
+set define off
+
+create or replace package body object
+as
+ function name (
+ object_id in sn_objects.object_id%TYPE
+ ) return varchar2
+ is
+ v_result sn_objects.one_line_description%TYPE;
+ begin
+ select nvl(one_line_description,'Unnamed ' || ot.pretty_name) into v_result
+ from sn_objects o, sn_object_types ot
+ where o.object_type_id = ot.object_type_id
+ and o.object_id = name.object_id;
+
+ return v_result;
+ end name;
+
+
+ procedure save_content (
+ v_object_id in sn_objects.object_id%TYPE,
+ v_question_id in sn_questions.question_id%TYPE,
+ v_html_p in sn_content.html_p%TYPE,
+ v_content_length in integer,
+ v_modifying_user in acs_objects.creation_user%TYPE,
+ v_modifying_ip in acs_objects.modifying_ip%TYPE,
+ v_update_date in acs_objects.last_modified%TYPE default sysdate
+ )
+ is
+ v_count_exists integer default 0;
+ begin
+ update sn_objects
+ set last_modified = v_update_date,
+ last_modifying_user_id = v_modifying_user
+ where object_id = v_object_id;
+
+ update acs_objects_description
+ set datastore = 'a'
+ where object_id = v_object_id;
+
+ acs_object.last_modified (
+ v_object_id => v_object_id,
+ v_modifying_user => v_modifying_user,
+ v_modifying_ip => v_modifying_ip,
+ v_last_modified => v_update_date);
+
+ select count(*)
+ into v_count_exists
+ from sn_content
+ where object_id=v_object_id
+ and question_id=v_question_id;
+
+ if v_count_exists = 0 then
+ insert into sn_content (object_id, question_id, html_p)
+ values (v_object_id, v_question_id, v_html_p);
+ else
+ if v_content_length = 0 then
+ delete from sn_content
+ where object_id=v_object_id
+ and question_id=v_question_id;
+ else
+ update sn_content
+ set html_p = v_html_p
+ where object_id=v_object_id
+ and question_id=v_question_id;
+ end if;
+ end if;
+ end save_content;
+
+ function insert_object (
+ v_object_type_id in sn_objects.object_type_id%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_objects.object_id%TYPE
+ is
+ v_return_object_id acs_objects.object_id%TYPE;
+ begin
+ v_return_object_id := acs_object.new (
+ object_type => 'sn_object',
+ creation_date => v_insertion_date,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => v_context_id
+ );
+
+ insert into sn_objects
+ (object_id, original_author_id, creation_date, last_modifying_user_id,
+ last_modified, object_type_id,context_id)
+ values (v_return_object_id, v_creation_user, v_insertion_date, v_creation_user,
+ v_insertion_date, v_object_type_id,v_context_id);
+
+ return v_return_object_id;
+ end insert_object;
+
+
+ function insert_object (
+ v_object_id in acs_objects.object_id%TYPE,
+ v_object_type_id in sn_objects.object_type_id%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_objects.object_id%TYPE
+ is
+ v_return_object_id acs_objects.object_id%TYPE;
+ begin
+ v_return_object_id := acs_object.new (
+ object_id => v_object_id,
+ object_type => 'sn_object',
+ creation_date => v_insertion_date,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => v_context_id
+ );
+
+ insert into sn_objects
+ (object_id, original_author_id, creation_date, last_modifying_user_id,
+ last_modified, object_type_id,context_id)
+ values (v_return_object_id, v_creation_user, v_insertion_date, v_creation_user,
+ v_insertion_date, v_object_type_id,v_context_id);
+
+ return v_return_object_id;
+ end insert_object;
+
+
+ function copy_object (
+ v_object_id in acs_objects.object_id%TYPE,
+ v_target_id in acs_objects.object_id%TYPE default null,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null
+ ) return sn_objects.object_id%TYPE
+ is
+ v_new_link_id sn_links.link_id%TYPE;
+ v_return_object_id acs_objects.object_id%TYPE;
+ begin
+ v_return_object_id := acs_object.new (
+ object_type => 'sn_object',
+ object_id => v_target_id,
+ creation_date => sysdate,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => v_context_id
+ );
+
+ acs_object.last_modified (
+ v_object_id => v_return_object_id,
+ v_modifying_user => v_creation_user,
+ v_modifying_ip => v_creation_ip,
+ v_last_modified => sysdate
+ );
+
+ -- copy sn_object
+ insert into sn_objects
+ (object_id, object_type_id, context_id, one_line_description,
+ overview, overview_html_p, creation_date, original_author_id,
+ last_modified, last_modifying_user_id, user_checkoff_date,
+ public_until, public_p, archived_p, access_total,
+ access_month, archiving_date, outdated_warning_date,
+ expired_warning_date)
+ (select v_return_object_id as object_id, object_type_id, context_id,
+ one_line_description, overview, overview_html_p,
+ sysdate as creation_date, v_creation_user as original_author_id,
+ sysdate as last_modified, v_creation_user as last_modifying_user_id,
+ null as user_checkoff_date, public_until, 'f' as public_p,
+ 'f' as archived_p, 0 as access_total, 0 as access_month,
+ null as archiving_date, null as outdated_warning_date,
+ null as expired_warning_date
+ from sn_objects o
+ where o.object_id = v_object_id);
+
+ -- copy categories
+ insert into sw_object_category_map (category_id, object_id)
+ (select category_id, v_return_object_id as object_id
+ from sw_object_category_map ocm
+ where ocm.object_id = v_object_id);
+
+ -- copy options
+ insert into sn_object_option_map (object_id, option_id)
+ (select v_return_object_id as object_id, option_id
+ from sn_object_option_map oom
+ where oom.object_id = v_object_id
+ and oom.option_id in (select ao.option_id
+ from sn_question_object_type_map qotm,
+ sn_objects o, sn_answer_options ao
+ where qotm.object_type_id = o.object_type_id
+ and qotm.question_state = 'active'
+ and qotm.question_id = ao.question_id
+ and o.object_id = v_object_id) );
+
+ -- copy content
+ insert into sn_content (object_id, question_id, content, html_p)
+ (select v_return_object_id as object_id, question_id, content, html_p
+ from sn_content c
+ where c.object_id = v_object_id
+ and c.question_id in (select qotm.question_id
+ from sn_question_object_type_map qotm,
+ sn_objects o
+ where qotm.object_type_id = o.object_type_id
+ and qotm.question_state = 'active'
+ and o.object_id = v_object_id) );
+
+ -- copy links
+ for link in (select qlm.link_id, qlm.question_id
+ from sn_question_link_map qlm, sn_objects o,
+ sn_question_object_type_map qotm, sn_links l
+ where qotm.object_type_id = o.object_type_id
+ and qotm.question_state = 'active'
+ and qlm.question_id = qotm.question_id
+ and l.link_id = qlm.link_id
+ and l.link_type = 'bi_directional'
+ and o.object_id = v_object_id
+ and l.object_id_a = o.object_id)
+ loop
+ select sn_links_seq.nextval into v_new_link_id from dual;
+
+ insert into sn_links
+ (link_id, link_type, object_id_a, object_id_b, link_comment,
+ html_p, creation_user, creation_date)
+ (select v_new_link_id, link_type,
+ decode(object_id_a,v_object_id,v_return_object_id,object_id_a),
+ decode(object_id_b,v_object_id,v_return_object_id,object_id_b),
+ link_comment, html_p, v_creation_user as creation_user,
+ sysdate as creation_date
+ from sn_links l
+ where l.link_id = link.link_id);
+
+ insert into sn_question_link_map (link_id, question_id)
+ values (v_new_link_id, link.question_id);
+ end loop;
+
+ return v_return_object_id;
+ end copy_object;
+
+ procedure audit_object (
+ v_object_id in sn_objects.object_id%TYPE,
+ v_question_id in sn_questions.question_id%TYPE,
+ v_last_modifying_user_id in acs_objects.modifying_ip%TYPE,
+ v_modifying_ip in acs_objects.modifying_ip%TYPE,
+ v_content in sn_audit_table.content%TYPE,
+ v_last_modified in acs_objects.last_modified%TYPE default sysdate
+ )
+ is
+ begin
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id, content)
+ values (v_object_id, v_question_id, v_last_modified, v_last_modifying_user_id, v_content);
+
+ update sn_objects
+ set last_modified = v_last_modified,
+ last_modifying_user_id = v_last_modifying_user_id,
+ outdated_warning_date = null
+ where object_id = v_object_id;
+
+ update acs_objects_description
+ set datastore = 'a'
+ where object_id = v_object_id;
+
+ acs_object.last_modified (
+ v_object_id => v_object_id,
+ v_modifying_user => v_last_modifying_user_id,
+ v_modifying_ip => v_modifying_ip,
+ v_last_modified => v_last_modified);
+ end audit_object;
+
+ procedure delete_object (
+ v_object_id in sn_objects.object_id%TYPE
+ )
+ is
+ cursor sn_comments is
+ select comment_id
+ from sn_comments
+ where object_id= v_object_id;
+ cursor bookmarks is
+ select bookmark_id
+ from bm_bookmarks
+ where object_id= v_object_id;
+
+ begin
+ delete from recommendations_log
+ where object_id = v_object_id;
+ delete from sn_question_link_map where link_id in
+ (select link_id
+ from sn_links
+ where object_id_a = v_object_id or object_id_b=v_object_id);
+ delete from psn_attachments where application_id in
+ (select application_id
+ from psn_res_applications
+ where object_id=v_object_id);
+ delete from psn_res_application_roles where application_id in
+ (select application_id
+ from psn_res_applications
+ where object_id=v_object_id);
+ delete from psn_res_applications where object_id=v_object_id;
+ delete from sn_links where object_id_a = v_object_id or object_id_b=v_object_id;
+ delete from user_alert_history where object_id=v_object_id;
+ delete from alerts where object_id=v_object_id;
+ delete from user_alerts where object_id=v_object_id;
+ for cur_val in bookmarks loop
+ acs_object.delete(cur_val.bookmark_id);
+ delete from bm_bookmarks where bookmark_id=cur_val.bookmark_id;
+ end loop;
+
+ delete from bm_shopping_cart where object_id= v_object_id;
+ -- ratings
+ for cur_val in sn_comments loop
+ acs_object.delete(cur_val.comment_id);
+ end loop;
+ delete from sn_owner_history where object_id=v_object_id;
+ delete from sn_content where object_id=v_object_id;
+ delete from sn_audit_table where object_id=v_object_id;
+ delete from sn_object_delete_reasons where object_id=v_object_id;
+ delete from sn_object_option_map where object_id=v_object_id;
+ delete from sn_access_counts where object_id = v_object_id;
+ delete from acs_permissions where object_id = v_object_id;
+ delete from sn_objects where object_id=v_object_id;
+ acs_object.delete(v_object_id);
+ end;
+
+ procedure delete_all_objects_of_a_type (
+ v_object_type_id in sn_object_types.object_type_id%TYPE
+ )
+ is
+ cursor cur_objects_of_a_type is
+ select object_id
+ from sn_objects
+ where object_type_id = v_object_type_id;
+ rows_processed boolean ;
+ begin
+ -- delete dependencies
+ update acs_objects set context_id=null where context_id in (select object_id
+ from sn_objects
+ where object_type_id = v_object_type_id);
+
+ delete from user_alert_history where content_type_id=v_object_type_id;
+ delete from alerts where content_type_id=v_object_type_id;
+ delete from user_alerts where content_type_id=v_object_type_id;
+ for v_objects_of_a_type in cur_objects_of_a_type loop
+ object.delete_object(v_objects_of_a_type.object_id);
+ end loop;
+ end;
+
+ procedure delete_all_objects_of_an_inst (
+ v_context_id in acs_objects.context_id%TYPE
+ )
+ is
+ begin
+ for v_all_objects_of_inst in (
+ select object_id from sn_objects
+ where context_id = v_context_id
+ )
+ loop
+ object.delete_object(v_all_objects_of_inst.object_id);
+ end loop;
+ end;
+
+end object;
+/
+show errors
+
+create or replace package body question
+as
+ -- Returns true if this question is a root of a branch (at any level)
+ function root_branch_p (
+ v_question_id in sn_questions.question_id%TYPE
+ ) return char
+ is
+ v_result char(1);
+ begin
+ select decode(count(*),0,'f','t')
+ into v_result
+ from sn_question_object_type_map
+ where parent_question_id=v_question_id and branch_p='t';
+
+ return v_result;
+ end root_branch_p;
+
+ PROCEDURE map_question_on_object (
+ v_question_id in sn_questions.question_id%TYPE,
+ v_object_type_id in sn_objects.object_type_id%TYPE,
+ v_form_number in sn_question_object_type_map.form_number%TYPE,
+ v_mandatory_p in sn_question_object_type_map.mandatory_p%TYPE,
+ v_question_state in sn_question_object_type_map.question_state%TYPE
+ ) IS
+ v_max_sort_key sn_question_object_type_map.sort_key%TYPE;
+ BEGIN
+ select max(sort_key)
+ into v_max_sort_key
+ from sn_question_object_type_map
+ where object_type_id = v_object_type_id;
+
+ v_max_sort_key := v_max_sort_key + 10;
+ insert into sn_question_object_type_map
+ (object_type_id, question_id, form_number, mandatory_p, question_state, branch_p, sort_key)
+ values (v_object_type_id, v_question_id, v_form_number, v_mandatory_p, v_question_state, 'f', v_max_sort_key);
+ -- DIRK: update last_modified_date
+ END map_question_on_object;
+
+ PROCEDURE delete_question (
+ v_question_id in sn_questions.question_id%TYPE
+ )
+ is
+ cursor cur_child_questions is
+ select question_id
+ from sn_question_object_type_map
+ where parent_question_id = v_question_id;
+ begin
+ -- nullify all short or long descriptions or linked_question-id or
+ -- public_until
+ delete from sn_types_map_short_name
+ where short_description = v_question_id;
+
+ update sn_object_types set
+ short_description = null
+ where short_description = v_question_id;
+
+ update sn_object_types set
+ long_description = null
+ where long_description = v_question_id;
+
+ update sn_object_types set
+ linked_question_id = null
+ where linked_question_id = v_question_id;
+
+ update sn_object_types set
+ public_until = null
+ where public_until = v_question_id;
+
+ update sn_questions set
+ references_question_id = null
+ where references_question_id = v_question_id;
+
+ -- delete all child questions
+ for v_child_questions in cur_child_questions loop
+ question.delete_question(v_child_questions.question_id);
+ end loop;
+
+ delete from sn_links where link_id in
+ (select link_id
+ from sn_question_link_map
+ where question_id = v_question_id);
+ delete from sn_question_link_map
+ where question_id = v_question_id;
+ delete from sn_question_object_type_map
+ where question_id = v_question_id;
+ delete from sn_content where question_id = v_question_id;
+ delete from sn_audit_table where question_id = v_question_id;
+ delete from sn_object_option_map where option_id in (select option_id
+ from sn_answer_options where question_id = v_question_id);
+ delete from sn_answer_options where question_id = v_question_id;
+
+ acs_object.delete(v_question_id);
+ delete from sn_questions where question_id = v_question_id;
+ end delete_question;
+
+ function insert_question (
+ v_question_id in sn_questions.question_id%TYPE default null,
+ v_pretty_name in sn_questions.pretty_name%TYPE,
+ v_abstract_data_type in sn_questions.abstract_data_type%TYPE,
+ v_order_by in sn_questions.order_by%TYPE,
+ v_default_value in sn_questions.default_value%TYPE,
+ v_entry_explanation in sn_questions.entry_explanation%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate,
+ v_references_q_id in sn_questions.question_id%TYPE
+ ) return sn_questions.question_id%TYPE
+ is
+ v_return_question_id acs_objects.object_id%TYPE;
+ v_presentation_type sn_questions.presentation_type%TYPE;
+ v_max_sort_key sn_question_object_type_map.sort_key%TYPE;
+ begin
+ if v_question_id is null then
+ v_return_question_id := acs_object.new (
+ object_type => 'sn_question',
+ creation_date => v_insertion_date,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => null
+ );
+ else
+ v_return_question_id := acs_object.new (
+ object_id => v_question_id,
+ object_type => 'sn_question',
+ creation_date => v_insertion_date,
+ creation_user => v_creation_user,
+ creation_ip => v_creation_ip,
+ context_id => null
+ );
+ end if;
+
+ if v_abstract_data_type = 'category' then
+ v_presentation_type := 'select';
+ elsif v_abstract_data_type = 'other_category' then
+ v_presentation_type := 'select';
+ elsif v_abstract_data_type = 'option' then
+ v_presentation_type := 'select';
+ elsif v_abstract_data_type = 'integer' then
+ v_presentation_type := 'shorttext';
+ else
+ v_presentation_type := 'custom';
+ end if;
+
+ insert into sn_questions
+ (question_id, pretty_name, abstract_data_type, presentation_type,
+ order_by, default_value, entry_explanation, references_question_id)
+ values
+ (v_return_question_id, v_pretty_name, v_abstract_data_type,
+ v_presentation_type, v_order_by, v_default_value, v_entry_explanation, v_references_q_id);
+
+ return v_return_question_id;
+ end insert_question;
+
+ procedure update_question (
+ v_question_id in sn_questions.question_id%TYPE,
+ v_pretty_name in sn_questions.pretty_name%TYPE,
+ v_abstract_data_type in sn_questions.abstract_data_type%TYPE,
+ v_order_by in sn_questions.order_by%TYPE,
+ v_default_value in sn_questions.default_value%TYPE,
+ v_entry_explanation in sn_questions.entry_explanation%TYPE,
+ v_modifying_user in acs_objects.creation_user%TYPE,
+ v_modifying_ip in acs_objects.modifying_ip%TYPE,
+ v_update_date in acs_objects.last_modified%TYPE default sysdate,
+ v_references_q_id in sn_questions.question_id%TYPE,
+ v_def_question_id in sn_questions.question_id%TYPE default null,
+ v_max_categories in sn_questions.max_categories%TYPE default null,
+ v_browse_p in sn_questions.browse_p%TYPE default 't'
+ )
+ is
+ begin
+ update sn_questions
+ set pretty_name = v_pretty_name,
+ entry_explanation = v_entry_explanation,
+ abstract_data_type = v_abstract_data_type,
+ order_by = v_order_by,
+ default_value = v_default_value,
+ references_question_id = v_references_q_id,
+ defaults_question_id = v_def_question_id,
+ max_categories = v_max_categories,
+ browse_p = v_browse_p
+ where question_id = v_question_id;
+ acs_object.last_modified (
+ v_object_id => v_question_id,
+ v_modifying_user => v_modifying_user,
+ v_modifying_ip => v_modifying_ip,
+ v_last_modified => v_update_date);
+ end update_question;
+
+ procedure delete_all_questions(
+ v_context_id in acs_objects.context_id%TYPE default null
+ ) is
+ cursor c_delete_all_questions is
+ select q.question_id
+ from sn_questions q, sn_question_object_type_map map, sn_object_types ot
+ where ot.context_id = v_context_id
+ and ot.object_type_id = map.object_type_id
+ and map.question_id = q.question_id;
+ begin
+ for v_delete_all_questions in c_delete_all_questions loop
+ question.delete_question(v_delete_all_questions.question_id);
+ end loop;
+ end delete_all_questions;
+end question;
+/
+show errors
+
+
+create or replace package body km_utilities
+as
+ function km_ancestor_list (
+ v_object_id in integer)
+ return varchar
+ is
+ result varchar(4000);
+ begin
+ for c1_rec in (
+ select '{' || sno.object_id || ' {' || sno.one_line_description || '}}' as l
+ from sn_objects sno, km_flat_object_hierarchy fo
+ where fo.child = v_object_id and fo.parent = sno.object_id
+ order by distance desc
+ )
+ loop
+ result := concat(result, c1_rec.l || ' ');
+ end loop;
+ return substr(result, 1, length(result) - 1);
+ end km_ancestor_list;
+
+ function km_category_list (
+ v_object_id in integer,
+ v_parent_node_id in varchar)
+ return varchar
+ is
+ the_list varchar(4000);
+ begin
+ for c1_rec in (
+ select long_name
+ from categories c, sw_flat_cat fc, sw_object_category_map cm
+ where fc.parent = v_parent_node_id
+ and fc.child_category_id = c.category_id
+ and cm.category_id = c.category_id
+ and cm.object_id = v_object_id
+ )
+ loop
+ the_list := concat(the_list, c1_rec.long_name || ', ');
+ end loop;
+ return substr(the_list, 1, length(the_list) - 2);
+ end km_category_list;
+
+ function km_string2xml (str varchar2) return varchar2
+ is
+ retval varchar2(4000);
+ begin
+ retval := replace(str,'&','&');
+ retval := replace(retval,'<','<');
+ retval := replace(retval,'>','>');
+ return retval;
+ end km_string2xml;
+
+ procedure km_clob2xml (dest in out clob, source in clob)
+ is
+ offset integer := 1;
+ len integer;
+ text varchar2(4000);
+ begin
+ len := dbms_lob.getlength(source);
+ WHILE len > offset LOOP
+ text := DBMS_LOB.SUBSTR(source,3000, offset);
+ text := replace(text,'&','&');
+ text := replace(text,'<','<');
+ text := replace(text,'>','>');
+ dbms_lob.writeappend(dest,length(text),text);
+ offset := offset + 3000;
+ END LOOP;
+ end km_clob2xml;
+
+ procedure km_string2xmlclob (dest in out clob, source varchar2)
+ is
+ offset integer := 1;
+ len integer;
+ text varchar2(4000);
+ begin
+ len := length(source);
+ WHILE len > offset LOOP
+ text := substr(source,offset,3000);
+ text := replace(text,'&','&');
+ text := replace(text,'<','<');
+ text := replace(text,'>','>');
+ dbms_lob.writeappend(dest,length(text),text);
+ offset := offset + 3000;
+ END LOOP;
+ end km_string2xmlclob;
+
+ function km_xml ( id sn_objects.object_id%type) RETURN CLOB
+ is
+ v_pretty_name sn_object_types.pretty_name%TYPE;
+
+ -- CONSTANTS
+ CR CONSTANT VARCHAR2(2) := CHR(13);
+ sn_objects_rec sn_objects%ROWTYPE;
+ CURSOR km_cursor (p_object_type_id integer) IS
+ SELECT b.question_id, b.pretty_name, b.abstract_data_type
+ FROM sn_question_object_type_map a, sn_questions b
+ WHERE a.object_type_id = p_object_type_id
+ AND a.question_id = b.question_id
+ AND abstract_data_type NOT IN (/*'child_object',*/ 'file', /*'user_link',*/ 'composite')
+ AND question_state <> 'invisible'
+ ORDER BY sort_key;
+
+ CURSOR km_category (p_object_id integer) IS
+ SELECT c.category_id, c.short_name
+ FROM sw_object_category_map m, categories c
+ WHERE m.object_id = p_object_id
+ AND c.category_id = m.category_id;
+
+ CURSOR g_comments (p_object_id integer) IS
+ SELECT content FROM sn_comments WHERE object_id = p_object_id;
+
+ CURSOR km_links (p_object_id integer, p_question_id integer) IS
+ SELECT c.object_id linked_id, b.link_type link_type, b.object_id_b
+ FROM sn_links b, sn_objects c, sn_question_link_map map
+ WHERE b.object_id_a = p_object_id
+ AND b.link_id = map.link_id
+ AND map.question_id = p_question_id
+ AND b.object_id_b = c.object_id
+ and c.object_id is not null;
+
+ CURSOR km_content (p_object_id integer, p_question_id integer) IS
+ SELECT dbms_lob.substr(content,3999,1) answer FROM sn_content WHERE object_id = p_object_id AND question_id = p_question_id and content is not null
+ UNION
+ SELECT answer_option answer
+ FROM sn_object_option_map a, sn_answer_options b
+ WHERE a.object_id = p_object_id
+ AND a.option_id = b.option_id
+ AND b.question_id = p_question_id;
+ tag_object varchar2(4000);
+ tag_owner varchar(300);
+ tag_text varchar(4000);
+ tag_category varchar(4000);
+ tag_comments clob;
+ tag_content clob;
+ text varchar (4000);
+
+ i integer;
+
+ /* -- VARIABLES -- */
+ tlob clob; /* variable for store function output*/
+ BEGIN
+ DBMS_LOB.CREATETEMPORARY(tlob, TRUE, DBMS_LOB.SESSION);
+ -- prepare temorary lob for store COMMENTS tag
+ DBMS_LOB.CREATETEMPORARY(tag_comments, TRUE, DBMS_LOB.SESSION);
+ -- prepare temorary lob for store object_content tag
+ DBMS_LOB.CREATETEMPORARY(tag_content, TRUE, DBMS_LOB.SESSION);
+
+ -- get various info on table and columns to index
+ SELECT * INTO sn_objects_rec FROM sn_objects WHERE object_id = id ;
+
+ SELECT pretty_name
+ into v_pretty_name
+ FROM sn_object_types a
+ WHERE a.object_type_id = sn_objects_rec.object_type_id;
+
+ v_pretty_name := km_string2xml(v_pretty_name);
+
+ SELECT '<?xml version="1.0"?>'||CR||'<object type_id="'||ltrim(to_char(sn_objects_rec.object_type_id))||'" type_name="'
+ ||v_pretty_name ||'" instance_id="'||ltrim(to_char(id))||'">'||CR
+ INTO tag_object
+ FROM sn_object_types a
+ WHERE a.object_type_id = sn_objects_rec.object_type_id;
+
+ -- get contents for OWNER tag
+ IF sn_objects_rec.original_author_id IS NOT NULL THEN
+ SELECT first_names || ' ' || last_name INTO tag_owner FROM users WHERE user_id = sn_objects_rec.original_author_id;
+ tag_owner := ' <owner id="'||ltrim(to_char(sn_objects_rec.original_author_id))||'">'||km_string2xml(tag_owner)||'</owner>'||CR;
+ END IF;
+
+ -- get content for CATEGORY tag
+ FOR ccat IN km_category(sn_objects_rec.object_id) LOOP
+ tag_category := tag_category || ' <category id="'||ltrim(to_char(ccat.category_id))||'">'||km_string2xml(ccat.short_name)||'</category>'||CR;
+ END LOOP;
+
+ -- get content for COMMENTS tag
+ -- at first look in general_comments table
+ FOR gcom IN g_comments (sn_objects_rec.object_id) LOOP
+ if nvl(dbms_lob.getlength(gcom.content),0) > 0 then
+ DBMS_LOB.WRITEAPPEND(tag_comments, length(' <comments>'), ' <comments>');
+ km_clob2xml(tag_comments, gcom.content);
+ DBMS_LOB.WRITEAPPEND(tag_comments, length(' </comments>'||CR), ' </comments>'||CR);
+ end if;
+ END LOOP;
+
+ FOR cc IN km_cursor (sn_objects_rec.object_type_id) LOOP
+ i := 0;
+ FOR c1 IN km_content(sn_objects_rec.object_id, cc.question_id) LOOP
+ IF i = 0 THEN
+ text := ' <question id="'||ltrim(to_char(cc.question_id))||'" name="'||km_string2xml(cc.pretty_name)||'">'||CR;
+ DBMS_LOB.WRITEAPPEND(tag_content,length(text),text);
+ i := 1;
+ END IF;
+ DBMS_LOB.WRITEAPPEND(tag_content, length(' <answer>'), ' <answer>');
+
+ km_string2xmlclob(tag_content, c1.answer);
+ DBMS_LOB.WRITEAPPEND(tag_content, length('</answer>'||CR), '</answer>'||CR);
+ END LOOP;
+ FOR c2 IN km_links(id, cc.question_id) LOOP
+ IF i = 0 THEN
+ text := ' <question id="'||ltrim(to_char(cc.question_id))||'" name="'||km_string2xml(cc.pretty_name)||'">'||CR;
+ DBMS_LOB.WRITEAPPEND(tag_content,length(text),text);
+ i := 1;
+ END IF;
+ text := ' <answer type="link" link_type="'||c2.link_type||'" linked_object_instace_id="'||ltrim(to_char(c2.linked_id))||'"></answer>'||CR;
+ DBMS_LOB.WRITEAPPEND(tag_content, length(text), text);
+ END LOOP;
+ IF i <> 0 THEN
+ DBMS_LOB.WRITEAPPEND(tag_content,length(' </question>'||CR),' </question>'||CR);
+ END IF;
+ END LOOP;
+
+ -- Construct XML DOC
+ DBMS_LOB.WRITEAPPEND (tlob,length(tag_object),tag_object);
+ DBMS_LOB.WRITEAPPEND (tlob,length(tag_owner),tag_owner);
+ IF tag_category is not null THEN
+ DBMS_LOB.WRITEAPPEND (tlob,length(tag_category),tag_category);
+ END IF;
+ DBMS_LOB.APPEND(tlob,tag_comments);
+ DBMS_LOB.APPEND (tlob,tag_content);
+ DBMS_LOB.WRITEAPPEND (tlob,9 ,'</object>');
+ return tlob;
+ END km_xml;
+
+ procedure km_populate_flat_object_hier
+ IS
+ CURSOR child_cursor IS
+ select object_id_b as object_id from sn_links where link_type in ('parent_child','uncle_nephew');
+ BEGIN
+ delete from km_flat_object_hierarchy;
+
+ FOR child IN child_cursor LOOP
+ insert into km_flat_object_hierarchy
+ select acs_object_id_seq.nextval, object_id_a, child.object_id, level, link_type
+ from sn_links start with object_id_b = child.object_id and link_type in ('parent_child','uncle_nephew')
+ connect by object_id_b = prior object_id_a and link_type in ('parent_child','uncle_nephew');
+ END LOOP;
+ END km_populate_flat_object_hier;
+
+ procedure km_logger (
+ v_who_is_logging varchar2,
+ v_log_text varchar2)
+ as
+ pragma autonomous_transaction;
+ begin
+ insert into km_logger_table values (sysdate, v_who_is_logging, v_log_text );
+ commit;
+ end km_logger;
+
+ function shortname_string (p_object_id in sn_objects.object_id%TYPE,
+ p_question_id1 in sn_questions.question_id%TYPE,
+ p_question_id2 in sn_questions.question_id%TYPE,
+ p_question_id3 in sn_questions.question_id%TYPE default 0)
+ return varchar2
+ is
+ v_result_string varchar2(4000) := '';
+ v_result_string1 varchar2(4000) := '';
+ v_result_string2 varchar2(4000) := '';
+ v_result_string3 varchar2(4000) := '';
+ v_length_string1 integer;
+ v_length_string2 integer;
+ v_length_string3 integer;
+ begin
+ begin
+ select trim(dbms_lob.substr(content,1300,1))
+ into v_result_string1
+ from sn_content
+ where question_id=p_question_id1
+ and object_id=p_object_id;
+ exception
+ when others then
+ v_result_string1 := '';
+ end;
+
+ begin
+ select trim(dbms_lob.substr(content,1300,1))
+ into v_result_string2
+ from sn_content
+ where question_id=p_question_id2
+ and object_id=p_object_id;
+ exception
+ when others then
+ v_result_string2 := '';
+ end;
+
+ begin
+ if p_question_id3 > 0 then
+ select trim(dbms_lob.substr(content,1300,1))
+ into v_result_string3
+ from sn_content
+ where question_id=p_question_id3
+ and object_id=p_object_id;
+ end if;
+ exception
+ when others then
+ v_result_string3 := '';
+ end;
+
+ v_length_string1 := length(v_result_string1);
+ v_length_string2 := length(v_result_string2);
+ v_length_string3 := length(v_result_string3);
+
+ if (v_length_string1 > 0) then
+ v_result_string := v_result_string1;
+ if (v_length_string2 > 0) then
+ v_result_string := v_result_string || ', ' || v_result_string2;
+ end if;
+ if (v_length_string3 > 0) then
+ v_result_string := v_result_string || ', ' || v_result_string3;
+ end if;
+ else
+ if (v_length_string2 > 0) then
+ v_result_string := v_result_string2;
+ if (v_length_string3 > 0) then
+ v_result_string := v_result_string || ', ' || v_result_string3;
+ end if;
+ else
+ if (v_length_string3 > 0) then
+ v_result_string := v_result_string3;
+ end if;
+ end if;
+ end if;
+ return v_result_string;
+ end shortname_string;
+
+ function strip_html ( input_text in varchar2)
+ return varchar2
+ is
+ output varchar2(4000);
+ i number;
+ tag_start number;
+ tag_end number;
+ char_count number;
+ begin
+
+ i := 1;
+ output := '';
+ while instr(input_text, '<', i) >= i
+ loop
+ tag_start := instr(input_text, '<', i);
+ tag_end := instr(input_text, '>', tag_start);
+ if tag_end > 0 then
+ char_count := tag_start - i;
+
+ if char_count > 0 then
+ output := output || substr(input_text, i, char_count);
+ end if;
+
+ i := tag_end + 1;
+ else
+ exit;
+ end if;
+ end loop;
+
+ output := output || substr(input_text, i);
+
+ select replace(output, '\<', '<') into output from dual;
+ select replace(output, '\>', '>') into output from dual;
+ select replace(output, '\"', '"') into output from dual;
+ return (output);
+ end strip_html;
+
+ function strip_html_and_limit_size
+ (p_overview in sn_objects.overview%TYPE)
+ return VARCHAR2
+ is
+ v_overview sn_objects.overview%TYPE;
+ begin
+ v_overview := strip_html(p_overview);
+ if (length(p_overview)>200) then
+ v_overview := substr(v_overview,1,200) || '...';
+ end if;
+ return v_overview;
+ end strip_html_and_limit_size;
+end km_utilities;
+/
+show errors
+
+
+
+create or replace trigger km_flat_object_hier_insert_tr
+before insert on sn_links for each row
+begin
+ if :new.link_type = 'parent_child' or :new.link_type = 'uncle_nephew' then
+ insert into km_flat_object_hierarchy (object_hierarchy_id, parent, child, distance, link_type)
+ values (acs_object_id_seq.nextval, :new.object_id_a, :new.object_id_b, 1, :new.link_type);
+
+ insert into km_flat_object_hierarchy (object_hierarchy_id, parent, child, distance, link_type)
+ select acs_object_id_seq.nextval, parent, :new.object_id_b, distance+1, :new.link_type
+ from km_flat_object_hierarchy
+ where child = :new.object_id_a;
+ end if;
+end ;
+/
+show errors
+
+
+create or replace trigger km_flat_object_hier_delete_tr
+before delete on sn_links for each row
+begin
+ if :old.link_type = 'parent_child' or :old.link_type = 'uncle_nephew' then
+ delete from km_flat_object_hierarchy
+ where child = :old.object_id_b;
+ end if;
+end ;
+/
+show errors
+
+create or replace function im_convert(
+ query in varchar2 default null
+ ) return varchar2
+is
+ i number :=0;
+ len number :=0;
+ char varchar2(1);
+ minusString varchar2(4000);
+ plusString varchar2(4000);
+ mainString varchar2(4000);
+ mainAboutString varchar2(4000);
+ finalString varchar2(4000);
+ hasMain number :=0;
+ hasPlus number :=0;
+ hasMinus number :=0;
+ token varchar2(4000);
+ tokenStart number :=1;
+ tokenFinish number :=0;
+ inPhrase number :=0;
+ inPlus number :=0;
+ inWord number :=0;
+ inMinus number :=0;
+ completePhrase number :=0;
+ completeWord number :=0;
+ code number :=0;
+begin
+
+ len := length(query);
+
+-- we iterate over the string to find special web operators
+ for i in 1..len loop
+ char := substr(query,i,1);
+ if(char = '"') then
+ if(inPhrase = 0) then
+ inPhrase := 1;
+ tokenStart := i;
+ else
+ inPhrase := 0;
+ completePhrase := 1;
+ tokenFinish := i-1;
+ end if;
+ elsif(char = ' ') then
+ if(inPhrase = 0) then
+ completeWord := 1;
+ tokenFinish := i-1;
+ end if;
+ elsif(char = '+') then
+ inPlus := 1;
+ tokenStart := i+1;
+ elsif((char = '-') and (i = tokenStart)) then
+ inMinus :=1;
+ tokenStart := i+1;
+ end if;
+
+ if(completeWord=1) then
+ token := '{ '||substr(query,tokenStart,tokenFinish-tokenStart+1)||' }';
+ if(inPlus=1) then
+ plusString := plusString||','||token||'*10';
+ hasPlus :=1;
+ elsif(inMinus=1) then
+ minusString := minusString||'OR '||token||' ';
+ hasMinus :=1;
+ else
+ mainString := mainString||' NEAR '||token;
+ mainAboutString := mainAboutString||' '||token;
+ hasMain :=1;
+ end if;
+ tokenStart :=i+1;
+ tokenFinish :=0;
+ inPlus := 0;
+ inMinus :=0;
+ end if;
+ completePhrase := 0;
+ completeWord :=0;
+ end loop;
+
+ -- find the last token
+ token := '{ '||substr(query,tokenStart,len-tokenStart+1)||' }';
+ if(inPlus=1) then
+ plusString := plusString||','||token||'*10';
+ hasPlus :=1;
+ elsif(inMinus=1) then
+ minusString := minusString||'OR '||token||' ';
+ hasMinus :=1;
+ else
+ mainString := mainString||' NEAR '||token;
+ mainAboutString := mainAboutString||' '||token;
+ hasMain :=1;
+ end if;
+
+
+ mainString := substr(mainString,6,length(mainString)-5);
+ mainAboutString := replace(mainAboutString,'{',' ');
+ mainAboutString := replace(mainAboutString,'}',' ');
+ plusString := substr(plusString,2,length(plusString)-1);
+ minusString := substr(minusString,4,length(minusString)-4);
+
+ -- we find the components present and then process them based on the specific combinations
+ code := hasMain*4+hasPlus*2+hasMinus;
+ if(code = 7) then
+ finalString := '('||plusString||','||mainString||'*2.0,about('||mainAboutString||')*0.5) NOT ('||minusString||')';
+ elsif (code = 6) then
+ finalString := plusString||','||mainString||'*2.0'||',about('||mainAboutString||')*0.5';
+ elsif (code = 5) then
+ finalString := '('||mainString||',about('||mainAboutString||')) NOT ('||minusString||')';
+ elsif (code = 4) then
+ finalString := mainString;
+ finalString := replace(finalString,'*1,',NULL);
+ finalString := '('||finalString||')*2.0,about('||mainAboutString||')';
+ elsif (code = 3) then
+ finalString := '('||plusString||') NOT ('||minusString||')';
+ elsif (code = 2) then
+ finalString := plusString;
+ elsif (code = 1) then
+ -- not is a binary operator for intermedia text
+ finalString := 'totallyImpossibleString'||' NOT ('||minusString||')';
+ elsif (code = 0) then
+ finalString := '';
+ end if;
+
+ return finalString;
+end;
+/
+
+create or replace package body psn_res_application
+as
+ procedure create_magic_objects (
+ package_id in apm_packages.package_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE default null,
+ creation_ip in acs_objects.creation_ip%TYPE default null
+ )
+ is
+ v_role_object_id acs_objects.object_id%TYPE;
+ v_language_object_id acs_objects.object_id%TYPE;
+ v_proficiency_object_id acs_objects.object_id%TYPE;
+ begin
+ v_role_object_id := acs_object.new (
+ object_type => 'psn_tree_object',
+ creation_date => sysdate,
+ creation_user => creation_user,
+ creation_ip => creation_ip,
+ context_id => package_id
+ );
+ acs_object.new_description (
+ v_object_id => v_role_object_id,
+ v_shortname => 'Role Category Tree',
+ v_overview => 'Role Category Tree for Knowledge Library #' || package_id,
+ v_overview_html_p => 'f',
+ v_package_id => package_id
+ );
+ v_language_object_id := acs_object.new (
+ object_type => 'psn_tree_object',
+ creation_date => sysdate,
+ creation_user => creation_user,
+ creation_ip => creation_ip,
+ context_id => package_id
+ );
+ acs_object.new_description (
+ v_object_id => v_language_object_id,
+ v_shortname => 'Language Category Tree',
+ v_overview => 'Language Category Tree for Knowledge Library #' || package_id,
+ v_overview_html_p => 'f',
+ v_package_id => package_id
+ );
+ v_proficiency_object_id := acs_object.new (
+ object_type => 'psn_tree_object',
+ creation_date => sysdate,
+ creation_user => creation_user,
+ creation_ip => creation_ip,
+ context_id => package_id
+ );
+ acs_object.new_description (
+ v_object_id => v_proficiency_object_id,
+ v_shortname => 'Language Proficiency Category Tree',
+ v_overview => 'Language Proficiency Category Tree for Knowledge Library #' || package_id,
+ v_overview_html_p => 'f',
+ v_package_id => package_id
+ );
+
+ insert into psn_category_trees (package_id, role_magic_id, language_magic_id, proficiency_magic_id)
+ values (package_id, v_role_object_id, v_language_object_id, v_proficiency_object_id);
+
+ end create_magic_objects;
+
+ procedure copy (
+ src_package_id in apm_packages.package_id%TYPE,
+ dst_package_id in apm_packages.package_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE,
+ creation_ip in acs_objects.creation_ip%TYPE
+ )
+ is
+ begin
+
+ -- Copy relations between magic objects and category trees.
+ -- We do this with a cursor because some of the relations may not exist.
+
+ for c in (
+ select r.object_id_two as tree_id, octr.subtree_root_node_id as node_id, ct2.role_magic_id as object_id
+ from psn_category_trees ct1, psn_category_trees ct2, acs_rels r,
+ object_category_tree_rels octr
+ where ct1.package_id = src_package_id
+ and ct2.package_id = dst_package_id
+ and r.object_id_one = ct1.role_magic_id
+ and r.rel_type = 'object_category_tree_rel'
+ and octr.rel_id = r.rel_id
+ union all
+ select r.object_id_two, octr.subtree_root_node_id, ct2.language_magic_id
+ from psn_category_trees ct1, psn_category_trees ct2, acs_rels r,
+ object_category_tree_rels octr
+ where ct1.package_id = src_package_id
+ and ct2.package_id = dst_package_id
+ and r.object_id_one = ct1.language_magic_id
+ and r.rel_type = 'object_category_tree_rel'
+ and octr.rel_id = r.rel_id
+ union all
+ select r.object_id_two, octr.subtree_root_node_id, ct2.proficiency_magic_id
+ from psn_category_trees ct1, psn_category_trees ct2, acs_rels r,
+ object_category_tree_rels octr
+ where ct1.package_id = src_package_id
+ and ct2.package_id = dst_package_id
+ and r.object_id_one = ct1.proficiency_magic_id
+ and r.rel_type = 'object_category_tree_rel'
+ and octr.rel_id = r.rel_id
+ ) loop
+ category.map_tree(c.object_id, c.node_id, c.tree_id);
+ end loop;
+
+ end copy;
+
+end psn_res_application;
+/
+show errors
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-packages.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-packages.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-packages.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,251 @@
+-- @cvs-id $Id: library-packages.sql,v 1.1 2003/07/02 12:19:42 peterm Exp $
+
+create or replace package library
+as
+ procedure copy (
+ src_package_id in apm_packages.package_id%TYPE,
+ dst_package_id in apm_packages.package_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE,
+ creation_ip in acs_objects.creation_ip%TYPE
+ );
+end library;
+/
+
+create or replace package question
+as
+ function insert_question (
+ v_question_id in sn_questions.question_id%TYPE default null,
+ v_pretty_name in sn_questions.pretty_name%TYPE,
+ v_abstract_data_type in sn_questions.abstract_data_type%TYPE,
+ v_order_by in sn_questions.order_by%TYPE,
+ v_default_value in sn_questions.default_value%TYPE,
+ v_entry_explanation in sn_questions.entry_explanation%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE,
+ v_creation_ip in acs_objects.creation_ip%TYPE,
+ v_context_id in acs_objects.context_id%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate,
+ v_references_q_id in sn_questions.question_id%TYPE default null
+ ) return sn_questions.question_id%TYPE;
+
+ procedure update_question (
+ v_question_id in sn_questions.question_id%TYPE,
+ v_pretty_name in sn_questions.pretty_name%TYPE,
+ v_abstract_data_type in sn_questions.abstract_data_type%TYPE,
+ v_order_by in sn_questions.order_by%TYPE,
+ v_default_value in sn_questions.default_value%TYPE,
+ v_entry_explanation in sn_questions.entry_explanation%TYPE,
+ v_modifying_user in acs_objects.creation_user%TYPE,
+ v_modifying_ip in acs_objects.modifying_ip%TYPE,
+ v_update_date in acs_objects.last_modified%TYPE default sysdate,
+ v_references_q_id in sn_questions.question_id%TYPE default null,
+ v_def_question_id in sn_questions.question_id%TYPE default null,
+ v_max_categories in sn_questions.max_categories%TYPE default null,
+ v_browse_p in sn_questions.browse_p%TYPE default 't'
+ );
+
+ procedure delete_question (
+ v_question_id in sn_questions.question_id%TYPE
+ );
+
+ procedure map_question_on_object (
+ v_question_id in sn_questions.question_id%TYPE,
+ v_object_type_id in sn_objects.object_type_id%TYPE,
+ v_form_number in sn_question_object_type_map.form_number%TYPE,
+ v_mandatory_p in sn_question_object_type_map.mandatory_p%TYPE,
+ v_question_state in sn_question_object_type_map.question_state%TYPE
+ );
+
+ function root_branch_p (
+ v_question_id in sn_questions.question_id%TYPE
+ ) return char;
+
+ procedure delete_all_questions(
+ v_context_id in acs_objects.context_id%TYPE
+ ) ;
+
+end question;
+/
+show errors
+
+create or replace package object_type
+as
+ function insert_object_type (
+ v_pretty_name in sn_object_types.pretty_name%TYPE,
+ v_pretty_plural in sn_object_types.pretty_plural%TYPE,
+ v_graphic in sn_object_types.graphic%TYPE,
+ v_deleted_p in sn_object_types.deleted_p%TYPE,
+ v_browse_p in sn_object_types.browse_p%TYPE,
+ v_public_p in sn_object_types.public_p%TYPE,
+ v_sort_key in sn_object_types.sort_key%TYPE,
+ v_short_description in sn_object_types.short_description%TYPE,
+ v_long_description in sn_object_types.long_description%TYPE,
+ v_linked_question_id in sn_object_types.linked_question_id%TYPE,
+ v_public_until in sn_object_types.public_until%TYPE,
+ v_default_age_filter in sn_object_types.default_age_filter%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE,
+ v_creation_ip in acs_objects.creation_ip%TYPE,
+ v_context_id in acs_objects.context_id%TYPE,
+ v_short_name in sn_object_types.short_name%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_object_types.object_type_id%TYPE;
+
+ function insert_object_type (
+ v_pretty_name in sn_object_types.pretty_name%TYPE,
+ v_pretty_plural in sn_object_types.pretty_plural%TYPE,
+ v_browse_p in sn_object_types.browse_p%TYPE,
+ v_default_age_filter in sn_object_types.default_age_filter%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE,
+ v_creation_ip in acs_objects.creation_ip%TYPE,
+ v_context_id in acs_objects.context_id%TYPE,
+ v_short_name in sn_object_types.short_name%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_object_types.object_type_id%TYPE;
+
+ procedure delete_object_type (
+ v_object_type_id in sn_object_types.object_type_id%TYPE
+ );
+
+ procedure delete_all_object_types (
+ v_context_id in acs_objects.context_id%TYPE
+ );
+
+ procedure copy_object_type (
+ v_object_type_id in sn_object_types.object_type_id%TYPE,
+ v_target_context_id in acs_objects.context_id%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE,
+ v_creation_ip in acs_objects.creation_ip%TYPE
+ );
+
+ procedure copy_all_object_types (
+ src_package_id in acs_objects.context_id%TYPE,
+ dst_package_id in acs_objects.context_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE,
+ creation_ip in acs_objects.creation_ip%TYPE
+ );
+
+end object_type;
+/
+show errors
+
+create or replace package object
+as
+ function name (
+ object_id in sn_objects.object_id%TYPE
+ ) return varchar2;
+
+ function insert_object (
+ v_object_type_id in sn_objects.object_type_id%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE,
+ v_creation_ip in acs_objects.creation_ip%TYPE,
+ v_context_id in acs_objects.context_id%TYPE,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_objects.object_id%TYPE;
+
+ function insert_object (
+ v_object_id in acs_objects.object_id%TYPE,
+ v_object_type_id in sn_objects.object_type_id%TYPE,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null,
+ v_insertion_date in acs_objects.creation_date%TYPE default sysdate
+ ) return sn_objects.object_id%TYPE;
+
+ procedure delete_object (
+ v_object_id in sn_objects.object_id%TYPE
+ );
+
+ procedure save_content (
+ v_object_id in sn_objects.object_id%TYPE,
+ v_question_id in sn_questions.question_id%TYPE,
+ v_html_p in sn_content.html_p%TYPE,
+ v_content_length in integer,
+ v_modifying_user in acs_objects.creation_user%TYPE,
+ v_modifying_ip in acs_objects.modifying_ip%TYPE,
+ v_update_date in acs_objects.last_modified%TYPE default sysdate
+ );
+
+ procedure delete_all_objects_of_a_type (
+ v_object_type_id in sn_object_types.object_type_id%TYPE
+ );
+
+ procedure delete_all_objects_of_an_inst (
+ v_context_id in acs_objects.context_id%TYPE
+ );
+
+ procedure audit_object (
+ v_object_id in sn_objects.object_id%TYPE,
+ v_question_id in sn_questions.question_id%TYPE,
+ v_last_modifying_user_id in acs_objects.modifying_ip%TYPE,
+ v_modifying_ip in acs_objects.modifying_ip%TYPE,
+ v_content in sn_audit_table.content%TYPE,
+ v_last_modified in acs_objects.last_modified%TYPE default sysdate
+ );
+
+ function copy_object (
+ v_object_id in acs_objects.object_id%TYPE,
+ v_target_id in acs_objects.object_id%TYPE default null,
+ v_creation_user in acs_objects.creation_user%TYPE default null,
+ v_creation_ip in acs_objects.creation_ip%TYPE default null,
+ v_context_id in acs_objects.context_id%TYPE default null
+ ) return sn_objects.object_id%TYPE;
+
+end object;
+/
+show errors
+
+
+create or replace package km_utilities
+as
+ function km_ancestor_list (
+ v_object_id in integer)
+ return varchar;
+
+ function km_category_list (
+ v_object_id in integer,
+ v_parent_node_id in varchar)
+ return varchar;
+
+ function km_xml (
+ id sn_objects.object_id%type)
+ return clob;
+
+ procedure km_populate_flat_object_hier;
+
+ procedure km_logger (
+ v_who_is_logging varchar2,
+ v_log_text varchar2);
+
+ function shortname_string (
+ p_object_id in sn_objects.object_id%TYPE,
+ p_question_id1 in sn_questions.question_id%TYPE,
+ p_question_id2 in sn_questions.question_id%TYPE,
+ p_question_id3 in sn_questions.question_id%TYPE default 0)
+ return varchar2;
+
+ function strip_html_and_limit_size
+ (p_overview in sn_objects.overview%TYPE)
+ return VARCHAR2;
+
+end km_utilities;
+/
+show errors
+
+create or replace package psn_res_application
+as
+
+ procedure create_magic_objects (
+ package_id in apm_packages.package_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE default null,
+ creation_ip in acs_objects.creation_ip%TYPE default null
+ );
+
+ procedure copy (
+ src_package_id in apm_packages.package_id%TYPE,
+ dst_package_id in apm_packages.package_id%TYPE,
+ creation_user in acs_objects.creation_user%TYPE,
+ creation_ip in acs_objects.creation_ip%TYPE
+ );
+
+end psn_res_application;
+/
+show errors
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-temp-tables.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-temp-tables.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-temp-tables.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,18 @@
+-- Here are the temporary tables that are being used by library-internal
+-- functions. Read Tom Kyte's book if you want to understand why I'm using
+-- temporary tables.
+
+create global temporary table km_temp_questions
+ (old_id integer ,
+ new_id integer)
+ on commit delete rows ;
+
+create global temporary table km_temp_object_types
+ (old_id integer ,
+ new_id integer)
+ on commit delete rows ;
+
+create global temporary table km_temp_answer_options
+ (old_id integer ,
+ new_id integer)
+ on commit delete rows ;
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-triggers.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-triggers.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-triggers.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,175 @@
+create or replace trigger sn_object_types_in_tr
+after insert on sn_object_types
+for each row
+begin
+ acs_object.new_description(
+ v_object_id => :new.object_type_id,
+ v_shortname => :new.pretty_name,
+ v_package_id => :new.context_id);
+end sn_objects_in_tr;
+/
+show errors
+
+create or replace trigger sn_object_types_up_tr
+after update on sn_object_types
+for each row
+declare
+begin
+ acs_object.set_shortname(
+ v_object_id => :new.object_type_id,
+ v_shortname => :new.pretty_name);
+
+ acs_object.set_package_id(
+ v_object_id => :new.object_type_id,
+ v_package_id => :new.context_id);
+
+end sn_object_types_up_tr;
+/
+show errors
+
+
+create or replace trigger sn_objects_in_tr
+after insert on sn_objects
+for each row
+declare
+ v_new_one_line_description sn_objects.one_line_description%TYPE;
+ v_creation_date acs_objects.creation_date%TYPE;
+begin
+ if :new.one_line_description is null or length(trim(:new.one_line_description)) = 0 then
+ select 'Unnamed ' || pretty_name
+ into v_new_one_line_description
+ from sn_object_types
+ where object_type_id = :new.object_type_id;
+ else
+ v_new_one_line_description := :new.one_line_description;
+ end if;
+
+ select creation_date into v_creation_date
+ from acs_objects
+ where object_id = :new.object_id;
+
+ acs_object.new_description(
+ v_object_id => :new.object_id,
+ v_shortname => substr(v_new_one_line_description,0,199),
+ v_overview => :new.overview,
+ v_presentation => 'presentation=private,object_type_id=' || :new.object_type_id,
+ v_overview_html_p => :new.overview_html_p,
+ v_package_id => :new.context_id,
+ v_publish_date => v_creation_date);
+
+ -- Fill the content areas
+ insert into acs_object_areas
+ (object_id, area_id, package_id)
+ values
+ (:new.object_id, :new.object_type_id, :new.context_id);
+end sn_objects_in_tr;
+/
+show errors
+
+create or replace trigger sn_objects_up_tr
+after update of one_line_description, overview, overview_html_p, context_id, public_p,
+ archived_p, in_review_p, expiration_date, user_checkoff_date, original_author_id on sn_objects
+for each row
+declare
+ v_new_one_line_description sn_objects.one_line_description%TYPE;
+ v_presentation acs_objects_description.presentation%TYPE;
+ v_state acs_objects_description.state%TYPE;
+ v_creation_date acs_objects.creation_date%TYPE;
+begin
+ if :new.one_line_description is null or length(trim(:new.one_line_description)) = 0 then
+ select 'Unnamed ' || pretty_name
+ into v_new_one_line_description
+ from sn_object_types
+ where object_type_id = :new.object_type_id;
+ else
+ v_new_one_line_description := :new.one_line_description;
+ end if;
+
+ if :new.original_author_id <> :old.original_author_id then
+ update acs_objects set creation_user = :new.original_author_id
+ where object_id = :new.object_id;
+ end if;
+
+ acs_object.set_shortname(
+ v_object_id => :new.object_id,
+ v_shortname => substr(v_new_one_line_description,0,199));
+
+ acs_object.set_overview(
+ v_object_id => :new.object_id,
+ v_overview => :new.overview,
+ v_overview_html_p => :new.overview_html_p);
+
+ if :new.context_id <> :old.context_id then
+ acs_object.set_package_id(
+ v_object_id => :new.object_id,
+ v_package_id => :new.context_id);
+
+ update acs_object_areas
+ set area_id = :new.object_type_id,
+ package_id= :new.context_id
+ where object_id = :new.object_id;
+ end if;
+
+ if :new.public_p <> :old.public_p
+ or :new.archived_p <> :old.archived_p
+ or :new.in_review_p <> :old.in_review_p then
+
+ if :new.public_p = 't' then
+ v_presentation := 'presentation=public';
+ elsif :new.public_p = 'f' then
+ v_presentation := 'presentation=private';
+ end if;
+
+ v_presentation := v_presentation || ',object_type_id=' || :new.object_type_id;
+
+ if :new.archived_p = 't' then
+ v_presentation := v_presentation || ',archived';
+ end if;
+
+ if :new.in_review_p = 't' then
+ v_presentation := v_presentation || ',in_review';
+ end if;
+
+ acs_object.set_presentation(
+ v_object_id => :new.object_id,
+ v_presentation => v_presentation);
+ end if;
+
+ if :new.expiration_date <> :old.expiration_date
+ or :new.archived_p <> :old.archived_p then
+ if :new.expiration_date <= sysdate then
+ v_state := 'd';
+ else
+ if :new.archived_p = 't' then
+ v_state := 'a';
+ elsif :new.archived_p = 'f' then
+ v_state := 'l';
+ end if;
+ end if;
+
+ acs_object.set_state(
+ v_object_id => :new.object_id,
+ v_state => v_state);
+ end if;
+
+ if :new.user_checkoff_date <> :old.user_checkoff_date
+ or (:new.user_checkoff_date is not null and :old.user_checkoff_date is null) then
+ acs_object.set_publish_date(
+ v_object_id => :new.object_id,
+ v_publish_date => :new.user_checkoff_date);
+ end if;
+
+ if :new.user_checkoff_date is null and :old.user_checkoff_date is not null then
+ select creation_date
+ into v_creation_date
+ from acs_objects
+ where object_id = :new.object_id;
+
+ acs_object.set_publish_date(
+ v_object_id => :new.object_id,
+ v_publish_date => v_creation_date);
+ end if;
+
+end sn_objects_up_tr;
+/
+show errors
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-create.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-create.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,355 @@
+/*
+ * Business Process Definition: Library Approval (library_approval_wf)
+ *
+ * Auto-generated by ACS Workflow Export, version 4.0.2
+ *
+ * Context: default
+ */
+
+-- This table will be used to queue email notifications from Oracle,
+-- which will then be composed and sent by a scheduled Tcl procedure.
+create table wf_library_notifications (
+ notification_id
+ integer
+ constraint wf_libr_notifications_pk
+ primary key,
+ task_id
+ integer
+ constraint wf_libr_n_task_id_fk
+ references wf_tasks
+ constraint wf_libr_n_task_id_nn
+ not null,
+ template_key
+ varchar2(64)
+ constraint wf_libr_n_template_fk
+ references et_templates(key)
+ constraint wf_libr_n_template_nn
+ not null,
+ recipient_id
+ integer
+ constraint wf_libr_n_recipient_fk
+ references users
+ constraint wf_libr_n_recipient_nn
+ not null,
+ sender_id
+ integer
+ constraint wf_libr_n_sender_fk
+ references users
+ constraint wf_libr_n_sender_nn
+ not null,
+ body
+ varchar2(4000)
+ default null
+);
+
+create sequence library_notification_id_seq start with 1;
+
+create or replace trigger wf_library_notifications_itrg
+ before insert on wf_library_notifications for each row
+begin
+ select library_notification_id_seq.nextval into :new.notification_id from dual;
+end;
+/
+show errors
+
+-- This table will hold one row for each case using this workflow.
+create table wf_library_approval_cases (
+ case_id integer
+ constraint wf_library_appr_cases_pk
+ primary key
+ constraint wf_library_appr_cases_case_fk
+ references wf_cases
+);
+
+declare
+ v_workflow_key wf_workflows.workflow_key%TYPE;
+begin
+ v_workflow_key := workflow.create_workflow(
+ workflow_key => 'library_approval_wf',
+ pretty_name => 'Library Approval Process',
+ pretty_plural => 'Library Approval Process',
+ description => 'Workflow for Approving a Knowledge Object Publication in the Library',
+ table_name => 'wf_library_approval_cases'
+ );
+
+ -- Creating places
+ workflow.add_place (
+ workflow_key => 'library_approval_wf',
+ place_key => 'start',
+ place_name => 'Needs to be reviewed',
+ sort_order => 1
+ );
+ workflow.add_place (
+ workflow_key => 'library_approval_wf',
+ place_key => 'to_be_clarified',
+ place_name => 'Needs to be clarified',
+ sort_order => 2
+ );
+ workflow.add_place (
+ workflow_key => 'library_approval_wf',
+ place_key => 'ready_for_publication',
+ place_name => 'Ready for Publication',
+ sort_order => 3
+ );
+ workflow.add_place (
+ workflow_key => 'library_approval_wf',
+ place_key => 'end',
+ place_name => 'Closed',
+ sort_order => 4
+ );
+
+ -- Creating transitions
+ workflow.add_transition (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_review',
+ transition_name => 'Review Knowledge Object',
+ sort_order => 1,
+ trigger_type => 'user'
+ );
+ workflow.add_transition (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_clarify',
+ transition_name => 'Clarify Knowledge Object',
+ sort_order => 2,
+ trigger_type => 'user'
+ );
+ workflow.add_transition (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_publish',
+ transition_name => 'Publish Knowledge Object',
+ sort_order => 3,
+ trigger_type => 'automatic'
+ );
+end;
+/
+show errors
+
+begin
+ -- creating arcs
+ -- review in
+ -- in
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_review',
+ place_key => 'start',
+ direction => 'in'
+ );
+ -- out
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_review',
+ place_key => 'to_be_clarified',
+ direction => 'out',
+ guard_callback => 'wf_callback.guard_attribute_true',
+ guard_custom_arg => 'library_object_needs_clarification',
+ guard_description => 'Knowledge Object needs clarification'
+ );
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_review',
+ place_key => 'ready_for_publication',
+ direction => 'out',
+ guard_callback => '#',
+ guard_description => 'Knowledge Object ready for publication'
+ );
+
+ -- clarify
+ -- in
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_clarify',
+ place_key => 'to_be_clarified',
+ direction => 'in'
+ );
+ -- out
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_clarify',
+ place_key => 'start',
+ direction => 'out'
+ );
+
+ -- publish
+ -- in
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_publish',
+ place_key => 'ready_for_publication',
+ direction => 'in'
+ );
+
+ -- out
+ workflow.add_arc (
+ workflow_key => 'library_approval_wf',
+ transition_key => 'library_publish',
+ place_key => 'end',
+ direction => 'out',
+ guard_callback => 'wf_callback.guard_attribute_true',
+ guard_custom_arg => 'library_object_published',
+ guard_description => 'Knowledge Object published'
+ );
+
+end;
+/
+show errors
+
+declare
+ v_attribute_id acs_attributes.attribute_id%TYPE;
+begin
+ v_attribute_id := workflow.create_attribute(
+ workflow_key => 'library_approval_wf',
+ attribute_name => 'library_object_needs_clarification',
+ datatype => 'boolean',
+ pretty_name => 'Knowledge Object needs clarification',
+ default_value => 'f'
+ );
+
+ insert into wf_transition_attribute_map
+ (workflow_key, transition_key, attribute_id, sort_order)
+ values
+ ('library_approval_wf', 'library_review', v_attribute_id, 1);
+
+ v_attribute_id := workflow.create_attribute(
+ workflow_key => 'library_approval_wf',
+ attribute_name => 'verified',
+ datatype => 'boolean',
+ pretty_name => 'Result is okay',
+ default_value => 't'
+ );
+
+ v_attribute_id := workflow.create_attribute(
+ workflow_key => 'library_approval_wf',
+ attribute_name => 'library_object_published',
+ datatype => 'boolean',
+ pretty_name => 'Knowledge Object published',
+ default_value => 't'
+ );
+
+end;
+/
+show errors
+
+insert into wf_context_transition_info (
+ context_key,
+ workflow_key,
+ transition_key,
+ assignment_callback,
+ fire_callback,
+ notification_callback,
+ notification_custom_arg,
+ unassigned_callback,
+ access_privilege
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_review',
+ 'library_callback.assign_task_to_assignee',
+ 'library_callback.review_fire',
+ 'library_callback.notification',
+ 'library_review_object',
+ 'library_callback.notify_admin',
+ 'write'
+);
+
+insert into wf_context_transition_info (
+ context_key,
+ workflow_key,
+ transition_key,
+ assignment_callback,
+ fire_callback,
+ notification_callback,
+ notification_custom_arg,
+ access_privilege
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_clarify',
+ 'library_callback.assign_task_to_submitter',
+ 'library_callback.clarify_fire',
+ 'library_callback.notification',
+ 'library_clarify_object',
+ 'admin'
+);
+
+insert into wf_context_transition_info (
+ context_key,
+ workflow_key,
+ transition_key,
+ fire_callback,
+ notification_callback,
+ notification_custom_arg,
+ access_privilege
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_publish',
+ 'library_callback.publish_fire',
+ 'library_callback.notification',
+ 'library_published',
+ 'admin'
+);
+insert into wf_context_task_panels (
+ context_key,
+ workflow_key,
+ transition_key,
+ sort_key,
+ header,
+ template_url
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_review',
+ 1,
+ 'Knowledge Object Info',
+ '/packages/library/wf-templates/object-info'
+);
+
+insert into wf_context_task_panels (
+ context_key,
+ workflow_key,
+ transition_key,
+ sort_key,
+ header,
+ template_url
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_review',
+ 2,
+ 'What to do',
+ '/packages/library/wf-templates/review'
+);
+
+insert into wf_context_task_panels (
+ context_key,
+ workflow_key,
+ transition_key,
+ sort_key,
+ header,
+ template_url
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_clarify',
+ 1,
+ 'Knowledge Object Info',
+ '/packages/library/wf-templates/object-info'
+);
+
+insert into wf_context_task_panels (
+ context_key,
+ workflow_key,
+ transition_key,
+ sort_key,
+ header,
+ template_url
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_clarify',
+ 2,
+ 'What to do',
+ '/packages/library/wf-templates/clarify'
+);
+
+commit;
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-drop.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-drop.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,30 @@
+--
+-- packages/library/sql/library-workflow-drop.sql
+--
+--
+-- @author Dirk Gomez (sharenet@dirkgomez.de)
+-- @author Timo Hentschel (timo@arsidigta.com)
+--
+-- @creation-date 2002-02-22
+--
+-- @cvs-id $Id: library-workflow-drop.sql,v 1.1 2003/07/02 12:19:42 peterm Exp $
+--
+
+truncate table wf_library_notifications;
+truncate table wf_ttracker_notifications;
+
+begin
+ workflow.delete_cases('library_approval_wf');
+end;
+/
+show errors
+
+drop table wf_library_approval_cases;
+begin
+ workflow.drop_workflow('library_approval_wf');
+end;
+/
+show errors
+
+drop table wf_library_notifications;
+drop sequence library_notification_id_seq;
Index: openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-packages.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-packages.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/sql/oracle/library-workflow-packages.sql 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,458 @@
+create or replace package library_workflow
+as
+ function new_workflow_case (
+ p_object_id in sn_objects.object_id%TYPE,
+ p_creation_date in acs_objects.creation_date%TYPE default sysdate,
+ p_creation_user in acs_objects.creation_user%TYPE,
+ p_creation_ip in acs_objects.creation_ip%TYPE default null,
+ p_publisher_id in sn_objects.publisher_id%TYPE default null
+ ) return integer;
+
+ procedure delete_workflow_case (
+ object_id in sn_objects.object_id%TYPE
+ );
+
+ function workflow_url (
+ absolute_p in char default 't'
+ ) return varchar2;
+
+ function notification_sender (
+ package_id in apm_packages.package_id%TYPE
+ ) return users.user_id%TYPE;
+
+end library_workflow;
+/
+show errors
+
+
+create or replace package body library_workflow
+as
+ function new_workflow_case (
+ p_object_id in sn_objects.object_id%TYPE,
+ p_creation_date in acs_objects.creation_date%TYPE default sysdate,
+ p_creation_user in acs_objects.creation_user%TYPE,
+ p_creation_ip in acs_objects.creation_ip%TYPE default null,
+ p_publisher_id in sn_objects.publisher_id%TYPE default null
+ ) return integer
+ is
+ v_case_id wf_cases.case_id%TYPE;
+ begin
+ -- create a new case
+ v_case_id := workflow_case.new (
+ workflow_key => 'library_approval_wf',
+ object_id => p_object_id,
+ creation_user => p_creation_user,
+ creation_ip => p_creation_ip
+ );
+
+ -- start the case
+ workflow_case.start_case (
+ case_id => v_case_id,
+ creation_user => p_creation_user,
+ creation_ip => p_creation_ip
+ );
+
+ -- now automatically assign the task to the coordinator. The workflow
+ -- package requires static assignment otherwise.
+ return v_case_id;
+ end new_workflow_case ;
+
+ procedure delete_workflow_case (
+ object_id in sn_objects.object_id%TYPE
+ )
+ is
+ cursor case_cur is
+ select case_id
+ from wf_cases
+ where object_id = object_id;
+ case_rec case_cur%ROWTYPE;
+ begin
+ open case_cur;
+ fetch case_cur into case_rec;
+
+ -- delete the workflow case that's associated with this object
+
+ if case_cur%FOUND then
+ workflow_case.delete(case_rec.case_id);
+ end if;
+
+ close case_cur;
+ end delete_workflow_case ;
+
+ function workflow_url (
+ absolute_p in char default 't'
+ ) return varchar2
+ is
+ v_system_url apm_parameter_values.attr_value%TYPE;
+ cursor node_cur is
+ select sn.node_id
+ from site_nodes sn,
+ apm_packages ap
+ where ap.package_key = 'acs-workflow'
+ and sn.object_id = ap.package_id;
+ node_rec node_cur%ROWTYPE;
+ begin
+ -- try to get the id of the site node that contains acs workflow
+ open node_cur;
+ fetch node_cur into node_rec;
+ if node_cur%NOTFOUND then
+ close node_cur;
+ raise_application_error(-20000, 'ACS Workflow must be mounted');
+ end if;
+ close node_cur;
+
+ -- if only relative url is needed
+ if absolute_p <> 't' then
+ return site_node.url(node_rec.node_id);
+ end if;
+
+ -- since there's only 1 instance of the kernel
+ -- it's ok to use select.. into..
+ select apv.attr_value into v_system_url
+ from apm_parameter_values apv,
+ apm_parameters ap
+ where ap.package_key = 'acs-kernel'
+ and ap.parameter_name = 'SystemURL'
+ and ap.parameter_id = apv.parameter_id;
+
+ return v_system_url||site_node.url(node_rec.node_id);
+
+ end workflow_url;
+
+ function notification_sender (
+ package_id in apm_packages.package_id%TYPE
+ ) return users.user_id%TYPE
+ is
+ v_result users.user_id%TYPE;
+ begin
+ select nvl(apm.get_value(notification_sender.package_id,'NotificationSender'),-1)
+ into v_result
+ from dual;
+
+ return v_result;
+ end notification_sender;
+
+end library_workflow;
+/
+show errors
+
+create or replace package library_callback
+as
+ procedure assign_task_to_submitter (
+ task_id in number,
+ custom_arg in varchar2
+ );
+
+ procedure assign_task_to_assignee (
+ task_id in number,
+ custom_arg in varchar2
+ );
+
+ procedure publish_fire (
+ case_id in number,
+ transition_key in varchar2,
+ custom_arg in varchar2
+ );
+
+ procedure clarify_fire (
+ case_id in number,
+ transition_key in varchar2,
+ custom_arg in varchar2
+ );
+
+ procedure review_fire (
+ case_id in number,
+ transition_key in varchar2,
+ custom_arg in varchar2
+ );
+
+ procedure notification (
+ task_id in number,
+ custom_arg in varchar2,
+ party_to in integer,
+ party_from in out integer,
+ subject in out varchar2,
+ body in out varchar2,
+ sent_p in out char
+ );
+
+ procedure notify_admin (
+ task_id in number,
+ custom_arg in varchar2
+ ) ;
+
+end library_callback;
+/
+show errors
+
+create or replace package body library_callback
+as
+ procedure assign_task_to_assignee (
+ task_id in number,
+ custom_arg in varchar2
+ )
+ is
+ v_publisher_id users.user_id%TYPE;
+ v_case_id wf_tasks.case_id%TYPE;
+ v_transition_key wf_tasks.transition_key%TYPE;
+ begin
+ begin
+ -- let's look up the last publisher.
+ select o.publisher_id, wt.case_id, wt.transition_key
+ into v_publisher_id, v_case_id, v_transition_key
+ from sn_objects o, wf_tasks wt, wf_cases wc
+ where wt.task_id = assign_task_to_assignee.task_id
+ and wt.case_id = wc.case_id
+ and wc.object_id = o.object_id
+ and o.publisher_id is not null
+ and (acs_permission.permission_p(o.object_id, o.publisher_id , 'km_publish'))='t';
+
+ workflow_case.add_task_assignment(assign_task_to_assignee.task_id, v_publisher_id);
+ workflow_case.add_manual_assignment (
+ case_id => v_case_id,
+ transition_key => v_transition_key,
+ party_id => v_publisher_id
+ );
+
+ exception
+ when no_data_found then
+ -- find the default assignees for this community
+
+ for v_approval_coordinators in (
+ select ac.coordinator_id,
+ wt.case_id,
+ wt.transition_key
+ from acs_objects ao, wf_tasks wt,wf_cases wc,
+ approval_coordinators ac
+ where wt.task_id = assign_task_to_assignee.task_id
+ and wt.case_id = wc.case_id
+ and wc.object_id = ao.object_id
+ and ac.package_id = ao.context_id )
+ loop
+ workflow_case.add_task_assignment(assign_task_to_assignee.task_id, v_approval_coordinators.coordinator_id);
+ workflow_case.add_manual_assignment (
+ case_id => v_approval_coordinators.case_id,
+ transition_key => v_approval_coordinators.transition_key,
+ party_id => v_approval_coordinators.coordinator_id
+ );
+ end loop;
+ end;
+ end assign_task_to_assignee;
+
+ procedure assign_task_to_submitter (
+ task_id in number,
+ custom_arg in varchar2
+ )
+ is
+ cursor object_cur is
+ select ao.creation_user,
+ wt.case_id,
+ wt.transition_key
+ from acs_objects ao, wf_tasks wt,wf_cases wc
+ where wt.task_id = assign_task_to_submitter.task_id
+ and wt.case_id = wc.case_id
+ and wc.object_id = ao.object_id;
+ object_rec object_cur%ROWTYPE;
+ begin
+ -- find the creation user of the object (submitter)
+ open object_cur;
+ fetch object_cur into object_rec;
+ close object_cur;
+
+ -- assign the task to the object submitter
+ workflow_case.add_task_assignment(assign_task_to_submitter.task_id, object_rec.creation_user);
+ workflow_case.add_manual_assignment (
+ case_id => object_rec.case_id,
+ transition_key => object_rec.transition_key,
+ party_id => object_rec.creation_user
+ );
+
+ end assign_task_to_submitter;
+
+ procedure publish_fire (
+ case_id in number,
+ transition_key in varchar2,
+ custom_arg in varchar2
+ )
+ is
+ v_journal_id journal_entries.journal_id%TYPE;
+ v_task_id wf_tasks.task_id%TYPE;
+ v_party_from users.user_id%TYPE;
+ v_party_to users.user_id%TYPE;
+ v_author_id users.user_id%TYPE;
+ v_subject varchar2(4000);
+ v_body varchar2(4000);
+ v_request_id integer;
+ v_sent_p char(1);
+ begin
+ select distinct(task_id) into v_task_id
+ from wf_tasks t
+ where case_id = publish_fire.case_id
+ and rownum = 1
+ order by task_id desc;
+
+ select ao.creation_user, so.original_author_id
+ into v_party_to, v_author_id
+ from acs_objects ao, wf_cases c, sn_objects so
+ where ao.object_id = c.case_id
+ and c.case_id = publish_fire.case_id
+ and so.object_id = c.object_id;
+
+ v_party_from := -1;
+ v_subject := 'default';
+ v_body := 'default';
+ v_sent_p := 'f';
+
+ library_callback.notification (
+ task_id => v_task_id,
+ custom_arg => 'library_published',
+ party_to => v_party_to,
+ party_from => v_party_from,
+ subject => v_subject,
+ body => v_body,
+ sent_p => v_sent_p
+ );
+
+ if v_party_to != v_author_id then
+ library_callback.notification (
+ task_id => v_task_id,
+ custom_arg => 'library_published',
+ party_to => v_author_id,
+ party_from => v_party_from,
+ subject => v_subject,
+ body => v_body,
+ sent_p => v_sent_p
+ );
+ end if;
+
+ v_journal_id := journal_entry.new (
+ object_id => case_id,
+ action => 'modify',
+ action_pretty => 'Attribute Change',
+ msg => 'Automatic action by the workflow process'
+ );
+ workflow_case.set_attribute_value (
+ journal_id => v_journal_id,
+ attribute_name => 'library_object_published',
+ value => 't'
+ );
+
+ end publish_fire;
+
+ procedure clarify_fire (
+ case_id in number,
+ transition_key in varchar2,
+ custom_arg in varchar2
+ )
+ is
+ v_journal_id journal_entries.journal_id%TYPE;
+ begin
+ v_journal_id := journal_entry.new (
+ object_id => case_id,
+ action => 'modify',
+ action_pretty => 'Attribute Change',
+ msg => 'Automatic action by the workflow process'
+ );
+ workflow_case.set_attribute_value (
+ journal_id => v_journal_id,
+ attribute_name => 'library_object_needs_clarification',
+ value => 'f'
+ );
+
+ end clarify_fire;
+
+ procedure review_fire (
+ case_id in number,
+ transition_key in varchar2,
+ custom_arg in varchar2
+ )
+ is
+ v_journal_id journal_entries.journal_id%TYPE;
+ begin
+ v_journal_id := journal_entry.new (
+ object_id => case_id,
+ action => 'modify',
+ action_pretty => 'Attribute Change',
+ msg => 'Automatic action by the workflow process'
+ );
+ workflow_case.set_attribute_value (
+ journal_id => v_journal_id,
+ attribute_name => 'verified',
+ value => 't'
+ );
+ end review_fire;
+
+ procedure notification (
+ task_id in number,
+ custom_arg in varchar2,
+ party_to in integer,
+ party_from in out integer,
+ subject in out varchar2,
+ body in out varchar2,
+ sent_p in out char
+ )
+ is
+ begin
+ select o.creation_user, j.msg into notification.party_from, notification.body
+ from acs_objects o, journal_entries j
+ where o.object_id = j.journal_id
+ and j.journal_id = (select max(j2.journal_id) from journal_entries j2, wf_tasks t, acs_objects o2
+ where t.case_id = j2.object_id
+ and t.task_id = notification.task_id
+ and o2.object_id = j2.journal_id
+ and o2.creation_user is not null);
+
+ insert into wf_library_notifications (task_id, template_key, recipient_id, sender_id, body)
+ values (notification.task_id, notification.custom_arg, notification.party_to,
+ notification.party_from, notification.body);
+
+ sent_p := 't';
+ end notification;
+
+ procedure notify_admin (
+ task_id in number,
+ custom_arg in varchar2
+ )
+ is
+ -- uses 2 separate queries to find out who has 'admin' privilege on this package
+ -- because we don't want to join any table with acs_object_party_privilege_map
+ -- unless we absolutely have to (in this case, users table)
+ -- the first query is only used to gather object info and package id
+ cursor object_cur is
+ select o.object_id,
+ o.one_line_description,
+ o.context_id as package_id
+ from sn_objects o,
+ wf_cases wc,
+ wf_tasks wt
+ where wt.task_id = notify_admin.task_id
+ and wc.case_id = wt.case_id
+ and wc.object_id = o.object_id;
+ object_rec object_cur%ROWTYPE;
+ cursor admin_cur is
+ select u.user_id
+ from users u,
+ acs_object_party_privilege_map m
+ where m.object_id = object_rec.package_id
+ and m.party_id = u.user_id
+ and m.privilege = 'admin';
+ v_request_id integer;
+ begin
+ open object_cur;
+ fetch object_cur into object_rec;
+ close object_cur;
+ for admin_rec in admin_cur loop
+ v_request_id := nt.post_request (
+ party_from => library_workflow.notification_sender(object_rec.package_id),
+ party_to => admin_rec.user_id,
+ expand_group => 'f',
+ subject => 'Object #'||object_rec.object_id||' -- '||'Assign Object',
+ message => 'Subject: '||object_rec.one_line_description||'To do: '||'Assign Object Manage via: '||library_workflow.workflow_url||'task?task_id='||task_id,
+ max_retries => 3
+ );
+ end loop;
+ end notify_admin;
+
+end library_callback;
+/
+show errors
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-00-defs-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-00-defs-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-00-defs-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,1337 @@
+# /tcl/km-00-defs.tcl
+#
+# $Id: km-00-defs-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+util_report_library_entry
+proc km_file_path {} { return [ad_parameter FilePath library "[acs_root_dir]/library-files"] }
+
+ad_proc util_GetUserAgentHeader {} {
+ get users browser etc
+} {
+ set header [ns_conn headers]
+ set userag [ns_set iget $header "USER-AGENT"]
+ return $userag
+}
+
+ad_proc km_get_community_name {} {
+ returns the name of the current community
+} {
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ return $node(instance_name)
+}
+
+ad_proc msie_p {} {
+ check if browser is microsoft or other
+} {
+ return [regexp -nocase {msie} [util_GetUserAgentHeader]]
+}
+
+ad_proc -public km_conn {args} {
+
+ km_conn works much like ad_conn. It caches http-session specific
+ information.
+
+ Example:
+ set admin_p [km_conn admin_p]
+
+} {
+ global km_conn
+
+ set flag [lindex $args 0]
+ if {[string index $flag 0] != "-"} {
+ set var $flag
+ set flag "-get"
+ } else {
+ set var [lindex $args 1]
+ }
+
+ switch -- $flag {
+ -set {
+ set km_conn($var) [lindex $args 2]
+ }
+
+ -unset {
+ unset km_conn($var)
+ }
+
+ -reset {
+ if {[info exists km_conn]} {
+ unset km_conn
+ }
+ array set km_conn {
+ admin_p ""
+ publish_p ""
+ read_p ""
+ write_p ""
+ delete_p ""
+ create_p ""
+ public_p ""
+ archived_p ""
+ deleted_p ""
+ expiration_date ""
+ object_type_id ""
+ object_name ""
+ overview ""
+ last_modified ""
+ creation_date ""
+ user_checkoff_date ""
+ original_author_id ""
+ original_author_name ""
+ access_total ""
+ access_month ""
+ public_until ""
+ start_date ""
+ end_date ""
+ publisher_id ""
+ in_review_p ""
+ review_state ""
+ }
+ }
+
+ -get {
+ if { [info exists km_conn($var)] } {
+ return $km_conn($var)
+ } else {
+ return ""
+ }
+ }
+
+ default {
+ error "km_conn: unknown flag $flag"
+ }
+ }
+}
+
+
+
+ad_proc -public km_static {args} {
+
+ km_static caches information about objects whose value is more or
+ less static throughout the system's life time. The first time a
+ particular information is being looked for, this information is being
+ loaded from the database into the cache. km_static does _not_ do any
+ error checking at the moment. It is also not the smartest caching
+ system under the sun (not yet at least).
+
+ - There should be proc that loads the cache on server
+ startup.
+
+ Example:
+ set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+
+} {
+# global km_static
+
+ set flag [lindex $args 0]
+ if {[string index $flag 0] != "-"} {
+ set var $flag
+ set flag "-get"
+ set array_index [lindex $args 1]
+ set value [lindex $args 2]
+ } else {
+ set var [lindex $args 1]
+ set array_index [lindex $args 2]
+ set value [lindex $args 3]
+ }
+
+ if {[empty_string_p $array_index]} {
+ set var_index "${var}"
+ } else {
+ set var_index "${var}${array_index}"
+ }
+
+ switch -- $flag {
+ -set {
+ nsv_set km_static ${var_index} $value
+ }
+
+ -reset {
+ server_cluster_httpget_from_peers "/SYSTEM/flush-km-static-cache.tcl?id=$var"
+ km_static_reset $var
+ }
+
+ -get {
+ if { [nsv_exists km_static $var_index] } {
+ set retval [nsv_get km_static $var_index]
+ return $retval
+ } else {
+ switch -regexp $var {
+ {package_object_types} {
+ set package_object_types_list [list]
+ db_foreach km_static_10 {select pretty_name, object_type_id
+ from sn_object_types
+ where context_id=:array_index} {
+ lappend package_object_types_list [list $pretty_name $object_type_id]
+ }
+ km_static -set package_object_types $array_index $package_object_types_list
+ return $package_object_types_list
+ }
+ {^object_type} {
+ db_1row object_type_info {
+ select pretty_name, pretty_plural,
+ graphic, graphic_p,
+ decode(deleted_p,'t',1,0) as deleted_p,
+ decode(browse_p,'t',1,0) as browse_p,
+ decode(public_p,'t',1,0) as public_p,
+ decode(create_p,'t',1,0) as create_p,
+ decode(archive_p,'t',1,0) as archive_p,
+ decode(copy_p,'t',1,0) as copy_p,
+ default_age_filter, start_date, end_date,
+ long_description,
+ public_until, linked_question_id, short_name
+ from sn_object_types
+ where object_type_id=:array_index}
+ set short_description [db_list get_short_description_list {
+ select short_description
+ from sn_types_map_short_name
+ where object_type_id=:array_index
+ order by position}]
+ km_static -set object_type_pretty_name $array_index $pretty_name
+ km_static -set object_type_short_name $array_index $short_name
+ km_static -set object_type_pretty_plural $array_index $pretty_plural
+ km_static -set object_type_graphic $array_index $graphic
+ km_static -set object_type_graphic_p $array_index $graphic_p
+ km_static -set object_type_deleted_p $array_index $deleted_p
+ km_static -set object_type_browse_p $array_index $browse_p
+ km_static -set object_type_public_p $array_index $public_p
+ km_static -set object_type_create_p $array_index $create_p
+ km_static -set object_type_archive_p $array_index $archive_p
+ km_static -set object_type_copy_p $array_index $copy_p
+ km_static -set object_type_default_age_filter $array_index $default_age_filter
+ km_static -set object_type_short_description $array_index $short_description
+ km_static -set object_type_long_description $array_index $long_description
+ km_static -set object_type_public_until $array_index $public_until
+ km_static -set object_type_start_date $array_index $start_date
+ km_static -set object_type_end_date $array_index $end_date
+ km_static -set object_type_linked_question_id $array_index $linked_question_id
+ regsub {object_type_} $var "" var
+ return [set $var]
+ }
+ {^question_} {
+ db_1row km_static_30 {
+ select pretty_name, abstract_data_type, order_by, target_object_type_id,
+ presentation_type, defaults_question_id, max_categories
+ from sn_questions
+ where question_id=:array_index}
+ km_static -set question_pretty_name $array_index $pretty_name
+ km_static -set question_abstract_data_type $array_index $abstract_data_type
+ km_static -set question_order_by $array_index $order_by
+ km_static -set question_target_object_type_id $array_index $target_object_type_id
+ km_static -set question_presentation_type $array_index $presentation_type
+ km_static -set question_defaults_question_id $array_index $defaults_question_id
+ km_static -set question_max_categories $array_index $max_categories
+ return [km_static ${var} ${array_index}]
+ }
+ {km_dummy_object_id} {
+ set new_km_dummy_object_id [db_string km_static_40 {
+ select object_id
+ from acs_magic_objects
+ where name='km_dummy_object'}]
+ km_static -set km_dummy_object_id $new_km_dummy_object_id
+ return $new_km_dummy_object_id
+ }
+ {^approval_} {
+ set coordinators [db_list km_static_10 {
+ select coordinator_id
+ from approval_coordinators
+ where package_id=:array_index
+ }]
+ km_static -set approval_coordinators $array_index $coordinators
+ if {[empty_string_p $coordinators]} {
+ km_static -set approval_p $array_index 0
+ } else {
+ km_static -set approval_p $array_index 1
+ }
+ return [km_static ${var} ${array_index}]
+ }
+ default {
+ error "km_static: unknown flag $flag"
+ }
+ }
+ }
+ }
+
+ default {
+ error "km_static: unknown flag $flag"
+ }
+}
+}
+
+ad_proc -public km_static_reset { id } {
+ Actually flush the km_static cache.
+} {
+ set all_the_cached_crud [nsv_array names km_static]
+ foreach cached_crud_item $all_the_cached_crud {
+ if {[regexp "$id\$" $cached_crud_item match matched_id]} {
+ nsv_unset km_static $cached_crud_item
+ }
+ }
+}
+
+ad_proc approval_coordinator_p {user_id} {
+
+ checks whether the user with user_id is approval coordinator
+} {
+ set package_id [ad_conn package_id]
+ if {[lsearch [km_static approval_coordinators $package_id] $user_id] > -1} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+proc_doc km_question_attributes {question_id_list} {
+
+ Returns the question_id, abstract_data_type, pretty_name as triples
+ for each question_id in the list.
+
+} {
+ set integer_list [filter_integers $question_id_list]
+ if {![null_p $integer_list]} {
+
+
+ if {[llength $integer_list] > 1} {
+ set where_clauses "where question_id in ([join $integer_list ","])"
+ } else {
+ set question_id [lindex $integer_list 0]
+ set where_clauses "where question_id = :question_id"
+ }
+
+
+ set sql "
+ select question_id, pretty_name, abstract_data_type
+ from sn_questions
+ $where_clauses
+ "
+ set result [db_list_of_lists km_question_attributes $sql]
+ return $result
+ }
+}
+
+# ********** Metadata **********
+
+ad_proc km_get_all_object_types {
+ {
+ -browsable_only_p 1
+ -createable_only_p 0
+ }
+} {
+ Returns a list of object_type_id, pretty_name, pretty_plural, browse_p, graphic, sort_key
+} {
+ set user_id [ad_conn user_id]
+ set package_id [ad_conn package_id]
+
+ if {$browsable_only_p} {
+ set browse_not "and browse_p='t'"
+ } else {
+ set browse_not ""
+ }
+
+ if {$createable_only_p} {
+ set privilege "create"
+ } else {
+ set privilege "read"
+ }
+
+ set result [db_list_of_lists object_types "
+ select object_type_id, pretty_name, pretty_plural,
+ decode(browse_p,'t',1,0), graphic, sort_key
+ from sn_object_types
+ where deleted_p = 'f'
+ and context_id = :package_id
+ $browse_not
+ and acs_permission.permission_p(object_type_id, :user_id, :privilege) = 't'
+ order by sort_key
+ "]
+
+ return $result
+}
+
+ad_proc km_get_questions {
+ {
+ -all_properties_p 0
+ -form_view ""
+ -root_node_p 1
+ -branch_children_p 1
+ -question_ids {}
+ -object_id 0
+ -object_type_id 0
+ -question_states {active}
+ -answers_p 0
+ -answered_p 0
+ -mandatory_p 0
+ }
+} {
+
+ Returns the column_name, pretty_name, abstract_data_type of all
+ questions for this object type or for this object as a *keyed* list.
+ root_node_p means it returns only top level questions for
+ branches. branch_children_p true means that branch children will ALSO be
+ listed individually
+
+} {
+ set columns {q.question_id q.pretty_name q.abstract_data_type}
+ set order_by ""
+ set tables {"sn_questions q" "sn_question_object_type_map m"}
+
+ if ![null_p $question_ids] {
+ # Return information about the given question.
+
+ lappend where_clauses "q.question_id=m.question_id"
+
+ if {[llength $question_ids] > 1} {
+ lappend where_clauses "q.question_id in ([join $question_ids ","])"
+ } else {
+ set question_id [lindex $question_ids 0]
+ lappend where_clauses "q.question_id = :question_id"
+ }
+ set order_by "order by m.sort_key"
+ } else {
+ if { $object_id } { set object_type_id [km_get_object_type $object_id] }
+
+ lappend join_tables "sn_questions q" "sn_question_object_type_map m"
+ lappend where_clauses "(m.object_type_id=$object_type_id and q.question_id=m.question_id)"
+ set order_by "order by m.sort_key"
+ }
+
+ if { $form_view == 1 } {
+ lappend where_clauses "form_number=1"
+ } elseif { $form_view == 2 } {
+ lappend where_clauses "q.abstract_data_type in ('text', 'option', 'category', 'other_category', 'date', 'file', 'integer', 'object_link', 'content_link', 'user_link', 'child_object', 'nephew_object')"
+ }
+
+ if {$answers_p} {
+ lappend columns "content as answer" "decode(nvl(html_p,'f'),'t',1,0) as html_p"
+ lappend where_clauses "c.object_id=$object_id and c.question_id=m.question_id"
+ lappend tables "sn_content c"
+ }
+
+ # we only want to know here, _if_ there is an answer. If html_p is null,
+ # then the outer join has retrieved a null row for sn_content, so there is
+ # no answer. Otherwise there is an answer.
+ if {$answered_p} {
+ lappend columns "nvl2(c.object_id,1,0) as answered_p"
+ lappend where_clauses "c.object_id(+)=$object_id and c.question_id(+)=m.question_id"
+ lappend tables "sn_content c"
+ }
+
+ if { $all_properties_p } {
+ lappend columns presentation_type tag_height tag_width entry_explanation year_from year_to \
+ m.mandatory_p m.question_state m.form_number m.sort_key q.node_id q.defaults_question_id \
+ q.order_by q.default_value q.target_object_type_id q.references_question_id m.object_type_id \
+ "decode(m.branch_p,'t',1,0) as branch_p" q.max_categories browse_p \
+ "(select decode(count(*),0,0,1) from dual
+ where exists (select 1
+ from sn_question_object_type_map m2
+ where m2.parent_question_id = q.question_id
+ and m2.branch_p='t'
+ and m2.object_type_id=$object_type_id)) as root_branch_p" \
+ parent_question_id
+ }
+
+ # Both branch and composite questions can have have parent and child questions
+ if { $root_node_p && !$branch_children_p } {
+
+ # We want to include questions at the root of branches in the selection but no children of branches
+ lappend where_clauses " m.parent_question_id=[km_static km_dummy_object_id]"
+
+ } elseif { $root_node_p } {
+
+ # We want branch children, too, but no composite children
+ lappend where_clauses " ( m.parent_question_id=[km_static km_dummy_object_id] or branch_p='t')"
+ }
+
+ if ![null_p $question_states] {
+ lappend where_clauses "m.question_state in ('[join $question_states "','"]')"
+ }
+
+ if { $mandatory_p } { lappend where_clauses "m.mandatory_p = 't'" }
+
+ # Get the question attributes out of the table
+ set sql_km_get_questions "
+ select [join $columns ", "]
+ from [join $tables ", "]
+ where [join $where_clauses " and "]
+ $order_by"
+ set result [km_db_to_named_list_list km_get_questions $sql_km_get_questions]
+
+ return $result
+}
+
+ad_proc km_get_question {
+ {
+ -previous_p 0
+ -next_p 0
+ -object_id 0
+ -entry_explanation_p 0
+ -all_types_p 0
+ }
+ question_id object_type_id
+} {
+
+ Returns the question_id, pretty_name, abstract_data_type, question_state,
+ optionally the entry_explanation as a list.
+
+ Set previous_p to 1 and it returns the previous question in the series
+ that belongs to this object type. Set next_p to 1 and it returns the
+ next in the series. This proc does NOT do branch analysis.
+ See km-branch.tcl.
+
+ What it does do is search for the next unanswered question that is not
+ in a branch when called with a branch question - not necessarily higher
+ on the sort key list.
+
+} {
+ if { $entry_explanation_p } {
+ set entry_string ", q.entry_explanation"
+ } else {
+ set entry_string ""
+ }
+
+ set sql_km_get_question_1 "select sort_key, decode(branch_p,'t',1,0)
+ as branch_p, sort_key as current_sort_key, question_state
+ from sn_question_object_type_map
+ where question_id=:question_id and object_type_id=:object_type_id"
+
+ if { ![db_0or1row km_get_question_1 $sql_km_get_question_1]} {
+ return ""
+ }
+
+ if { $next_p || $previous_p } {
+ # We need some extra limitations here so that we don't pull out composite questions or branches.
+
+ set question_state_sql "and question_state <> 'invisible'"
+ if { $all_types_p } {
+ set question_state_sql ""
+ }
+ if { $next_p } {
+
+ if { $branch_p } {
+ # This is a branch leaf. We determine the next question
+ # relative to its root.
+ set root_id [km_get_root_branch $question_id $object_type_id]
+ set current_sort_key "(select sort_key from sn_question_object_type_map where question_id=:root_id and object_type_id = :object_type_id)"
+ }
+ set limitation " and qm.sort_key = (
+ select min(sort_key)
+ from sn_question_object_type_map
+ where object_type_id=:object_type_id
+ and sort_key > :current_sort_key
+ $question_state_sql
+ and branch_p='f'
+ and parent_question_id=[km_static km_dummy_object_id])"
+
+ } elseif { $previous_p } {
+ set limitation " and qm.sort_key = (
+ select max(sort_key) from sn_question_object_type_map
+ where object_type_id=:object_type_id
+ and sort_key < :current_sort_key
+ $question_state_sql
+ and branch_p='f'
+ and parent_question_id=[km_static km_dummy_object_id])"
+ }
+ } else {
+ set limitation "and q.question_id=:question_id"
+ }
+
+ set question_state_sql "and qm.question_state <> 'invisible'"
+ if { $all_types_p } {
+ set question_state_sql ""
+ }
+ set result [km_db_1row_to_list km_get_question_2 "
+ select q.question_id, q.pretty_name, q.abstract_data_type, qm.question_state $entry_string
+ from sn_questions q, sn_question_object_type_map qm
+ where qm.question_id = q.question_id
+ and qm.object_type_id = :object_type_id
+ $question_state_sql
+ $limitation"]
+
+ if { ($next_p || $previous_p) && ![empty_string_p $result] } {
+ # We want to skip deprecated and read-only questions
+ # which have not been answered.
+
+ set new_question_id [fst $result]
+ set new_abstract_data_type [thd $result]
+ set new_question_state [lindex $result 3]
+
+ set answer [fst [km_get_object_data -questions [list {question_id pretty_name abstract_data_type question_state} $result] $object_id]]
+
+ if { $new_question_state != "active" && ![km_answered_p $new_abstract_data_type $answer] } {
+ set result [km_get_question -next_p $next_p -previous_p $previous_p -entry_explanation_p $entry_explanation_p -object_id $object_id $new_question_id $object_type_id]
+ }
+ }
+
+ return $result
+}
+
+proc_doc km_get_child_questions {composite_id} {
+ Returns a list of child question_ids for this composite question.
+} {
+ set sql "select question_id from sn_question_object_type_map
+ where parent_question_id = :composite_id and branch_p='f' and question_state <> 'invisible'"
+ set result [db_list km_get_child_questions $sql]
+ return $result
+}
+
+proc_doc km_get_answer_options {question_id} {
+
+ Returns the list of key-value-sort_key tuples of answer options
+ for this question_id, assuming that this question is actually
+ a question of type option.
+
+} {
+ set result [db_list_of_lists km_get_answer_options "
+ select option_id, answer_option, sort_key
+ from sn_answer_options
+ where question_id = :question_id
+ order by sort_key"]
+ return $result
+}
+
+proc_doc km_answer_option {option_id} {
+ Returns an the pretty name of an answer option.
+} {
+ set sql "select answer_option from sn_answer_options where option_id = :option_id"
+ set result [db_string km_answer_option $sql -default ""]
+ return $result
+}
+
+proc km_pretty_question_state { question_state } {
+ switch $question_state {
+ "active" { return "Active" }
+ "deprecated" { return "To be phased out" }
+ "read-only" { return "Read-Only" }
+ "invisible" { return "Invisible" }
+ }
+}
+
+# ******************** Input checking ********************
+
+proc_doc km_sort_form { key_value_tuples } {
+ Sorts form vars into a list of tuples of keys and value_lists. Date variables are assembled to make one value. Note that
+ even if one key has only one value associated with it that this value will be represented as a single element list.
+} {
+ set sorted_tuples [list]
+ set sister_tag_p 0
+
+ #Put dates together
+ set tuples [km_assemble_dates -filter_p 0 [fst [transpose $key_value_tuples]] [snd [transpose $key_value_tuples]]]
+ # Sort the tuple values into new value_lists by key
+ foreach tuple $tuples {
+
+ set key [fst $tuple]
+ set value [snd $tuple]
+
+ # Put textareas and their sister html_p tags together
+ if {[regexp {(.*)\.html_p} $key match x] } {
+ set key $x
+ set sister_tag_p 1
+ }
+
+ # Get the index of the element in sorted_tuples to be manipulated
+ set ix [lsearch [fst [transpose $sorted_tuples]] $key]
+
+ if {$ix >= 0} {
+
+ # This key is already in sorted_tuples list so add this value to the value_list in the tuple
+ set new_value_list [concat [snd [lindex $sorted_tuples $ix]] $value]
+
+ # Replace the old element of sorted_tuples with the new tuple
+ set sorted_tuples [lreplace $sorted_tuples $ix $ix [list $key $new_value_list]]
+ set sister_tag_p 0
+
+ } elseif {$sister_tag_p} {
+
+ # Then this is an html_p tag that has no sister textarea tag: i.e. the textarea tag is an empty string
+ lappend sorted_tuples [list $key [list "" $value]]
+ set sister_tag_p 0
+
+ } else {
+
+
+ # This key isn't yet in the sorted_tuple list so append a new tuple to it
+ lappend sorted_tuples [list $key [list $value]]
+
+ }
+ }
+ return $sorted_tuples
+}
+
+proc_doc km_filter_valid_keys { key_value_list} {
+ Returns the tuple if it is valid- i.e. it has an integer key value.
+} {
+ set filtered_tuples [list]
+ foreach tuple $key_value_list {
+ if {[integer_p [fst $tuple]]} {lappend filtered_tuples $tuple}
+ }
+ return $filtered_tuples
+}
+
+proc_doc km_filter_other_category_keys { key_value_list} {
+ Returns the tuple if it is originating from extra input field for category 'Other'
+} {
+ set filtered_tuples [list]
+ foreach tuple $key_value_list {
+ set key [fst $tuple]
+ if { [regexp {([0-9]+)_other$} $key match question_id] && [integer_p $question_id] } {
+ lappend filtered_tuples [list $question_id [snd $tuple]]
+ }
+ }
+ return $filtered_tuples
+}
+
+proc_doc km_required_questions {object_id} {
+ Returns a list of required (or mandatory) questions for this object.
+} {
+ set context_id [ad_conn package_id]
+ set result [db_list km_required_questions "
+ select q.question_id
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and qm.question_state = 'active'
+ and o.context_id=:context_id
+ and qm.mandatory_p = 't'"]
+ return $result
+}
+
+ad_proc km_mandatory_child_p { { -parent_id 0 -child_ids {} } } {
+
+ Returns 1 if this composite parent has a mandatory child
+ or if one of the child_ids passed is mandatory.
+
+} {
+ if { $parent_id } { set child_ids [km_get_child_questions $parent_id] }
+
+ if [null_p $child_ids] { return 0 }
+ set children [km_get_questions -all_properties_p 1 -branch_children_p 1 -root_node_p 0 -question_ids $child_ids]
+ set key [fst $children]
+ set children [tail $children]
+
+ foreach child $children {
+ set mandatory_p [ad_decode [lindex $child [lsearch $key mandatory_p]] t 1 0]
+ if { $mandatory_p } { return 1 }
+ }
+
+ return 0
+}
+
+ad_proc km_is_required {
+ {
+ -object_id 0
+ -object_type_id 0
+ }
+ question_id
+} {
+ Checks if a question is mandatory.
+} {
+ if !$object_type_id { set object_type_id [km_get_object_type $object_id] }
+ set result [db_list km_is_required "
+ select decode(mandatory_p,'t',1,0)
+ from sn_question_object_type_map
+ where question_id=:question_id and object_type_id=:object_type_id"]
+ return $result
+}
+
+proc_doc km_answered_p { abstract_data_type answer } {
+ Determines on the basis of the abstract_data_type if this question has been answered or is empty.
+} {
+ switch $abstract_data_type {
+ "object_link" { return [expr ![null_p [tail $answer]]] }
+ "composite" {
+ # This is a bit tricky. Composite questions come in as little
+ # packets of other questions from km_object_data.
+ # A composite question is considered answered if at least one
+ # child has been answered.
+
+ foreach item $answer {
+ if [km_answered_p [lindex $item 3] [fst $item]] { return 1 }
+ }
+ return 0
+ }
+ "option" - "other_category" -
+ "category" { return [expr ![null_p $answer]] }
+ "integer" -
+ "text" { return [expr ![empty_string_p [fst $answer]]] }
+ default { return [expr ![empty_string_p $answer]]}
+ }
+}
+
+ad_proc km_check_input {
+ {
+ -required_p 0
+ -complete_p 0
+ }
+ object_id
+ key_value_list
+} {
+
+ This proc determines if the list of question_ids and their value
+ are valid entries according to their abstract data type.
+ It will also check if the set of keys and values submitted are
+ enough to make this object complete if complete_p is true. Or it will
+ check if a each key is a required question and if so, it will
+ check if that question is answered when required_p is true.
+
+ This proc returns a tuple for ad_return_complaint if it has reason
+ to complain.
+
+} {
+ set invalid_questions {}
+ set missing_ids {}
+ set required_ids {}
+
+ #Remove any key value tuples that do not have an integer key
+ set key_value_list [km_filter_valid_keys $key_value_list]
+
+ # The keys in key value tuples are the question_ids
+ set submitted_ids [fst [transpose $key_value_list]]
+ set values [snd [transpose $key_value_list]]
+
+ #Get a list of required questions to check for completeness
+ if {$complete_p || $required_p} { set required_ids [km_required_questions $object_id] }
+
+ # Get the abstract data types and pretty_names of the questions
+ set questions [km_question_attributes [concat $submitted_ids $required_ids]]
+ set question_ids [fst [transpose $questions]]
+ set abstract_data_types [thd [transpose $questions]]
+ set pretty_names [snd [transpose $questions]]
+
+ foreach submitted_id $submitted_ids {
+
+ # check the input
+ set abstract_data_type [lindex $abstract_data_types [lsearch $question_ids $submitted_id]]
+ set value_list [lindex $values [lsearch $submitted_ids $submitted_id]]
+
+ switch $abstract_data_type {
+ "text" {
+ if {($complete_p || $required_p) && ([elem_p $submitted_id $required_ids] && ([null_p $value_list] \
+ || [empty_string_p [fst $value_list]])) } {
+ lappend missing_ids $submitted_id
+ }
+ }
+ "category" - "other_category" - "option" {
+ set max_categories [km_static question_max_categories $submitted_id]
+ if {($complete_p || $required_p) && [elem_p $submitted_id $required_ids] && [null_p $value_list]} {
+ lappend missing_ids $submitted_id
+ } elseif {![empty_string_p $max_categories] && ([llength $value_list] > $max_categories)} {
+ lappend invalid_questions [list $submitted_id "more than the allowed $max_categories categories chosen"]
+ }
+ }
+ "date" {
+ if {($complete_p || $required_p) && [elem_p $submitted_id $required_ids] && [empty_date_p $value_list]} {
+ lappend missing_ids $submitted_id
+ } elseif {![empty_date_p $value_list] && ![date_p $value_list]} {
+ lappend invalid_questions [list $submitted_id "no valid date"]
+ }
+ }
+ "integer" {
+ if {($complete_p || $required_p) && ([elem_p $submitted_id $required_ids] && ([null_p $value_list] \
+ || [empty_string_p [fst $value_list]])) } {
+ lappend missing_ids $submitted_id
+ } elseif {![integer_p [fst $value_list]]} {
+ lappend invalid_questions [list $submitted_id "no valid number"]
+ }
+ }
+ "file" {
+ set client_filename [fst $value_list]
+
+ if {($complete_p || $required_p) && [elem_p $submitted_id $required_ids] } {
+ if [empty_string_p $client_filename] {
+ # Go to the db and see if a file already exists for this variable.
+ if ![km_upload_exists_p $object_id $submitted_id] {
+ lappend missing_ids $submitted_id
+ }
+ }
+ }
+
+ if { ![empty_string_p $client_filename] } {
+ # If the temporary file is empty, there has been an error.
+ set tmpfilename [ns_queryget $submitted_id.tmpfile]
+ if ![file size $tmpfilename] {
+ lappend invalid_questions [list $submitted_id "invalid file"]
+ }
+ }
+ }
+ default { continue }
+ }
+ }
+
+ foreach question_id $required_ids {
+ set abstract_data_type [lindex $abstract_data_types [lsearch [fst [transpose $questions]] $question_id]]
+ switch $abstract_data_type {
+ "user_link" {
+ if ![null_p [km8_get_to_links $object_id $question_id]] {
+ # If there already are links for this question, we pretend
+ # it has been submitted.
+ lappend submitted_ids $question_id
+ }
+ }
+ "file" {
+ if ![km_upload_exists_p $submitted_id $object_id] {
+ lappend submitted_ids $question_id
+ }
+ }
+ "child_object" {
+ if {![null_p [km_get_child_objects $object_id $question_id]] } {
+ lappend submitted_ids $question_id
+ }
+ }
+ "nephew_object" {
+ if {![null_p [km_get_nephew_objects $object_id $question_id]] } {
+ lappend submitted_ids $question_id
+ }
+ }
+ }
+ }
+
+ # Check if there are some other keys that also should be submitted to make this complete
+ if { $complete_p } { set missing_ids [concat $missing_ids [minus $required_ids $submitted_ids]] }
+
+ #Prepare the complaint messages
+ foreach missing_id $missing_ids {
+ set pretty_name [lindex $pretty_names [lsearch $question_ids $missing_id]]
+ append message "You must supply a value for $pretty_name<br>"
+ }
+ foreach invalid_question $invalid_questions {
+ set invalid_id [fst $invalid_question]
+ set invalid_msg [snd $invalid_question]
+ set pretty_name [lindex $pretty_names [lsearch $question_ids $invalid_id]]
+ append message "You have entered an invalid entry for $pretty_name ($invalid_msg)<br>"
+ }
+ set i [expr [llength $invalid_questions] + [llength $missing_ids]]
+ if { $i } {
+ return [list $i $message]
+ } else {
+ return
+ }
+}
+
+proc_doc km_upload_exists_p { object_id question_id } {
+ Looks if a file has been uploaded for this object_id and question_id
+} {
+ set client_filename [db_string km_upload_exists_p "
+ select content from sn_content
+ where object_id=:object_id
+ and question_id=:question_id" -default ""]
+
+ if ![empty_string_p $client_filename] {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+ad_proc km_original_author_p { user_id object_id } {
+ Test if the user is the original author of this object.
+} {
+ set context_id [ad_conn package_id]
+ set result [db_string km_original_author_p "
+ select count(*) from sn_objects where object_id=:object_id and original_author_id=:user_id and context_id=:context_id"]
+
+ return $result
+}
+
+proc_doc km_type_has_data_type_p { object_type_id data_type } {
+ Determines if an object type has a column of the given abstract datatype.
+} {
+ return [db_string km_type_has_data_type_p "
+ select decode(count(*),0,0,1) from dual where exists (select 1
+ from sn_questions q, sn_question_object_type_map qm
+ where qm.question_id = q.question_id
+ and qm.object_type_id = :object_type_id
+ and qm.question_state <> 'invisible'
+ and q.abstract_data_type = :data_type)"]
+}
+
+# ******************** Date Procs ********************
+
+proc_doc month_list {} {
+ Returns a list of months, the second row holds the corresponding 2 digit values.
+} {
+ set months [list Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]
+ set values [list 01 02 03 04 05 06 07 08 09 10 11 12]
+ return [list $months $values]
+}
+
+proc_doc km_default_date {question_id} {
+ Calculates a default date based on the question_id
+} {
+ set default_value [db_string km_default_date_1 "
+ select default_value from sn_questions where question_id=:question_id" -default ""]
+ if [empty_string_p $default_value] {
+ set result {}
+ } else {
+ if { ![catch {set default_date [db_string km_default_date_2 "select $default_value from dual"]}] } {
+ set result [km_break_date $default_date]
+ } else {
+ set result {}
+ }
+ }
+ return $result
+}
+
+ad_proc km_get_year_range {question_id} {
+ Calculates the year range for this date question
+} {
+ db_1row get_year_range {
+ select (to_char(add_months(sysdate,12*year_from),'YYYY')) as year_from,
+ (to_char(add_months(sysdate,12*year_to),'YYYY')) as year_to
+ from sn_questions
+ where question_id = :question_id
+ }
+ return [list $year_from $year_to]
+}
+
+ad_proc km_assemble_dates { {-filter_p 1} keys values } {
+
+ Given a list of keys and values, this proc searches for all keys with the form
+ key_name:month, key_name:year, key_name:day, which is how km-date-tags
+ returns them in this module. It returns a list of key value tuples
+ of the form: key_name YYYY-MM-DD. It does not check if these are valid dates, that's
+ what date_p does. If filter_p is set to 1, it returns only the date tuples back.
+ Otherwise it returns all other keys and values in the same order.
+
+} {
+ # we need a list of key_name tags and their values, sort them so that
+ # all key_names are grouped together and that :day, :month, :year
+ # will be evaluated in that order
+
+ set key_name ""
+ set tuples [zip $keys $values]
+ set tuples [qsort $tuples]
+ set last_key_name ""
+ set result [list]
+
+ set counter 0
+ foreach tuple $tuples {
+
+ if { [regexp {(.*)\.(month|year|day)} [fst $tuple] match key_name] } {
+ # Looks like a date value.
+
+ if { [string compare $key_name $last_key_name] == 0 } {
+ lappend ${key_name}_value [snd $tuple]
+ } else {
+
+ # It's a different key_name so append the last_key_name and
+ # its date to the list (if there is one).
+
+ if ![empty_string_p $last_key_name] {
+ lappend dates [list $last_key_name [set ${last_key_name}_value]]
+ }
+
+ # Start assembling the next date
+ lappend ${key_name}_value [snd $tuple]
+ }
+
+ set last_key_name $key_name
+ incr counter
+
+ } elseif !$filter_p {
+ # No date value, but we are not allowed to filter other values out.
+ # So just copy it.
+
+ lappend result $tuple
+ }
+ }
+
+ if { $counter } {
+
+ # Append the last last_key_name and its date to the list.
+ lappend dates [list $last_key_name [set ${last_key_name}_value]]
+
+ # Oracle will want the date YYY-MM-DD instead of a list DD MM YYYY,
+ # so split the tuples up again and format the date part.
+
+ set formatted_dates [map {flip join "-"} [map reverse [snd [transpose $dates]]]]
+
+ # Pack them up again to be returned as a list of tuples.
+ set result "$result [zip [fst [transpose $dates]] $formatted_dates]"
+ }
+
+ return $result
+}
+
+
+# ******************** Navigation ********************
+
+proc_doc generate_path_id {} {
+
+ Generates a random number to uniquely define this excursion state in
+ the knowledge management library.
+
+ This number will be passed from one form to the next throughout the excursion.
+
+} {
+ while 1 {
+ # Note that ns_rand only gives us six digits - so we call it twice.
+ set path_id "[ns_rand 1000000][ns_rand 1000000]"
+
+ if ![db_string generate_path_id "select count(*) from km_path where path_id=:path_id"] {
+ return $path_id
+ }
+ }
+}
+
+ad_proc set_path_values {{-question_id ""} object_id category_id } {
+
+ Returns a simple list of name and value tuples that should be stored
+ for library excursions in the km_excursion_path table
+
+} {
+
+ if ![empty_string_p $question_id] {
+ set values [list object_id $object_id question_id $question_id category_id $category_id]
+ } else {
+ set values [list object_id $object_id category_id $category_id]
+ }
+ return $values
+}
+
+ad_proc init_path {
+ {
+ -last_path_id ""
+ }
+ values_list return_to action
+} {
+
+ Initializes the path variable for an excursion through the library.
+
+ Begins an excursion by saving all the information that will be
+ necessary at the end of this excursion to return to the same place it
+ started. It is assumed that an excursion is only occuring while
+ editing, creating or linking an object. In all other cases there will
+ be no excursion state and also no object_id. Important! The
+ last_path_id that is being passed is the id of the excursion state out
+ of which this excursion is being launched!
+
+} {
+ set path_id [generate_path_id]
+ if [empty_string_p $last_path_id] { set last_path_id [db_null] }
+
+ # Insert the info about this particular excursion into the database
+
+ db_dml init_path "insert into km_path
+ (path_id, last_path_id, action, values_list, return_to, start_time)
+ values (:path_id, :last_path_id, :action,
+ :values_list, :return_to, sysdate)"
+
+ return $path_id
+}
+
+proc_doc get_path_return_url {path_id} {
+
+ Returns the destination of a path if it's a valid path, otherwise
+ it returns an empty string.
+
+} {
+ if [empty_string_p $path_id] { return "" }
+
+ set calc_excursion_timeout [expr [excursion_timeout]/24]
+ set sql "select return_to from km_path
+ where path_id=:path_id and sysdate - start_time < :calc_excursion_timeout"
+
+ if {[catch {set destination [db_string get_path_return_url $sql]}]} {
+ set result ""
+ } else {
+ set result $destination
+ }
+
+ return $result
+}
+
+ad_proc get_path_values { {-action_only_p 1} path_id } {
+
+ Given an excursion's path_id, this proc returns the action of this
+ excursion as a two-part list: {action action_value}. This is often
+ necessary for a page to know what it is supposed to do. If the option
+ action_only_p is set to 0 then a simple list is returned with the name
+ and value of the variables in the same order that they were given to
+ km_set_path_values
+
+} {
+
+ set timeout [excursion_timeout]
+
+ if !$action_only_p {
+ # Return a list with all excursion details
+ set values ", values_list "
+ } else {
+ set values ""
+ }
+
+ # Get out the action and the list of values from oracle and
+ # turn it into a list of action and the other values
+
+ set values_list {}
+ if { ![db_0or1row get_path_values "
+ select action $values from km_path
+ where path_id=:path_id and sysdate - start_time < :timeout/24"]} {
+ set result {}
+ } else {
+
+ split $values_list
+
+ set result {}
+ foreach value $values_list { lappend result $value }
+ lappend result action $action
+ }
+
+ return $result
+}
+
+proc_doc get_path_action {path_id} {
+ Returns the path's action as a plain value.
+} {
+ return [snd [get_path_values $path_id]]
+}
+
+proc_doc get_last_path {path_id} {
+
+ If this was an excursion launched within another excursion then we
+ want to return the path_id of that excursion.
+
+} {
+ set last_path_id [db_string get_last_path "
+ select last_path_id from km_path where path_id=:path_id" -default ""]
+
+ return $last_path_id
+}
+
+proc_doc path_valid_p {path_id} {
+ Checks if the given path (still) exists.
+} {
+ if [empty_string_p $path_id] { return 0 }
+
+ set calc_excursion_timeout [expr [excursion_timeout]/24]
+ set result [db_string path_valid_p "
+ select count(*) from km_path
+ where path_id=:path_id and sysdate - start_time <= :calc_excursion_timeout"]
+ return $result
+}
+
+proc_doc value_from_tuples {key_values key} {
+
+ Given a list of key/value tuples, returns the value associated with
+ the given key.
+
+} {
+ if { [lsearch $key_values $key] == -1 } {
+ return ""
+ } else {
+ return [lindex $key_values [expr [lsearch $key_values $key] + 1]]
+ }
+}
+
+ad_proc sn_success_story_id {} {
+ Returns the object_type_id for the Success Stories.
+} {
+ set context_id [ad_conn package_id]
+ set result [db_string sn_success_story_id "
+ select object_type_id from sn_object_types
+ where upper(pretty_name) = upper('success story') and context_id=:context_id" -default "0"]
+
+ return $result
+}
+
+
+ad_proc km_workflow_task_per_object {object_id} {
+ Return information about the current workflow task for this object_id
+} {
+ # dirk: remove the rownum - it's only in for debugging purposes.
+ if {[db_0or1row km_workflow_task_per_object {
+ select t.task_id,
+ t.case_id,
+ t.transition_key,
+ t.state,
+ t.transition_name as task_name
+ from wf_cases c,
+ wf_user_tasks t
+ where c.case_id = t.case_id
+ and c.object_id=:object_id
+ and rownum=1}]} {
+ return [list \
+ workflow_task_p t \
+ task_id $task_id \
+ case_id $case_id \
+ transition_key $transition_key \
+ state $state \
+ task_name $task_name]
+ } else {
+ return [list \
+ workflow_task_p f \
+ task_id "" \
+ case_id "" \
+ transition_key "" \
+ state "" \
+ task_name ""]
+ }
+ return ""
+}
+
+
+ad_proc library_approval_process_notifications {} {
+
+ Processes the notifications queued in table wf_library_notifications.
+
+} {
+ # Make sure that only one thread is processing the queue at a time.
+ if {[nsv_incr library library_notifications_p] > 1} {
+ nsv_incr library library_notifications_p -1
+ return
+ }
+
+ with_finally {
+
+ db_foreach get_notifications {
+ select notification_id, task_id, template_key, recipient_id, sender_id, body
+ from wf_library_notifications
+ } {
+
+ db_1row ticket_info {
+ select o.object_id,
+ o.one_line_description as shortname, sn.node_id,
+ u1.email as sender_email, u2.email as recipient_email,
+ u1.first_names || ' ' || u1.last_name as sender_name,
+ u2.first_names || ' ' || u2.last_name as recipient_name,
+ apm_package.name(o.context_id) as package_name
+ from wf_tasks wt, wf_cases wc, sn_objects o, users u2,
+ site_nodes sn, users u1
+ where u1.user_id = :sender_id
+ and u2.user_id = :recipient_id
+ and wc.case_id = wt.case_id
+ and wt.task_id = :task_id
+ and o.object_id = wc.object_id
+ and sn.object_id = o.context_id
+ }
+
+ set community_id [sn_community::leaf_community $node_id]
+
+ set replacement_list \
+ [list \
+ object_id $object_id \
+ object_link "[ad_url]/o/$object_id" \
+ package_name $package_name \
+ shortname $shortname \
+ submitter_name $sender_name \
+ submitter_email $sender_email \
+ recipient_email $recipient_email \
+ notification_sender $sender_email \
+ body $body]
+
+ db_dml delete_notification {
+ delete from wf_library_notifications
+ where notification_id = :notification_id
+ }
+
+ et_send_email [et_process -community_id $community_id $template_key $replacement_list]
+ }
+
+ } finally {
+ nsv_incr library library_notifications_p -1
+ }
+}
+
+
+util_report_successful_library_load
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-access-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-access-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-access-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,315 @@
+# /tcl/km-access-procs.tcl
+#
+# Functions related to access control.
+#
+# Created by carsten@arsdigita.com in June 2000
+#
+# $Id: km-access-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+ad_proc km_check_object_id {
+ {
+ -check_deleted_p 1
+ -check_read_p 1
+ -check_edit_p 0
+ -check_delete_p 0
+ -print_errors_p 1
+ }
+ object_id
+} {
+
+ Check if the object exists, and print an error message if it
+ doesn't. Returns 0 if the object_id is invalid.
+
+ If check_deleted_p is 1, also checks if the object has been deleted.
+ If check_read_p is 1, also checks if the user may view the object.
+ If check_edit_p is 1, also checks if the user may edit the object.
+ Only complains to the user if print_errors_p is 1.
+
+} {
+ set package_id [ad_conn package_id]
+ set user_id [ad_conn user_id]
+
+ if { ![db_0or1row get_object_info "
+ select decode(sign(sysdate-o.expiration_date),1,1,0,1,0) as deleted_p,
+ o.original_author_id, o.expiration_date, o.object_type_id,
+ o.one_line_description as object_name, o.overview,
+ o.last_modifying_user_id, o.start_date, o.end_date,
+ decode(o.public_p,'t',1,0) as public_p, o.public_until,
+ decode(o.archived_p,'t',1,0) as archived_p,
+ o.original_author_id, to_char(o.creation_date) as creation_date,
+ to_char(o.last_modified) as last_modified,
+ to_char(o.user_checkoff_date) as user_checkoff_date,
+ u.first_names || ' ' || u.last_name as original_author_name,
+ u.email as original_author_email, o.publisher_id,
+ decode([tcl_permission_p ":object_id" ":user_id" "'read'"],'t',1,0) as read_p,
+ decode([tcl_permission_p ":object_id" ":user_id" "'write'"],'t',1,0) as write_p,
+ decode([tcl_permission_p ":object_id" ":user_id" "'delete'"],'t',1,0) as delete_p,
+ decode([tcl_permission_p ":package_id" ":user_id" "'admin'"],'t',1,0) as admin_p,
+ decode([tcl_permission_p ":package_id" ":user_id" "'km_publish'"],'t',1,0) as publish_p,
+ decode(acs_permission.permission_p(o.object_type_id, :user_id, 'create'),'t',1,0) as create_p,
+ nvl(o.access_total,0) as access_total, nvl(o.access_month,0) as access_month,
+ decode(o.in_review_p,'t',1,0) as in_review_p
+ from sn_objects o, users u
+ where o.object_id = :object_id
+ and u.user_id = o.original_author_id
+ "] } {
+ # Error: The object does not exist.
+
+ if { $print_errors_p } {
+ ad_return_exception_page 404 "Entry does not exist." "
+ The entry with id $object_id does not exist.
+ We never really delete object IDs from the database so this is quite
+ unusual. Unless you tried to hack the URL manually this might be a bug
+ in our software."
+ }
+ return 0
+ }
+
+ if { [empty_string_p $object_name] } {
+ set object_name "Unnamed [km_static object_type_pretty_name $object_type_id]"
+ }
+ # review process enabled?
+ if { [km_static approval_p $package_id] && !$publish_p } {
+ if {$public_p || $in_review_p} {
+ # revoke delete permission from object owners if object is
+ # public or review process started
+ set delete_p $admin_p
+ }
+ }
+
+ # The state of a workflow task is user-dependant!
+ if {$in_review_p} {
+ set state [db_string workflow_case_state {select distinct t.transition_key
+ from wf_cases c,
+ wf_user_tasks t
+ where c.case_id = t.case_id
+ and c.object_id=:object_id
+ and c.state = 'active'
+ and rownum = 1
+ order by t.transition_key desc} -default ""]
+ } else {
+ set state ""
+ }
+## and t.user_id = :user_id
+
+ km_conn -reset
+ km_conn -set public_p $public_p
+ km_conn -set archived_p $archived_p
+ km_conn -set deleted_p $deleted_p
+ km_conn -set expiration_date $expiration_date
+ km_conn -set object_type_id $object_type_id
+ km_conn -set object_name $object_name
+ km_conn -set overview $overview
+ km_conn -set original_author_id $original_author_id
+ km_conn -set original_author_name $original_author_name
+ km_conn -set original_author_email $original_author_email
+ km_conn -set creation_date $creation_date
+ km_conn -set last_modified $last_modified
+ km_conn -set user_checkoff_date $user_checkoff_date
+ km_conn -set admin_p $admin_p
+ km_conn -set publish_p $publish_p
+ km_conn -set read_p $read_p
+ km_conn -set write_p $write_p
+ km_conn -set delete_p $delete_p
+ km_conn -set create_p $create_p
+ km_conn -set last_modifying_user_id $last_modifying_user_id
+ km_conn -set access_total $access_total
+ km_conn -set access_month $access_month
+ km_conn -set public_until $public_until
+ km_conn -set start_date $start_date
+ km_conn -set end_date $end_date
+ km_conn -set publisher_id $publisher_id
+ km_conn -set in_review_p $in_review_p
+ km_conn -set review_state $state
+
+ if { $check_deleted_p && $deleted_p } {
+ # Error: The object has been deleted.
+
+ set expiration_date [util_AnsiDatetoPrettyDate $expiration_date]
+
+ if {![empty_string_p $last_modifying_user_id]} {
+ # If we know who deleted the object, we want to give the
+ # user a link to that user's community page.
+
+ set deletor_name [db_string km_check_object_id_2 "
+ select first_names || ' ' || last_name
+ from users where user_id=:last_modifying_user_id"]
+
+ set deletion_text "This object was deleted on $expiration_date by [ad_present_user $last_modifying_user_id $deletor_name]."
+
+ set reason_for_deleting [db_string km_check_object_id_3 "
+ select reason_for_deleting
+ from sn_object_delete_reasons
+ where object_id=:object_id" -default ""]
+
+ if {![empty_string_p $reason_for_deleting]} {
+ append deletion_text "<p>Reason: <blockquote>$reason_for_deleting</blockquote>"
+ }
+
+ } else {
+ set deletion_text "This object was deleted on $expiration_date."
+ }
+
+ if { $print_errors_p } { ad_returnredirect "object-deleted?object_id=$object_id" }
+
+ return 0
+ }
+
+ if { $check_read_p && !$read_p } {
+ # A user only has read access if the object is public,
+ # or he has been given read permission.
+
+ if { $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to view this object."
+ }
+ return 0
+ } elseif { $check_edit_p && !$admin_p && (!$write_p || $archived_p) } {
+ if { $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to edit this object."
+ }
+ return 0
+ } elseif { $check_delete_p && !$admin_p && !$delete_p } {
+ if { $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to delete this object."
+ }
+ return 0
+ }
+
+ # Check if the object type (still) exists, and if the user is allowed
+ # to view it.
+
+ if { [km_static object_type_deleted_p $object_type_id] } {
+ if { $print_errors_p } {
+ # Only complain to the user if we were told so.
+
+ set pretty_type [km_static object_type_pretty_name $object_type_id]
+ ad_return_exception_page 404 "The object type \"$pretty_type\" has been removed from the system." "The object type \"$pretty_type\" has been removed from the system.
+You therefore cannot view this object"
+ }
+ return 0
+ }
+
+ if { $check_read_p && ![km_static object_type_public_p $object_type_id] && !$admin_p } {
+ # The object type may not be viewed by this user.
+
+ if { $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to view this object."
+ }
+ return 0
+ }
+
+ return 1
+}
+
+ad_proc km_check_object_type_id {
+ {
+ -check_view_p 1
+ -check_create_p 0
+ -print_errors_p 1
+ }
+ object_type_id
+} {
+
+ Check if the user may access the given object type. Checks for
+ read and create permissions, whether the object type
+ has been deleted, and whether it belongs to the current package.
+
+ If check_create_p is set, also complains when the object type
+ is not browsable.
+
+} {
+ set package_id [ad_conn package_id]
+ set user_id [ad_conn user_id]
+
+ if { ![db_0or1row km_check_object_type_id "
+ select deleted_p, browse_p, public_p,
+ decode([tcl_permission_p ":package_id" ":user_id" "'admin'"],'t',1,0) as admin_p,
+ decode([tcl_permission_p ":object_type_id" ":user_id" "'create'"],'t',1,0) as create_p
+ from sn_object_types
+ where object_type_id = :object_type_id
+ and context_id = :package_id
+ "] } {
+ if { $print_errors_p } {
+ ad_return_exception_page 404 "Invalid object_type_id" \
+ "The given object_type_id is invalid."
+ }
+ return 0
+ }
+
+ km_conn -reset
+ km_conn -set admin_p $admin_p
+ km_conn -set create_p $create_p
+
+ if { $deleted_p == "t" } {
+ if { $print_errors_p } {
+ ad_return_exception_page 410 "Object type no longer exists" \
+ "This object type has been removed from the system."
+ }
+ return 0
+ }
+
+ if { $check_view_p && $public_p == "f" && !$admin_p } {
+ if { $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to view objects of this type."
+ }
+ return 0
+ }
+
+ if { $check_create_p && ($public_p == "f" || !$create_p) && !$admin_p } {
+ if { $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to create objects of this type."
+ }
+ return 0
+ }
+
+ return 1
+}
+
+ad_proc km_check_owner_change {
+ {
+ -print_errors_p 1
+ }
+ object_id
+} {
+
+ Checks if the user may change the ownership of the given
+ object. This is only allowed for the object owner and administrators.
+
+} {
+ set user_id [ad_conn user_id]
+ set package_id [ad_conn package_id]
+
+ set result [db_string check_owner_change "
+ select decode(count(*),0,0,1) from dual where exists
+ (select 1
+ from sn_objects
+ where object_id = :object_id
+ and context_id = :package_id
+ and (original_author_id = :user_id or
+ [tcl_permission_p ":package_id" ":user_id" "'admin'"] = 't'))
+ "]
+
+ if { !$result && $print_errors_p } {
+ ad_return_forbidden "Not Authorized" \
+ "You are not authorized to change the ownership of this object."
+ }
+
+ return $result
+}
+
+proc_doc km_object_type_private_p {object_type_id} {
+ Checks if an object type is not visible to the public.
+} {
+ set context_id [ad_conn package_id]
+ set result [db_string km_object_type_private_p "
+ select decode(public_p,'t',0,1)
+ from sn_object_types where object_type_id=:object_type_id" -default ""]
+
+ return $result
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-admin-lib-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-admin-lib-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-admin-lib-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,161 @@
+ad_proc km_db_1row_to_list { statement_name sql args } {
+
+ Performs the SQL query $sql. Returns a list of the results.
+
+} {
+ ad_arg_parser { bind } $args
+
+ # Query Dispatcher (OpenACS - ben)
+ set full_statement_name [db_qd_get_fullname $statement_name]
+
+ db_with_handle db {
+ set selection [db_exec 0or1row $db $full_statement_name $sql]
+ }
+
+ if { [empty_string_p $selection] } {
+ return ""
+ }
+
+ set list_to_return ""
+
+ for { set i 0 } { $i < [ns_set size $selection] } { incr i } {
+ lappend list_to_return [ns_set value $selection $i]
+ }
+
+
+ for { set i 0 } { $i < [ns_set size $selection] } { incr i } {
+ upvar 1 [ns_set key $selection $i] value
+ set value [ns_set value $selection $i]
+ }
+
+ return $list_to_return
+}
+
+ad_proc km_db_to_named_list_list { statement_name sql args} {
+ Returns a list of Tcl lists, with each sublist containing the columns returned
+ by the database; if no rows are returned by the database, returns the
+ empty list (empty string in Tcl 7.x and 8.x)"
+} {
+ ad_arg_parser { bind } $args
+
+ # Query Dispatcher (OpenACS )
+ set full_statement_name [db_qd_get_fullname $statement_name]
+
+ db_with_handle db {
+ set selection [db_exec select $db $full_statement_name $sql]
+
+ set keys [list]
+ for {set i 0} {$i<[ns_set size $selection]} {incr i} {
+ lappend keys [ns_set key $selection $i]
+ }
+ set list_to_return [list $keys]
+ while {[ns_db getrow $db $selection]} {
+ set row_list ""
+ set size [ns_set size $selection]
+ set i 0
+ while {$i<$size} {
+ lappend row_list [ns_set value $selection $i]
+ incr i
+ }
+ lappend list_to_return $row_list
+ }
+ }
+
+ return $list_to_return
+}
+
+proc_doc km_new_acs_object_id {} {
+ Returns a new acs_object_id
+} {
+ set result [db_string km_new_acs_object_id "select acs_object_id_seq.nextval from dual"]
+ return $result
+}
+
+proc_doc km_sort_key_list { object_type_id } {
+
+ Returns a list of sort_keys available for this object_type
+ (sort_keys are offered as increments of 10 and should *NEVER* be
+ the same for 2 questions of one object_type)
+
+} {
+ set result ""
+ set existing_keys [db_list km_sort_key_list "select sort_key from
+ sn_question_object_type_map
+ where object_type_id=$object_type_id"]
+ set i 0
+ while { $i < 400 } {
+
+ set i [expr $i + 10]
+ if {[elem_p $i $existing_keys]} {
+ continue
+ } else {
+ lappend result $i
+ }
+ }
+ return $result
+}
+
+ad_proc km_adt_list { { -pretty_names_p 0 } } {
+ Returns a list of abstract data types as a list or as a list of tuples
+ with the pretty name as the second element.
+} {
+ set adts {
+ text option category other_category integer date file composite
+ object_link user_link content_link child_object nephew_object
+ other_category
+ }
+ set pretty_names {
+ Text "Multiple Choice" Category "Category with 'Other' field" Number Date File
+ Composite "Object-Object Link" "Object-User Link" "Object-Content Link"
+ "Child Object Type" "Nephew Object Type"
+
+ }
+
+ if { $pretty_names_p } {
+ return [zip $adts $pretty_names]
+ } else {
+ return $adts
+ }
+}
+
+proc_doc km_pretty_adt { abstract_data_type } {
+ Returns the pretty abstract data type
+} {
+ switch $abstract_data_type {
+ "text" { return Text }
+ "option" { return "Multiple Choice" }
+ "category" { return "Category" }
+ "other_category" { return "Category with 'Other' field" }
+ "date" { return "Date" }
+ "file" { return "Attachment" }
+ "composite" { return "Composite" }
+ "object_link" { return "Object Link" }
+ "user_link" { return "User Link" }
+ "content_link" { return "Content Link" }
+ "child_object" { return "Child Object Type" }
+ "nephew_object" { return "Nephew Object Type" }
+ "integer" { return "Number" }
+ default { return}
+ }
+}
+
+
+proc_doc km_pretty_tag { presentation_type } {
+ Returns the pretty tag name
+} {
+ switch $presentation_type {
+ "shorttext" { return "Short Text" }
+ "text" { return "Short Text" }
+ "textarea" {return "Textarea" }
+ "textarea_with_refs" {return "Textarea with Reference Buttons"}
+ "select" { return Select}
+ "selectmultiple" {return "Select Multiple" }
+ "checkbox" {return "Checkbox"}
+ "radio" {return "Radio Buttons"}
+ "custom" { return "Custom"}
+ "application" { return "Application Form"}
+ default { return }
+ }
+}
+
+
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-branch-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-branch-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-branch-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,319 @@
+# /tcl/km-branch.tcl
+#
+# These procs have to do with the branches to questions. Branches are
+# answer-dependent questions that follow other questions.
+#
+# $Id: km-branch-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+ad_proc km_get_branches {
+ {
+ -question_attributes_p 0
+ -branch_id 0
+ }
+ root_question_id
+ object_type_id
+} {
+ Returns a list of the question_ids directly beneath this question_id in the branch tree. If
+ this question is not a branched question then it returns nothing.
+} {
+
+ set join_tables [list "sn_question_object_type_map m1" "sn_question_object_type_map m2"]
+ set join_clause ""
+ set columns ""
+ set limitation ""
+
+ if { $question_attributes_p } {
+
+ # We need to know the abstract_data_type of the parent question to know
+ # if the answer is stored as an option or as a foreign key in the branch recipe.
+
+ set abstract_data_type [thd [km_get_question $root_question_id $object_type_id]]
+
+ switch $abstract_data_type {
+ "integer" -
+ "text" {
+ append columns ", m1.branch_answer branch_answer"
+ }
+ "category" - "other_category" {
+ append columns ",c.category_id, c.long_name branch_answer"
+ lappend join_tables "categories c"
+ append join_clause " and m1.branch_answer_foreign_key = c.category_id(+)"
+ }
+ "option" {
+ append columns ", ao.option_id, ao.answer_option branch_answer"
+ lappend join_tables "sn_answer_options ao"
+ append join_clause " and m1.branch_answer_foreign_key = ao.option_id(+)"
+ }
+ default { return }
+ }
+ lappend join_tables " sn_questions q"
+ append join_clause " and q.question_id = m1.question_id"
+ append columns ", m1.branch_operator, pretty_name, q.entry_explanation, q.presentation_type, q.abstract_data_type"
+ }
+ if { $branch_id } { set limitation " and m1.question_id = :branch_id " }
+
+ set sql "select m1.question_id $columns from [join $join_tables ","]
+ where m2.question_id = m1.parent_question_id
+ and m1.branch_p = 't'
+ and m1.object_type_id = :object_type_id
+ and m1.parent_question_id = :root_question_id
+ $join_clause $limitation"
+ set result [km_db_to_named_list_list km_get_branches $sql]
+ return $result
+}
+
+proc_doc km_default_branch { root_branch_id } {
+ Returns the default branch of a branch node.
+} {
+ set default_branch [db_string km_default_branch "
+ select default_branch
+ from sn_question_object_type_map qm
+ where question_id=$root_branch_id
+ and (select qm2.branch_p
+ from sn_question_object_type_map qm2
+ where qm2.question_id = qm.default_branch) = 't'" -default ""]
+
+ return $default_branch
+}
+
+proc_doc km_branch_parent { question_id object_type_id } {
+ Returns the parent_question_id of this question iff this is a branch.
+} {
+ set result [db_string km_branch_parent "
+ select parent_question_id
+ from sn_question_object_type_map
+ where question_id=:question_id
+ and branch_p='t'
+ and object_type_id=:object_type_id" -default ""]
+
+ return $result
+}
+
+proc_doc km_composite_parent { question_id object_type_id } {
+ Returns the parent_question_id of this question if this is a composite child.
+} {
+ set result [db_string km_composite_parent "
+ select parent_question_id
+ from sn_question_object_type_map
+ where question_id=:question_id
+ and branch_p='f'
+ and object_type_id=:object_type_id" -default ""]
+ if {$result == [km_static km_dummy_object_id]} {
+ return ""
+ }
+ return $result
+}
+
+proc_doc km_get_root_branch { question_id object_type_id} {
+ Returns the id of the root question of this branch.
+} {
+ set result [db_string km_get_root_branch "
+ select question_id
+ from sn_question_object_type_map
+ where question_id <> :question_id and branch_p='f'
+ start with question_id=:question_id and object_type_id=:object_type_id
+ connect by question_id = prior parent_question_id" -default ""]
+
+ return $result
+}
+
+proc_doc km_root_branch_p { question_id } {
+ Returns true if this question is a root of a branch (at any level)
+} {
+ return [db_string km_root_branch_p {
+ select decode(count(*),0,0,1) from dual where exists
+ (select 1
+ from sn_question_object_type_map
+ where parent_question_id = :question_id and branch_p='t')
+ }]
+}
+
+proc_doc km_composite_child_p { question_id object_type_id } {
+ Returns 1 if this question is the child of a composite question, 0 otherwise.
+ Included here because the distinction between branches and composite children is slight.
+} {
+ set result [db_string km_composite_child_p "
+ select decode(parent_question_id,[km_static km_dummy_object_id],0,1)
+ from sn_question_object_type_map
+ where branch_p='f'
+ and question_id=:question_id
+ and object_type_id=:object_type_id" -default "0"]
+
+ return 0
+}
+
+proc_doc km_active_branch_path { root_question_id object_id object_type_id } {
+
+ Returns the sequence of questions after this root branch question that
+ are part of the active branch path for this object.
+
+} {
+ set branch_id $root_question_id
+ set branch_list {}
+ if ![km_root_branch_p $root_question_id] { return $branch_list }
+
+ # Loop through hierarchy until we reach a leaf node or an unanswered question.
+ set i 0
+ while { 1 == 1 } {
+ # Get object data for the branch_id.
+ set question [km_get_question $branch_id $object_type_id]
+ if [empty_string_p $question] {
+ ns_log Error "Question $branch_id not found in km_active_branch_path"
+ return
+ }
+
+ set answer [fst [km_get_object_data -answers_only_p 0 -questions [list {question_id pretty_name abstract_data_type} $question] $object_id]]
+ set value [fst $answer]
+ set abstract_data_type [lindex $answer 3]
+
+ # Append this question to the list
+ lappend branch_list $branch_id
+
+ if ![km_answered_p $abstract_data_type $value] {
+ # the answer is empty so return the list
+ return $branch_list
+ } else {
+ # Get next branch
+ set branch_id [km_next_branch -abstract_data_type $abstract_data_type $branch_id $value $object_type_id]
+ if [empty_string_p $branch_id ] { return $branch_list }
+ }
+
+ incr i
+ if { $i > 100 } {
+ ns_log Error "Endless loop in km_active_branch_path"
+ return
+ }
+ }
+}
+
+proc_doc km_active_path_p { question_id object_id object_type_id } {
+
+ Returns 1 if this question is on an active branch path or is not on a branch at all.
+ Returns 0 if this question is not on a central branch path (i.e. it is decoupled
+ from the normal question sequence)
+
+} {
+ set root_question_id [km_get_root_branch $question_id $object_type_id]
+ if [empty_string_p $root_question_id] { return 1 }
+
+ set active_branches [km_active_branch_path $root_question_id $object_id $object_type_id]
+ if [elem_p $question_id $active_branches] {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+ad_proc km_next_branch { { -abstract_data_type "" } root_branch_id answer object_type_id } {
+
+ Returns the question_id that should follow this question as a result of
+ the answers. It returns the default question if the answer hasn't been matched or is empty.
+ If it can't figure out the next question it returns nothing.
+
+} {
+ if [empty_string_p $abstract_data_type] {
+ set abstract_data_type [km_static question_abstract_data_type $root_branch_id]
+ }
+
+ # If it's not one of these abstract data types then this proc should never have been called!
+ if { [lsearch {"category" "other_category" "option"} $abstract_data_type] >= 0 } {
+
+ # Data answers are always tuples - we need the first value of the first pair
+ set answer [fst [fst $answer]]
+
+ # Then the answer is the integer value of the option, a foreign key
+ set column "branch_answer_foreign_key"
+
+ if { [empty_string_p $answer] || ![integer_p $answer] } { return }
+
+ } elseif { [lsearch {"text" "integer"} $abstract_data_type] >= 0 } {
+ set column "branch_answer"
+ set answer [fst $answer]
+ if { [empty_string_p $answer] || ![integer_p $answer] } { return }
+ } else {
+ return ""
+ }
+
+ set default_branch [km_default_branch $root_branch_id]
+
+ set branches [db_list_of_lists km_next_branch "
+ select question_id, branch_operator, $column
+ from sn_question_object_type_map
+ where parent_question_id=$root_branch_id
+ and object_type_id=$object_type_id"]
+
+ # Go through each of the branches and see if the operator matches this value
+ foreach branch $branches {
+ set branch_id [fst $branch]
+ set operator [snd $branch]
+ set branch_answer [thd $branch]
+
+ if [eval_binary $operator $answer $branch_answer] { return $branch_id }
+ }
+
+ return $default_branch
+}
+
+proc km_pretty_operator { operator } {
+ switch $operator {
+ "=" { return "Equals =" }
+ "<" { return "Less Than <" }
+ ">" { return "Greater Than >" }
+ default { return }
+ }
+}
+
+ad_proc km_branch_questions {
+ {
+ -branch_id 0
+ -all_properties_p 1
+ -root_question_id 0
+ -composite_children_p 1
+ }
+ object_type_id
+} {
+
+ This proc returns keyed question lists with attributes on the basis of variable branch
+ properties. i.e. It can return a list that shows all questions of an object_type that
+ are NOT branches, or these plus the one that IS this branch_id.
+
+ This proc has become more a general admin questions list, since it can do some stuff
+ for composite questions, too.
+
+} {
+ if { $all_properties_p } {
+ set additional_columns ",presentation_type, tag_height, tag_width, entry_explanation, qm.mandatory_p, qm.question_state, qm.form_number, qm.sort_key "
+ }
+
+ set limitation "parent_question_id=[km_static km_dummy_object_id] and question_state <> 'invisible'"
+ set counter 1
+
+ if { $root_question_id } {
+ append limitation " and qm.question_id != :root_question_id"
+ incr counter
+ }
+ if { $branch_id } {
+ append limitation " or qm.question_id = :branch_id "
+ incr counter
+ }
+ if { $counter > 1 } {
+ set limitation " and ($limitation)"
+ } else {
+ set limitation " and $limitation"
+ }
+ if { $composite_children_p } {
+ append limitation "
+and q.abstract_data_type in ('text', 'option', 'category', 'other_category', 'date', 'file', 'integer', 'object_link', 'content_link', 'user_link', 'child_object', 'nephew_object')
+and q.question_id not in (select parent_question_id from sn_question_object_type_map where object_type_id=:object_type_id and branch_p='t')"
+ }
+ set result [km_db_to_named_list_list km_branch_questions "
+ select q.question_id, q.pretty_name, q.abstract_data_type
+ $additional_columns
+ from sn_questions q, sn_question_object_type_map qm
+ where q.question_id=qm.question_id
+ and qm.object_type_id = :object_type_id
+ $limitation
+ order by qm.sort_key"]
+
+ return $result
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-browse-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-browse-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-browse-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,375 @@
+# /tcl/km-browsing.tcl
+#
+# Browsing of knowledge objects.
+# Created by carsten@arsdigita.com in June 2000
+#
+# $Id: km-browse-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+proc_doc km_ancestors_context_list {ancestors {category_id ""} {pre_url ""}} {
+
+ Get a list of links to the parent objects, plus a link
+ to the root parent's object type.
+
+} {
+ set root_object_id [fst [fst $ancestors]]
+
+ db_1row get_root_info {
+ select o.one_line_description as ancestor_name,
+ o.object_type_id as ancestor_object_type_id,
+ ot.pretty_plural as ancestor_object_type,
+ o.archived_p as ancestor_archived_p
+ from sn_objects o, sn_object_types ot
+ where o.object_id = :root_object_id
+ and ot.object_type_id = o.object_type_id
+ }
+
+ if {$ancestor_archived_p == "t"} {
+ set ancestor_object_type "$ancestor_object_type (Archived)"
+ set archive t
+ }
+ lappend result [list "${pre_url}browse-one-type?[export_vars [list [list object_type_id $ancestor_object_type_id] archive]]" $ancestor_object_type]
+
+ if {![empty_string_p $category_id] && $category_id != "none"} {
+ if {[db_string is_object_of_category {select count(*) from sw_object_category_map where category_id = :category_id and object_id = :root_object_id}] > 0} {
+ lappend result [list "${pre_url}browse-one-category?[export_vars [list [list object_type_id $ancestor_object_type_id] category_id archive]]" [km_category_name $category_id]]
+ }
+ }
+
+ foreach ancestor $ancestors {
+ set name [sn_striphtml [snd $ancestor]]
+ if {[empty_string_p $name]} {
+ set name "Unnamed [km_static object_type_pretty_name [thd $ancestor]]"
+ }
+ lappend result [list "${pre_url}object-view?object_id=[fst $ancestor]&category_id=$category_id" $name]
+ }
+
+ return $result
+}
+
+proc_doc km_sort_by_bar { sort_by child_type_p } {
+ Sort: Object name | Modification date
+} {
+ set sort_by_list {{name "name"} {last_modified "modification date"}}
+ lappend sort_by_list {average_rating "user rating"}
+ if { $child_type_p } { lappend sort_by_list {parent "parent object"} }
+
+ foreach sort_item $sort_by_list {
+ set sort_column [lindex $sort_item 0]
+ set sort_description [lindex $sort_item 1]
+
+ if {$sort_column == $sort_by} {
+ lappend sort_text "<b>$sort_description</b>"
+ } else {
+ lappend sort_text "<a href=\"[ns_conn url]?[export_ns_set_vars url {sort_by}]&sort_by=$sort_column\">$sort_description</a>"
+ }
+ }
+
+ return "\[ [join [concat $sort_text] " | "] \]"
+}
+
+proc_doc km_category_display_limit {} {
+
+ If the object list contains more than this many objects,
+ no categorization will be shown.
+
+} {
+ return [ad_parameter CategoryDisplayLimit library 20]
+}
+
+ad_proc km8_output_object_list {
+ {
+ -object_type_id 0
+ -header ""
+ -current_action ""
+ -path_id ""
+ -pool all
+ -age all
+ -sort_by ""
+ -show short
+ -category_id ""
+ -question_id 0
+ -where_clauses {}
+ -minus_join_tables {}
+ -minus_where_clauses {}
+ -first_row 0
+ -last_row 0
+ -begin_letter ""
+ -archived "f"
+ -start_date ""
+ -end_date ""
+ -more_join_tables {}
+ }
+} {
+
+ Output a list of objects.
+
+} {
+ ! Entered km8_output_object_list +more_join_tables
+ set user_id [ad_conn user_id]
+ set package_id [ad_conn package_id]
+ set instance_read_p [ad_permission_p $package_id "read"]
+
+ template::multirow create object_list public_p archived_p review_p object_view_link object_name user_link last_modified number_ratings rating_avg rating_avg_img rating_max rating_max_img access_total access_month overview categories_html
+
+ set child_type_p [db_string km_output_object_list_1 "
+ select decode(count(*),0,0,1) from sn_questions
+ where abstract_data_type in ('child_object','nephew_object')
+ and target_object_type_id = :object_type_id"]
+
+ # If the user is linking, or adding a SN reference,
+ # we add a button to each object.
+
+ # Make sure the user cannot see expired or private objects.
+ # Exceptions: Administrators, Sharenet Managers, and users who have been granted
+ # view permission for the object.
+
+ set join_tables [list "sn_objects obj"]
+
+ set package_id [ad_conn package_id]
+ lappend where_clauses \
+ "obj.expiration_date > sysdate" \
+ "obj.object_type_id = :object_type_id" \
+ "obj.context_id = :package_id" \
+ "obj.archived_p = :archived"
+
+ if { !$instance_read_p && $pool == "all" } {
+ # Only count published objects, or objects for which the user
+ # has view permission.
+
+ # Note that we only check direct read permission on flat
+ # groups and users. Since the context_id of private objects is
+ # NULL, and we only grant permissions to private groups, this
+ # is sufficient.
+
+ lappend where_clauses \
+ "(obj.public_p = 't' or obj.object_id in (
+ select object_id from acs_permissions
+ where (grantee_id = :user_id
+ or grantee_id in (select group_id from membership_rels
+ where person_id = :user_id))
+ and privilege = 'read'))"
+ }
+
+ if { [string compare $age all] != 0 } {
+ # Filter by time of last modification.
+ lappend where_clauses "sysdate - obj.last_modified < :age"
+ }
+
+ # Filter by author and co-owners.
+ switch $pool {
+ own { lappend where_clauses "obj.original_author_id = :user_id" }
+ coown {
+ lappend join_tables "acs_permissions p"
+
+ lappend where_clauses \
+ "obj.object_id = p.object_id" \
+ "p.privilege = 'write'" \
+ "(p.grantee_id = :user_id
+ or p.grantee_id in (select group_id from membership_rels where person_id = :user_id))"
+ }
+ }
+
+ # Sort by time of last modification or by name.
+ set columns {1}
+ switch $sort_by {
+ average_rating {
+ set sort_by_clause "nvl(cr.rating_sum,0) / nvl(cr.rating_count,1) desc, obj.last_modified desc"
+ set sort_by_clause2 "rating_avg desc, last_modified desc"
+ }
+ last_modified {
+ set sort_by_clause "obj.last_modified desc, lower(obj.one_line_description)"
+ set sort_by_clause2 "last_modified desc, lower(name)"
+ }
+ name {
+ set sort_by_clause "lower(obj.one_line_description), obj.last_modified desc"
+ set sort_by_clause2 "lower(name), last_modified desc"
+ }
+ parent {
+ set sort_by_clause "lower(obj2.one_line_description), lower(obj.one_line_description), obj.last_modified desc"
+ set sort_by_clause2 "lower(parent_name), lower(name), last_modified desc"
+
+ lappend columns "obj2.one_line_description as parent_name"
+ lappend join_tables "km_flat_object_hierarchy fo" "sn_objects obj2"
+ lappend where_clauses \
+ "fo.child(+) = obj.object_id" \
+ "(fo.distance = 1 or fo.distance is null)" \
+ "fo.parent = obj2.object_id(+)"
+ }
+ default {
+ set sort_by_clause "$sort_by, obj.last_modified desc"
+ set sort_by_clause2 "$sort_by, last_modified desc"
+ }
+ }
+
+ if { ![string equal $begin_letter all] } {
+ if { ![string equal $begin_letter other] } {
+ lappend where_clauses "substr(upper(obj.one_line_description),1,1) = '[string toupper $begin_letter]'"
+ } else {
+ lappend where_clauses "(substr(upper(obj.one_line_description),1,1) < 'A' or substr(upper(obj.one_line_description),1,1) > 'Z')"
+ }
+ }
+
+ if { ![empty_string_p $start_date] && ![empty_string_p $end_date]} {
+ lappend where_clauses "obj.start_date <= :end_date" "obj.end_date >= :start_date"
+ }
+
+ set join_tables [concat $join_tables $more_join_tables]
+
+ # We first need to get the number of listed objects, because
+ # depending on this number, we will or will not display object
+ # categorization.
+
+ ! Get the number of listed objects
+ set num_found_objects [db_string count_all_objects "
+ select count(unique obj.object_id)
+ from [join $join_tables ", "]
+ where [join $where_clauses "\nand "]"]
+ ! Got the number of listed objects +num_found_objects
+
+ if { ![null_p $minus_join_tables] } {
+ ! Get the number of excluded objects
+ set num_excluded_objects [db_string count_excluded_objects "
+ select count(unique obj.object_id)
+ from [join [concat $join_tables $minus_join_tables] ", "]
+ where [join [concat $where_clauses $minus_where_clauses] "\nand "]"]
+ ! Got the number of excluded objects +num_excluded_objects
+
+ set num_found_objects [expr $num_found_objects - $num_excluded_objects]
+ }
+
+ if { $child_type_p } {
+ lappend columns "km_utilities.km_ancestor_list(obj.object_id) as ancestors"
+ }
+
+ set display_limit [km_category_display_limit]
+ set category_questions {}
+ if { $num_found_objects < $display_limit } {
+ # Get node_id, category, question_id, question_pretty_name.
+ set category_questions [km_node_question_list $object_type_id]
+
+ foreach category_tuple $category_questions {
+ set root_node_id [fst $category_tuple]
+ lappend columns "km_utilities.km_category_list(obj.object_id, $root_node_id) as cat$root_node_id"
+ }
+ }
+
+ if { [null_p $minus_join_tables] } {
+ set sql "
+ select * from (select obj.object_id,
+ decode(obj.public_p,'t',1,0) as public_p,
+ decode(obj.archived_p,'t',1,0) as archived_p,
+ decode(obj.in_review_p,'t',1,0) as review_p,
+ u.first_names || ' ' || u.last_name as owner, u.user_id as owner_id,
+ obj.one_line_description as name, obj.overview,
+ decode(obj.overview_html_p,'t',1,0) as overview_html_p,
+ obj.last_modified, nvl(obj.access_total,0) as access_total,
+ nvl(obj.access_month,0) as access_month,
+ round(nvl(cr.rating_sum,0) / nvl(cr.rating_count,1),1) as rating_avg,
+ nvl(cr.rating_max,0) as rating_max,
+ nvl(cr.rating_count,0) as number_ratings,
+ dense_rank() over (order by $sort_by_clause) dr,
+ [join $columns ", "]
+ from [join $join_tables ", "], sn_comments_ratings cr, users u
+ where u.user_id = obj.original_author_id
+ and cr.object_id(+) = obj.object_id
+ and [join $where_clauses "\nand "])
+ where dr >= :first_row and (:last_row = 0 or dr <= :last_row)
+ order by $sort_by_clause2"
+ } else {
+ # This will be a bit complicated. We were called from browse-one-category
+ # to display a list of uncategorized objects. The fastest way to do this
+ # is with a MINUS, using only the object_id column. We then join the result
+ # with the query we would normally use to get the data we want.
+
+ set sql "
+select * from (select obj.object_id,
+ decode(obj.public_p,'t',1,0) as public_p,
+ decode(obj.archived_p,'t',1,0) as archived_p,
+ decode(obj.in_review_p,'t',1,0) as review_p,
+ u.first_names || ' ' || u.last_name as owner, u.user_id as owner_id,
+ obj.one_line_description as name, obj.overview,
+ decode(obj.overview_html_p,'t',1,0) as overview_html_p,
+ obj.last_modified, nvl(obj.access_total,0) as access_total,
+ nvl(obj.access_month,0) as access_month,
+ round(nvl(cr.rating_sum,0) / nvl(cr.rating_count,1),1) as rating_avg,
+ nvl(cr.rating_max,0) as rating_max,
+ nvl(cr.rating_count,0) as number_ratings,
+ dense_rank() over (order by $sort_by_clause) dr,
+ [join $columns ", "]
+from [join $join_tables ", "], sn_comments_ratings cr, users u,
+ (select obj.object_id
+ from [join $join_tables ", "]
+ where [join $where_clauses "\nand "]
+ minus
+ select /*+ORDERED*/ obj.object_id
+ from [join [concat $join_tables $minus_join_tables] ", "]
+ where [join [concat $where_clauses $minus_where_clauses] "\nand "]) filtered
+where u.user_id = obj.original_author_id
+ and cr.object_id(+) = obj.object_id
+ and obj.object_id = filtered.object_id)
+where dr >= :first_row and (:last_row = 0 or dr <= :last_row)
+order by $sort_by_clause2"
+ }
+
+ # We pass use a path to pass a couple of values to object-view,
+ # so they can be used as return URLs. (This is important because
+ # we want to preserve the user's filter and sort settings.)
+
+ set value_list [list browse_type [export_url_vars pool age sort_by show begin_letter]]
+ set parameters ""
+ if { ![empty_string_p $category_id] } {
+ set value_list [concat $value_list [list browse_category [export_url_vars pool age sort_by show begin_letter question_id column_name]]]
+ set parameters "&category_id=$category_id"
+ }
+ set new_path_id [init_path -last_path_id $path_id $value_list "" "browse"]
+
+ ! Getting the object list
+ set old_rank "0"
+ db_foreach get_object_list $sql {
+ ## filter out duplicate rows with the same dense_rank than the row
+ ## before
+ if {$dr == $old_rank} {
+ continue
+ }
+ set old_rank $dr
+ set categories_html ""
+
+ # Display the object's parent.
+ if { $child_type_p && ![empty_string_p $ancestors] } {
+ append categories_html "Related Objects: "
+ foreach ancestor $ancestors {
+ append categories_html "<a href=\"object-view?object_id=[fst $ancestor]\">[snd $ancestor]</a>; "
+ }
+ set categories_html [string range $categories_html 0 end-2]
+ }
+
+ if { $num_found_objects <= $display_limit && ![null_p $category_questions] } {
+ # List the object's categories.
+ foreach category_pair $category_questions {
+ set root_node_id [fst $category_pair]
+ set question_name [lindex $category_pair 3]
+ set category_value [set cat$root_node_id]
+
+ if ![empty_string_p $category_value] {
+ if ![empty_string_p $categories_html] { append categories_html "; " }
+ append categories_html "$question_name: $category_value"
+ }
+ }
+ }
+
+ if ![empty_string_p $overview] {
+ set overview [util_trim_string_with_hrefs [sn_striphtml $overview]]
+ }
+
+ if [empty_string_p $name] {
+ set name "Unnamed [km_static object_type_pretty_name $object_type_id]"
+ }
+
+ set object_view_link "object-view?object_id=$object_id$parameters&path_id=$new_path_id"
+ template::multirow append object_list $public_p $archived_p $review_p $object_view_link [sn_striphtml $name] [ad_present_user $owner_id $owner] [util_AnsiDatetoPrettyDate $last_modified] $number_ratings $rating_avg [gf_feedback_points_img $rating_avg 5] $rating_max [gf_feedback_points_img $rating_max 5] $access_total $access_month $overview $categories_html
+ }
+ ! Got the object list
+
+ ! Exiting km8_output_object_list
+ return $num_found_objects
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-callback-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-callback-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,200 @@
+# /tcl/km-callback-procs.tcl
+#
+# Procs called from other modules.
+#
+# @author Carsten Clasohm (carsten@arsdigita.de)
+# @creation-date 2001-10-10
+# @cvs-id $Id: km-callback-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+ad_proc -public library_post_instantiation {
+ package_id
+} {
+ This is the TCL proc that is called automatically by the APM
+ whenever a new instance of the application is created.
+} {
+ sn_community::grant_role_permissions $package_id {
+ maintainer {access create km_publish}
+ member {access create}
+ guest {access}
+ }
+ db_exec_plsql create_magic_psn_category_objects {
+ begin
+ psn_res_application.create_magic_objects (
+ package_id => :package_id
+ );
+ end;
+ }
+}
+
+ad_proc -public library_supported_privileges {} {
+
+ Returns a list of instance-level privileges supported by the Library.
+ Used by sn-communities to set permissions for role groups.
+
+} {
+ return {
+ {admin "Administer"}
+ {access "Access"}
+ {create "Create new objects"}
+ {read "Read private objects"}
+ {write "Edit all objects"}
+ {delete "Delete all objects"}
+ {km_publish "Publish an object if approval process is true"}
+ }
+}
+
+ad_proc -public library_copy_data {source_package_id target_package_id} {
+ Copy object type structure to the target package.
+} {
+ set ip_address [ns_conn peeraddr]
+ set user_id [ad_get_user_id]
+
+ db_exec_plsql copy_all_object_types {
+ begin
+ library.copy (
+ src_package_id => :source_package_id,
+ dst_package_id => :target_package_id,
+ creation_user => :user_id,
+ creation_ip => :ip_address);
+ end;
+ }
+}
+
+ad_proc -public library_get_category_trees {package_id} {
+
+ Returns a list of all category trees used by this instance.
+ Used during community copying, to grant permissions on the trees.
+
+} {
+
+ return [db_list get_categories {
+ -- Categories used for object type questions.
+ select tree_id
+ from sn_object_types ot, sn_question_object_type_map qm, sn_questions q
+ where ot.context_id = :package_id
+ and qm.object_type_id = ot.object_type_id
+ and q.question_id = qm.question_id
+ and q.abstract_data_type in ('category', 'other_category')
+ and q.tree_id is not null
+ union
+ -- Categories used for object feedback.
+ select object_id_two
+ from acs_rels
+ where rel_type = 'object_category_tree_rel'
+ and object_id_one = :package_id
+ union
+ -- Categories used on the PeopleShareNet application form.
+ select object_id_two
+ from acs_rels r, psn_category_trees ct
+ where r.rel_type = 'object_category_tree_rel'
+ and ct.package_id = :package_id
+ and (r.object_id_one = ct.role_magic_id
+ or r.object_id_one = ct.language_magic_id
+ or r.object_id_one = ct.proficiency_magic_id)
+
+ }]
+
+}
+
+namespace eval categories::packages::library {
+ ad_proc -public get_instances { tree_id } {
+ Returns a list of all library instances using a certain category tree
+ } {
+ set instance_list [list]
+ set user_id [ad_conn user_id]
+
+ db_foreach get_library_instances_for_tree {
+ select v.object_id, p.instance_name, v.object_name,
+ ci.community_id, p2.instance_name as community_name,
+ acs_permission.permission_p(p.package_id, :user_id, 'access') as show_p
+ from apm_packages p, apm_packages p2, sn_community_instances_all ci,
+ (select distinct q.question_id, ot.object_type_id as object_id,
+ ot.pretty_plural || ' (Question "' || q.pretty_name || '")' as object_name,
+ ot.context_id as package_id
+ from sn_object_types ot, sn_questions q,
+ sn_question_object_type_map qm, sw_category_dim d
+ where d.parent_node_id = q.node_id
+ and d.tree_id = :tree_id
+ and q.question_id = qm.question_id
+ and qm.object_type_id = ot.object_type_id
+ union
+ select 0 as question_id, p.package_id as object_id,
+ 'Feedback' as object_name, p.package_id
+ from acs_rels r, apm_packages p
+ where r.object_id_two = :tree_id
+ and r.rel_type = 'object_category_tree_rel'
+ and r.object_id_one = p.package_id
+ and p.package_key = 'library') v
+ where p.package_id = v.package_id
+ and ci.package_id = v.package_id
+ and p2.package_id = ci.community_id
+ order by p2.instance_name, p.instance_name, v.object_name
+ } {
+ lappend instance_list [list Libraries $object_id $object_name $instance_name $community_id $community_name $show_p $show_p]
+ }
+ return $instance_list
+ }
+}
+
+namespace eval sn_presentation::types::sn_object {
+ ad_proc linkable_item {object_id url object_data_var} {
+ upvar 1 $object_data_var object_data
+
+ set public_p 0
+ if { [string first "presentation=public" $object_data(presentation)] != -1 } {
+ set public_p 1
+ }
+ set archived_p 0
+ if { [string first "archived" $object_data(presentation)] != -1 } {
+ set archived_p 1
+ }
+ set in_review_p 0
+ if { [string first "in_review" $object_data(presentation)] != -1 } {
+ set in_review_p 1
+ }
+
+ set result "<a href=\"[ad_quotehtml $url]\">[sn_striphtml $object_data(name)]</a>"
+ if { !$public_p } { append result " <font color=\"red\">\[Private\]</font>" }
+ if { $archived_p } { append result " <font color=\"red\">\[Archived\]</font>" }
+ if { $in_review_p } { append result " <font color=\"green\">\[In review\]</font>" }
+ return $result
+ }
+
+ ad_proc item {object_id object_data_var} {
+ upvar 1 $object_data_var object_data
+
+ set public_p 0
+ if { [string first "presentation=public" $object_data(presentation)] != -1 } {
+ set public_p 1
+ }
+ set archived_p 0
+ if { [string first "archived" $object_data(presentation)] != -1 } {
+ set archived_p 1
+ }
+ set in_review_p 0
+ if { [string first "in_review" $object_data(presentation)] != -1 } {
+ set in_review_p 1
+ }
+
+ set result [sn_striphtml $object_data(name)]
+ if { !$public_p } { append result " <font color=\"red\">\[Private\]</font>" }
+ if { $archived_p } { append result " <font color=\"red\">\[Archived\]</font>" }
+ if { $in_review_p } { append result " <font color=\"green\">\[In review\]</font>" }
+ return $result
+ }
+}
+
+namespace eval alerts {
+ namespace eval types {
+ namespace eval sn_object {
+ ad_proc -public get_object {object_id} {
+ } {
+ if { [catch { set object_as_clob [db_string object_public_object_clob \
+ {select site_wide_search.indexed_content(:object_id) from dual}]} errmsg] } {
+ return [list "" 0]
+ }
+ return [list $object_as_clob 0]
+ }
+ }
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-categories-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-categories-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-categories-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,876 @@
+# /tcl/km-categories.tcl
+#
+# Categorization of knowledge objects.
+#
+# Created by carsten@arsdigita.com in June 2000
+#
+# Modified by tvujec@arsdigita.com in August 2001
+#
+# $Id: km-categories-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+# Category hierarchy
+#
+# location <question_name> [Placeholder]
+# Global <real category> [Location]
+
+ad_proc km_category_table {
+ {
+ -object_type_id 0
+ -question_id 0
+ -parent_node_id 0
+ -uncategorized_p 1
+ -target {}
+ -category_counts {}
+ -maximum_sub_columns 1
+ }
+} {
+
+ Generate the table of links for a category tree. Returns 0 if
+ the table is empty, otherwise returns a non-zero integer.
+
+} {
+ template::multirow create categorization_widget category target category_id sum_count parent_node_id question_id
+ template::multirow create categorization_widget_header header_name
+ if { !$parent_node_id } {
+
+ # If no parent categories have been specified, we get all the
+ # categories that can be associated with the given object type
+ # and question.
+
+ set questions [db_list_of_lists get_category_questions {
+ select q.question_id, q.node_id, q.pretty_name
+ from sn_questions q, sn_question_object_type_map qm
+ where qm.object_type_id = :object_type_id
+ and qm.question_id = q.question_id
+ and qm.question_state <> 'invisible'
+ and q.browse_p = 't'
+ and q.abstract_data_type in ('category','other_category')
+ order by qm.sort_key}]
+
+ if [null_p $questions] { return 0 }
+ } else {
+ set pretty_question [db_string get_pretty_question {
+ select pretty_name
+ from sn_questions
+ where question_id = :question_id}]
+ set questions [list [list $question_id $parent_node_id $pretty_question]]
+ }
+
+ set category_list {}
+ foreach question $questions {
+ # For each of the parent categories we display the child categories.
+
+ set question_id [fst $question]
+ set parent_node_id [snd $question]
+ set pretty_question [thd $question]
+
+ if { $uncategorized_p && ![empty_string_p $category_counts] } {
+ set uncategorized_target "${target}none&question_id=$question_id"
+ set uncategorized_count [ns_set get $category_counts "uncat $question_id"]
+ } else {
+ set uncategorized_target ""
+ set uncategorized_count 0
+ }
+
+ set elem [km8_categorization_widget \
+ -uncategorized_p $uncategorized_p \
+ -parent_node_id $parent_node_id -target $target \
+ -question_id $question_id \
+ -category_count $category_counts \
+ -uncategorized_target $uncategorized_target \
+ -uncategorized_count $uncategorized_count \
+ -maximum_columns $maximum_sub_columns]
+
+ if ![null_p $elem] {
+ lappend category_list [list $pretty_question $elem]
+ }
+ }
+
+ set n_total 0
+ set i 0
+ set category_type_count [llength $category_list]
+ while { $i < $category_type_count } {
+ template::multirow append categorization_widget_header [fst [lindex $category_list $i]]
+ incr i
+ }
+
+ return $i
+}
+
+proc_doc km_get_child_categories {question_id} {
+
+ Returns all the categories associated with the given question
+ as a list of tuples holding the category_id and the indented
+ category name.
+
+} {
+ set root_node_id [db_string get_node_id {
+ select node_id from sn_questions
+ where question_id = :question_id
+ }]
+
+ if ![empty_string_p $root_node_id] {
+ set result [util_memoize "swc_get_category_tree $root_node_id 0 {}"]
+ } else {
+ set result {}
+ }
+
+ return $result
+}
+
+proc_doc km_get_node_id {question_id} {
+
+ Returns the node_id for this question_id or an empty string.
+
+} {
+ set result [db_string km_get_category_id "
+ select node_id from sn_questions where question_id=:question_id" -default ""]
+ return $result
+}
+
+proc_doc km_categorize_object { question_id object_id category_ids } {
+
+ Inserts a row into the sw_object_category_map which maps each
+ object to a list of categories.
+
+ Also takes care of removing old categorizations which are of the same type
+ as the given category_ids.
+
+ Returns a list of 1 for each successfully inserted and 0 for each
+ failed category_id.
+
+} {
+ foreach category_id $category_ids {
+ if ![empty_string_p $category_id] {
+ lappend nonempty_category_ids $category_id
+ }
+ }
+ if {![info exists nonempty_category_ids]} {
+ km_uncategorize_object $object_id $question_id
+ return
+ }
+ set category_ids $nonempty_category_ids
+
+ set user_id [ad_conn user_id]
+ set ip_address [ns_conn peeraddr]
+
+ db_transaction {
+ # First get rid of any old categorizations of this object
+ # that belongs to the same question.
+
+ db_dml uncategorize {
+ delete from sw_object_category_map
+ where object_id = :object_id
+ and category_id in (select child_category_id from sw_flat_cat
+ where parent = (select node_id from sn_questions
+ where question_id = :question_id))
+ }
+
+ # Insert the new categorization.
+ # The insert query gracefully ignores duplicate categorization.
+
+ foreach category_id $category_ids {
+ db_dml categorize {
+ insert into sw_object_category_map (object_id, category_id)
+ select :object_id, :category_id
+ from dual
+ where not exists (select 1 from sw_object_category_map
+ where object_id = :object_id
+ and category_id = :category_id)
+ }
+ }
+
+ db_exec_plsql last_modified {
+ begin
+ acs_object.last_modified (
+ v_object_id => :object_id,
+ v_modifying_user => :user_id,
+ v_modifying_ip => :ip_address
+ );
+ end;
+ }
+
+ set pretty_categories [db_list km_categorize_object_50 "
+ select long_name from categories
+ where category_id in ([join $category_ids ","])"]
+
+ if { [llength $pretty_categories] > 1 } {
+ set label "categories"
+ } else {
+ set label "category"
+ }
+
+ set content "Set $label [DoubleApos [join $pretty_categories ", "]]."
+ db_exec_plsql km_categorize_object_6 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+ }
+
+ # After the user has changed the categorization of an object, we
+ # want to give him up-to-date category counts. So we flush the
+ # memoized km_get_category_count results for him.
+ km_flush_category_count -object_id $object_id
+}
+
+ad_proc km_flush_category_count {
+ {
+ -object_id 0
+ -object_type_id 0
+ -user_id 0
+ -local 0
+ }
+} {
+ Clears the cached category count for the current user.
+ Note that we only flush for "begin_letter all". Flushing
+ for all letters would take too much time.
+} {
+ if !$user_id { set user_id [ad_conn user_id] }
+ if !$object_type_id { set object_type_id [km_get_object_type $object_id] }
+
+ if !$local {
+ server_cluster_httpget_from_peers "/SYSTEM/flush-category-count.tcl?[export_url_vars object_type_id user_id]"
+ }
+
+ foreach pool {all own coown} {
+ foreach age {90 180 365 730 all} {
+ foreach archived {t f} {
+ util_memoize_flush_local "km_get_category_count_internal -age $age -pool $pool -begin_letter all -archived $archived $object_type_id $user_id"
+ }
+ }
+ }
+}
+
+ad_proc km_uncategorize_object { object_id question_id } {
+
+ Removes all categorization of this object for this question.
+ This is used for non-mandatory fields were the user hasn't selected
+ any categories.
+
+} {
+ db_transaction {
+ db_dml uncategorize {
+ delete from sw_object_category_map
+ where object_id = :object_id
+ and category_id in (select child_category_id from sw_flat_cat
+ where parent = (select node_id from sn_questions
+ where question_id = :question_id))
+ }
+
+ set user_id [ad_conn user_id]
+ set ip_address [ns_conn peeraddr]
+
+ db_exec_plsql km_uncategorize_object_10 {
+ begin
+ acs_object.last_modified (
+ v_object_id => :object_id,
+ v_modifying_user => :user_id,
+ v_modifying_ip => :ip_address
+ );
+ end;
+ }
+
+ set content "Deleted all categories."
+ set ip_address [ns_conn peeraddr]
+ db_exec_plsql km_uncategorize_object_3 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+ }
+
+ km_flush_category_count -object_id $object_id
+}
+
+ad_proc km_get_categories {object_id question_id } {
+ Returns a list of {category_id category} mapped to this object and this question.
+} {
+ return [db_list_of_lists get_categories {
+ select c.category_id, c.long_name
+ from categories c, sw_flat_cat fc, sw_object_category_map cm, sn_questions q
+ where cm.object_id = :object_id
+ and q.question_id = :question_id
+ and fc.parent = q.node_id
+ and c.category_id = fc.child_category_id
+ and cm.category_id = c.category_id
+ }]
+}
+
+ad_proc km_get_category_counts {
+ {
+ -age "all"
+ -pool "all"
+ -begin_letter "all"
+ -start_category_id 0
+ -archived "f"
+ -start_date ""
+ -end_date ""
+ }
+ object_type_id result
+} {
+
+ Returns the count of number of objects as a new ns_set.
+ Caches things for a few minutes.
+
+} {
+ set category_count_timeout [ad_parameter CategoryCountTimeout library 300]
+ set user_id [ad_conn user_id]
+
+ set category_count_list [util_memoize "km_get_category_count_internal -age $age -pool $pool -begin_letter $begin_letter -start_category_id $start_category_id -archived $archived -start_date $start_date -end_date $end_date $object_type_id $user_id" $category_count_timeout]
+
+ foreach elem $category_count_list {
+ ns_set put $result [lindex $elem 0] [lindex $elem 1]
+ }
+
+ return $result
+}
+
+ad_proc km_get_category_count_internal {
+ {
+ -age "all"
+ -pool "all"
+ -begin_letter "all"
+ -start_category_id 0
+ -archived "f"
+ -start_date ""
+ -end_date ""
+ }
+ object_type_id user_id
+} {
+
+ Counts the number of objects the user can view, grouped by
+ category. (Internal version.)
+
+} {
+ ! We're not caching. Entering km_get_category_count_internal
+ set package_id [ad_conn package_id]
+ set instance_read_p [ad_permission_p $package_id "read"]
+
+ set category_count_list {}
+
+ lappend where_clauses \
+ "o.object_type_id = :object_type_id" \
+ "o.context_id = :package_id" \
+ "o.expiration_date > sysdate" \
+ "o.archived_p = :archived"
+
+ set tables "sw_category_dim swcd, sw_flat_cat fc, sw_object_category_map swcm, sn_objects o"
+ set total_tables "sn_objects o"
+ if { !$instance_read_p && $pool == "all" } {
+ # Only count published objects, or objects for which the user
+ # has view permission.
+
+ # Note that we only check direct read permission on flat
+ # groups and users. Since the context_id of private objects is
+ # NULL, and we only grant permissions to private groups, this
+ # is sufficient.
+
+ lappend where_clauses \
+ "(o.public_p = 't' or o.object_id in (
+ select object_id from acs_permissions
+ where (grantee_id = :user_id
+ or grantee_id in (select group_id from membership_rels
+ where person_id = :user_id))
+ and privilege = 'read'))"
+ }
+
+ if { $age != "all" } { lappend where_clauses "sysdate - o.last_modified < :age" }
+
+ # Filter by author.
+ switch $pool {
+ own {
+ lappend where_clauses "o.original_author_id = :user_id"
+ }
+ coown {
+ set tables "(select group_id as grantee_id from membership_rels where person_id = :user_id union select $user_id as grantee_id from dual) g, acs_permissions p, sn_objects o, sw_object_category_map swcm, sw_flat_cat fc, sw_category_dim swcd"
+ set total_tables "(select group_id as grantee_id from membership_rels where person_id = :user_id union select $user_id as grantee_id from dual) g, acs_permissions p, sn_objects o"
+ lappend where_clauses \
+ "o.object_id = p.object_id" \
+ "p.grantee_id = g.grantee_id" \
+ "p.privilege = 'write'"
+ }
+ }
+
+ if { ![string equal $begin_letter all] } {
+ if { ![string equal $begin_letter other] } {
+ lappend where_clauses "upper(o.one_line_description) like '[string toupper $begin_letter]%'"
+ } else {
+ lappend where_clauses "(upper(o.one_line_description) < 'A' or upper(o.one_line_description) > 'Z')"
+ }
+ }
+
+ if { ![empty_string_p $start_date] && ![empty_string_p $end_date]} {
+ lappend where_clauses "o.start_date <= :end_date" "o.end_date >= :start_date"
+ }
+
+ # Count the total number of viewable objects.
+
+ set total_viewable_objects_count [db_string get_total_count [subst {
+ select count(unique o.object_id)
+ from $total_tables
+ where [join $where_clauses "\nand "]
+ }]]
+
+ lappend category_count_list [list total $total_viewable_objects_count]
+
+ if { $start_category_id == 0 } {
+
+ # Count the uncategorized stuff for each question.
+ # We do this by counting all the categorized objects
+ # and subtracting the resulting number from the total number
+ # of objects. This is much faster than letting Oracle do
+ # the job.
+
+ set questions [km_node_question_list -browse_p $object_type_id]
+
+ foreach question $questions {
+ util_unlist $question question_node_id dummy question_id
+
+ set count [db_string count_categorized_objects [subst {
+ select /*+ORDERED*/ count(unique o.object_id)
+ from $total_tables, sw_object_category_map swcm, sw_flat_cat fc
+ where [join $where_clauses "\n and "]
+ and swcm.object_id = o.object_id
+ and swcm.category_id = fc.child_category_id
+ and fc.parent = :question_node_id
+ }]]
+
+ lappend category_count_list \
+ [list "uncat $question_id" [expr $total_viewable_objects_count - $count]]
+
+ # Count categorized stuff by category on the first level below the question.
+
+ db_foreach get_category_counts [subst {
+ select /*+ORDERED*/ fc.parent_category_id,
+ count(unique o.object_id) as object_count
+ from $tables
+ where [join $where_clauses "\n and "]
+ and swcd.parent_node_id = :question_node_id
+ and fc.parent = swcd.node_id
+ and swcm.category_id = fc.child_category_id
+ and swcm.object_id = o.object_id
+ group by fc.parent_category_id
+ }] {
+ lappend category_count_list [list $parent_category_id $object_count]
+ }
+ }
+
+ } else {
+
+ # Get counts below a certain root category.
+
+ set count [db_string count_categorized_objects [subst {
+ select /*+ORDERED*/ count(unique o.object_id)
+ from $total_tables, sw_object_category_map swcm, sw_flat_cat fc
+ where [join $where_clauses "\n and "]
+ and swcm.object_id = o.object_id
+ and swcm.category_id = fc.child_category_id
+ and fc.parent_category_id = :start_category_id
+ }]]
+
+ lappend category_count_list \
+ [list $start_category_id $count] \
+ [list "uncat" [expr $total_viewable_objects_count - $count]]
+
+ # Count categorized stuff by category on the first level below the question.
+
+ set node_id [db_string get_start_node_id {
+ select node_id
+ from sw_category_dim
+ where object_id = :start_category_id
+ }]
+
+ db_foreach get_category_counts [subst {
+ select /*+ORDERED*/ fc.parent_category_id,
+ count(unique o.object_id) as object_count
+ from $tables
+ where [join $where_clauses "\n and "]
+ and swcd.parent_node_id = :node_id
+ and fc.parent = swcd.node_id
+ and swcm.category_id = fc.child_category_id
+ and swcm.object_id = o.object_id
+ group by fc.parent_category_id
+ }] {
+ lappend category_count_list [list $parent_category_id $object_count]
+ }
+
+ }
+
+ ! Exiting km_get_category_count_internal
+ return $category_count_list
+}
+
+ad_proc km_node_question_list { {-browse_p:boolean 0} object_type_id } {
+
+ Returns a list of questions that are categorizations for the given
+ object type, each element being a list of
+ node ID, category or tree name, question ID, pretty_name.
+ if -browse_p is given, it will return only browseable category
+ questions.
+
+} {
+ if {$browse_p} {
+ set browse_clause "and q.browse_p = 't'"
+ } else {
+ set browse_clause ""
+ }
+
+ set result [db_list_of_lists km_node_question_list "
+ select q.node_id, g.tree_name, q.question_id, q.pretty_name
+ from sn_questions q, sn_question_object_type_map qm, generic_trees g
+ where q.question_id = qm.question_id
+ and g.tree_id = q.tree_id
+ and qm.object_type_id = :object_type_id
+ and qm.question_state <> 'invisible'
+ $browse_clause
+ order by qm.sort_key"]
+
+ return $result
+}
+
+ad_proc km_question_in_object_type { } {
+ Replaces the PL/SQL function sn_question_in_object_type.
+ Returns an exists clause that should be much faster than the previous
+PL/SQL function.
+} {
+ return "and 1= (select count(*)
+ from sn_question_object_type_map
+ where object_type_id = :object_type_id
+ and question_id = :question_id
+ and question_state <> 'invisible')"
+}
+
+proc_doc km_node_question { object_type_id node_id } {
+
+ Given an object type and a top-level node ID, determine
+ which question this category belongs to.
+
+} {
+ # rownum=1 added by dirk (11-july-2001). remove it...it's most likely
+ # wrong, but I just want to get this big piece of software to run
+
+ set result [db_string km_node_question "
+ select question_id from sn_questions
+ where node_id=:node_id
+ [km_question_in_object_type] and rownum=1" -default ""]
+ return $result
+}
+
+ad_proc km_node_question_parent { object_type_id node_id } {
+
+ Given an object type and a node ID, determine which question this
+ category belongs to.
+
+} {
+ return [km_db_1row_to_list km_node_question_parent {
+ select q.question_id, q.node_id
+ from sn_questions q, sw_flat_cat fc, sn_question_object_type_map qm
+ where fc.child = :node_id
+ and fc.parent = q.node_id
+ and qm.object_type_id = :object_type_id
+ and qm.question_id = q.question_id
+ and qm.question_state <> 'invisible'
+ }]
+}
+
+ad_proc km_category_name { category_id } {
+ Get the name of the of a category
+} {
+ if [empty_string_p $category_id] { return -code error "Missing category_id" }
+ if {[string equal $category_id none]} {
+ return ""
+ }
+ set result [db_string km_category_name "
+ select long_name from categories
+ where category_id = :category_id" -default ""]
+
+ return $result
+}
+
+ad_proc km_root_node {
+ {
+ -question_id 0
+ }
+ object_type_id
+} {
+
+ Get the parent node_id for a given object type.
+
+ If question_id is 0, a list of the parents for all the questions
+ of this object type is returned.
+ Else, the parent for the given question_id is returned.
+
+} {
+ if !$question_id {
+ # Select all categorization questions.
+
+ set result [db_list km_root_node "
+ select node_id
+ from sn_questions q, sn_question_object_type_map qm
+ where q.node_id is not null
+ and qm.object_type_id = :object_type_id
+ and qm.question_id = q.question_id
+ and qm.question_state <> 'invisible'
+ order by sort_key"]
+ } else {
+ set result [db_string km_root_node_2 "
+ select node_id from sn_questions where question_id=:question_id" -default ""]
+ }
+
+ return $result
+}
+
+ad_proc km_object_filter_bar {
+ {
+ -child_type_p 0
+ }
+ pool age sort_by
+} {
+
+ Filters and sorting options displayed on the top of most category pages.
+ Note that *you* have to provide the TABLE tag.
+
+} {
+ return "
+<tr><td>Owner:</td><td>[km_ownership_bar $pool]</td></tr>
+<tr><td>Sort: <td>[km_sort_by_bar $sort_by $child_type_p]</td></tr>"
+}
+
+proc_doc km_object_view_bar_top_level { show short_title all_title } {
+ View: Just category descriptions | All objects
+} {
+ set show_list [list [list short $short_title] [list all $all_title]]
+
+ foreach show_pair $show_list {
+ set show_value [lindex $show_pair 0]
+ set show_annotation [lindex $show_pair 1]
+
+ if {$show == $show_value} {
+ lappend show_bar "<b>$show_annotation</b>"
+ } else {
+ lappend show_bar "<a href=\"[ns_conn url]?[export_ns_set_vars url {show}]&show=$show_value\">$show_annotation</a>"
+ }
+ }
+
+ return "\[ [join $show_bar " | "] \]"
+}
+
+proc_doc km_ownership_bar { current_pool } {
+ Filter: My objects | My objects & co-owner | All
+} {
+ return [ad_choice_bar \
+ { "my objects" "my objects & co-owner" "all" } \
+ "[ns_conn url]?[export_ns_set_vars url {pool}]&pool=\$value" \
+ { own coown all } \
+ $current_pool]
+}
+
+proc_doc km_archive_bar { current_archive } {
+ Filter: Live Objects | Archived Objects
+} {
+ return [ad_choice_bar \
+ { "live objects" "archived objects" } \
+ "[ns_conn url]?[export_ns_set_vars url {archive}]&archive=\$value" \
+ { f t } \
+ $current_archive]
+}
+
+proc_doc km_age_bar { current_age } {
+ Filter: 3 6 12 24 months | All
+} {
+ proc mk_link { default parms } {
+ set label [fst $parms]
+ set value [snd $parms]
+
+ if { $value == $default } {
+ return "<strong>$label</strong>"
+ } else {
+ return "<a href=\"[ns_conn url]?[export_ns_set_vars url {age}]&age=$value\">$label</a>"
+ }
+ }
+
+ return "[join [map "mk_link $current_age" [list "3 90" "6 180" "12 365" "24 730"]] " "] months | [mk_link $current_age "All all"]"
+}
+
+ad_proc km8_categorization_widget {
+ {
+ -parent_node_id {}
+ -uncategorized_p 0
+ -target {}
+ -question_id {}
+ -category_count {}
+ -uncategorized_target {}
+ -uncategorized_count {}
+ -maximum_columns 1
+ }
+} {
+
+ Build the table showing category counts for a given parent category.
+
+} {
+ # Translate ns_set category_count into a Tcl array
+ #
+ if { ![null_p $category_count] } {
+ for {set i 0} {$i < [ns_set size $category_count]} {incr i} {
+ set sum_count([ns_set key $category_count $i]) [ns_set value $category_count $i]
+ }
+ }
+
+ # Fetch the category hierarchy.
+ #
+
+ set ordered {}
+ set select_size 0
+ db_foreach categories {
+ select c.long_name as category, c.category_id
+ from categories c, sw_category_dim d
+ where d.parent_node_id = :parent_node_id
+ and c.category_id = d.object_id
+ order by nvl(c.sort_key,9999)
+ } {
+ if { [empty_string_p $category_count] ||
+ ([info exists sum_count($category_id)] && $sum_count($category_id) > 0) } {
+ lappend ordered [list $category $category_id]
+ incr select_size
+ }
+ }
+
+ if { !$select_size } { return "" }
+
+ # Generate the widget open tag, now that we know the size
+ if { $maximum_columns > 1 } {
+ if { $select_size < 15 } {
+ set maximum_columns 1
+ } else {
+ set column_size [expr $select_size / $maximum_columns]
+ }
+ }
+
+ # What column are we currently writing to
+ set column_no 1
+ # How many rows have we written to that
+ set column_count 0
+ set show_category_p 0
+
+ # Iterate to generate the HTML
+ #
+ foreach elem $ordered {
+ set category [fst $elem]
+ set category_id [snd $elem]
+
+ set option ""
+
+ if { $maximum_columns > 1 } {
+ incr column_count
+ if { $column_count > $column_size && $column_no < $maximum_columns } {
+ incr column_no
+ set column_count 0
+ }
+ }
+
+ if {![info exists sum_count($category_id)]} {
+ set sum_count($category_id) ""
+ }
+
+ set show_category_p 1
+ template::multirow append categorization_widget $category $target $category_id "$sum_count($category_id)" $parent_node_id $question_id
+
+ }
+ # foreach
+
+ if { $uncategorized_p } {
+ if {![empty_string_p $uncategorized_count] && $uncategorized_count != 0} {
+ if { ![empty_string_p $uncategorized_target]} {
+ set target ${uncategorized_target}
+ }
+ set show_category_p 1
+ template::multirow append categorization_widget Uncategorized $target "" $uncategorized_count $parent_node_id
+
+ }
+ }
+ return $show_category_p
+}
+
+
+proc_doc ad_category_parentage_list {category_id {known_parent_id ""}} {
+
+ Returns a list of lists, where each sublist is one line of
+ parentage up from the specified category to the hierarchy root. In
+ turn, each parentage line list consists of two-item lists: category_id
+ and long_name. A list of lists is needed since a category can have
+ multiple parents. If this category has no parents, then return the
+ empty list.
+
+} {
+
+ set n_parents [db_string ad_category_parentage_list_10 "select count(*) from sw_category_dim where object_id = :category_id"]
+
+ if { $n_parents == 0 } {
+ return [list]
+ }
+
+ set sql_ad_category_parentage_list_20 "SELECT c.category_id AS parent_id, c.long_name AS parent_category, hc.level_col
+FROM categories c,
+(SELECT h.object_id as child, LEVEL AS level_col, ROWNUM AS row_col
+ FROM sw_category_dim h
+ START WITH h.object_id = :category_id
+ CONNECT BY h.node_id = PRIOR h.parent_node_id) hc
+WHERE c.category_id = hc.child
+ORDER BY hc.row_col"
+
+ set parentage_list [list]
+ set parentage_line [list]
+ set prior_level 0
+ set stop_everything 0
+ db_foreach ad_category_parentage_list_20 $sql_ad_category_parentage_list_20 {
+ if {$stop_everything== 1} {
+
+ if {$level_col <= $prior_level} {
+ # Parent line is now completed, flush it
+ lappend parentage_list $parentage_line
+
+ # Keep the last bit of the parentage chain
+ # lars@pinds.com, Feb 2000
+ #
+ set parentage_line [lrange $parentage_line [expr $prior_level - $level_col + 1] end]
+ }
+
+ set prior_level $level_col
+
+ # We're moving up the hierarchy so put this category at
+ # the beginning of the parentage line.
+ #
+ set parentage_line [concat [list [list $parent_id $parent_category]] $parentage_line]
+
+ if { ![empty_string_p $known_parent_id] && $known_parent_id == $parent_id } {
+ set stop_everything 1
+ }
+ }
+
+ }
+
+ if {$stop_everything == 1} {
+ # you cannot return from within db_foreach
+ return $parentage_line
+ }
+ if { [empty_string_p $known_parent_id] } {
+ # Don't forget the last parentage line
+ return [lappend parentage_list $parentage_line]
+ } else {
+ # We didn't find the wanted parent
+ return [list]
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-display-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-display-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-display-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,490 @@
+# /tcl/km-display-procs.tcl
+#
+# Display of data.
+#
+# $Id: km-display-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+# ********** Display procs for questions of various abstract data types- No Form **********
+proc_doc km_display_category_value {category_value_list} {
+ Formats a list of category_id and category value tuples for simple display.
+} {
+ set category_names [snd [transpose $category_value_list]]
+ set formatted_values [join $category_names ", "]
+ return $formatted_values
+}
+
+proc_doc km_display_other_category_value {category_value_list object_id question_id} {
+ Formats a list of category_id and category value tuples for simple display.
+} {
+ set other_value [snd [fst [km_get_object_content -question_ids [list $question_id] $object_id]]]
+ set category_names [snd [transpose $category_value_list]]
+ set category_list [list]
+ foreach category $category_names {
+ if { [string equal [string toupper $category] "OTHER"] && ![empty_string_p $other_value] } {
+ append category " ($other_value)"
+ }
+ lappend category_list $category
+ }
+ set formatted_values [join $category_list ", "]
+ return $formatted_values
+}
+
+proc_doc km_display_options {answer_option_list} {
+ Displays tuples in an option list for simple display.
+} {
+ return [join [snd [transpose $answer_option_list]] ", "]
+}
+
+# *********Buttons**********
+
+ad_proc km_get_button_names {} {
+ Returns a list of all the constant submit button names in the km library.
+} {
+
+ return {
+ proceed
+ finish
+ details
+ add_web_ref
+ add_sn_ref
+ add_user_ref
+ add_content_ref
+ next_question
+ last_question
+ link
+ browse
+ all_questions
+ unanswered
+ answered
+ add_child
+ add_nephew
+ copy_child
+ copy_nephew
+ volunteer
+ previous_question
+ next_question
+ delete
+ }
+}
+
+proc_doc km8_button_panel {question_id object_id object_type_id} {
+
+ This proc returns the submit button-panel.
+
+ Note that I'm getting the buttons to the same size manually, since netscape 4x
+ can't do width as a style for an input button. You have to pass the object_id
+ since the active branch path can only be determined from object data.
+
+ } {
+ set captions {}
+ set button_values ""
+ set next_value ""
+ set next_name ""
+
+ # If this question leads to a branch, we set the default answer as next question.
+ set root_branch_p [km_root_branch_p $question_id]
+
+ # If this question is a branch, then we need to know its parent.
+ set branch_parent [km_branch_parent $question_id $object_type_id]
+
+ # Determine the next question.
+ if { $root_branch_p } {
+ # The branch continues - so we don't know where to go to yet.
+ set next_question 0
+ } elseif ![empty_string_p $branch_parent] {
+ # End of branch. We determine the next question relative to the branch root.
+ set branch_root [km_get_root_branch $question_id $object_type_id]
+ set next_question [km_get_question -next_p 1 -object_id $object_id $branch_root $object_type_id]
+ } else {
+ # This is no branch. So just use the current question_id for determining
+ # the next.
+ set next_question [km_get_question -next_p 1 -object_id $object_id $question_id $object_type_id]
+ }
+
+ # Determine the previous question.
+ if ![empty_string_p $branch_parent] {
+ # When in a branch, Previous always takes us back to our parent.
+ set previous_question $branch_parent
+ } else {
+ set previous_question [km_get_question -previous_p 1 -object_id $object_id $question_id $object_type_id]
+ if ![empty_string_p $previous_question] {
+ if [km_root_branch_p [fst $previous_question]] {
+ # The previous question is the root of a branch. To find the actual "previous"
+ # question, we have to traverse this branch until the last active question.
+ set active_branches [km_active_branch_path [fst $previous_question] $object_id $object_type_id]
+ set previous_question [fst [reverse $active_branches]]
+ }
+ }
+ }
+
+ set button_values {" << " " >> "}
+ if ![empty_string_p $previous_question] {
+ set previous_value [fst $button_values]
+ set previous_name "previous_question.[fst $previous_question]"
+ }
+ if ![empty_string_p $next_question] {
+ set next_value [snd $button_values]
+ set next_name "next_question.[fst $next_question]"
+ }
+
+ set button_1 ""
+ set button_2 ""
+ if { ![empty_string_p $previous_question] && ![empty_string_p $next_question] } {
+ set button_1 $previous_name
+ set button_2 $next_name
+ } elseif ![empty_string_p $previous_question] {
+ set button_1 $previous_name
+ } elseif ![empty_string_p $next_question] {
+ set button_2 $next_name
+ }
+
+ set button_names {"all_questions." "unanswered." "answered."}
+ set button_values {"All Questions" "Completed Content"}
+ return [list $button_1 \
+ [fst $button_names] \
+ [snd $button_names] \
+ [thd $button_names] \
+ $button_2]
+}
+
+# ********** Basic Display Procs **********
+proc_doc km_count_object_view { user_id object_id } {
+ Record an object view.
+} {
+ if {![km_original_author_p $user_id $object_id]} {
+ db_dml km_count_object_view_10 "
+ update sn_access_counts
+ set access_count = access_count + 1
+ where object_id=:object_id
+ and access_date = (trunc(sysdate,'month'))"
+
+ if {![db_resultrows]} {
+ db_dml insert_access_count {
+ insert into sn_access_counts (object_id, access_count, access_date)
+ select :object_id, 1, (trunc(sysdate,'month')) from dual
+ where not exists (select 1 from sn_access_counts
+ where object_id=:object_id
+ and access_date = (trunc(sysdate,'month')))
+ }
+ db_dml reset_sn_object_monthly_count {
+ update sn_objects
+ set access_total = access_total +1,
+ access_month = 1
+ where object_id = :object_id
+ }
+ } else {
+ db_dml increment_sn_object_count {
+ update sn_objects
+ set access_total = access_total +1,
+ access_month = access_month +1
+ where object_id = :object_id
+ }
+ }
+ }
+}
+
+proc_doc km_get_access_count { object_id } {
+} {
+ return [db_string access_count {
+ select nvl(sum(access_count),0)
+ from sn_access_counts
+ where object_id = :object_id
+ }]
+}
+
+proc_doc km_get_access_count_month { object_id } {
+} {
+ return [db_string access_count_month {
+ select nvl(sum(access_count),0)
+ from sn_access_counts
+ where object_id = :object_id
+ and access_date = (trunc(sysdate,'month'))
+ }]
+}
+
+
+proc_doc km_object_access_toolbar {object_id {category_id ""}} {
+ Toolbar: [Private] Make public | Access Control | Delete Object
+} {
+ set user_id [ad_conn user_id]
+ set package_id [ad_conn package_id]
+
+ set return_url "object-view?[export_url_vars object_id category_id]"
+
+ set result {}
+ set write_p [km_conn write_p]
+ set admin_p [km_conn admin_p]
+ set publish_p [km_conn publish_p]
+ set public_p [km_conn public_p]
+ set archived_p [km_conn archived_p]
+ set archive_p [km_static object_type_archive_p [km_conn object_type_id]]
+ set approval_p [km_static approval_p $package_id]
+ set in_review_p [km_conn in_review_p]
+ set review_state [km_conn review_state]
+
+ # admins or users with write permission (if object is not archived)
+ # can make object public/private
+ if {$admin_p || ($approval_p && $publish_p)} {
+ if {!$public_p} {
+ if {$approval_p && $in_review_p} {
+ if {[string equal $review_state library_review]} {
+ lappend result "<font color=red>\[Private\]</font> <font color=green>\[In review\]</font> <a href=\"object-publish?[export_url_vars object_id category_id return_url]\">Make public</a>"
+ } else {
+ lappend result "<font color=red>\[Private\]</font> <font color=green>\[Needs clarification\]</font> <a href=\"object-publish?[export_url_vars object_id category_id return_url]\">Make public</a>"
+ }
+ } else {
+ lappend result "<font color=red>\[Private\]</font> <a href=\"object-publish?[export_url_vars object_id category_id return_url]\">Make public</a>"
+ }
+ } else {
+ lappend result "\[Public\] <a href=\"object-unpublish?[export_url_vars object_id category_id return_url]&[csrf::link_token]\">Make private</a>"
+ }
+ } elseif {$write_p && !$archived_p} {
+ if { !$public_p } {
+ if {!$in_review_p && $approval_p} {
+ lappend result "<font color=red>\[Private\]</font> <a href=\"object-propose-public?[export_url_vars object_id category_id return_url]\">Propose to publish</a>"
+ } elseif {!$in_review_p} {
+ lappend result "<font color=red>\[Private\]</font> <a href=\"object-publish?[export_url_vars object_id category_id return_url]\">Make public</a>"
+ } else {
+ # The state of a workflow task is user-dependant, hence we need the
+ # else clause. A task might be in review, but there's nothing going
+ # on for the user.
+ db_1row get_workflow_task {
+ select distinct(ut.task_id)
+ from wf_cases c, wf_user_tasks ut
+ where c.object_id = :object_id
+ and c.case_id = ut.case_id
+ and c.state = 'active'
+ and rownum = 1
+ order by ut.task_id desc
+ }
+ if {[string equal $review_state library_review]} {
+ lappend result "<font color=red>\[Private\]</font> <a href=\"../approval-tasks/task?[export_url_vars task_id]\">In review</a>"
+ } elseif {[string equal $review_state library_clarify]} {
+ lappend result "<font color=red>\[Private\]</font> Review: <a href=\"../approval-tasks/task?[export_url_vars task_id]\">Needs clarification</a>"
+ } else {
+ lappend result "<font color=red>\[Private\]</font> <font color=green>\[In review\]</font>"
+ }
+ }
+ } elseif {!$approval_p} {
+ lappend result "\[Public\] <a href=\"object-unpublish?[export_url_vars object_id category_id return_url]\">Make private</a>"
+ } else {
+ lappend result "\[Public\]"
+ }
+ } else {
+ if { $in_review_p } {
+ lappend result "<font color=red>\[Private\]</font> <font color=green>\[In review\]</font>"
+ } elseif { !$public_p } {
+ lappend result "<font color=red>\[Private\]</font>"
+ }
+ }
+ ## users with write permission can archive/unarchive object
+ ## (and admins and publishers)
+ if {$write_p || $admin_p || ($approval_p && $publish_p)} {
+ if {$archived_p} {
+ lappend result "<font color=red>\[Archived\]</font> <a href=\"object-unarchive?[export_url_vars object_id category_id return_url]\">Remove from archive</a>"
+ }
+ if {$archive_p && !$archived_p && ($admin_p || $publish_p || !$approval_p || (!$public_p && !$in_review_p))} {
+ lappend result "<a href=\"object-archive?[export_url_vars object_id category_id return_url]\">Put in archive</a>"
+ }
+ }
+ # admins or users with write permission (if object is not archived)
+ # can change permissions on the object
+ if {$admin_p || ($write_p && !$archived_p)} {
+ lappend result "<a href=\"object-access?[export_url_vars object_id category_id]\">Access Control</a>"
+ }
+ # users with delete permissions (owner or admins) can delete an object
+ if [km_conn delete_p] {
+ if {[empty_string_p $category_id] || $category_id == "none"} {
+ set return_delete "browse-one-type?object_type_id=[km_conn object_type_id]"
+ } else {
+ set return_delete "browse-one-category?object_type_id=[km_conn object_type_id]&category_id=$category_id"
+ }
+ lappend result "<a href=\"object-delete?[export_url_vars object_id category_id return_delete]\">Delete Object</a>"
+ }
+
+ # admins or publishers have access to the approval task
+ if {$approval_p && $in_review_p && ($publish_p || $admin_p)} {
+ db_1row get_workflow_task {
+ select distinct(ut.task_id)
+ from wf_cases c, wf_user_tasks ut
+ where c.object_id = :object_id
+ and c.case_id = ut.case_id
+ and c.state = 'active'
+ and rownum = 1
+ order by ut.task_id desc
+ }
+ lappend result "<a href=\"../approval-tasks/task?[export_url_vars task_id]\">Manage Approval</a>"
+ }
+
+ return [join $result " | "]
+}
+
+proc_doc km_shorten_question { question } {
+ Shortens a question up to the question mark in the question.
+} {
+ set line_end [string first ? $question]
+ if { $line_end >= 0 } {
+ return [string range $question 0 $line_end]
+ } else {
+ return $question
+ }
+}
+
+#--------------------------------------------------------
+
+
+proc_doc util_trim_string_with_hrefs { string_to_trim { final_length 200 } } {
+ Will return the trimmed string without cutting off an href before the </a> tag.
+} {
+
+ if {[string length $string_to_trim] < $final_length} {
+ return $string_to_trim
+ }
+
+ set string_trimmed [string range $string_to_trim 0 $final_length]
+ set string_trimmed_lower [string tolower $string_trimmed]
+
+ # find the last occurance of "<a href"
+
+ set last_href [string last "<a href" $string_trimmed_lower]
+
+ if { $last_href != -1 } {
+
+ # find the last occurance of </a>
+ set last_href_close [string last "</a>" $string_trimmed_lower]
+
+ # if there is no </a> after the last <a href then cut off
+ # the string at the last <a href
+
+ if {$last_href > $last_href_close} {
+ set string_trimmed [string range $string_trimmed 0 [expr $last_href - 1]]
+ }
+ }
+
+ return "$string_trimmed..."
+}
+
+
+proc_doc util_make_href_and_mailto_links { text } {
+ Changes http:// and https:// to links and email formats to mailto's
+} {
+ # (bd) if there are any A HREF or IMG SRCs this guy know how to use them
+ # so we don't touch his HTML. It may be hard to see but I am using
+ # carriage returns, # newlines, tabs and spaces (in that order) in these
+ # regexps:
+ set text " $text"
+ if {!([regexp -nocase {<[
+ ]*a[
+ ]*href[
+ ]*=} $text] || [regexp -nocase {<[
+ ]*img[
+ ]*src[
+ ]*=} $text])} {
+ # if something is " http://" or " https://"
+ # we assume it is a link to an outside source.
+
+ # (bd) The only purpose of thiese sTaRtUrL and
+ # eNdUrL markers is to get rid of trailing dots,
+ # commas and things like that. Note that there
+ # is a TAB before and after each marker.
+
+ regsub -nocase -all {"} $text {"} text
+ regsub -nocase -all {"} $text {"} text
+ regsub -nocase -all {([^a-zA-Z0-9]+)(http://[^\(\)"<>
+ ]+)} $text {\1 sTaRtUrL\2eNdUrL } text
+ regsub -nocase -all {([^a-zA-Z0-9]+)(https://[^\(\)"<>
+ ]+)} $text {\1 sTaRtUrL\2eNdUrL } text
+ regsub -nocase -all {([^a-zA-Z0-9]+)(ftp://[^\(\)"<>
+ ]+)} $text {\1 sTaRtUrL\2eNdUrL } text
+
+ # email links have the form xxx@xxx.xxx
+ regsub -nocase -all {([^a-zA-Z0-9]+)([^\(\)
+ :;,@<>]+@[^\(\)
+ .:;,@<>]+[.][^\(\)
+ :;,@<>]+)} $text {\1 sTaRtEmAiL\2eNdEmAiL } text
+ #
+ regsub -all {([]!?.:;,<>\(\)\}-]+)(eNdUrL )} $text {\2\1} text
+ regsub -all {([]!?.:;,<>\(\)\}-]+)(eNdEmAiL )} $text {\2\1} text
+ regsub -all { sTaRtUrL([^ ]*)eNdUrL } $text {<a href="\1">\1</a>} text
+ regsub -all { sTaRtEmAiL([^ ]*)eNdEmAiL } $text {<a href="mailto:\1">\1</a>} text
+ }
+ return [string trimleft $text]
+}
+
+proc_doc util_make_href_and_mailto_links_and_convert_to_html { text {html_p 0} } {
+
+ util_make_href_and_mailto_links interferes badly with util_convert_to_html.
+ That's why I had to write a special procedure that does both things correctly.
+ See those two procs for details.
+
+} {
+
+ if { $html_p } { return $text }
+
+ set text " $text"
+ # if something is " http://" or " https://"
+ # we assume it is a link to an outside source.
+
+ # (bd) The only purpose of thiese sTaRtUrL and
+ # eNdUrL markers is to get rid of trailing dots,
+ # commas and things like that. Note that there
+ # is a TAB before and after each marker.
+
+ regsub -nocase -all {([^a-zA-Z0-9]+)(http://[^\(\)"<>
+ ]+)} $text {\1 sTaRtUrL\2eNdUrL } text
+ regsub -nocase -all {([^a-zA-Z0-9]+)(https://[^\(\)"<>
+ ]+)} $text {\1 sTaRtUrL\2eNdUrL } text
+ regsub -nocase -all {([^a-zA-Z0-9]+)(ftp://[^\(\)"<>
+ ]+)} $text {\1 sTaRtUrL\2eNdUrL } text
+
+ # email links have the form xxx@xxx.xxx
+ regsub -nocase -all {([^a-zA-Z0-9]+)([^\(\)
+ :;,@<>]+@[^\(\)
+ .:;,@<>]+[.][^\(\)
+ :;,@<>]+)} $text {\1 sTaRtEmAiL\2eNdEmAiL } text
+ # At this point, before inserting some of our own <, >, and "'s
+ # we quote the ones entered by the user:
+ set text [util_quotehtml $text]
+ # turn CRLFCRLF into <P>
+ if { [regsub -all "\015\012\015\012" $text "<p>" text] == 0 } {
+ # try LFLF
+ if { [regsub -all "\012\012" $text "<p><p>" text] == 0 } {
+ # try CRCR
+ regsub -all "\015\015" $text "<p><p>" text
+ }
+ }
+ # turn CRLF into <BR>
+ if { [regsub -all "\015\012" $text "<br>" text] == 0 } {
+ # try LF
+ if { [regsub -all "\012" $text "<br>" text] == 0 } {
+ # try CR
+ regsub -all "\015" $text "<br>" text
+ }
+ }
+ # Dress the links and emails with A HREF
+ regsub -all {([]!?.:;,<>\(\)\}-]+)(eNdUrL )} $text {\2\1} text
+ regsub -all {([]!?.:;,<>\(\)\}-]+)(eNdEmAiL )} $text {\2\1} text
+ regsub -all { sTaRtUrL([^ ]*)eNdUrL } $text {<a href="\1">\1</a>} text
+ regsub -all { sTaRtEmAiL([^ ]*)eNdEmAiL } $text {<a href="mailto:\1">\1</a>} text
+ return [string trimleft $text]
+}
+
+proc_doc library_icon_height {} "Returns the height for an object icon" {
+ return "50"
+}
+
+proc_doc library_icon_width {} "Returns the width for an object icon" {
+ return "50"
+}
+
+ad_proc space {{-size 20}} "returns an html space" {
+
+ set space ""
+ set i 0
+ while { $i < $size } {
+ append space " "
+ incr i
+ }
+ return $space
+
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-feedback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-feedback-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-feedback-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,165 @@
+# /tcl/km-feedback.tcl
+#
+# General comment system adapted to KM.
+#
+# Created by carsten@arsdigita.com in June 2000
+# modified by bernd@arsdigita.com in Jan. 2001
+#
+# ported by dirk@arsdigita.com in July 2001
+
+proc_doc km_check_comment_id { user_id comment_id } {
+
+ Checks if the user may edit the comment. If not, 0 is returned.
+ If he has edit permission, the associated object_id is returned.
+
+} {
+ if {![db_0or1row km_check_comment_id_10 {
+ select object_id, user_id as comment_user_id
+ from sn_comments where comment_id = :comment_id
+ }] } {
+ ad_return_exception_page 404 "" \
+ "The entry $comment_id does not exist in table general_comments."
+ return 0
+ }
+
+ if ![km_check_object_id $object_id] { return 0 }
+
+ if { $user_id != $comment_user_id && ![km_conn admin_p] } {
+ ad_return_complaint 1 "<li>You cannot edit this entry because you did not post it."
+ return 0
+ }
+
+ return $object_id
+}
+
+ad_proc km_general_comment_add {
+ object_id user_id html_p reuse_points scale feedback_category_id public_p comment
+} {
+
+ Inserts a comment into the general comment system with additional
+ possibility of giving feedback.
+
+} {
+ set ip_address [ns_conn peeraddr]
+ set package_id [ad_conn package_id]
+ set short_comment [string range $comment 0 3999]
+
+ if {$reuse_points > $scale} {
+ return 0
+ }
+
+ db_transaction {
+ set new_comment_id [db_exec_plsql km_general_comment_add_10 {
+ begin
+ :1 := sn_comment.new_comment (
+ object_id => :object_id,
+ html_p => :html_p,
+ display_p => :public_p,
+ rating => :reuse_points,
+ scale => :scale,
+ user_id => :user_id,
+ ip_address => :ip_address,
+ package_id => :package_id,
+ category_id => :feedback_category_id,
+ short_content => :short_comment
+ );
+ end;
+ }]
+
+ db_dml km_general_comment_add_20 {
+ update sn_comments
+ set content = empty_clob()
+ where comment_id = :new_comment_id
+ returning content into :1
+ } -clobs [list $comment]
+ }
+
+ return $new_comment_id
+}
+
+ad_proc km_general_comment_update {
+ {
+ -html_p "f"
+ -public_p "t"
+ -feedback_category_id ""
+ }
+ user_id object_id comment_id comment
+} {
+ Updates a comment in the general comment system.
+} {
+ set ip_address [ns_conn peeraddr]
+ set short_comment [string range $comment 0 3999]
+
+ db_exec_plsql km_general_comments_update_10 {
+ begin
+ sn_comment.update_comment (
+ comment_id => :comment_id,
+ html_p => :html_p,
+ display_p => :public_p,
+ user_id => :user_id,
+ ip_address => :ip_address,
+ category_id => :feedback_category_id,
+ short_content => :short_comment
+ );
+ end;
+ }
+
+ db_transaction {
+ db_dml km_general_comments_update_20 "
+ update sn_comments
+ set content = empty_clob()
+ where comment_id = :comment_id
+ returning content into :1" -clobs [list $comment]
+
+ }
+}
+
+ad_proc feedback_points_img { feedback_points scale } {
+ Returns an IMG tag that shows via stars how valuable a posting was.
+ We have up to 5 stars, so we might need to scale.
+} {
+ if { $scale == 5 } {
+ set scaled_feedback_points $feedback_points
+ } else {
+ set scaled_feedback_points [expr [expr [expr $feedback_points * 1.0] / $scale] * 5]
+ }
+
+ if {$scaled_feedback_points <= 0} {
+ set gif_number "00"
+ } elseif {$scaled_feedback_points > 0 && $scaled_feedback_points < 1} {
+ set gif_number "05"
+ } elseif {$scaled_feedback_points == 1} {
+ set gif_number "10"
+ } elseif {$scaled_feedback_points > 1 && $scaled_feedback_points < 2} {
+ set gif_number "15"
+ } elseif {$scaled_feedback_points == 2} {
+ set gif_number "20"
+ } elseif {$scaled_feedback_points > 2 && $scaled_feedback_points < 3} {
+ set gif_number "25"
+ } elseif {$scaled_feedback_points == 3} {
+ set gif_number "30"
+ } elseif {$scaled_feedback_points > 3 && $scaled_feedback_points < 4} {
+ set gif_number "35"
+ } elseif {$scaled_feedback_points == 4} {
+ set gif_number "40"
+ } elseif {$scaled_feedback_points > 4 && $scaled_feedback_points < 5} {
+ set gif_number "45"
+ } else {
+ set gif_number "50"
+ }
+
+ set points [format "%.1f" $feedback_points]
+ regsub {\.0} $points "" points
+ return "stars[set gif_number].gif"
+
+# return "<nobr>$points <img src=\"graphics/stars[set gif_number].gif\" alt=\"$feedback_points feedback points\" width=\"50\" height=\"9\"></nobr>"
+}
+
+
+
+
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-links-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-links-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-links-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,1069 @@
+# /tcl/km-links.tcl
+#
+# Knowledge object linking.
+#
+# Created by carsten@arsdigita.com in June 2000
+#
+# $Id: km-links-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+proc_doc km_linked_object_types { object_type_id } {
+
+ Returns an array in the form: object_type_id, pretty_type, pretty_plural, graphic
+ for all object_types that are linkable with this object_type.
+
+} {
+ # Only object_types that have been listed for a question in
+ # sn_questions are considered to be linkable with this
+ # object_type.
+
+ set context_id [ad_conn package_id]
+
+ set result [db_list_of_lists km_linked_object_types "
+ select ot.object_type_id, ot.pretty_name, ot.pretty_plural, ot.graphic
+ from sn_questions q, sn_question_object_type_map qm, sn_object_types ot
+ where q.question_id = qm.question_id
+ and qm.object_type_id = :object_type_id
+ and qm.question_state <> 'invisible'
+ and ot.object_type_id = :object_type_id
+ and context_id=:context_id
+ and q.abstract_data_type = 'object_link'"]
+
+ return $result
+}
+
+ad_proc km_get_linked_objects {
+ {
+ -question_id 0
+ -to_p 0
+ -from_p 0
+ -reference_links_p 1
+ -family_members_p 1
+ -only_unarchived_p 0
+ }
+ user_id object_id
+} {
+
+ Returns objects linked to this object as specified in the
+ parameters. Note that this function does not enforce
+ access control rules, but only returns two colunms named
+ view_p and edit_p.
+
+} {
+ if { !$to_p && !$from_p } { return {} }
+
+ set admin_p [km_conn admin_p]
+ set package_id [ad_conn package_id]
+ set instance_read_p [ad_permission_p $package_id "read"]
+
+ set join_tables {
+ "sn_links l"
+ "sn_objects obj1"
+ "sn_objects obj2"
+ "users u"
+ "sn_object_types ot"
+ "sn_question_object_type_map qotm"
+ "sn_question_link_map qlm"
+ }
+
+ set order_by "order by linked_object_type, question_id, name"
+
+ set parent_link_type parent_child
+
+ set join_tables_from {}
+ lappend where_from \
+ "obj1.object_id = l.object_id_a " \
+ "l.object_id_b = obj2.object_id " \
+ "obj2.original_author_id = u.user_id" \
+ "obj1.object_id = :object_id " \
+ "obj2.expiration_date > sysdate" \
+ "qotm.object_type_id = obj1.object_type_id" \
+ "qotm.question_id = qlm.question_id" \
+ "l.link_id = qlm.link_id" \
+ "qotm.question_state <> 'invisible'" \
+ "ot.object_type_id = obj2.object_type_id" \
+ "ot.deleted_p = 'f'"
+
+ if !$admin_p { lappend where_from "ot.public_p = 't'" }
+
+ if !$instance_read_p {
+ lappend where_from \
+ "(obj2.public_p = 't' or obj2.object_id in (
+ select object_id from acs_permissions
+ where (grantee_id = :user_id
+ or grantee_id in (select group_id from membership_rels
+ where person_id = :user_id))
+ and privilege = 'read'))"
+ }
+
+ lappend where_to \
+ "obj1.object_id = l.object_id_a " \
+ "l.object_id_b = obj2.object_id " \
+ "obj1.original_author_id = u.user_id" \
+ "obj2.object_id = :object_id " \
+ "obj1.expiration_date > sysdate" \
+ "qotm.object_type_id = obj1.object_type_id" \
+ "qotm.question_id = qlm.question_id" \
+ "l.link_id = qlm.link_id" \
+ "qotm.question_state <> 'invisible'" \
+ "ot.object_type_id = obj1.object_type_id" \
+ "ot.deleted_p = 'f'"
+
+ if !$family_members_p {
+ lappend where_to "l.link_type not in ('uncle_nephew','parent_child')"
+ lappend where_from "l.link_type not in ('uncle_nephew','parent_child')"
+ }
+
+ if { $only_unarchived_p } {
+ lappend where_to "obj1.archived_p = 'f'"
+ lappend where_from "obj2.archived_p = 'f'"
+ }
+
+ if !$admin_p { lappend where_to "ot.public_p = 't'" }
+
+ if !$instance_read_p {
+ lappend where_to \
+ "(obj1.public_p = 't' or obj1.object_id in (
+ select object_id from acs_permissions
+ where (grantee_id = :user_id
+ or grantee_id in (select group_id from membership_rels
+ where person_id = :user_id))
+ and privilege = 'read'))"
+ }
+
+ if { $question_id } {
+ lappend where_from "qlm.question_id = :question_id"
+ lappend where_to "qlm.question_id = :question_id"
+ }
+
+ if { $reference_links_p == 0 } {
+ # We were told to exclude links which may already have been
+ # displayed as answers in the target object.
+
+ lappend where_to {
+ qlm.question_id not in
+ (select references_question_id
+ from sn_questions
+ where references_question_id is not null and question_id in
+ (select question_id from sn_question_object_type_map
+ where object_type_id = obj2.object_type_id))
+ }
+ }
+
+ set links_from "
+ select l.link_id, l.link_comment, decode(html_p,'t',1,0) as comment_html_p,
+ obj2.object_id linked_object_id, obj2.object_type_id linked_object_type,
+ qlm.question_id, obj2.one_line_description name, obj2.last_modified,
+ km_utilities.strip_html_and_limit_size(obj2.overview) as overview,
+ decode(obj2.public_p,'t',1,0) as public_p, u.user_id as owner_id,
+ u.first_names || ' ' || u.last_name as owner_name,
+ 1 as view_p, decode(obj2.archived_p,'t',1,0) as archived_p,
+ decode(obj2.in_review_p,'t',1,0) as review_p,
+ decode(acs_permission.permission_p(obj2.object_id, :user_id, 'write'),'t',1,0) as edit_p,
+ 1 as from_p
+ from [join [concat $join_tables $join_tables_from] ","]
+ where [join $where_from " and "]"
+
+ set links_to "
+ select l.link_id, l.link_comment, decode(html_p,'t',1,0) as comment_html_p,
+ obj1.object_id linked_object_id, obj1.object_type_id linked_object_type,
+ qlm.question_id, obj1.one_line_description name, obj1.last_modified,
+ km_utilities.strip_html_and_limit_size(obj1.overview) as overview,
+ decode(obj1.public_p,'t',1,0) as public_p, u.user_id as owner_id,
+ u.first_names || ' ' || u.last_name as owner_name,
+ 1 as view_p, decode(obj1.archived_p,'t',1,0) as archived_p,
+ decode(obj1.in_review_p,'t',1,0) as review_p,
+ decode(acs_permission.permission_p(obj1.object_id, :user_id, 'write'),'t',1,0) as edit_p,
+ 0 as from_p
+ from [join $join_tables ","]
+ where [join $where_to " and "]"
+
+ # Put the SQL together.
+ if { $from_p && $to_p } {
+ set sql "$links_from union $links_to $order_by"
+ } elseif { $from_p } {
+ set sql "$links_from $order_by"
+ } else {
+ set sql "$links_to $order_by"
+ }
+
+ # strip html from overview
+ set result [km_db_to_named_list_list km_get_linked_objects_2 $sql]
+
+ return $result
+}
+
+proc_doc km8_get_to_links { {-only_unarchived_p 0} object_id question_id } {
+
+} {
+ set current_user_id [ad_conn user_id]
+ set result [db_list_of_lists km8_get_to_links {
+ select * from (
+ select object_id_b, aodesc.shortname, aodesc.overview,
+ aodesc.overview_html_p, l.link_id, object_id_a, ao.object_type,
+ aodesc.presentation, acs_permission.permission_p(l.object_id_b, :current_user_id, 'sw_read') sw_read_p,
+ (select decode(count(*),0,'f','t')
+ from membership_rels mr_lm
+ where mr_lm.person_id = l.object_id_b
+ and sn_group.group_list_members_p(mr_lm.group_id, :current_user_id) > 0 ) as user_list_p,
+ l.link_comment, decode(l.html_p,'t',1,0) as comment_html_p
+ from sn_links l, sn_question_link_map map, acs_objects_description aodesc,
+ acs_objects ao
+ where l.object_id_a = :object_id
+ and aodesc.object_id = ao.object_id
+ and aodesc.object_id = l.object_id_b
+ and aodesc.state <> 'd'
+ and (:only_unarchived_p = 0 or ao.object_type <> 'sn_object' or aodesc.state <> 'a')
+ and map.question_id = :question_id
+ and l.link_id = map.link_id
+ order by shortname
+ ) where sw_read_p='t' or user_list_p='t'}]
+ return $result
+}
+
+ad_proc km_get_linked_names { object_id question_id } {
+ Returns the names of users, objects or ACS content linked from this object and question.
+} {
+ set context_id [ad_conn package_id]
+
+ set result [db_list_of_lists km_get_linked_names "
+ select obj1.one_line_description
+ from sn_links l, sn_objects obj1, sn_objects obj2, sn_question_link_map map
+ where l.object_id_a = obj2.object_id
+ and l.object_id_b = obj1.object_id
+ and map.question_id = :question_id
+ and l.link_id = map.link_id
+ and obj2.object_id = :object_id
+ and obj1.context_id = :context_id
+ and obj2.context_id = :context_id
+ order by one_line_description"]
+
+ return [map fst $result]
+}
+
+proc_doc sn_people_responsible {user_id object_id} {
+
+ Returns a list of triples:user_id, full name, email of people
+ responsible for this xchange_task project.
+
+} {
+ set package_id [ad_conn package_id]
+ set contact_person_p [db_0or1row get_contact_person_question {
+ select q.question_id
+ from sn_objects o, sn_questions q, sn_question_object_type_map qm
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id = :package_id
+ and q.pretty_name = 'Contact Person'
+ }]
+
+ set result ""
+ if {$contact_person_p} {
+ db_0or1row get_contact_person {
+ select content as result
+ from sn_content
+ where object_id = :object_id
+ and question_id = :question_id
+ }
+ }
+ if [empty_string_p $result] {
+ db_1row get_author_email {
+ select u.first_names || ' ' || u.last_name author_name, u.email author_email
+ from users u, sn_objects o
+ where u.user_id = o.original_author_id
+ and o.object_id = :object_id
+ }
+ set result "$author_name <$author_email>"
+ }
+
+ return $result
+}
+
+ad_proc km_get_parent { object_id } {
+ Returns the parent of an object
+} {
+ if { [db_0or1row km_get_parent {
+ select obj.object_id as parent_id, obj.one_line_description as parent_name, obj.object_type_id
+ from sn_objects obj, km_flat_object_hierarchy fo
+ where fo.child = :object_id
+ and obj.object_id = fo.parent
+ and fo.link_type = 'parent_child'
+ and fo.distance = 1 }] } {
+
+ if {[empty_string_p $parent_name]} {
+ set parent_name "Unnamed [km_static object_type_pretty_name $object_type_id]"
+ }
+ return [list $parent_id $parent_name $object_type_id]
+ } else {
+ return
+ }
+}
+
+ad_proc km_get_uncle { object_id } {
+ Returns the uncle of an object
+} {
+ if { [db_0or1row km_get_uncle {
+ select obj.object_id as uncle_id, obj.one_line_description as uncle_name, obj.object_type_id
+ from sn_objects obj, km_flat_object_hierarchy fo
+ where fo.child = :object_id
+ and obj.object_id = fo.parent
+ and fo.link_type = 'uncle_nephew'
+ and fo.distance = 1 }] } {
+
+ if {[empty_string_p $uncle_name]} {
+ set uncle_name "Unnamed [km_static object_type_pretty_name $object_type_id]"
+ }
+ return [list $uncle_id $uncle_name $object_type_id]
+ } else {
+ return
+ }
+}
+
+ad_proc km_is_nephew_p { object_id } {
+ Checks if this object is linked as a nephew to an uncle
+} {
+ set result [db_string km_is_nephew_p {
+ select count(*)
+ from km_flat_object_hierarchy
+ where child = :object_id
+ and link_type = 'uncle_nephew'
+ and distance = 1
+ }]
+ return $result
+}
+
+ad_proc km_is_uncle_p { object_id } {
+ Checks if this object is linked as a uncle to an object
+} {
+ set result [db_string km_is_uncle_p {
+ select count(*)
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.link_type = 'uncle_nephew'
+ and foh.distance = 1
+ and foh.child = o.object_id
+ and o.expiration_date > sysdate
+ }]
+ return $result
+}
+
+ad_proc km_is_parent_p { object_id } {
+ Checks if this object is linked as a parent to an object
+} {
+ set result [db_string km_is_parent_p {
+ select count(*)
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.link_type = 'parent_child'
+ and foh.distance = 1
+ and foh.child = o.object_id
+ and o.expiration_date > sysdate
+ }]
+ return $result
+}
+
+ad_proc km_is_child_p { object_id } {
+ Checks if this object is linked as a child to a parent
+} {
+ set result [db_string km_is_child_p {
+ select count(*)
+ from km_flat_object_hierarchy
+ where child = :object_id
+ and link_type = 'parent_child'
+ and distance = 1
+ }]
+ return $result
+}
+
+ad_proc km_is_descendant_p { object_id } {
+ Checks if this object is linked as a child/nephew to a parent/uncle
+} {
+ set result [db_string km_is_child_p {
+ select count(*)
+ from km_flat_object_hierarchy
+ where child = :object_id
+ and distance = 1
+ }]
+ return $result
+}
+
+ad_proc km_is_mandatory_nephew_p { object_id } {
+ Checks if this object is linked as a nephew to an uncle via a mandatory question
+} {
+ set result [db_string km_is_mandatory_nephew_p {
+ select count(*)
+ from sn_links l, sn_question_link_map map, sn_question_object_type_map qm
+ where l.object_id_b = :object_id
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ }]
+ return $result
+}
+
+ad_proc km_is_mandatory_uncle_p { object_id } {
+ Checks if this object is linked as a uncle to an object via a mandatory question
+} {
+ set result [db_string km_is_mandatory_uncle_p {
+ select count(*)
+ from sn_links l, sn_question_link_map map,
+ sn_question_object_type_map qm, sn_objects o
+ where l.object_id_a = :object_id
+ and l.object_id_b = o.object_id
+ and o.expiration_date > sysdate
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ }]
+ return $result
+}
+
+ad_proc km_is_nephew_with_private_uncle_p { object_id {public_p "f"} } {
+ Checks if this object is linked as a nephew to an uncle
+} {
+ set result [db_string km_is_nephew_with_private_uncle_p {
+ select count(*)
+ from km_flat_object_hierarchy ko, sn_objects o
+ where ko.child = :object_id
+ and ko.parent = o.object_id
+ and ko.link_type = 'uncle_nephew'
+ and ko.distance = 1
+ and o.public_p = :public_p
+ }]
+ return $result
+}
+
+ad_proc km_is_child_with_private_parent_p { object_id {public_p "f"} } {
+ Checks if this object is linked as a child to a parent
+} {
+ set result [db_string km_is_child_with_private_parent_p {
+ select count(*)
+ from km_flat_object_hierarchy ko, sn_objects o
+ where ko.child = :object_id
+ and ko.parent = o.object_id
+ and ko.link_type = 'parent_child'
+ and ko.distance = 1
+ and o.public_p = :public_p
+ }]
+ return $result
+}
+
+ad_proc km_private_ancestor_p { object_id {public_p "f"} } {
+ Checks if this object is linked as a child or nephew to a private ancestor.
+} {
+ set result [db_string km_private_ancestor_p {
+ select count(*)
+ from km_flat_object_hierarchy ko, sn_objects o
+ where ko.child = :object_id
+ and ko.parent = o.object_id
+ and ko.distance = 1
+ and o.public_p = :public_p
+ }]
+ return $result
+}
+
+ad_proc km_archived_ancestor_p { object_id {archived_p "t"} } {
+ Checks if this object is linked as a child or nephew to an archived ancestor.
+} {
+ set result [db_string km_archived_ancestor_p {
+ select count(*)
+ from km_flat_object_hierarchy ko, sn_objects o
+ where ko.child = :object_id
+ and ko.parent = o.object_id
+ and ko.distance = 1
+ and o.archived_p = :archived_p
+ }]
+ return $result
+}
+
+ad_proc km_check_public_status_after_edit { object_id } {
+ Checks the public status of the object, it's descendants and it's uncle after
+ editing the object.
+} {
+ set nephew_p [km_is_mandatory_nephew_p $object_id]
+ set complete_p [km_object_complete_p $object_id]
+ db_1row km_check_public_status_after_edit_10 {
+ select public_p, archived_p
+ from sn_objects where
+ object_id = :object_id
+ }
+ if { $complete_p && $public_p == "f" } {
+ if {[km_private_ancestor_p $object_id "t"]} {
+ # if object is uncle then publish it and all nephews - user can later
+ # unpublish some nephews
+ km_object_publish [concat $object_id [map fst [km_get_descendents $object_id]]]
+ }
+ }
+ if { !$complete_p && $public_p == "t" } {
+ km_object_unpublish $object_id
+ if {$nephew_p} {
+ set uncle_id [km_get_uncle $object_id]
+ if {[km_uncle_needs_private_status_p $uncle_id]} {
+ km_object_unpublish $uncle_id
+ }
+ }
+ }
+}
+
+ad_proc km_object_publish { object_list } {
+ Publishes an object and all its selected descendants
+} {
+ set user_id [ad_conn user_id]
+
+ foreach child_id $object_list {
+ if [km_object_complete_p $child_id] {
+ lappend object_list $child_id
+ }
+ }
+ set object_sql [join $object_list ","]
+
+ db_transaction {
+ db_exec_plsql km_object_publish_10 "
+ declare
+ v_the_public acs_objects.object_id%TYPE;
+ begin
+ select acs.magic_object_id('the_public') into v_the_public from dual;
+ for v_objects in (select object_id from sn_objects where object_id in ($object_sql))
+ loop
+ acs_permission.grant_permission(v_objects.object_id, v_the_public, 'read');
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id, content)
+ values
+ (v_objects.object_id, null, sysdate, :user_id, 'Object Published');
+ end loop;
+ end;
+ "
+
+ db_dml km_object_publish_20 "
+ update sn_objects
+ set user_checkoff_date = sysdate, public_p = 't', in_review_p = 'f'
+ where object_id in ($object_sql)"
+
+ }
+}
+
+ad_proc km_object_unpublish { object_id } {
+ Unpublishes an object and all its descendants
+} {
+ if {[ad_conn -connected_p]} {
+ set user_id [ad_conn user_id]
+ } else {
+ set user_id [db_null]
+ }
+
+ db_transaction {
+ db_exec_plsql km_object_unpublish_10 {
+ declare
+ v_the_public acs_objects.object_id%TYPE;
+ begin
+ select acs.magic_object_id('the_public') into v_the_public from dual;
+ for v_objects in (select object_id from sn_objects
+ where object_id = :object_id
+ or object_id in (select o.object_id
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.public_p = 't') )
+ loop
+ acs_permission.revoke_permission(v_objects.object_id, v_the_public, 'read');
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id, content)
+ values
+ (v_objects.object_id, null, sysdate, :user_id, 'Set to Private');
+ end loop;
+ end;
+ }
+
+ db_dml km_object_unpublish_20 {
+ update sn_objects
+ set user_checkoff_date = null, public_p = 'f'
+ where object_id = :object_id
+ or object_id in (select o.object_id
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.public_p = 't')
+ }
+ }
+}
+
+ad_proc km_object_archive { object_id reason } {
+ archives an object and all its descendants
+} {
+ set reason "Archived: [ad_quotehtml $reason]"
+ if {[ad_conn -connected_p]} {
+ set user_id [ad_conn user_id]
+ } else {
+ set user_id [db_null]
+ }
+
+ db_transaction {
+ set object_list [db_list get_archivable_objects {
+ ( select o.object_id
+ from km_flat_object_hierarchy foh, sn_objects o, sn_object_types ot
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.archived_p = 'f'
+ and o.object_type_id = ot.object_type_id
+ and ot.archive_p = 't' )
+ minus
+ ( select child as object_id
+ from km_flat_object_hierarchy
+ where parent in (select o.object_id
+ from km_flat_object_hierarchy foh, sn_objects o,
+ sn_object_types ot
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.archived_p = 'f'
+ and o.object_type_id = ot.object_type_id
+ and ot.archive_p = 'f') )
+ }]
+ set object_sql [join [concat $object_id $object_list] ","]
+
+ db_dml km_object_archive_10 "
+ insert into sn_audit_table (
+ select o.object_id, null as question_id, sysdate as last_modified,
+ :user_id as last_modifying_user_id, :reason as content
+ from sn_objects o
+ where o.object_id in ($object_sql)
+ )
+ "
+
+ db_dml km_object_archive_20 "
+ update sn_objects
+ set archiving_date = sysdate,
+ archived_p = 't'
+ where object_id in ($object_sql)
+ "
+ }
+}
+
+ad_proc km_object_unarchive { object_id object_id_list } {
+ Unarchives an object and all selected descendants (-> private)
+} {
+ set user_id [ad_conn user_id]
+ lappend object_id_list $object_id
+ set object_sql [join $object_id_list ","]
+
+ db_transaction {
+ ## revoke public permissions from all objects + descendants
+ db_exec_plsql km_object_unarchive_10 {
+ declare
+ v_the_public acs_objects.object_id%TYPE;
+ begin
+ select acs.magic_object_id('the_public') into v_the_public from dual;
+ for v_objects in (select object_id from sn_objects
+ where object_id = :object_id
+ or object_id in (select o.object_id
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.public_p = 't') )
+ loop
+ acs_permission.revoke_permission(v_objects.object_id, v_the_public, 'read');
+ end loop;
+ end;
+ }
+
+ ## make a note in the audit table that objects got unarchived
+ db_dml km_object_unarchive_20 "
+ insert into sn_audit_table (
+ select o.object_id, null as question_id, sysdate as last_modified,
+ :user_id as last_modifying_user_id, 'Unarchived, set to Private' as content
+ from sn_objects o
+ where object_id in ($object_sql)
+ )
+ "
+
+ ## remove objects from archive and make private
+ db_dml km_object_unarchive_30 "
+ update sn_objects
+ set archiving_date = null,
+ user_checkoff_date = null,
+ public_p = 'f',
+ archived_p = 'f'
+ where object_id in ($object_sql)
+ "
+
+ ## make a note in the audit table that all other descendants
+ ## got private
+ db_dml km_object_unarchive_40 "
+ insert into sn_audit_table (
+ select o.object_id, null as question_id, sysdate as last_modified,
+ :user_id as last_modifying_user_id, 'Set to Private' as content
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.public_p = 't'
+ )
+ "
+
+ ## make all other desendants private
+ db_dml km_object_unarchive_50 "
+ update sn_objects
+ set user_checkoff_date = null,
+ public_p = 'f'
+ where object_id in (select o.object_id
+ from km_flat_object_hierarchy foh, sn_objects o
+ where foh.parent = :object_id
+ and foh.child = o.object_id
+ and o.public_p = 't')
+ "
+ }
+}
+
+proc_doc km_get_object_ancestors { object_id } {
+
+ Returns a list of ids of the parent of this object, the parent of
+ the parent of this object, etc. Will do this for normal links if
+ the link type_id is set to the one for bidirectional links.
+
+} {
+ set result [db_list_of_lists km_get_object_ancestors "
+ select obj.object_id, obj.one_line_description, obj.object_type_id
+ from sn_objects obj, km_flat_object_hierarchy fo
+ where fo.child = :object_id
+ and obj.object_id = fo.parent
+ order by distance"]
+
+ return $result
+}
+
+proc_doc km_get_descendents { object_id } {
+ Almost identical to the ancestor proc.
+} {
+ set result [db_list_of_lists km_get_descendents "
+ select obj.object_id, obj.one_line_description
+ from sn_objects obj, km_flat_object_hierarchy fo
+ where fo.parent = :object_id
+ and obj.object_id = fo.child
+ and obj.expiration_date > sysdate
+ order by distance"]
+
+ return $result
+}
+
+ad_proc km_get_child_descendents { object_id } {
+ Returns only children and grandchildren.
+} {
+ set result [db_list km_get_child_descendents {
+ select fo.child
+ from km_flat_object_hierarchy fo, sn_objects o
+ where fo.parent = :object_id
+ and fo.link_type = 'parent_child'
+ and o.object_id = fo.child
+ and o.expiration_date > sysdate
+ order by distance }]
+
+ return $result
+}
+
+ad_proc km_get_objects_descendents { object_list } {
+ Returns descendents of a list of objects.
+} {
+ set result [db_list km_get_objects_descendents "
+ select fo.child
+ from km_flat_object_hierarchy fo, sn_objects o
+ where fo.parent in ([join $object_list ","])
+ and o.object_id = fo.child
+ and o.expiration_date > sysdate
+ order by distance"]
+
+ return $result
+}
+
+ad_proc km_get_presentation_type_of_nephew_question { object_id } {
+ Returns the presentation_type of the uncle's nephew question under
+ which this object is linked
+} {
+ set result [db_string km_get_presentation_type_of_nephew_question_10 {
+ select q.presentation_type
+ from sn_questions q, sn_question_link_map map, sn_links l
+ where q.abstract_data_type = 'nephew_object'
+ and q.question_id = map.question_id
+ and l.link_id = map.link_id
+ and l.link_type = 'uncle_nephew'
+ and l.object_id_b = :object_id
+ } -default "custom"]
+
+ return $result
+}
+
+proc_doc km_get_child_objects {
+ {-only_unarchived_p 0} object_id question_id
+} {
+ Returns an array containing the object_ids of the child objects
+ associated with this object_id and question_id.
+
+} {
+ set order_by [db_string order_by {
+ select nvl(order_by,'name')
+ from sn_questions
+ where question_id = :question_id}]
+
+ # We select more columns than we need because of sorting.
+ return [map fst [db_list child_objects {
+ select obj2.object_id, obj2.one_line_description as name, obj2.last_modified, l.link_id
+ from sn_objects obj1,sn_objects obj2, sn_links l, sn_question_link_map map
+ where l.object_id_b = obj2.object_id
+ and l.object_id_a = obj1.object_id
+ and map.question_id = :question_id
+ and l.link_id = map.link_id
+ and l.link_type = 'parent_child'
+ and obj1.object_id = :object_id
+ and obj2.expiration_date > sysdate
+ and obj2.archived_p <> decode(:only_unarchived_p,'0','a','t')
+ order by :order_by}]]
+}
+
+proc_doc km_get_nephew_objects {
+ {-only_unarchived_p 0} object_id question_id
+} {
+ Returns an array containing the object_ids of the nephew objects
+ associated with this object_id and question_id.
+
+} {
+ set user_id [ad_conn user_id]
+ set order_by [db_string order_by {
+ select nvl(order_by,'name')
+ from sn_questions
+ where question_id = :question_id}]
+
+ # We select more columns than we need because of sorting.
+ return [map fst [db_list nephew_objects {
+ select obj2.object_id, obj2.one_line_description as name, obj2.last_modified, l.link_id
+ from sn_objects obj1,sn_objects obj2, sn_links l, sn_question_link_map map
+ where l.object_id_b = obj2.object_id
+ and l.object_id_a = obj1.object_id
+ and map.question_id = :question_id
+ and l.link_id = map.link_id
+ and l.link_type = 'uncle_nephew'
+ and obj1.object_id = :object_id
+ and obj2.expiration_date > sysdate
+ and obj2.archived_p <> decode(:only_unarchived_p,'0','a','t')
+ and acs_permission.permission_p (obj2.object_id, :user_id, 'read') = 't'
+ order by :order_by}]]
+}
+
+ad_proc km_get_nephew_count { object_id } {
+ Returns the total number of nephew objects for a particular object.
+} {
+ set result [db_string km_get_nephew_count {
+ select count(*)
+ from sn_links l, sn_objects o
+ where l.link_type = 'uncle_nephew'
+ and l.object_id_a = :object_id
+ and l.object_id_b = o.object_id
+ and o.expiration_date > sysdate
+ }
+ return $result
+}
+
+ad_proc km_uncle_needs_private_status_p { object_id {nephew_id ""} } {
+ Checks if uncle need to be private after making a nephew private
+} {
+ set context_id [ad_conn package_id]
+ if {[empty_string_p $nephew_id]} {
+ set nephew_questions_without_public_nephews [db_string km_uncle_needs_private_status_p_10 {
+ select count(*)
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id=:context_id
+ and q.abstract_data_type = 'nephew_object'
+ and not exists (select nephew.object_id
+ from sn_objects nephew, sn_question_link_map map, sn_links l
+ where l.object_id_a = :object_id
+ and l.object_id_b = nephew.object_id
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = q.question_id
+ and nephew.expiration_date > sysdate
+ and nephew.archived_p = o.archived_p
+ and nephew.public_p = 't')
+ }]
+ } else {
+ set nephew_questions_without_public_nephews [db_string km_uncle_needs_private_status_p_20 {
+ select count(*)
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id=:context_id
+ and q.abstract_data_type = 'nephew_object'
+ and not exists (select nephew.object_id
+ from sn_objects nephew, sn_question_link_map map, sn_links l
+ where l.object_id_a = :object_id
+ and l.object_id_b = nephew.object_id
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = q.question_id
+ and nephew.expiration_date > sysdate
+ and nephew.public_p = 't'
+ and nephew.archived_p = o.archived_p
+ and nephew.object_id <> :nephew_id)
+ }]
+ }
+ return $nephew_questions_without_public_nephews
+}
+
+proc_doc km_link_question_attributes { question_id } {
+ Returns the object_type_attributes for this object_link question.
+} {
+ set context_id [ad_conn package_id]
+ set sql "select ot.object_type_id, ot.pretty_name, ot.pretty_plural, ot.graphic
+ from sn_questions q, sn_object_types ot
+ where q.target_object_type_id = ot.object_type_id
+ and q.question_id = :question_id"
+ set result [km_db_1row_to_list km_link_question_attributes $sql]
+ return $result
+}
+
+ad_proc km_link_objects {
+ {
+ -link_type ""
+ }
+ question_id user_id object_id_a object_id_b link_comment html_p
+} {
+ Creates a new link between two objects.
+} {
+ if [empty_string_p $link_type] {
+ set link_type bi_directional
+ }
+
+ if {[string equal $link_type "parent_child"] || [string equal $link_type "uncle_nephew"]} {
+ if {[db_string check_parent_or_uncle "
+ select count(*) from sn_links
+ where object_id_b = :object_id_b
+ and link_type in ('parent_child','uncle_nephew')"] > 0} {
+ return 0
+ }
+ }
+
+ set new_link_id [db_string km_link_objects_10 "select sn_links_seq.nextval from dual"]
+
+ db_dml km_link_objects_20 {insert into sn_links (link_id, link_type, object_id_a,
+ object_id_b, link_comment, html_p, creation_user, creation_date)
+ values (:new_link_id, :link_type, :object_id_a,
+ :object_id_b, :link_comment, :html_p, :user_id, sysdate)}
+
+ if { ![db_0or1row km_link_objects_25 {
+ select nvl(one_line_description,'Unnamed ' || pretty_name) as target_name, pretty_name as target_type
+ from sn_objects o, sn_object_types ot
+ where o.object_id = :object_id_b
+ and o.object_type_id = ot.object_type_id}]
+ } {
+ db_1row km_link_objects_26 {
+ select
+ shortname as target_type,
+ overview as target_name
+ from
+ acs_objects_description
+ where
+ object_id = :object_id_b
+ }
+ }
+
+ set content "Added link to $target_type \"$target_name\" $link_comment"
+ set ip_address [ns_conn peeraddr]
+
+ db_exec_plsql km_link_objects_30 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id_a,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+
+ db_dml km_link_objects_40 {insert into sn_question_link_map (link_id, question_id)
+ values (:new_link_id, :question_id)}
+
+ set sql_fragment "[km_link_description_update $object_id_a $question_id]"
+ if {![empty_string_p $sql_fragment]} {
+ db_dml km_link_objects_50 "
+ update sn_objects
+ set $sql_fragment
+ where object_id = :object_id_a"
+ }
+ return 1
+}
+
+ad_proc km_link_description_update { object_id question_id } {
+
+ Returns a SQL fragment for updating the short or long description
+ of an object, if the given question is set as the object type's
+ description. Works for all linking questions.
+
+} {
+ db_1row km_link_description_update "
+ select long_description
+ from sn_object_types
+ where object_type_id = (select object_type_id from sn_objects
+ where object_id=:object_id)"
+
+ set short_desc_list [db_list_of_lists question_info_short_desc {
+ select map.short_description
+ from sn_types_map_short_name map
+ where map.object_type_id = (select object_type_id from sn_objects
+ where object_id=:object_id)
+ order by position
+ }]
+
+ set result ""
+ if { [lsearch $short_desc_list $question_id] != -1 || $question_id == $long_description } {
+ set QQlinked_names [util_trim_string_with_hrefs [DoubleApos [join [km_get_linked_names $object_id $question_id] ", "]] 2000]
+
+ if { $question_id == $long_description } {
+ set result "overview = '$QQlinked_names', overview_html_p = 'f'"
+ } else {
+ set result "one_line_description = '$QQlinked_names'"
+ }
+ }
+
+ return $result
+}
+
+namespace eval sn_links::objects::sn_object {
+ ad_proc -public restrict {source_id target_id target_presentation pass} {
+
+ Limit knowledge object types in linking service.
+
+ } {
+
+ if { [regexp {exclude ([0-9 ]+)} $pass match exclude_ids] } {
+ if { [lsearch $exclude_ids $target_id] != -1 } {
+ return 0
+ }
+ }
+
+ if {![regexp {restriction(\d*)} $pass match restrict_to_object_type_id]} {
+ # The restriction is not required, so show all objects.
+ return 1
+ } else {
+ if {![regexp {object_type_id=(\d*)} $target_presentation match object_type_id]} {
+ # Bug in the database, the presentation column is wrong.
+ ns_log Notice "Presentation is wrong for object_id $target_id."
+ return 1
+ } else {
+ if {$object_type_id == $restrict_to_object_type_id} {
+ return 1
+ }
+ return 0
+ }
+ }
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-object-data-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-object-data-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-object-data-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,933 @@
+# /tcl/km-object-data.tcl
+#
+# $Id: km-object-data-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+util_report_library_entry
+
+# ********** Procs that get data from an object **********
+
+proc_doc km_object_exists_p {object_id} "Returns 1 if this object exists in the library" {
+ if [empty_string_p [km_get_object_type $object_id]] {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+ad_proc km_get_object_type { object_id } "Returns the object type for any given object." {
+ set this_object_type [db_string km_get_object_type "
+ select object_type_id
+ from sn_objects
+ where object_id=:object_id" -default ""]
+
+ return $this_object_type
+}
+
+ad_proc km_object_nephews_p { object_id } {
+ Returns 1 if the object has a uncle-nephew question and some nephews.
+} {
+ set context_id [ad_conn package_id]
+ set nephew_questions_without_nephews [db_string km_object_nephews_p {
+ select count(*)
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id=:context_id
+ and q.abstract_data_type = 'nephew_object'
+ and not exists (select nephew.object_id
+ from sn_objects nephew, sn_question_link_map map, sn_links l
+ where l.object_id_a = :object_id
+ and l.object_id_b = nephew.object_id
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = q.question_id
+ and nephew.expiration_date > sysdate)
+ }]
+ if {$nephew_questions_without_nephews > 0} {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+ad_proc km_valid_nephew_publish_list_p { object_id nephew_list } {
+ Returns 1 if for every uncle-nephew question of the object there is at least one
+ nephew object in the list to be published.
+} {
+ set context_id [ad_conn package_id]
+ set nephew_questions_without_nephews [db_string km_valid_nephew_publish_list_p "
+ select count(*)
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id=:context_id
+ and q.abstract_data_type = 'nephew_object'
+ and not exists (select nephew.object_id
+ from sn_objects nephew, sn_question_link_map map, sn_links l
+ where l.object_id_a = :object_id
+ and l.object_id_b = nephew.object_id
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = q.question_id
+ and nephew.expiration_date > sysdate
+ and nephew.object_id in ([join $nephew_list ","]))
+ "]
+ if {$nephew_questions_without_nephews > 0} {
+ return 0
+ } else {
+ foreach nephew_id $nephew_list {
+ if {![km_object_complete_p $nephew_id]} {
+ return 0
+ }
+ }
+ return 1
+ }
+}
+
+ad_proc km_uncle_nephew_questions { object_id } {
+ Returns a list of all questions of the object (question_ids) that are of uncle-nephew type
+} {
+ set context_id [ad_conn package_id]
+ set nephew_question_list [db_list_of_lists km_uncle_nephew_questions {
+ select q.question_id, q.pretty_name
+ from sn_objects o, sn_questions q, sn_question_object_type_map qm
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.mandatory_p = 't'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id = :context_id
+ and q.abstract_data_type = 'nephew_object'
+ }]
+ return $nephew_question_list
+}
+
+ad_proc km_publishable_nephews { object_id question_id } {
+ Returns the list of all publishable nephews for the object and question
+} {
+ set archived_p [db_string get_archived_status {select archived_p from sn_objects where object_id = :object_id}]
+ set nephew_list [db_list_of_lists km_publishable_nephews {
+ select nephew.object_id, nephew.one_line_description, nephew.in_review_p
+ from sn_objects nephew, sn_links l, sn_question_link_map map
+ where l.object_id_a = :object_id
+ and l.object_id_b = nephew.object_id
+ and l.link_type = 'uncle_nephew'
+ and l.link_id = map.link_id
+ and map.question_id = :question_id
+ and nephew.archived_p = :archived_p
+ and nephew.expiration_date > sysdate
+ }]
+ set result [list]
+ foreach nephew $nephew_list {
+ if {[km_object_complete_p [fst $nephew]]} {
+ lappend result $nephew
+ }
+ }
+ return $result
+}
+
+ad_proc km_object_complete_p { object_id } {
+ Returns 1 if the object is complete, 0 if not.
+} {
+ set required_questions [km_question_attributes [km_required_questions $object_id]]
+ db_1row get_object_type_id {
+ select object_type_id, decode(archived_p,'t',0,1) as unarchived_p
+ from sn_objects
+ where object_id = :object_id
+ }
+ if ![null_p $required_questions] {
+ set questions {{question_id pretty_name abstract_data_type}}
+ set questions [concat {{question_id pretty_name abstract_data_type}} $required_questions]
+ set object_data [km_get_object_data -questions $questions -answers_only_p 0 -only_unarchived_p $unarchived_p $object_id]
+ } else {
+ return 1
+ }
+ foreach item $object_data {
+ set value [fst $item]
+ set abstract_data_type [lindex $item 3]
+ set answered_p [km_answered_p $abstract_data_type $value]
+ if !$answered_p {
+ set question_id [snd $item]
+ if {[km_active_path_p $question_id $object_id $object_type_id]} {
+ return 0
+ }
+ }
+ }
+ return 1
+}
+
+ad_proc km_get_object_summary { object_id } {
+ Returns a tuple of object_id, public_p, archived_p, review_p, short_description, long_description of an object
+} {
+ set result [km_db_1row_to_list km_get_object_summary "
+ select object_id, public_p, archived_p, in_review_p as review_p, one_line_description, overview
+ from sn_objects
+ where object_id=:object_id"]
+
+ return $result
+}
+
+ad_proc km_get_object_name { object_id } {
+ Returns the name or short_description of an object.
+} {
+ db_1row get_object_name {
+ select one_line_description as object_name, object_type_id
+ from sn_objects
+ where object_id = :object_id
+ }
+
+ if [empty_string_p $object_name] {
+ return "Unnamed [km_static object_type_pretty_name $object_type_id]"
+ } else {
+ return $object_name
+ }
+}
+
+ad_proc km_get_object_data {
+ {
+ -answers_only_p 1
+ -questions {}
+ -show_values_p 1
+ -only_unarchived_p 0
+ }
+ object_id
+} {
+
+ Retrieves the data mapped to the given questions (as returned by
+ km_get_questions) and returns it as a list of lists in the form:
+ answer question_id pretty_question abstract_data_type branch_p
+ or as just the answers if answers_only_p is set.
+
+} {
+ set user_id [ad_conn user_id]
+ set archived_p [db_string get_archived_flag {select decode(archived_p,'t',1,0) from sn_objects where object_id = :object_id} -default 0]
+
+ if [null_p $questions] {
+ # Retrieve all possible questions for this object
+ set question_states [list active deprecated read-only]
+ if { $archived_p } {
+ lappend question_states invisible
+ }
+ set questions [km_get_questions -question_states $question_states -root_node_p 1 -branch_children_p 1 -all_properties_p 1 -object_id $object_id]
+
+ # Get all text answers for all questions.
+ # (So we don't have to query for each question.)
+ if { $show_values_p} {
+ set content_answers [km_get_object_content $object_id]
+ } else {
+ set content_answers ""
+ }
+
+ # Do the same for all linking questions.
+ set linked_objects_from [km_get_linked_objects -from_p 1 -only_unarchived_p $only_unarchived_p $user_id $object_id]
+ set linked_objects_to [km_get_linked_objects -to_p 1 -only_unarchived_p $only_unarchived_p $user_id $object_id]
+ set link_question_id_ix [lsearch [head $linked_objects_from] "question_id"]
+ } else {
+ set question_ids [map fst [tail $questions]]
+ if { $show_values_p} {
+ set content_answers [km_get_object_content -question_ids $question_ids $object_id]
+ } else {
+ set content_answers ""
+ }
+ set linked_objects_to {}
+ set linked_objects_from {}
+ set link_question_id_ix -1
+ }
+
+ set key [fst $questions]
+ set questions [tail $questions]
+
+ set answer_list {}
+ set question_id_ix [lsearch $key "question_id"]
+ set pretty_name_ix [lsearch $key "pretty_name"]
+ set abstract_data_type_ix [lsearch $key "abstract_data_type"]
+ set question_state_ix [lsearch $key "question_state"]
+ set branch_p_ix [lsearch $key "branch_p"]
+ set root_branch_p_ix [lsearch $key "root_branch_p"]
+ set references_question_id_ix [lsearch $key "references_question_id"]
+
+ foreach question $questions {
+ set question_id [lindex $question $question_id_ix]
+ set pretty_name [lindex $question $pretty_name_ix]
+ set abstract_data_type [lindex $question $abstract_data_type_ix]
+ set references_question_id [lindex $question $references_question_id_ix]
+ set question_state [lindex $question $question_state_ix]
+ if { $branch_p_ix != -1 } {
+ set branch_p [lindex $question $branch_p_ix]
+ } else {
+ set branch_p ""
+ }
+ if { $root_branch_p_ix != -1 } {
+ set root_branch_p [lindex $question $root_branch_p_ix]
+ } else {
+ set root_branch_p ""
+ }
+
+ # Collect the data on the basis of the abstract_data_type
+ switch $abstract_data_type {
+ "text" {
+ if { $show_values_p} {
+ set text_value [lindex [snd [transpose $content_answers]] [lsearch [fst [transpose $content_answers]] $question_id]]
+ set html_p [lindex [thd [transpose $content_answers]] [lsearch [fst [transpose $content_answers]] $question_id]]
+ set answer [list $text_value $html_p]
+ } else {
+ set text_value ""
+ set html_p ""
+ set answer ""
+ }
+ }
+ "integer" -
+ "date" -
+ "file" {
+ if { $show_values_p} {
+ set answer [lindex [snd [transpose $content_answers]] [lsearch [fst [transpose $content_answers]] $question_id]]
+ } else {
+ set answer ""
+ }
+ }
+ "object_link" {
+ if { $show_values_p} {
+ if { $link_question_id_ix == -1 } {
+ set answer [km_get_linked_objects -question_id $question_id -from_p 1 -only_unarchived_p $only_unarchived_p $user_id $object_id]
+ } else {
+ set answer [list [head $linked_objects_from]]
+ foreach linked_object [tail $linked_objects_from] {
+ set link_question_id [lindex $linked_object $link_question_id_ix]
+ if { $link_question_id == $question_id } {
+ lappend answer $linked_object
+ }
+ }
+ foreach linked_object [tail $linked_objects_to] {
+ set link_question_id [lindex $linked_object $link_question_id_ix]
+ if { $link_question_id == $references_question_id } {
+ lappend answer $linked_object
+ }
+ }
+ }
+ } else {
+ set answer ""
+ }
+ }
+ "composite" {
+ set child_ids [km_get_child_questions $question_id]
+ if ![null_p $child_ids] {
+ set child_questions [km_get_questions -question_states {active deprecated read-only} -root_node_p 0 -question_ids $child_ids]
+ set answer [km_get_object_data -questions $child_questions -answers_only_p 0 -only_unarchived_p $only_unarchived_p $object_id]
+ } else {
+ set answer {}
+ }
+ }
+ "category" { set answer [km_get_categories $object_id $question_id] }
+ "other_category" { set answer [km_get_categories $object_id $question_id] }
+ "option" { set answer [km_get_object_answers $object_id $question_id] }
+ "user_link" { set answer [km8_get_to_links $object_id $question_id] }
+ "content_link" { set answer [km8_get_to_links -only_unarchived_p $only_unarchived_p $object_id $question_id] }
+ "child_object" {
+ set answer ""
+ set child_ids [km_get_child_objects -only_unarchived_p $only_unarchived_p $object_id $question_id]
+ foreach child_id $child_ids {
+ lappend answer [km_get_object_summary $child_id]
+ }
+ }
+ "nephew_object" {
+ set answer ""
+ set nephew_ids [km_get_nephew_objects -only_unarchived_p $only_unarchived_p $object_id $question_id]
+ foreach nephew_id $nephew_ids {
+ lappend answer [km_get_object_summary $nephew_id]
+ }
+ }
+ default { set answer "" }
+ }
+ if { $answers_only_p } {
+ lappend answer_list $answer
+ } else {
+ lappend answer_list [list $answer $question_id $pretty_name $abstract_data_type $branch_p $root_branch_p]
+ }
+ }
+ return $answer_list
+}
+
+
+ad_proc km_get_object_content { { -question_ids {} } object_id } {
+ Returns all content about this object_id.
+} {
+ set result {}
+ if ![null_p $question_ids] {
+ foreach question_id $question_ids {
+ if {[db_0or1row km_get_object_content_10 "
+ select content,decode(html_p,'t',1,0) as html_p from sn_content
+ where object_id=:object_id and question_id=:question_id"]} {
+ lappend result [list $question_id $content $html_p]
+ }
+ }
+ } else {
+ set sql "select question_id, content,
+ decode(html_p,'t',1,0) as html_p from sn_content
+ where object_id=:object_id"
+ db_foreach km_get_object_content_20 $sql {
+ lappend result [list $question_id $content $html_p]
+ }
+ }
+
+ return $result
+}
+
+proc_doc km_get_object_answers { object_id question_id } {
+ Returns the option_ids, pretty_names as tuples that answer this question for this object.
+} {
+ set sql "select a.option_id, a.answer_option
+ from sn_answer_options a, sn_object_option_map m
+ where a.option_id =m.option_id
+ and m.object_id = :object_id
+ and a.question_id = :question_id"
+ set result [db_list_of_lists km_get_object_answers $sql]
+ return $result
+}
+
+# ********** Saving data **********
+
+proc_doc km_create_object { object_type_id user_id } {
+
+ Creates a new knowledge object as a row in sn_objects. Note that the
+ object is first considered completed when all required questions
+ concerning the object have been answered.
+
+} {
+ set package_id [ad_conn package_id]
+ set user_id [ad_verify_and_get_user_id]
+ set creation_ip [ad_conn peeraddr]
+
+ set new_object_id [db_exec_plsql create_object_10 {
+ begin
+ :1 := object.insert_object (
+ v_object_type_id => :object_type_id,
+ v_creation_user => :user_id,
+ v_creation_ip => :creation_ip,
+ v_context_id => :package_id
+ );
+ end;
+ }]
+
+ return $new_object_id
+}
+
+
+proc_doc km_save_object_data { object_id user_id key_values } {
+ Takes object data in as a list of keys value tuples and saves it in the database
+ according to its abstract data type.
+} {
+ if ![km_object_exists_p $object_id] { return }
+
+ # Filter extra input field for category 'other'
+ set other_category_key_values [km_filter_other_category_keys $key_values]
+ set other_category_question_ids [fst [transpose $other_category_key_values]]
+ set other_category_values [snd [transpose $other_category_key_values]]
+
+ #Make sure every key is an integer because all tag names here are question_ids.
+ set key_values [km_filter_valid_keys $key_values]
+ set submitted_question_ids [fst [transpose $key_values]]
+ set values [snd [transpose $key_values]]
+ if [null_p $submitted_question_ids] { return }
+
+ db_1row km_save_object_data_10 "
+ select long_description, public_until, start_date, end_date
+ from sn_object_types
+ where object_type_id = (select object_type_id from sn_objects
+ where object_id = :object_id)"
+
+ set short_description [db_list_of_lists question_info_short_desc {
+ select map.short_description
+ from sn_types_map_short_name map
+ where map.object_type_id = (select object_type_id from sn_objects
+ where object_id=:object_id)
+ order by position
+ }]
+
+ #Get the attributes of the submitted_question_ids.
+ set questions [km_question_attributes $submitted_question_ids]
+
+ db_transaction {
+ #Save the value according to the abstract_data_type
+ foreach question $questions {
+
+ set question_id [fst $question]
+ set abstract_data_type [thd $question]
+ set value_list [lindex $values [lsearch $submitted_question_ids $question_id]]
+
+ switch $abstract_data_type {
+ "category" { km_categorize_object $question_id $object_id $value_list }
+ "other_category" {
+ km_categorize_object $question_id $object_id $value_list
+ if {[lsearch -exact $value_list [km_get_other_category_id $question_id]] == -1} {
+ set other_value ""
+ } else {
+ set other_value [fst [lindex $other_category_values [lsearch $other_category_question_ids $question_id]]]
+ }
+ km_save_object_content -html_p 0 $question_id $object_id $user_id $other_value
+ }
+ "option" { km_map_object_answers $question_id $object_id $value_list }
+ "text" {
+ set content [fst $value_list]
+ set html_p [snd $value_list]
+ km_save_object_content -html_p $html_p $question_id $object_id $user_id $content
+ km_update_descriptions \
+ -short_description $short_description -long_description $long_description \
+ -html_p $html_p $object_id $question_id $content
+ }
+ "file" {
+ set filename [fst $value_list]
+ if ![empty_string_p $filename] {
+ # First test if the file is empty. If so, we ignore it.
+
+ set tmpfilename [ns_queryget $question_id.tmpfile]
+ if [file size $tmpfilename] {
+ ns_cp $tmpfilename "[km_file_path]/$object_id.$question_id"
+
+ # switch from DOS (\) to UNIX (/) path separators.
+ regsub -all {\\} $filename "/" filename
+ set filename [file tail $filename]
+
+ km_save_object_content $question_id $object_id $user_id $filename
+ km_update_descriptions \
+ -short_description $short_description -long_description $long_description \
+ $object_id $question_id $filename
+ }
+ }
+ }
+ "integer" {
+ km_save_object_content $question_id $object_id $user_id [fst $value_list]
+ km_update_descriptions \
+ -short_description $short_description -long_description $long_description \
+ $object_id $question_id [fst $value_list]
+ }
+ "date" {
+ if [date_p $value_list] {
+ km_save_object_content $question_id $object_id $user_id $value_list
+ if { $question_id == $public_until } {
+ db_dml km_save_object_data_20 "
+ update sn_objects
+ set public_until=:value_list,
+ expired_warning_date = null
+ where object_id=:object_id"
+ }
+ if { $question_id == $start_date } {
+ db_dml km_save_object_data_22 "
+ update sn_objects
+ set start_date=:value_list
+ where object_id=:object_id"
+ }
+ if { $question_id == $end_date } {
+ db_dml km_save_object_data_24 "
+ update sn_objects
+ set end_date=:value_list
+ where object_id=:object_id"
+ }
+ km_update_descriptions \
+ -short_description $short_description -long_description $long_description \
+ $object_id $question_id [util_AnsiDatetoPrettyDate $value_list]
+ }
+ }
+ default {
+ ns_log Error "Unknown abstract_data_type in km_save_object_data: $abstract_data_type"
+ }
+ }
+ }
+ }
+
+ return
+}
+
+ad_proc km_append_object_content { {-html_p "f"} object_id question_id new_content } {
+
+ Similar to km_save_object_content, but appends text to an already existing
+ entry in sn_content.
+
+} {
+ set content [db_string km_append_object_content_1 "
+ select content from sn_content
+ where object_id=:object_id and question_id=:question_id" -default ""]
+
+ append content $new_content
+
+ km_save_object_content -html_p $html_p $question_id $object_id [ad_get_user_id] $content
+}
+
+ad_proc km_save_object_content { { -html_p ""} question_id object_id user_id content } {
+ Saves content into sn_content and and modification facts in sn_objects.
+} {
+ set user_id [ad_get_user_id]
+ set ip_address [ns_conn peeraddr]
+ db_transaction {
+ if {[string length [string trim $content]] == 0} {
+ db_dml km_save_object_content_2 {delete from sn_content
+ where question_id=:question_id and object_id=:object_id
+ }
+ db_exec_plsql km_save_object_content_10 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+ } else {
+ set html_p [ad_decode $html_p 0 "f" "t"]
+ set content_length [string bytelength $content]
+
+ db_exec_plsql km_save_object_content_10 {
+ begin
+ object.save_content (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_html_p => :html_p,
+ v_content_length => :content_length,
+ v_modifying_user => :user_id,
+ v_modifying_ip => :ip_address
+ );
+ end;
+ }
+
+ db_dml km_save_object_content_20 "
+ update sn_content
+ set content = empty_clob()
+ where object_id = :object_id and question_id = :question_id
+ returning content into :1" -clobs [list $content]
+
+ if {$content_length>4000} {
+ set content [string range $content 0 2000]
+ }
+
+ db_exec_plsql km_save_object_content_10 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+
+ }
+ }
+}
+
+ad_proc km_update_descriptions {
+ {
+ -short_description 0
+ -long_description 0
+ -html_p 0
+ }
+ object_id question_id content
+} {
+ Updates one_line_description and overview in sn_objects
+ if the question_id matches the given IDs.
+} {
+ if { [lsearch $short_description $question_id] == -1 && $question_id != $long_description } {
+ return
+ }
+
+ if [empty_string_p $html_p] { set html_p 0 }
+ set content [util_trim_string_with_hrefs [string trim $content] 2000]
+
+ if { [lsearch $short_description $question_id] != -1} {
+ if {$short_description==$question_id} {
+ set object_name [sn_striphtml $content]
+
+ db_dml km_update_descriptions_10 {
+ update sn_objects
+ set one_line_description = :object_name
+ where object_id = :object_id
+ }
+ } else {
+ set question1 [lindex $short_description 0]
+ set question2 [lindex $short_description 1]
+ set question3 [lindex $short_description 2]
+ db_dml km_update_descriptions_15 {
+ update sn_objects
+ set one_line_description = km_utilities.shortname_string(:object_id,:question1,:question2,:question3)
+ where object_id=:object_id}
+ }
+ } elseif { $question_id == $long_description } {
+ set decoded_html_p [ad_decode $html_p 0 "f" "t"]
+ db_dml km_update_descriptions_20 {
+ update sn_objects
+ set overview = :content, overview_html_p = :decoded_html_p
+ where object_id = :object_id
+ }
+ }
+}
+
+proc_doc km_map_object_answers { question_id object_id option_ids } {
+ Maps any number of answer_options to a
+} {
+ db_dml km_map_object_answers_1 "delete from sn_object_option_map where object_id=:object_id
+ and option_id in ( select option_id from sn_answer_options
+ where question_id = :question_id)"
+ foreach option_id $option_ids {
+ set sql "insert into sn_object_option_map (object_id, option_id) values (:object_id, :option_id)"
+ catch { [db_dml km_map_object_answers_2 $sql] }
+ }
+}
+
+ad_proc km_unoptionize_object { object_id question_id } {
+ Removes options for this object and question
+} {
+ db_dml km_unoptionize_object_1 "
+ delete from sn_object_option_map
+ where object_id = :object_id and
+ option_id in (select option_id from sn_answer_options where question_id = :question_id)"
+
+}
+
+proc_doc km_delete_object_data { object_id question_id } {
+ Removes the answer for a question. (Used for read-only questions.)
+} {
+ set abstract_data_type [db_string km_delete_object_data_1 "
+ select abstract_data_type from sn_questions where question_id = :question_id"]
+
+ switch $abstract_data_type {
+ "text" -
+ "integer" -
+ "date" {
+ db_dml km_delete_object_data_2 "
+ delete from sn_content where object_id=:object_id and question_id=:question_id"
+ }
+ "file" {
+ db_dml km_delete_object_data_3 "
+ delete from sn_content where object_id=:object_id and question_id=:question_id"
+ ns_unlink -nocomplain "[km_file_path]/$object_id.$question_id"
+ }
+ "option" { km_unoptionize_object $object_id $question_id }
+ "category" { km_uncategorize_object $object_id $question_id }
+ "other_category" { km_uncategorize_object $object_id $question_id }
+ default { ns_log Error "km_delete_object_data cannot handle abstract_data_type $abstract_data_type" }
+ }
+}
+
+
+# ********** Filters/Validators **********
+
+proc_doc km_filter_content_questions {question_ids abstract_data_types} {
+ Returns a list of question_ids that are actually a row in sn_content.
+} {
+ set questions [zip $question_ids $abstract_data_types]
+ set content [list]
+ foreach pair $questions {
+ set question_id [fst $pair]
+ set abstract_data_type [snd $pair]
+ if [lsearch [list text date upload] $abstract_data_type] >= 0 {
+ lappend filtered_questions $question_id
+ }
+ }
+ return $filtered_questions
+}
+
+proc_doc integer_p {number} "returns 1 if this is an integer" {
+ if [regexp {[^0-9]} $number] {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc filter_integers {char_list} {
+ returns a filtered list of characters in the list that are integers
+} {
+ set result [list]
+ foreach char $char_list {
+ if [integer_p $char] {lappend result $char}
+ }
+ return $result
+}
+
+proc_doc date_p {date} "returns 1 if this is a date" {
+ set result [catch {db_0or1row date_p "select to_date('$date') from dual"}]
+ if {$result} {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc_doc km_break_date {date} {
+ Breaks an Oracle date in the form YYYY-MM-DD up into a list YYYY MM DD
+} {
+ if {![regexp {([0-9]*)-.*} $date match YYYY]} { return ""}
+ if {![regexp {[0-9]*-([0-9]*)-*} $date match MM]} { return ""}
+ if {![regexp {[0-9]*-[0-9]*-([0-9]*)} $date match DD]} {return ""}
+
+ return [list $YYYY $MM $DD]
+}
+
+proc_doc empty_date_p {date} "returns 1 if this is an empty date in the form xx--" {
+
+ if [regexp {.+-.+-.+} $date] {return 0}
+ return 1
+}
+
+# Serve the abstract URL
+# download/<object_id>.<question_id>/<client_filename>
+
+proc km_serve_document {} {
+ if { ![regexp {/download/([0-9]+)\.([0-9]+)/([^/]+)$} [ns_conn url] match object_id question_id client_filename] } {
+ ad_return_warning "Malformed Document Request" \
+ "Your request for a document was malformed."
+ return
+ }
+
+ if [km_check_object_id $object_id] {
+ ns_returnfile 200 [ns_guesstype $client_filename] "[km_file_path]/$object_id.$question_id"
+ }
+}
+
+ad_proc set_the_usual_klib_context_bar { object_id {category_id ""} {pre_url ""} } {
+ Display normal klib context bar - you have to use km_check_object_id first
+} {
+ set object_type_id [km_conn object_type_id]
+ set object_name [km_conn object_name]
+ set object_link "${pre_url}object-view?[export_url_vars object_id category_id]"
+ set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+ if {[km_conn archived_p]} {
+ set pretty_type_plural "$pretty_type_plural (Archived)"
+ set archive t
+ }
+ set stripped_name [sn_striphtml $object_name]
+ set browse_type "${pre_url}browse-one-type?[export_url_vars object_type_id archive]"
+ set browse_category "${pre_url}browse-one-category?[export_url_vars object_type_id category_id archive]"
+ set ancestors [reverse [km_get_object_ancestors $object_id]]
+
+ if {![null_p $ancestors]} {
+ set context_list [km_ancestors_context_list $ancestors $category_id $pre_url]
+ lappend context_list [list $object_link $stripped_name]
+ eval set_context_bar_data -link_last $context_list
+ } elseif { ![empty_string_p $category_id] && ![string equal $category_id "none"] } {
+ set_context_bar_data -link_last \
+ [list $browse_type $pretty_type_plural] \
+ [list $browse_category [km_category_name $category_id]] \
+ [list $object_link $stripped_name]
+ } else {
+ set_context_bar_data -link_last [list $browse_type $pretty_type_plural] [list $object_link $stripped_name]
+ }
+}
+
+ad_proc km_other_category_set { object_id question_id content } {
+ Insert or update the text the user entered in the text field for category 'other'
+} {
+ if [empty_string_p $content] {
+ km_other_category_delete $object_id $question_id
+ } else {
+ set content_length [string bytelength $content]
+ set ip_address [ns_conn peeraddr]
+ set user_id [ad_conn user_id]
+
+ db_exec_plsql km_other_category_set_1 {
+ begin
+ object.save_content (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_html_p => 'f',
+ v_content_length => :content_length,
+ v_modifying_user => :user_id,
+ v_modifying_ip => :ip_address
+ );
+ end;
+ }
+
+ db_dml km_other_category_set_2 "
+ update sn_content
+ set content = empty_clob()
+ where object_id = :object_id and question_id = :question_id
+ returning content into :1" -clobs [list $content]
+
+ if {$content_length>4000} {
+ set content [string range $content 0 2000]
+ }
+
+ db_exec_plsql km_other_category_set_3 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+ }
+}
+
+ad_proc km_other_category_get { object_id question_id } {
+ Get the text the user entered in the text field for category 'other'
+} {
+ set result [db_string km_other_category_get {
+ select content
+ from sn_content
+ where object_id = :object_id
+ and question_id = :question_id
+ } -default ""]
+
+ return $result
+}
+
+ad_proc km_other_category_delete { object_id question_id } {
+ Delete the text the user entered in the text field for category 'other'
+} {
+ set ip_address [ns_conn peeraddr]
+ set user_id [ad_conn user_id]
+ set content [km_other_category_get $object_id $question_id
+
+ db_dml km_other_category_delete_1 {
+ delete from sn_content
+ where object_id = :object_id
+ and question_id = :question_id
+ }
+
+ db_exec_plsql km_other_category_delete_2 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+}
+
+ad_proc km_get_other_category_id { question_id } {
+ get the category_id of the category "other" - or the last category in
+ sorted list
+} {
+ set categories [db_list_of_lists check_other_category_id {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as other_category_id
+ from sw_category_dim
+ start with node_id = (select node_id from sn_questions where question_id = :question_id)
+ connect by prior node_id = parent_node_id
+ }]
+
+ set values [fst [transpose $categories]]
+ set ids [snd [transpose $categories]]
+ set found_pos [lsearch $values "Other"]
+ if {$found_pos > -1} {
+ set other_category_id [lindex $ids $found_pos]
+ } else {
+ set other_category_id [snd [fst [reverse $categories]]]
+ }
+ return $other_category_id
+}
+
+util_report_successful_library_load
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-psn-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-psn-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-psn-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,1770 @@
+# /tcl/km-psn-procs.tcl
+#
+# People Sharenet Procs.
+#
+# Created by timo@arsdigita.com in late October 2001
+#
+# $Id: km-psn-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+ad_proc -public portal_saved_applications { cf } {
+ Displays the list of the saved and unfinished applications for demand
+ descriptions.
+} {
+ set user_id [ad_conn user_id]
+ set return_url "[ad_conn url]?[ad_conn query]"
+
+ template::multirow create saved_applications project_name demand_name application_id library_url return_url
+
+ db_foreach portal_saved_applications_10 {
+ select o1.one_line_description as demand_name, a.object_id,
+ o2.one_line_description as project_name, a.application_id
+ from sn_objects o1, sn_objects o2, psn_res_applications a
+ where a.user_id = :user_id
+ and a.sent_p = 'f'
+ and o1.object_id = a.object_id
+ and o2.object_id = a.resource_req_id
+ } {
+ db_1row portal_saved_applications_20 {
+ select site_node.url(sn.node_id) as library_url
+ from site_nodes sn, acs_objects_description dsc
+ where sn.object_id = dsc.package_id
+ and dsc.object_id = :object_id
+ and rownum = 1
+ }
+ template::multirow append saved_applications $project_name $demand_name $application_id $library_url $return_url
+ }
+}
+
+ad_proc -public portal_approval_processes { cf } {
+ Displays the list of the approval workflows.
+} {
+ set user_id [ad_conn user_id]
+
+ set package_id [portal_arg $cf package_id]
+ if [empty_string_p $package_id] {
+ # grab the community_id
+ set where_sql "o.context_id in (select package_id
+ from sn_community_mounts_all cm
+ where cm.community_id = :community_id
+ and acs_permission.permission_p(package_id, :user_id, 'access') = 't')"
+ } else {
+ set where_sql "o.context_id = :package_id"
+ }
+
+ set last_package_id ""
+
+ template::multirow create task_list task_id enabled_date enabled_time started_date started_time state object_id object_name object_type_id object_type_pretty workflow_key task_name task_url submitter_id submitter_name package_id package_name package_url
+
+ db_transaction {
+ if { [empty_string_p $package_id] } {
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set community_id $node(package_id)
+
+ db_dml check_package_access "
+ insert into yp_package_access
+ select p.package_id
+ from sn_community_mounts cm, apm_packages p
+ where cm.community_id = :community_id
+ and p.package_id = cm.package_id
+ and p.package_key = 'library'
+ and [tcl_permission_for_bind_vars_p "p.package_id" ":user_id" "'access'"] = 't'
+ "
+ } else {
+ db_dml check_package_access_one {
+ insert into yp_package_access
+ select :package_id
+ from dual
+ where acs_permission.permission_p(:package_id, :user_id, 'access') = 't'
+ }
+ }
+
+ db_foreach get_workflows {
+ select t.task_id, t.state, c.object_id, o.object_type_id,
+ t.enabled_date, t.started_date,
+ to_char(t.enabled_date, 'HH24;MI') as enabled_time_pretty,
+ to_char(t.started_date, 'HH24:MI') as started_time_pretty,
+ ot.pretty_name as object_type_pretty, o.one_line_description as object_name,
+ c.workflow_key, t.transition_name as task_name, u.user_id as submitter_id,
+ u.first_names || ' ' || u.last_name as submitter_name,
+ o.context_id as package_id
+ from wf_cases c, sn_objects o, sn_object_types ot, wf_user_tasks t,
+ users u, acs_objects ao, yp_package_access ypa
+ where c.case_id = t.case_id
+ and c.object_id = o.object_id
+ and ot.object_type_id = o.object_type_id
+ and t.user_id = :user_id
+ and (t.state = 'enabled' or (t.state = 'started' and t.holding_user = t.user_id))
+ and c.workflow_key = 'library_approval_wf'
+ and ao.object_id = c.case_id
+ and ao.creation_user = u.user_id
+ and o.context_id = ypa.package_id
+ order by o.context_id, t.transition_name, t.enabled_date desc, ot.pretty_name, o.one_line_description
+ } {
+ if {$package_id != $last_package_id} {
+ set last_package_id $package_id
+ db_1row get_package_data {
+ select site_node.url(n.node_id) as package_url, p.instance_name as package_name
+ from site_nodes n, apm_packages p
+ where n.object_id = :package_id
+ and p.package_id = :package_id
+ and rownum = 1
+ }
+ }
+
+ template::multirow append task_list $task_id \
+ [util_AnsiDatetoPrettyDate $enabled_date] $enabled_time_pretty \
+ [util_AnsiDatetoPrettyDate $started_date] $started_time_pretty \
+ $state $object_id $object_name $object_type_id $object_type_pretty \
+ $workflow_key $task_name "../approval-tasks/task?task_id=$task_id" \
+ $submitter_id $submitter_name $package_id $package_name $package_url
+ }
+ }
+}
+
+ad_proc -public km_sweeper_daily { } {
+ db_transaction {
+ km_sweeper_warn "outdated"
+ km_sweeper_warn "expired"
+ km_sweeper "outdated"
+ km_sweeper "expired"
+ }
+}
+
+ad_proc -private km_sweeper_warn { time } {
+} {
+ if {[string equal $time "expired"]} {
+ set time_sql "o.expired_warning_date is null and o.public_until is not null and o.public_until + 1 - ot.sweeper_warning_time < sysdate"
+ } else {
+ set time_sql "o.outdated_warning_date is null and o.last_modified + ot.sweeper_outdated_time - ot.sweeper_warning_time < sysdate"
+ }
+
+ db_transaction {
+ ################
+ ## process the single objects
+ ################
+ set count 0
+ db_foreach get_outdated_objects_for_warning "
+ select o.object_id, o.object_type_id, o.one_line_description as object_name,
+ ot.pretty_name as object_type, o.original_author_id, o.context_id,
+ ot.sweeper_action, (sysdate - o.last_modified) as days_unchanged,
+ ot.sweeper_warning_time
+ from sn_objects o, sn_object_types ot
+ where ot.object_type_id = o.object_type_id
+ and o.public_p = 't'
+ and o.archived_p = 'f'
+ and o.expiration_date > sysdate
+ and ot.sweeper = :time
+ and ot.sweeper_warning_time > 0
+ and $time_sql
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_object_name $object_name
+ lappend o_object_type $object_type
+ lappend o_original_author_id $original_author_id
+ lappend o_context_id $context_id
+ lappend o_sweeper_action $sweeper_action
+ lappend o_days_unchanged $days_unchanged
+ lappend o_sweeper_warning_time $sweeper_warning_time
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ object_name $o_object_name object_type $o_object_type \
+ original_author_id $o_original_author_id \
+ context_id $o_context_id sweeper_action $o_sweeper_action \
+ days_unchanged $o_days_unchanged \
+ sweeper_warning_time $o_sweeper_warning_time {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ ## set mail_body [km_sweeper_single_objects_warning_mail $time $sweeper_action $object_type $object_name $object_id $days_unchanged $sweeper_warning_time]
+ set mail_body "$object_name ([ad_url]/o/$object_id)\n"
+
+ db_dml warn_single_object_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:original_author_id, :context_id, :object_type_id, :object_id, :object_name, :mail_body)
+ }
+ }
+
+ ## now register that warnings got send for these objects
+ db_dml object_warnings "
+ update sn_objects
+ set $time\_warning_date = trunc(sysdate)
+ where object_id in (select o.object_id
+ from sn_objects o, sn_object_types ot
+ where ot.object_type_id = o.object_type_id
+ and o.public_p = 't'
+ and o.archived_p = 'f'
+ and ot.sweeper = :time
+ and ot.sweeper_warning_time > 0
+ and $time_sql )
+ "
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_object_name
+ unset o_object_type
+ unset o_original_author_id
+ unset o_context_id
+ unset o_sweeper_action
+ unset o_days_unchanged
+ unset o_sweeper_warning_time
+
+ }
+
+ ################
+ ## now send all the email, one per user, ordered by object_type
+ ################
+ set mail ""
+ set last_user_id ""
+ set last_user_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set count 0
+ db_foreach get_mail_bodies_per_user {
+ select u.user_id, u.email as user_email, s.content as mail_body,
+ ot.object_type_id, ot.pretty_plural as object_type,
+ p.instance_name as package_name, s.package_id,
+ p2.instance_name as community_name, ci.community_id,
+ ot.sweeper_warning_time, ot.sweeper_outdated_time
+ from km_sweeper s, users u, sn_object_types ot,
+ sn_community_instances ci, apm_packages p, apm_packages p2
+ where u.user_id = s.user_id
+ and s.object_type_id = ot.object_type_id
+ and ci.package_id = s.package_id
+ and p.package_id = s.package_id
+ and p2.package_id = ci.community_id
+ order by s.user_id, p2.instance_name, p.instance_name,
+ ot.pretty_plural, s.object_name
+ } {
+ lappend o_user_id $user_id
+ lappend o_user_email $user_email
+ lappend o_mail_body $mail_body
+ lappend o_object_type_id $object_type_id
+ lappend o_object_type $object_type
+ lappend o_package_name $package_name
+ lappend o_package_id $package_id
+ lappend o_community_name $community_name
+ lappend o_community_id $community_id
+ lappend o_sweeper_warning_time $sweeper_warning_time
+ lappend o_sweeper_outdated_time [expr $sweeper_outdated_time - $sweeper_warning_time]
+ incr count
+ }
+
+ if {$count>0} {
+ foreach user_id $o_user_id user_email $o_user_email \
+ mail_body $o_mail_body object_type_id $o_object_type_id \
+ object_type $o_object_type package_name $o_package_name \
+ package_id $o_package_id community_name $o_community_name \
+ community_id $o_community_id \
+ sweeper_warning_time $o_sweeper_warning_time \
+ sweeper_outdated_time $o_sweeper_outdated_time {
+
+ if {($last_user_id != $user_id) && ![empty_string_p $last_user_id]} {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $last_user_email]
+
+ et_queue_email [et_process "km_sweeper_warn" $replacement_list]
+ set last_user_id ""
+ set last_user_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set mail ""
+ }
+ if {$last_community_id != $community_id} {
+ append mail "Community: $community_name\n===========\n"
+ set last_community_id $community_id
+ }
+ if {$last_package_id != $package_id} {
+ append mail "\n$package_name:\n===========\n"
+ set last_package_id $package_id
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append mail "\n$object_type:\n===========\n\n"
+ if {![string equal $time "expired"]} {
+ append mail "The following objects haven't been changed in the last $sweeper_outdated_time days. "
+ }
+ append mail "Please change the objects in the next $sweeper_warning_time days:\n\n"
+ set last_object_type_id $object_type_id
+ }
+ append mail $mail_body
+ set last_user_id $user_id
+ set last_user_email $user_email
+ }
+ if ![empty_string_p $mail] {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $user_email]
+
+ et_queue_email [et_process "km_sweeper_warn" $replacement_list]
+ }
+
+ unset o_user_id
+ unset o_user_email
+ unset o_mail_body
+ unset o_object_type_id
+ unset o_object_type
+ unset o_package_name
+ unset o_package_id
+ unset o_community_name
+ unset o_community_id
+ unset o_sweeper_warning_time
+ unset o_sweeper_outdated_time
+ }
+
+ ################
+ ## now send the email to object publisher
+ ## one per user, ordered by object_type
+ ################
+ set mail ""
+ set last_publisher_id ""
+ set last_publisher_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set count 0
+ db_foreach get_publisher_mail_bodies_per_user {
+ select u.user_id as publisher_id, u.email as publisher_email,
+ s.content as mail_body, ot.object_type_id,
+ ot.pretty_plural as object_type,
+ p.instance_name as package_name, s.package_id,
+ p2.instance_name as community_name, ci.community_id,
+ ot.sweeper_warning_time, ot.sweeper_outdated_time
+ from km_sweeper s, users u, sn_object_types ot, sn_objects o,
+ sn_community_instances ci, apm_packages p, apm_packages p2
+ where u.user_id = o.publisher_id
+ and o.publisher_id <> s.user_id
+ and s.object_id = o.object_id
+ and s.object_type_id = ot.object_type_id
+ and ci.package_id = s.package_id
+ and p.package_id = s.package_id
+ and p2.package_id = ci.community_id
+ and s.package_id in (select distinct ac.package_id
+ from approval_coordinators ac)
+ order by s.user_id, p2.instance_name, p.instance_name,
+ ot.pretty_plural, s.object_name
+ } {
+ lappend o_publisher_id $publisher_id
+ lappend o_publisher_email $publisher_email
+ lappend o_mail_body $mail_body
+ lappend o_object_type_id $object_type_id
+ lappend o_object_type $object_type
+ lappend o_package_name $package_name
+ lappend o_package_id $package_id
+ lappend o_community_name $community_name
+ lappend o_community_id $community_id
+ lappend o_sweeper_warning_time $sweeper_warning_time
+ lappend o_sweeper_outdated_time [expr $sweeper_outdated_time - $sweeper_warning_time]
+ incr count
+ }
+
+ if {$count>0} {
+ foreach publisher_id $o_publisher_id publisher_email $o_publisher_email \
+ mail_body $o_mail_body object_type_id $o_object_type_id \
+ object_type $o_object_type package_name $o_package_name \
+ package_id $o_package_id community_name $o_community_name \
+ community_id $o_community_id \
+ sweeper_warning_time $o_sweeper_warning_time \
+ sweeper_outdated_time $o_sweeper_outdated_time {
+
+ if {($last_publisher_id != $publisher_id) && ![empty_string_p $last_publisher_id]} {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $last_publisher_email]
+
+ et_queue_email [et_process "km_sweeper_warn_publisher" $replacement_list]
+ set last_publisher_id ""
+ set last_publisher_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set mail ""
+ }
+ if {$last_community_id != $community_id} {
+ append mail "Community: $community_name\n===========\n"
+ set last_community_id $community_id
+ }
+ if {$last_package_id != $package_id} {
+ append mail "\n$package_name:\n===========\n"
+ set last_package_id $package_id
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append mail "\n$object_type:\n===========\n\n"
+ if {![string equal $time "expired"]} {
+ append mail "The following objects haven't been changed in the last $sweeper_outdated_time days. "
+ }
+ append mail "Please change the objects in the next $sweeper_warning_time days:\n\n"
+ set last_object_type_id $object_type_id
+ }
+ append mail $mail_body
+ set last_publisher_id $publisher_id
+ set last_publisher_email $publisher_email
+ }
+ if ![empty_string_p $mail] {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $publisher_email]
+
+ et_queue_email [et_process "km_sweeper_warn_publisher" $replacement_list]
+ }
+
+ unset o_publisher_id
+ unset o_publisher_email
+ unset o_mail_body
+ unset o_object_type_id
+ unset o_object_type
+ unset o_package_name
+ unset o_package_id
+ unset o_community_name
+ unset o_community_id
+ unset o_sweeper_warning_time
+ unset o_sweeper_outdated_time
+ }
+
+ ###############
+ ## now cleanup: delete temp table
+ ###############
+ db_dml km_sweeper_cleanup {
+ delete from km_sweeper
+ }
+ }
+}
+
+# time: expired / outdated
+ad_proc -private km_sweeper { time } {
+ Sets objects with outdated publication date to private and sends an email
+ notification to the object owner
+} {
+ if {[string equal $time "expired"]} {
+ set time_sql "(o.public_until is not null and o.public_until+1 < sysdate and (o.expired_warning_date is null or o.expired_warning_date + ot.sweeper_warning_time < sysdate))"
+ set time_sql2 "(o2.public_until is not null and o2.public_until+1 < sysdate and (o2.expired_warning_date is null or o2.expired_warning_date + ot2.sweeper_warning_time < sysdate))"
+ } else {
+ set time_sql "(o.last_modified + ot.sweeper_outdated_time < sysdate and (o.outdated_warning_date is null or o.outdated_warning_date + ot.sweeper_warning_time < sysdate))"
+ set time_sql2 "(o2.last_modified + ot2.sweeper_outdated_time < sysdate and (o2.outdated_warning_date is null or o2.outdated_warning_date + ot2.sweeper_warning_time < sysdate))"
+ }
+
+ db_transaction {
+ #################
+ ## deal with uncle objects that won't have public nephews any longer
+ #################
+ ## IMPORTANT NOTE: this supports only ONE hierarchy level in the sense
+ ## that only the DIRECT uncle of outdated objects will get private
+ ## - but then all it's descendants (multiple levels) will get private also
+ #################
+ set outdated_uncles [db_list get_uncles_need_private_status "
+ select foh.parent
+ from km_flat_object_hierarchy foh, sn_objects o, sn_object_types ot
+ where foh.parent = o.object_id
+ and o.public_p = 't'
+ and o.archived_p = 'f'
+ and o.expiration_date > sysdate
+ and o.object_type_id = ot.object_type_id
+ and not ((ot.sweeper = 'expired' and o.public_until is not null and o.public_until+1 < sysdate and (o.expired_warning_date is null or o.expired_warning_date + ot.sweeper_warning_time < sysdate))
+ or (ot.sweeper = 'outdated' and o.last_modified + ot.sweeper_outdated_time < sysdate and (o.outdated_warning_date is null or o.outdated_warning_date + ot.sweeper_warning_time < sysdate)))
+ and foh.link_type = 'uncle_nephew'
+ and exists (select 1
+ from sn_questions q, sn_question_object_type_map qotm,
+ sn_object_types ot3
+ where qotm.object_type_id = o.object_type_id
+ and qotm.question_id = q.question_id
+ and q.abstract_data_type = 'nephew_object'
+ and qotm.mandatory_p = 't'
+ and qotm.question_state = 'active'
+ and q.target_object_type_id = ot3.object_type_id
+ and ot3.sweeper = :time
+ and not exists (select 1
+ from sn_question_link_map qlm, sn_links l,
+ sn_objects o2, sn_object_types ot2
+ where qlm.question_id = q.question_id
+ and qlm.link_id = l.link_id
+ and l.object_id_a = o.object_id
+ and l.object_id_b = o2.object_id
+ and o2.object_type_id = ot2.object_type_id
+ and o2.public_p = 't'
+ and o2.archived_p = 'f'
+ and ot2.sweeper = :time
+ and not $time_sql2 ) )
+ order by foh.distance desc
+ "]
+
+ foreach outdated_uncle $outdated_uncles {
+ # check if uncle is still public and get uncle data
+ # get the questions that won't have any public nephews any longer
+ # get all nephews that result in private uncle
+ # get all other descendants
+ # send email to uncle owner
+ # loop over nephews again, but with different owner
+ # if different owner -> send email
+ # loop over other descendants again, but with different owner
+ # if different owner -> send email
+ # unpublish uncle and all descendants
+
+ db_1row get_outdated_uncle_object_data {
+ select o.object_id as uncle_id, o.object_type_id as uncle_object_type_id,
+ o.one_line_description as uncle_name, ot.sweeper_action,
+ ot.pretty_name as uncle_object_type, o.public_p, o.archived_p,
+ u.email as uncle_author_email, u.user_id as uncle_author_id,
+ u.first_names || ' ' || u.last_name as uncle_author, o.context_id,
+ ci.community_id, o.publisher_id as uncle_publisher_id
+ from sn_objects o, sn_object_types ot, users u,
+ sn_community_instances ci
+ where ot.object_type_id = o.object_type_id
+ and u.user_id = o.original_author_id
+ and o.object_id = :outdated_uncle
+ and ci.package_id = o.context_id
+ }
+
+ if [empty_string_p $uncle_name] {
+ set uncle_name "Unnamed $uncle_object_type"
+ }
+
+ ## if uncle of this object already got private, so did this object, so check
+ ## if it's still public
+ if {$public_p == "t" && $archived_p == "f"} {
+
+ if {[string equal $time "expired"]} {
+ set archive_sql "o.archived_p = 'f'"
+ set archive_sql2 "o2.archived_p = 'f'"
+ } else {
+ set archive_sql "o.public_p = 't'"
+ set archive_sql2 "o2.public_p = 't'"
+ }
+
+ ## get all violated questions with outdated nephews
+ set question_ids [db_list get_violated_questions "
+ select q.question_id
+ from sn_questions q, sn_question_object_type_map qotm,
+ sn_objects o, sn_object_types ot
+ where q.abstract_data_type = 'nephew_object'
+ and qotm.question_id = q.question_id
+ and qotm.mandatory_p = 't'
+ and qotm.question_state = 'active'
+ and qotm.object_type_id = o.object_type_id
+ and o.object_id = :uncle_id
+ and q.target_object_type_id = ot.object_type_id
+ and ot.sweeper = :time
+ and not exists (select 1
+ from sn_question_link_map qlm, sn_links l,
+ sn_objects o2, sn_object_types ot2
+ where qlm.question_id = q.question_id
+ and l.link_id = qlm.link_id
+ and l.object_id_a = :uncle_id
+ and l.object_id_b = o2.object_id
+ and o2.object_type_id = ot2.object_type_id
+ and o2.public_p = 't'
+ and o2.archived_p = 'f'
+ and ot2.sweeper = :time
+ and not $time_sql2 )
+ "]
+
+ ## get all outdated nephews for the violated questions
+ set last_object_type_id ""
+ set nephew_list ""
+ set nephew_ids [list]
+
+ db_foreach get_outdated_violating_nephews "
+ select o.object_id, o.object_type_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot, sn_question_link_map qlm,
+ sn_links l
+ where ot.object_type_id = o.object_type_id
+ and o.public_p = 't'
+ and o.archived_p = 'f'
+ and ot.sweeper = :time
+ and $time_sql
+ and l.object_id_a = :uncle_id
+ and l.object_id_b = o.object_id
+ and l.link_id = qlm.link_id
+ and qlm.question_id in ([join $question_ids ,])
+ order by o.object_type_id
+ " {
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {$last_object_type_id != $object_type_id} {
+ append nephew_list "\n$object_type_plural: $object_name"
+ } else {
+ append nephew_list ", $object_name"
+ }
+ set last_object_type_id $object_type_id
+ lappend nephew_ids $object_id
+ }
+
+ ## get all other public descendants
+ set last_object_type_id ""
+ set object_list ""
+
+ db_foreach get_all_other_public_descendants "
+ select o.object_id, o.object_type_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot, km_flat_object_hierarchy foh
+ where ot.object_type_id = o.object_type_id
+ and $archive_sql
+ and foh.parent = :uncle_id
+ and o.object_id = foh.child
+ and o.object_id not in ([join $nephew_ids ,])
+ order by o.object_type_id
+ " {
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {$last_object_type_id != $object_type_id} {
+ append object_list "\n$object_type_plural: $object_name"
+ } else {
+ append object_list ", $object_name"
+ }
+ set last_object_type_id $object_type_id
+ }
+
+ ## send email to object owner
+ set mail_body [km_sweeper_uncle_with_nephews_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $nephew_list $object_list]
+
+ db_dml uncle_with_nephews_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:uncle_author_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+
+ if {![empty_string_p $uncle_publisher_id] && $uncle_publisher_id != $uncle_author_id} {
+ db_dml uncle_with_nephews_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:uncle_publisher_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ }
+
+ ## get all outdated nephews for the violated questions with different
+ ## owners and send them email
+ ##################
+ set last_author_id ""
+ set last_object_type_id ""
+ set outdated_nephew_list ""
+ set count 0
+
+ db_foreach get_outdated_violating_nephews_other_owner "
+ select o.object_id, o.object_type_id, o.original_author_id as author_id,
+ o.one_line_description as object_name, u.email as author_email,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot, users u
+ where ot.object_type_id = o.object_type_id
+ and u.user_id = o.original_author_id
+ and u.user_id <> :uncle_author_id
+ and o.object_id in ([join $nephew_ids ,])
+ order by u.user_id, o.object_type_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_author_id $author_id
+ lappend o_object_name $object_name
+ lappend o_author_email $author_email
+ lappend o_object_type_plural $object_type_plural
+ lappend o_object_type $object_type
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ author_id $o_author_id author_email $o_author_email \
+ object_name $o_object_name object_type $o_object_type \
+ object_type_plural $o_object_type_plural {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {($last_author_id != $author_id) && ![empty_string_p $last_author_id]} {
+ set mail_body [km_sweeper_nephew_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $outdated_nephew_list $object_list]
+
+ db_dml uncle_with_nephews_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:author_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+
+ set last_object_type_id ""
+ set outdated_nephew_list ""
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append outdated_nephew_list "\n\n$object_type_plural:"
+ set last_object_type_id $object_type_id
+ set last_author_id $author_id
+ }
+ append outdated_nephew_list "\n$object_name ([ad_url]/o/$object_id)"
+ }
+ if ![empty_string_p $outdated_nephew_list] {
+
+ set mail_body [km_sweeper_nephew_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $outdated_nephew_list $object_list]
+
+ db_dml uncle_with_nephews_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:author_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_author_id
+ unset o_author_email
+ unset o_object_name
+ unset o_object_type
+ unset o_object_type_plural
+ }
+
+ ## get all other descendants with different owners and send them email
+ set last_author_id ""
+ set last_object_type_id ""
+ set descendants_list ""
+ set count 0
+
+ db_foreach get_all_other_public_descendants_other_owner "
+ select o.object_id, o.object_type_id, o.original_author_id as author_id,
+ o.one_line_description as object_name, u.email as author_email,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot, km_flat_object_hierarchy foh,
+ users u
+ where ot.object_type_id = o.object_type_id
+ and u.user_id = o.original_author_id
+ and u.user_id <> :uncle_author_id
+ and u.user_id not in (select distinct o2.original_author_id
+ from sn_objects o2
+ where o2.object_id in ([join $nephew_ids ,]))
+ and $archive_sql
+ and foh.parent = :uncle_id
+ and o.object_id = foh.child
+ and o.object_id not in ([join $nephew_ids ,])
+ order by u.user_id, o.object_type_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_author_id $author_id
+ lappend o_object_name $object_name
+ lappend o_author_email $author_email
+ lappend o_object_type_plural $object_type_plural
+ lappend o_object_type $object_type
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ author_id $o_author_id author_email $o_author_email \
+ object_name $o_object_name object_type $o_object_type \
+ object_type_plural $o_object_type_plural {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {($last_author_id != $author_id) && ![empty_string_p $last_author_id]} {
+ set mail_body [km_uncles_descendant_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $nephew_list $descendants_list]
+
+ db_dml uncle_with_nephews_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:author_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ set last_object_type_id ""
+ set descendants_list ""
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append descendants_list "\n\n$object_type_plural:"
+ set last_object_type_id $object_type_id
+ set last_author_id $author_id
+ }
+ append descendants_list "\n$object_name ([ad_url]/o/$object_id)"
+ }
+ if ![empty_string_p $descendants_list] {
+
+ set mail_body [km_uncles_descendant_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $nephew_list $descendants_list]
+
+ db_dml uncle_with_nephews_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:author_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_author_id
+ unset o_author_email
+ unset o_object_name
+ unset o_object_type
+ unset o_object_type_plural
+ }
+
+ ## get all outdated nephews for the violated questions with different
+ ## publishers and send them email
+ ##################
+ if {[empty_string_p $uncle_publisher_id]} {
+ set uncle_publisher_id 0
+ }
+ set last_publisher_id ""
+ set last_object_type_id ""
+ set outdated_nephew_list ""
+ set count 0
+
+ db_foreach get_outdated_violating_nephews_other_publisher "
+ select o.object_id, o.object_type_id, o.publisher_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot
+ where ot.object_type_id = o.object_type_id
+ and o.publisher_id is not null
+ and o.publisher_id <> :uncle_publisher_id
+ and o.publisher_id <> :uncle_author_id
+ and o.object_id in ([join $nephew_ids ,])
+ and o.publisher_id not in (select distinct o2.original_author_id
+ from sn_objects o2, km_flat_object_hierarchy foh
+ where foh.child = o2.object_id
+ and foh.parent = :uncle_id
+ and $archive_sql2)
+ order by o.publisher_id, o.object_type_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_publisher_id $publisher_id
+ lappend o_object_name $object_name
+ lappend o_object_type_plural $object_type_plural
+ lappend o_object_type $object_type
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ publisher_id $o_publisher_id object_name $o_object_name \
+ object_type $o_object_type \
+ object_type_plural $o_object_type_plural {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {($last_publisher_id != $publisher_id) && ![empty_string_p $last_publisher_id]} {
+ set mail_body [km_sweeper_nephew_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $outdated_nephew_list $object_list]
+
+ db_dml uncle_with_nephews_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+
+ set last_object_type_id ""
+ set outdated_nephew_list ""
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append outdated_nephew_list "\n\n$object_type_plural:"
+ set last_object_type_id $object_type_id
+ set last_publisher_id $publisher_id
+ }
+ append outdated_nephew_list "\n$object_name ([ad_url]/o/$object_id)"
+ }
+ if ![empty_string_p $outdated_nephew_list] {
+
+ set mail_body [km_sweeper_nephew_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $outdated_nephew_list $object_list]
+
+ db_dml uncle_with_nephews_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_publisher_id
+ unset o_object_name
+ unset o_object_type
+ unset o_object_type_plural
+ }
+
+ ## get all other descendants with different publisher
+ ## and send them email
+ set last_publisher_id ""
+ set last_object_type_id ""
+ set descendants_list ""
+ set count 0
+
+ db_foreach get_all_other_public_descendants_other_publisher "
+ select o.object_id, o.object_type_id, o.publisher_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot, km_flat_object_hierarchy foh
+ where ot.object_type_id = o.object_type_id
+ and o.publisher_id is not null
+ and o.publisher_id <> :uncle_author_id
+ and o.publisher_id not in (select distinct o2.publisher_id
+ from sn_objects o2
+ where o2.object_id in ([join $nephew_ids ,]))
+ and o.publisher_id not in (select distinct o2.original_author_id
+ from sn_objects o2, km_flat_object_hierarchy foh2
+ where foh2.child = o2.object_id
+ and foh2.parent = :uncle_id
+ and $archive_sql2)
+ and o.public_p = 't'
+ and foh.parent = :uncle_id
+ and o.object_id = foh.child
+ and o.object_id not in ([join $nephew_ids ,])
+ order by o.publisher_id, o.object_type_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_publisher_id $publisher_id
+ lappend o_object_name $object_name
+ lappend o_object_type_plural $object_type_plural
+ lappend o_object_type $object_type
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ publisher_id $o_publisher_id object_name $o_object_name \
+ object_type $o_object_type \
+ object_type_plural $o_object_type_plural {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {($last_publisher_id != $publisher_id) && ![empty_string_p $last_publisher_id]} {
+ set mail_body [km_uncles_descendant_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $nephew_list $descendants_list]
+
+ db_dml uncle_with_nephews_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ set last_object_type_id ""
+ set descendants_list ""
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append descendants_list "\n\n$object_type_plural:"
+ set last_object_type_id $object_type_id
+ set last_publisher_id $publisher_id
+ }
+ append descendants_list "\n$object_name ([ad_url]/o/$object_id)"
+ }
+ if ![empty_string_p $descendants_list] {
+
+ set mail_body [km_uncles_descendant_objects_mail $community_id $time $sweeper_action $uncle_object_type $uncle_name $uncle_id $uncle_author $nephew_list $descendants_list]
+
+ db_dml uncle_with_nephews_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :uncle_object_type_id, :uncle_id, :uncle_name, :mail_body)
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_publisher_id
+ unset o_object_name
+ unset o_object_type
+ unset o_object_type_plural
+ }
+
+ ## now finally unpublish / archive the uncle and all descendants
+ ##########
+ if {[string equal $sweeper_action "archive"]} {
+ foreach nephew_id $nephew_ids {
+ km_object_archive $nephew_id "object $time, archived by sweeper"
+ }
+ km_object_archive $uncle_id "linked objects $time, archived by sweeper"
+ } else {
+ km_object_unpublish $uncle_id
+ }
+ }
+ }
+
+ #################
+ ## deal with outdated parent objects
+ #################
+ set outdated_parents [db_list get_outdated_parent_objects "
+ select foh.parent
+ from km_flat_object_hierarchy foh, sn_objects o, sn_object_types ot
+ where foh.parent = o.object_id
+ and o.public_p = 't'
+ and o.archived_p = 'f'
+ and o.expiration_date > sysdate
+ and ot.object_type_id = o.object_type_id
+ and ot.sweeper = :time
+ and $time_sql
+ order by distance desc
+ "]
+
+ foreach outdated_parent $outdated_parents {
+ # check if object is still public and get object data
+ # loop over children, order by object_type
+ # append children to email
+ # loop over children with different owner, order by owner, object type
+ # if different child owner -> send email
+ # unpublish children, unpublish parent
+
+ db_1row get_outdated_parent_object_data {
+ select o.object_id as parent_id, o.object_type_id as parent_object_type_id,
+ o.one_line_description as parent_name, ot.sweeper_action,
+ ot.pretty_name as parent_object_type, o.public_p, o.archived_p,
+ u.email as parent_author_email, u.user_id as parent_author_id,
+ u.first_names || ' ' || u.last_name as parent_author,
+ trunc(sysdate - o.last_modified) as days_unchanged,
+ o.context_id, ci.community_id,
+ o.publisher_id as parent_publisher_id
+ from sn_objects o, sn_object_types ot, users u,
+ sn_community_instances ci
+ where ot.object_type_id = o.object_type_id
+ and u.user_id = o.original_author_id
+ and o.object_id = :outdated_parent
+ and ci.package_id = o.context_id
+ }
+
+ if [empty_string_p $parent_name] {
+ set parent_name "Unnamed $parent_object_type"
+ }
+
+ ## if parent of this object already got private, so did this object, so check
+ ## if it's still public
+ if {$public_p == "t" && $archived_p == "f"} {
+
+ ## create list of all children to be made private for the email to
+ ## the owner of the parent
+ set last_object_type_id ""
+ set object_list ""
+
+ if {[string equal $sweeper_action "archive"]} {
+ ## we have to archive all children, as long as they can
+ ## be archived (=> cut the tree off at this point)
+ set sql "( select o2.object_id
+ from km_flat_object_hierarchy foh, sn_objects o2, sn_object_types ot2
+ where foh.parent = :parent_id
+ and foh.child = o2.object_id
+ and o2.archived_p = 'f'
+ and o2.object_type_id = ot2.object_type_id
+ and ot2.archive_p = 't' )
+ minus
+ ( select child as object_id
+ from km_flat_object_hierarchy
+ where parent in (select o2.object_id
+ from km_flat_object_hierarchy foh, sn_objects o2,
+ sn_object_types ot2
+ where foh.parent = :parent_id
+ and foh.child = o2.object_id
+ and o2.archived_p = 'f'
+ and o2.object_type_id = ot2.object_type_id
+ and ot2.archive_p = 'f') )"
+
+ set sql "select o.object_id, o.object_type_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type, o.publisher_id
+ from sn_objects o, sn_object_types ot
+ where ot.object_type_id = o.object_type_id
+ and o.object_id in ($sql)
+ order by o.object_type_id"
+ } else {
+ ## we have to make all children private
+ set sql "select o.object_id, o.object_type_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type, o.publisher_id
+ from sn_objects o, sn_object_types ot, km_flat_object_hierarchy foh
+ where ot.object_type_id = o.object_type_id
+ and o.public_p = 't'
+ and foh.parent = :parent_id
+ and o.object_id = foh.child
+ order by o.object_type_id"
+ }
+
+ set child_list [list]
+ db_foreach get_all_children_of_parent $sql {
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {$last_object_type_id != $object_type_id} {
+ append object_list "\n$object_type_plural: $object_name"
+ } else {
+ append object_list ", $object_name"
+ }
+ set last_object_type_id $object_type_id
+ lappend child_list $object_id
+ }
+
+
+ ## send email to object owner
+ if {![llength $child_list]} {
+ ## so there are no children that will be put in the archive
+ ## so treat the parent as a single object
+ set mail_body [km_sweeper_single_objects_mail $community_id $time $sweeper_action $parent_object_type $parent_name $parent_id $days_unchanged]
+
+ db_dml object_without_children_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:parent_author_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+
+ if {![empty_string_p $parent_publisher_id] && $parent_publisher_id != $parent_author_id} {
+ db_dml object_without_children_outdated {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:parent_publisher_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+ }
+
+ } else {
+ ## so there are actually children
+ set mail_body [km_sweeper_object_with_children_mail $community_id $time $sweeper_action $parent_object_type $parent_name $parent_id $days_unchanged $object_list]
+
+ db_dml object_with_children_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:parent_author_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+
+ if {![empty_string_p $parent_publisher_id] && $parent_publisher_id != $parent_author_id} {
+ db_dml object_with_children_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:parent_publisher_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+ }
+
+ set last_author_id ""
+ set last_object_type_id ""
+ set object_list ""
+ set count 0
+
+ ## if children owner is not the same as parent owner, sent him
+ ## an email
+ #############
+ db_foreach get_all_children_of_parent_other_owner "
+ select o.object_id, o.object_type_id, o.original_author_id as author_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type
+ from sn_objects o, sn_object_types ot
+ where ot.object_type_id = o.object_type_id
+ and o.original_author_id <> :parent_author_id
+ and o.object_id in ([join $child_list ,])
+ order by o.original_author_id, o.object_type_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_author_id $author_id
+ lappend o_object_name $object_name
+ lappend o_object_type_plural $object_type_plural
+ lappend o_object_type $object_type
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ author_id $o_author_id object_name $o_object_name \
+ object_type $o_object_type \
+ object_type_plural $o_object_type_plural {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {($last_author_id != $author_id) && ![empty_string_p $last_author_id]} {
+ set mail_body [km_sweeper_child_object_mail $community_id $time $sweeper_action $parent_object_type $parent_name $parent_id $parent_author $days_unchanged $object_list]
+
+ db_dml child_objects_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:author_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+ set last_object_type_id ""
+ set object_list ""
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append object_list "\n\n$object_type_plural:"
+ set last_object_type_id $object_type_id
+ set last_author_id $author_id
+ }
+ append object_list "\n$object_name ([ad_url]/o/$object_id)"
+ }
+ if ![empty_string_p $object_list] {
+ set mail_body [km_sweeper_child_object_mail $community_id $time $sweeper_action $parent_object_type $parent_name $parent_id $parent_author $days_unchanged $object_list]
+
+ db_dml child_objects_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:author_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_author_id
+ unset o_object_name
+ unset o_object_type
+ unset o_object_type_plural
+ }
+
+ set last_publisher_id ""
+ set last_object_type_id ""
+ set object_list ""
+ set count 0
+
+ ## if children publisher is not the same as of parent, sent him
+ ## an email
+ #############
+ if {[empty_string_p $parent_publisher_id]} {
+ set parent_publisher_id 0
+ }
+ db_foreach get_all_children_of_parent_other_publisher "
+ select o.object_id, o.object_type_id,
+ o.one_line_description as object_name,
+ ot.pretty_plural as object_type_plural,
+ ot.pretty_name as object_type, o.publisher_id
+ from sn_objects o, sn_object_types ot
+ where ot.object_type_id = o.object_type_id
+ and o.publisher_id <> :parent_publisher_id
+ and o.publisher_id <> :parent_author_id
+ and o.publisher_id is not null
+ and o.object_id in ([join $child_list ,])
+ and o.publisher_id not in (select distinct o2.original_author_id
+ from sn_objects o2
+ where o2.object_id in ([join $child_list ,]))
+ order by o.publisher_id, o.object_type_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_publisher_id $publisher_id
+ lappend o_object_name $object_name
+ lappend o_object_type_plural $object_type_plural
+ lappend o_object_type $object_type
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ publisher_id $o_publisher_id object_name $o_object_name \
+ object_type $o_object_type \
+ object_type_plural $o_object_type_plural {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ if {($last_publisher_id != $publisher_id) && ![empty_string_p $last_publisher_id]} {
+ set mail_body [km_sweeper_child_object_mail $community_id $time $sweeper_action $parent_object_type $parent_name $parent_id $parent_author $days_unchanged $object_list]
+
+ db_dml child_objects_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+ set last_object_type_id ""
+ set object_list ""
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append object_list "\n\n$object_type_plural:"
+ set last_object_type_id $object_type_id
+ set last_publisher_id $publisher_id
+ }
+ append object_list "\n$object_name ([ad_url]/o/$object_id)"
+ }
+ if ![empty_string_p $object_list] {
+ set mail_body [km_sweeper_child_object_mail $community_id $time $sweeper_action $parent_object_type $parent_name $parent_id $parent_author $days_unchanged $object_list]
+
+ db_dml child_objects_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :parent_object_type_id, :parent_id, :parent_name, :mail_body)
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_publisher_id
+ unset o_object_name
+ unset o_object_type
+ unset o_object_type_plural
+ }
+ }
+
+ ## now finally archive/publish the objects
+ if {[string equal $sweeper_action "archive"]} {
+ km_object_archive $parent_id "object $time, archived by sweeper"
+ } else {
+ km_object_unpublish $parent_id
+ }
+ }
+ }
+
+ ################
+ ## now process the single objects
+ ################
+ set count 0
+ db_foreach get_outdated_single_objects "
+ select o.object_id, o.object_type_id, o.one_line_description as object_name,
+ ot.pretty_name as object_type, o.original_author_id, o.context_id,
+ ot.sweeper_action, trunc(sysdate - o.last_modified) as days_unchanged,
+ ci.community_id, o.publisher_id
+ from sn_objects o, sn_object_types ot, sn_community_instances ci
+ where ot.object_type_id = o.object_type_id
+ and o.public_p = 't'
+ and o.archived_p = 'f'
+ and o.expiration_date > sysdate
+ and ot.sweeper = :time
+ and $time_sql
+ and ci.package_id = o.context_id
+ " {
+ lappend o_object_id $object_id
+ lappend o_object_type_id $object_type_id
+ lappend o_object_name $object_name
+ lappend o_object_type $object_type
+ lappend o_original_author_id $original_author_id
+ lappend o_context_id $context_id
+ lappend o_sweeper_action $sweeper_action
+ lappend o_days_unchanged $days_unchanged
+ lappend o_community_id $community_id
+ lappend o_publisher_id $publisher_id
+ incr count
+ }
+
+ if {$count>0} {
+ foreach object_id $o_object_id object_type_id $o_object_type_id \
+ object_name $o_object_name object_type $o_object_type \
+ original_author_id $o_original_author_id context_id $o_context_id \
+ sweeper_action $o_sweeper_action days_unchanged $o_days_unchanged \
+ community_id $o_community_id publisher_id $o_publisher_id {
+
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+
+ set mail_body [km_sweeper_single_objects_mail $community_id $time $sweeper_action $object_type $object_name $object_id $days_unchanged]
+
+ db_dml single_object_outdated {
+ insert into km_sweeper (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:original_author_id, :context_id, :object_type_id, :object_id, :object_name, :mail_body)
+ }
+
+ if {![empty_string_p $publisher_id] && $publisher_id != $original_author_id} {
+ db_dml single_object_outdated_publisher {
+ insert into km_sweeper_publisher (user_id, package_id, object_type_id, object_id, object_name, content)
+ values (:publisher_id, :context_id, :object_type_id, :object_id, :object_name, :mail_body)
+ }
+ }
+
+ if {[string equal $sweeper_action "archive"]} {
+ km_object_archive $object_id "object $time, archived by sweeper"
+ } else {
+ km_object_unpublish $object_id
+ }
+ }
+
+ unset o_object_id
+ unset o_object_type_id
+ unset o_object_name
+ unset o_object_type
+ unset o_original_author_id
+ unset o_context_id
+ unset o_sweeper_action
+ unset o_days_unchanged
+ unset o_community_id
+ unset o_publisher_id
+ }
+
+ ###########################
+ ## now send all the email, one per user, ordered by object_type
+ ###########################
+ set mail ""
+ set last_user_id ""
+ set last_user_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set count 0
+ db_foreach get_mail_bodies_per_user {
+ select u.user_id, u.email as user_email, s.content as mail_body,
+ ot.object_type_id, ot.pretty_plural as object_type,
+ p.instance_name as package_name, s.package_id,
+ p2.instance_name as community_name, ci.community_id
+ from km_sweeper s, users u, sn_object_types ot,
+ sn_community_instances ci, apm_packages p, apm_packages p2
+ where u.user_id = s.user_id
+ and s.object_type_id = ot.object_type_id
+ and ci.package_id = s.package_id
+ and p.package_id = s.package_id
+ and p2.package_id = ci.community_id
+ order by s.user_id, p2.instance_name, p.instance_name,
+ ot.pretty_plural, s.object_name
+ } {
+ lappend o_user_id $user_id
+ lappend o_user_email $user_email
+ lappend o_mail_body $mail_body
+ lappend o_object_type_id $object_type_id
+ lappend o_object_type $object_type
+ lappend o_package_name $package_name
+ lappend o_package_id $package_id
+ lappend o_community_name $community_name
+ lappend o_community_id $community_id
+ incr count
+ }
+
+ if {$count>0} {
+ foreach user_id $o_user_id user_email $o_user_email \
+ mail_body $o_mail_body object_type_id $o_object_type_id \
+ object_type $o_object_type package_name $o_package_name \
+ package_id $o_package_id community_name $o_community_name \
+ community_id $o_community_id {
+
+ if {($last_user_id != $user_id) && ![empty_string_p $last_user_id]} {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $last_user_email]
+
+ et_queue_email [et_process "km_sweeper" $replacement_list]
+ set last_user_id ""
+ set last_user_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set mail ""
+ }
+ if {$last_community_id != $community_id} {
+ append mail "Community: $community_name\n===========\n\n"
+ set last_community_id $community_id
+ }
+ if {$last_package_id != $package_id} {
+ append mail "$package_name:\n===========\n\n"
+ set last_package_id $package_id
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append mail "$object_type:\n===========\n\n"
+ set last_object_type_id $object_type_id
+ }
+ append mail "$mail_body\n---------------\n\n"
+ set last_user_id $user_id
+ set last_user_email $user_email
+ }
+ if ![empty_string_p $mail] {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $user_email]
+
+ et_queue_email [et_process "km_sweeper" $replacement_list]
+ }
+
+ unset o_user_id
+ unset o_user_email
+ unset o_mail_body
+ unset o_object_type_id
+ unset o_object_type
+ unset o_package_name
+ unset o_package_id
+ unset o_community_name
+ unset o_community_id
+ }
+
+ ###########################
+ ## now send the email to object publisher
+ ## one per user, ordered by object_type
+ ###########################
+ set mail ""
+ set last_publisher_id ""
+ set last_publisher_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set count 0
+ db_foreach get_mail_bodies_per_publisher {
+ select u.user_id as publisher_id, u.email as publisher_email,
+ s.content as mail_body, ot.object_type_id,
+ ot.pretty_plural as object_type, p.instance_name as package_name,
+ s.package_id, p2.instance_name as community_name, ci.community_id
+ from km_sweeper_publisher s, users u, sn_object_types ot,
+ sn_community_instances ci, apm_packages p, apm_packages p2
+ where u.user_id = s.user_id
+ and s.object_type_id = ot.object_type_id
+ and ci.package_id = s.package_id
+ and p.package_id = s.package_id
+ and p2.package_id = ci.community_id
+ order by u.user_id, p2.instance_name, p.instance_name,
+ ot.pretty_plural, s.object_name
+ } {
+ lappend o_publisher_id $publisher_id
+ lappend o_publisher_email $publisher_email
+ lappend o_mail_body $mail_body
+ lappend o_object_type_id $object_type_id
+ lappend o_object_type $object_type
+ lappend o_package_name $package_name
+ lappend o_package_id $package_id
+ lappend o_community_name $community_name
+ lappend o_community_id $community_id
+ incr count
+ }
+
+ if {$count>0} {
+ foreach publisher_id $o_publisher_id publisher_email $o_publisher_email \
+ mail_body $o_mail_body object_type_id $o_object_type_id \
+ object_type $o_object_type package_name $o_package_name \
+ package_id $o_package_id community_name $o_community_name \
+ community_id $o_community_id {
+
+ if {($last_publisher_id != $publisher_id) && ![empty_string_p $last_publisher_id]} {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $last_publisher_email]
+
+ et_queue_email [et_process "km_sweeper_publisher" $replacement_list]
+ set last_publisher_id ""
+ set last_publisher_email ""
+ set last_community_id ""
+ set last_package_id ""
+ set last_object_type_id ""
+ set mail ""
+ }
+ if {$last_community_id != $community_id} {
+ append mail "Community: $community_name\n===========\n\n"
+ set last_community_id $community_id
+ }
+ if {$last_package_id != $package_id} {
+ append mail "$package_name:\n===========\n\n"
+ set last_package_id $package_id
+ }
+ if {$last_object_type_id != $object_type_id} {
+ append mail "$object_type:\n===========\n\n"
+ set last_object_type_id $object_type_id
+ }
+ append mail "$mail_body\n---------------\n\n"
+ set last_publisher_id $publisher_id
+ set last_publisher_email $publisher_email
+ }
+ if ![empty_string_p $mail] {
+ set replacement_list \
+ [list \
+ type $time \
+ mail_body $mail \
+ recipient $publisher_email]
+
+ et_queue_email [et_process "km_sweeper_publisher" $replacement_list]
+ }
+
+ unset o_publisher_id
+ unset o_publisher_email
+ unset o_mail_body
+ unset o_object_type_id
+ unset o_object_type
+ unset o_package_name
+ unset o_package_id
+ unset o_community_name
+ unset o_community_id
+ }
+
+ ##############
+ ## now cleanup: delete temp tables
+ ##############
+ db_dml km_sweeper_cleanup {
+ delete from km_sweeper
+ }
+ db_dml km_sweeper_publisher_cleanup {
+ delete from km_sweeper_publisher
+ }
+## end of transaction
+}
+}
+
+
+ad_proc km_sweeper_uncle_with_nephews_mail { community_id time action object_type object_name object_id nephew_list object_list } {
+} {
+ set template "km_sweeper_uncle_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id \
+ object_list $object_list \
+ nephew_list $nephew_list]
+ set result [et_process -community_id $community_id $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_sweeper_nephew_objects_mail { community_id time action object_type object_name object_id object_author nephew_list object_list } {
+} {
+ set template "km_sweeper_nephew_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id \
+ object_author $object_author \
+ object_list $object_list \
+ nephew_list $nephew_list]
+ set result [et_process -community_id $community_id $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_uncles_descendant_objects_mail { community_id time action object_type object_name object_id object_author nephew_list object_list } {
+} {
+ set template "km_sweeper_descendants_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id \
+ object_author $object_author \
+ object_list $object_list \
+ nephew_list $nephew_list]
+ set result [et_process -community_id $community_id $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_sweeper_object_with_children_mail { community_id time action object_type object_name object_id days_unchanged object_list } {
+} {
+ set template "km_sweeper_parent_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id \
+ object_list $object_list]
+ if {[string equal $time "outdated"]} {
+ lappend replace_list days_unchanged $days_unchanged
+ }
+ set result [et_process -community_id $community_id $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_sweeper_child_object_mail { community_id time action object_type object_name object_id object_author days_unchanged object_list } {
+} {
+ set template "km_sweeper_child_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id \
+ object_author $object_author \
+ object_list $object_list]
+ if {[string equal $time "outdated"]} {
+ lappend replace_list days_unchanged $days_unchanged
+ }
+ set result [et_process -community_id $community_id $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_sweeper_single_objects_mail { community_id time action object_type object_name object_id days_unchanged } {
+} {
+ set template "km_sweeper_single_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id]
+ if {[string equal $time "outdated"]} {
+ lappend replace_list days_unchanged $days_unchanged
+ }
+ set result [et_process -community_id $community_id $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_sweeper_single_objects_warning_mail { time action object_type object_name object_id days_unchanged days_untill_change } {
+} {
+ set template "km_warn_sweeper_$action\_$time"
+ set replace_list [list \
+ ad_url [ad_url] \
+ object_type $object_type \
+ object_name $object_name \
+ object_id $object_id \
+ days_untill_change $days_untill_change]
+ if {[string equal $time "outdated"]} {
+ lappend replace_list days_unchanged $days_unchanged
+ }
+ set result [et_process -community_id 0 $template $replace_list]
+
+ return [ns_set get $result body]
+}
+
+
+ad_proc km_copy_object { object_id target_id } {
+ copies the object object_id to the new object target_id.
+ copies only active questions and no parent-child/uncle-nephew questions
+} {
+ set user_id [ad_conn user_id]
+ set package_id [ad_conn package_id]
+ set ip_addr [ns_conn peeraddr]
+
+ db_1row get_object_name {
+ select one_line_description as object_name, object_type_id
+ from sn_objects
+ where object_id = :object_id
+ }
+ set object_type [km_static object_type_pretty_name $object_type_id]
+ if [empty_string_p $object_name] {
+ set object_name "Unnamed $object_type"
+ }
+ set msg "Copied from $object_type \"$object_name\""
+
+ db_transaction {
+ set target_id [db_exec_plsql create_object {
+ begin
+ :1 := object.copy_object (
+ v_object_id => :object_id,
+ v_target_id => :target_id,
+ v_creation_user => :user_id,
+ v_creation_ip => :ip_addr,
+ v_context_id => :package_id
+ );
+ end;
+ }]
+
+ db_exec_plsql grant_owner_permissions {
+ begin
+ acs_permission.grant_permission(:target_id, :user_id, 'read');
+ acs_permission.grant_permission(:target_id, :user_id, 'write');
+ acs_permission.grant_permission(:target_id, :user_id, 'delete');
+ end;
+ }
+
+ db_dml add_audit_entry {
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id,
+ content)
+ values
+ (:target_id, null, sysdate, :user_id, :msg)
+ }
+ }
+
+ return $target_id
+}
+
+ad_proc km_clean_sweeper_tmp_table { } {
+ Deletes all old data from sweepers temp table in the event that the sweeper
+ didn't finish.
+} {
+ db_dml km_sweeper_cleanup {
+ delete from km_sweeper
+ }
+ db_dml km_sweeper_publisher_cleanup {
+ delete from km_sweeper_publisher
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/tcl/km-users-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/km-users-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/km-users-procs.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,82 @@
+# /tcl/km-users.tcl
+# User centric knowledge management.
+# (My Objects, User Contributions, etc.)
+#
+# Created by carsten@arsdigita.com in June 2000
+#
+# $Id: km-users-procs.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+proc_doc km_workspace_toolbar {object_id {category_id ""} {child_p 0}} {
+
+ Show a toolbar to allow the user to add an object to his workspace
+ or list of alerts, or send it to a colleague.
+
+} {
+ set user_id [ad_conn user_id]
+ set original_author_id [km_conn original_author_id]
+
+ if { $user_id != $original_author_id } {
+ set parameters "[export_url_vars object_id category_id]&return_url=[ns_urlencode "object-view?[export_url_vars object_id category_id]"]"
+
+ }
+
+ # Always allow the user to send the page to a colleague.
+
+ set page_url "[ns_conn url]?[export_ns_set_vars url {path_id}]"
+ set return_title [km_conn object_name]
+
+ lappend result "<a href=\"send-page-ref?[export_url_vars object_id category_id page_url return_title]\">Send this page to a colleague</a>"
+
+ if { $user_id != $original_author_id && [km_conn public_p] && ![km_conn archived_p] } {
+ lappend result "<a href=\"comment-add?[export_url_vars object_id category_id]\">Give Feedback</a>"
+ }
+
+ set object_type_id [km_conn object_type_id]
+ set object_type [util_quotehtml [km_static object_type_pretty_name $object_type_id]]
+ set copy_p [km_static object_type_copy_p $object_type_id]
+ set create_p [km_conn create_p]
+ set write_p [km_conn write_p]
+ if {![km_static object_type_create_p $object_type_id]} {
+ set create_p 0
+ }
+
+ if {$create_p && !$child_p} {
+ lappend result "<a href=\"object-edit?object_type_id=$object_type_id\">Create new $object_type</a>"
+ }
+
+ if {$write_p && $copy_p && $create_p} {
+ lappend result "<a href=\"object-copy-1?[export_url_vars object_id category_id]\">Copy this $object_type</a>"
+ }
+
+ return [join $result " | "]
+}
+
+proc_doc km_list_user_searches {user_id} {
+
+ Returns a list of the searches the user has done in the past.
+ Each row looks like this: name url_params
+
+} {
+ set result [db_list_of_lists km_list_user_searches "
+ select name, url_params from km_library_searches
+ where user_id=:user_id
+ and name is not null"]
+
+ return $result
+}
+
+proc_doc km_user_info {user_id} {
+
+ Given an user_id, returns a list with
+ full name, email, affiliation, work phone, country
+
+} {
+ set result [km_db_1row_to_list km_user_info "
+ select first_names || ' ' || last_name, email
+ from users u
+ where u.user_id=$user_id"]
+ return $result
+}
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/tcl/library-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/tcl/library-init.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/tcl/library-init.tcl 2 Jul 2003 12:19:41 -0000 1.1
@@ -0,0 +1,69 @@
+# packages/library/tcl/library-init.tcl
+#
+# $Id: library-init.tcl,v 1.1 2003/07/02 12:19:41 peterm Exp $
+
+proc_doc excursion_timeout {} {
+
+ Returns the amount of time in hours that an excursion exists
+ before being timed out.
+
+} {
+ return 120
+}
+
+proc purge_old_paths {} {
+ set timeout [expr [excursion_timeout]/24]
+ db_dml purge_old_paths {
+ delete from km_path
+ where sysdate - start_time > :timeout
+ }
+}
+
+proc reset_access_counts_monthly {} {
+ if {[ns_fmttime [ns_time] "%e"] == 1} {
+ ns_log Notice "resetting access_month counts to 0"
+ db_dml reset_access_counts_monthly {
+ update sn_objects
+ set access_month = 0
+ where access_month <> 0
+ }
+ }
+}
+
+if { ([server_cluster_enabled_p] && [ad_canonical_server_p]) || ![server_cluster_enabled_p]} {
+ # Register sn_object with the bookmarks module, if it's present.
+ ad_call_proc_if_exists bookmarks::register_type "sn_object"
+ ad_call_proc_if_exists yp::register_type "sn_object"
+
+ # Do the same for incentives.
+ ad_call_proc_if_exists incentives::register_charge_category \
+ -key_usage key_with_default \
+ kl_rating_give library "Object feedback given"
+ ad_call_proc_if_exists incentives::register_charge_category \
+ -key_usage key_with_default \
+ -value_meaning factor \
+ kl_rating_receive library "Object feedback received"
+ ad_call_proc_if_exists incentives::register_charge_category \
+ -key_usage key_with_default \
+ kl_object_publish library "Objects published"
+
+ # Register library as a module which can be used in communities.
+ ad_call_proc_if_exists sn_community::register_package library library f f
+
+ # Register library as a module using category trees
+ ad_call_proc_if_exists categories::register_package library
+}
+
+# Register sweeper proc for outdated knowledge objects
+ad_schedule_daily -thread t 3 17 km_sweeper_daily
+
+ad_schedule_proc -once t 10 reset_access_counts_monthly
+
+# clear sweeper tmp table if sweeper didn't finish
+ad_schedule_daily 21 0 km_clean_sweeper_tmp_table
+
+#schedule emails for workflow tasks
+nsv_set library library_notifications_p 0
+ad_schedule_proc -thread t 300 library_approval_process_notifications
+
+ad_schedule_daily -thread t 3 15 purge_old_paths
Index: openacs-4/contrib/obsolete-packages/library/wf-templates/clarify.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/wf-templates/clarify.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/wf-templates/clarify.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,6 @@
+<ol>
+ <li>Hit 'Start task'
+ <li>Clarify the Knowledge Object. <a
+ href="/o/@object_id@">Click here to look at it</a>
+ <li>Hit 'Task done'
+</ol>
\ No newline at end of file
Index: openacs-4/contrib/obsolete-packages/library/wf-templates/object-info.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/wf-templates/object-info.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/wf-templates/object-info.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,2 @@
+@object_name@
+
Index: openacs-4/contrib/obsolete-packages/library/wf-templates/object-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/wf-templates/object-info.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/wf-templates/object-info.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,39 @@
+# /packages/ticket-tracker/wf-templates/ticket-info.tcl
+
+ad_page_contract {
+ Return info about an object.
+
+ @author Dirk Gomez (sharenet@dirkgomez.de)
+ @author Timo Hentschel (timo@arsdigita.com)
+ @creation-date 2002-02-27
+ @cvs-id $Id: object-info.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+}
+
+# task is one of the datasources specified in the <include> tag in /packages/acs-workflow/www/task.adp
+set object_id $task(object_id)
+
+if { ![db_0or1row get_object_info "
+ select o.object_type_id, o.one_line_description as object_name,
+ decode(o.public_p,'t',1,0) as public_p,
+ o.original_author_id, u.first_names || ' ' || u.last_name as original_author_name,
+ u.email as original_author_email
+ from sn_objects o, users u
+ where o.object_id = :object_id
+ and u.user_id = o.original_author_id
+"] } {
+ # Error: The object does not exist.
+
+ if { $print_errors_p } {
+ ad_return_exception_page 404 "Entry does not exist." "
+ The entry with id $object_id does not exist.
+ We never really delete object IDs from the database so this is quite
+ unusual. Unless you tried to hack the URL manually this might be a bug
+ in our software."
+ }
+ return 0
+}
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+set stripped_name [sn_striphtml $object_name]
+set object_name [km_get_object_name $object_id]
Index: openacs-4/contrib/obsolete-packages/library/wf-templates/review.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/wf-templates/review.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/wf-templates/review.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,6 @@
+<ol>
+ <li>Hit 'Start task
+ <li>Check to see if the object needs to be clarified. <a
+ href="/o/@object_id@">Click here to look at it</a>
+ <li>Select the appropriate answer, add a comment and hit 'Task done'
+</ol>
Index: openacs-4/contrib/obsolete-packages/library/wf-templates/verify.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/wf-templates/verify.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/wf-templates/verify.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,7 @@
+<ol>
+ <li>Hit 'Start task'
+ <li>Verify that the result is as you expected.
+ <li>If it is, select 'yes' at the right.
+ <li>If not, select 'no' at the right.
+ <li>Hit 'Task done'
+</ol>
\ No newline at end of file
Index: openacs-4/contrib/obsolete-packages/library/www/add-sharenet-ref.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/add-sharenet-ref.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/add-sharenet-ref.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,52 @@
+ad_page_contract {
+ /www/library/add-sharenet-ref.tcl
+
+ Called after the user has selected an existing or created a new
+ object. Appends a reference to this object to the question
+ associated with the current path.
+
+ @cvs-id $Id: add-sharenet-ref.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ path_id:notnull
+ object_id:notnull,integer
+}
+csrf::authenticate
+
+if ![path_valid_p $path_id] {
+ ad_return_error "Invalid Path" \
+ "The current path ID is invalid. Perhaps you used your browser's Back button
+ and tried to press the <cite>Link</cite> button a second time?"
+ return
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+
+# Determine to which object we are going to add the href,
+# and if the current user is allowed to do this.
+
+set values [get_path_values -action_only_p 0 $path_id]
+set original_object_id [value_from_tuples $values object_id]
+set sub_object_id [value_from_tuples $values sub_object_id]
+
+if ![km_check_object_id -check_edit_p 1 $original_object_id] { return }
+
+
+# OK, let's insert it.
+
+if [empty_string_p $sub_object_id] {
+ set question_id [value_from_tuples $values question_id]
+ set row_id $original_object_id
+} else {
+ set question_id [value_from_tuples $values subquestion_id]
+ set row_id $sub_object_id
+}
+
+km_append_object_content -html_p "t" $row_id $question_id \
+ "<a href=\"/o/$object_id\">[km_get_object_name $object_id]</a>"
+
+km_check_public_status_after_edit $row_id
+
+# All done, back to the path's origin.
+
+ad_returnredirect [get_path_return_url $path_id]
Index: openacs-4/contrib/obsolete-packages/library/www/add-web-ref-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/add-web-ref-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/add-web-ref-2.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,87 @@
+ad_page_contract {
+ /www/library/add-web-ref-2.tcl
+
+ Verify Web or email reference, and append it to the column given as
+ part of the path.
+
+ @cvs-id $Id: add-web-ref-2.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ path_id:notnull,integer
+ url
+ url_title
+}
+csrf::authenticate
+
+if ![path_valid_p $path_id] {
+ ad_return_error "Invalid Path" \
+ "The current path ID is invalid. Perhaps you used your browser's Back button
+ and tried to enter another Web/email reference?"
+ return
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# Determine to which object we are going to add the href,
+# and if the current user is allowed to do this.
+
+set values [get_path_values -action_only_p 0 $path_id]
+set object_id [value_from_tuples $values object_id]
+set sub_object_id [value_from_tuples $values sub_object_id]
+
+
+# Check the user input.
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set examples "
+ <ul>
+ <li>A valid URL would be something like <b>http://photo.net/philg/</b>,
+ <li>A valid E-mail address would be something like: <b>philg@mit.edu</b>.
+ </ul>"
+
+set exception_count 0
+set exception_text ""
+
+if { ![empty_string_p $url] && ![util_url_valid_p $url] && ![util_email_valid_p $url] } {
+ # There is a URL or email, but it doesn't match our REGEXP.
+
+ incr exception_count
+ append exception_text "<li>The text you entered: <b>$url</b> looks
+ neither like an URL nor like an E-mail address.
+ $examples
+ "
+}
+
+if [empty_string_p $url] {
+ incr exception_count
+ append exception_text "<li>Please enter an URL or an E-mail address.
+ $examples"
+}
+
+if { $exception_count > 0 } {
+ ad_return_complaint $exception_count $exception_text
+ return
+}
+
+if [empty_string_p $url_title] { set url_title $url }
+if [util_email_valid_p $url] { set url "mailto:$url" }
+
+
+# OK, let's append it.
+
+if [empty_string_p $sub_object_id] {
+ set question_id [value_from_tuples $values question_id]
+} else {
+ set question_id [value_from_tuples $values subquestion_id]
+ set object_id $sub_object_id
+}
+
+km_append_object_content -html_p "t" $object_id $question_id "<a href=\"$url\">$url_title</a>"
+
+km_check_public_status_after_edit $object_id
+
+# All done, back to the path's origin.
+
+ad_returnredirect [get_path_return_url $path_id]
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/add-web-ref.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/add-web-ref.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/add-web-ref.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,26 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form method=post action="@target@">
+<csrf-token>
+@form_vars;noquote@
+
+<table>
+<tr><td>
+
+<b>URL</b> - <i>example:</i> http://dir.yahoo.com/Arts/<br>
+or <b>E-mail address</b> - <i>example:</i> bugs@microsoft.com<br>
+<input type=text size=50 name=url>
+<p>
+<b>Title</b> -
+ <i>example:</i>
+Yahoo Arts page <i>or</i> Bill's E-mail address<br>
+(<i>This text will be blue, underlined and clickable</i>)<br>
+<input type=text size=50 name=url_title>
+
+</td></tr>
+
+<tr><td align=center><input type=submit name=submit value="Proceed"></td></tr>
+</table>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/add-web-ref.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/add-web-ref.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/add-web-ref.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,32 @@
+ad_page_contract {
+ /library/add-web-ref.tcl
+
+ @cvs-id $Id: add-web-ref.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ path_id:notnull,integer
+} -properties {
+ title:onevalue
+ target:onevalue
+ form_vars:onevalue
+}
+
+set return_url [get_path_return_url $path_id]
+set user_id [ad_maybe_redirect_for_registration]
+
+# Determine to which object we are going to add the href,
+# and if the current user is allowed to do this.
+
+set values [get_path_values -action_only_p 0 $path_id]
+set object_id [value_from_tuples $values object_id]
+set sub_object_id [value_from_tuples $values sub_object_id]
+set category_id [value_from_tuples $values category_id]
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set title "Add a Web/Email Reference"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data [list $return_url "Edit"] "Web/Email Reference"
+set target "add-web-ref-2"
+set form_vars [export_form_vars path_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/alert-categories.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert-categories.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert-categories.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,5 @@
+<include src="/packages/acs-subsite/www/alerts/alert"
+ included=1
+ category_id=@category_id@
+ content_type_id=@content_type_id@
+ return_uri=@return_uri;noquote@>
Index: openacs-4/contrib/obsolete-packages/library/www/alert-categories.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert-categories.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert-categories.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,9 @@
+ad_page_contract {
+ alerting.
+} {
+ return_uri
+ category_id:integer
+ content_type_id:integer
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/alert-instance.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert-instance.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert-instance.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,3 @@
+<include src="/packages/acs-subsite/www/alerts/alert"
+ included=1
+ return_uri=@return_uri;noquote@>
Index: openacs-4/contrib/obsolete-packages/library/www/alert-instance.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert-instance.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert-instance.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,7 @@
+ad_page_contract {
+ alerting.
+} {
+ return_uri
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/alert-types.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert-types.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert-types.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,4 @@
+<include src="/packages/acs-subsite/www/alerts/alert"
+ included=1
+ content_type_id=@object_type_id@
+ return_uri=@return_uri;noquote@>
Index: openacs-4/contrib/obsolete-packages/library/www/alert-types.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert-types.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert-types.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,10 @@
+ad_page_contract {
+ alerting.
+} {
+ return_uri
+ object_type_id:integer
+}
+
+if {![km_check_object_type_id $object_type_id]} { return }
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/alert.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,5 @@
+<include src="/packages/acs-subsite/www/alerts/alert"
+ included=1
+ object_id=@object_id@
+ content_type_id=@object_type_id@
+ return_uri=@return_uri;noquote@>
Index: openacs-4/contrib/obsolete-packages/library/www/alert.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/alert.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/alert.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,11 @@
+ad_page_contract {
+ alerting.
+} {
+ return_uri
+ object_id:integer
+}
+
+if {![km_check_object_id $object_id]} { return }
+
+set object_type_id [km_conn object_type_id]
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/browse-one-category.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/browse-one-category.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/browse-one-category.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,144 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width;noquote@</property>
+<property name="subsite_url">@subsite_url;noquote@</property>
+<property name="subsite_name">@subsite_name;noquote@</property>
+<property name="search_contexts">@search_contexts;noquote@</property>
+
+<include src="category-action" category_id=@category_id@ return_uri="@return_uri;noquote@" create_p=@create_p@ copy_p=@copy_p@ object_type_id=@object_type_id@ object_type_pretty_name="@object_type_pretty_name;noquote@" have_alert=@have_alert@>
+
+<if @category_id@ ne "none">
+ Number of objects in this category and it's subcategories (@total_num_objects@)<p>
+ View items modified in the last @age_bar;noquote@
+ <p>
+ <if @date_filter_p@ eq t>
+ <include src="date-filter" target="browse-one-category" start="@start_date@" end="@end_date@" start_offset="-5" end_offset="7" presentation_type="select" form_vars="@date_filter_vars;noquote@">
+ </if>
+
+ <table><tr>
+ <multiple name="categorization_widget_header">
+ <th bgcolor="#cccfff">@categorization_widget_header.header_name@</th>
+ </multiple>
+ </tr><tr>
+
+ <multiple name="categorization_widget">
+ <td valign="top">
+ <ul>
+
+ <group column=parent_node_id>
+ <li><a href="@categorization_widget.target@@categorization_widget.category_id@">@categorization_widget.category@</a> (@categorization_widget.sum_count;noquote@)
+ </group>
+ </multiple>
+ </td>
+</table>
+ <p>
+</if><else>
+Number of objects that are not categorized by @pretty_question@ (@total_num_objects@)<p>
+ <p>View items modified in the last @age_bar;noquote@
+</else>
+
+<if @num_displayed_objects@ eq 0>
+
+ <table>
+ <if @category_id@ ne "none">
+ <tr><td>View: <td>@object_view_bar_top_level;noquote@<br>
+ </if>
+ <if @archive_p@ eq 1>
+ <tr><td>Status:</td><td>@archive_bar;noquote@</td></tr>
+ </if>
+ <tr><td>Owner:</td><td>@ownership_bar;noquote@</td></tr>
+ <if @begin_letter@ ne "all">
+ <tr><td>Alphabet: <td>[
+ <multiple name="alphabet">
+ <if @alphabet.url@ not nil>
+ <a href="@alphabet.url@">@alphabet.letter@</a>
+ </if>
+ <else>
+ <b>@alphabet.letter@</b>
+ </else>
+ </multiple>]
+ </tr>
+ </if>
+ </table>
+ <p>No objects here.
+
+</if><else>
+
+ <table>
+ <if @category_id@ ne "none">
+ <tr><td>View: <td>@object_view_bar_top_level;noquote@<br>
+ </if>
+ <if @archive_p@ eq 1>
+ <tr><td>Status:</td><td>@archive_bar;noquote@</td></tr>
+ </if>
+ <tr><td>Owner:</td><td>@ownership_bar;noquote@</td></tr>
+ <tr><td>Sort: <td>@object_sort_bar;noquote@</td></tr>
+ <tr><td>Alphabet: <td>[
+ <multiple name="alphabet">
+ <if @alphabet.url@ not nil>
+ <a href="@alphabet.url@">@alphabet.letter@</a>
+ </if>
+ <else>
+ <b>@alphabet.letter@</b>
+ </else>
+ </multiple>]
+ </tr>
+ </table>
+
+ <h3>@pretty_type_plural;noquote@
+ <if @first_row@ gt 1 or @last_row@ lt @num_displayed_objects@>
+ @first_row@-@last_row@ of @num_displayed_objects@
+ </if>
+ <else>(@num_displayed_objects@)</else>
+ </h3>
+
+ <if @num_displayed_objects@ gt @category_display_limit@>
+ <font size=-1>(Note: When there are more than @category_display_limit@ objects found,
+ categories are not shown.)</font>
+ </if>
+
+ <if @num_displayed_objects@ eq 0>No objects match your filters.</if>
+ <else>
+ <ul>
+ <multiple name="object_list">
+
+ <li>
+ <if @object_list.public_p@ eq 0>
+ <font color=red>[Private]</font>
+ </if>
+ <if @object_list.archived_p@ eq 1>
+ <font color=red>[Archived]</font>
+ </if>
+ <if @object_list.review_p@ eq 1>
+ <font color=green>[In review]</font>
+ </if>
+ <a href="@object_list.object_view_link@">@object_list.object_name@</a>
+ by @object_list.user_link;noquote@ (@object_list.last_modified@)
+
+ <if @object_list.access_total@ gt 0>
+ (@object_list.access_total@ hits, @object_list.access_month@ this month)
+ </if>
+
+ <if @object_list.number_ratings@ gt 0>
+ (@object_list.number_ratings@ user
+ rating<if @object_list.number_ratings@ gt 1>s: average of</if><else>:</else>
+ <nobr>@object_list.rating_avg@ <img src="@subsite_url@images/@object_list.rating_avg_img@" alt="@object_list.rating_avg@" width="50" height="9"></nobr>)
+ </if>
+
+ <if @object_list.overview@ ne "">
+ <br>@object_list.overview@
+ </if>
+
+ <if @object_list.categories_html@ ne "">
+ <br><font size=-1>(@object_list.categories_html;noquote@)</font>
+ </if>
+
+ </multiple>
+ </ul>
+
+
+ <include src="result-pages" &result_pages="result_pages" url_stub="@url_stub;noquote@" first_row="@first_row@" last_row="@last_row@" object_count="@num_displayed_objects@">
+
+ </else>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/browse-one-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/browse-one-category.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/browse-one-category.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,435 @@
+! Entering browse-one-category
+ad_page_contract {
+ /packages/library/www/browse-one-category.tcl
+
+ Show the subcategories and objects associated with a category.
+
+ @cvs-id $Id: browse-one-category.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ {object_type_id:integer 0}
+ {object_type ""}
+ {category_id 0}
+ {category ""}
+ {question_id:integer 0}
+ {path_id:integer ""}
+ {show short}
+ {pool all}
+ {age ""}
+ {sort_by last_modified}
+ {first_row:integer 1}
+ {last_row:integer 0}
+ {begin_letter all}
+ {archive "f"}
+ start:array,optional
+ end:array,optional
+} -properties {
+ object_list:multirow
+ title:onevalue
+ graphic_width:onevalue
+ category_action:onevalue
+ category_id:onevalue
+ total_num_objects:onevalue
+ num_displayed_objects:onevalue
+ category_display_limit:onevalue
+ pretty_question:onevalue
+ object_type_id:onevalue
+ category_id:onevalue
+ path_id:onevalue
+ system_name:onevalue
+ age_bar:onevalue
+ ownership_bar:onevalue
+ archive_bar:onevalue
+ object_view_bar_top_level:onevalue
+ object_sort_bar:onevalue
+ objects:onevalue
+ first_row:onevalue
+ last_row:onevalue
+ alphabet:multirow
+ begin_letter:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ default_age_filter:onevalue
+ archive:onevalue
+ archive_p:onevalue
+ start_date:onevalue
+ end_date:onevalue
+ date_filter_vars:onevalue
+ date_filter_p:onevalue
+}
+
+set package_id [ad_conn package_id]
+set form [ad_conn form]
+# For backward compatibility, we still support the object_type parameter.
+
+if { [empty_string_p $object_type] && !$object_type_id } {
+ ad_return_warning "Missing object type" \
+ "Either object_type or object_type_id have to be given."
+ return
+}
+
+if [empty_string_p $show] {
+ set show short
+}
+
+if !$object_type_id {
+ set object_type_id [db_string object_type_id {
+ select object_type_id from sn_object_types
+ where short_name = :object_type
+ and context_id = :package_id
+ and rownum = 1
+ } -default ""]
+ if {[empty_string_p $object_type_id]} {
+ ad_return_complaint 1 "No such object type found."
+ return
+ }
+ # manipulate the form data so to export object_type_id
+ # via export_ns_set_vars
+ ns_set delkey $form object_type
+ ns_set put $form object_type_id $object_type_id
+}
+
+if { $category_id != "none" && !$category_id } {
+ set category_id [db_string category_id {
+ select c.category_id
+ from categories c, sn_questions q, sn_question_object_type_map qm,
+ sw_category_dim d
+ where c.short_name = :category
+ and qm.object_type_id = :object_type_id
+ and qm.question_id = q.question_id
+ and qm.question_state <> 'invisible'
+ and d.parent_node_id = q.node_id
+ and c.category_id = d.object_id
+ and rownum = 1
+ } -default ""]
+ if {[empty_string_p $category_id]} {
+ ad_return_complaint 1 "No such category found."
+ return
+ }
+ # manipulate the form data so to export category_id
+ # via export_ns_set_vars
+ ns_set delkey $form category
+ ns_set put $form category_id $category_id
+}
+
+set child_type_p [db_string child_object_type {
+ select decode(count(*),0,0,1) from dual where exists
+ (select 1
+ from sn_questions
+ where abstract_data_type = 'child_object'
+ and target_object_type_id = :object_type_id)
+}]
+
+set user_id [ad_conn user_id]
+if ![km_check_object_type_id $object_type_id] { return }
+
+if ![info exists start] {
+ set start_date ""
+} else {
+ set start_date "$start(year)-$start(month)-$start(day)"
+ if ![date_p $start_date] {
+ ad_return_complaint 1 "Invalid start date"
+ return
+ }
+}
+if ![info exists end] {
+ set end_date ""
+} else {
+ set end_date "$end(year)-$end(month)-$end(day)"
+ if ![date_p $end_date] {
+ ad_return_complaint 1 "Invalid end date"
+ return
+ }
+}
+
+set archive_p [km_static object_type_archive_p $object_type_id]
+if {!$archive_p} {
+ set archive f
+}
+
+if [empty_string_p $path_id] {
+ set current_action browse
+} else {
+ set current_action [get_path_action $path_id]
+}
+
+set default_age_filter [km_static object_type_default_age_filter $object_type_id]
+
+if [empty_string_p $age] {
+ # First, we check if there is a default age filter for this object
+ # type. If not, we use "all" as our default.
+
+ set age $default_age_filter
+ if [empty_string_p $age] { set age all }
+}
+
+set return_uri [ad_urlencode "[ad_conn url]?[ad_conn query]"]
+set date_filter_vars [export_ns_set_vars form {first_row last_row start.day start.month start.year end.day end.month end.year} $form]
+if {![empty_string_p [km_static object_type_start_date $object_type_id]] && ![empty_string_p [km_static object_type_end_date $object_type_id]]} {
+ set date_filter_p t
+} else {
+ set date_filter_p f
+}
+
+# Get the name of the object type.
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+if {$archive=="t"} {
+ set pretty_type_plural "$pretty_type_plural (archived)"
+}
+set graphic [km_static object_type_graphic $object_type_id]
+# Get the name of the category
+
+if { $category_id == "none" } {
+
+ set have_alert 0
+ set category "Uncategorized"
+
+ if !$question_id {
+ ad_return_error "Deep trouble" "
+ We're looking for uncategorized things, but we weren't
+ told which question should be uncategorized. Probably our programming error."
+ return
+ }
+
+ set node_id 0
+ set root_node [km_root_node -question_id $question_id $object_type_id]
+ set pretty_question [snd [km_get_question $question_id $object_type_id]]
+
+} else {
+
+ set have_alert [alerts::exists -category_id $category_id -content_type_id $object_type_id]
+ set category [km_category_name $category_id]
+
+ if { [empty_string_p $category] } {
+ ad_return_error "Deep trouble" \
+ "We're in deep trouble, because we couldn't find category_id $category_id"
+ return
+ }
+
+ set node_id [db_string node_id "
+ select node_id from sw_category_dim where object_id=:category_id" -default ""]
+ set parent_info [km_node_question_parent $object_type_id $node_id]
+ set question_id [fst $parent_info]
+ set root_node [snd $parent_info]
+ set pretty_question [snd [km_get_question $question_id $object_type_id]]
+}
+# Check if the corresponding question has been made invisible.
+
+set question_info [km_get_question $question_id $object_type_id]
+if [empty_string_p $question_info] {
+ ad_return_warning "Invalid Category" "
+ The given categorization does not exist, probably because it has been removed
+ from this object type. Please go back to the
+ <a href=\"browse-one-type?[export_ns_set_vars url {category_id first_row last_row show} $form]\">browsing page</a>
+ for $pretty_type_plural."
+ return
+}
+
+set parameters [export_ns_set_vars url {first_row last_row category_id question_id show} $form]
+
+if { $category_id == "none" } {
+ set_context_bar_data [list "browse-one-type?$parameters" $pretty_type_plural] "Uncategorized by $pretty_question"
+} else {
+
+ set context_list [list]
+
+ lappend context_list [list "browse-one-type?$parameters" $pretty_type_plural]
+
+ if {!$root_node} {
+ set parent_info [km_category_question_parent $object_type_id $category_id]
+ set root_category [snd $parent_info]
+ } else {
+ set root_category $root_node
+ }
+
+ set parentage_list [ad_category_parentage_list $category_id $root_category]
+
+ set ancestor_count [llength $parentage_list]
+
+ # We don't want to show a link for the current category.
+ incr ancestor_count -1
+ for { set i 1 } { $i < $ancestor_count } { incr i } {
+ set parent [lindex $parentage_list $i]
+ set parent_id [fst $parent]
+ set parent_name [snd $parent]
+ lappend context_list ["[ad_conn url]?$parameters&category_id=$parent_id" $parent_name]
+ }
+
+ lappend context_list [km_category_name $category_id]
+
+ eval set_context_bar_data $context_list
+
+
+}
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+
+set create_p [km_conn create_p]
+set copy_p [km_static object_type_copy_p $object_type_id]
+set object_type_pretty_name [km_static object_type_pretty_name $object_type_id]
+set graphic_width [library_icon_width]
+
+if {![km_static object_type_create_p $object_type_id]} {
+ set create_p 0
+}
+
+if { [empty_string_p $category] } {
+ set maybe_category ""
+} else {
+ set maybe_category "in $category"
+}
+
+set title "$pretty_type_plural $maybe_category"
+
+! Getting count of objects in this category or subcategories
+
+set category_display_limit [km_category_display_limit]
+set category_counts [ns_set create]
+
+if { $category_id == "none" } {
+
+ km_get_category_counts -age $age -pool $pool -begin_letter $begin_letter -archived $archive -start_date $start_date -end_date $end_date $object_type_id $category_counts
+ set total_num_objects [ns_set get $category_counts "uncat $question_id"]
+
+} else {
+
+ km_get_category_counts -age $age -pool $pool -begin_letter $begin_letter -archived $archive -start_category_id $category_id -start_date $start_date -end_date $end_date $object_type_id $category_counts
+ set total_num_objects [ns_set get $category_counts $category_id]
+
+}
+
+! Got the counts +total_num_objects
+
+set system_name [km_get_community_name]
+set age_bar [km_age_bar $age]
+set ownership_bar [km_ownership_bar $pool]
+
+set target_url "[ns_conn url]?[export_ns_set_vars url {category_id} $form]&category_id="
+
+km_category_table -object_type_id $object_type_id \
+ -question_id $question_id -parent_node_id $node_id -target $target_url \
+ -category_counts $category_counts -maximum_sub_columns 3 -uncategorized_p 0
+
+set object_view_bar_top_level [km_object_view_bar_top_level $show "just this category" "this category and its subcategories"]
+set object_sort_bar [km_sort_by_bar $sort_by $child_type_p]
+
+set minus_join_tables {}
+set where_clauses {}
+set minus_where_clauses {}
+set more_join_tables {}
+
+if { $category_id == "none" } {
+
+ lappend minus_join_tables \
+ "sw_object_category_map cm" \
+ "sw_flat_cat fc"
+
+ lappend minus_where_clauses \
+ "cm.object_id = obj.object_id" \
+ "cm.category_id = fc.child_category_id" \
+ "fc.parent = $root_node"
+
+} else {
+
+ switch $show {
+
+ all {
+ ! We are showing objects on +category_id level AND all sublevels
+ lappend where_clauses "obj.object_id = swcm.object_id"
+ lappend where_clauses "fc.parent_category_id = :category_id"
+ lappend where_clauses "swcm.category_id = fc.child_category_id"
+
+ lappend more_join_tables "sw_object_category_map swcm"
+ lappend more_join_tables "sw_flat_cat fc"
+ }
+
+ default {
+ ! We are showing just objects on +category_id level
+ set show "short"
+ lappend where_clauses "obj.object_id = swcm.object_id"
+ lappend where_clauses "swcm.category_id = :category_id"
+
+ lappend more_join_tables "sw_object_category_map swcm"
+ }
+ }
+}
+
+if [empty_string_p $total_num_objects] { set total_num_objects 0 }
+
+if !$last_row {
+ if { $total_num_objects > [expr $first_row + 99] } {
+ set last_row [expr $first_row + 99]
+ }
+} elseif { $last_row < $total_num_objects && $total_num_objects <= [expr $first_row + 99] } {
+ set last_row $total_num_objects
+}
+
+set url_stub "browse-one-category?[export_ns_set_vars url {first_row last_row} $form]"
+
+set num_displayed_objects 0
+if { $total_num_objects > 0 } {
+ set header $pretty_type_plural
+ ! Calling km8_output_object_list +where_clauses +minus_join_tables +minus_where_clauses +more_join_tables
+ set num_displayed_objects [km8_output_object_list -object_type_id $object_type_id \
+ -header $header -pool $pool -age $age -sort_by $sort_by \
+ -show $show -current_action $current_action -path_id $path_id \
+ -category_id $category_id -question_id $question_id \
+ -first_row $first_row -last_row $last_row \
+ -where_clauses $where_clauses -begin_letter $begin_letter \
+ -minus_join_tables $minus_join_tables \
+ -minus_where_clauses $minus_where_clauses \
+ -archived $archive -start_date $start_date -end_date $end_date \
+ -more_join_tables $more_join_tables]
+ ! Done with km8_output_object_list
+
+ if { $last_row > $num_displayed_objects } {
+ set last_row $num_displayed_objects
+ } elseif !$last_row {
+ set last_row $num_displayed_objects
+ }
+}
+
+set url_vars [export_ns_set_vars url {begin_letter first_row last_row} $form]
+template::multirow create alphabet letter url
+foreach letter {all A B C D E F G H I J K L M N O P Q R S T U V W X Y Z other} {
+ if [string equal $letter $begin_letter] {
+ template::multirow append alphabet $letter ""
+ } else {
+ template::multirow append alphabet $letter "browse-one-category?$url_vars&begin_letter=$letter"
+ }
+}
+
+set archive_bar [km_archive_bar $archive]
+
+query get_package_name package_name onevalue {
+ select instance_name from apm_packages where package_id = :package_id
+}
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set community_id $node(package_id)
+
+if [integer_p $category_id] {
+ query get_category_tree_info tree_info onerow {
+ select gt.tree_name, gt.tree_id, c.short_name
+ from sw_category_dim scd, generic_trees gt, categories c
+ where scd.object_id = :category_id
+ and scd.tree_id = gt.tree_id
+ and c.category_id = :category_id
+ }
+ set search_contexts [list \
+ [list "lcat:$object_type_id,$tree_info(tree_id),$category_id" "$tree_info(short_name)"] \
+ [list "ltype:$object_type_id" "$pretty_type_plural"] \
+ [list "lib:$package_id" "$package_name"] \
+ [list "sc:$community_id" "$subsite_name"] \
+ [sws_km_site_search_context]]
+} else {
+ set search_contexts [list \
+ [list "ltype:$object_type_id" "$pretty_type_plural"] \
+ [list "lib:$package_id" "$package_name"] \
+ [list "sc:$community_id" "$subsite_name"] \
+ [sws_km_site_search_context]]
+}
+
+ad_return_template
+! Exiting browse-one-category
Index: openacs-4/contrib/obsolete-packages/library/www/browse-one-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/browse-one-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/browse-one-type.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,145 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width;noquote@</property>
+<property name="subsite_url">@subsite_url;noquote@</property>
+<property name="subsite_name">@subsite_name;noquote@</property>
+<property name="search_contexts">@search_contexts;noquote@</property>
+
+<include src="category-action" category_id="none" return_uri="@return_uri;noquote@" create_p=@create_p@ copy_p=@copy_p@ object_type_id=@object_type_id@ object_type_pretty_name="@object_type_pretty_name;noquote@" have_alert=@have_alert@>
+
+Number of objects (@total_num_objects@)
+<p>
+View items modified in the last @age_bar;noquote@
+<p>
+
+<if @date_filter_p@ eq t>
+ <include src="date-filter" target="browse-one-type" start="@start_date@" end="@end_date@" start_offset="-5" end_offset="7" presentation_type="select" form_vars="@date_filter_vars;noquote@">
+</if>
+
+ <table><tr>
+ <multiple name="categorization_widget_header">
+ <th bgcolor="#cccfff">@categorization_widget_header.header_name@</th>
+ </multiple>
+ </tr><tr>
+
+ <multiple name="categorization_widget">
+ <td valign="top">
+ <ul>
+
+ <group column=parent_node_id>
+ <li><a href="@categorization_widget.target@@categorization_widget.category_id@">@categorization_widget.category@</a> (@categorization_widget.sum_count;noquote@)
+ </group>
+ </multiple>
+ </td>
+</table>
+<p>
+
+<if @total_num_objects@ eq 0>
+
+ <table>
+ <tr><td>View:</td><td>
+ @object_view_bar_top_level;noquote@
+ <br>
+ <if @archive_p@ eq 1>
+ <tr><td>Status:</td><td>@archive_bar;noquote@</td></tr>
+ </if>
+ <tr><td>Owner:</td><td>@ownership_bar;noquote@</td></tr>
+ <if @begin_letter@ ne "all">
+ <tr><td>Alphabet: <td>[
+ <multiple name="alphabet">
+ <if @alphabet.url@ not nil>
+ <a href="@alphabet.url@">@alphabet.letter@</a>
+ </if>
+ <else>
+ <b>@alphabet.letter@</b>
+ </else>
+ </multiple>]
+ </tr>
+ </if>
+ </table>
+ <p>No objects here.
+
+</if><else>
+
+ <table>
+ <tr><td>View:</td><td>
+ @object_view_bar_top_level;noquote@
+ <br>
+ <if @show@ eq "short">
+ <if @archive_p@ eq 1>
+ <tr><td>Status:</td><td>@archive_bar;noquote@</td></tr>
+ </if>
+ <tr><td>Owner:</td><td>@ownership_bar;noquote@</td></tr>
+ </table>
+ </if><else>
+ <if @archive_p@ eq 1>
+ <tr><td>Status:</td><td>@archive_bar;noquote@</td></tr>
+ </if>
+ <tr><td>Owner:</td><td>@ownership_bar;noquote@</td></tr>
+ <tr><td>Sort: <td>@object_sort_bar;noquote@</td></tr>
+ <tr><td>Alphabet: <td>[
+ <multiple name="alphabet">
+ <if @alphabet.url@ not nil>
+ <a href="@alphabet.url@">@alphabet.letter@</a>
+ </if>
+ <else>
+ <b>@alphabet.letter@</b>
+ </else>
+ </multiple>]
+ </tr>
+ </table>
+
+ <h3>@pretty_type_plural;noquote@
+ <if @first_row@ gt 1 or @last_row@ lt @total_num_objects@>
+ @first_row@-@last_row@ of @total_num_objects@
+ </if>
+ <else>(@total_num_objects@)</else>
+ </h3>
+
+ <if @total_num_objects@ gt @category_display_limit@>
+ <font size=-1>(Note: When there are more than @category_display_limit@ objects found,
+ categories are not shown.)</font>
+ </if>
+
+ <ul>
+ <multiple name="object_list">
+
+ <li>
+ <if @object_list.public_p@ eq 0>
+ <font color=red>[Private]</font>
+ </if>
+ <if @object_list.archived_p@ eq 1>
+ <font color=red>[Archived]</font>
+ </if>
+ <if @object_list.review_p@ eq 1>
+ <font color=green>[In review]</font>
+ </if>
+ <a href="@object_list.object_view_link@">@object_list.object_name@</a>
+ by @object_list.user_link;noquote@ (@object_list.last_modified@)
+
+ <if @object_list.access_total@ gt 0>
+ (@object_list.access_total@ hits, @object_list.access_month@ this month)
+ </if>
+
+ <if @object_list.number_ratings@ gt 0>
+ (@object_list.number_ratings@ user
+ rating<if @object_list.number_ratings@ gt 1>s: average of</if><else>:</else>
+ <nobr>@object_list.rating_avg@ <img src="@subsite_url@images/@object_list.rating_avg_img@" alt="@object_list.rating_avg@" width="50" height="9"></nobr>)
+ </if>
+
+ <if @object_list.overview@ ne "">
+ <br>@object_list.overview@
+ </if>
+
+ <if @object_list.categories_html@ ne "">
+ <br><font size=-1>(@object_list.categories_html;noquote@)</font>
+ </if>
+
+ </multiple>
+ </ul>
+
+ <include src="result-pages" &result_pages="result_pages" url_stub="@url_stub;noquote@" first_row="@first_row@" last_row="@last_row@" object_count="@total_num_objects@">
+
+ </else>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/browse-one-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/browse-one-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/browse-one-type.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,250 @@
+! Entering browse-one-type
+ad_page_contract {
+ /packages/library/www/browse-one-type.tcl
+
+ Show all categories associated with the given object type.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: browse-one-type.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ {object_type_id:integer 0}
+ {short_name ""}
+ {path_id:integer ""}
+ {show ""}
+ {pool all}
+ {age ""}
+ {sort_by last_modified}
+ {first_row:integer 1}
+ {last_row:integer 0}
+ {begin_letter all}
+ {archive "f"}
+ start:array,optional
+ end:array,optional
+} -properties {
+ title:onevalue
+ graphic_width:onevalue
+ total_num_objects:onevalue
+ category_display_limit:onevalue
+ pretty_type_plural:onevalue
+ system_name:onevalue
+ object_type_id:onevalue
+ age_bar:onevalue
+ path_id:onevalue
+ ownership_bar:onevalue
+ archive_bar:onevalue
+ object_view_bar_top_level:onevalue
+ show:onevalue
+ object_sort_bar:onevalue
+ objects:onevalue
+ first_row:onevalue
+ last_row:onevalue
+ categorization_widget:multirow
+ alphabet:multirow
+ begin_letter:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ default_age_filter:onevalue
+ search_contexts:onevalue
+ archive:onevalue
+ archive_p:onevalue
+ start_date:onevalue
+ end_date:onevalue
+ date_filter_vars:onevalue
+ date_filter_p:onevalue
+}
+
+set user_id [ad_conn user_id]
+set package_id [ad_conn package_id]
+set instance_name [ad_conn instance_name]
+set form [ad_conn form]
+
+if { [empty_string_p $short_name] && !$object_type_id } {
+ ad_return_warning "Invalid object type" \
+ "short_name or object_type_id are either missing or invalid."
+ return
+}
+
+if !$object_type_id {
+ set object_type_id [db_string object_type_id {
+ select object_type_id
+ from sn_object_types
+ where short_name = :short_name
+ and context_id = :package_id
+ and rownum = 1
+ } -default ""]
+ # manipulate the form data so to export object_type_id
+ # via export_ns_set_vars
+ if {[empty_string_p $object_type_id]} {
+ ad_return_complaint 1 "No such object type found."
+ return
+ }
+ ns_set delkey $form short_name
+ ns_set put $form object_type_id $object_type_id
+}
+
+if ![km_check_object_type_id $object_type_id] { return }
+
+if ![info exists start] {
+ set start_date ""
+} else {
+ set start_date "$start(year)-$start(month)-$start(day)"
+ if ![date_p $start_date] {
+ ad_return_complaint 1 "Invalid start date"
+ return
+ }
+}
+if ![info exists end] {
+ set end_date ""
+} else {
+ set end_date "$end(year)-$end(month)-$end(day)"
+ if ![date_p $end_date] {
+ ad_return_complaint 1 "Invalid end date"
+ return
+ }
+}
+
+set archive_p [km_static object_type_archive_p $object_type_id]
+if {!$archive_p} {
+ set archive f
+}
+
+if ![path_valid_p $path_id] {
+ set current_action "browse"
+} else {
+ set current_action [get_path_action $path_id]
+}
+
+if [empty_string_p $pool] { set pool all }
+if [empty_string_p $sort_by] { set sort_by last_modified }
+
+set default_age_filter [km_static object_type_default_age_filter $object_type_id]
+
+if [empty_string_p $age] {
+ # First, we check if there is a default age filter for this object
+ # type. If not, we use "all" as our default.
+
+ set age $default_age_filter
+ if [empty_string_p $age] { set age all }
+}
+
+
+set return_uri [ad_urlencode "[ad_conn url]?[ad_conn query]"]
+set have_alert [alerts::exists -content_type_id $object_type_id]
+set date_filter_vars [export_ns_set_vars form {first_row last_row start.day start.month start.year end.day end.month end.year} $form]
+if {![empty_string_p [km_static object_type_start_date $object_type_id]] && ![empty_string_p [km_static object_type_end_date $object_type_id]]} {
+ set date_filter_p t
+} else {
+ set date_filter_p f
+}
+
+# Get the pretty name of the object type
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+if {$archive=="t"} {
+ set pretty_type_plural "$pretty_type_plural (archived)"
+ set have_alert 1
+}
+set graphic [km_static object_type_graphic $object_type_id]
+set age_bar [km_age_bar $age]
+
+set child_type_p [db_string child_object_type {
+ select decode(count(*),0,0,1) from dual where exists
+ (select 1
+ from sn_questions
+ where abstract_data_type = 'child_object' and target_object_type_id=:object_type_id)
+}]
+
+# Get the category counts.
+
+set category_counts [ns_set create]
+km_get_category_counts -age $age -pool $pool -begin_letter $begin_letter -archived $archive -start_date $start_date -end_date $end_date $object_type_id $category_counts
+
+set total_num_objects [ns_set get $category_counts total]
+set category_display_limit [km_category_display_limit]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+set subcommunity_id $node(package_id)
+
+set graphic_width [library_icon_width]
+set_context_bar_data -- $pretty_type_plural
+
+set title $pretty_type_plural
+set object_type_pretty_name [km_static object_type_pretty_name $object_type_id]
+set system_name [km_get_community_name]
+set ownership_bar [km_ownership_bar $pool]
+
+if ![km_static object_type_create_p $object_type_id] {
+ set create_p 0
+} else {
+ set create_p [km_conn create_p]
+}
+set copy_p [km_static object_type_copy_p $object_type_id]
+
+set target_url "browse-one-category?[export_ns_set_vars url {category_id show first_row last_row} $form]&category_id="
+
+set categories_p [km_category_table -object_type_id $object_type_id \
+ -target $target_url -category_counts $category_counts]
+
+if [empty_string_p $show] {
+ if { !$categories_p || $total_num_objects < $category_display_limit } {
+ set show all
+ } else {
+ set show short
+ }
+}
+
+if { $show != "short" } {
+ set object_sort_bar [km_sort_by_bar $sort_by $child_type_p]
+} else {
+ set object_sort_bar ""
+}
+
+if !$last_row {
+ if { $total_num_objects > [expr $first_row + 99] } {
+ set last_row [expr $first_row + 99]
+ }
+} elseif { $last_row < $total_num_objects && $total_num_objects <= [expr $first_row + 99] } {
+ set last_row $total_num_objects
+}
+
+set url_stub "browse-one-type?[export_ns_set_vars url {first_row last_row} $form]"
+
+set objects ""
+set total_num_objects2 [km8_output_object_list \
+ -object_type_id $object_type_id \
+ -pool $pool -age $age -sort_by $sort_by \
+ -show $show -path_id $path_id -current_action $current_action \
+ -first_row $first_row -last_row $last_row -begin_letter $begin_letter \
+ -archived $archive -start_date $start_date -end_date $end_date]
+
+if !$last_row { set last_row $total_num_objects }
+
+set url_vars [export_ns_set_vars url {begin_letter first_row last_row} $form]
+template::multirow create alphabet letter url
+foreach letter {all A B C D E F G H I J K L M N O P Q R S T U V W X Y Z other} {
+ if [string equal $letter $begin_letter] {
+ template::multirow append alphabet $letter ""
+ } else {
+ template::multirow append alphabet $letter "browse-one-type?$url_vars&begin_letter=$letter"
+ }
+}
+
+set object_view_bar_top_level [km_object_view_bar_top_level $show \
+ "just category descriptions" \
+ "all $pretty_type objects ($total_num_objects)"]
+
+set archive_bar [km_archive_bar $archive]
+
+set search_contexts [list \
+ [list "ltype:$object_type_id" "$pretty_type_plural"] \
+ [list "lib:$package_id" "$instance_name"] \
+ [list "sc:$subcommunity_id" "$subsite_name"] \
+ [sws_km_site_search_context]]
+
+ad_return_template
+! Exiting browse-one-type
Index: openacs-4/contrib/obsolete-packages/library/www/category-action.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/category-action.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/category-action.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,17 @@
+<if @have_alert@ eq 0>
+ <if @category_id@ ne "" and @category_id@ ne "none">
+ <a href="alert-categories?content_type_id=@object_type_id@&category_id=@category_id@&return_uri=@return_uri;noquote@">Set Alert</a>
+ </if><else>
+ <a href="alert-types?object_type_id=@object_type_id@&return_uri=@return_uri;noquote@">Set Alert</a>
+ </else>
+</if>
+
+<if @create_p@ eq 1>
+ <if @have_alert@ eq 0>|</if>
+ <a href="object-edit?object_type_id=@object_type_id@">Create new @object_type_pretty_name;noquote@</a>
+ <if @copy_p@ eq 1>
+ | <a href="object-copy?object_type_id=@object_type_id@">Copy a @object_type_pretty_name;noquote@</a>
+ </if>
+</if>
+
+<p>
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add-2.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add-2.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add-2.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,86 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="subsite_url">@subsite_url;noquote@</property>
+<property name="subsite_name">@subsite_name;noquote@</property>
+<property name="header_stuff">@header_stuff;noquote@</property>
+
+<blockquote>
+<b>@object_name@</b>:<br>
+@overview_with_href_and_mailto;noquote@
+
+<p>
+
+<h3>@headline@</h3>
+
+<form action=comment-add-3 method=post>
+<csrf-token>
+@form_vars;noquote@
+
+<if @user_id@ ne @author_id@>
+Please tell <a href="../users/yp?user_id=@author_id@">@author_name@</a>
+how valuable you find her/his @object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>".
+<if @reuse_p@ eq t>
+ He/she will receive a variable number of <ad-parameter package=acs-kernel name=SystemName>
+ Shares defined by you along with your comment.
+
+ <h4>Select feedback points</h4>
+ <p> By giving feedback points you help users to easily find
+ interesting content in <ad-parameter package=acs-kernel name=SystemName>. Also, <a href="../users/yp?user_id=@author_id@">@author_name@</a>
+ will receive a number of <ad-parameter package=acs-kernel name=SystemName> Shares proportional to the number of
+ feedback points you award. <!--Choosing
+ "0" feedback points on all answers in this thread will
+ result in your request to be handled as "unanswered"
+ again.--></p>
+
+ <nobr>Answer didn't help me
+ <multiple name=ratings><input type="radio" name="reuse_points" value="@ratings.number@"<if @reuse_points@ eq @ratings.number@> checked</if>>@ratings.number@ </multiple>
+ Perfect Answer</nobr></p>
+</if>
+</if>
+
+<p>
+
+<if @reuse_p@ eq t>
+ <h4>Comment</h4>
+ <p>Please add a comment to your feedback. The system will include
+ it in the feedback E-Mail to the user.
+ <br><em>Here you shall explain, describe or comment your feedback
+ (i.e. what project did you reuse the information for,
+ what did you learn, why do you think it's outdated or should have
+ more details, etc.).</em></p>
+</if><else>
+ <em>What comment would you like to add to the above @object_type@?</em>
+</else>
+</p>
+
+<table>
+<tr><td rowspan="2">
+<textarea name=comment rows=10 cols=60 wrap=soft>@comment;noquote@</textarea>
+</td>
+<td valign="top">
+<a href="javascript:PopUp("@subsite_url@guidelines/quality/feedback.htm")"><img src="@subsite_url@images/logoQual.gif"
+hspace=5 border=0 align=left width=128 height=27></a>
+</td></tr>
+<tr><td>
+<p><select name=html_p>
+<option value="f"<if @html_p@ eq "f"> SELECTED</if>>Plain Text
+<option value="t"<if @html_p@ eq "t"> SELECTED</if>>HTML
+</select>
+</td></tr></table>
+
+<p>
+<input type="checkbox" name="public_p" value="t"<if @public_p@ eq "t"> checked</if>>
+Add this comment as a public comment to the knowledge object
+</p>
+
+<center><input type=submit name=submit value="Proceed"></center>
+</form>
+</blockquote>
+
+<if @feedback_category_id@ not nil>
+ <form action="comment-add" method=post>
+ <csrf-token>
+ @form_vars;noquote@
+ <input type=submit name=back value="Back">
+ </form>
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add-2.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,123 @@
+ad_page_contract {
+ /packages/library/www/comment-add-2.tcl
+
+ Let the user enter a comment and the number of reuse points.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Bernd Schmeil (bernd@arsdigita.com) - did modifications
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-add-2.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ {feedback_category_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+ {comment ""}
+ {html_p:oneof(t|f) "f"}
+ {public_p:optional "t"}
+ {reuse_points:integer "-1"}
+} -properties {
+ title:onevalue
+ headline:onevalue
+ object_name:onevalue
+ object_type:onevalue
+ form_vars:onevalue
+ feedback_category:onevalue
+ feedback_category_id:onevalue
+ ratings:multirow
+ overview_with_href_and_mailto:onevalue
+ author_id:onevalue
+ author_name:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ header_stuff:onevalue
+ comment:onevalue
+ html_p:onevalue
+ public_p:onevalue
+ reuse_points:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set community_id $node(package_id)
+
+if ![km_check_object_id $object_id] { return }
+set author_id [km_conn original_author_id]
+set author_name [km_conn original_author_name]
+
+if {$feedback_category_id == 0} {
+ ad_return_complaint 1 "Please select a feedback category!"
+ return
+}
+
+if {[km_conn archived_p]} {
+ ad_return_complaint 1 "Only feedback for not archived knowledge objects is allowed!"
+ return
+}
+
+set object_name [km_conn object_name]
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+set header_stuff "<SCRIPT LANGUAGE=\"JavaScript\" SRC=\"$subsite_url\guidelines/jscript/functions.js\" TYPE=\"text/javascript\"> </SCRIPT>"
+
+if {![empty_string_p $feedback_category_id]} {
+ set feedback_category [db_string get_category_name {
+ select long_name from categories
+ where category_id = :feedback_category_id} -default ""]
+
+ # don't let user give feedback points if user is author
+ # or object is private
+ if {($user_id == $author_id) || ![km_conn public_p] || ![db_0or1row get_rating_scale {
+ select rating_p as reuse_p, scale
+ from sn_comments_category_settings
+ where object_id = :package_id
+ and category_id = :feedback_category_id }]} {
+ set reuse_p "f"
+ set scale 0
+ }
+} else {
+ set reuse_p "f"
+ set scale 0
+ set feedback_category ""
+}
+
+if {$reuse_p=="t"} {
+ set what "Give feedback"
+ set headline "Give Feedback"
+ set title "Give feedback for \"$object_name\""
+} else {
+ set what "Add comment"
+ set headline "Your Comment"
+ set title "Add a comment to \"$object_name\""
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+if {[empty_string_p $feedback_category_id]} {
+ append_context_bar_data $what
+} else {
+ append_context_bar_data [list "comment-add?[export_url_vars object_id category_id path_id]" "Feedback category"] $what
+}
+
+set overview_with_href_and_mailto [util_make_href_and_mailto_links [km_conn overview]]
+set form_vars [export_form_vars object_id feedback_category_id category_id path_id]
+set original_author_p [km_original_author_p $user_id $object_id]
+
+template::multirow create ratings number
+
+if { $reuse_p=="t" } {
+ # Generate the list of valid reuse points.
+ if { $scale > 0} {
+ for { set counter 0 } { $counter <= $scale } { incr counter } {
+ template::multirow append ratings $counter
+ }
+ }
+}
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add-3.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add-3.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add-3.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,71 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+The following is your comment as it would appear on the page
+<i>@object_name@</i>. If it looks incorrect, please use the back button
+on your browser to return and correct it. Otherwise, press
+"Continue".
+
+<blockquote>
+<if @feedback_category@ not nil>
+ <p><b>Feedback type:</b> @feedback_category@</p>
+</if>
+ <p><b>Comment:</b><p>@comment;noquote@</p>
+</blockquote>
+<p>
+<if @public_p@ eq t>
+ This comment will appear as a comment below the @object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>".
+</if><else>
+ <if @user_id@ ne @author_id@>
+ This comment will only get sent to the author
+ <a href="../users/yp?user_id=@author_id@">@author_name@</a> of the
+ @object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>"
+ and will NOT appear as a comment below the @object_type@.
+ </if>
+</else>
+
+<if @html_p@ eq "t">
+ <p>Note: If the comment has lost all of its paragraph breaks then you
+ probably should have selected "Plain Text" rather than "HTML".
+</if><else>
+ <p>Note: If the comment has a bunch of visible HTML tags then you probably
+ should have selected "HTML" rather than "Plain Text". Use your
+ browser's Back button to return to the submission form.
+</else>
+
+<if @reuse_points@ ne -1>
+ <if @own_shares:rowcount@ gt 0>
+ <p>You will receive the following shares:
+ <ul><multiple name=own_shares>
+ <li><a href="/incentives/user/shares?bank_id=@own_shares.bank_id@">@own_shares.bank_name@</a>: @own_shares.amount@ @own_shares.currency@ (New balance: @own_shares.balance@ @own_shares.currency@)</li>
+ </multiple></ul>
+ </if><else><p></else>
+ <a href="../users/yp?user_id=@author_id@">@author_name@</a>
+ <if @reuse_points@ eq 0 or @author_shares:rowcount@ eq 0>
+ <if @reuse_points@ eq 0>
+ is about to receive no shares since you rated the object with 0.
+ </if><else>
+ is about to receive no shares since no shares will be awarded for this feedback type.
+ </else>
+ </if><else>
+ is about to receive the following shares proportional to <b>@reuse_points@
+ point<if @reuse_points@ ne 1>s</if></b> you awarded his knowledge object:
+ <ul><multiple name=author_shares>
+ <li>@author_shares.bank_name@</a>: @author_shares.amount@ @author_shares.currency@</li>
+ </multiple></ul>
+ </else>
+ <p>
+</if>
+
+
+<form action=comment-add-4 method=post>
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+<center><input type=submit name=submit value="Continue"></center>
+</form>
+
+<form action="comment-add-2" method=post>
+@form_vars;noquote@
+<input type=submit name=back value="Back">
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add-3.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add-3.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,139 @@
+ad_page_contract {
+ /packages/library/www/comment-add-3.tcl
+
+ Ask the user for confirmation before adding comment and reuse points.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Bernd Schmeil (bernd@arsdigita.com) - did modifications
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-add-3.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ comment:notnull
+ html_p:notnull,oneof(t|f)
+ {reuse_points:integer "-1"}
+ {feedback_category_id:integer ""}
+ {public_p:optional "f"}
+ {category_id ""}
+ {path_id:integer ""}
+} -properties {
+ title:onevalue
+ object_name:onevalue
+ object_type:onevalue
+ form_vars:onevalue
+ feedback_category:onevalue
+ comment:onevalue
+ html_p:onevalue
+ reuse_points:onevalue
+ original_author_p:onevalue
+ author_id:onevalue
+ author_name:onevalue
+ dc_export:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ own_shares:multirow
+ author_shares:multirow
+ admin_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if ![km_check_object_id $object_id] { return }
+set author_id [km_conn original_author_id]
+set author_name [km_conn original_author_name]
+set admin_p [km_conn admin_p]
+
+if {$user_id == $author_id} {
+ set reuse_points -1
+}
+
+if {[km_conn archived_p]} {
+ ad_return_complaint 1 "Only feedback for not archived knowledge objects is allowed!"
+ return
+}
+
+set object_name [km_conn object_name]
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+set title "Confirm comment on \"$object_name\""
+
+set form_vars [export_form_vars object_id comment html_p reuse_points feedback_category_id public_p category_id path_id]
+set original_author_p [km_original_author_p $user_id $object_id]
+
+set reuse_p "f"
+if {![empty_string_p $feedback_category_id]} {
+ set feedback_category [db_string get_category_name "
+ select long_name from categories
+ where category_id = :feedback_category_id" -default ""]
+ if {[db_0or1row get_rating_scale {
+ select rating_p as reuse_p, scale
+ from sn_comments_category_settings
+ where object_id = :package_id
+ and category_id = :feedback_category_id }] && $reuse_p == "t" } {
+ if {[empty_string_p $reuse_points] || $reuse_points < 0 || $reuse_points > $scale} {
+ ad_return_complaint 1 "Please provide a rating!"
+ return
+ }
+ }
+} else {
+ set feedback_category ""
+}
+
+if {$reuse_p=="t"} {
+ set what "Give feedback"
+ set confirm "Confirm feedback"
+} else {
+ set what "Add comment"
+ set confirm "Confirm comment"
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+if [empty_string_p $feedback_category_id] {
+ append_context_bar_data [list "comment-add-2?[export_url_vars object_id category_id path_id]" $what] $confirm
+} else {
+ append_context_bar_data [list "comment-add?[export_url_vars object_id category_id path_id]" "Feedback category"] [list "comment-add-2?[export_url_vars object_id category_id path_id feedback_category_id]" $what] $confirm
+}
+
+if { $html_p == "f" } {
+ set comment [util_make_href_and_mailto_links_and_convert_to_html $comment]
+}
+
+template::multirow create own_shares bank_id bank_name currency amount balance
+if {$reuse_points > -1 && ($user_id != $author_id) && ![empty_string_p $feedback_category_id] && [info exists incentives::initialized]} {
+ foreach bank_id [incentives::bank_list $package_id] {
+ set amount [incentives::charge_value -key $feedback_category_id kl_rating_give $bank_id]
+ if {$amount > 0} {
+ db_1row get_currency_name {
+ select pretty_name as bank_name, currency_name
+ from ir_banks
+ where bank_id = :bank_id
+ }
+ template::multirow append own_shares $bank_id $bank_name $currency_name $amount [expr $amount+[thd [incentives::account_balance $bank_id]]]
+ }
+ }
+}
+
+template::multirow create author_shares bank_id bank_name currency amount balance
+if {$reuse_points > 0 && ($user_id != $author_id) && ![empty_string_p $feedback_category_id] && [info exists incentives::initialized]} {
+ foreach bank_id [incentives::bank_list -user_id $author_id $package_id] {
+ set factor [incentives::charge_value -key $feedback_category_id kl_rating_receive $bank_id]
+ set amount [expr {$factor * $reuse_points}]
+ if {$amount > 0} {
+ db_1row get_currency_name {
+ select pretty_name as bank_name, currency_name
+ from ir_banks
+ where bank_id = :bank_id
+ }
+ template::multirow append author_shares $bank_id $bank_name $currency_name $amount [expr $amount+[thd [incentives::account_balance -user_id $author_id $bank_id]]]
+ }
+ }
+}
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add-4.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add-4.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,197 @@
+ad_page_contract {
+ /packages/library/www/comment-add-4.tcl
+
+ Store comment and reuse points.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Bernd Schmeil (bernd@arsdigita.com) - modifications done in Jan 2001
+
+ @cvs-id $Id: comment-add-4.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ comment:notnull
+ {html_p:notnull,oneof(t|f) "f"}
+ {public_p:optional "f"}
+ {reuse_points:integer "-1"}
+ {feedback_category_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id $object_id] { return }
+set author_id [km_conn original_author_id]
+
+if {$user_id == $author_id} {
+ set reuse_points -1
+}
+
+if {[km_conn archived_p]} {
+ ad_return_complaint 1 "Only feedback for not archived knowledge objects is allowed!"
+ return
+}
+
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+
+set return_url "object-view?[export_url_vars object_id category_id path_id]"
+
+if {[doubleclick::check_all]} {
+ ns_sleep 2
+ ad_returnredirect $return_url
+ return
+}
+
+set category_forward_email ""
+set scale 0
+
+if {[db_0or1row get_rating_scale {
+ select rating_p as reuse_p, scale, email as category_forward_email
+ from sn_comments_category_settings
+ where object_id = :package_id
+ and category_id = :feedback_category_id
+}] && $reuse_p == "t" } {
+ if {[empty_string_p $reuse_points] || $reuse_points < 0 || $reuse_points > $scale} {
+ ad_return_complaint 1 "Please provide a rating!"
+ return
+ }
+}
+
+db_transaction {
+ # Save the comment.
+ set comment_id [km_general_comment_add $object_id $user_id $html_p \
+ $reuse_points $scale $feedback_category_id $public_p $comment]
+
+ # add comment to yellow page
+ db_dml insert_content_area {
+ insert into acs_object_areas (object_id, area_id, package_id)
+ values (:comment_id, null, :package_id)
+ }
+
+ set author_id [km_conn original_author_id]
+ db_1row get_original_author_email {
+ select email as author_email from users where user_id = :author_id
+ }
+
+ if {$comment_id && ($user_id != $author_id)} {
+ if {$reuse_points > -1
+ && ![empty_string_p $feedback_category_id]
+ && [info exists incentives::initialized]
+ } {
+ # NOTE: this code almost exactly the same as the code in
+ # bboard/www/comment-add-3.tcl.
+
+ # We have to award shares twice: to the user who received
+ # the rating, and to the user who gave the rating.
+
+ # Note that we do need to loop over the banks twice,
+ # because the two users may not be in the same groups.
+
+ # First handle the user who gives the rating.
+ foreach bank_id [incentives::bank_list [ad_conn package_id]] {
+ set amount [incentives::charge_value -key $feedback_category_id kl_rating_give $bank_id]
+ incentives::award_shares kl_rating_give $amount $bank_id $comment_id
+ }
+
+ # Then the user who gets the rating. Check for 0 just so
+ # we don't bother with listing the banks and all if we're
+ # not going to award any shares in the end.
+ set shares_list [list]
+ set shares_awarded_p 0
+ if {$reuse_points > 0} {
+ foreach bank_id [incentives::bank_list -user_id $author_id [ad_conn package_id]] {
+ set factor [incentives::charge_value -key $feedback_category_id kl_rating_receive $bank_id]
+ if {$factor > 0} {
+ set amount [expr {$factor * $reuse_points}]
+ incentives::award_shares -user_id $author_id \
+ kl_rating_receive $amount $bank_id $comment_id
+ db_1row get_currency_name {
+ select pretty_name as bank_name, currency_name
+ from ir_banks
+ where bank_id = :bank_id
+ }
+ set balance [thd [incentives::account_balance -user_id $author_id $bank_id]]
+ lappend shares_list "$amount $currency_name (new total: $balance) for $bank_name ([ad_url]/incentives/user/shares?bank_id=$bank_id)"
+ set shares_awarded_p 1
+ }
+ }
+ set shares_list [join $shares_list "\n"]
+ }
+ }
+
+ # Send email to object owner.
+
+ set object_name [sn_striphtml [km_conn object_name]]
+
+ db_1row object_info {
+ select u.email as sender_email,
+ u.first_names || ' ' || u.last_name as sender_name,
+ site_node.url(sn.node_id) as package_url
+ from users u, site_nodes sn
+ where u.user_id = :user_id
+ and sn.object_id = :package_id
+ and rownum = 1
+ }
+
+ if {![empty_string_p $feedback_category_id]} {
+ set feedback_category [db_string comment_add_4_20 {
+ select long_name from categories
+ where category_id = :feedback_category_id
+ } -default ""]
+ } else {
+ set feedback_category "Comment"
+ }
+
+ if { $html_p == "t" } { set comment [ad_html_to_text $comment] }
+
+ set replacement_list \
+ [list \
+ knowledge_object $object_name \
+ knowledge_object_link [ad_url]${package_url}object-view?object_id=$object_id \
+ knowledge_object_type $object_type \
+ feedback_type $feedback_category \
+ recipient_email $author_email \
+ sender_email $sender_email \
+ sender_name $sender_name \
+ comment $comment]
+
+ if {$reuse_points == -1} {
+ set template_name "km_object_comment"
+ } else {
+ set template_name "km_object_feedback"
+ lappend replacement_list points $reuse_points
+ if {$shares_awarded_p} {
+ set template_name "km_object_feedback_shares"
+ lappend replacement_list shares_list $shares_list
+ }
+ }
+
+ # This uses sn_community_instances_all. Should it be using
+ # sn_community_mounts_all instead?
+ set community_id [db_string get_community_id {
+ select community_id
+ from sn_community_instances_all
+ where package_id = :package_id
+ }]
+
+ et_queue_email [et_process -community_id $community_id $template_name $replacement_list]
+
+ if { ![empty_string_p $category_forward_email] } {
+ set replacement_list \
+ [list \
+ knowledge_object $object_name \
+ knowledge_object_link [ad_url]${package_url}object-view?object_id=$object_id \
+ knowledge_object_type $object_type \
+ feedback_type $feedback_category \
+ recipient_email $category_forward_email \
+ sender_email $sender_email \
+ sender_name $sender_name \
+ comment $comment]
+
+ et_queue_email [et_process -community_id $community_id "km_object_feedback_notify" $replacement_list]
+ }
+ }
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,39 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<blockquote>
+<b>@object_name@</b>:<br>
+@overview_with_href_and_mailto;noquote@
+
+<p>
+
+<h3>@headline@</h3>
+
+<form action=comment-add-2 method=post>
+<csrf-token>
+@form_vars;noquote@
+
+<if @user_id@ ne @author_id@>
+Please tell <a href="../users/yp?user_id=@author_id@">@author_name@</a> how valuable you find
+her/his @object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>".
+ <if @public_p@ eq 1>
+ He/she will receive a variable number of <ad-parameter package=acs-kernel name=SystemName> Shares defined by you along with your comment.
+ </if>
+</if><else>
+Please give your feedback on your @object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>".
+</else>
+
+<if @categories:rowcount@ gt 0>
+ <h4><strong>What sort of feedback do you give?</strong></h4>
+ <p><select name="feedback_category_id" size="1">
+ <option value="0">-- Please choose one--
+ <multiple name=categories><option value="@categories.category_id@"<if @feedback_category_id@ eq @categories.category_id@> selected</if>>@categories.level;noquote@ @categories.name@</multiple>
+ </select>
+</if>
+
+<p>
+
+<center><input type=submit name=submit value="Proceed"></center>
+</form>
+
+</blockquote>
Index: openacs-4/contrib/obsolete-packages/library/www/comment-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-add.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-add.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,109 @@
+ad_page_contract {
+ /packages/library/www/comment-add.tcl
+
+ Let the user choose a category for his feedback.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-add.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ {feedback_category_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+} -properties {
+ title:onevalue
+ object_name:onevalue
+ object_type:onevalue
+ headline:onevalue
+ overview_with_href_and_mailto:onevalue
+ form_vars:onevalue
+ categories:multirow
+ author_id:onevalue
+ author_name:onevalue
+ feedback_category_id:onevalue
+ public_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set community_id $node(package_id)
+
+if ![km_check_object_id $object_id] { return }
+set author_id [km_conn original_author_id]
+set author_name [km_conn original_author_name]
+set public_p [km_conn public_p]
+
+if {[km_conn archived_p]} {
+ ad_return_complaint 1 "Only feedback for not archived knowledge objects is allowed!"
+ return
+}
+
+set object_name [km_conn object_name]
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+
+set title "Give feedback for \"$object_name\""
+set headline "Give feedback"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Feedback category"
+set overview_with_href_and_mailto [util_make_href_and_mailto_links [km_conn overview]]
+
+set form_vars [export_form_vars object_id path_id category_id]
+
+set feedback_category_tree_assigned_p [db_0or1row feedback_category_tree {
+ select gt.tree_name, octr.subtree_root_node_id, gt.root_node_id as original_root_node_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :package_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if { !$feedback_category_tree_assigned_p } {
+ ad_returnredirect "comment-add-2?[export_url_vars object_id path_id category_id]"
+ return
+} else {
+ # get feedback categories
+ if { $subtree_root_node_id == $original_root_node_id } {
+ set level_correction 1
+ } else {
+ set level_correction 0
+ }
+
+ template::multirow create categories name category_id level
+
+ set sql_query "
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id, deprecated_p, node_id,
+ level as sortlevel
+ from sw_category_dim
+ start with node_id = :subtree_root_node_id
+ connect by prior node_id = parent_node_id"
+
+ # don't allow feedback categories with feedback points
+ # if user is author of the object or the object is private
+ if {($user_id == $author_id) || !$public_p} {
+ set sql_query "
+ select cat.name, cat.category_id, cat.deprecated_p,
+ cat.node_id, cat.sortlevel
+ from sn_comments_category_settings ccs,
+ ($sql_query) cat
+ where ccs.object_id = :package_id
+ and ccs.category_id (+) = cat.category_id
+ and nvl(ccs.rating_p,'f') = 'f'"
+ }
+
+ db_foreach get_one_tree $sql_query {
+ if { [string equal $deprecated_p "f"]} {
+ if { $node_id!=$subtree_root_node_id || $subtree_root_node_id != $original_root_node_id } {
+ template::multirow append categories $name $category_id [gt_repeat_string " " [expr ($sortlevel - 1 -$level_correction) * 5]]
+ }
+ }
+ }
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/comment-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-delete-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-delete-2.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,92 @@
+ad_page_contract {
+ /packages/library/www/comment-delete-2.tcl
+
+ Allow the admin to delete feedback
+
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-delete-2.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ comment_id:notnull,integer
+ {category_id ""}
+ {path_id ""}
+}
+
+csrf::authenticate
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+set object_id [km_check_comment_id $user_id $comment_id]
+if !$object_id { return }
+
+set admin_p [km_conn admin_p]
+
+if {!$admin_p} {
+ ad_return_complaint 1 "Only admins can delete feedback!"
+ return
+}
+
+set object_name [sn_striphtml [km_conn object_name]]
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+
+set category_forward_email ""
+set scale 0
+
+set return_url "object-view?[export_url_vars object_id category_id path_id]"
+
+db_1row get_comment_data {
+ select sc.content, sc.html_p, c.long_name as feedback_category
+ from sn_comments sc, categories c
+ where comment_id=:comment_id
+ and sc.category_id = c.category_id(+) }
+
+db_transaction {
+ # remove the feedback from yellow pages
+ db_dml delete_content_area {
+ delete from acs_object_areas
+ where object_id = :comment_id
+ }
+
+ # remove the feedback
+ db_exec_plsql delete_feedback {
+ begin
+ sn_comment.delete_comment ( :comment_id );
+ end;
+ }
+
+ if { $html_p == "t" } { set comment [ad_html_to_text $content] }
+
+ set author_id [km_conn original_author_id]
+ set author_email [km_conn original_author_email]
+
+ db_1row object_info {
+ select u.email as sender_email,
+ u.first_names || ' ' || u.last_name as sender_name,
+ site_node.url(sn.node_id) as package_url
+ from users u, site_nodes sn
+ where u.user_id = :user_id
+ and sn.object_id = :package_id
+ }
+
+ set replacement_list \
+ [list \
+ knowledge_object $object_name \
+ knowledge_object_link [ad_url]${package_url}object-view?object_id=$object_id \
+ knowledge_object_type $object_type \
+ feedback_type $feedback_category \
+ recipient_email $author_email \
+ sender_email $sender_email \
+ sender_name $sender_name \
+ comment $content]
+
+ # This uses sn_community_instances_all. Should it be using
+ # sn_community_mounts_all instead?
+ set package_id [ad_conn package_id]
+ set community_id [db_string get_community_id {
+ select community_id
+ from sn_community_instances_all
+ where package_id = :package_id }]
+
+ et_queue_email [et_process -community_id $community_id "km_object_feedback_delete" $replacement_list]
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/comment-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-delete.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-delete.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,33 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<blockquote><b>@object_name@</b><br>
+@overview_with_href_and_mailto;noquote@
+
+<p><h4>Feedback:</h4>
+
+<blockquote>
+ <b>Feedback author:</b> @author@<br>
+ <if @feedback_category@ not nil><b>Feedback type:</b> @feedback_category@<br></if>
+ <if @rating@ gt -1 and @scale@ gt 0><b>Rating:</b> @rating@ out of @scale@ points</if>
+ <p><b>Comment:</b></p>@content;noquote@
+</blockquote>
+
+<p><b>Do you really want to delete this feedback?</b>
+<p>Please be aware that the shares awarded for this feedback will NOT
+be taken away by this action - you have to do these things in the Incentive system.
+<p>
+
+<center>
+<form action=comment-delete-2 method=post>
+ <csrf-token>
+ @form_vars;noquote@
+ @dc_export;noquote@
+ <input type=submit name=submit value="Delete">
+</form>
+<form action=object-view method=get>
+ @form_vars_cancel;noquote@
+ <input type=submit name=submit value="Cancel">
+</form>
+</center>
+</blockquote>
Index: openacs-4/contrib/obsolete-packages/library/www/comment-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-delete.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-delete.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,71 @@
+ad_page_contract {
+ /packages/library/www/comment-delete.tcl
+
+ Allow the admin to delete feedback
+
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-delete.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ comment_id:notnull,integer
+ {category_id ""}
+ {path_id:integer ""}
+} -properties {
+ title:onevalue
+ object_name:onevalue
+ overview_with_href_and_mailto:onevalue
+ content:onevalue
+ author:onevalue
+ admin_p:onevalue
+ rating:onevalue
+ scale:onevalue
+ feedback_category:onevalue
+ form_vars:onevalue
+ form_vars_cancel:onevalue
+ dc_export:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+set object_id [km_check_comment_id $user_id $comment_id]
+if !$object_id { return }
+
+set object_name [km_conn object_name]
+
+db_1row get_comment_data {
+ select sc.content, sc.html_p, rating, scale,
+ c.long_name as feedback_category, sc.display_p as public_p,
+ u.first_names || ' ' || u.last_name as author
+ from sn_comments sc, categories c, users u
+ where comment_id=:comment_id
+ and sc.category_id = c.category_id(+)
+ and u.user_id = sc.user_id }
+
+set admin_p [km_conn admin_p]
+
+if {!$admin_p} {
+ ad_return_complaint 1 "Only admins can delete feedback!"
+ return
+}
+
+set title "Delete feedback on \"$object_name\""
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Delete feedback"
+set overview_with_href_and_mailto [util_make_href_and_mailto_links [km_conn overview]]
+set form_vars [export_form_vars comment_id category_id path_id]
+set form_vars_cancel [export_form_vars object_id category_id path_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+
+if { [string eq $html_p "f"] } {
+ set content [ad_quotehtml $content]
+}
+
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/comment-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-edit-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-edit-2.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,122 @@
+ad_page_contract {
+ /packages/library/www/comment-edit-2.tcl
+
+ Commits the feedback changes to the db.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-edit-2.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ comment_id:notnull,integer
+ comment:notnull
+ {html_p:oneof(t|f) "f"}
+ {feedback_category_id:integer ""}
+ {public_p:optional "f"}
+ {category_id ""}
+ {path_id:integer ""}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+set object_id [km_check_comment_id $user_id $comment_id]
+if !$object_id { return }
+
+set admin_p [km_conn admin_p]
+set object_name [sn_striphtml [km_conn object_name]]
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+
+set category_forward_email ""
+set scale 0
+
+db_0or1row get_rating_scale {
+ select scale, email as category_forward_email
+ from sn_comments_category_settings
+ where object_id = :package_id
+ and category_id = :feedback_category_id
+}
+
+db_1row get_message_data {
+ select u.email as feedback_author_email, u.user_id as feedback_author_id
+ from sn_comments sc, users u
+ where sc.comment_id = :comment_id
+ and u.user_id = sc.user_id }
+
+if {!$admin_p && (($user_id != $feedback_author_id) || [km_conn archived_p])} {
+ ad_return_forbidden "Only the feedback author or admins can edit feedback!"
+ return
+}
+
+set return_url "object-view?[export_url_vars object_id category_id path_id]"
+
+db_transaction {
+
+ km_general_comment_update -html_p $html_p -public_p $public_p -feedback_category_id $feedback_category_id $feedback_author_id $object_id $comment_id $comment
+
+ if { $html_p == "t" } { set comment [ad_html_to_text $comment] }
+
+ set author_id [km_conn original_author_id]
+ set author_email [km_conn original_author_email]
+
+ db_1row object_info {
+ select u.email as sender_email,
+ u.first_names || ' ' || u.last_name as sender_name,
+ site_node.url(sn.node_id) as package_url
+ from users u, site_nodes sn
+ where u.user_id = :user_id
+ and sn.object_id = :package_id
+ and rownum = 1
+ }
+
+ if {![empty_string_p $feedback_category_id]} {
+ set feedback_category [db_string comment_edit_2_20 {
+ select long_name from categories
+ where category_id = :feedback_category_id
+ } -default ""]
+ } else {
+ set feedback_category ""
+ }
+
+ # This uses sn_community_instances_all. Should it be using
+ # sn_community_mounts_all instead?
+ set community_id [db_string get_community_id {
+ select community_id
+ from sn_community_instances_all
+ where package_id = :package_id
+ }]
+
+ if { $user_id != $author_id } {
+ set replacement_list \
+ [list \
+ knowledge_object $object_name \
+ knowledge_object_link [ad_url]${package_url}object-view?object_id=$object_id \
+ knowledge_object_type $object_type \
+ feedback_type $feedback_category \
+ recipient_email $author_email \
+ sender_email $sender_email \
+ sender_name $sender_name \
+ comment $comment]
+
+ et_queue_email [et_process -community_id $community_id "km_object_feedback_edit" $replacement_list]
+ }
+
+ if { $admin_p && $feedback_author_id != $user_id } {
+ # we have to sent the feedback author an email that an admin changed
+ # his feedback
+
+ set replacement_list \
+ [list \
+ knowledge_object $object_name \
+ knowledge_object_link [ad_url]${package_url}object-view?object_id=$object_id \
+ knowledge_object_type $object_type \
+ feedback_type $feedback_category \
+ recipient_email $feedback_author_email \
+ sender_email $sender_email \
+ sender_name $sender_name \
+ comment $comment]
+
+ et_queue_email [et_process -community_id $community_id "km_object_feedback_edit_admin" $replacement_list]
+ }
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/comment-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-edit.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-edit.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,61 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="subsite_url">@subsite_url;noquote@</property>
+<property name="subsite_name">@subsite_name;noquote@</property>
+<property name="header_stuff">@header_stuff;noquote@</property>
+
+<blockquote><b>@object_name@</b><br>
+@overview_with_href_and_mailto;noquote@
+
+<p>Edit <if @user_id@ eq @author_id@>your</if><else>the</else> comment on the @object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>".<br>
+
+<form action=comment-edit-2 method=post>
+<csrf-token>
+@form_vars;noquote@
+
+<if @admin_p@ eq 1 and @categories:rowcount@ gt 0>
+ <h4><strong>What sort of feedback should this be?</strong></h4>
+ <p><select name="feedback_category_id" size="1">
+ <option value="0">-- Please choose one--
+ <multiple name=categories><option value="@categories.category_id@" <if @categories.category_id@ eq @feedback\_category_id@> SELECTED</if>>@categories.name@</multiple>
+ </select>
+</if><else>
+ <if @feedback_category@ not nil>
+ <p>Feedback type: @feedback_category@</p>
+ </if>
+</else>
+<if @rating@ gt -1>
+ <p>Rating : @rating@ out of @scale@ points</p>
+</if>
+
+<p>
+<h4>What comment do you want to make?</h4>
+<em>Here you shall explain, describe or comment your feedback
+(i.e. what project did you reuse the information for,
+what did you learn, why do think it's outdated or should have
+more details, etc.).</em>
+</p>
+
+<table>
+<tr><td rowspan="2">
+<textarea name=comment rows=10 cols=60 wrap=soft>@content;noquote@</textarea>
+</td>
+<td valign="top">
+<a href="javascript:PopUp("@subsite_url@guidelines/quality/feedback.htm")"><img src="@subsite_url@images/logoQual.gif"
+hspace=5 border=0 align=left width=128 height=27></a>
+</td></tr>
+<tr><td>
+<p><select name=html_p>
+<option value="f"<if @html_p@ eq "f"> SELECTED</if>>Plain Text
+<option value="t"<if @html_p@ eq "t"> SELECTED</if>>HTML
+</select>
+</td></tr></table>
+<p>
+<input type="checkbox" name="public_p" value="t"<if @public_p@ eq "t"> checked</if>>
+Add this comment as a public comment to the knowledge object
+</p>
+
+<center><input type=submit name=submit value="Proceed"></center>
+</form>
+
+</blockquote>
Index: openacs-4/contrib/obsolete-packages/library/www/comment-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/comment-edit.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/comment-edit.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,120 @@
+ad_page_contract {
+ /packages/library/www/comment-edit.tcl
+
+ Allow the user to edit one of his general comments.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: comment-edit.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ comment_id:notnull,integer
+ {category_id ""}
+ {path_id:integer ""}
+} -properties {
+ title:onevalue
+ object_name:onevalue
+ object_id:onevalue
+ objec_type:onevalue
+ overview_with_href_and_mailto:onevalue
+ content:onevalue
+ rating:onevalue
+ scale:onevalue
+ admin_p:onevalue
+ feedback_category_id:onevalue
+ feedback_category:onevalue
+ public_p:onevalue
+ categories:multirow
+ form_vars:onevalue
+ user_id:onevalue
+ author_id:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ header_stuff:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set community_id $node(package_id)
+
+set object_id [km_check_comment_id $user_id $comment_id]
+if { !$object_id } { return }
+
+set object_name [km_conn object_name]
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+
+set author_id [km_conn original_author_id]
+set author_name [km_conn original_author_name]
+
+set admin_p [km_conn admin_p]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+set header_stuff "<SCRIPT LANGUAGE=\"JavaScript\" SRC=\"$subsite_url\guidelines/jscript/functions.js\" TYPE=\"text/javascript\"> </SCRIPT>"
+
+if {$admin_p} {
+ set title "Edit feedback for \"$object_name\""
+ set header "Edit feedback"
+} else {
+ set title "Edit comment on \"$object_name\""
+ set header "Edit comment"
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data $header
+set overview_with_href_and_mailto [util_make_href_and_mailto_links [km_conn overview]]
+
+template::multirow create categories category_id name deprecated_p level
+
+db_1row get_comment_data {
+ select sc.content, sc.html_p, rating, scale, c.category_id as feedback_category_id,
+ c.long_name as feedback_category, sc.display_p as public_p, sc.user_id as feedback_author_id
+ from sn_comments sc, categories c
+ where comment_id=:comment_id
+ and sc.category_id = c.category_id(+) }
+
+if {!$admin_p && (($user_id != $feedback_author_id) || [km_conn archived_p])} {
+ ad_return_forbidden "Only the feedback author or admins can edit feedback!"
+ return
+}
+
+if { [string eq $html_p "f"] } {
+ set content [ad_quotehtml $content]
+}
+
+set feedback_object_id 0
+set form_vars [export_form_vars comment_id category_id path_id feedback_category_id]
+
+if { $admin_p } {
+ #assuming that only one tree(subtree) is assigned to this object
+
+ set feedback_category_tree_assigned_p [db_0or1row feedback_category_tree {
+ select gt.tree_name, octr.subtree_root_node_id, gt.root_node_id as original_root_node_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :package_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+ if {$feedback_category_tree_assigned_p} {
+ db_foreach get_one_tree_edit {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ category.sort_key(object_id) as sort_key,
+ object_id as fb_category_id, deprecated_p, level
+ from sw_category_dim
+ start with node_id = :subtree_root_node_id
+ connect by prior node_id = parent_node_id
+ } {
+ template::multirow append categories $fb_category_id $name $deprecated_p $level
+ }
+
+ set form_vars [export_form_vars comment_id category_id path_id]
+ }
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/content-link-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/content-link-add.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/content-link-add.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,86 @@
+ad_page_contract {
+ $Id: content-link-add.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ target:integer,notnull
+ pass:integer,notnull
+ link_comment
+}
+csrf::authenticate
+
+if ![path_valid_p $pass] {
+ ad_return_error "Invalid Path" \
+ "The current path ID is invalid. Perhaps you used your browser's Back button
+ and tried to add another user?"
+ return
+}
+set object_id $target
+set user_id [ad_maybe_redirect_for_registration]
+
+# Determine to which object we are going to add the user reference,
+# and if the current user is allowed to do this.
+
+set values [get_path_values -action_only_p 0 $pass]
+set object_id_a [value_from_tuples $values object_id]
+set question_id [value_from_tuples $values question_id]
+
+if ![km_check_object_id -check_edit_p 1 $object_id_a] { return }
+
+ad_permission_p $target read
+
+# Hardcoding the link type_id here.
+set link_type bi_directional
+
+set exists_p [db_string content_link_add_10 "
+ select decode(count(*),0,0,1) from sn_links
+ where object_id_a=:object_id_a and object_id_b=:object_id"]
+
+if {!$exists_p} {
+ db_transaction {
+
+ set new_link_id [db_string content_link_add_15 "select sn_links_seq.nextval from dual"]
+
+ db_dml content_link_add_20 "
+ insert into sn_links (link_id, link_type, object_id_a, object_id_b,
+ creation_user, creation_date, link_comment)
+ select :new_link_id, 'bi_directional', :object_id_a, :object_id,
+ :user_id, sysdate, :link_comment
+ from dual
+ where not exists (select 1 from sn_links
+ where object_id_a=:object_id_a and object_id_b=:object_id)"
+
+ db_dml content_link_add_25 "
+ insert into sn_question_link_map (link_id, question_id)
+ values (:new_link_id, :question_id)"
+
+ db_dml content_link_add_30 "
+ update acs_objects
+ set last_modified = sysdate, modifying_user = :user_id
+ where object_id = :object_id_a"
+
+ db_dml content_link_add_35 "
+ update sn_objects
+ set last_modified = sysdate, last_modifying_user_id = :user_id
+ [km_link_description_update $object_id_a $question_id]
+ where object_id = :object_id_a"
+
+ db_dml content_link_add_40 "
+ update acs_objects_description
+ set state = state
+ where object_id = :object_id_a"
+
+ set one_line_desc [db_string content_link_add_50 "select shortname
+ from acs_objects_description
+ where object_id=:object_id"]
+
+ set audit_comment "Added link to \"$one_line_desc\""
+ db_dml content_link_add_60 {
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id, content)
+ values (:object_id_a, :question_id, sysdate, :user_id, :audit_comment)}
+
+}
+}
+
+# All done, back to the path's origin.
+
+ad_returnredirect [get_path_return_url $pass]
Index: openacs-4/contrib/obsolete-packages/library/www/content-link-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/content-link-delete-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/content-link-delete-2.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,58 @@
+# /www/library/content-link-delete-2.tcl
+#
+# Delete an object-content link.
+#
+# $Id: content-link-delete-2.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+
+ad_page_variables {
+ link_id
+ return_url
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# We are dealing with object <-> content links here.
+# The following query relies on the object being
+# referenced by the object_id_a column.
+
+if {![db_0or1row content_link_delete_2_10 "
+ select obj1.object_id, obj2.shortname as one_line_description, map.question_id
+ from sn_links l, sn_objects obj1, acs_objects_description obj2, sn_question_link_map map
+ where l.link_id=:link_id
+ and obj1.object_id = l.object_id_a
+ and obj2.object_id = l.object_id_b
+ and l.link_id = map.link_id"]} {
+ # The link already has been deleted.
+ ad_returnredirect $return_url
+ return
+}
+
+# Check if the user is authorized to delete this link.
+
+if ![ad_permission_p $object_id write] {
+ ad_return_error "Not authorized" "You are not authorized to delete this link."
+ return
+}
+
+# All checks passed - let's delete the row.
+
+set audit_comment "Deleted link to '$one_line_description'"
+
+db_transaction {
+ db_dml content_link_delete_2_20 "delete from sn_links where link_id=:link_id"
+ db_dml content_link_delete_2_21 "delete from sn_question_link_map where link_id=:link_id"
+
+ db_dml content_link_delete_2_40 {
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id, content)
+ values (:object_id, :question_id, sysdate, :user_id, :audit_comment)}
+
+ db_dml content_link_delete_2_50 "
+ update sn_objects
+ set last_modified = sysdate, last_modifying_user_id = :user_id
+ [km_link_description_update $object_id $question_id]
+ where object_id = :object_id"
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/content-link-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/content-link-delete.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/content-link-delete.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,22 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+Are you sure that you want to delete this link?
+
+<p><table>
+<tr>
+ <td>
+ <form action="content-link-delete-2" method=post>
+ <csrf-token>
+ @form_vars1;noquote@
+ <input type=submit name=submit value="Yes, Proceed">
+ </form>
+ </td>
+ <td>
+ <form action="one-question-edit" method=get>
+ @form_vars2;noquote@
+ <input type=submit name=submit value="No, Cancel">
+ </form>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/content-link-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/content-link-delete.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/content-link-delete.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,25 @@
+# /www/library/content-link-delete.tcl
+#
+# Ask for confirmation before deleting a object-content mapping.
+#
+# $Id: content-link-delete.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+
+ad_page_variables {
+ link_id
+ object_id
+ question_id
+ {category_id ""}
+}
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set return_url "one-question-edit?[export_url_vars object_id category_id question_id]"
+set title "Delete Link [km_conn object_name]"
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data $title
+
+set form_vars1 [export_form_vars link_id return_url]
+set form_vars2 [export_form_vars object_id category_id question_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/date-filter.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/date-filter.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/date-filter.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,9 @@
+<form action="@target@">
+<csrf-token>
+@form_vars;noquote@
+Start:
+<include src="km-date-tag" day_value="@start_day@" month_value="@start_month@" year_value="@start_year@" presentation_type="@presentation_type@" name="start" year_from="1997" year_to="2004">
+ End:
+<include src="km-date-tag" day_value="@end_day@" month_value="@end_month@" year_value="@end_year@" presentation_type="@presentation_type@" name="end" year_from="1998" year_to="2005">
+ <input type=submit value="Filter">
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/date-filter.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/date-filter.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/date-filter.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,26 @@
+if ![info exists presentation_type] {
+ set presentation_type "custom"
+}
+
+
+if ![empty_date_p $start] {
+ util_unlist [km_break_date $start] start_year start_month start_day
+} elseif ![empty_string_p $start_offset] {
+ db_1row get_start_date "select sysdate+$start_offset as start_date from dual"
+ util_unlist [km_break_date $start_date] start_year start_month start_day
+} else {
+ set start_year ""
+ set start_month ""
+ set start_day ""
+}
+
+if ![empty_date_p $end] {
+ util_unlist [km_break_date $end] end_year end_month end_day
+} elseif ![empty_string_p $end_offset] {
+ db_1row get_end_date "select sysdate+$end_offset as end_date from dual"
+ util_unlist [km_break_date $end_date] end_year end_month end_day
+} else {
+ set end_year ""
+ set end_month ""
+ set end_day ""
+}
Index: openacs-4/contrib/obsolete-packages/library/www/delete-audit-trail.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/delete-audit-trail.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/delete-audit-trail.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,43 @@
+ad_page_contract {
+ /www/library/delete-audit-trail.tcl
+
+ Delete a single row from sn_audit_table. Only admins may do this.
+
+ @cvs-id $Id: delete-audit-trail.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ rowid:notnull
+}
+csrf::authenticate
+
+ad_require_permission [ad_conn package_id] "admin"
+
+set last_item [db_string last_item {
+ select max(rowid)
+ from sn_audit_table
+ where last_modified = (select max(last_modified)
+ from sn_audit_table
+ where object_id = :object_id)
+}]
+
+set del_rowid $rowid
+
+db_transaction {
+
+ db_dml delete_audit_trail "delete from sn_audit_table where rowid=:del_rowid"
+
+ if { $last_item == $rowid } {
+ # If we just deleted the last audit item, we have to update the object timestamp.
+ db_dml update_last_modified {
+ update sn_objects
+ set last_modified = (select max(last_modified)
+ from sn_audit_table
+ where object_id = :object_id)
+ where object_id = :object_id
+ }
+ }
+
+}
+
+ad_returnredirect "object-audit-trail?object_id=$object_id&category_id=$category_id"
Index: openacs-4/contrib/obsolete-packages/library/www/file-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/file-delete-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/file-delete-2.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,30 @@
+ad_page_contract {
+ /www/library/file-delete-2.tcl
+
+ Delete an attached document.
+
+ @cvs-id $Id: file-delete-2.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ question_id:notnull,integer
+ {category_id ""}
+ {parent_question_id:integer 0}
+ {return_page "one-question-edit"}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+if [km_is_required -object_id $object_id $question_id] {
+ ad_return_warning "Required Field" \
+ "The attachment is mandatory and therefore may only be
+ overwritten, but not removed."
+ return
+}
+
+km_delete_object_data $object_id $question_id
+
+if { $parent_question_id } { set question_id $parent_question_id }
+
+ad_returnredirect "$return_page?[export_url_vars object_id category_id question_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/file-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/file-delete.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/file-delete.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,23 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+Do you really wish to remove the attachment "@client_filename@"
+from object "@object_name@"?
+
+<p><table>
+<tr>
+ <td>
+ <form action="file-delete-2" method=post>
+ <csrf-token>
+ @form_vars_proceed;noquote@
+ <input type=submit name=submit value="Yes, Proceed">
+ </form>
+ </td>
+ <td>
+ <form action="@return_page@" method=get>
+ @form_vars_cancel;noquote@
+ <input type=submit name=submit value="No, Cancel">
+ </form>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/file-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/file-delete.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/file-delete.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,49 @@
+ad_page_contract {
+ /www/library/file-delete.tcl
+
+ Ask the user for confirmation before deleting an attached document.
+
+ @cvs-id $Id: file-delete.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+ object_id:notnull,integer
+ question_id:notnull,integer
+ {parent_question_id:integer 0}
+ {category_id ""}
+ {return_page "one-question-edit"}
+} -properties {
+ title:onevalue
+ client_filename:onevalue
+ object_name:onevalue
+ form_vars_proceed:onevalue
+ form_vars_cancel:onevalue
+ return_page:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set client_filename [db_string file_delete_10 "
+ select content from sn_content
+ where object_id=:object_id and question_id=:question_id"]
+
+if [km_is_required -object_id $object_id $question_id] {
+ ad_return_warning "Required Field" \
+ "The attachment is mandatory and therefore may only be
+ overwritten, but not removed."
+ return
+}
+
+set object_name [km_conn object_name]
+set title "Delete Attached File"
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data $title
+
+set form_vars_proceed [export_form_vars object_id category_id question_id parent_question_id return_page]
+
+if { $parent_question_id } {
+ set question_id $parent_question_id
+}
+set form_vars_cancel [export_form_vars object_id category_id question_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/form.css
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/form.css,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/form.css 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,5 @@
+p { font-family:verdana,arial,helvetica,sans-serif; font-size:12px; line-height:16px; }
+.snbgform { background-color:#dddddd; }
+.sntextform { font-family:monospace; }
+.sntextformelement { font-size:12px; line-height:14px; font-weight:bold; }
+#snattention { color:#ff0000; }
Index: openacs-4/contrib/obsolete-packages/library/www/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/index.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,68 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="search_contexts">@search_contexts;noquote@</property>
+
+<if @admin_p@ eq 1><a href="admin/">Administer</a><p></if>
+
+<if @have_alert@ eq 0>
+ <a href="alert-instance?return_uri=@return_uri;noquote@">Set Alert</a>
+</if>
+
+
+<table bgcolor="#eeeeee" cellpadding=3 cellspacing=0 border=1>
+<tr bgcolor="#cccfff">
+
+<th width="5%">Graphic</th>
+
+<th width="45%">Browse Knowledge Objects</th>
+
+<if @create_p@ eq 1>
+<th width="45%">Create Knowledge Objects</th>
+</if>
+</tr>
+
+<multiple name="object_types">
+ <if @object_types.rownum@ odd><tr bgcolor="#eeeeee" valign=middle></if>
+ <else><tr bgcolor="#cccfff" valign=middle></else>
+
+ <td align=center>
+
+ <if @object_types.graphic@ ne "">
+ <a href="browse-one-type?object_type_id=@object_types.object_type_id@"><img src="/library-files/@object_types.graphic@" height=@graphic_height@ width=@graphic_width@ border=0></a>
+ </if>
+ <else> </else>
+
+ </td>
+
+ <td align=center>
+ <a href="browse-one-type?object_type_id=@object_types.object_type_id@"><b>@object_types.pretty_plural@</b></a>
+ <if @object_types.archive_p@ eq 1>
+ <br><a href="browse-one-type?object_type_id=@object_types.object_type_id@&archive=t"><b>Archived @object_types.pretty_plural@</b></a>
+ </if>
+ </td>
+
+ <td align=center>
+ <if @create_p@ eq 1 and @object_types.create_p@ eq 1>
+ <a href="object-edit?object_type_id=@object_types.object_type_id@"><b>@object_types.pretty_name@</b></a>
+ <if @object_types.copy_p@ eq 1>
+ <br><a href="object-copy?object_type_id=@object_types.object_type_id@"><b>Copy a @object_types.pretty_name@</b></a>
+ </if>
+ </if>
+ </td>
+ </tr>
+</multiple>
+
+</table>
+
+<if @task_list:rowcount@ not nil and @task_list:rowcount@ gt 0>
+ <h3>Object Approval Tasks</h3>
+ <table width="100%" cellspacing=1 cellpadding=4 border=1>
+ <tr bgcolor=#ffffe4><th>To do</th><th>On what</th><th>Submitted</th><th>Started</td></tr>
+ <multiple name=task_list>
+ <tr valign=middle bgcolor=#eeeeee><td><a href="@task_list.task_url@">@task_list.task_name@</a> </td>
+ <td><a href="browse-one-type?object_type_id=@task_list.object_type_id@">@task_list.object_type_pretty@</a> "<a href="object-view?object_id=@task_list.object_id@">@task_list.object_name@</a>" </td>
+ <td>@task_list.enabled_date@ by <a href="../users/yp?user_id=@task_list.submitter_id@">@task_list.submitter_name@</a> </td>
+ <td>@task_list.started_date@ </td></tr>
+ </multiple>
+ </table>
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/index.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,69 @@
+ad_page_contract {
+ /packages/library/www/admin/index.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: index.tcl,v 1.1 2003/07/02 12:19:42 peterm Exp $
+} {
+} -properties {
+ context_bar:onevalue
+ instance_name:onevalue
+ object_types:multirow
+ graphic_height:onevalue
+ graphic_width:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ subcommunity_id:onevalue
+ approval_p:onevalue
+ publish_p:onevalue
+ admin_p:onevalue
+}
+
+# connection timeout
+set user_id [ad_conn user_id]
+set package_id [ad_conn package_id]
+set instance_name [ad_conn instance_name]
+
+set return_uri [ad_urlencode "[ad_conn url]?[ad_conn query]"]
+set have_alert [alerts::exists]
+
+set admin_p [ad_permission_p $package_id "admin"]
+set create_p [ad_permission_p $package_id "create"]
+set publish_p [ad_permission_p $package_id "km_publish"]
+set approval_p [km_static approval_p $package_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+set subcommunity_id $node(package_id)
+
+db_multirow object_types object_type {
+ select object_type_id, pretty_name, pretty_plural, graphic,
+ decode(create_p,'t',1,0) as create_p,
+ decode(archive_p,'t',1,0) as archive_p,
+ decode(copy_p,'t',1,0) as copy_p
+ from sn_object_types
+ where deleted_p = 'f'
+ and browse_p = 't'
+ and (public_p = 't' or :admin_p = 1)
+ and context_id = :package_id
+ order by sort_key, pretty_name
+}
+
+set title "Library Index"
+set graphic_height [library_icon_height]
+set graphic_width [library_icon_width]
+
+set_context_bar_data
+
+set cf(package_id) $package_id
+portal_approval_processes [array get cf]
+
+set search_contexts [list \
+ [list "lib:$package_id" "$instance_name" ] \
+ [list "sc:$subcommunity_id" "$subsite_name" ] \
+ [sws_km_site_search_context]]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/km-checkbox-tag.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-checkbox-tag.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-checkbox-tag.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,3 @@
+<multiple name="tags">
+ <input type="checkbox" name="@tags.name@" value="@tags.item_value@" @tags.checked_string@>@tags.item;noquote@ @tags.break;noquote@
+</multiple>
Index: openacs-4/contrib/obsolete-packages/library/www/km-checkbox-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-checkbox-tag.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-checkbox-tag.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,49 @@
+# Returns a series of checkboxes with the same name and differing items/values.
+
+if {![info exists default]} {
+ set default ""
+}
+
+if {![info exists values]} {
+ set values {}
+}
+
+if {![info exists verticle_p]} {
+ set verticle_p 1
+}
+
+if {![info exists size]} {
+ set size ""
+}
+
+set counter 0
+set checked_string ""
+template::multirow create tags name item_value checked_string item break
+foreach item $items {
+
+ set item_value [lindex $values $counter]
+ foreach default_value $default {
+
+ #figure out if this item is to be checked
+ if {[string compare $item $default_value] == 0} {
+ set checked_string "checked"
+ break
+ } elseif {[string compare $item_value $default_value] == 0} {
+ set checked_string "checked"
+ break
+ }
+ set checked_string ""
+ }
+
+
+ if {[empty_string_p $item_value]} {
+ set item_value $item
+ }
+ if { $verticle_p == 0 } {
+ set break " "
+ } else {
+ set break "<br>"
+ }
+ template::multirow append tags $name $item_value $checked_string $item $break
+ incr counter
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-content-link-table.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-content-link-table.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-content-link-table.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,27 @@
+<table border="0" cellspacing="1" cellpadding="4">
+<tr>
+<th class="snbgform">No</th>
+<th class="snbgform">Headline</th>
+
+<if @edit_p@ eq 1>
+ <th class="snbgform">Action</th>
+</if>
+</tr>
+
+<multiple name="content_links">
+ <tr>
+ <td class="snbgcontent" valign="top"><p>@content_links.i@</p></td>
+ <td class="snbgcontent" valign="top"><p>@content_links.pretty_object;noquote@</p></td>
+ <td class="snbgcontent" valign="top"><p>@content_links.link_comment;noquote@</p></td>
+
+ <if @edit_p@ eq 1>
+ <td><font size=-1>
+ <a href="link-reason-edit?@content_links.reason_url_vars@">Edit linking reason</a> |
+ <a href="content-link-delete?@content_links.delete_url_vars@">Delete Link</a></font></td>
+ </if>
+ </tr>
+
+</multiple>
+
+</table>
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-content-link-table.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-content-link-table.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-content-link-table.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,50 @@
+# Displays the list of content-object links when existing_links is supplied as
+# a list of lists in the order: table_name one_line_description
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists object_id]} {
+ set object_id 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists question_id]} {
+ set question_id 0
+}
+
+# existing_links
+
+set return_url "[ns_conn url]?[ns_conn query]"
+
+template::multirow create content_links i pretty_object delete_url_vars reason_url_vars link_comment
+set i 1
+foreach link $existing_links {
+ set object_id_b [lindex $link 0]
+ set one_line_description [lindex $link 1]
+ set link_id [lindex $link 4]
+ set object_id [lindex $link 5]
+ set object_type [lindex $link 6]
+ set presentation [lindex $link 7]
+ set link_comment [lindex $link 10]
+ set comment_html_p [lindex $link 11]
+
+ if {![empty_string_p $link_comment]} {
+ if {$comment_html_p} {
+ set link_comment "([util_make_href_and_mailto_links $link_comment])"
+ } else {
+ set link_comment "([util_make_href_and_mailto_links [ad_quotehtml $link_comment]])"
+ }
+ }
+
+ array unset od
+ array set od [list name [sn_striphtml $one_line_description] presentation $presentation]
+
+ template::multirow append content_links $i [sn_presentation::generic::linkable_item $object_type $object_id_b /o/$object_id_b od] [export_url_vars link_id question_id category_id object_id] [export_url_vars object_id link_id category_id return_url] $link_comment
+
+ incr i
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-date-tag.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-date-tag.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-date-tag.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,10 @@
+<if @presentation_type@ eq "select">
+ <include src="km-select-tag" values="@days@" default="@day_value@" name="@name@.day" items="@days@">
+ <include src="km-select-tag" values="@months_values@" default="@month_value@" name="@name@.month" items="@months@">
+ <include src="km-select-tag" values="@years@" default="@year_value@" name="@name@.year" items="@years@">
+</if>
+<else>
+ <include src="km-input-tag" size="5" maxlength="2" value="@day_value@" name="@name@.day">
+ <include src="km-select-tag" values="@months_values@" default="@month_value@" name="@name@.month" items="@months@">
+ <include src="km-input-tag" size="5" maxlength="4" value="@year_value@" name="@name@.year">
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/km-date-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-date-tag.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-date-tag.tcl 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,37 @@
+# Returns three-part form elements for date entry: a select box for the month,
+# and two small text fields for day and year.
+
+# named required parameters presentation_type question_id name
+
+
+if {![info exists day_value]} {
+ set day_value ""
+}
+
+if {![info exists month_value]} {
+ set month_value ""
+}
+
+if {![info exists year_value]} {
+ set year_value ""
+}
+
+util_unlist [month_list] months months_values
+
+if {[string equal $presentation_type "select"]} {
+ set days [list 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31]
+ if ![info exists year_from] {
+ util_unlist [km_get_year_range $question_id] year_from year_to
+ }
+ set years [list]
+ for { set year $year_from } { $year <= $year_to } { incr year } {
+ lappend years $year
+ }
+ if { $year_value < $year_from } {
+ set years [concat $year_value $years]
+ } elseif { $year_value > $year_to } {
+ set years [concat $years $year_value]
+ }
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-child-object.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-child-object.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-child-object.adp 2 Jul 2003 12:19:42 -0000 1.1
@@ -0,0 +1,41 @@
+<table border=0 cellspacing=0 cellpadding=1>
+<tr>
+<td width="100%" class="snbgform">
+<table border="0" cellspacing="1" cellpadding="4">
+<tr>
+<th class="snbgform">No.</th><th class="snbgform">Content</th></tr>
+<tr>
+<if @short_desc_list@ ne "">
+ <th class="snbgform"> @short_desc_list@ </th>
+</if>
+<if @long_p@ eq 1>
+ <th class="snbgform"> @long_pretty_name@ </th>
+</if>
+<if @edit_p@ eq 1>
+ <th>Action</th>
+</if>
+
+<multiple name="children_list">
+ <tr>
+ <td class="snbgcontent" valign="top"><p>@children_list.i@</p></td>
+ <if @children_list.short_p@ eq 1>
+ <td class="snbgcontent" valign="top"><a href="object-view?@children_list.url_vars;noquote@">@children_list.short_description@</a><if @children_list.public_p@ eq "f"> <font color=red>[Private]</font></if><if @children_list.archived_p@ eq "t"> <font color=red>[Archived]</font></if><if @children_list.review_p@ eq "t"> <font color=green>[In review]</font></if></td>
+ </if>
+ <if @children_list.long_p@ eq 1>
+ <td class="snbgcontent" valign="top"><if @children_list.short_p@ eq 0><a href="object-view?@children_list.url_vars;noquote@">@children_list.long_description@</a></if><else>@children_list.long_description@</else><if @children_list.short_p@ eq 0><if @children_list.public_p@ eq "f"> <font color=red>[Private]</font></if><if @children_list.archived_p@ eq "t"> <font color=red>[Archived]</font></if><if @children_list.review_p@ eq "t"> <font color=green>[In review]</font></if></if></td>
+ </if>
+
+ <if @children_list.edit_p@ eq 1>
+ <td class="snbgcontent" valign="top"><p>
+ <if @children_list.question_state@ ne "read-only">
+ <a href="questions?@children_list.url_vars;noquote@">Edit</a> |
+ </if>
+ <a href="object-delete?@children_list.url_vars;noquote@">Delete</a></td>
+ </if>
+ </tr>
+</multiple>
+
+</table>
+</td>
+</tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-child-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-child-object.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-child-object.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,87 @@
+# Takes a list of child_object_data and displays the short_description and
+# long description in a blue box.
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists child_object_type]} {
+ set child_object_type 0
+}
+
+if {![info exists question_state]} {
+ set question_state "active"
+}
+
+# question_id user_id object_id children
+
+
+if !$child_object_type {
+ set child_object_type [db_string km_display_child_object_1 "
+ select target_object_type_id
+ from sn_questions where question_id=:question_id"]
+}
+set context_id [ad_conn package_id]
+
+# We need the pretty name of the short and long descriptions:
+db_1row question_info_long_desc {
+ select nvl(q.question_id,0) as long_p, q.pretty_name as long_pretty_name
+ from sn_questions q, sn_object_types ot
+ where ot.long_description = q.question_id(+)
+ and ot.object_type_id = :child_object_type
+ and ot.context_id = :context_id
+}
+
+set short_desc_list ""
+
+db_foreach question_info_short_desc {
+ select q1.pretty_name as short_pretty_name
+ from sn_questions q1, sn_types_map_short_name map, sn_object_types ot
+ where map.short_description = q1.question_id(+)
+ and map.object_type_id = :child_object_type
+ and map.object_type_id = ot.object_type_id
+ and ot.context_id = :context_id
+ order by position
+} {
+ if {![empty_string_p $short_desc_list]} {
+ append short_desc_list ", $short_pretty_name"
+ } else {
+ set short_desc_list $short_pretty_name
+ }
+}
+
+if {![empty_string_p $short_desc_list]} {
+ set short_p 1
+} else {
+ set short_p 0
+}
+
+set table ""
+
+set i 1
+
+template::multirow create children_list short_p long_p short_description public_p archived_p review_p edit_p question_state i url_vars long_description
+foreach child $children {
+ util_unlist $child object_id public_p archived_p review_p short_description long_description
+
+ if {[empty_string_p $short_description]} {
+ set short_description [km_get_object_name $object_id]
+ }
+ set short_description [sn_striphtml $short_description]
+
+ template::multirow append children_list $short_p $long_p $short_description $public_p $archived_p $review_p $edit_p $question_state $i [export_url_vars object_id category_id] $long_description
+ incr i
+}
+
+
+
+
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-composite.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-composite.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-composite.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,5 @@
+<table border=0 cellspacing=2 cellpadding=2>
+<multiple name="children_list">
+ <tr><td><include src="km-display-question-answer" value_only_p="0" question_id="@children_list.question_id@" abstract_data_type="@children_list.abstract_data_type@" value="@children_list.value;noquote@" object_id="@object_id@" category_id="@category_id@" pretty_question="@children_list.pretty_question@"></td></tr>
+</multiple>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-composite.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-composite.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-composite.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,12 @@
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+template::multirow create children_list value question_id pretty_name abstract_data_type pretty_question
+foreach child $children {
+ util_unlist $child value question_id pretty_name abstract_data_type
+
+ if [km_answered_p $abstract_data_type $value] {
+ template::multirow append children_list $value $question_id $pretty_name $abstract_data_type [km_static question_pretty_name $question_id]
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-file.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-file.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-file.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,6 @@
+<if @everything_is_okay_p@ eq t>
+ <a href="download/@object_id@.@question_id@/@url_filename@">@client_filename@</a> (@file_size@ bytes)
+</if>
+<else>
+ <font color=red>Something is wrong with the file. Sorry.</font>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-file.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-file.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,16 @@
+# Link to a downloadable file and show its size. If the document has
+# disappeared, tell the user so.
+
+# object_id question_id client_filename
+
+
+regsub -all {[^-_.0-9a-zA-Z]+} $client_filename "_" url_filename
+
+if ![catch { set file_size [file size [km_file_path]/$object_id.$question_id] } errmsg] {
+ set everything_is_okay_p t
+} else {
+ set everything_is_okay_p f
+ ns_log Warning "Something went wrong with the file [km_file_path]/$object_id.$question_id: $errmsg"
+}
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-nephew-object.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-nephew-object.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-nephew-object.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,65 @@
+<table border=0 cellspacing=0 cellpadding=1>
+<tr>
+<td width="100%" class="snbgform">
+<table border="0" cellspacing="1" cellpadding="4">
+<tr>
+<th class="snbgform">No</th>
+<if @short_p@ eq 1>
+ <th class="snbgform"> @short_desc_list;noquote@ </th>
+</if>
+
+<if @long_p@ eq 1>
+ <th class="snbgform"> @long_pretty_name;noquote@ </th>
+</if>
+
+@action_caption;noquote@
+</tr>
+
+@table;noquote@
+<multiple name="nephews_list">
+<tr>
+ <td class="snbgcontent" valign="top"><p>@nephews_list.i@</p></td>
+ <if @nephews_list.short_p@ eq 1>
+ <td class="snbgcontent" valign="top"><p><a href="object-view?@nephews_list.url_vars;noquote@">@nephews_list.short_description@</a>
+ <if @nephews_list.public_p@ eq "f">
+ <font color=red>[Private]</font>
+ </if>
+ <if @nephews_list.archived_p@ eq "t">
+ <font color=red>[Archived]</font>
+ </if>
+ <if @nephews_list.review_p@ eq "t">
+ <font color=green>[In review]</font>
+ </if>
+ </p></td>
+ </if>
+ <if @nephews_list.long_p@ eq 1>
+ <td class="snbgcontent" valign="top"><p><if @nephews_list.short_p@ eq 0><a href="object-view?@nephews_list.url_vars;noquote@">@nephews_list.long_description@</a></if><else>@nephews_list.long_description@</else>
+ <if @nephews_list.short_p@ eq 0>
+ <if @nephews_list.public_p@ eq "f">
+ <font color=red>[Private]</font>
+ </if>
+ <if @nephews_list.archived_p@ eq "t">
+ <font color=red>[Archived]</font>
+ </if>
+ <if @nephews_list.review_p@ eq "t">
+ <font color=green>[In review]</font>
+ </if>
+ </if>
+ </p></td>
+ </if>
+ <if @nephews_list.edit_p@ eq 1>
+ <td class="snbgcontent" valign="top"><p>
+ <if @nephews_list.question_state@ ne "read-only">
+ <a href="questions?@nephews_list.url_vars;noquote@">Edit</a> |
+ </if>
+ <a href="object-delete?@nephews_list.url_vars;noquote@">Delete</a></td>
+ </if>
+</tr>
+</multiple>
+
+
+
+</table>
+</td>
+</tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-nephew-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-nephew-object.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-nephew-object.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,88 @@
+# Takes a list of nephew_object_data and displays the short_description and
+# long description in a blue box.
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists nephew_object_type]} {
+ set nephew_object_type 0
+}
+
+if {![info exists question_state]} {
+ set question_state "active"
+}
+
+# question_id user_id object_id nephews
+
+# Takes a list of nephew_object_data and displays the short_description and
+# long description in a blue box.
+
+
+if { $edit_p } {
+ set action_caption "<th>Action</th>"
+} else {
+ set action_caption ""
+}
+if !$nephew_object_type {
+ set nephew_object_type [km_static question_target_object_type_id $question_id]
+}
+set context_id [ad_conn package_id]
+
+# We need the pretty name of the short and long descriptions:
+db_1row question_info_long_desc {
+ select nvl2(q.question_id,1,0) as long_p, q.pretty_name as long_pretty_name
+ from sn_questions q, sn_object_types ot
+ where ot.long_description = q.question_id(+)
+ and ot.object_type_id = :nephew_object_type
+ and ot.context_id = :context_id
+}
+
+set short_desc_list ""
+db_foreach question_info_short_desc {
+ select q1.pretty_name as short_pretty_name
+ from sn_questions q1, sn_types_map_short_name map, sn_object_types ot
+ where map.short_description = q1.question_id(+)
+ and map.object_type_id = :nephew_object_type
+ and map.object_type_id = ot.object_type_id
+ and ot.context_id = :context_id
+ order by position
+} {
+ if {![empty_string_p $short_desc_list]} {
+ append short_desc_list ", $short_pretty_name"
+ } else {
+ set short_desc_list $short_pretty_name
+ }
+}
+
+if {![empty_string_p $short_desc_list]} {
+ set short_p 1
+ set short_desc_list [join $short_desc_list ", "]
+} else {
+ set short_p 0
+}
+
+set table ""
+
+set i 1
+template::multirow create nephews_list edit_p question_state i short_p long_p short_description public_p archived_p review_p url_vars long_description
+
+foreach nephew $nephews {
+ util_unlist $nephew object_id public_p archived_p review_p short_description long_description
+
+ set short_description ""
+ if { $short_p } {
+ if {[empty_string_p $short_description]} {
+ set short_description [km_get_object_name $object_id]
+ }
+ set short_description [sn_striphtml $short_description]
+ }
+
+ template::multirow append nephews_list $edit_p $question_state $i $short_p $long_p $short_description $public_p $archived_p $review_p [export_url_vars object_id category_id] [util_trim_string_with_hrefs $long_description]
+ incr i
+}
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-question-answer.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-question-answer.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-question-answer.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,68 @@
+<if @answered_p@ eq 1>
+ <if @value_only_p@ eq 0>
+ <tr><th align="right" valign="top">
+ </if>
+
+ @pretty_question;noquote@
+
+ <if @value_only_p@ eq 0>
+ </th>
+
+ <td> </td>
+
+ <td align="left" valign="top">
+
+ <if @abstract_data_type@ eq "object_link">
+ <include src="km-linked-object-list" question_id="@question_id@" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" linked_object_list="@value@">
+ </if>
+ <if @abstract_data_type@ eq "text">
+ @text_value;noquote@
+ </if>
+
+ <if @abstract_data_type@ eq "integer">
+ @integer_value@
+ </if>
+
+ <if @abstract_data_type@ eq "content_link">
+ <include src="km-content-link-table" category_id="@category_id@" existing_links="@value@">
+ </if>
+
+ <if @abstract_data_type@ eq "user_link">
+ <include src="km-user-link-table" category_id="@category_id@" existing_links="@value@">
+ </if>
+
+ <if @abstract_data_type@ eq "nephew_object">
+ <include src="km-display-nephew-object" question_id="@question_id@" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" nephews="@value@">
+ </if>
+
+ <if @abstract_data_type@ eq "child_object">
+ <include src="km-display-child-object" question_id="@question_id@" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" children="@value@">
+ </if>
+
+ <if @abstract_data_type@ eq "composite">
+ <include src="km-display-composite" object_id="@object_id@" category_id="@category_id@" children="@value;noquote@">
+ </if>
+
+ <if @abstract_data_type@ eq "option">
+ @option_value@
+ </if>
+
+ <if @abstract_data_type@ eq "category">
+ @category_value@
+ </if>
+
+ <if @abstract_data_type@ eq "other_category">
+ @category_value@
+ </if>
+
+ <if @abstract_data_type@ eq "date">
+ @date_value@
+ </if>
+
+ <if @abstract_data_type@ eq "file">
+ <include src="km-display-file" client_filename="@value@" object_id="@object_id@" question_id="@question_id@">
+ </if>
+
+ </td></tr>
+ </if>
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/km-display-question-answer.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-display-question-answer.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-display-question-answer.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,88 @@
+if {![info exists pretty_question]} {
+ set pretty_question ""
+}
+
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists branch_p]} {
+ set branch_p ""
+}
+
+if {![info exists root_branch_p]} {
+ set root_branch_p ""
+}
+
+if {![info exists value_only_p]} {
+ set value_only_p 0
+}
+
+set answered_p [km_answered_p $abstract_data_type $value]
+
+if {$answered_p} {
+ set user_id [ad_conn user_id]
+ if {[empty_string_p $root_branch_p]} {
+ set root_branch_p [km_root_branch_p $question_id]
+ }
+
+ if { [empty_string_p $branch_p] || $branch_p } {
+ set object_type_id [km_conn object_type_id]
+ set branch_parent [km_branch_parent $question_id $object_type_id]
+ } else {
+ set branch_parent ""
+ }
+
+ switch $abstract_data_type {
+ "category" {
+ set category_value [km_display_category_value $value]
+ }
+ "other_category" {
+ set category_value [km_display_other_category_value $value $object_id $question_id]
+ }
+ "option" {
+ set option_value [km_display_options $value]
+ }
+ "date" {
+ set date_value [util_AnsiDatetoPrettyDate [fst $value]]
+ }
+ "text" {
+ set text_value [fst $value]
+ if [empty_string_p $text_value] { return "" }
+
+ set html_p [snd $value]
+
+ if { [empty_string_p $html_p] || !$html_p == 1 } {
+ set text_value [ad_text_to_html -- $text_value]
+ } else {
+ set text_value [ad_activate_hyperlinks $text_value]
+ }
+ }
+ "integer" {
+ set integer_value [fst $value]
+ }
+ }
+
+ if {($edit_p && ![km_conn archived_p]) || [km_conn admin_p]} {
+ # The edit links on object-view.tcl are set according to abstract_data_type:
+ if { $abstract_data_type == "object_link" } {
+ set pretty_question "<a href=\"object-link?[export_url_vars object_id category_id question_id]\">[sn_striphtml $pretty_question]</a>"
+ } else {
+ set pretty_question "<a href=\"one-question-edit?[export_url_vars object_id category_id question_id]\">[sn_striphtml $pretty_question]</a>"
+ }
+ } else {
+ set pretty_question $pretty_question
+ }
+
+ if {![empty_string_p $branch_parent]} {
+ set pretty_question "... $pretty_question"
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-form.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-form.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-form.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,83 @@
+<multiple name="fields">
+ <if @fields_only_p@ eq 0>
+ <table border="0" width="100%" cellspacing="0" cellpadding="4">
+ <tr><td class="snbgform">
+ <p class="sntextformelement">@fields.pretty_name;noquote@ <include src="question-state" question_state="@fields.question_state@"></p>
+ </td></tr>
+ </table>
+
+ <p>@fields.entry_explanation;noquote@</p>
+ </if>
+ <else>
+ <p>@fields.entry_explanation;noquote@ <include src="question-state" question_state="@fields.question_state@"></p>
+ </else>
+
+ <p>
+ <if @fields.abstract_data_type@ eq "date">
+ <include src="question-field-date" value="@fields.value;noquote@" object_type_id="@object_type_id@" object_id="@fields.object_id@" presentation_type="@fields.presentation_type@" question_id="@fields.question_id@" question_state="@fields.question_state@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "composite">
+ <include src="question-field-composite" edit_p="@edit_p@" object_id="@fields.object_id@" category_id="@category_id@" show_values_p="@show_values_p@" question_id="@fields.question_id@" children="@fields.value;noquote@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "child_object">
+ <include src="question-field-child-object" edit_p="@edit_p@" object_id="@fields.object_id@" category_id="@category_id@" question_id="@fields.question_id@" question_state="@fields.question_state@" children="@fields.value;noquote@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "nephew_object">
+ <include src="question-field-nephew-object" edit_p="@edit_p@" object_id="@fields.object_id@" category_id="@category_id@" question_id="@fields.question_id@" question_state="@fields.question_state@" value="@fields.value;noquote@" >
+ </if>
+
+ <if @fields.abstract_data_type@ eq "user_link">
+ <include src="question-field-user-link" edit_p="@edit_p@" object_id="@fields.object_id@" category_id="@category_id@" question_id="@fields.question_id@" hit_database_p="@show_values_p@" question_state="@fields.question_state@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "content_link">
+ <include src="question-field-content-link" edit_p="@edit_p@" object_id="@fields.object_id@" category_id="@category_id@" question_id="@fields.question_id@" hit_database_p="@show_values_p@" question_state="@fields.question_state@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "object_link">
+ <include src="question-field-object-link" path_id="@fields.new_path_id@" return_url="@return_url;noquote@" hit_database_p="@show_values_p@" object_id="@fields.object_id@" category_id="@category_id@" question_id="@fields.question_id@" question_state="@fields.question_state@" user_id="@user_id@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "file">
+ <include src="question-field-file" value="@fields.value@" object_id="@fields.object_id@" category_id="@category_id@" question_id="@fields.question_id@" question_state="@fields.question_state@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "integer">
+ <include src="question-field-integer" height="@fields.height@" width="@fields.width@" value="@fields.value;noquote@" presentation_type="@fields.presentation_type@" question_id="@fields.question_id@" question_state="@fields.question_state@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "text">
+ <include src="question-field-text" height="@fields.height@" width="@fields.width@" value="@fields.value;noquote@" presentation_type="@fields.presentation_type@" question_id="@fields.question_id@" question_state="@fields.question_state@" html_p="@fields.html_p@" >
+ </if>
+
+ <if @fields.abstract_data_type@ eq "option">
+ <include src="question-field-option" height="@fields.height@" width="@fields.width@" value="@fields.value;noquote@" presentation_type="@fields.presentation_type@" question_id="@fields.question_id@" question_state="@fields.question_state@" items="@fields.option_answers;noquote@" item_values="@fields.option_ids@" mandatory_p="@fields.mandatory_p@">
+ </if>
+
+ <if @fields.abstract_data_type@ eq "category">
+ <include src="question-field-category" height="@fields.height@" width="@fields.width@" value="@fields.value;noquote@" presentation_type="@fields.presentation_type@" question_id="@fields.question_id@" question_state="@fields.question_state@" items="@fields.items;noquote@" item_values="@fields.item_values@" mandatory_p="@fields.mandatory_p@">
+
+ <if @fields.descriptions@ ne "">
+ <script language="JavaScript" src="util.js" type="text/javascript"></script>
+ <br><a href="javascript:OpenPopup("show-descriptions?question_id=@fields.question_id@")">Show
+ category descriptions</a>
+ </if>
+
+ </if>
+
+ <if @fields.abstract_data_type@ eq "other_category">
+ <include src="question-field-other-category" height="@fields.height@" width="@fields.width@" value="@fields.value;noquote@" presentation_type="@fields.presentation_type@" question_id="@fields.question_id@" question_state="@fields.question_state@" items="@fields.items;noquote@" item_values="@fields.item_values@" other_value="@fields.other_value@" mandatory_p="@fields.mandatory_p@">
+
+ <if @fields.descriptions@ ne "">
+ <script language=\"JavaScript\" src=\"util.js\" type=\"text/javascript\"></script>
+ <br><a href=\"javascript:OpenPopup("show-descriptions?question_id=$question_id")\">Show
+ category descriptions</a>
+ </if>
+
+ </if>
+
+ </p>
+</multiple>
Index: openacs-4/contrib/obsolete-packages/library/www/km-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-form.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-form.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,239 @@
+# Given an object_type_id or a question_id, this proc returns a
+# create/edit form. You will only see values for a given object if you
+# pass its object_id and set show_values_p 1. You set question_id if you
+# just want to see one question. Important!!! YOU have to put in the
+# form tags around this html.
+
+if {![info exists object_id]} {
+ set object_id 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists show_values_p]} {
+ set show_values_p 0
+}
+
+if {![info exists all_types_p]} {
+ set all_types_p 0
+}
+
+if {![info exists form_view]} {
+ set form_view 1
+}
+
+if {![info exists question_ids]} {
+ set question_ids {}
+}
+
+if {![info exists object_type_id]} {
+ set object_type_id 0
+}
+
+if {![info exists user_id]} {
+ set user_id 0
+}
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists path_id]} {
+ set path_id ""
+}
+
+if {![info exists fields_only_p]} {
+ set fields_only_p 0
+}
+
+if {![info exists mandatory_p]} {
+ set mandatory_p 0
+}
+
+if {![info exists ancestor_id]} {
+ set ancestor_id 0
+}
+
+if { $object_id && $show_values_p } {
+ set question_states {active deprecated read-only}
+ if {$all_types_p} {
+ lappend question_states invisible
+ }
+} else {
+ set question_states {active}
+}
+
+if ![null_p $question_ids] {
+ set questions [km_get_questions -question_states $question_states -question_ids $question_ids -root_node_p 0 -all_properties_p 1]
+} elseif { $object_type_id } {
+ if { $mandatory_p } { set form_view "" }
+ set questions [km_get_questions -question_states $question_states -form_view $form_view -branch_children_p 0 -mandatory_p $mandatory_p -all_properties_p 1 -object_type_id $object_type_id]
+} else {
+ return
+}
+
+if { $object_id && $show_values_p } {
+ # try to display some values - the proc get_object_data expects a *keyed* list
+ set values [km_get_object_data -answers_only_p 1 -questions $questions $object_id]
+} else {
+ set values {}
+}
+
+# Separate the key list and the questions list.
+set key [head $questions]
+set questions [tail $questions]
+
+set counter 0
+set html ""
+set question_id_ix [lsearch $key "question_id"]
+set abstract_data_type_ix [lsearch $key "abstract_data_type"]
+set pretty_name_ix [lsearch $key "pretty_name"]
+set presentation_type_ix [lsearch $key "presentation_type"]
+set entry_explanation_ix [lsearch $key "entry_explanation"]
+set height_ix [lsearch $key "tag_height"]
+set width_ix [lsearch $key "tag_width"]
+set mandatory_p_ix [lsearch $key "mandatory_p"]
+set question_state_ix [lsearch $key "question_state"]
+set defaults_question_id_ix [lsearch $key "defaults_question_id"]
+
+if !$user_id { set user_id [ad_get_user_id] }
+set return_url "[ns_conn url]?[ns_conn query]"
+
+template::multirow create fields object_id pretty_name abstract_data_type question_state entry_explanation height width value html_p presentation_type question_id question_state items item_values option_ids new_path_id descriptions option_ids option_answers other_value mandatory_p
+
+foreach question $questions {
+
+ set value [lindex $values $counter]
+ set question_id [lindex $question $question_id_ix]
+ set abstract_data_type [lindex $question $abstract_data_type_ix]
+ set pretty_name [lindex $question $pretty_name_ix]
+ set presentation_type [lindex $question $presentation_type_ix]
+ set entry_explanation [lindex $question $entry_explanation_ix]
+ set height [lindex $question $height_ix]
+ set width [lindex $question $width_ix]
+ set mandatory_p [lindex $question $mandatory_p_ix]
+ set question_state [lindex $question $question_state_ix]
+ set defaults_question_id [lindex $question $defaults_question_id_ix]
+ set items ""
+ set item_values ""
+ set option_ids ""
+ set new_path_id ""
+ set descriptions ""
+ set html_p 0
+ set option_ids ""
+ set option_answers ""
+ set other_value ""
+ set other_value_def ""
+ incr counter
+
+ # if a default for this question should be taken from ancestor object,
+ # get the default if no value has been provided yet
+ if {([empty_string_p $value]) && ($ancestor_id > 0) && ($defaults_question_id > 0)} {
+ switch $abstract_data_type {
+ "text" - "integer" - "date" {
+ db_0or1row get_default_content {
+ select content as value, html_p
+ from sn_content
+ where question_id = :defaults_question_id
+ and object_id = :ancestor_id
+ }
+ if {[string equal $abstract_data_type "text"]} {
+ set value [list $value $html_p]
+ }
+ }
+ "category" {
+ set value [km_get_categories $ancestor_id $defaults_question_id]
+ }
+ "other_category" {
+ set value [km_get_categories $ancestor_id $defaults_question_id]
+ db_0or1row get_default_other_value_field {
+ select content as other_value_def
+ from sn_content
+ where question_id = :defaults_question_id
+ and object_id = :ancestor_id
+ }
+ }
+ }
+ }
+
+ if { $question_state != "active" && ![km_answered_p $abstract_data_type $value] } {
+ # Don't show deprecated or read-only questions which haven't been answered yet.
+ continue
+ }
+
+ if { $mandatory_p == "t" } {
+ set pretty_name "$pretty_name <span id=\"snattention\">*</span>"
+ }
+
+ # Call the proc that know how to display this abstract_data_type.
+ switch $abstract_data_type {
+ "date" {
+ set value [fst $value]
+ }
+ "object_link" {
+ set path_vars [set_path_values -question_id $question_id $object_id $category_id]
+ set new_path_id [init_path -last_path_id $path_id $path_vars $return_url link]
+ }
+ "option" {
+ # Get the answer options for this question
+ util_unlist [transpose [km_get_answer_options $question_id]] \
+ option_ids option_answers
+
+ set value [fst [transpose $value]]
+ if {![empty_string_p $value]} {
+ #pass the list of checked items
+ set item_values [fst [transpose $value]]
+ }
+ }
+ "category" {
+ # Get the categories for this question
+ set item_values {}
+ set items {}
+ set descriptions {}
+ set show_descriptions_p 0
+ foreach category [km_get_child_categories $question_id] {
+ util_unlist $category category_id category_name description node_id level
+
+ lappend item_values $category_id
+ lappend items "[gt_repeat_string " " [expr $level*4]]$category_name"
+ lappend descriptions $description
+
+ if { ![empty_string_p $description] } { set show_descriptions_p 1 }
+ }
+ if { !$show_descriptions_p } { set descriptions "" }
+
+ if { ![null_p $value] } { set value [fst [transpose $value]] }
+ }
+ "other_category" {
+ # Get the categories for this question
+ set item_values {}
+ set items {}
+ set descriptions {}
+ set show_descriptions_p 0
+ foreach category [km_get_child_categories $question_id] {
+ util_unlist $category category_id category_name description node_id level
+
+ lappend item_values $category_id
+ lappend items "[gt_repeat_string " " [expr $level*4]]$category_name"
+ lappend descriptions $description
+
+ if { ![empty_string_p $description] } { set show_descriptions_p 1 }
+ }
+ if { !$show_descriptions_p } { set descriptions "" }
+
+
+ set other_value [snd [fst [km_get_object_content -question_ids [list $question_id] $object_id]]]
+ if [empty_string_p $other_value] { set other_value $other_value_def }
+
+ if { ![null_p $value] } { set value [fst [transpose $value]] }
+ }
+ "text" {
+ set html_p [snd $value]
+ set value [fst $value]
+ }
+ }
+
+ template::multirow append fields $object_id $pretty_name $abstract_data_type $question_state $entry_explanation $height $width $value $html_p $presentation_type $question_id $question_state $items $item_values $option_ids $new_path_id $descriptions $option_ids $option_answers $other_value $mandatory_p
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-input-tag.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-input-tag.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-input-tag.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1 @@
+<input type="text" size="@size@" maxlength="@maxlength@" name="@name@" value="@value@">
Index: openacs-4/contrib/obsolete-packages/library/www/km-input-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-input-tag.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-input-tag.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,15 @@
+if {![info exists size] || [empty_string_p $size]} {
+ set size 60
+}
+
+if {![info exists maxlength]} {
+ set maxlength 199
+}
+
+if {![info exists value]} {
+ set value ""
+}
+
+set value $value
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/km-linked-object-list.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-linked-object-list.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-linked-object-list.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,74 @@
+<multiple name="linked_objects_list">
+ <if @display_object_types_p@ eq 1>
+ <ul>
+ <p><table>
+ <tr><td valign=top><include src="km-object-type-img" graphic="@linked_objects_list.graphic@" attributes="hspace=5"></td>
+ <td><b>@linked_objects_list.pretty_type_plural@</b><br>
+ </ul>
+ </td></tr></table>
+ </if>
+ <else>
+ <ul>
+ </else>
+ <group column=object_type_id>
+ <if @linked_objects_list.question@ ne "">
+ <p>Question: <cite>@linked_objects_list.question;noquote@</cite>
+ </if>
+
+ <li>
+
+ <if @linked_objects_list.from_p@ eq 1>
+ Link to
+ </if>
+ <else>
+ Link from
+ </else>
+
+ <if @linked_objects_list.public_p@ eq 0>
+ <font color=red>[Private]</font>
+ </if>
+ <if @linked_objects_list.archived_p@ eq 1>
+ <font color=red>[Archived]</font>
+ </if>
+ <if @linked_objects_list.review_p@ eq 1>
+ <font color=green>[In review]</font>
+ </if>
+
+ <if @linked_objects_list.may_view_p@ eq t>
+ <a href="/o/@linked_objects_list.linked_object_id@">@linked_objects_list.linked_object_name@</a>
+ </if>
+ <else>
+ <font color=gray>@linked_objects_list.linked_object_name@</font>
+ <em>You are not allowed to view this object. You may ask
+ @owner_html;noquote@ for permission.</em>
+ </else>
+
+ <if @display_inline_object_types_p@ eq 1>
+ @linked_objects_list.object_type_pretty_name@
+ </if>
+
+ @linked_objects_list.link_comment;noquote@ by @linked_objects_list.present_owner_html;noquote@
+
+ <if @linked_objects_list.overview@ ne "">
+ <br>@linked_objects_list.overview@
+ </if>
+
+ <if @linked_objects_list.edit_links_p@ eq 1 or @linked_objects_list.delete_links_p@ eq 1>
+ <br><font size=-1>
+ </if>
+ <if @linked_objects_list.edit_links_p@ eq 1>
+ <a href="link-reason-edit?@linked_objects_list.url_vars@">Edit linking reason</a>
+ </if>
+ <if @linked_objects_list.edit_links_p@ eq 1 and @linked_objects_list.delete_links_p@ eq 1>
+ |
+ </if>
+ <if @linked_objects_list.delete_links_p@ eq 1>
+ <a href="link-delete?@linked_objects_list.url_vars@">Delete link</a>
+ </if>
+ <if @linked_objects_list.edit_links_p@ eq 1 or @linked_objects_list.delete_links_p@ eq 1>
+ </font>
+ </if>
+
+ </group>
+ </ul>
+</multiple>
Index: openacs-4/contrib/obsolete-packages/library/www/km-linked-object-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-linked-object-list.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-linked-object-list.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,182 @@
+# Takes the keyed lists from km_get_linked_objects and
+# organizes them into HTML lists sorted by object_type.
+
+# Note that edit_links_p and delete_links_p display edit/delete
+# hyperlinks for *all* links. We do not check permissions.
+
+if {![info exists edit_links_p]} {
+ set edit_links_p 0
+}
+
+if {![info exists delete_links_p]} {
+ set delete_links_p 0
+}
+
+if {![info exists display_object_types_p]} {
+ set display_object_types_p 0
+}
+
+if {![info exists display_inline_object_types_p]} {
+ set display_inline_object_types_p 0
+}
+
+if {![info exists display_questions_p]} {
+ set display_questions_p 0
+}
+
+if {![info exists question_id]} {
+ set question_id 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists return_url]} {
+ set return_url ""
+}
+
+# This page is used by admin/view-sample-form,
+# so km_conn may return empty strings.
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set write_p [km_conn write_p]
+
+if [empty_string_p $admin_p] {
+ set admin_p [ad_permission_p [ad_conn package_id] "admin"]
+}
+
+if [empty_string_p $archived_p] { set archived_p 0 }
+if [empty_string_p $write_p] { set admin_p 0 }
+
+if { $archived_p && !$admin_p } {
+ set edit_links_p 0
+ set delete_links_p 0
+}
+
+set source_object_type_id [km_get_object_type $object_id]
+set key [head $linked_object_list]
+set linked_objects [tail $linked_object_list]
+if [null_p $linked_objects] return
+
+if { $question_id && [llength $linked_objects] > 1 } {
+
+ set order_by [km_static question_order_by $question_id]
+
+ proc lindex2 {idx xs} { return [lindex $xs $idx] }
+ switch $order_by {
+ "name desc" { set linked_objects [reverse $linked_objects] }
+ "last_modified" -
+ "last_modified desc" {
+ set last_modified_ix [lsearch $key last_modified]
+ set linked_objects [qsort $linked_objects "lindex2 $last_modified_ix"]
+ if { $order_by == "last_modified desc" } {set linked_objects [reverse $linked_objects] }
+ }
+ "link_id" -
+ "link_id desc" {
+ set link_id_ix [lsearch $key link_id]
+ set linked_objects [qsort $linked_objects "lindex2 $link_id_ix"]
+ if { $order_by == "link_id desc" } {set linked_objects [reverse $linked_objects] }
+ }
+ default {}
+ }
+}
+
+set linked_object_id_ix [lsearch $key linked_object_id]
+set name_ix [lsearch $key name]
+set overview_ix [lsearch $key overview]
+set overview_html_p_ix [lsearch $key overview_html_p]
+set link_comment_ix [lsearch $key link_comment]
+set comment_html_p_ix [lsearch $key comment_html_p]
+set linked_object_type_ix [lsearch $key linked_object_type]
+set question_id_ix [lsearch $key question_id]
+set public_p_ix [lsearch $key public_p]
+set archived_p_ix [lsearch $key archived_p]
+set review_p_ix [lsearch $key review_p]
+set from_p_ix [lsearch $key from_p]
+set owner_id_ix [lsearch $key owner_id]
+set owner_name_ix [lsearch $key owner_name]
+
+set result ""
+set last_question_id 0
+
+template::multirow create linked_objects_list object_type_id pretty_type_plural graphic overview link_comment public_p archived_p review_p linked_object_name may_view_p owner_html question from_p object_type_pretty_name present_owner_html edit_links_p delete_links_p link_id linked_object_id url_vars
+
+foreach item $linked_objects {
+ set linked_object_id [lindex $item $linked_object_id_ix]
+ set linked_object_name [lindex $item $name_ix]
+ set overview [lindex $item $overview_ix]
+ set overview_html_p [lindex $item $overview_html_p_ix]
+ set link_comment [lindex $item $link_comment_ix]
+ set comment_html_p [lindex $item $comment_html_p_ix]
+ set object_type_id [lindex $item $linked_object_type_ix]
+ set question_id [lindex $item $question_id_ix]
+ set public_p [lindex $item $public_p_ix]
+ set archived_p [lindex $item $archived_p_ix]
+ set review_p [lindex $item $review_p_ix]
+ set from_p [lindex $item $from_p_ix]
+ set owner_id [lindex $item $owner_id_ix]
+ set owner_name [lindex $item $owner_name_ix]
+
+ set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+ set graphic [km_static object_type_graphic $object_type_id]
+
+ # Establish the permissions + publishing facts
+ set edit_p $write_p
+ set view_p [lindex $item [lsearch $key view_p]]
+ if [empty_string_p $view_p] { set view_p 0 }
+
+ if {![empty_string_p $link_comment]} {
+ if {$comment_html_p} {
+ set link_comment "([util_make_href_and_mailto_links $link_comment])"
+ } else {
+ set link_comment "([util_make_href_and_mailto_links [ad_quotehtml $link_comment]])"
+ }
+ }
+
+ if {[empty_string_p $linked_object_name]} {
+ # Use the default "Unnamed <pretty_object_type>" label.
+ set linked_object_name [km_get_object_name $linked_object_id]
+ }
+
+ if { $public_p || $view_p || $edit_p } {
+ set may_view_p t
+ set owner_html ""
+ } else {
+ set may_view_p f
+ set owner_html [ad_present_user $owner_id "the owner"]
+ }
+ set linked_object_name [sn_striphtml $linked_object_name]
+
+ set question ""
+ if { $display_questions_p && ![empty_string_p $question_id] && $last_question_id != $question_id } {
+ if { $from_p } {
+ set question_ot_id $source_object_type_id
+ } else {
+ set question_ot_id $object_type_id
+ }
+
+ set question_info [km_get_question -entry_explanation_p 1 $question_id $question_ot_id]
+ set explanation [lindex $question_info 4]
+ set short_explanation [km_shorten_question $explanation]
+ if ![empty_string_p $short_explanation] {
+ set question "$short_explanation"
+ }
+ set last_question_id $question_id
+ }
+
+ set present_owner_html [ad_present_user $owner_id $owner_name]
+ if { $public_p || $view_p || $edit_p } {
+ if { [string length $overview] > 200 } {
+ set overview "[string range $overview 0 200]..."
+ }
+ } else {
+ set overview ""
+ }
+
+ set link_id [lindex $item [lsearch $key link_id]]
+ set url_vars [export_url_vars object_id category_id link_id return_url]
+
+ template::multirow append linked_objects_list $object_type_id $pretty_type_plural $graphic $overview $link_comment $public_p $archived_p $review_p $linked_object_name $may_view_p $owner_html $question $from_p [km_static object_type_pretty_name $object_type_id] $present_owner_html $edit_links_p $delete_links_p $link_id $linked_object_id $url_vars
+
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-object-type-img.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-object-type-img.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-object-type-img.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,6 @@
+<if @graphic@ ne "">
+ <img src="/library-files/@graphic@" height="@library_icon_height@" width="@library_icon_width@" @attributes@>
+</if>
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-object-type-img.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-object-type-img.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-object-type-img.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,7 @@
+if {![info exists attributes]} {
+ set attributes ""
+}
+
+set library_icon_height [library_icon_height]
+set library_icon_width [library_icon_width]
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-radio-tag.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-radio-tag.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-radio-tag.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,3 @@
+<multiple name="tags">
+ <input type="radio" name="@tags.name@" value="@tags.item_value@" @tags.checked_string@>@tags.item@
+</multiple>
Index: openacs-4/contrib/obsolete-packages/library/www/km-radio-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-radio-tag.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-radio-tag.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,47 @@
+# Returns any number of radio boxes with one optionally checked.
+
+if {![info exists default]} {
+ set default ""
+}
+
+if {![info exists values]} {
+ set values {}
+}
+
+if {![info exists empty_tag]} {
+ set empty_tag ""
+}
+
+if {![info exists mandatory_p]} {
+ set mandatory_p f
+}
+
+set counter 0
+template::multirow create tags name item_value checked_string item
+
+if {![empty_string_p $empty_tag] && ($mandatory_p == "f")} {
+ if {[empty_string_p $default]} {
+ set checked_string "checked"
+ } else {
+ set checked_string ""
+ }
+ template::multirow append tags $name "" $checked_string $empty_tag
+}
+
+foreach item $items {
+ if {[string equal $item $default]} {
+ set checked_string "checked"
+ } else {
+ set checked_string ""
+ }
+
+ set item_value [lindex $values $counter]
+ if {[empty_string_p $item_value]} {
+ set item_value $item
+ } elseif {[string equal $item_value $default]} {
+ set checked_string "checked"
+ }
+
+ template::multirow append tags $name $item_value $checked_string $item
+ incr counter
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-ref-buttons.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-ref-buttons.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-ref-buttons.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,6 @@
+</p>
+<p>Add a reference to
+<input type="submit" name="add_sn_ref.@question_id@" value="Community Content">
+<input type="submit" name="add_web_ref.@question_id@" value="Web/Email Address"></p>
+<p><include src="km-text-select" name="@question_id@" html_p="@html_p@">
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-ref-buttons.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-ref-buttons.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-ref-buttons.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,18 @@
+
+# Puts two buttons below or to the right of a textarea that allow
+# the users to add a web reference or km object reference into
+# this textarea.
+
+if {![info exists email_only_p]} {
+ set email_only_p 0
+}
+
+if {![info exists user_only_p]} {
+ set user_only_p 0
+}
+
+if {![info exists horizontal_p]} {
+ set horizontal_p 0
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/km-select-tag.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-select-tag.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-select-tag.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,16 @@
+<if @multiple_p@ eq 1>
+ <select multiple size=@size@ name="@name@">
+</if>
+<else>
+ <select size=@size@ name="@name@">
+</else>
+
+<multiple name="tags">
+ <if @tags.selected_p@ eq t>
+ <option SELECTED value="@tags.value@">@tags.display_string;noquote@
+ </if>
+ <else>
+ <option value="@tags.value@">@tags.display_string;noquote@
+ </else>
+</multiple>
+</select>
Index: openacs-4/contrib/obsolete-packages/library/www/km-select-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-select-tag.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-select-tag.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,58 @@
+# Returns an entire select tag.
+
+if {![info exists default]} {
+ set default ""
+}
+
+if {![info exists values]} {
+ set values {}
+}
+
+if {![info exists multiple_p]} {
+ set multiple_p 0
+}
+
+if {![info exists size]} {
+ set size ""
+}
+
+if {![info exists empty_tag]} {
+ set empty_tag ""
+}
+
+if {$multiple_p} {
+ if [empty_string_p $size] { set size 15 }
+} else {
+ if [empty_string_p $size] { set size 1 }
+}
+
+if {![info exists mandatory_p]} {
+ set mandatory_p f
+}
+
+if [null_p $values] { set values $items }
+
+set count 0
+template::multirow create tags value selected_p display_string
+
+if {![empty_string_p $empty_tag] && ($mandatory_p == "f")} {
+ if [empty_string_p $default] {
+ set selected_p t
+ } else {
+ set selected_p f
+ }
+ template::multirow append tags "" $selected_p $empty_tag
+}
+
+foreach value $values {
+ if { $multiple_p && [lsearch $default $value] != -1 || [string compare $default $value] == 0 } {
+ set selected_p t
+ } else {
+ set selected_p f
+ }
+ template::multirow append tags $value $selected_p [lindex $items $count]
+ incr count
+}
+if {[llength $values] < $size } {
+ set size [llength $values]
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-submit-button.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-submit-button.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-submit-button.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1 @@
+<input type="submit" name="@name@" value="@value@">
Index: openacs-4/contrib/obsolete-packages/library/www/km-submit-button.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-submit-button.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-submit-button.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,15 @@
+# Returns a submit button tag. The text on the button defaults to
+# Submit, unless you specify it.
+
+if {![info exists size]} {
+ set size 30
+}
+
+if {![info exists value]} {
+ set value "Proceed"
+}
+
+ad_return_template
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-text-select.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-text-select.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-text-select.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,5 @@
+The text above is <select size=1 name="@var_name@"><option @plain_checked@ value="0">Plain Text
+<option @html_checked@ value="1">HTML
+</select>
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-text-select.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-text-select.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-text-select.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,25 @@
+# Makes the select box for the html or plain text choice for a textarea
+
+if {![info exists name]} {
+ set name ""
+}
+
+if {![info exists html_p] || [empty_string_p $html_p]} {
+ set html_p 0
+}
+
+if {$html_p} {
+ set html_checked "SELECTED"
+ set plain_checked ""
+} else {
+ set plain_checked "SELECTED"
+ set html_checked ""
+}
+
+if {![empty_string_p $name]} {
+ set var_name "$name.html_p"
+} else {
+ set var_name "html_p"
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/km-textarea-tag.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-textarea-tag.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-textarea-tag.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,2 @@
+<textarea name="@name@" cols="@cols@" rows="@rows@" wrap="soft">@value@</textarea>
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-textarea-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-textarea-tag.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-textarea-tag.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,16 @@
+if {![info exists cols] || [empty_string_p $cols]} {
+ set cols 60
+}
+
+if {![info exists rows] || [empty_string_p $rows]} {
+ set rows 15
+}
+
+if {![info exists value]} {
+ set value ""
+}
+
+ad_return_template
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-user-link-table.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-user-link-table.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-user-link-table.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,23 @@
+<table border=1 cellspacing=0 cellpadding=1>
+
+<if @edit_p@ eq 1>
+ <tr><th>No.</th><th>@community_name@ Community Member</th><th>Action</th></tr>
+</if>
+<else>
+ <tr><th>No.</th><th>@community_name@ Community Member</th></tr>
+</else>
+
+
+<multiple name="user_links">
+ <tr>
+ <td><p>@user_links.i@</p></td><td><p><a href="../users/yp?user_id=@user_links.user_id@">
+ @user_links.user_name@</a></p></td>
+
+ <if @edit_p@ eq 1>
+ <td><p><font size=-1><a href="user-link-delete?@user_links.url_vars@">Delete Link</a></font></p></td>
+ </if>
+ </tr>
+
+</multiple>
+
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/km-user-link-table.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-user-link-table.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-user-link-table.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,35 @@
+# Displays the list of user-objects links when existing_links is supplied as a
+# list of lists in the order: user_id full_name
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists object_id]} {
+ set object_id 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists question_id]} {
+ set question_id 0
+}
+
+# existing_links
+
+set return_url "[ns_conn url]?[ns_conn query]"
+set community_name [km_get_community_name]
+
+template::multirow create user_links i user_id user_name url_vars link_id
+set i 1
+foreach link $existing_links {
+ set user_id [fst $link]
+ set user_name [snd $link]
+ set link_id [lindex $link 4]
+ set url_vars [export_url_vars link_id object_id category_id question_id]
+
+ template::multirow append user_links $i $user_id $user_name $url_vars $link_id
+ incr i
+}
Index: openacs-4/contrib/obsolete-packages/library/www/km-yes-no.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-yes-no.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-yes-no.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,3 @@
+<input type="radio" name="@name@" value="1" @checked_yes@>Yes
+<input type="radio" name="@name@" value="0" @checked_no@>No
+
Index: openacs-4/contrib/obsolete-packages/library/www/km-yes-no.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/km-yes-no.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/km-yes-no.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,12 @@
+if {![info exists default]} {
+ set default 0
+}
+
+if {$default} {
+ set checked_yes "CHECKED"
+ set checked_no ""
+} else {
+ set checked_no "CHECKED"
+ set checked_yes ""
+}
+
Index: openacs-4/contrib/obsolete-packages/library/www/link-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-delete-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-delete-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,61 @@
+# /www/library/link-delete-2.tcl
+#
+# Delete an object-object link.
+#
+# $Id: link-delete-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+
+ad_page_variables {
+ link_id
+ return_url
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# We are dealing with object <-> object links here. The following
+# query relies on the originating object being referenced by the
+# object_id_a column.
+
+if {![db_0or1row link_delete_2_10 {
+ select obj1.object_id as object_id_a, obj2.object_id as object_id_b, map.question_id
+ from sn_links l, sn_objects obj1, sn_objects obj2, sn_question_link_map map
+ where l.link_id=:link_id
+ and map.link_id = l.link_id
+ and obj1.object_id = object_id_a
+ and obj2.object_id = object_id_b}]} {
+ # The link already has been deleted.
+ ad_returnredirect $return_url
+ return
+}
+
+# Check if the user is authorized to delete this link.
+
+if ![km_check_object_id -check_edit_p 1 $object_id_a] { return }
+
+db_transaction {
+
+db_1row link_delete_2_20 "
+select object_id as object_id_b, one_line_description as target_name, pretty_name as target_type
+from sn_objects obj, sn_object_types ot
+where object_id=:object_id_b
+and obj.object_type_id = ot.object_type_id"
+
+# All checks passed - let's delete the row.
+
+db_dml link_delete_2_30 "delete from sn_links where link_id=:link_id"
+
+db_dml link_delete_2_50 "
+ insert into sn_audit_table
+ (object_id, question_id, last_modified, last_modifying_user_id, content)
+ values ($object_id_a, $question_id, sysdate, $user_id,
+ 'Deleted link to $target_type \"[DoubleApos $target_name]\"')"
+
+db_dml link_delete_2_6 "
+ update sn_objects
+ set last_modified = sysdate, last_modifying_user_id = $user_id
+ [km_link_description_update $object_id_a $question_id]
+ where object_id = $object_id_a"
+
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/link-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-delete.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-delete.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,22 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+Are you sure that you want to delete this link?
+
+<p><table>
+<tr>
+ <td>
+ <form action="link-delete-2" method=post>
+ <csrf-token>
+ @form_vars_delete;noquote@
+ <input type=submit name=submit value="Yes, Proceed">
+ </form>
+ </td>
+ <td>
+ <form action="object-link" method=get>
+ @form_vars_cancel;noquote@
+ <input type=submit name=submit value="No, Cancel">
+ </form>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/link-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-delete.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-delete.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,31 @@
+# /www/library/link-delete.tcl
+#
+# Ask for confirmation before deleting an object-object link.
+#
+# $Id: link-delete.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+
+ad_page_variables {
+ object_id
+ link_id
+ {category_id ""}
+ {return_url ""}
+}
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+if [empty_string_p $return_url] {
+ set return_url "object-link?[export_url_vars object_id category_id question_id]"
+}
+
+set question_id [db_string link_delete_10 "
+ select question_id from sn_question_link_map where link_id=:link_id"]
+
+set object_name [km_conn object_name]
+
+set title "Delete Link"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Delete Link"
+
+set form_vars_delete [export_form_vars link_id return_url]
+set form_vars_cancel [export_form_vars object_id category_id question_id]
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/link-reason-add.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-reason-add.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-reason-add.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,23 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<table width=10%>
+
+<tr><td><p>Describe shortly the connection between "@original_object_name@"
+and the @target_object_type@ you are linking it to.</td></tr>
+
+<tr><td>
+<form action=object-link-2>
+<csrf-token>
+@form_vars;noquote@
+
+<p><textarea name=link_comment cols=50 rows=5 wrap=soft></textarea>
+</td></tr>
+
+<tr><td align="center"><input type=submit name=submit value="Proceed"></td></tr>
+
+<tr><td><include src="km-text-select"></td></tr>
+
+<tr><td> </td></tr>
+
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/link-reason-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-reason-add.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-reason-add.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,40 @@
+ad_page_contract {
+ link-reason-add.tcl
+
+ After the user has selected or created an object for linking,
+ ask him for the link comment.
+
+ $Id: link-reason-add.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ path_id:notnull
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if ![path_valid_p $path_id] {
+ ad_return_error "Invalid Path" \
+ "The current path ID is invalid. Perhaps you used your browser's Back button
+ and tried to add another link?"
+ return
+}
+
+set path_values [get_path_values -action_only_p 0 $path_id]
+set original_object_id [value_from_tuples $path_values object_id]
+set category_id [value_from_tuples $path_values category_id]
+
+if ![km_check_object_id -check_edit_p 1 $original_object_id] { return }
+
+set original_object_name [km_conn object_name]
+set target_object_type [db_string get_object_type {
+ select ot.pretty_name
+ from sn_object_types ot, sn_objects o
+ where o.object_id = :object_id
+ and ot.object_type_id = o.object_type_id
+}]
+
+set title "Reason for linking to \"$original_object_name\""
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Reason for linking"
+set form_vars [export_form_vars object_id path_id link_id link_comment_id]
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/link-reason-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-reason-edit-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-reason-edit-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,52 @@
+# /www/library/link-reason-edit-2.tcl
+#
+# Save the changed linking comment.
+#
+# $Id: link-reason-edit-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+
+ad_page_variables {
+ object_id
+ link_id
+ question_id
+ link_comment
+ html_p
+ return_url
+}
+csrf::authenticate
+
+set html_p [ad_decode $html_p 1 t f]
+set user_id [ad_maybe_redirect_for_registration]
+
+# Check if the user is authorized to change this comment.
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set ip_address [ns_conn peeraddr]
+
+db_transaction {
+
+db_1row km_link_objects_20 "
+ select one_line_description as target_name, pretty_name as target_type
+ from sn_objects obj, sn_object_types ot
+ where object_id=:object_id
+ and obj.object_type_id = ot.object_type_id"
+
+set content "Changed comment for link to $target_type \"[DoubleApos $target_name]\": $QQlink_comment"
+
+db_dml link_reason_edit_10 {update sn_links set link_comment = :link_comment, html_p = :html_p where link_id =:link_id}
+
+set ip_address [ns_conn peeraddr]
+db_exec_plsql link_reason_edit_20 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+}
+
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/link-reason-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-reason-edit.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-reason-edit.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,20 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<table width=10%>
+<tr><td>Describe shortly the connection between the two linked objects.</td></tr>
+
+<form action="link-reason-edit-2">
+<csrf-token>
+@form_vars;noquote@
+
+<tr><td>
+<textarea name=link_comment cols=50 rows=5 wrap=soft>@link_comment;noquote@</textarea>
+</td></tr>
+
+<tr><td><include src="km-text-select" html_p="@html_p@"></td></tr>
+<tr><td align="center"><input type=submit name=submit value="Proceed"></td></tr>
+
+</form>
+
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/link-reason-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/link-reason-edit.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/link-reason-edit.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,29 @@
+ad_page_contract {
+ link-reason-edit.tcl
+ Allow the user the change the linking reason.
+} {
+ object_id
+ link_id
+ {category_id ""}
+ {return_url ""}
+}
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+if [empty_string_p $return_url] {
+ set return_url "object-link?[export_url_vars object_id category_id question_id]"
+}
+
+db_1row link_reason_edit_10 "
+ select question_id, link_comment, html_p
+ from sn_links l, sn_question_link_map map
+ where l.link_id=:link_id and map.link_id=l.link_id"
+
+set object_name [km_conn object_name]
+
+set title "Edit Reason for Linking"
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data $title
+set form_vars [export_form_vars link_id return_url object_id question_id]
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/master.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/master.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/master.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,16 @@
+<master>
+<property name="title">@title;noquote@</property>
+<property name="focus">@focus;noquote@</property>
+<property name="header_stuff">@header_stuff;noquote@</property>
+<if @graphic_p@ eq t>
+ <property name="graphic"><include src="km-object-type-img" graphic="@graphic;noquote@"></property>
+ <property name="graphic_width">@graphic_width;noquote@</property>
+</if>
+<property name="subsite_url">@subsite_url;noquote@</property>
+<property name="subsite_name">@subsite_name;noquote@</property>
+
+<if @search_contexts@ not nil>
+ <property name="search_contexts">@search_contexts;noquote@</property>
+</if>
+
+<slave>
Index: openacs-4/contrib/obsolete-packages/library/www/master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/master.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/master.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,31 @@
+## copied from www/default-master
+
+if [template::util::is_nil title] { set title [km_get_community_name] }
+if ![info exists header_stuff] { set header_stuff {} }
+
+if { [template::util::is_nil focus] } {
+ set focus ""
+}
+
+
+if {[info exists graphic] && ![empty_string_p $graphic]} {
+ set graphic_p t
+ set graphic_width [library_icon_width]
+} else {
+ set graphic_p f
+}
+
+if {![info exists subsite_url]} {
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set subsite_url $node(url)
+ set subsite_name $node(instance_name)
+}
+
+set package_object_types_list [km_static package_object_types [ad_conn package_id]]
+template::multirow create object_types_list object_type_name object_type_id
+
+foreach package_object_type $package_object_types_list {
+ template::multirow append object_types_list [lindex $package_object_type 0] [lindex $package_object_type 1]
+}
+
+set ds_link [ad_call_proc_if_exists ds_link]
Index: openacs-4/contrib/obsolete-packages/library/www/object-access-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-access-add-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-access-add-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,46 @@
+ad_page_contract {
+ /www/library/object-access-add-2.tcl
+
+ Add a user to the access control list of a list of objects.
+
+ @cvs-id $Id: object-access-add-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ linked_objects:integer,multiple,optional
+ grantee_id:integer
+ view_p:boolean,notnull
+ edit_p:boolean,notnull
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+if [info exists linked_objects] {
+ db_transaction {
+
+ foreach linked_object_id $linked_objects {
+ if [km_check_object_id -check_edit_p 1 -print_errors_p 0 $linked_object_id] {
+ if { $view_p } {
+ db_exec_plsql grant_read {
+ begin
+ acs_permission.grant_permission(:linked_object_id, :grantee_id, 'read');
+ end;
+ }
+ }
+
+ if { $edit_p } {
+ db_exec_plsql grant_write {
+ begin
+ acs_permission.grant_permission(:linked_object_id, :grantee_id, 'write');
+ end;
+ }
+ }
+ }
+ }
+
+ }
+}
+
+ad_returnredirect "object-access?object_id=$object_id&category_id=$category_id"
Index: openacs-4/contrib/obsolete-packages/library/www/object-access-add.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-access-add.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-access-add.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,35 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<p>Access has been granted to @grantee_name@.
+
+You may <a href="object-access?object_id=@object_id@&category_id=@category_id@">return to where
+you were</a>, or also grant access to the linked objects below. To do
+so, select any number of objects and press <cite>Proceed</cite>.
+
+<form action="object-access-add-2" method=POST>
+<csrf-token>
+@form_vars;noquote@
+
+<multiple name=links>
+
+<h3><include src="km-object-type-img" graphic="@links.graphic;noquote@" attributes="{align=absmiddle hspace=10}"> @links.pretty_type_plural@</h3>
+
+<table>
+
+<group column=linked_object_type_id>
+
+<tr><td valign="top"><input type=checkbox value=@links.object_id@ name=linked_objects>
+<a href="object-view?object_id=@links.object_id@">@links.object_name@</a></td>
+<td valign="top">@links.short_description;noquote@</td><td>@links.overview;noquote@</td></tr>
+
+</group>
+
+</table>
+
+</multiple>
+
+<p><input type=submit value="Proceed">
+</table>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-access-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-access-add.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-access-add.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,116 @@
+ad_page_contract {
+ /www/library/object-access-add.tcl
+
+ Add a user or group to the object's access control list.
+ List all linked objects and let the user select the ones that should
+ be assigned the same permissions.
+
+ @cvs-id $Id: object-access-add.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {view_p:boolean 1}
+ {edit_p:boolean 1}
+ {user_id_from_search:integer,optional}
+ {group_id:integer,optional}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ object_id:onevalue
+ links:multirow
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set object_type_id [km_conn object_type_id]
+set object_name [km_conn object_name]
+set graphic [km_static object_type_graphic $object_type_id]
+
+set title "Access control for \"$object_name\""
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data [list "object-access?[export_url_vars object_id category_id]" "Access control"] "Linked Objects"
+
+if { [info exists user_id_from_search] } {
+ set grantee_name [db_string user_name {
+ select first_names || ' ' || last_name
+ from users
+ where user_id = :user_id_from_search
+ }]
+ set grantee_id $user_id_from_search
+} else {
+ set grantee_name [db_string group_name {
+ select group_name
+ from groups
+ where group_id = :group_id
+ }]
+ set grantee_id $group_id
+}
+
+if { $view_p } {
+ db_exec_plsql grant_read {
+ begin
+ acs_permission.grant_permission(:object_id, :grantee_id, 'read');
+ end;
+ }
+}
+
+if { $edit_p } {
+ db_exec_plsql grant_write {
+ begin
+ acs_permission.grant_permission(:object_id, :grantee_id, 'write');
+ end;
+ }
+}
+
+# List the linked objects for which the current user may set
+# permissions.
+
+set linked_objects [km_get_linked_objects -from_p 1 -to_p 1 $user_id $object_id]
+
+set linked_object_ix [lsearch [fst $linked_objects] linked_object_id]
+set linked_object_type_id_ix [lsearch [fst $linked_objects] linked_object_type]
+set name_ix [lsearch [fst $linked_objects] name]
+set overview_ix [lsearch [fst $linked_objects] overview]
+set form_vars [export_form_vars object_id category_id view_p edit_p grantee_id]
+
+set counter 0
+template::multirow create links linked_object_type_id graphic pretty_type_plural object_id object_name short_description overview
+
+foreach link [tail $linked_objects] {
+ set linked_object_id [lindex $link $linked_object_ix]
+ set linked_object_type_id [lindex $link $linked_object_type_id_ix]
+ set linked_object_name [lindex $link $name_ix]
+
+ if { $overview_ix != -1 } {
+ set overview [lindex $link $overview_ix]
+ } else {
+ set overview ""
+ }
+
+ if [km_check_object_id -check_edit_p 1 -print_errors_p 0 $linked_object_id] {
+ # Only show the object if the user may change the
+ # permissions for it.
+
+ set pretty_type_plural [km_static object_type_pretty_plural $linked_object_type_id]
+ set graphic [km_static object_type_graphic $linked_object_type_id]
+ if ![empty_string_p $overview] {
+ set overview [util_trim_string_with_hrefs $overview]
+ set snd_column "-"
+ } else {
+ set snd_column ""
+ }
+
+ incr counter
+
+ template::multirow append links $linked_object_type_id $graphic $pretty_type_plural $linked_object_id $linked_object_name $snd_column $overview
+ }
+}
+
+if !$counter {
+ ad_returnredirect "object-access?[export_url_vars object_id category_id]"
+ return
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-access-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-access-change.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-access-change.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,50 @@
+ad_page_contract {
+ /packages/library/www/object-access-change.tcl
+
+ Grant or revoke direct read/write permissions on an object.
+
+ @cvs-id $Id: object-access-change.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ party_ids:integer,multiple
+ allow_edit:optional
+ disallow_edit:optional
+ disallow_access:optional
+}
+csrf::authenticate
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+db_transaction {
+
+if [info exists allow_edit] {
+ foreach party_id $party_ids {
+ db_exec_plsql grant_write {
+ begin
+ acs_permission.grant_permission(:object_id, :party_id, 'write');
+ end;
+ }
+ }
+} elseif [info exists disallow_edit] {
+ foreach party_id $party_ids {
+ db_exec_plsql grant_write {
+ begin
+ acs_permission.revoke_permission(:object_id, :party_id, 'write');
+ end;
+ }
+ }
+} elseif [info exists disallow_access] {
+ foreach party_id $party_ids {
+ db_exec_plsql grant_write {
+ begin
+ acs_permission.revoke_permission(:object_id, :party_id, 'read');
+ acs_permission.revoke_permission(:object_id, :party_id, 'write');
+ end;
+ }
+ }
+}
+
+}
+
+ad_returnredirect "object-access?object_id=$object_id&category_id=$category_id"
Index: openacs-4/contrib/obsolete-packages/library/www/object-access.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-access.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-access.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,148 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<p>
+
+<if @public_p@ eq 0>
+
+This object is private.
+<if @review_p@ eq 0>
+ <a href="object-publish?object_id=@object_id@&category_id=@category_id@&return_url=@return_url;noquote@">Allow all users to view this object</a>.
+</if><else>
+ It has been submitted for approval.
+</else>
+
+</if><else>
+
+All users may view this object.
+<if @unpublish_p@ eq 1>
+ <a href="object-unpublish?object_id=@object_id@&category_id=@category_id@&return_url=@return_url;noquote@">Restrict access</a>.
+</if>
+
+</else>
+
+<if @users_read:rowcount@ gt 0 or @users_write:rowcount@ gt 0><hr></if>
+
+<if @users_read:rowcount@ gt 0>
+ <h3>Users allowed to view</h3>
+
+ <blockquote>
+ <form method=post action=object-access-change>
+ <csrf-token>
+ <input type=hidden name=object_id value=@object_id@>
+
+ <multiple name="users_read">
+ <input type=checkbox name=party_ids value=@users_read.user_id@>
+ <a href="../users/yp?user_id=@users_read.user_id@">@users_read.user_name@</a><br>
+ </multiple>
+
+ <input type=submit name=allow_edit value="Allow editing">
+ <input type=submit name=disallow_access value="Disallow Access">
+
+ </form>
+ </blockquote>
+</if>
+
+<if @users_write:rowcount@ gt 0>
+ <h3>Users allowed to edit</h3>
+
+ <blockquote>
+ <form method=post action=object-access-change>
+ <csrf-token>
+ <input type=hidden name=object_id value=@object_id@>
+
+ <multiple name="users_write">
+ <input type=checkbox name=party_ids value=@users_write.user_id@>
+ <a href="../users/yp?user_id=@users_write.user_id@">@users_write.user_name@</a><br>
+ </multiple>
+
+ <input type=submit name=disallow_edit value="Disallow editing">
+ <input type=submit name=disallow_access value="Disallow Access">
+
+ </form>
+ </blockquote>
+</if>
+
+<hr>
+
+<h3>Grant read and write access to a user</h3>
+
+<form action="user-search" method="get">
+@form_vars_search;noquote@
+
+Email address / surname contains:
+<input type=text name=keyword size=23>
+<input type=submit name=submit value="Search">
+
+</form>
+
+<if @groups_read:rowcount@ gt 0 or @groups_write:rowcount@ gt 0><hr></if>
+
+<if @groups_read:rowcount@ gt 0>
+ <h3>Groups allowed to view</h3>
+
+ <blockquote>
+ <form method=post action=object-access-change>
+ <csrf-token>
+ <input type=hidden name=object_id value=@object_id@>
+
+ <multiple name="groups_read">
+ <input type=checkbox name=party_ids value=@groups_read.group_id@>
+ <a href="groupadmin/private-group?group_id=@groups_read.group_id@&pass=object_id@object_id@category_id@category_id@" target="_blank">@groups_read.group_name@</a><br>
+ </multiple>
+
+ <input type=submit name=allow_edit value="Allow editing">
+ <input type=submit name=disallow_access value="Disallow Access">
+
+ </form>
+ </blockquote>
+</if>
+
+<if @groups_write:rowcount@ gt 0>
+ <h3>Groups allowed to edit</h3>
+
+ <blockquote>
+ <form method=post action=object-access-change>
+ <csrf-token>
+ <input type=hidden name=object_id value=@object_id@>
+
+ <multiple name="groups_write">
+ <input type=checkbox name=party_ids value=@groups_write.group_id@>
+ <a href="groupadmin/private-group?group_id=@groups_write.group_id@&pass=object_id@object_id@category_id@category_id@" target="_blank">@groups_write.group_name@</a><br>
+ </multiple>
+
+ <input type=submit name=disallow_edit value="Disallow editing">
+ <input type=submit name=disallow_access value="Disallow Access">
+
+ </form>
+ </blockquote>
+</if>
+
+<hr>
+
+<h3>Grant read and write access to a group</h3>
+
+<if @all_groups:rowcount@ gt 0>
+ <form action="object-access-add" method="post">
+ <csrf-token>
+ @form_vars_group;noquote@
+
+ Choose an existing group:
+ <select name="group_id">
+ <multiple name="all_groups">
+ <option value="@all_groups.group_id@">@all_groups.group_name@
+ </multiple>
+ </select>
+ <input type="submit" value="Grant">
+ </form>
+</if>
+
+<form action="private-group-create" method="get">
+<csrf-token>
+@form_vars_group;noquote@
+
+<p>Create a new group:
+<input name="group_name" type="text" size="30">
+<input type="submit" value="Create">
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-access.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-access.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-access.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,173 @@
+ad_page_contract {
+ /packages/library/www/object-access.tcl
+
+ @cvs-id $Id: object-access.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+} -properties {
+ title:onevalue
+ object_id:onevalue
+ url_vars:onevalue
+ return_url:onevalue
+ private_p:onevalue
+ form_vars_search:onevalue
+ form_vars_access_add:onevalue
+ users:multirow
+ unpublish_p:onevalue
+ review_p:onevalue
+ ot_archive_p:onevalue
+ task_id:onevalue
+ archived_p:onevalue
+ approval_p:onevalue
+ pretty_type:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if { ![km_check_object_id -check_edit_p 1 $object_id] } { return }
+set package_id [ad_conn package_id]
+
+set admin_p [km_conn admin_p]
+set object_name [km_conn object_name]
+set stripped_name [sn_striphtml $object_name]
+set public_p [km_conn public_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set review_p [km_conn in_review_p]
+set approval_p [km_static approval_p $package_id]
+set object_type_id [km_conn object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set ot_archive_p [km_static object_type_archive_p $object_type_id]
+set object_url "object-access"
+set title "Access control for \"$stripped_name\""
+set return_url [ad_urlencode "object-access?[export_url_vars object_id category_id]"]
+
+set unpublish_p 1
+if {$approval_p && !$admin_p && !$publish_p} {
+ set unpublish_p 0
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Access control"
+
+# Set up variables for user-search.tcl.
+set passthrough {object_id category_id}
+set target "object-access-add"
+set show_myself_p f
+set context_bar [list "object-access?[export_url_vars object_id category_id]" "Access control"]
+set form_vars_search [export_form_vars target passthrough object_id category_id show_myself_p context_bar]
+set form_vars_group [export_form_vars object_id category_id]
+set url_vars [export_url_vars object_id category_id object_name object_url]
+
+## get the task_id of the workflow task if object is in review
+if { $review_p } {
+ set task_id [db_string get_workflow_task {
+ select distinct(ut.task_id)
+ from wf_cases c, wf_user_tasks ut
+ where c.object_id = :object_id
+ and c.case_id = ut.case_id
+ and c.state = 'active'
+ and rownum = 1
+ order by ut.task_id desc
+ } -default ""]
+} else {
+ set task_id ""
+}
+
+# Get users which have direct permissions on this object.
+
+template::multirow create users_write user_id user_name
+db_foreach user_list {
+ select u.user_id as access_user_id,
+ u.first_names || ' ' || u.last_name as access_user_name
+ from acs_permissions p1, acs_permissions p2,
+ users u, sn_objects o
+ where o.object_id = :object_id
+ and p1.object_id = :object_id
+ and p1.grantee_id = u.user_id
+ and (:admin_p = 1 or p1.grantee_id <> o.original_author_id)
+ and p1.privilege = 'read'
+ and p2.object_id = :object_id
+ and p2.grantee_id = u.user_id
+ and p2.privilege = 'write'
+ order by access_user_name
+} {
+ template::multirow append users_write $access_user_id $access_user_name
+}
+
+template::multirow create users_read user_id user_name
+db_foreach user_list {
+ select u.user_id as access_user_id,
+ u.first_names || ' ' || u.last_name as access_user_name
+ from acs_permissions p1, users u, sn_objects o
+ where o.object_id = :object_id
+ and p1.object_id = :object_id
+ and p1.grantee_id = u.user_id
+ and (:admin_p = 1 or p1.grantee_id <> o.original_author_id)
+ and p1.privilege = 'read'
+ and not exists (select 1 from acs_permissions p2
+ where p2.object_id = :object_id
+ and p2.grantee_id = u.user_id
+ and p2.privilege = 'write')
+ order by access_user_name
+} {
+ template::multirow append users_read $access_user_id $access_user_name
+}
+
+
+# Get list of private groups this user owns.
+
+db_multirow all_groups all_groups {
+ select g.group_id, g.group_name
+ from groups g, acs_objects o
+ where o.creation_user = :user_id
+ and o.object_type = 'private_group'
+ and g.group_id = o.object_id
+ and g.group_id not in (select grantee_id from acs_permissions
+ where object_id = :object_id and privilege = 'read')
+}
+
+# Get private groups which have direct permissions on this object.
+# If the user is an admin, show all groups, else only the user's
+# private groups.
+
+template::multirow create groups_write group_id group_name
+db_foreach group_list {
+ select g.group_id as access_group_id,
+ g.group_name as access_group_name
+ from acs_permissions p1, acs_permissions p2,
+ groups g, acs_objects o
+ where o.object_type = 'private_group'
+ and (:admin_p = 1 or o.creation_user = :user_id)
+ and g.group_id = o.object_id
+ and p1.object_id = :object_id
+ and p1.grantee_id = g.group_id
+ and p1.privilege = 'read'
+ and p2.object_id = :object_id
+ and p2.grantee_id = g.group_id
+ and p2.privilege = 'write'
+ order by access_group_name
+} {
+ template::multirow append groups_write $access_group_id $access_group_name
+}
+
+template::multirow create groups_read group_id group_name
+db_foreach group_list {
+ select g.group_id as access_group_id,
+ g.group_name as access_group_name
+ from acs_permissions p1, groups g, acs_objects o
+ where o.object_type = 'private_group'
+ and (:admin_p = 1 or o.creation_user = :user_id)
+ and g.group_id = o.object_id
+ and p1.object_id = :object_id
+ and p1.grantee_id = g.group_id
+ and p1.privilege = 'read'
+ and not exists (select 1 from acs_permissions p2
+ where p2.object_id = :object_id
+ and p2.grantee_id = g.group_id
+ and p2.privilege = 'write')
+ order by access_group_name
+} {
+ template::multirow append groups_read $access_group_id $access_group_name
+}
Index: openacs-4/contrib/obsolete-packages/library/www/object-archive-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-archive-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-archive-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,80 @@
+ad_page_contract {
+ /packages/library/www/object-archive-2.tcl
+
+ Actually put object (and descendants) into the Archive.
+ If nephew is last public nephew, make uncle (and all descendants) private.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: object-archive-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+ cancel:optional
+ confirm:optional
+ {reason ""}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if [empty_string_p $return_url] {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+}
+
+if {[info exists cancel]} {
+ ad_returnredirect $return_url
+ return
+}
+
+if {[empty_string_p $reason]} {
+ ad_return_complaint 1 "You have to state a reason for archiving."
+ return
+}
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+if {[km_conn archived_p]} {
+ ad_returnredirect $return_url
+}
+
+set object_type_id [km_conn object_type_id]
+set archive_p [km_static object_type_archive_p $object_type_id]
+set publish_p [km_conn publish_p]
+set admin_p [km_conn admin_p]
+set public_p [km_conn public_p]
+set in_review_p [km_conn in_review_p]
+set approval_p [km_static approval_p $package_id]
+
+if {!$archive_p || ($approval_p && !$publish_p && !$admin_p && ($public_p || $in_review_p))} {
+ ad_return_complaint 1 "Not allowed to archive [km_static object_type_pretty_plural $object_type_id]!"
+ return
+}
+
+set nephew_p [km_is_mandatory_nephew_p $object_id]
+
+db_transaction {
+
+ km_object_archive $object_id $reason
+
+ db_dml insert_reason {
+ insert into sn_object_archive_reasons
+ (object_id, reason_for_archiving, archived_on)
+ values
+ (:object_id, :reason, sysdate)
+ }
+
+ if {$nephew_p} {
+ set uncle [km_get_uncle $object_id]
+ set uncle_id [fst $uncle]
+ if { [km_uncle_needs_private_status_p $uncle_id] } {
+ km_object_unpublish $uncle_id
+ }
+ }
+
+}
+
+km_flush_category_count -object_type_id $object_type_id
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/object-archive.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-archive.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-archive.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,22 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form method="post" action="object-archive-2">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<if @nephew_p@ eq 1>
+ <p>The @uncle_object_type@ "<a href="object-view?object_id=@uncle_id@&category_id=@category_id@">@uncle_name@</a>"
+ and all the linked @descendent_object_types@ may need to be made private if this is the last public
+ @object_type@ of "<a href="object-view?object_id=@uncle_id@&category_id=@category_id@">@uncle_name@</a>".
+</if>
+<if @parent_p@ eq 1 or @uncle_p@ eq 1>
+ <p>Together with this @object_type@ all linked @descendent_object_types@ will be put into the archive as well.
+</if>
+<p>Please state a reason for archiving:
+<p><textarea name=reason rows=5 cols=60 maxsize=3999 wrap=soft></textarea>
+
+<p><center><input type="submit" name="confirm" value="Proceed">
+ <input type="submit" name="cancel" value="Cancel"></center>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-archive.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-archive.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-archive.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,89 @@
+ad_page_contract {
+ /packages/library/www/object-archive.tcl
+
+ Put an object in the Archive.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: object-archive.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ dc_export:onevalue
+ uncle_id:onevalue
+ uncle_name:onevalue
+ uncle_p:onevalue
+ nephew_p:onevalue
+ object_type:onevalue
+ uncle_object_type:onevalue
+ descendent_object_types:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+if {[km_conn archived_p]} {
+ ad_returnredirect $return_url
+ return
+}
+
+set object_type_id [km_conn object_type_id]
+set archive_p [km_static object_type_archive_p $object_type_id]
+set publish_p [km_conn publish_p]
+set admin_p [km_conn admin_p]
+set public_p [km_conn public_p]
+set in_review_p [km_conn in_review_p]
+set approval_p [km_static approval_p $package_id]
+
+if {!$archive_p || ($approval_p && !$publish_p && !$admin_p && ($public_p || $in_review_p))} {
+ ad_return_complaint 1 "Not allowed to archive [km_static object_type_pretty_plural $object_type_id]!"
+ return
+}
+
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_name [km_conn object_name]
+set nephew_p [km_is_mandatory_nephew_p $object_id]
+set uncle_p [km_is_uncle_p $object_id]
+set parent_p [km_is_parent_p $object_id]
+set uncle_object_type ""
+set descendent_object_types ""
+
+if {$nephew_p} {
+ set uncle [km_get_uncle $object_id]
+ set uncle_id [fst $uncle]
+ set uncle_name [snd $uncle]
+ set uncle_object_type [km_static object_type_pretty_name [thd $uncle]]
+ set ancestor_id $uncle_id
+}
+
+if {$uncle_p || $parent_p} {
+ set ancestor_id $object_id
+}
+
+if {$uncle_p || $parent_p || $nephew_p} {
+ db_foreach get_descendent_object_type_list {
+ select q.target_object_type_id as descendent_object_type_id
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :ancestor_id
+ and o.context_id=:package_id
+ and q.abstract_data_type in ('nephew_object','child_object')
+ } {
+ lappend object_type_list [km_static object_type_pretty_plural $descendent_object_type_id]
+ }
+ set descendent_object_types [join $object_type_list " and "]
+}
+
+set title "Archive $object_type '$object_name'"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Archive"
+set form_vars [export_form_vars object_id category_id return_url]
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-audit-trail.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-audit-trail.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-audit-trail.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,26 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<multiple name=history>
+
+<h4>@history.name@ on @history.modified_date@ @history.modified_time@ by <if @history.user_link@ not nil>@history.user_link;noquote@</a></if><else>Sweeper</else>
+
+<if @admin_p@ eq 1>
+<font size=-1>(<a href="delete-audit-trail?object_id=@object_id@&category_id=@category_id@&rowid=@history.rowid@">delete</a>)</font>
+</if>
+
+</h4>
+<table>
+
+<if @history.new_p@ eq 2>
+ <tr><td valign=top>Status change:</td><td>@history.content;noquote@</td></tr>
+</if><else><if @history.new_p@ eq 1>
+ <tr><td valign=top>Added content to <a href="one-question-edit?object_id=@object_id@&question_id=@history.question_id@">@history.question_name@</a>:</td><td>@history.content;noquote@</td></tr>
+ </if><else>
+ <tr><td valign=top>Modified content for <a href="one-question-edit?object_id=@object_id@&question_id=@history.question_id@">@history.question_name@</a>:</td><td>@history.content;noquote@</td></tr>
+ </else>
+</else>
+
+</table>
+
+</multiple>
Index: openacs-4/contrib/obsolete-packages/library/www/object-audit-trail.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-audit-trail.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-audit-trail.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,70 @@
+ad_page_contract {
+ /packages/library/www/object-audit-trail.tcl
+
+ Object access history.
+
+ @cvs-id $Id: object-audit-trail.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+} -properties {
+ title:onevalue
+ admin_p:onevalue
+ history:multirow
+ object_id:onevalue
+}
+
+set user_id [ad_conn user_id]
+if ![km_check_object_id $object_id] { return }
+
+set admin_p [km_conn admin_p]
+set object_name [km_conn object_name]
+set title "History"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "History"
+
+# Get the entries in the audit table
+
+set old_selection [ns_set create old_selection]
+template::multirow create history question_id question_name content new_p rowid name modified_date modified_time user_link
+
+db_foreach object_audit_trail_10 {
+ select a.rowid, a.question_id, a.content, obj.one_line_description as name,
+ first_names || ' ' || last_name as modifying_user_name,
+ a.last_modifying_user_id as modifying_user_id, a.last_modified,
+ to_char(a.last_modified,'HH24:MI') as modified_time
+ from sn_audit_table a, sn_objects obj, users u
+ where u.user_id (+) = a.last_modifying_user_id
+ and a.object_id = :object_id
+ and obj.object_id = :object_id
+ and a.content is not null
+ order by a.last_modified asc
+} {
+ set modified_date [util_AnsiDatetoPrettyDate $last_modified]
+ if { $content != [ns_set get $old_selection $question_id] || [empty_string_p $question_id] } {
+ # report if the value changed
+ if { [empty_string_p $question_id] } {
+ set new_p 2
+ set question_name ""
+ } else {
+ set question_name [km_static question_pretty_name $question_id]
+ if { [empty_string_p [ns_set get $old_selection $question_id]]} {
+ set new_p 1
+ } else {
+ set new_p 0
+ }
+ }
+ if ![empty_string_p $modifying_user_id] {
+ set user_link [ad_present_user $modifying_user_id $modifying_user_name]
+ } else {
+ set user_link ""
+ }
+ template::multirow append history $question_id $question_name $content $new_p $rowid $name $modified_date $modified_time $user_link
+ }
+
+ if ![empty_string_p $question_id] {
+ ns_set update $old_selection $question_id $content
+ }
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy-1.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy-1.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy-1.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,20 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form method="post" action="object-copy-2">
+<csrf-token>
+@form_vars;noquote@
+
+Please select all objects that should be copied to the
+@object_type@ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>":
+
+<multiple name=descendants>
+ <p><b>@descendants.child_type_plural@:</b><p>
+ <group column=child_type_id>
+ <input type=checkbox name=object_id_list value=@descendants.child_id@> <a href="object-view?object_id=@descendants.child_id@&category_id=@category_id@">@descendants.child_name@</a> <if @descendants.public_p@ eq 0><font color=red>[Private]</font></if> <if @descendants.archived_p@ eq 1><font color=red>[Archived]</font></if> <if @descendants.review_p@ eq 1><font color=green>[In review]</font></if><br>
+ </group>
+</multiple>
+
+<input type=submit name="copy" value="Copy">
+<input type=submit name="cancel" value="Cancel">
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy-1.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy-1.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,109 @@
+ad_page_contract {
+ object-copy-1.tcl
+
+ Present user a list of descendant object which he might want to copy, too.
+ We came from index, browse-one-* or object-view
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ $Id: object-copy-1.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ {object_type_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+ {copy_id:integer ""}
+ {object_id:integer ""}
+ {return_url ""}
+ cancel:optional
+ copy:optional
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ descendants:multirow
+ object_type:onevalue
+ object_type_plural:onevalue
+ object_name:onevalue
+ object_id:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if ![empty_string_p $copy_id] {
+ set object_id $copy_id
+}
+
+if {[info exists cancel]} {
+ set return_url "browse-one-type?[export_url_vars object_type_id]"
+ ad_returnredirect $return_url
+ return
+}
+
+if {[empty_string_p $object_type_id] && [empty_string_p $object_id]} {
+ ad_return_complaint 1 "Please select an object that should be copied!"
+ return
+}
+
+## check if object can be copied - correct permissions
+if ![km_check_object_id $object_id] { return }
+if {![km_conn admin_p] && ![km_conn write_p]} { return }
+set object_type_id [km_conn object_type_id]
+set object_name [km_conn object_name]
+
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_type_plural [km_static object_type_pretty_plural $object_type_id]
+set title "Copy linked objects"
+set new_object_id [km_new_acs_object_id]
+set form_vars [export_vars -form {object_type_id category_id path_id copy_id object_id return_url}]
+set url_vars [export_url_vars object_type_id category_id path_id]
+
+if {![km_static object_type_copy_p $object_type_id]} {
+ ad_return_complaint 1 "Not allowed to copy $object_type_plural!"
+ return
+}
+
+if {![km_static object_type_create_p $object_type_id]} {
+ ad_return_complaint 1 "No standalone objects allowed for $object_type_plural!"
+ return
+}
+
+if {[empty_string_p $copy_id]} {
+ ## so we are called from object-view
+ set_the_usual_klib_context_bar $object_id $category_id
+ append_context_bar_data "Copy"
+
+} else {
+ ## so we are called from index, browse-one-type or browse-one-category
+ set_context_bar_data [list "browse-one-type?[export_url_vars object_type_id]" $object_type_plural] [list "object-copy?$url_vars" "Copy a $object_type"] $title
+}
+
+set count 0
+template::multirow create descendants child_id child_name child_type_id child_type_plural public_p archived_p review_p
+db_foreach get_object_descendants {
+ select obj.object_id as child_id, obj.one_line_description as child_name,
+ obj.object_type_id as child_type_id,
+ acs_permission.permission_p(obj.object_id, :user_id, 'write') as write_p,
+ decode(obj.public_p,'t',1,0) as public_p,
+ decode(obj.archived_p,'t',1,0) as archived_p,
+ decode(obj.in_review_p,'t',1,0) as review_p
+ from sn_objects obj, km_flat_object_hierarchy fo
+ where fo.parent = :object_id
+ and fo.distance = 1
+ and obj.object_id = fo.child
+ and obj.expiration_date > sysdate
+ order by obj.object_type_id, obj.one_line_description
+} {
+ if {$write_p == "t"} {
+ if [empty_string_p $child_name] {
+ set child_name "Unnamed [km_static object_type_pretty_name $child_type_id]"
+ }
+ template::multirow append descendants $child_id $child_name $child_type_id [km_static object_type_pretty_plural $child_type_id] $public_p $archived_p $review_p
+ }
+ incr count
+}
+
+if {$count == 0} {
+ ad_returnredirect "object-copy-2?[export_url_vars object_type_id category_id path_id copy_id object_id return_url]"
+ return
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy-2.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy-2.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy-2.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,39 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form method="post" action="object-copy-3">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<if @parent_id@ not nil>
+ Are you sure you want to copy the following @object_type_plural@
+ to the @parent_type@
+ "<a href="object-view?object_id=@parent_id@&category_id=@category_id@">@parent_name@</a>"
+ regarding "@question_name@" ?
+
+ <ul>
+ <multiple name=objects>
+ <li><a href="object-view?object_id=@objects.object_id@&category_id=@category_id@">@objects.name@</a> <if @objects.public_p@ eq 0><font color=red>[Private]</font></if> <if @objects.archived_p@ eq 1><font color=red>[Archived]</font></if> <if @objects.review_p@ eq 1><font color=green>[In review]</font></if></li>
+ </multiple>
+ </ul>
+</if>
+<else>
+ Are you sure you want to copy the @object_type@
+ "<a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>"
+ <if @objects:rowcount@ eq 0>?</if><else>and the following linked objects?
+ <p>
+ <multiple name=objects>
+ <b>@objects.object_type@:</b><ul>
+ <group column=object_type_id>
+ <li><a href="object-view?object_id=@objects.object_id@&category_id=@category_id@">@objects.name@</a> <if @objects.public_p@ eq 0><font color=red>[Private]</font></if> <if @objects.archived_p@ eq 1><font color=red>[Archived]</font></if> <if @objects.review_p@ eq 1><font color=green>[In review]</font></if></li>
+ </group>
+ </ul>
+ </multiple>
+ </else>
+</else>
+
+<p>
+<input type=submit name=copy value="Copy">
+<input type=submit name=cancel value="Cancel">
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,142 @@
+ad_page_contract {
+ object-copy-2.tcl
+
+ Asks user for confirmation before copying selected objects.
+ (a) if parent_id is set, the user can select several objects to be
+ copied to parent_id under question_id (-> object_id_list)
+ (b) if object_id is set, create a standalone object (check if possible).
+ if object_id_list is also there, we came from object-unarchive
+ or index/browse-one-*/object-view
+ (c) copy all objects in object_id_list to object copied from object_id
+ under the respective question_ids
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ $Id: object-copy-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ {object_type_id:integer ""}
+ {parent_id:integer ""}
+ {question_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+ {copy_id:integer ""}
+ {object_id:integer ""}
+ {object_id_list:integer,multiple ""}
+ {return_url ""}
+ cancel:optional
+ copy:optional
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ url_vars:onevalue
+ dc_export:onevalue
+ objects:multirow
+ object_type:onevalue
+ object_type_plural:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if ![empty_string_p $copy_id] {
+ set object_id $copy_id
+}
+
+if {[info exists cancel]} {
+ if ![empty_string_p $question_id] {
+ set return_url [get_path_return_url $path_id]
+ } else {
+ set return_url "browse-one-type?[export_url_vars object_type_id]"
+ }
+ ad_returnredirect $return_url
+ return
+}
+
+if {[empty_string_p $object_type_id] && [empty_string_p $question_id] && [empty_string_p $object_id]} {
+ ad_return_complaint 1 "Please select an object that should be copied!"
+ return
+}
+
+if ![empty_string_p $question_id] {
+ set object_type_id [km_static question_target_object_type_id $question_id]
+} elseif ![empty_string_p $object_id] {
+ ## check if object can be copied - correct permissions
+ if ![km_check_object_id $object_id] { return }
+ if {![km_conn admin_p] && ![km_conn write_p]} { return }
+ set object_type_id [km_conn object_type_id]
+}
+
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_type_plural [km_static object_type_pretty_plural $object_type_id]
+set title "Confirm copy"
+set new_object_id [km_new_acs_object_id]
+set form_vars [export_vars -form {object_type_id parent_id question_id category_id path_id copy_id object_id object_id_list:multiple new_object_id return_url}]
+set url_vars [export_url_vars object_type_id parent_id question_id category_id path_id]
+
+if {![km_static object_type_copy_p $object_type_id]} {
+ ad_return_complaint 1 "Not allowed to copy $object_type_plural!"
+ return
+}
+
+if {[empty_string_p $question_id] && ![km_static object_type_create_p $object_type_id]} {
+ ad_return_complaint 1 "No standalone objects allowed for $object_type_plural!"
+ return
+}
+
+if ![empty_string_p $object_id] {
+ set object_name [km_conn object_name]
+}
+
+if ![empty_string_p $question_id] {
+ ## so we are called from one-question-edit or object-edit
+ if [empty_string_p $object_id_list] {
+ ad_return_complaint 1 "Please select objects to be copied!"
+ return
+ }
+ if ![km_check_object_id $parent_id] { return }
+ set parent_type [km_static object_type_pretty_name [km_conn object_type_id]]
+ set parent_name [km_conn object_name]
+ set question_name [km_static question_pretty_name $question_id]
+ set_the_usual_klib_context_bar $parent_id $category_id
+ append_context_bar_data [list "object-copy?$url_vars" "Copy a $object_type"] [list [get_path_return_url $path_id] Edit] $title
+
+} elseif {![empty_string_p $return_url] && ![info exists copy]} {
+ ## so we are called from object-unarchive
+ set_the_usual_klib_context_bar $object_id $category_id
+ append_context_bar_data [list "object-unarchive?[export_url_vars object_id category_id return_url]" "Remove from Archive"] "Copy"
+
+} elseif {[empty_string_p $copy_id]} {
+ ## so we are called from object-view
+ set_the_usual_klib_context_bar $object_id $category_id
+ append_context_bar_data "Copy"
+
+} else {
+ ## so we are called from index, browse-one-type or browse-one-category
+ set_context_bar_data [list "browse-one-type?[export_url_vars object_type_id]" $object_type_plural] [list "object-copy?$url_vars" "Copy a $object_type"] $title
+}
+
+template::multirow create objects object_id name object_type_id object_type public_p archived_p review_p
+
+if {![empty_string_p $object_id_list]} {
+ db_foreach check_objects_for_copy "
+ select o.object_id as copy_object_id, o.object_type_id as type_id,
+ decode(o.one_line_description,null,'Unnamed ' || ot.pretty_name,o.one_line_description) as copy_object_name,
+ decode(o.public_p,'t',1,0) as public_p,
+ decode(o.archived_p,'t',1,0) as archived_p,
+ decode(o.in_review_p,'t',1,0) as review_p,
+ ot.pretty_plural as type_plural
+ from sn_objects o, sn_object_types ot
+ where o.object_type_id = ot.object_type_id
+ and o.object_id in ([join $object_id_list ,])
+ and o.context_id = :package_id
+ and o.expiration_date > sysdate
+ and acs_permission.permission_p(o.object_id, :user_id, 'write') = 't'
+ order by ot.pretty_plural
+ " {
+ template::multirow append objects $copy_object_id [sn_striphtml $copy_object_name] $type_id $type_plural $public_p $archived_p $review_p
+ }
+}
+
+# Double click.
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy-3.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy-3.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,140 @@
+ad_page_contract {
+ object-copy-3.tcl
+
+ Copies selected objects.
+ (a) if parent_id is set, the user can select several objects to be
+ copied to parent_id under question_id (-> object_id_list)
+ (b) if object_id is set, create a standalone object (check if possible).
+ if object_id_list is also there, we came from object-unarchive:
+ (c) copy all objects in object_id_list to object copied from object_id
+ under the respective question_ids
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ $Id: object-copy-3.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ {object_type_id:integer ""}
+ {parent_id:integer ""}
+ {question_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+ {copy_id:integer ""}
+ {object_id:integer ""}
+ {object_id_list:integer,multiple ""}
+ cancel:optional
+ {return_url ""}
+ new_object_id:integer
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if {[info exists cancel]} {
+ if ![empty_string_p $question_id] {
+ set return_url [get_path_return_url $path_id]
+ } elseif {[empty_string_p $return_url]} {
+ if [empty_string_p $copy_id] {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+ } elseif [empty_string_p $category_id] {
+ set return_url "browse-one-type?[export_url_vars object_type_id]"
+ } else {
+ set return_url "browse-one-category?[export_url_vars object_type_id category_id]"
+ }
+ }
+ ad_returnredirect $return_url
+ return
+}
+
+if ![empty_string_p $question_id] {
+ set target_url [get_path_return_url $path_id]
+} else {
+ set target_url "questions?object_id=$new_object_id&category_id=$category_id"
+}
+
+## have to deal with doubleclick here: (actually, only at object-copy-3)
+## redirect to one-question-edit/object-edit or questions of new object
+if {[doubleclick::check_all]} {
+ ns_sleep 10
+ ad_returnredirect $target_url
+ return
+}
+
+if {[empty_string_p $object_type_id] && [empty_string_p $question_id] && [empty_string_p $object_id]} {
+ ad_return_complaint 1 "Please select an object that should be copied!"
+ return
+}
+
+if ![empty_string_p $question_id] {
+ set object_type_id [km_static question_target_object_type_id $question_id]
+} elseif ![empty_string_p $object_id] {
+ ## check if object can be copied - correct permissions
+ if ![km_check_object_id $object_id] { return }
+ if {![km_conn admin_p] && ![km_conn write_p]} { return }
+ set object_type_id [km_conn object_type_id]
+}
+
+if {![km_static object_type_copy_p $object_type_id]} {
+ ad_return_complaint 1 "Not allowed to copy [km_static object_type_pretty_plural $object_type_id]!"
+ return
+}
+
+if {[empty_string_p $question_id] && ![km_static object_type_create_p $object_type_id]} {
+ ad_return_complaint 1 "No standalone objects allowed for [km_static object_type_pretty_plural $object_type_id]!"
+ return
+}
+
+if ![empty_string_p $question_id] {
+ ## so we are called from one-question-edit or object-edit
+ ## copy all objects in object_id_list to parent_id under question_id
+ if {[string equal [km_static question_abstract_data_type $question_id] "child_object"]} {
+ set link_type "parent_child"
+ } else {
+ set link_type "uncle_nephew"
+ }
+ db_transaction {
+ foreach child_id $object_id_list {
+ set new_object_id [km_new_acs_object_id]
+ km_copy_object $child_id $new_object_id
+ set result [km_link_objects -link_type $link_type $question_id $user_id $parent_id $new_object_id "" f]
+ km_check_public_status_after_edit $new_object_id
+ }
+ }
+
+} elseif {![empty_string_p $return_url] || ![empty_string_p $object_id_list]} {
+ ## so we are called from object-unarchive
+ ## or object-view, index, browse-one-*
+ ## copy object_id and object_id_list
+ db_transaction {
+ km_copy_object $object_id $new_object_id
+ set parent_id $new_object_id
+
+ if ![empty_string_p $object_id_list] {
+ db_foreach check_children "
+ select l.object_id_b as child_id, l.link_type, qlm.question_id
+ from sn_links l, sn_question_link_map qlm
+ where l.object_id_a = :object_id
+ and l.link_type in ('parent_child','uncle_nephew')
+ and l.object_id_b in ([join $object_id_list ,])
+ and l.link_id = qlm.link_id
+ " {
+ lappend child_list [list $child_id $link_type $question_id]
+ }
+
+ foreach child $child_list {
+ util_unlist $child child_id link_type question_id
+ set new_object_id [km_new_acs_object_id]
+ km_copy_object $child_id $new_object_id
+ set result [km_link_objects -link_type $link_type $question_id $user_id $parent_id $new_object_id "" f]
+ }
+ }
+ }
+
+} else {
+ ## so we are called from object-view, index, browse-one-*
+ ## copy object_id
+ db_transaction {
+ km_copy_object $object_id $new_object_id
+ }
+}
+
+ad_returnredirect $target_url
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,62 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<if @objects:rowcount@ gt 0>
+
+<form method="post" action="@target@">
+<csrf-token>
+@form_vars;noquote@
+
+<if @parent_id@ not nil>
+ Please select all @object_type_plural@ that should be copied to the
+ @parent_type@ "<a href="object-view?object_id=@parent_id@&category_id=@category_id@">@parent_name@</a>"
+ regarding "@question_name@":
+</if><else>
+ Please select a @object_type@ that should be copied:
+</else>
+
+<p>
+Sort: [ <if @order@ eq "name"><b>name</b></if><else><a href="object-copy?@url_vars@&order=name">name</a></else> |
+<if @order@ eq "name"><a href="object-copy?@url_vars@&order=date">modification date</a></if><else><b>modification date</b></else> ]
+
+<p>
+<table>
+<tr><td></td>
+ <if @short_p@ eq 1>
+ <th>@short_description@ </th>
+ </if>
+ <if @long_p@ eq 1>
+ <th>@long_description@</th>
+ </if>
+</tr>
+<multiple name=objects>
+<tr>
+<if @parent_id@ not nil>
+ <td><input type=checkbox name=object_id_list value=@objects.object_id@> </td>
+</if><else>
+ <td><input type=radio name=copy_id value=@objects.object_id@> </td>
+</else>
+<if @short_p@ eq 1>
+ <td><a href="object-view?object_id=@objects.object_id@">@objects.name@</a> <if @objects.public_p@ eq 0><font color=red>[Private]</font></if> <if @objects.archived_p@ eq 1><font color=red>[Archived]</font></if> <if @objects.review_p@ eq 1><font color=green>[In review]</font></if> </td>
+
+</if>
+<if @long_p@ eq 1>
+ <td>@objects.overview;noquote@ <if @objects.public_p@ eq 0 and @short_p@ eq 0><font color=red>[Private]</font></if> <if @objects.archived_p@ eq 1 and @short_p@ eq 0><font color=red>[Archived]</font></if> <if @objects.review_p@ eq 1 and @short_p@ eq 0><font color=green>[In review]</font></if> </td>
+</if>
+</tr>
+</multiple>
+</table>
+
+<input type=submit name="copy" value="Copy">
+<input type=submit name="cancel" value="Cancel">
+</form>
+
+</if><else>
+ You can't copy any @object_type_plural@ since you don't have write
+ permission to any @object_type@.
+
+ <form method="post" action="@target@">
+ @form_vars;noquote@
+ <input type=submit name="cancel" value="Cancel">
+ </form>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/object-copy.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-copy.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-copy.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,149 @@
+ad_page_contract {
+ object-copy.tcl
+
+ Displays a list of all objects the user can copy
+ if parent_id is not set, let user select only one object as standalone
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ $Id: object-copy.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ {object_type_id:integer ""}
+ {parent_id:integer ""}
+ {question_id:integer ""}
+ {category_id ""}
+ {path_id:integer ""}
+ {order:oneof(name|date) "name"}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ url_vars:onevalue
+ objects:multirow
+ object_type:onevalue
+ object_type_plural:onevalue
+ short_description:onevalue
+ long_description:onevalue
+ short_p:onevalue
+ long_p:onevalue
+ cancel_url:onevalue
+ target:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if {[empty_string_p $object_type_id] && [empty_string_p $question_id]} {
+ ad_return_complaint 1 "Error in page call"
+ return
+}
+
+if [empty_string_p $object_type_id] {
+ set object_type_id [km_static question_target_object_type_id $question_id]
+}
+
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_type_plural [km_static object_type_pretty_plural $object_type_id]
+set title "Copy a $object_type"
+set package_id [ad_conn package_id]
+set user_id [ad_conn user_id]
+set form_vars [export_form_vars object_type_id parent_id question_id category_id path_id]
+set url_vars [export_url_vars object_type_id parent_id question_id category_id path_id]
+
+set short_ids [km_static object_type_short_description $object_type_id]
+set long_id [km_static object_type_long_description $object_type_id]
+if {[empty_string_p $short_ids]} {
+ set short_p 0
+ set short_description ""
+} else {
+ set short_p 1
+ set short_description [list]
+ foreach short_id $short_ids {
+ lappend short_description [km_static question_pretty_name $short_id]
+ }
+ set short_description [join $short_description ", "]
+}
+if {[empty_string_p $long_id]} {
+ set long_p 0
+ set long_description ""
+} else {
+ set long_p 1
+ set long_description [km_static question_pretty_name $long_id]
+}
+if {!$short_p && !$long_p} {
+ set short_p 1
+ set short_description "Name"
+}
+
+if {![km_static object_type_copy_p $object_type_id]} {
+ ad_return_complaint 1 "Not allowed to copy $object_type_plural!"
+ return
+}
+
+if {[empty_string_p $question_id] && ![km_static object_type_create_p $object_type_id]} {
+ ad_return_complaint 1 "No standalone objects allowed for $object_type_plural!"
+ return
+}
+
+if ![empty_string_p $question_id] {
+ ## so we are called from one-question-edit or object-edit
+ if ![km_check_object_id $parent_id] { return }
+ set cancel_url [get_path_return_url $path_id]
+ set parent_type [km_static object_type_pretty_name [km_conn object_type_id]]
+ set parent_name [km_conn object_name]
+ set question_name [km_static question_pretty_name $question_id]
+ set_the_usual_klib_context_bar $parent_id $category_id
+ append_context_bar_data [list $cancel_url Edit] $title
+ set target "object-copy-2"
+
+} else {
+ ## so we are called from index, browse-one-type or browse-one-category
+ if {[empty_string_p $category_id]} {
+ set cancel_url "browse-one-type?[export_url_vars object_type_id]"
+ } else {
+ set cancel_url "browse-one-category?[export_url_vars object_type_id category_id]"
+ }
+ set target "object-copy-1"
+ set_context_bar_data [list "browse-one-type?[export_url_vars object_type_id]" $object_type_plural] $title
+}
+
+if {$order == "name"} {
+ set order_sql "lower(object_name)"
+} else {
+ set order_sql "o.last_modified"
+}
+
+template::multirow create objects object_id name overview owner_id owner_name public_p archived_p review_p
+
+set descendants_p 0
+db_foreach get_copyable_objects "
+ select o.object_id as copy_object_id, o.overview,
+ decode(o.one_line_description,null,'Unnamed ' || ot.pretty_name,o.one_line_description) as object_name,
+ decode(o.overview_html_p,'t',1,0) as overview_html_p,
+ decode(o.public_p,'t',1,0) as public_p,
+ decode(o.archived_p,'t',1,0) as archived_p,
+ decode(o.in_review_p,'t',1,0) as review_p,
+ o.creation_date, u.user_id as owner_id,
+ u.first_names || ' ' || u.last_name as owner_name,
+ acs_permission.permission_p(o.object_id, :user_id, 'write') as write_p
+ from sn_objects o, users u, sn_object_types ot
+ where ot.object_type_id = :object_type_id
+ and o.object_type_id = ot.object_type_id
+ and o.context_id = :package_id
+ and o.expiration_date > sysdate
+ and o.original_author_id = u.user_id
+ order by $order_sql
+" {
+ set descendants_p 1
+ if {$write_p == "t"} {
+ if ![empty_string_p $overview] {
+ set overview [util_trim_string_with_hrefs [sn_striphtml $overview]]
+ }
+ template::multirow append objects $copy_object_id [sn_striphtml $object_name] $overview $owner_id $owner_name $public_p $archived_p $review_p
+ }
+}
+
+# if there are no descendant objects the user could choose to copy too, redirect
+# directly to confirmation page
+if {!$descendants_p} {
+ set target "object-copy-2"
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-delete-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-delete-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,107 @@
+ad_page_contract {
+ packages/library/www/object-delete-2.tcl
+
+ Delete an object.
+
+ @cvs-id $Id: object-delete-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {parent_object_id:integer 0}
+ {uncle_object_id:integer 0}
+ {question_id:integer 0}
+ {category_id ""}
+ {reason_for_deleting ""}
+ {return_delete ""}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if {!$parent_object_id && !$uncle_object_id} {
+ set parent [km_get_parent $object_id]
+ if ![empty_string_p $parent] {
+ set parent_object_id [fst $parent]
+ }
+ set uncle [km_get_uncle $object_id]
+ if ![empty_string_p $uncle] {
+ set uncle_object_id [fst $uncle]
+ }
+}
+
+if { !$parent_object_id && !$uncle_object_id && [empty_string_p $reason_for_deleting] } {
+ ad_return_complaint 1 "<li>You have to enter a reason for deleting this object."
+ return
+}
+
+if { $parent_object_id && $parent_object_id != [fst [km_get_parent $object_id]] } {
+ ad_return_complaint 1 "The parent object given doesn't match the parent in the database."
+ return
+}
+
+if { $uncle_object_id } {
+ set parent_object_id [fst [km_get_uncle $object_id]]
+ if { $parent_object_id != $uncle_object_id } {
+ ad_return_complaint 1 "The uncle object given doesn't match the uncle in the database."
+ return
+ }
+}
+
+if { $parent_object_id && $question_id } {
+ # We're deleting a child object, so we have to use a special return_url.
+ append return_delete "?object_id=$parent_object_id&category_id=$category_id&question_id=$question_id"
+}
+
+if ![km_check_object_id -check_delete_p 1 $object_id] { return }
+set object_type_id [km_conn object_type_id]
+
+if [doubleclick::check_all $object_id] {
+ ns_sleep 2
+} else {
+ db_transaction {
+ db_dml object_delete_2_10 {
+ update sn_objects
+ set expiration_date = sysdate, last_modifying_user_id = :user_id
+ where object_id=:object_id
+ or object_id in (select child
+ from km_flat_object_hierarchy
+ where parent = :object_id)
+ }
+
+ if ![empty_string_p $reason_for_deleting] {
+ db_dml object_delete_2_20 {
+ insert into sn_object_delete_reasons (object_id, reason_for_deleting)
+ values (:object_id, :reason_for_deleting)
+ }
+ }
+
+ if { $uncle_object_id && [km_uncle_needs_private_status_p $uncle_object_id] } {
+ km_object_unpublish $uncle_object_id
+ }
+ }
+}
+
+if { [empty_string_p $return_delete] && ($parent_object_id || $uncle_object_id) } {
+ if { $parent_object_id } {
+ set object_id $parent_object_id
+ } else {
+ set object_id $uncle_object_id
+ }
+ set return_delete "object-view"
+}
+
+if {[empty_string_p $return_delete]} {
+ if {[empty_string_p $category_id] || $category_id == "none"} {
+ set return_delete "browse-one-type"
+ } else {
+ set return_delete "browse-one-category"
+ }
+}
+
+switch $return_delete {
+ "browse-one-type" { set return_delete "browse-one-type?[export_url_vars object_type_id]" }
+ "browse-one-category" { set return_delete "browse-one-category?[export_url_vars object_type_id category_id]" }
+ "object-view" { set return_delete "object-view?[export_url_vars object_id category_id]" }
+ "one-question-edit" { set return_delete "one-question_id?[export_url_vars object_id category_id question_id]" }
+}
+
+ad_returnredirect $return_delete
Index: openacs-4/contrib/obsolete-packages/library/www/object-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-delete.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-delete.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,39 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form action="object-delete-2" method=post>
+<csrf-token>
+@form_vars_delete;noquote@
+
+<if @parent_object_id@ eq 0>
+<p>Why do you want to delete the object '@object_name@'?
+<p><textarea name=reason_for_deleting rows=5 cols=60 maxsize=3999 wrap=soft></textarea>
+</if><else>
+<input type=hidden name=reason_for_deleting value="">
+</else>
+
+<p>Do you really wish to delete the @object_type@ '@object_name@'?
+
+<if @uncle_p@ ne 0>
+ <p>All @second_object_type@ will also be deleted!
+</if>
+<if @nephew_p@ ne 0>
+ <if @private_uncle_needed_p@ eq 0>
+ <p>The @second_object_type@ may get private if the last public
+ @object_type@ gets deleted.
+ </if><else>
+ <p>The @second_object_type@ will get private since this is the last public
+ @object_type@.
+ </else>
+</if>
+
+<table><tr>
+<td><input type=submit name=submit value="Yes, Proceed"></form></td>
+<td><form action="@return_cancel@" method=get>
+
+@form_vars_cancel;noquote@
+ <input type=submit name=submit value="No, Cancel">
+ </form></td></tr></table>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/object-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-delete.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-delete.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,101 @@
+ad_page_contract {
+ packages/library/www/object-delete.tcl
+
+ Ask the user for confirmation before deleting an object.
+
+ @cvs-id $Id: object-delete.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {question_id:integer 0}
+ {parent_object_id:integer 0}
+ {uncle_object_id:integer 0}
+ {return_delete ""}
+ {return_cancel ""}
+} -properties {
+ title:onevalue
+ form_vars_delete:onevalue
+ form_vars_cancel:onevalue
+ parent_object_id:onevalue
+ object_name:onevalue
+ object_type:onevalue
+ second_object_type:onevalue
+ return_cancel:onevalue
+ uncle_p:onevalue
+ nephew_p:onevalue
+ private_uncle_needed_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id -check_delete_p 1 $object_id] { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set uncle_p [km_is_uncle_p $object_id]
+set nephew_p [km_is_nephew_with_private_uncle_p $object_id "t"]
+set object_type [km_static object_type_pretty_name $object_type_id]
+set private_uncle_needed_p 0
+
+if { $parent_object_id && $parent_object_id != [fst [km_get_parent $object_id]] } {
+ ad_return_complaint 1 "The parent object given doesn't match the parent in the database."
+ return
+}
+
+if { $uncle_object_id && $uncle_object_id != [fst [km_get_uncle $object_id]] } {
+ ad_return_complaint 1 "The uncle object given doesn't match the uncle in the database."
+ return
+}
+
+if { [empty_string_p $return_delete] && [empty_string_p $return_cancel] && $question_id && ($parent_object_id || $uncle_object_id) } {
+ # We're deleting a child or nephew object
+ set return_delete "one-question-edit"
+ set return_cancel "one-question-edit"
+}
+
+if {[empty_string_p $return_delete]} {
+ set return_delete "browse-one-type"
+}
+if {[empty_string_p $return_cancel]} {
+ set return_cancel "object-view"
+}
+
+set title "Delete Object"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data $title
+
+set dc_signature [doubleclick::signature]
+set form_vars_delete [export_form_vars object_id category_id parent_object_id uncle_object_id question_id return_delete object_type_id dc_signature]
+
+if {$uncle_p} {
+ db_foreach get_nephew_object_type_list {
+ select q.target_object_type_id as nephew_object_type_id
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id=:package_id
+ and q.abstract_data_type = 'nephew_object'
+ } {
+ lappend object_type_list [km_static object_type_pretty_plural $nephew_object_type_id]
+ }
+ set second_object_type [join $object_type_list " and "]
+} elseif {$nephew_p} {
+ set uncle [km_get_uncle $object_id]
+ set second_object_type [km_static object_type_pretty_name [thd $uncle]]
+ set private_uncle_needed_p [km_uncle_needs_private_status_p [fst $uncle] $object_id]
+} else {
+ set second_object_type ""
+}
+
+if { $question_id && $parent_object_id } {
+ set object_id $parent_object_id
+}
+if { $question_id && $uncle_object_id } {
+ set object_id $uncle_object_id
+}
+
+set form_vars_cancel [export_form_vars object_id category_id question_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-deleted.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-deleted.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-deleted.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,8 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+The @pretty_type@ "@object_name@" was deleted on @expiration_date@ by @deletor_link;noquote@.
+
+<if @reason_for_deleting@ not nil>
+ <p>Reason: <blockquote>@reason_for_deleting;noquote@</blockquote></p>
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/object-deleted.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-deleted.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-deleted.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,49 @@
+ad_page_contract {
+ /www/library/object-deleted.tcl
+
+ Tell the user that this object has been deleted.
+
+ @cvs-id $Id: object-deleted.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+} -properties {
+ pretty_type:onevalue
+ object_name:onevalue
+ expiration_date:onevalue
+ deletor_link:onevalue
+ title:onevalue
+ reason_for_deleting:onevalue
+}
+
+if ![km_check_object_id -check_deleted_p 0 $object_id] { return }
+
+set object_name [km_conn object_name]
+set pretty_type [km_static object_type_pretty_name [km_conn object_type_id]]
+set expiration_date [km_conn expiration_date]
+set last_modifying_user_id [km_conn last_modifying_user_id]
+
+if [empty_string_p $object_name] {
+ set object_name "Unnamed $pretty_type"
+}
+
+db_1row deletor_info {
+ select u.first_names || ' ' || u.last_name as deletor_name
+ from users u
+ where u.user_id = :last_modifying_user_id
+}
+
+set reason_for_deleting [db_string reason_for_deleting {
+ select reason_for_deleting
+ from sn_object_delete_reasons
+ where object_id = :object_id
+} -default ""]
+
+set expiration_date [util_AnsiDatetoPrettyDate $expiration_date]
+set deletor_link [ad_present_user $last_modifying_user_id $deletor_name]
+
+set_the_usual_klib_context_bar $object_id
+append_context_bar_data "Object Deleted"
+
+set title "Object Deleted"
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-edit-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-edit-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,251 @@
+ad_page_contract {
+ /www/library/object-edit-2.tcl
+
+ First save the data from object-edit.tcl, then redirect the user
+ to his destination.
+
+ @cvs-id $Id: object-edit-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_type_id:integer
+ object_id:integer
+ {path_id:integer ""}
+ {category_id ""}
+ {parent_object_id:integer 0}
+ {uncle_object_id:integer 0}
+ {question_id:integer 0}
+ gc_checksum:notnull
+ mandatory_p:integer
+}
+csrf::authenticate
+
+set last_question_id $question_id
+set action ""
+set_the_usual_form_variables
+
+set form_size [ns_set size $Vform]
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set submit_buttons [km_get_button_names]
+
+# Go through the form and pick out the data we need for the path from
+# the data that needs to go to Oracle
+set i 0
+while {$i < $form_size} {
+
+ set key [ns_set key $Vform $i]
+ set value [ns_set value $Vform $i]
+ # isolate the general name of this form field--
+ # a submit button has the form general_name:question_id from the question_id
+ # that is is attached to
+ regsub {\..*} $key {} button_name
+
+ # see if this key is a submit button
+ set ix [lsearch [km_get_button_names] $button_name]
+ if {$ix >= 0} {
+
+ # This IS the form's submit button which sets the path action.
+ # We want to get the question_id out of it as well.
+ set action $button_name
+ regexp {.*\.([0-9]*)} $key match question_id
+
+
+ # If it's the delete button for read-only questions,
+ # get the question_id.
+ regexp {delete\.([0-9]+)} $key match delete_question_id
+
+ } elseif { [lsearch {object_type object_id category_id path_id} $key] == -1 } {
+
+ # Must be a column that belongs to the object type.
+ lappend keys $key
+ lappend values $value
+ }
+ incr i
+}
+
+# Create the object if it doesn't already exist
+if {![km_object_exists_p $object_id]} {
+ if ![km_check_object_type_id -check_view_p 0 -check_create_p 1 $object_type_id] {
+ return
+ }
+
+ set package_id [ad_conn package_id]
+ set peeraddr [ad_conn peeraddr]
+
+ db_transaction {
+ set dummy_object_id [db_exec_plsql create_object {
+ begin
+ :1 := object.insert_object (v_object_id => :object_id,
+ v_object_type_id => :object_type_id,
+ v_creation_user => :user_id,
+ v_creation_ip => :peeraddr,
+ v_context_id => :package_id);
+ end;
+ }]
+
+ db_exec_plsql grant_owner_permissions {
+ begin
+ acs_permission.grant_permission(:object_id, :user_id, 'read');
+ acs_permission.grant_permission(:object_id, :user_id, 'write');
+ acs_permission.grant_permission(:object_id, :user_id, 'delete');
+ end;
+ }
+ }
+
+ km_flush_category_count -object_type_id $object_type_id
+
+} else {
+ if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+}
+
+# Sort the form data
+set key_values [km_sort_form [zip $keys $values]]
+
+# Check the input for bad dates, etc.
+set bad_input [km_check_input $object_id $key_values]
+
+if ![null_p $bad_input] {
+ ad_return_complaint [fst $bad_input] [snd $bad_input]
+ return
+}
+
+# Save the data
+km_save_object_data $object_id $user_id $key_values
+km_check_public_status_after_edit $object_id
+
+# Have these already been linked during some path?
+set ancestors [km_get_object_ancestors $object_id]
+set result 1
+if { $parent_object_id && ![elem_p $parent_object_id [fst [transpose $ancestors]]] } {
+ # Create a parent_child_link
+ set result [km_link_objects -link_type parent_child $last_question_id $user_id $parent_object_id $object_id "" f]
+}
+if { $uncle_object_id && ![elem_p $uncle_object_id [fst [transpose $ancestors]]] } {
+ # Create a uncle_nephew_link
+ set result [km_link_objects -link_type uncle_nephew $last_question_id $user_id $uncle_object_id $object_id "" f]
+}
+if {!$result} {
+ ad_return_complaint 1 "This object couldnt be linked because it is already a child or a nephew of a knowledge object."
+ return
+}
+
+# Figure out where to go from here.
+if { [string compare $action "delete"] == 0 } {
+ km_delete_object_data $object_id $delete_question_id
+ if { [string equal $action "details"]} {
+ set destination "questions?[export_url_vars object_id category_id]"
+ } else {
+ ## action = "finish"
+ set destination "object-view?[export_url_vars object_id category_id]"
+ }
+
+} elseif { ![string equal $action "finish"] && ![string equal $action "details"]} {
+ # Some excursion is starting here.
+ set path_vars [set_path_values -question_id $question_id $object_id $category_id]
+ if [empty_string_p $path_id] {
+ set parameters [export_url_vars object_id category_id mandatory_p]
+ } else {
+ set parameters [export_url_vars object_id category_id path_id mandatory_p]
+ }
+
+ if { $action == "add_user_ref" } {
+ set return_url "object-edit?$parameters&foo=bar#user_link"
+ } elseif { $action == "add_content_ref" } {
+ set return_url "object-edit?$parameters&foo=bar#content_link$question_id"
+ } elseif { $parent_object_id } {
+ set return_url "object-edit?$parameters&parent_object_id=$parent_object_id&question_id=$last_question_id"
+ } elseif { $uncle_object_id } {
+ set return_url "object-edit?$parameters&uncle_object_id=$uncle_object_id&question_id=$last_question_id"
+ } else {
+ set return_url "object-edit?$parameters"
+ }
+ set path_id [init_path -last_path_id $path_id $path_vars $return_url $action]
+
+ # Figure out where it is they want to go and redirect them.
+ switch $action {
+ "add_web_ref" { set destination "add-web-ref?[export_url_vars path_id]" }
+ "add_sn_ref" {
+ set path_vars [list question_id $question_id object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url add_sn_ref]
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set community_id $node(package_id)
+ set destination "linking/?community_id=$community_id&source_id=$object_id&pass=$path_id"
+ }
+ "add_child" {
+ set parent_object_id $object_id
+ set destination "object-edit?[export_url_vars path_id question_id parent_object_id category_id]"
+ }
+ "add_nephew" {
+ set uncle_object_id $object_id
+ set destination "object-edit?[export_url_vars path_id question_id uncle_object_id category_id]"
+ }
+ "copy_child" {
+ set parent_id $object_id
+ set destination "object-copy?[export_url_vars path_id question_id parent_id category_id]"
+ }
+ "copy_nephew" {
+ set parent_id $object_id
+ set destination "object-copy?[export_url_vars path_id question_id parent_id category_id]"
+ }
+ "add_user_ref" {
+ set target "user-link-add"
+ set passthrough {path_id}
+ set keyword [set user_link.$question_id]
+ set context_bar [list $return_url "Edit"]
+ set destination "user-search?[export_url_vars keyword target passthrough path_id context_bar object_id category_id]"
+ }
+ "add_content_ref" {
+ set target "content-link-add"
+ set query_string [set content_query:$question_id]
+ set table_name [set content_table:$question_id]
+ set destination "/shared/sw-search-2?[export_url_vars query_string table_name target path_id]"
+ }
+ default {
+ if { [string equal $action "details"]} {
+ set destination "questions?[export_url_vars object_id category_id]"
+ } else {
+ ## action == "finish"
+ set destination "object-view?[export_url_vars object_id category_id]"
+ }
+ }
+ }
+} elseif ![empty_string_p $path_id] {
+ # We already are on an excursion, and the user has just created a new object. So instead of returning to
+ # questions.tcl, let's take a look at the path's action.
+ set values [get_path_values -action_only_p 0 $path_id]
+ set action [value_from_tuples $values action]
+ switch $action {
+ "add_sn_ref" {
+ set destination "add-sharenet-ref?[export_url_vars object_id path_id]"
+ }
+ "link" {
+ set destination "link-reason-add?[export_url_vars object_id path_id]"
+ }
+ "add_child" -
+ "add_nephew"
+ {
+ set destination [get_path_return_url $path_id]
+ }
+ default {
+ if { [string equal $action "details"]} {
+ set destination "questions?[export_url_vars object_id category_id]"
+ } else {
+ ## action == "finish"
+ set destination "object-view?[export_url_vars object_id category_id]"
+ }
+ }
+ }
+} elseif { $parent_object_id && $question_id } {
+ set destination "one-question-edit?object_id=$parent_object_id&question_id=$question_id&category_id=$category_id"
+} elseif { $uncle_object_id && $question_id } {
+ set destination "one-question-edit?object_id=$uncle_object_id&question_id=$question_id&category_id=$category_id"
+} else {
+ if { [string equal $action "details"]} {
+ set destination "questions?[export_url_vars object_id category_id]"
+ } else {
+ ## action == "finish"
+ set destination "object-view?[export_url_vars object_id category_id]"
+ }
+}
+
+ad_returnredirect $destination
Index: openacs-4/contrib/obsolete-packages/library/www/object-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-edit.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-edit.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,21 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width;noquote@</property>
+<property name="header_stuff"><link rel="stylesheet" href="form.css"></property>
+
+<form @enctype@ method=post action="object-edit-2">
+<csrf-token>
+<if @ancestor_object_id@ ne 0>
+ @ancestor_object_type@: @ancestor_name@<br>
+</if>
+@form_vars;noquote@
+@gc_checksum_export;noquote@
+
+<include src="km-form" object_id="@object_id@" category_id="@category_id@" show_values_p="@show_values_p@" mandatory_p="@mandatory_p@" object_type_id="@object_type_id@" ancestor_id="@ancestor_object_id@">
+
+
+<center><input type=submit name=finish value=finish></center>
+<center><input type=submit name=details value="Answer more details"></center>
+</form>
+
Index: openacs-4/contrib/obsolete-packages/library/www/object-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-edit.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-edit.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,144 @@
+ad_page_contract {
+ /packages/library/www/object-add.tcl
+
+ Create the form for adding an object.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: object-edit.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ { object_type_id:integer 0 }
+ { object_id:integer 0 }
+ { category_id "" }
+ { parent_object_id:integer 0 }
+ { uncle_object_id:integer 0 }
+ { path_id:integer "" }
+ { link_new_p:boolean 0 }
+ { mandatory_p:boolean 0 }
+ { question_id:integer 0 }
+ { short_name "" }
+} -properties {
+ title:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ form_vars:onevalue
+ enctype:onevalue
+ gc_checksum_export:onevalue
+ ancestor_name:onevalue
+ ancestor_object_type:onevalue
+ ancestor_object_id:onevalue
+ object_id:onevalue
+ object_type_id:onevalue
+ show_values_p:onevalue
+ mandatory_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set edit_p 0
+set show_values_p 0
+
+if { $object_id } {
+
+ # Retrieve the infos for an existing object and display data in
+ # the form.
+
+ if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+ set object_name [km_conn object_name]
+ set object_type_id [km_conn object_type_id]
+ set show_values_p 1
+ set edit_p 1
+
+} elseif {$object_type_id || ![empty_string_p $short_name]} {
+
+ if {![empty_string_p $short_name]} {
+ set context_id [ad_conn package_id]
+ set object_type_id [db_string object_type_id {
+ select min(object_type_id)
+ from sn_object_types
+ where short_name = :short_name and context_id = :context_id
+ } -default "0"]
+ }
+ if ![km_check_object_type_id -check_view_p 0 -check_create_p 1 $object_type_id] {
+ return
+ }
+
+ # This page is for a brand-new knowledge object, so there's no data.
+ set object_id [km_new_acs_object_id]
+
+} elseif { $question_id } {
+
+ # This page has been called up for the creation of a child object
+ set object_type_id [km_static question_target_object_type_id $question_id]
+
+ # Set the new object_id here directly on the form
+ set object_id [km_new_acs_object_id]
+
+} else {
+ set return_url [ad_conn url]?[ad_conn query]
+ set path_vars [list question_id $question_id object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url add_content_ref]
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set community_id $node(package_id)
+ ad_returnredirect "linking/?community_id=$community_id&source_id=$object_id&pass=$path_id"
+ return
+}
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_plural [km_static object_type_pretty_plural $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+if { $edit_p } {
+ set action "Edit"
+ set title "Edit $object_name"
+} else {
+ set action "Create $pretty_type"
+ set title $action
+}
+
+# Since this object may not yet exist, it might not have ancestors but
+# it *might* already have a parent associated with it.
+
+set ancestor_object_id 0
+if { $parent_object_id > 0 || $uncle_object_id > 0 } {
+
+ if { $parent_object_id } {
+ set ancestor_object_id $parent_object_id
+ } else {
+ set ancestor_object_id $uncle_object_id
+ }
+ if ![km_check_object_id $ancestor_object_id] { return }
+ set ancestor_object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+ set ancestor_name [km_conn object_name]
+ set_the_usual_klib_context_bar $ancestor_object_id $category_id
+
+ if { $edit_p } {
+ append_context_bar_data [list "object-view?object_id=$object_id&category_id=$category_id" $object_name] $action
+ } else {
+ append_context_bar_data $action
+ }
+} elseif { $edit_p } {
+ set_the_usual_klib_context_bar $object_id $category_id
+ append_context_bar_data $action
+} else {
+ set_context_bar_data [list "browse-one-type?[export_url_vars object_type_id]" $pretty_plural] $action
+}
+
+
+if ![km_check_object_type_id -check_view_p 0 -check_create_p 1 $object_type_id] {
+ return
+}
+
+if [km_type_has_data_type_p $object_type_id "file"] {
+ set enctype "enctype=multipart/form-data"
+} else {
+ set enctype ""
+}
+
+set form_vars [export_form_vars object_id category_id path_id object_type_id parent_object_id uncle_object_id question_id mandatory_p]
+set graphic_width [library_icon_width]
+
+set gc_checksum [doubleclick::generate_checksum $object_id]
+set gc_checksum_export [export_form_vars gc_checksum]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-indexed.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-indexed.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-indexed.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,19 @@
+ad_page_contract {
+ /www/library/object-indexed.tcl
+
+ Show intemedia index contents for given object instance
+
+ created by akananov@arsdigita.com 18.10.2000
+
+ @cvs-id $Id: object-indexed.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+}
+
+if ![km_check_object_id $object_id] { return }
+if {![km_conn admin_p]} { return }
+
+ns_return 200 text/plain [db_string get_indexed_content {
+ select site_wide_search.indexed_content(:object_id)
+ from dual
+}]
Index: openacs-4/contrib/obsolete-packages/library/www/object-link-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-link-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-link-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,29 @@
+ad_page_contract {
+ object-link-2.tcl
+
+ Create a new link between two objects.
+
+ $Id: object-link-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ link_comment
+ path_id:notnull
+ {html_p:notnull,oneof(1|0)}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# Determine to which object we are going to add the link,
+# and if the current user is allowed to do this.
+
+set path_values [get_path_values -action_only_p 0 $path_id]
+set original_object_id [value_from_tuples $path_values object_id]
+set question_id [value_from_tuples $path_values question_id]
+
+if ![km_check_object_id -check_edit_p 1 $original_object_id] { return }
+
+set html_p [ad_decode $html_p 1 t f]
+km_link_objects $question_id $user_id $original_object_id $object_id $link_comment $html_p
+
+ad_returnredirect [get_path_return_url $path_id]
Index: openacs-4/contrib/obsolete-packages/library/www/object-link.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-link.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-link.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,44 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+<form method=post action="one-question-edit-2">
+<csrf-token>
+@form_vars;noquote@
+<table width=100% cellpadding=0 cellspacing=0 border=0 height=80%>
+<tr valign=top><td align=left>
+
+<include src="km-form" show_values_p="1" path_id="@new_path_id@" user_id="@user_id@" edit_p="1" question_ids="@question_list@" object_id="@object_id@" category_id="@category_id@" object_type_id="@object_type_id@">
+
+</td></tr>
+<tr valign=bottom><td>
+ <table width=100% height=100%>
+ <tr><td align=center><strong>Save and proceed to:</strong>
+
+ <tr><td align=center>
+
+<if @button_1@ ne "">
+ <input type="submit" name="@button_1@" value=" << ">
+</if>
+
+<if @button_2@ ne "">
+ <input type="submit" name="@button_2@" value="All Questions">
+</if>
+
+<if @button_3@ ne "">
+ <input type="submit" name="@button_3@" value="Unanswered Questions">
+</if>
+
+<if @button_4@ ne "">
+ <input type="submit" name="@button_4@" value="Completed Content">
+</if>
+
+<if @button_5@ ne "">
+ <input type="submit" name="@button_5@" value=" >> ">
+</if>
+
+ </table>
+</td></tr>
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-link.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-link.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-link.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,63 @@
+# /www/library/object-link.tcl
+#
+# Show existing links for an object and allow the user to add new
+# links.
+#
+# $Id: object-link.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+
+ad_page_variables {
+ object_id
+ question_id
+ {category_id ""}
+ {path_id ""}
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id $object_id] { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+set path_vars [set_path_values -question_id $question_id $object_id $category_id]
+set return_url "object-link?[export_url_vars object_id category_id question_id path_id]"
+set new_path_id [init_path -last_path_id $path_id $path_vars $return_url link]
+
+set question_list [list $question_id]
+
+set question_info [km_get_question $question_id $object_type_id]
+set question_state [lindex $question_info 3]
+
+if {$question_state != "active" } {
+ # If there are no links and the question is not active,
+ # there's no point in being here.
+ ad_returnredirect "questions?[export_url_vars object_id category_id]"
+ return
+}
+
+# Check if the question still exists and inform the user about the
+# current state.
+if [null_p $question_info] {
+ ad_return_warning "Question does not exist." "
+ The question with id $question_id is not accessible, probably
+ because it has been made invisible."
+ return
+}
+
+set title "$pretty_type_plural: Add a link to $object_name"
+set graphic_width [library_icon_width]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Add a link"
+set form_vars [export_form_vars question_id object_id category_id object_type_id path_id]
+set buttons [km8_button_panel $question_id $object_id $object_type_id]
+set button_1 [lindex $buttons 0]
+set button_2 [lindex $buttons 1]
+set button_3 [lindex $buttons 2]
+set button_4 [lindex $buttons 3]
+set button_5 [lindex $buttons 4]
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/object-propose-public-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-propose-public-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-propose-public-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,160 @@
+ad_page_contract {
+ /packages/library/www/object-propose-public-2.tcl
+
+ Submit object for approval.
+
+ @cvs-id $Id: object-propose-public-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {button_name "Confirm"}
+ {return_url ""}
+ {nephew_list:multiple,optional ""}
+}
+csrf::authenticate
+
+if {[empty_string_p $return_url]} {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+}
+
+if {[doubleclick::check_all $nephew_list]} {
+ ns_sleep 2
+ ad_returnredirect $return_url
+ return
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id $object_id] { return }
+
+set author_id [km_conn original_author_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set approval_p [km_static approval_p $package_id]
+set creation_ip [ad_conn peeraddr]
+# the sweeper will make sure that descendants will have the same publisher
+# than the ancestors
+set publisher_id [km_conn publisher_id]
+
+if { !$approval_p || $publish_p || $admin_p } {
+ ad_returnredirect "object-publish?[export_url_vars object_id category_id return_url]"
+ return
+}
+
+if { [km_conn public_p] } {
+ ad_return_complaint 1 "This [km_static object_type_pretty_name [km_conn object_type_id]] is already public."
+ return
+}
+
+if { $button_name == "Cancel" } {
+ ad_returnredirect $return_url
+ return
+}
+
+if { ![km_conn delete_p] } {
+ ad_return_complaint 1 "Only owners can propose an object for publication."
+ return
+}
+
+set uncle_p [km_is_mandatory_uncle_p $object_id]
+set child_p [km_is_child_p $object_id]
+set private_nephew_p [km_is_nephew_with_private_uncle_p $object_id]
+
+if {$child_p} {
+ ad_return_complaint 1 "Not allowed to publish descendent objects separately."
+ return
+}
+
+if {$private_nephew_p} {
+ ad_return_complaint 1 "Not allowed to publish descendent object without public main object"
+ return
+}
+
+if {$uncle_p && ([empty_string_p $nephew_list] || ![km_valid_nephew_publish_list_p $object_id $nephew_list])} {
+ ad_return_complaint 1 "You have to select at least one linked object of each question for publishing!"
+ return
+}
+
+if {[empty_string_p $nephew_list]} {
+ set descendents [concat $object_id [map fst [km_get_descendents $object_id]]]
+} else {
+ set descendents [concat $object_id $nephew_list [km_get_objects_descendents $nephew_list] [km_get_child_descendents $object_id]]
+}
+
+set complete_p [km_object_complete_p $object_id]
+
+if {!$complete_p} {
+ ad_return_warning "Required Data Missing" \
+ "<p>At least one mandatory question has not been answered. Please
+ <a href=\"object-edit?[export_url_vars object_id]&mandatory_p=1\">edit</a>
+ the object and add any missing data."
+ return
+}
+
+# have to compose workflow comment if nephew_list supplied
+if ![empty_string_p $nephew_list] {
+ set msg_list [list]
+ set last_nephew_type_id ""
+
+ db_foreach get_nephew_data "
+ select object_id as nephew_id, one_line_description as nephew_name,
+ object_type_id as nephew_type_id
+ from sn_objects
+ where object_id in ([join $nephew_list ,])
+ order by object_type_id, one_line_description
+ " {
+ if [empty_string_p $nephew_name] {
+ set nephew_name "Unnamed [km_static object_type_pretty_name $nephew_type_id]"
+ }
+ if {$last_nephew_type_id != $nephew_type_id} {
+ lappend msg_list "[km_static object_type_pretty_plural $nephew_type_id]: $nephew_name"
+ set last_nephew_type_id $nephew_type_id
+ } else {
+ lappend msg_list $nephew_name
+ }
+ }
+ set msg "The following linked objects should be made public as well: [join $msg_list ,]"
+}
+
+db_transaction {
+ # mark objects as in_review_p
+ db_dml mark_objects_in_review_p "
+ update sn_objects
+ set in_review_p = 't'
+ where object_id in ([join $descendents ,])
+ "
+
+ # Actually submit objects for publication.
+ set case_id [db_exec_plsql object_queue_for_review {
+ begin
+ :1 := library_workflow.new_workflow_case (
+ p_object_id => :object_id,
+ p_creation_user => :user_id,
+ p_creation_ip => :creation_ip,
+ p_publisher_id => :publisher_id
+ );
+ end;
+ }]
+
+ # add workflow comment for selected nephews
+ if ![empty_string_p $nephew_list] {
+ db_exec_plsql add_workflow_comment {
+ begin
+ :1 := journal_entry.new(
+ object_id => :case_id,
+ action => 'case start',
+ action_pretty => 'Case started',
+ creation_user => :user_id,
+ creation_ip => :creation_ip,
+ msg => :msg
+ );
+ end;
+ }
+ }
+}
+
+ad_returnredirect $return_url
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/object-propose-public.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-propose-public.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-propose-public.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,47 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<if @error@ eq 0>
+ <form method="post" action="object-propose-public-2">
+ <csrf-token>
+ @form_vars;noquote@
+ @dc_export;noquote@
+
+ <if @nephews:rowcount@ ne 0>
+ <h3>Please select the knowledge objects that should be proposed for publication (at least one per question)</h3>
+ <multiple name=nephews>
+ <h4><a href="one-question-edit?object_id=@object_id@&category_id=@category_id@&question_id=@nephews.question_id@">@nephews.question_name@</a> (@nephews.object_type@)</h4>
+ <ul>
+ <group column=question_id>
+ <li><input type=checkbox name=nephew_list value=@nephews.object_id@><a href="object-view?object_id=@nephews.object_id@&category_id=@category_id@">@nephews.object_name@</a></li>
+ </group>
+ </ul>
+ </multiple>
+ </if>
+
+ This object will be proposed for publication. Do you wish to continue?
+
+ <p><center><input type="submit" name="button_name" value="Confirm">
+ <input type=submit name="button_name" value="Cancel"></center>
+ </form>
+</if><else>
+
+ <if @data_missing_questions:rowcount@ eq 0>
+ <if @error@ gt 0>
+ <p>At least one mandatory question has not been answered. Please
+ <a href="object-edit?object_id=@object_id@&category_id=@category_id@&mandatory_p=1">edit</a> the
+ object and add any missing data.</p>
+ </if><else>
+ <p>Sorry. @title@.</p>
+ </else>
+ </if><else>
+ <p>At least one mandatory question has not been answered for each linked
+ knowledge object of the following questions:
+ <p><ul>
+ <multiple name=data_missing_questions>
+ <li><a href="one-question-edit?object_id=@object_id@&category_id=@category_id@&question_id=@data_missing_questions.question_id@">@data_missing_questions.question_name@</a></li>
+ </multiple>
+ </ul>
+ </else>
+
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/object-propose-public.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-propose-public.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-propose-public.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,129 @@
+ad_page_contract {
+ /packages/library/www/object-propose-public.tcl
+
+ Submit object for approval.
+
+ @cvs-id $Id: object-propose-public.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ object_id:onevalue
+ object_type:onevalue
+ object_type_plural:onevalue
+ ancestor_object_type:onevalue
+ ancestor_object_type_plural:onevalue
+ author_id:onevalue
+ author_name:onevalue
+ complete_p:onevalue
+ nephews:multirow
+ nephews_p:onevalue
+ nephew_p:onevalue
+ data_missing_questions:multirow
+ error:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id $object_id] { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_type_plural [km_static object_type_pretty_plural $object_type_id]
+set author_id [km_conn original_author_id]
+set author_name [km_conn original_author_name]
+set complete_p [km_object_complete_p $object_id]
+set nephews_p [km_object_nephews_p $object_id]
+set uncle_p [km_is_mandatory_uncle_p $object_id]
+set child_p [km_is_child_p $object_id]
+set private_nephew_p [km_is_nephew_with_private_uncle_p $object_id]
+set nephew_p [km_is_nephew_p $object_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set package_id [ad_conn package_id]
+set approval_p [km_static approval_p $package_id]
+
+if { !$approval_p || $publish_p || $admin_p } {
+ ad_returnredirect "object-publish?[export_url_vars object_id category_id return_url]"
+ return
+}
+
+if { [km_conn public_p] } {
+ ad_return_complaint 1 "This $object_type is already public."
+ return
+}
+
+if { [km_conn in_review_p] } {
+ ad_return_complaint 1 "This $object_type has already been submitted for approval."
+ return
+}
+
+if { ![km_conn delete_p] } {
+ ad_return_complaint 1 "Only owner can propose an object for publication."
+ return
+}
+
+set form_vars [export_form_vars object_id category_id return_url]
+
+set error 0
+template::multirow create nephews object_id object_name in_review_p question_id question_name object_type object_type_plural
+template::multirow create data_missing_questions question_id question_name
+
+set ancestor_object_type ""
+set ancestor_object_type_plural ""
+
+if {$child_p} {
+ set parent_object_type_id [thd [km_get_parent $object_id]]
+ set ancestor_object_type [km_static object_type_pretty_name $parent_object_type_id]
+ set ancestor_object_type_plural [km_static object_type_pretty_plural $parent_object_type_id]
+ set title "It is not possible to propose $object_type_plural for publication separately from the linked $ancestor_object_type"
+ set error -1
+} elseif {$private_nephew_p} {
+ set uncle_object_type_id [thd [km_get_uncle $object_id]]
+ set ancestor_object_type [km_static object_type_pretty_name $uncle_object_type_id]
+ set ancestor_object_type_plural [km_static object_type_pretty_plural $uncle_object_type_id]
+ set title "Not allowed to propose $object_type_plural for publication without linked public $ancestor_object_type"
+ set error -2
+} elseif {$complete_p && $uncle_p && $nephews_p} {
+ set nephew_question_list [km_uncle_nephew_questions $object_id]
+ foreach nephew_question $nephew_question_list {
+ set nephew_list [km_publishable_nephews $object_id [fst $nephew_question]]
+ if {[llength $nephew_list] == 0} {
+ set error 1
+ lappend error_questions $nephew_question
+ } else {
+ set target_object_type_id [km_static question_target_object_type_id [fst $nephew_question]]
+ set target_pretty_name [km_static object_type_pretty_name $target_object_type_id]
+ set target_pretty_plural [km_static object_type_pretty_plural $target_object_type_id]
+ foreach nephew $nephew_list {
+ eval template::multirow append nephews $nephew $nephew_question $target_pretty_name $target_pretty_plural]
+ }
+ }
+ }
+ if {!$error} {
+ set title "Select Linked Objects for Proposing for Publication"
+ } else {
+ set title "Required Data Missing in Linked Objects"
+ foreach nephew_question $error_questions {
+ eval template::multirow append data_missing_questions $nephew_question
+ }
+ }
+} elseif {$complete_p} {
+ set title "Confirm Proposing Object Publication"
+} else {
+ set title "Required Data Missing"
+ set error 2
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Propose for publication"
+
+# Double click.
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-publish-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-publish-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-publish-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,197 @@
+ad_page_contract {
+ /www/library/object-publish-2.tcl
+
+ Publish the object.
+
+ @cvs-id $Id: object-publish-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ cancel:optional
+ confirm:optional
+ release_date:array,optional
+ {return_url ""}
+ {nephew_list:multiple,optional ""}
+ task_id:optional
+ msg:optional
+}
+csrf::authenticate
+
+if {[empty_string_p $return_url]} {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+}
+
+if {[doubleclick::check_all $nephew_list]} {
+ ns_sleep 2
+ ad_returnredirect $return_url
+ return
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id $object_id] { return }
+
+set author_id [km_conn original_author_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set approval_p [km_static approval_p $package_id]
+set in_review_p [km_conn in_review_p]
+
+if { !$admin_p && (!$write_p || $archived_p) } { return }
+
+if { [km_conn public_p] } {
+ ad_return_complaint 1 "This [km_static object_type_pretty_name [km_conn object_type_id]] is already public."
+ return
+}
+
+if { $approval_p && !$publish_p && !$admin_p } {
+ ad_returnredirect "object-propose-public?[export_url_vars object_id category_id return_url]"
+ return
+}
+
+if {[info exists cancel]} {
+ ad_returnredirect $return_url
+ return
+}
+
+set uncle_p [km_is_mandatory_uncle_p $object_id]
+set child_p [km_is_child_p $object_id]
+set private_nephew_p [km_is_nephew_with_private_uncle_p $object_id]
+
+if {$child_p} {
+ ad_return_complaint 1 "Not allowed to publish descendent objects separately."
+ return
+}
+
+if {$private_nephew_p} {
+ ad_return_complaint 1 "Not allowed to publish descendent object without public main object"
+ return
+}
+
+if {$uncle_p && ([empty_string_p $nephew_list] || ![km_valid_nephew_publish_list_p $object_id $nephew_list])} {
+ ad_return_complaint 1 "You have to select at least one linked object of each question for publishing!"
+ return
+}
+
+if {[empty_string_p $nephew_list]} {
+ set descendents [concat $object_id [map fst [km_get_descendents $object_id]]]
+} else {
+ set descendents [concat $object_id $nephew_list [km_get_objects_descendents $nephew_list] [km_get_child_descendents $object_id]]
+}
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set write_p [km_conn write_p]
+set original_author_id [km_conn original_author_id]
+set complete_p [km_object_complete_p $object_id]
+
+if { [info exists release_date] } {
+ set release_date_sql "$release_date(year)-$release_date(month)-$release_date(day)"
+ if { $release_date_sql == "--" || ![date_p $release_date_sql] } {
+ set release_date_sql "sysdate"
+ } else {
+ set release_date_sql "'$release_date_sql'"
+ }
+} else {
+ set release_date_sql "sysdate"
+}
+
+if {!$complete_p} {
+ ad_return_warning "Required Data Missing" \
+ "<p>At least one mandatory question has not been answered. Please
+ <a href=\"object-edit?[export_url_vars object_id]&mandatory_p=1\">edit</a>
+ the object and add any missing data."
+ return
+}
+
+db_transaction {
+
+ # Check if a user already got shares for this entry (by making
+ # it public). If not, give him the shares. This is ignoring
+ # the issue of different banks, but that's OK because we just
+ # want to know if he was rewarded for publishing the object,
+ # not where and how the reward took place.
+ set awardedp [db_string object_awarded_shares {
+ select count(*) from ir_share_transactions
+ where cc_name = 'kl_object_publish' and object_id = :object_id
+ }]
+
+ if {!$awardedp && ![km_is_nephew_p $object_id]} {
+ foreach bank_id [incentives::bank_list -user_id $original_author_id $package_id] {
+ set amount [incentives::charge_value -key $object_type_id \
+ kl_object_publish $bank_id]
+ incentives::award_shares -user_id $original_author_id \
+ kl_object_publish $amount $bank_id $object_id
+ }
+ }
+
+ # Actually publish the object.
+ km_object_publish $descendents
+
+ # Generate alerts.
+ set published_objects_list [db_list_of_lists get_published_objects "
+ select object_id, object_type_id
+ from sn_objects
+ where public_p = 't'
+ and object_id in ([join $descendents ,])
+ "]
+
+ foreach published_object $published_objects_list {
+ util_unlist $published_object published_object_id published_object_type_id
+
+ alerts::generate_alert -package_id $package_id -content_type_id $published_object_type_id -action insert -link_only $published_object_id
+ }
+
+ ## but what if the task is at a clarify state? can we close it then
+ ## with this code?
+ if ![info exists task_id] {
+ db_0or1row get_workflow_case {
+ select case_id
+ from wf_cases
+ where object_id = :object_id
+ and state = 'active'
+ and rownum = 1
+ order by case_id desc
+ }
+ if [info exists case_id] {
+ db_dml delete_task_assignments {
+ delete from wf_task_assignments
+ where task_id in (select task_id from wf_tasks where case_id = :case_id)
+ }
+ db_dml finish_tasks {
+ update wf_tasks
+ set state = 'finished'
+ where case_id = :case_id
+ }
+ db_dml delete_tokens {
+ delete from wf_tokens
+ where case_id = :case_id
+ }
+ db_1row get_task_id {
+ select wf_task_id_seq.nextval as task_id from dual
+ }
+ db_dml insert_transition_key {
+ insert into wf_tasks
+ (task_id, case_id, workflow_key, transition_key, state, started_date, holding_user)
+ values (:task_id, :case_id, 'library_approval_wf', 'library_review', 'started', sysdate, :user_id)
+ }
+ set msg "Object Published"
+ }
+ }
+
+ if [info exists task_id] {
+ # update publisher_id
+ db_dml update_publisher_id "
+ update sn_objects
+ set publisher_id = :user_id
+ where object_id in ([join $descendents ,])
+ "
+
+ #finish workflow task
+ set journal_id [wf_task_action -user_id $user_id -msg $msg -attributes [list library_object_needs_clarification f] $task_id finish]
+ }
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/object-publish.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-publish.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-publish.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,66 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<if @error@ eq 0>
+ <form method="post" action="object-publish-2">
+ <csrf-token>
+ @form_vars;noquote@
+ @dc_export;noquote@
+
+ <if @nephews:rowcount@ ne 0>
+ <h3>Please select the knowledge objects that should be made public (at least one per question)</h3>
+ <multiple name=nephews>
+ <h4><a href="one-question-edit?object_id=@object_id@&category_id=@category_id@&question_id=@nephews.question_id@">@nephews.question_name@</a> (@nephews.object_type@)</h4>
+ <ul>
+ <group column=question_id>
+ <li><input type=checkbox name=nephew_list value=@nephews.object_id@<if @in_review_p@ eq 1 and @admin_p@ eq 0> checked</if>><a href="object-view?object_id=@nephews.object_id@&category_id=@category_id@">@nephews.object_name@</a></li>
+ </group>
+ </ul>
+ </multiple>
+ </if>
+
+ <if @nephew_p@ eq 0>
+ <if @awarded_p@ eq 0 and @shares:rowcount@ gt 0>
+ When this object is now made public, the current owner
+ <a href="../users/yp?user_id=@author_id@">@author_name@</a> will receive the following shares:
+ <if @author_id@ eq @user_id@ or @admin_p@ eq 1>
+ <ul><multiple name=shares>
+ <li><a href="/incentives/user/shares?bank_id=@shares.bank_id@">@shares.bank_name@</a>: @shares.amount@ @shares.currency@ (New balance: @shares.balance@ @shares.currency@)</li>
+ </multiple></ul>
+ </if><else>
+ <ul><multiple name=shares>
+ <li>@shares.bank_name@: @shares.amount@ @shares.currency@</li>
+ </multiple></ul>
+ </else>
+ </if><else>
+ This object will be made public.
+ </else>
+ Do you wish to continue?
+ </if><else>
+ This object will be made public. Do you wish to continue?
+ </else>
+
+ <p><center><input type="submit" name="confirm" value="Confirm">
+ <input type=submit name="cancel" value="Cancel"></center>
+ </form>
+</if><else>
+
+ <if @data_missing_questions:rowcount@ eq 0>
+ <if @error@ gt 0>
+ <p>At least one mandatory question has not been answered. Please
+ <a href="object-edit?object_id=@object_id@&category_id=@category_id@&mandatory_p=1">edit</a> the
+ object and add any missing data.</p>
+ </if><else>
+ <p>Sorry. @title@.</p>
+ </else>
+ </if><else>
+ <p>At least one mandatory question has not been answered for each linked
+ knowledge object of the following questions:
+ <p><ul>
+ <multiple name=data_missing_questions>
+ <li><a href="one-question-edit?object_id=@object_id@&category_id=@category_id@&question_id=@data_missing_questions.question_id@">@data_missing_questions.question_name@</a></li>
+ </multiple>
+ </ul>
+ </else>
+
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/object-publish.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-publish.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-publish.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,163 @@
+ad_page_contract {
+ /packages/library/www/object-publish.tcl
+
+ Ask the user for confirmation before publishing an object.
+
+ @cvs-id $Id: object-publish.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+ task_id:optional
+ msg:optional
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ object_id:onevalue
+ object_type:onevalue
+ object_type_plural:onevalue
+ ancestor_object_type:onevalue
+ ancestor_object_type_plural:onevalue
+ author_id:onevalue
+ author_name:onevalue
+ complete_p:onevalue
+ nephews:multirow
+ nephews_p:onevalue
+ nephew_p:onevalue
+ data_missing_questions:multirow
+ error:onevalue
+ in_review_p:onevalue
+ awarded_p:onevalue
+ shares:multirow
+ user_id:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id $object_id] { return }
+
+set checkoff_date [db_string object_publish_10 "
+ select decode(user_checkoff_date,'9999-12-31',sysdate,user_checkoff_date)
+ from sn_objects where object_id=:object_id"]
+set release_year [string range $checkoff_date 0 3]
+set release_month [string range $checkoff_date 5 6]
+set release_day [string range $checkoff_date 8 9]
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_type_plural [km_static object_type_pretty_plural $object_type_id]
+set author_id [km_conn original_author_id]
+set author_name [km_conn original_author_name]
+set complete_p [km_object_complete_p $object_id]
+set nephews_p [km_object_nephews_p $object_id]
+set uncle_p [km_is_mandatory_uncle_p $object_id]
+set child_p [km_is_child_p $object_id]
+set private_nephew_p [km_is_nephew_with_private_uncle_p $object_id]
+set nephew_p [km_is_nephew_p $object_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set package_id [ad_conn package_id]
+set approval_p [km_static approval_p $package_id]
+set in_review_p [km_conn in_review_p]
+
+if { !$admin_p && (!$write_p || $archived_p) } { return }
+
+if { [km_conn public_p] } {
+ ad_return_complaint 1 "This $object_type is already public."
+ return
+}
+
+if { $approval_p && !$publish_p && !$admin_p } {
+ ad_returnredirect "object-propose-public?[export_url_vars object_id category_id return_url]"
+ return
+}
+
+set form_vars [export_form_vars object_id category_id return_url task_id msg]
+
+set error 0
+template::multirow create nephews object_id object_name in_review_p question_id question_name object_type object_type_plural
+template::multirow create data_missing_questions question_id question_name
+
+set ancestor_object_type ""
+set ancestor_object_type_plural ""
+
+if {$child_p} {
+ set parent_object_type_id [thd [km_get_parent $object_id]]
+ set ancestor_object_type [km_static object_type_pretty_name $parent_object_type_id]
+ set ancestor_object_type_plural [km_static object_type_pretty_plural $parent_object_type_id]
+ set title "It is not possible to publish $object_type_plural separately from the linked $ancestor_object_type"
+ set error -1
+} elseif {$private_nephew_p} {
+ set uncle_object_type_id [thd [km_get_uncle $object_id]]
+ set ancestor_object_type [km_static object_type_pretty_name $uncle_object_type_id]
+ set ancestor_object_type_plural [km_static object_type_pretty_plural $uncle_object_type_id]
+ set title "Not allowed to publish $object_type_plural without linked public $ancestor_object_type"
+ set error -2
+} elseif {$complete_p && $uncle_p && $nephews_p} {
+ set nephew_question_list [km_uncle_nephew_questions $object_id]
+ foreach nephew_question $nephew_question_list {
+ set nephew_list [km_publishable_nephews $object_id [fst $nephew_question]]
+ if {[llength $nephew_list] == 0} {
+ set error 1
+ lappend error_questions $nephew_question
+ } else {
+ set target_object_type_id [km_static question_target_object_type_id [fst $nephew_question]]
+ set target_pretty_name [km_static object_type_pretty_name $target_object_type_id]
+ set target_pretty_plural [km_static object_type_pretty_plural $target_object_type_id]
+ set count 0
+ foreach nephew $nephew_list {
+ if {!$in_review_p || $admin_p || [thd $nephew] == "t"} {
+ eval template::multirow append nephews $nephew $nephew_question $target_pretty_name $target_pretty_plural]
+ incr count
+ }
+ }
+ if {$count == 0} {
+ set error 1
+ lappend error_questions $nephew_question
+ }
+ }
+ }
+ if {!$error} {
+ set title "Select Linked Objects for Publishing"
+ } else {
+ set title "Required Data Missing in Linked Objects"
+ foreach nephew_question $error_questions {
+ eval template::multirow append data_missing_questions $nephew_question
+ }
+ }
+} elseif {$complete_p} {
+ set title "Confirm Object Publishing"
+} else {
+ set title "Required Data Missing"
+ set error 2
+}
+
+set awarded_p [db_string object_awarded_shares {
+ select count(*) from ir_share_transactions
+ where cc_name = 'kl_object_publish' and object_id = :object_id
+}]
+
+template::multirow create shares bank_id bank_name currency amount balance
+if {!$awarded_p && !$nephew_p} {
+ foreach bank_id [incentives::bank_list -user_id $author_id $package_id] {
+ set amount [incentives::charge_value -key $object_type_id kl_object_publish $bank_id]
+ if {$amount > 0} {
+ db_1row get_currency_name {
+ select pretty_name as bank_name, currency_name
+ from ir_banks
+ where bank_id = :bank_id
+ }
+ template::multirow append shares $bank_id $bank_name $currency_name $amount [expr $amount+[thd [incentives::account_balance -user_id $author_id $bank_id]]]
+ }
+ }
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Make public"
+
+# Double click.
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-unarchive-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-unarchive-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-unarchive-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,84 @@
+ad_page_contract {
+ /packages/library/www/object-unarchive-2.tcl
+
+ Actually remove object (and descendants) from the Archive. If nephew
+ is last archived public nephew, make uncle (and all descendants) private.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: object-unarchive-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+ cancel:optional
+ confirm:optional
+ copy:optional
+ {object_id_list:multiple,integer ""}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if [empty_string_p $return_url] {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+}
+
+if {[info exists cancel]} {
+ ad_returnredirect $return_url
+ return
+}
+
+if ![km_check_object_id $object_id] { return }
+
+if {![km_conn archived_p]} {
+ ad_returnredirect $return_url
+ return
+}
+
+if {![km_conn admin_p] && ![km_conn write_p]} { return }
+
+set object_type_id [km_conn object_type_id]
+
+if {[info exists copy]} {
+ if {![km_static object_type_copy_p $object_type_id] || ![km_static object_type_create_p $object_type_id]} {
+ ad_returnredirect $return_url
+ return
+ } else {
+ ad_returnredirect "object-copy-2?[export_vars -url {object_id category_id object_id_list:multiple return_url}]"
+ return
+ }
+}
+
+if [empty_string_p $object_id_list] {
+ set object_id_list [list]
+}
+
+set object_type_id [km_conn object_type_id]
+set nephew_p [km_is_mandatory_nephew_p $object_id]
+
+if {[km_archived_ancestor_p $object_id]} {
+ set ancestor [fst [reverse [km_get_object_ancestors $object_id]]]
+ set ancestor_id [fst $ancestor]
+ set ancestor_name [snd $ancestor]
+ set ancestor_type [km_static object_type_pretty_name [thd $ancestor]]
+ ad_return_complaint 1 "This $object_type '$object_name' can't be removed from the archive since the linked $ancestor_type <a href=\"object-view?object_id=$ancestor_id&category_id=$category_id\">$ancestor_name</a> needs to be removed from the archive first."
+ return
+}
+
+db_transaction {
+
+ km_object_unarchive $object_id $object_id_list
+
+ if {$nephew_p} {
+ set uncle [km_get_uncle $object_id]
+ set uncle_id [fst $uncle]
+ if { [km_uncle_needs_private_status_p $uncle_id] } {
+ km_object_unpublish $uncle_id
+ }
+ }
+
+}
+
+km_flush_category_count -object_type_id $object_type_id
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/object-unarchive.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-unarchive.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-unarchive.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,45 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<if @archived_ancestor_p@ ne 0>
+This @object_type@ <a href="object-view?object_id=@object_id@&category_id=@category_id@">@object_name@</a>
+can't be removed from the archive since the linked @ancestor_type@
+<a href="object-view?object_id=@ancestor_id@&category_id=@category_id@">@ancestor_name@</a>
+needs to be removed from the archive first.
+</if>
+<else>
+
+<form method="post" action="object-unarchive-2">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<if @nephew_p@ eq 1 and @public_p@ eq 1>
+ <p>The @uncle_object_type@ "<a href="object-view?object_id=@uncle_id@&category_id=@category_id@">@uncle_name@</a>"
+ and all the linked @descendent_object_types@ may need to be made private if this is the last public archived
+ @object_type@ of "<a href="object-view?object_id=@uncle_id@&category_id=@category_id@">@uncle_name@</a>".
+</if>
+<if @parent_p@ gt 0 or @uncle_p@ gt 0>
+ <if @descendants:rowcount@ gt 0>
+ <p>Please select the objects that should be removed from the archive together
+ with this @object_type@ '@object_name@':
+ <multiple name=descendants>
+ <p><b>@descendants.child_type_plural@:</b><p>
+ <group column=child_type_id>
+ <input type=checkbox name=object_id_list value=@descendants.child_id@> <a href="object-view?object_id=@descendants.child_id@&category_id=@category_id@">@descendants.child_name@</a><br>
+ </group>
+ </multiple>
+ </if>
+</if><else>
+ <p>Are you sure you want to remove the @object_type@ '@object_name@' from
+ the archive?
+</else>
+
+<p><center><input type="submit" name="confirm" value="Proceed">
+ <input type="submit" name="cancel" value="Cancel">
+<if @copy_p@ ne 0>
+ <input type="submit" name="copy" value="Copy"></center>
+</if>
+</form>
+
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/object-unarchive.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-unarchive.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-unarchive.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,107 @@
+ad_page_contract {
+ /packages/library/www/object-unarchive.tcl
+
+ Remove an object from the Archive.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: object-unarchive.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ dc_export:onevalue
+ uncle_id:onevalue
+ uncle_name:onevalue
+ uncle_p:onevalue
+ public_p:onevalue
+ nephew_p:onevalue
+ object_type:onevalue
+ uncle_object_type:onevalue
+ descendent_object_types:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id $object_id] { return }
+
+if {![km_conn archived_p]} {
+ ad_returnredirect $return_url
+ return
+}
+
+if {![km_conn admin_p] && ![km_conn write_p]} { return }
+
+set object_type_id [km_conn object_type_id]
+set object_type [km_static object_type_pretty_name $object_type_id]
+set object_name [km_conn object_name]
+set public_p [km_conn public_p]
+set nephew_p [km_is_mandatory_nephew_p $object_id]
+set uncle_p [km_is_uncle_p $object_id]
+set parent_p [km_is_parent_p $object_id]
+set copy_p [km_static object_type_copy_p $object_type_id]
+set create_p [km_static object_type_create_p $object_type_id]
+set uncle_object_type ""
+set descendent_object_types ""
+set archived_ancestor_p [km_archived_ancestor_p $object_id]
+
+if {$copy_p} {
+ set copy_p $create_p
+}
+
+if {$archived_ancestor_p} {
+ set ancestor [fst [reverse [km_get_object_ancestors $object_id]]]
+ set ancestor_id [fst $ancestor]
+ set ancestor_name [snd $ancestor]
+ set ancestor_type [km_static object_type_pretty_name [thd $ancestor]]
+}
+
+if {$nephew_p && $public_p} {
+ set uncle [km_get_uncle $object_id]
+ set uncle_id [fst $uncle]
+ set uncle_name [snd $uncle]
+ set uncle_object_type [km_static object_type_pretty_name [thd $uncle]]
+ db_foreach get_descendent_object_type_list {
+ select q.target_object_type_id as descendent_object_type_id
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :uncle_id
+ and o.context_id=:package_id
+ and q.abstract_data_type in ('nephew_object','child_object')
+ } {
+ lappend object_type_list [km_static object_type_pretty_plural $descendent_object_type_id]
+ }
+ set descendent_object_types [join $object_type_list " and "]
+}
+
+if {$uncle_p || $parent_p} {
+ template::multirow create descendants child_id child_name child_type_id child_type_plural
+ db_foreach get_object_descendants {
+ select obj.object_id as child_id, obj.one_line_description as child_name,
+ obj.object_type_id as child_type_id
+ from sn_objects obj, km_flat_object_hierarchy fo
+ where fo.parent = :object_id
+ and fo.distance = 1
+ and obj.object_id = fo.child
+ and obj.archived_p = 't'
+ and obj.expiration_date > sysdate
+ order by obj.object_type_id, obj.one_line_description
+ } {
+ if [empty_string_p $child_name] {
+ set child_name "Unnamed [km_static object_type_pretty_name $child_type_id]"
+ }
+ template::multirow append descendants $child_id $child_name $child_type_id [km_static object_type_pretty_plural $child_type_id]
+ }
+}
+
+set title "Remove $object_type '$object_name' from Archive"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Remove from Archive"
+set form_vars [export_form_vars object_id category_id return_url]
+set dc_export [doubleclick::signature_html]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-unpublish-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-unpublish-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-unpublish-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,68 @@
+ad_page_contract {
+ /packages/library/www/object-unpublish-2.tcl
+
+ Mark a nephew or uncle object as private.
+
+ @cvs-id $Id: object-unpublish-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+ cancel:optional
+ confirm:optional
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if [empty_string_p $return_url] {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+}
+
+if {[info exists cancel]} {
+ ad_returnredirect $return_url
+ return
+}
+
+if ![km_check_object_id $object_id] { return }
+
+if {![km_conn public_p]} {
+ ad_returnredirect $return_url
+}
+
+set author_id [km_conn original_author_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set approval_p [km_static approval_p $package_id]
+
+if { !$admin_p && (!$write_p || $archived_p || ($approval_p && !$publish_p)) } { return }
+
+set nephew_p [km_is_mandatory_nephew_p $object_id]
+set child_p [km_is_child_p $object_id]
+
+if {$child_p} {
+ set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+ set parent_object_type [km_static object_type_pretty_name [thd [km_get_parent $object_id]]]
+ ad_return_complaint 1 "Not allowed to unpublish this $object_type separately from the linked $parent_object_type."
+ return
+}
+
+db_transaction {
+
+ km_object_unpublish $object_id
+
+ if {$nephew_p} {
+ set uncle [km_get_uncle $object_id]
+ set uncle_id [fst $uncle]
+ set uncle_name [snd $uncle]
+ if { [km_uncle_needs_private_status_p $uncle_id] } {
+ km_object_unpublish $uncle_id
+ }
+ }
+
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/object-unpublish.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-unpublish.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-unpublish.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,20 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form method="post" action="object-unpublish-2">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<if @nephew_p@ eq 1>
+ <p>The @uncle_object_type@ "<a href="object-view?object_id=@uncle_id@&category_id=@category_id@">@uncle_name@</a>"
+ and all the linked @descendent_object_types@ may need to be made private as well if this is the last public
+ @object_type@ of "<a href="object-view?object_id=@uncle_id@&category_id=@category_id@">@uncle_name@</a>".
+</if>
+<else>
+ <p>Together with this @object_type@ all @descendent_object_types@ will be made private as well.
+</else>
+
+<p><center><input type="submit" name="confirm" value="Proceed">
+ <input type="submit" name="cancel" value="Cancel"></center>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/object-unpublish.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-unpublish.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-unpublish.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,109 @@
+ad_page_contract {
+ /packages/library/www/object-unpublish.tcl
+
+ Mark an object as private.
+
+ @cvs-id $Id: object-unpublish.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ {return_url ""}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ dc_export:onevalue
+ uncle_id:onevalue
+ uncle_name:onevalue
+ uncle_p:onevalue
+ nephew_p:onevalue
+ object_type:onevalue
+ uncle_object_type:onevalue
+ descendent_object_types:onevalue
+}
+csrf::authenticate
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if ![km_check_object_id $object_id] { return }
+
+if ![km_conn public_p] {
+ ad_returnredirect $return_url
+ return
+}
+
+set author_id [km_conn original_author_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+set publish_p [km_conn publish_p]
+set approval_p [km_static approval_p $package_id]
+
+if { !$admin_p && (!$write_p || $archived_p || ($approval_p && !$publish_p)) } { return }
+
+set object_type [km_static object_type_pretty_name [km_conn object_type_id]]
+set nephew_p [km_is_mandatory_nephew_p $object_id]
+set child_p [km_is_child_p $object_id]
+set uncle_p [km_is_uncle_p $object_id]
+set parent_p [km_is_parent_p $object_id]
+set uncle_object_type ""
+set descendent_object_types ""
+
+if {$child_p} {
+ set parent_object_type [km_static object_type_pretty_name [thd [km_get_parent $object_id]]]
+ ad_return_complaint 1 "Not allowed to unpublish this $object_type separately from the linked $parent_object_type."
+ return
+}
+
+if {$nephew_p} {
+ set uncle [km_get_uncle $object_id]
+ set uncle_id [fst $uncle]
+ set uncle_name [snd $uncle]
+ set uncle_object_type [km_static object_type_pretty_name [thd $uncle]]
+ db_foreach get_descendent_object_type_list {
+ select q.target_object_type_id as descendent_object_type_id
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :uncle_id
+ and o.context_id=:package_id
+ and q.abstract_data_type in ('nephew_object','child_object')
+ } {
+ lappend object_type_list [km_static object_type_pretty_plural $descendent_object_type_id]
+ }
+ set descendent_object_types [join $object_type_list " and "]
+}
+
+if {$uncle_p || $parent_p} {
+ db_foreach get_descendent_object_type_list {
+ select q.target_object_type_id as descendent_object_type_id
+ from sn_questions q, sn_question_object_type_map qm, sn_objects o
+ where q.question_id = qm.question_id
+ and qm.question_state = 'active'
+ and qm.object_type_id = o.object_type_id
+ and o.object_id = :object_id
+ and o.context_id=:package_id
+ and q.abstract_data_type in ('nephew_object','child_object')
+ } {
+ lappend object_type_list [km_static object_type_pretty_plural $descendent_object_type_id]
+ }
+ set descendent_object_types [join $object_type_list " and "]
+}
+
+if {$parent_p || $uncle_p || ($nephew_p && [km_uncle_needs_private_status_p $uncle_id $object_id])} {
+ set title "Unpublish linked objects"
+ set_the_usual_klib_context_bar $object_id $category_id
+ append_context_bar_data "Make private"
+ set form_vars [export_form_vars object_id category_id return_url]
+ set dc_export [doubleclick::signature_html]
+} else {
+ km_object_unpublish $object_id
+
+ if [empty_string_p $return_url] {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+ }
+
+ ad_returnredirect $return_url
+ return
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-view-linked.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-view-linked.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-view-linked.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,21 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<include src="object-view-toolbar" child_p="@child_p@" object_id="@object_id@" category_id="@category_id@" default="linked_objects">
+<p>
+<if @length_linked_objects@ gt 0>
+
+<p>On this page you see all links that exist to or from the @pretty_type@
+"@object_name@". Along with the object itself, the linking direction
+and the question that led to the link are displayed:</p>
+
+<include src="km-linked-object-list" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" linked_object_list="@linked_objects;noquote@" display_questions_p="1" display_object_types_p="1">
+
+</if>
+<else>
+<em>There are no links to or from other objects.</em>
+</else>
+
+<if @length_linked_objects@ gt 4>
+ <p><include src="object-view-toolbar" child_p="@child_p@" object_id="@object_id@" category_id="@category_id@" default="linked_objects">
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/object-view-linked.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-view-linked.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-view-linked.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,45 @@
+ad_page_contract {
+ Show all objects linked to the given object.
+ $Id: object-view-linked.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:integer,notnull
+ {category_id ""}
+} -properties {
+ object_id:onevalue
+ community_id:onevalue
+ admin_p:onevalue
+ public_p:onevalue
+ original_author_id:onevalue
+ user_id:onevalue
+ child_p:onevalue
+ archived_p:onevalue
+ review_p:onevalue
+}
+
+set user_id [ad_conn user_id]
+if {![km_check_object_id $object_id]} { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+set title "[km_static object_type_pretty_name $object_type_id]: $object_name"
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set community_id $node(package_id)
+set public_p [km_conn public_p]
+set archived_p [km_conn archived_p]
+set review_p [km_conn review_p]
+set original_author_id [km_conn original_author_id]
+
+# Determine which permissions the viewing user has.
+set admin_p [km_conn admin_p]
+
+set linked_objects [km_get_linked_objects -to_p 1 -from_p 1 $user_id $object_id]
+set length_linked_objects [llength $linked_objects]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Linked Objects"
+set child_p [km_is_descendant_p $object_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-view-toolbar.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-view-toolbar.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-view-toolbar.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,69 @@
+View:
+[
+<if @write_p@ eq 1>
+ <if @default@ eq all>
+ <strong>All Questions</strong>
+ </if>
+ <else>
+ <a href="questions?@parameters@">All Questions</a>
+ </else>
+ |
+
+ <if @default@ eq unanswered>
+ <strong>Unanswered Questions</strong>
+ </if>
+ <else>
+ <a href="questions?view_questions=unanswered&@parameters@">Unanswered Questions</a>
+ </else>
+ |
+</if>
+
+<if @child_p@ eq 0>
+ <if @default@ eq linked_objects>
+ <strong>Linked Objects</strong>
+ </if>
+ <else>
+ <a href="object-view-linked?@parameters@">Linked Objects</a>
+ </else>
+ |
+</if>
+
+<if @default@ eq object_view>
+ <strong>Completed Content</strong>
+</if>
+<else>
+ <a href="object-view?@parameters@">Completed Content</a>
+</else>
+
+<if @admin_p@ eq 1>
+ |
+ <if @default@ eq object-indexed>
+ <strong>Indexed Content</strong>
+ </if>
+ <else>
+ <a href="object-indexed?@parameters@">Indexed Content</a>
+ </else>
+ |
+ <if @default@ eq object-xml>
+ <strong>XML</strong>
+ </if>
+ <else>
+ <a href="object-xml?@parameters@">XML</a>
+ </else>
+</if>
+
+<if @bookmarks_installed_p@ eq 1>
+ <if @bookmarked@ ne 1>
+ | <a href="/bookmarks/object-add?@bookmark_url_vars@&return_uri=@return_uri@">Bookmark this object</a>
+ </if>
+ <if @shopping_cart@ ne 1>
+ | <a href="/bookmarks/shopp-add?object_id=@object_id@&return_uri=@return_uri@&@csrf_link@">Add to your shopping cart</a>
+ </if>
+
+</if>
+
+<if @have_alert@ eq 0>
+ | <a href="alert?object_id=@object_id@&return_uri=@return_uri@">Set an alert</a>
+</if>
+]
+
Index: openacs-4/contrib/obsolete-packages/library/www/object-view-toolbar.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-view-toolbar.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-view-toolbar.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,57 @@
+# Allow the user to select different views of the object if he
+# is allowed to edit the object:
+
+# All Questions | Unanswered Questions | Linked Objects | Completed Content | Indexed Content | XML
+
+
+if ![info exists child_p] {
+ set child_p 0
+}
+
+if ![info exists subsite_url] {
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set subsite_url $node(url)
+}
+
+set bar_pretty {}
+set bar_url {}
+set bar_short {}
+
+set parameters [export_url_vars object_id category_id]
+set write_p [km_conn write_p]
+set admin_p [km_conn admin_p]
+set archived_p [km_conn archived_p]
+if {$archived_p} {
+ set write_p $admin_p
+}
+
+set csrf_link [csrf::link_token]
+
+if {[info exists bookmarks::initialized]} {
+ set bookmarks_installed_p 1
+ set viewer_id [ad_conn user_id]
+ upvar bookmarked_p bookmarked shopping_cart_p shopping_cart
+ set bookmarked [bookmarks::is_bookmarked $viewer_id $object_id]
+ set shopping_cart [bookmarks::in_the_shopping_cart $viewer_id $object_id]
+ set return_uri [ad_urlencode "[ad_conn url]?object_id=$object_id&category_id=$category_id"]
+ if {!$bookmarked} {
+ set node_id [ad_conn node_id]
+ db_0or1row get_community_id {
+ select c.community_id
+ from site_nodes s, site_nodes sp, sn_communities c
+ where s.node_id = :node_id
+ and s.parent_id = sp.node_id
+ and sp.object_id = c.community_id
+ }
+ set bookmark_url_vars [export_url_vars community_id object_id]
+ }
+} else {
+ set bookmarks_installed_p 0
+}
+
+if {$archived_p} {
+ set have_alert 1
+} else {
+ set have_alert [alerts::exists -object_id $object_id -content_type_id [km_conn object_type_id]]
+}
+
Index: openacs-4/contrib/obsolete-packages/library/www/object-view.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-view.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-view.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,154 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="subsite_url">@subsite_url;noquote@</property>
+<property name="subsite_name">@subsite_name;noquote@</property>
+<property name="search_contexts">@search_contexts;noquote@</property>
+
+<if @read_only_child_p@ eq 0>
+<include src="object-view-toolbar" child_p="@child_p@" object_id="@object_id@" category_id="@category_id@" default="object_view"><p>
+</if>
+<if @workspace_toolbar@ not nil>
+<p>@workspace_toolbar;noquote@
+</if>
+
+<p><table cellspacing=2 cellpadding=2>
+
+<tr>
+<if @write_feedback_of_object@ eq 1>
+ <if @feedback_statistics.count@ eq 0>
+ <td></td><td> </td><td>No user rating yet
+ </if>
+ <else>
+ <td align=right><nobr>@feedback_statistics.average@ <img src="@subsite_url@images/@feedback_statistics.avg_points_img@" alt="@feedback_statistics.average@ points" width="50" height="9"></nobr></td><td> </td><td>
+ <if @feedback_statistics.count@ eq 1> from 1 user rating</if>
+ <else>
+ average out of @feedback_statistics.count@ user rating<if @feedback_statistics.count@ gt 1>s</if>
+(@feedback_statistics.total@ points in total)
+ </else>
+ </else>
+ |
+</if>
+<else>
+ <td></td><td> </td><td>
+</else>
+
+@access_count@ hits <if @access_count_month@ ne 0>(@access_count_month@ this month)</if>
+</td></tr>
+
+<if @ancestor_object_id@ ne 0>
+ <tr><th align="right">@ancestor_object_type@</th><td> </td><td><a href="object-view?object_id=@ancestor_object_id@">@ancestor_name@</a><if @ancestor_public_p@ eq 0> <font color=red>[Private]</font></if><if @ancestor_archived_p@ eq 1> <font color=red>[Archived]</font></if><if @ancestor_review_p@ eq 1> <font color=green>[In review]</font></if></td></tr>
+</if>
+
+<tr><th align="right">Date Created</th><td> </td><td>@date_created@</td></tr>
+
+<if @public_p@ eq 0>
+ <if @checkoff_date@ ne "">
+ <tr><th align="right">Release Date</th><td> </td><td>@pretty_checkoff_date@</td></tr>
+ </if>
+</if><else>
+ <tr><th align="right">Date Published</th><td> </td><td>@pretty_checkoff_date@</td></tr>
+</else>
+
+<tr><th align="right">Last Modified</th>
+<td> </td>
+<td>@date_last_modified@ (<a href="object-audit-trail?object_id=@object_id@&category_id=@category_id@">History</a>)</td>
+</tr>
+</if>
+
+<tr><td align=right>
+<if @change_owner_p@ eq 1>
+<a href="owner-change?object_id=@object_id@&category_id=@category_id@"><b>Owner</b></a>
+</if>
+<else><b>Owner</b></else>
+</td>
+<td> </td>
+<td><a href="../users/yp?user_id=@author_id@">@author_name@</a></td></tr>
+
+<if @publisher_id@ not nil>
+ <if @change_publisher_p@ eq 1>
+ <tr><td align=right><a href="publisher-change?object_id=@object_id@&category_id=@category_id@"><b>Publisher</b></a></td>
+ </if>
+ <else>
+ <tr><td align=right><b>Publisher</b></td>
+ </else>
+ <td> </td>
+ <td><a href="../users/yp?user_id=@publisher_id@">@publisher_name@</a></td></tr>
+</if>
+
+<multiple name="display_object_data">
+ <include src="km-display-question-answer" object_type_id="@object_type_id@" object_id="@display_object_data.object_id@" category_id="@category_id@" question_id="@display_object_data.question_id@" abstract_data_type="@display_object_data.abstract_data_type@" branch_p="@display_object_data.branch_p@" root_branch_p="@display_object_data.root_branch_p@" pretty_question="@display_object_data.pretty_question@" value="@display_object_data.value;noquote@" edit_p="@display_object_data.edit_p@">
+</multiple>
+
+
+<if @linked_objects@ ne "">
+<tr><th align="right" valign="top">More Links</th><td> </td>
+<td>
+<include src="km-linked-object-list" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" linked_object_list="@linked_objects;noquote@">
+</td></tr>
+</if>
+
+</table>
+
+<if @archived_p@ eq 0>
+ <center>
+ <a href="comment-add?object_id=@object_id@&category_id=@category_id@&path_id=@path_id@">Give feedback</a>
+ </center>
+</if>
+
+<p>
+<if @comments:rowcount@ ne 0>
+ <h3>Comments and Feedback</h3>
+</if>
+
+<multiple name=comments>
+ <if @comments.display_p@ eq "1" or @admin_p@ eq "1" or @comments.comment_user_id@ eq @user_id@ or @author_id@ eq @user_id@>
+ <blockquote>
+ <if @comments.category@ not nil>
+ <p><strong>@comments.category@</strong>
+ </if>
+ <if @comments.rating@ ne "-1" and @comments.rating@ not nil>
+ (<nobr>@comments.rating@ <img src="@subsite_url@images/@comments.rating_img@" alt="@comments.rating@" width="50" height="9"></nobr> feedback point<if @comments.rating@ ne 1>s</if> given)
+ </if>
+ <p>
+ @comments.content;noquote@
+ <p>
+ -- <a href="../users/yp?user_id=@comments.comment_user_id@">@comments.commenter_name@</a>, @comments.comment_date@
+ <if @comments.display_p@ eq "0">
+ (<font color=red>Private</font>)
+ </if>
+ <if @admin_p@ eq "1">
+ (<a href="comment-edit?comment_id=@comments.comment_id@&category_id=@category_id@&path_id=@path_id@">edit</a>)
+ (<a href="comment-delete?comment_id=@comments.comment_id@&category_id=@category_id@&path_id=@path_id@">delete</a>)
+ </if>
+ <else>
+ <if @archived_p@ eq 0 and @comments.comment_user_id@ eq @user_id@>
+ (<a href="comment-edit?comment_id=@comments.comment_id@&category_id=@category_id@&path_id=@path_id@">edit</a>)
+ </if>
+ </else>
+ </if>
+ </blockquote>
+</multiple>
+
+<if @comments:rowcount@ ne 0 and @archived_p@ eq 0>
+ <center>
+ <a href="comment-add?object_id=@object_id@&category_id=@category_id@&path_id=@path_id@">Give feedback</a>
+ </center>
+</if>
+</p>
+
+</if>
+
+<if @application_p@ eq 1 and @public_p@ eq 1 and @archived_p@ eq 0>
+ <form method=get action="resource-application-add">
+ <csrf-token>
+ @application_form_vars;noquote@
+ <center><input type=submit value="I Apply"></center>
+ </form>
+</if>
+
+<if @read_only_child_p@ eq 0>
+ <p><include src="object-view-toolbar" child_p="@child_p@" object_id="@object_id@" category_id="@category_id@" default="object_view">
+</if>
+
+<p>@object_access_toolbar;noquote@
Index: openacs-4/contrib/obsolete-packages/library/www/object-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-view.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-view.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,316 @@
+ad_page_contract {
+ object-view.tcl
+
+ Display the completed content of an object.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ $Id: object-view.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:integer
+ {category_id ""}
+ {path_id:integer ""}
+} -properties {
+ title:onevalue
+ write_feedback_of_object:onevalue
+ object_id:onevalue
+ object_type_id:onevalue
+ pretty_type:onevalue
+ date_created:onevalue
+ public_p:onevalue
+ checkoff_date:onevalue
+ pretty_checkoff_date:onevalue
+ date_last_modified:onevalue
+ author_id:onevalue
+ author_name:onevalue
+ length_linked_objects:onevalue
+ object_list:onevalue
+ read_only_child_p:onevalue
+ object_access_toolbar:onevalue
+ display_object_data:multirow
+ linked_urls_list:onevalue
+ workspace_toolbar:onevalue
+ access_count:onevalue
+ access_count_month:onevalue
+ edit_p:onevalue
+ admin_p:onevalue
+ delete_p:onevalue
+ change_owner_p:onevalue
+ change_publisher_p:onevalue
+ user_id:onevalue
+ reuse_p:onevalue
+ comments:multirow
+ path_id:onevalue
+ category_id:onevalue
+ subsite_url:onevalue
+ subsite_name:onevalue
+ community_id:onevalue
+ public_p:onevalue
+ bookmarked_p:onevalue
+ shopping_cart_p:onevalue
+ child_p:onevalue
+ nephew_p:onevalue
+ application_p:onevalue
+ application_form_vars:onevalue
+ ancestor_object_id:onevalue
+ ancestor_object_type:onevalue
+ ancestor_name:onevalue
+ ancestor_public_p:onevalue
+ ancestor_archived_p:onevalue
+ ancestor_review_p:onevalue
+ publisher_id:onevalue
+ publisher_name:onevalue
+ ot_create_p:onevalue
+ ot_copy_p:onevalue
+ ot_archive_p:onevalue
+ review_p:onevalue
+ task_id:onevalue
+ archived_p:onevalue
+ approval_p:onevalue
+ review_state:onevalue
+ create_p:onevalue
+}
+
+set user_id [ad_conn user_id]
+set package_id [ad_conn package_id]
+set instance_name [ad_conn instance_name]
+
+if ![km_check_object_id $object_id] { return }
+
+set object_type_id [km_conn object_type_id]
+set read_only_child_p 0
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set community_id $node(package_id)
+set subsite_url $node(url)
+set subsite_name $node(instance_name)
+set public_p [km_conn public_p]
+set review_p [km_conn in_review_p]
+set review_state [km_conn review_state]
+set original_author_id [km_conn original_author_id]
+set object_name [km_conn object_name]
+set stripped_name [sn_striphtml $object_name]
+set approval_p [km_static approval_p $package_id]
+set ancestor_object_id 0
+set publisher_id [km_conn publisher_id]
+if ![empty_string_p $publisher_id] {
+ set publisher_name [db_string get_publisher_name {select first_names || ' ' || last_name from users where user_id = :publisher_id}]
+} else {
+ set publisher_name ""
+}
+
+# Determine which permissions the viewing user has.
+set admin_p [km_conn admin_p]
+set publish_p [km_conn publish_p]
+set edit_p [km_conn write_p]
+set delete_p [km_conn delete_p]
+set create_p [km_conn create_p]
+set archived_p [km_conn archived_p]
+set ot_archive_p [km_static object_type_archive_p $object_type_id]
+set ot_create_p [km_static object_type_create_p $object_type_id]
+set ot_copy_p [km_static object_type_copy_p $object_type_id]
+set publisher_id [km_conn publisher_id]
+set title "$pretty_type: $stripped_name"
+
+if { ($user_id == $original_author_id && !$archived_p) || $admin_p } {
+ set change_owner_p 1
+} else {
+ set change_owner_p 0
+}
+
+if { $admin_p || $publish_p || $publisher_id == $user_id} {
+ set change_publisher_p 1
+} else {
+ set change_publisher_p 0
+}
+
+## get the task_id of the workflow task if object is in review
+if { $review_p } {
+ set task_id [db_string get_workflow_task {
+ select distinct(ut.task_id)
+ from wf_cases c, wf_user_tasks ut
+ where c.object_id = :object_id
+ and c.case_id = ut.case_id
+ and c.state = 'active'
+ and rownum = 1
+ order by ut.task_id desc
+ } -default ""]
+} else {
+ set task_id ""
+}
+
+# Determine how often the object has been viewed in total, and this month.
+if { $user_id } { km_count_object_view $user_id $object_id }
+
+set access_count [km_conn access_total]
+set access_count_month [km_conn access_month]
+
+# This object may have some parents.
+# The proc returns pairs of parent_object_id and the object name
+set ancestors [reverse [km_get_object_ancestors $object_id]]
+
+if ![null_p $ancestors] {
+ set ancestor [fst $ancestors]
+ set ancestor_object_id [fst $ancestor]
+ set ancestor_object_type [km_static object_type_pretty_name [thd $ancestor]]
+ set ancestor_name [snd $ancestor]
+ db_1row get_public_archived_status {
+ select decode(public_p,'t',1,0) as ancestor_public_p,
+ decode(archived_p,'t',1,0) as ancestor_archived_p,
+ decode(in_review_p,'t',1,0) as ancestor_review_p
+ from sn_objects
+ where object_id = :ancestor_object_id
+ }
+
+ if { !$admin_p } {
+ set ancestor_object_type_id [thd $ancestor]
+ if {[llength $ancestors] > 1} {
+ set ancestor_linked_object_id [fst [snd $ancestors]]
+ } else {
+ set ancestor_linked_object_id $object_id
+ }
+ set ancestor_question_state [db_string object_view_10 "
+ select qm.question_state
+ from sn_question_object_type_map qm, sn_links l, sn_question_link_map map
+ where l.object_id_a = :ancestor_object_id
+ and l.object_id_b = :ancestor_linked_object_id
+ and l.link_id = map.link_id
+ and map.question_id = qm.question_id
+ and qm.object_type_id = :ancestor_object_type_id"]
+ if { $ancestor_question_state == "read-only" } {
+ set edit_p 0
+ set read_only_child_p 1
+ }
+ }
+ set child_p 1
+} else {
+ set child_p 0
+}
+
+set nephew_p [km_is_nephew_p $object_id]
+
+if {$child_p && !$nephew_p} {
+ if {$ot_archive_p} {
+ set return_url "object-view?[export_url_vars object_id]"
+ if { $archived_p && $edit_p } {
+ set object_access_toolbar "<font color=red>\[Archived\]</font> <a href=\"object-unarchive?[export_url_vars object_id category_id return_url]\">Remove from archive</a>"
+ } else {
+ set object_access_toolbar "<a href=\"object-archive?[export_url_vars object_id category_id return_url]\">Put in archive</a>"
+ }
+ } else {
+ set object_access_toolbar ""
+ }
+} else {
+ set object_access_toolbar [km_object_access_toolbar $object_id $category_id]
+}
+
+if {$nephew_p && [string equal [km_get_presentation_type_of_nephew_question $object_id] "application"]} {
+ set application_p 1
+ set resource_req_id [fst [km_get_uncle $object_id]]
+ set return_url "object-view?[ad_conn query]"
+ set application_form_vars [export_form_vars object_id category_id resource_req_id return_url]
+} else {
+ set application_p 0
+ set application_form_vars ""
+}
+
+if { ![empty_string_p $path_id] && [path_valid_p $path_id] } {
+ set path_values [get_path_values -action_only_p 0 $path_id]
+ set last_path_id [get_last_path $path_id]
+ set browse_type [snd $path_values]
+ set browse_category [lindex $path_values 3]
+
+ set browse_type "browse-one-type?[export_url_vars object_type_id]&path_id=$last_path_id&$browse_type"
+ set browse_category "browse-one-category?[export_url_vars object_type_id category_id]&path_id=$last_path_id&$browse_category"
+} else {
+ set browse_type "browse-one-type?[export_url_vars object_type_id]"
+ set browse_category "browse-one-category?[export_url_vars object_type_id category_id]"
+}
+
+# Set up the context bar. This is so complicated because we
+# not only provide a link to browse-one-type.tcl, but also
+# to browse-one-category.tcl (if needed).
+
+## if {$child_p && !$nephew_p} {
+## set workspace_toolbar ""
+##} else {
+ set workspace_toolbar [km_workspace_toolbar $object_id $category_id $child_p]
+##}
+set_the_usual_klib_context_bar $object_id $category_id
+
+if { $public_p } {
+ set write_feedback_of_object [get_feedback_statistics_for_object $object_id feedback_statistics]
+} else {
+ set write_feedback_of_object 0
+ set feedback_statistics ""
+}
+
+# Display questions and answers (omitting unanswered questions).
+set date_created [util_AnsiDatetoPrettyDate [km_conn creation_date]]
+set date_last_modified [util_AnsiDatetoPrettyDate [km_conn last_modified]]
+set checkoff_date [km_conn user_checkoff_date]
+set pretty_checkoff_date [util_AnsiDatetoPrettyDate [km_conn user_checkoff_date]]
+
+set author_name [km_conn original_author_name]
+set author_id [km_conn original_author_id]
+
+# Retrieve all data for this object as a list of lists in this Special Form:
+# question_id, pretty_question, abstract_data_type, value
+set object_data [km_get_object_data -answers_only_p 0 $object_id]
+
+template::multirow create display_object_data object_id question_id abstract_data_type branch_p root_branch_p pretty_question value edit_p
+
+foreach item $object_data {
+ set value [fst $item]
+ set question_id [snd $item]
+ set pretty_question [thd $item]
+ set abstract_data_type [lindex $item 3]
+ set branch_p [lindex $item 4]
+ set root_branch_p [lindex $item 5]
+
+ if {[empty_string_p $branch_p]} {
+ set branch_p 0
+}
+ if { !$branch_p || [km_active_path_p $question_id $object_id $object_type_id] } {
+ template::multirow append display_object_data $object_id $question_id $abstract_data_type $branch_p $root_branch_p $pretty_question $value $edit_p
+ }
+}
+
+set linked_objects [km_get_linked_objects -to_p 1 -reference_links_p 0 -family_members_p 0 $user_id $object_id]
+if {[llength $linked_objects] <= 1} {
+ set linked_objects ""
+}
+
+set reuse_p 0
+if { $public_p && $original_author_id != $user_id } {
+ # Prevent private objects from getting shares.
+ set reuse_p 1
+}
+
+get_feedback_for_object $object_id comments
+
+if {![empty_string_p $category_id] && ![string equal $category_id none]} {
+ query get_category_tree_info tree_info onerow {
+ select gt.tree_name, gt.tree_id, c.short_name
+ from sw_category_dim scd, generic_trees gt, categories c
+ where scd.object_id = :category_id
+ and scd.tree_id = gt.tree_id
+ and c.category_id = :category_id
+ }
+ set search_contexts [list \
+ [list "lcat:$object_type_id,$tree_info(tree_id),$category_id" "$tree_info(short_name)"] \
+ [list "ltype:$object_type_id" "$pretty_type_plural"] \
+ [list "lib:$package_id" "$instance_name"] \
+ [list "sc:$community_id" "$subsite_name"] \
+ [sws_km_site_search_context]]
+} else {
+ set search_contexts [list \
+ [list "ltype:$object_type_id" "$pretty_type_plural"] \
+ [list "lib:$package_id" "$instance_name"] \
+ [list "sc:$community_id" "$subsite_name"] \
+ [sws_km_site_search_context]]
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/object-xml.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/object-xml.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/object-xml.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,29 @@
+ad_page_contract {
+ /www/library/object-indexed.tcl
+
+ Show intemedia index contents for given object instance
+
+ created by akananov@arsdigita.com 18.10.2000
+
+ @cvs-id $Id:
+} {
+ object_id:notnull,integer
+ {msie_p:boolean 0}
+}
+
+if ![km_check_object_id $object_id] { return }
+if {![km_conn admin_p]} { return }
+
+set sql "
+ select km_utilities.km_xml(object_id) xml_doc from sn_objects
+ where object_id = :object_id"
+
+db_1row object_xml_10 $sql
+
+if {[msie_p]} {
+ set mime application/xml
+} else {
+ set mime text/plain
+}
+
+ns_return 200 $mime $xml_doc
Index: openacs-4/contrib/obsolete-packages/library/www/one-question-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/one-question-edit-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/one-question-edit-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,278 @@
+ad_page_contract {
+ /www/library/one-question-edit-2.tcl
+
+ First save the data from one-question-edit.tcl, then redirect the user
+ to his destination.
+
+ @cvs-id $Id: one-question-edit-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ question_id:integer
+}
+csrf::authenticate
+
+set key_values {}
+set_the_usual_form_variables
+set button_name ""
+set new_question ""
+set branch_id ""
+set action ""
+
+# We need some information about this question
+set pretty_name [km_static question_pretty_name $question_id]
+set abstract_data_type [km_static question_abstract_data_type $question_id]
+
+# expecting: object_id path_id
+# In the form: the submit button name, the question's column_name
+# and its value to be stored in the database
+
+set form_size [ns_set size $Vform]
+
+# Go through the form and pick out the data we need for the path from
+# the data that needs to go to Oracle.
+set counter 0
+
+while { $counter < $form_size } {
+
+ set key [ns_set key $Vform $counter]
+ set value [ns_set value $Vform $counter]
+ incr counter
+
+ # Isolate the general name of this form field.
+ # A submit button has the form general_name.question_id
+
+ regexp {(.*)\.} $key match button_name
+
+ # See if this is the form's submit button.
+ if { [lsearch [km_get_button_names] $button_name] >= 0 } {
+ regexp {\.(.*)} $key match button_target
+
+ # This IS the form's submit button which sets the path action.
+ # We want to get the question_id out of it as well.
+
+ set action $button_name
+
+ # The second half of the submit button name is the question_id
+ # for the next/previous question to be edited
+ if { $button_name == "next_question" || $button_name == "previous_question" } {
+ set new_question_id $button_target
+ }
+
+ } else {
+
+ switch $key {
+ "path_id" { set path_id $value }
+ "object_id" { set object_id $value }
+ "object_type_id" { set object_type_id $value }
+ "parent_object_id" { set parent_object_id $value }
+ "uncle_object_id" { set uncle_object_id $value }
+ "question_id" { set question_id $value }
+ "category_id" { set category_id $value }
+ "default" { lappend key_values [list $key $value] }
+ }
+ }
+}
+
+if {![km_check_object_id -check_edit_p 1 $object_id]} {
+ return
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set archived_p [km_conn archived_p]
+set admin_p [km_conn admin_p]
+set all_types_p 0
+if {$admin_p && $archived_p} {
+ set all_types_p 1
+}
+
+set question [km_get_question -all_types_p $all_types_p $question_id $object_type_id]
+set question_state [lindex $question 3]
+
+if ![info exists path_id] { set path_id "" }
+
+if {[lsearch [list category other_category option] $abstract_data_type] != -1} {
+ set valid_keys [km_filter_valid_keys $key_values]
+ if {![null_p $valid_keys] && [empty_string_p [snd [fst $valid_keys]]]} {
+ set key_values [list]
+ }
+}
+
+if { $action == "delete" } {
+ set results [km_delete_object_data $object_id $button_target]
+}
+
+if { $action == "delete" || ($question_state == "read-only" && !$admin_p) } {
+ # If the user cannot edit or has deleted the content,
+ # then there won't be bad input, and nothing should be saved.
+ set results ""
+} elseif {![null_p [km_filter_valid_keys $key_values]] || [string equal $abstract_data_type date]} {
+
+ # Do some error checking
+ set key_values [km_sort_form $key_values]
+ set bad_input [km_check_input -required_p 1 $object_id $key_values]
+
+ if ![null_p $bad_input] {
+ ad_return_complaint [fst $bad_input] [snd $bad_input]
+ return
+ } else {
+ # Save the data
+ set results [km_save_object_data $object_id $user_id $key_values]
+ }
+
+} elseif { [string equal $abstract_data_type "category"] || [string equal $abstract_data_type "other_category"] } {
+
+ # We have to handle this differently because it is possible that
+ # no variable is carried thru from the one-question-edit.tcl, and
+ # yet this variable may be required.
+
+ if { [elem_p $question_id [km_required_questions $object_id]] } {
+ # Some important variable has not passed that is required
+ ad_return_complaint 1 "<li>You must supply a value for $pretty_name"
+ return
+ } else {
+ # this isn't a required field
+ km_uncategorize_object $object_id $question_id
+ if { $abstract_data_type == "other_category" } {
+ km_save_object_content -html_p 0 $question_id $object_id $user_id ""
+ }
+ set results {}
+ }
+} elseif { $abstract_data_type == "option" } {
+
+ if { [elem_p $question_id [km_required_questions $object_id]] } {
+ # Some important variable has not passed that is required
+ ad_return_complaint 1 "<li>You must supply a value for $pretty_name"
+ return
+ } else {
+ # this isn't a required field so we need to save an empty string
+ set results [km_unoptionize_object $object_id $question_id]
+ }
+
+} else {
+ # If the form has no input fields then there won't be bad input.
+ set results ""
+}
+
+km_check_public_status_after_edit $object_id
+
+if [empty_string_p [snd $results]] {
+ # If there was no message then we can assume the editing was a success.
+ # So where do we go now?
+
+ switch $action {
+ "previous_question" -
+ "next_question" {
+
+ # First, this question might lead off to a branch
+ if { [lsearch {"option" "category" "other_category" "integer" "text"} $abstract_data_type] >= 0 &&
+ $action == "next_question" } {
+ if { $question_state == "read-only" && !$admin_p } {
+ # There was no form on one-question-edit.tcl.
+ # So we have to retrieve the answer from the database.
+
+ set question_fields {question_id pretty_name abstract_data_type question_state}
+ set question [list $question_fields [list $question_id $pretty_name $abstract_data_type $question_state]]
+ set answer [fst [km_get_object_data -questions $question $object_id]]
+ } else {
+ set answer [snd [fst $key_values]]
+ }
+ set branch_id [km_next_branch -abstract_data_type $abstract_data_type $question_id $answer $object_type_id]
+ if ![empty_string_p $branch_id] {
+ set new_question_id $branch_id
+ } elseif { [km_root_branch_p $question_id] } {
+ set new_question_id [fst [km_get_question -next_p 1 -all_types_p $all_types_p $question_id $object_type_id]]
+ }
+ }
+
+ # Set the destination
+ if ![empty_string_p $new_question_id] {
+ set question_id $new_question_id
+ set new_abstract_data_type [km_static question_abstract_data_type $question_id]
+
+ if { $new_abstract_data_type == "object_link" } {
+ set destination "object-link?[export_url_vars object_id category_id question_id]"
+ } elseif ![empty_string_p $question_id] {
+ set destination "one-question-edit?[export_url_vars object_id category_id question_id parent_object_id]"
+ } else {
+ set destination "object-view?[export_url_vars object_id category_id]"
+ }
+ } else {
+ # redirect to answered questions if the answer to this branch
+ # question doesn't lead to a branch and this question
+ # is the last question
+ set destination "object-view?edit_p=1&[export_url_vars object_id category_id parent_object_id]"
+ }
+ }
+ "all_questions" {
+ set destination "questions?view_questions=all&[export_url_vars object_id category_id parent_object_id]"
+ }
+ "answered" {
+ set destination "object-view?edit_p=1&[export_url_vars object_id category_id parent_object_id]"
+ }
+ "unanswered" {
+ set destination "questions?view_questions=unanswered&[export_url_vars object_id category_id parent_object_id]"
+ }
+ "add_web_ref" {
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id]"
+ set path_vars [list question_id $button_target object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ set destination "add-web-ref?[export_url_vars path_id]"
+ }
+ "add_sn_ref" {
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id]"
+ set path_vars [list question_id $button_target object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set community_id $node(package_id)
+ set destination "linking/?community_id=$community_id&source_id=$object_id&pass=$path_id"
+ }
+ "add_user_ref" {
+ set target "user-link-add"
+ set passthrough {path_id}
+ set keyword [set user_link.$button_target]
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id]"
+ set path_vars [list question_id $button_target object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+
+ set context_bar [list "one-question-edit?[export_url_vars object_id category_id question_id]" "Edit"]
+ set destination "user-search?[export_url_vars keyword target passthrough path_id context_bar object_id category_id]"
+ }
+ "add_content_ref" {
+ set target "content-link-add"
+ set query_string $content_query
+ set table_name $content_table
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id]"
+ set path_vars [list question_id $button_target object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ set destination "/shared/sw-search-2?[export_url_vars query_string table_name target path_id]"
+ }
+ "add_nephew" {
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id path_id]"
+ set path_vars [list question_id $button_target uncle_object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ set destination "object-edit?[export_url_vars path_id]&uncle_object_id=$object_id&question_id=$button_target"
+ }
+ "add_child" {
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id path_id]"
+ set path_vars [list question_id $button_target parent_object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ set destination "object-edit?[export_url_vars path_id]&parent_object_id=$object_id&question_id=$button_target"
+ }
+ "copy_nephew" {
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id path_id]"
+ set path_vars [list question_id $button_target uncle_object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ set destination "object-copy?[export_url_vars path_id category_id]&parent_id=$object_id&question_id=$button_target"
+ }
+ "copy_child" {
+ set return_url "one-question-edit?[export_url_vars object_id category_id question_id path_id]"
+ set path_vars [list question_id $button_target parent_object_id $object_id category_id $category_id]
+ set path_id [init_path $path_vars $return_url $action]
+ set destination "object-copy?[export_url_vars path_id category_id]&parent_id=$object_id&question_id=$button_target"
+ }
+ default { set destination "questions?view_questions=all&[export_url_vars object_id category_id]" }
+ }
+} else {
+ set destination "/global/error.html"
+}
+
+ad_returnredirect $destination
Index: openacs-4/contrib/obsolete-packages/library/www/one-question-edit.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/one-question-edit.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/one-question-edit.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,45 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+<property name="header_stuff"><link rel="stylesheet" href="form.css"></property>
+
+<form enctype="multipart/form-data" method=post action="one-question-edit-2">
+<csrf-token>
+@form_vars;noquote@
+<table width=100% cellpadding=0 cellspacing=0 border=0 height=75%>
+<tr valign=top><td align=left>
+
+<include src="km-form" all_types_p="@all_types_p@" show_values_p="1" user_id="@user_id@" edit_p="1" question_ids="@question_list@" object_id="@object_id@" category_id="@category_id@" object_type_id="@object_type_id@" ancestor_id="@ancestor_object_id@">
+
+<tr valign=top><td align=left>
+</td></tr>
+<tr valign=bottom><td>
+
+ <table width=100% height=100%>
+ <tr><td align=center><strong>Save and proceed to:</strong>
+ <tr><td align=center>
+ <if @button_1@ ne "">
+ <input type="submit" name="@button_1@" value=" << ">
+ </if>
+
+ <if @button_2@ ne "">
+ <input type="submit" name="@button_2@" value="All Questions">
+ </if>
+
+ <if @button_3@ ne "">
+ <input type="submit" name="@button_3@" value="Unanswered Questions">
+ </if>
+
+ <if @button_4@ ne "">
+ <input type="submit" name="@button_4@" value="Completed Content">
+ </if>
+
+ <if @button_5@ ne "">
+ <input type="submit" name="@button_5@" value=" >> ">
+ </if>
+ </td></tr>
+ </table>
+</td></tr>
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/one-question-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/one-question-edit.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/one-question-edit.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,107 @@
+ad_page_contract {
+ /www/library/one-question-edit.tcl
+
+ Create the form for editing one question.
+
+ @cvs-id $Id: one-question-edit.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ {object_id:integer ""}
+ {question_id:integer ""}
+ {category_id ""}
+ path_id:integer,optional
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ ancestor_object_id:onevalue
+ user_id:onevalue
+ question_list:onevalue
+ object_id:onevalue
+ object_type_id:onevalue
+}
+
+if { [info exists path_id] && [empty_string_p $question_id] } {
+ # Get the path variables.
+ set values [get_path_values -action_only_p 0 $path_id]
+ set object_id [value_from_tuples $values object_id]
+ set question_id [value_from_tuples $values question_id]
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+set graphic_width [library_icon_width]
+set archived_p [km_conn archived_p]
+set admin_p [km_conn admin_p]
+set all_types_p 0
+if {$admin_p && $archived_p} {
+ set all_types_p 1
+}
+
+set question_info [km_get_question -all_types_p $all_types_p $question_id $object_type_id]
+
+if [null_p $question_info] {
+ ad_return_warning "Invalid Question ID" "
+ The given question does not exist, probably because it has been removed
+ from this object type. Please go back to the
+ <a href=\"questions?[export_url_vars object_id category_id]\">list of questions</a>."
+ return
+}
+
+set abstract_data_type [thd $question_info]
+set question_state [lindex $question_info 3]
+
+set composite_parent_id [km_composite_parent $question_id $object_type_id]
+if ![empty_string_p $composite_parent_id] {
+ ad_returnredirect "one-question-edit?[export_url_vars object_id category_id path_id]&question_id=$composite_parent_id"
+ return
+}
+
+set ancestor_object_id [fst [fst [km_get_object_ancestors $object_id]]]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Edit"
+
+set abstract_data_type [km_static question_abstract_data_type $question_id]
+
+if {[string equal $abstract_data_type "child_object"] || [string equal $abstract_data_type "nephew_object"]} {
+ db_1row check_if_answered {
+ select count(*) as answers
+ from sn_question_link_map map, sn_links l
+ where map.question_id = :question_id
+ and map.link_id = l.link_id
+ and l.object_id_a = :object_id
+ }
+ if {!$answers && ![km_static object_type_copy_p [km_static question_target_object_type_id $question_id]]} {
+ if {[string equal $abstract_data_type "child_object"]} {
+ ad_returnredirect "one-question-edit-2?[export_url_vars question_id object_id category_id path_id object_type_id]&add_child.$question_id"
+ return
+ }
+ if {[string equal $abstract_data_type "nephew_object"]} {
+ ad_returnredirect "one-question-edit-2?[export_url_vars question_id object_id category_id path_id object_type_id]&add_nephew.$question_id"
+ return
+ }
+ }
+}
+
+set title "$pretty_type: Edit $object_name"
+set form_vars [export_form_vars question_id object_id category_id path_id object_type_id parent_object_id uncle_object_id]
+
+set question_list [list $question_id]
+
+set buttons [km8_button_panel $question_id $object_id $object_type_id]
+
+set button_1 [lindex $buttons 0]
+set button_2 [lindex $buttons 1]
+set button_3 [lindex $buttons 2]
+set button_4 [lindex $buttons 3]
+set button_5 [lindex $buttons 4]
+
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/owner-change-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/owner-change-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/owner-change-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,68 @@
+ad_page_contract {
+ /packages/library/www/owner-change-2.tcl
+
+ Change the ownership of an object.
+
+ @cvs-id $Id: owner-change-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ user_id_from_search:notnull,integer
+ {still_access_p:boolean "f"}
+ {reason ""}
+ {page_url:notnull}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+if {![km_check_object_id $object_id]} { return }
+if ![km_check_owner_change $object_id] { return }
+
+set author_id [km_conn original_author_id]
+
+# Everything seems fine. Now we can put the old owner on the access list.
+
+db_transaction {
+
+ if { $still_access_p == "f" } {
+ # Revoke permissions for old owner.
+ db_exec_plsql revoke_old_owner {
+ begin
+ acs_permission.revoke_permission(:object_id, :author_id, 'read');
+ acs_permission.revoke_permission(:object_id, :author_id, 'write');
+ acs_permission.revoke_permission(:object_id, :author_id, 'delete');
+ end;
+ }
+ }
+
+ # Grant permissions to the new owner.
+ db_exec_plsql grant_new_owner {
+ begin
+ acs_permission.grant_permission(:object_id, :user_id_from_search, 'read');
+ acs_permission.grant_permission(:object_id, :user_id_from_search, 'write');
+ acs_permission.grant_permission(:object_id, :user_id_from_search, 'delete');
+ end;
+ }
+
+ # And now we update the owner
+ db_dml update_owner {
+ update sn_objects
+ set original_author_id = :user_id_from_search
+ where object_id = :object_id
+ }
+
+ db_dml update_owner {
+ update acs_objects
+ set creation_user = :user_id_from_search
+ where object_id = :object_id
+ }
+
+ # Log owner change
+ db_dml log_change {
+ insert into sn_owner_history
+ (object_id, change_user_id, old_user_id, new_user_id, change_date, reason)
+ values
+ (:object_id, :user_id, :author_id, :user_id_from_search, sysdate, :reason)
+ }
+}
+
+ad_returnredirect $page_url
Index: openacs-4/contrib/obsolete-packages/library/www/owner-change.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/owner-change.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/owner-change.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,45 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+Currently @owner_name;noquote@ owns this object.
+
+<p>Locate the new owner:
+
+<form method="get" action="user-search">
+@form_vars;noquote@
+
+<table border=0>
+<tr><td align="right">Email address / surname contains:</td>
+<td><input type=text name=keyword size=40></td></tr>
+<tr><td>Still allow current owner access ?:</td>
+ <td><input type=checkbox name="still_access_p" value="t" checked></td></tr>
+<tr><td align="right">Reason for owner change:</td>
+<td><textarea name=reason rows=5 cols=60 maxsize=3999 wrap=soft></textarea></td></tr>
+<tr><td colspan=2 align="center"><input type=submit value="Search"></td></tr>
+
+</table>
+</form>
+
+<if @history:rowcount@ gt 0>
+<p>Current owner history:
+<table>
+ <tr>
+ <th>Changed by</th>
+ <th>Changed from</th>
+ <th>Changed to</th>
+ <th>Changed on</th>
+ <th>Reason</th>
+ </tr>
+<multiple name="history">
+ <tr>
+ <td>@history.ch_by;noquote@</td>
+ <td>@history.ch_from;noquote@</td>
+ <td>@history.ch_to;noquote@</td>
+ <td>@history.ch_date@</td>
+ <td>@history.ch_reason@</td>
+ </tr>
+</multiple>
+</table>
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/owner-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/owner-change.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/owner-change.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,67 @@
+ad_page_contract {
+ /www/library/owner-change.tcl
+
+ Let the user search for the new object owner.
+
+ @cvs-id $Id: owner-change.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+} -properties {
+ title:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ form_vars:onevalue
+ owner_name:onevalue
+ history:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if {![km_check_object_id $object_id]} { return }
+if {![km_check_owner_change $object_id]} { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]w
+set graphic [km_static object_type_graphic $object_type_id]
+set graphic_width [library_icon_width]
+
+set author_name [km_conn original_author_name]
+set author_id [km_conn original_author_id]
+
+set target "owner-change-2"
+set passthrough {object_id category_id still_access_p reason page_url}
+set page_url "object-view?object_id=$object_id&category_id=$category_id"
+
+set title "Change Owner for $object_name"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Change owner"
+
+set context_bar [list "owner-change?[export_url_vars object_id category_id]" "Change owner"]
+if {[ad_conn user_id] == $author_id} {
+ set show_myself_p f
+} else {
+ set show_myself_p t
+}
+set form_vars [export_form_vars target passthrough object_id category_id context_bar show_myself_p page_url]
+set owner_name [ad_present_user $author_id $author_name]
+
+
+template::multirow create history ch_by ch_from ch_to ch_date ch_reason
+db_foreach get_owner_history {
+ select change_user_id, u1.first_names||' '||u1.last_name as change_user_name,
+ old_user_id, u2.first_names||' '||u2.last_name as old_user_name,
+ new_user_id, u3.first_names||' '||u3.last_name as new_user_name,
+ change_date, reason
+ from sn_owner_history h, users u1, users u2, users u3
+ where h.object_id = :object_id
+ and change_user_id = u1.user_id
+ and old_user_id = u2.user_id
+ and new_user_id = u3.user_id
+ order by change_date
+} {
+ template::multirow append history "[ad_present_user $change_user_id $change_user_name]" "[ad_present_user $old_user_id $old_user_name]" "[ad_present_user $new_user_id $new_user_name]" "$change_date" "$reason"
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/private-group-create.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/private-group-create.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/private-group-create.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,43 @@
+ad_page_contract {
+ /packages/library/www/private-group-create.tcl
+
+ @cvs-id $Id: private-group-create.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+ group_name:notnull
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if { [db_string check_if_exists {
+ select decode(count(*),0,0,1) from dual where exists
+ (select 1
+ from groups g, acs_objects o
+ where lower(g.group_name) = lower(:group_name)
+ and o.object_id = g.group_id
+ and o.object_type = 'private_group'
+ and o.creation_user = :user_id)}] } {
+ ad_return_complaint 1 "<li>You already have defined a private group with that name."
+ return
+}
+
+set peeraddr [ns_conn peeraddr]
+
+# Create private group, and allow its members to view and edit
+# the knowledge object. Grant admin rights for this group
+# to the current user.
+
+set group_id [db_exec_plsql create_group {
+ begin
+ :1 := private_group.new(
+ group_name => :group_name,
+ creation_user => :user_id,
+ creation_ip => :peeraddr,
+ join_policy => 'closed');
+ acs_permission.grant_permission(:1, :user_id, 'admin');
+ end;
+}]
+
+ad_returnredirect "object-access-add?[export_url_vars object_id category_id group_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/publisher-change-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/publisher-change-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/publisher-change-2.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,40 @@
+ad_page_contract {
+ /packages/library/www/publisher-change-2.tcl
+
+ Change the publisher of an object.
+
+ @cvs-id $Id: publisher-change-2.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ user_id_from_search:notnull,integer
+ {page_url:notnull}
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if {![km_check_object_id $object_id]} { return }
+if {![ad_permission_p -user_id $user_id_from_search $package_id km_publish]} {
+ ad_return_complaint 1 "The new publisher has to have the publish permission."
+ return
+}
+
+set publisher_id [km_conn publisher_id]
+set admin_p [km_conn admin_p]
+set publish_p [km_conn publish_p]
+
+if {!$admin_p && !$publish_p && $publisher_id != $user_id} {
+ ad_return_complaint 1 "Not sufficient permissions."
+ return
+}
+
+# Everything seems fine.
+
+# Update the publisher
+db_dml update_publisher {
+ update sn_objects
+ set publisher_id = :user_id_from_search
+ where object_id = :object_id
+}
+
+ad_returnredirect $page_url
Index: openacs-4/contrib/obsolete-packages/library/www/publisher-change.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/publisher-change.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/publisher-change.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,19 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+Currently @publisher_name;noquote@ is the publisher of this object.
+
+<p>Locate the new publisher:
+
+<form method="get" action="user-search">
+@form_vars;noquote@
+
+<table border=0>
+<tr><td align="right">Email address / surname contains:</td>
+<td><input type=text name=keyword size=40></td></tr>
+<tr><td colspan=2 align="center"><input type=submit value="Search"></td></tr>
+
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/publisher-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/publisher-change.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/publisher-change.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,61 @@
+ad_page_contract {
+ /www/library/publisher-change.tcl
+
+ Let the user search for the new object publisher.
+
+ @cvs-id $Id: publisher-change.tcl,v 1.1 2003/07/02 12:19:43 peterm Exp $
+} {
+ object_id:notnull,integer
+ {category_id ""}
+} -properties {
+ title:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ form_vars:onevalue
+ publisher_name:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+if {![km_check_object_id $object_id]} { return }
+
+set object_name [km_conn object_name]
+set object_type_id [km_conn object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]w
+set graphic [km_static object_type_graphic $object_type_id]
+set graphic_width [library_icon_width]
+set admin_p [km_conn admin_p]
+set publish_p [km_conn publish_p]
+set publisher_id [km_conn publisher_id]
+
+if {!$admin_p && !$publish_p && $publisher_id != $user_id} {
+ ad_return_complaint 1 "Not sufficient permissions."
+ return
+}
+
+db_1row get_publisher_name {
+ select first_names || ' ' || last_name as publisher_name
+ from users
+ where user_id = :publisher_id
+}
+
+set target "publisher-change-2"
+set passthrough {object_id category_id still_access_p reason page_url}
+set page_url "object-view?object_id=$object_id&category_id=$category_id"
+set extra_permission "km_publish"
+set extra_package_id $package_id
+
+set title "Change Publisher for $object_name"
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Change publisher"
+
+set context_bar [list "publisher-change?[export_url_vars object_id category_id]" "Change publisher"]
+if {$user_id == $publisher_id} {
+ set show_myself_p f
+} else {
+ set show_myself_p t
+}
+set form_vars [export_form_vars target passthrough object_id category_id context_bar show_myself_p page_url extra_permission extra_package_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-category.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-category.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-category.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,19 @@
+<if @read_only_p@ eq t>
+ <table><tr><td>
+ <table cellpadding=5 cellspacing=1 border=1><tr><td bgcolor="white">@formatted_value;noquote@</td></tr></table></td></tr>
+ <tr><td align="center"><include src="km-submit-button" value="Delete" name="delete.@question_id@"></td></tr></td></table>
+</if>
+<else>
+ <if @presentation_type@ eq "select">
+ <include src="km-select-tag" default="@default_value@" multiple_p="0" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@" empty_tag="--None--" mandatory_p="@mandatory_p@">
+ </if>
+ <if @presentation_type@ eq "selectmultiple">
+ <include src="km-select-tag" default="@default_value@" multiple_p="1" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@">
+ </if>
+ <if @presentation_type@ eq "checkbox">
+ <include src="km-checkbox-tag" default="@default_value@" multiple_p="1" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@">
+ </if>
+ <if @presentation_type@ eq "radio">
+ <include src="km-radio-tag" default="@default_value@" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@" empty_tag="None" mandatory_p="@mandatory_p@">
+ </if>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-category.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-category.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,54 @@
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists default_value]} {
+ set default_value ""
+}
+
+if {![info exists height]} {
+ set height ""
+}
+
+if {![info exists width]} {
+ set width ""
+}
+
+if {![info exists items]} {
+ set items {}
+}
+
+if {![info exists item_values]} {
+ set item_values {}
+}
+
+if {![info exists html_p]} {
+ set html_p 0
+}
+
+if {![info exists mandatory_p]} {
+ set mandatory_p f
+}
+
+if {![empty_string_p $value]} {
+ set default_value $value
+}
+if { $question_state == "read-only" && ! [km_conn admin_p]} {
+ set read_only_p t
+ switch $presentation_type {
+ "select" -
+ "radio" {
+ set formatted_value [lindex $items [lsearch $item_values $default_value]]
+ }
+ "selectmultiple" -
+ "checkbox" {
+ set selected_items {}
+ foreach value $default_value {
+ lappend selected_items [lindex $items [lsearch $item_values $value]]
+ }
+ set formatted_value [join $selected_items ", "]
+ }
+ }
+} else {
+ set read_only_p f
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-child-object.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-child-object.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-child-object.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,15 @@
+<table>
+<if @children@ ne "">
+ <tr><td>
+ <include src="km-display-child-object" edit_p="@edit_p@" question_state="@question_state@" question_id="@question_id@" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" children="@children@">
+ </td></tr>
+</if>
+<if @show_button_p@ eq t>
+ <tr><td>
+ <input type="submit" name="add_child.@question_id@" value="Add a @child_object_type@">
+ <if @copy_p@ eq 1>
+ <input type="submit" name="copy_child.@question_id@" value="Copy @child_object_type_plural@">
+ </if>
+ </td></tr>
+</if>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-child-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-child-object.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-child-object.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,23 @@
+# Displays child object types
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+set user_id [ad_get_user_id]
+set children [map km_get_object_summary [km_get_child_objects $object_id $question_id]]
+
+if { $question_state != "read-only" || [km_conn admin_p] } {
+ set show_button_p t
+ set child_object_type_id [km_static question_target_object_type_id $question_id]
+ set child_object_type_plural [km_static object_type_pretty_plural $child_object_type_id]
+ set copy_p [km_static object_type_copy_p $child_object_type_id]
+ set child_object_type [km_static object_type_pretty_name $child_object_type_id]
+} else {
+ set show_button_p f
+}
+
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-composite.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-composite.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-composite.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,6 @@
+<if @child_ids@ ne "">
+ <include src="km-form" fields_only_p="1" question_ids="@child_ids@" show_values_p="@show_values_p@" object_id="@object_id@" category_id="@category_id@" edit_p="@edit_p@" children="@child_ids@">
+</if>
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-composite.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-composite.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-composite.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,20 @@
+# Returns a composite field- i.e. a field made up of more than one question.
+
+if {![info exists show_values_p]} {
+ set show_values_p 1
+}
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists object_id]} {
+ set object_id 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+set child_ids [km_get_child_questions $question_id]
+
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-content-link.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-content-link.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-content-link.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,15 @@
+<table cellspacing=0 cellpadding=0 width=100%>
+
+<if @question_state@ ne "read-only" or @admin_p@ eq 1>
+ <tr><td>
+ <p><a href="linking/?community_id=@community_id@&source_id=@object_id@&pass=@pass;noquote@">Link to community content</a></td></tr>
+ <tr><td> </td></tr>
+</if>
+
+
+<if @existing_links@ ne "">
+ <include src="km-content-link-table" edit_p="@edit_p@" object_id="@object_id@" category_id="@category_id@" question_id="@question_id@" existing_links="@existing_links;noquote@">
+</if>
+
+
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-content-link.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-content-link.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-content-link.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,47 @@
+# Displays this field for a form field.
+# Lists all of the existing links between ACS content and this
+# object. Shows the button that leads to content linking excursion.
+
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists size]} {
+ set size 30
+}
+
+if {![info exists maxlength]} {
+ set maxlength 50
+}
+
+if {![info exists hit_database_p]} {
+ set hit_database_p 1
+}
+
+if [empty_string_p $value] { set value "Link" }
+
+set return_url "one-question-edit?[export_url_vars object_id question_id category_id]"
+set path_vars [list question_id $question_id object_id $object_id category_id $category_id]
+set path_id [init_path $path_vars $return_url add_content_ref]
+set admin_p [km_conn admin_p]
+
+if { $question_state != "read-only" || [km_conn admin_p] } {
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set community_id $node(package_id)
+}
+
+if { $hit_database_p } {
+ set existing_links [km8_get_to_links $object_id $question_id]
+ set pass [ns_urlencode "$path_id:exclude [map fst $existing_links]"]
+} else {
+ set existing_links {}
+ set pass $path_id
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-date.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-date.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-date.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,9 @@
+<if @read_only_p@ eq t>
+ <table><tr><td>
+ <table cellpadding=5 cellspacing=1 border=1><tr><td bgcolor="white">@formatted_value;noquote@</td></tr></table></td></tr>
+ <tr><td align="center"><input type="submit" name="delete.@question_id@" value="Delete"></td></tr></td></table>"
+</if>
+<else>
+ <include src="km-date-tag" day_value="@day_value@" month_value="@month_value@" year_value="@year_value@" presentation_type="@presentation_type@" question_id="@question_id@" name="@question_id@">
+ <input type="submit" name="delete.@question_id@" value="Delete">
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-date.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-date.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,31 @@
+# Displays a date field. It knows what default dates it should use for
+# different object types that have dates.
+
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists object_type_id]} {
+ set object_type_id 0
+}
+
+if {!$object_type_id} {
+ set object_type_id [km_get_object_type $object_id]
+}
+
+if {![empty_string_p $value]} {
+ if { $question_state == "read-only" && ![km_conn admin_p] } {
+ set read_only_p t
+ set formatted_value [util_AnsiDatetoPrettyDate $value]
+ } else {
+ #break it up into form tag boxes
+ set read_only_p f
+ set date [km_break_date $value]
+ util_unlist $date year_value month_value day_value
+ }
+} else {
+ set read_only_p f
+ set date [km_default_date $question_id]
+ util_unlist $date year_value month_value day_value
+}
+
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-file.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-file.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-file.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,21 @@
+<if @value@ ne "">
+ <p>The current file was retrieved from
+ <include src="km-display-file" client_filename="@value@" object_id="@object_id@" question_id="@question_id@"><br>
+
+ <if @question_state@ ne "read-only" or @admin_p@ eq 1>
+ To overwrite it with a new file, enter the filename below.
+ <if @may_delete_p@ eq 1>
+ <br>You may also <a href="file-delete?@url_vars;noquote@">remove</a> the file.
+ </if>
+ </if>
+ <else>
+ Since the question is read-only, you may only
+ <a href="file-delete?@url_vars;noquote@">remove</a>
+ the file.
+ </else>
+</if>
+</p>
+<if @question_state@ ne "read-only" or @admin_p@ eq 1>
+ <input type="file" size="@size@" maxlength="@maxlength@" name="@question_id@" value="@value@">
+</if>
+
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-file.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-file.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-file.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,42 @@
+# Returns an file tag with a value optional
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists size]} {
+ set size 60
+}
+
+if {![info exists maxlength]} {
+ set maxlength 255
+}
+
+
+set return_page [ns_conn url]
+set parent_question_id [ns_set get [ns_conn form] question_id]
+
+if { $question_id == $parent_question_id } {
+ set parent_question_id 0
+}
+
+set admin_p [km_conn admin_p]
+
+set url_vars [export_url_vars object_id category_id question_id parent_question_id return_page]
+
+if ![empty_string_p $value] {
+
+ regsub -all {[^-_.0-9a-zA-Z]+} $value "_" url_filename
+
+ if { ![string equal $question_state "read-only"] || !$admin_p } {
+ if { $object_id && ![km_is_required -object_id $object_id $question_id] } {
+ set may_delete_p 1
+ } else {
+ set may_delete_p 0
+ }
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-integer.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-integer.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-integer.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,10 @@
+<if @read_only_p@ eq t>
+ <table><tr><td>
+ <table cellpadding=5 cellspacing=1 border=1><tr><td bgcolor="white">@formatted_value;noquote@</td></tr></table></td></tr>
+ <tr><td align="center"><include src="km-submit-button" value="Delete" name="delete.@question_id@"></td></tr></td></table>
+</if>
+<else>
+ <if @presentation_type@ eq "shorttext">
+ <include src="km-input-tag" value="@default_value@" size="@width@" name="@question_id@">
+ </if>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-integer.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-integer.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-integer.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,27 @@
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists default_value]} {
+ set default_value ""
+}
+
+if {![info exists height]} {
+ set height ""
+}
+
+if {![info exists width]} {
+ set width ""
+}
+
+if ![empty_string_p $value] {
+ # A real value from the data is more important than the standard default value.
+ set default_value $value
+}
+
+if { $question_state == "read-only" && ! [km_conn admin_p] } {
+ set read_only_p t
+ set formatted_value [util_make_href_and_mailto_links_and_convert_to_html $default_value]
+} else {
+ set read_only_p f
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-nephew-object.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-nephew-object.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-nephew-object.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,13 @@
+<table>
+<if @nephews@ ne "">
+ <tr><td><include src="km-display-nephew-object" edit_p="@edit_p@" question_state="@question_state@" question_id="@question_id@" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" nephews="@value@"></td></tr>
+</if>
+<if @show_button_p@ eq t>
+ <tr><td>
+ <input type="submit" name="add_nephew.@question_id@" value="Add a @pretty_name@">
+ <if @copy_p@ eq 1>
+ <input type="submit" name="copy_nephew.@question_id@" value="Copy @pretty_plural@">
+ </if>
+ </td></tr>
+</if>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-nephew-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-nephew-object.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-nephew-object.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,22 @@
+# Displays nephew object types
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+set user_id [ad_get_user_id]
+set nephews [map km_get_object_summary [km_get_nephew_objects $object_id $question_id]]
+
+if { $question_state != "read-only" || [km_conn admin_p] } {
+ set show_button_p t
+ set nephew_object_type_id [km_static question_target_object_type_id $question_id]
+ set pretty_plural [km_static object_type_pretty_plural $nephew_object_type_id]
+ set copy_p [km_static object_type_copy_p $nephew_object_type_id]
+ set pretty_name [km_static object_type_pretty_name $nephew_object_type_id]
+} else {
+ set show_button_p f
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-object-link.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-object-link.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-object-link.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,20 @@
+<table cellspacing=0 cellpadding=0 width=100%>
+
+<if @read_only_p@ eq f>
+ <tr><td align="center" width="6%" valign="middle"><include src="km-object-type-img" graphic="@graphic@"> </td>
+ <td align=left>
+ <table border=0 cellspacing=3 cellpadding=3>
+ <tr><td bgcolor="#F0F0F0">
+ <p><a href="linking/?community_id=@community_id@&source_id=@object_id@&pass=@pass;noquote@">Link to another @pretty_type@</a></td></tr>
+ </td></tr>
+ </table>
+ </td></tr>
+
+</if>
+
+<tr><td colspan=2> </td></tr>
+<tr><th align=left colspan=2>Existing links to @pretty_plural@<br></th></tr>
+<tr><td colspan=2><include src="km-linked-object-list" edit_links_p="@edit_links_p@" delete_links_p=1 return_url="@return_url;noquote@" question_id="@question_id@" user_id="@user_id@" object_id="@object_id@" category_id="@category_id@" linked_object_list="@linked_objects;noquote@">
+</td></tr>
+<tr><td colspan=2> </td></tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-object-link.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-object-link.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-object-link.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,56 @@
+# Displays the form field for a linking question: all already linked objects
+# and the possibility to add new links.
+
+if {![info exists path_id]} {
+ set path_id ""
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists return_url]} {
+ set return_url ""
+}
+
+if {![info exists hit_database_p]} {
+ set hit_database_p 1
+}
+
+set field ""
+util_unlist [km_link_question_attributes $question_id] \
+ object_type_id pretty_type pretty_plural graphic
+
+set edit_links_p [ad_decode $question_state "read-only" 0 1]
+
+
+# Sometimes we are called from places such as admin pages where there are
+# no linked objects because there is no object_id ...
+
+set linked_object_ids {}
+if { $object_id } {
+ set linked_objects [km_get_linked_objects -question_id $question_id -from_p 1 $user_id $object_id]
+
+ set linked_object_id_ix [lsearch [head $linked_objects] linked_object_id]
+ foreach item [tail $linked_objects] {
+ lappend linked_object_ids [lindex $item $linked_object_id_ix]
+ }
+
+} else {
+ set linked_objects ""
+}
+
+if { $question_state != "read-only" || [km_conn admin_p] } {
+ set target_object_type_id \
+ [db_string km_content_link_field_10 \
+ {select target_object_type_id
+ from sn_questions
+ where question_id=:question_id}]
+
+ array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+ set community_id $node(package_id)
+ set read_only_p f
+ set pass [ns_urlencode "$path_id:restriction${target_object_type_id}:exclude $linked_object_ids"]
+} else {
+ set read_only_p t
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-option.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-option.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-option.adp 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,19 @@
+<if @read_only_p@ eq t>
+ <table><tr><td>
+ <table cellpadding=5 cellspacing=1 border=1><tr><td bgcolor="white">@formatted_value;noquote@</td></tr></table></td></tr>
+ <tr><td align="center"><include src="km-submit-button" value="Delete" name="delete.@question_id@"></td></tr></td></table>
+</if>
+<else>
+ <if @presentation_type@ eq "select">
+ <include src="km-select-tag" default="@default_value@" multiple_p="0" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@" empty_tag="--None--" mandatory_p="@mandatory_p@">
+ </if>
+ <if @presentation_type@ eq "selectmultiple">
+ <include src="km-select-tag" default="@default_value@" multiple_p="1" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@">
+ </if>
+ <if @presentation_type@ eq "checkbox">
+ <include src="km-checkbox-tag" default="@default_value@" multiple_p="1" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@">
+ </if>
+ <if @presentation_type@ eq "radio">
+ <include src="km-radio-tag" default="@default_value@" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@" empty_tag="None" mandatory_p="@mandatory_p@">
+ </if>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-option.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-option.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-option.tcl 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,54 @@
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists default_value]} {
+ set default_value ""
+}
+
+if {![info exists height]} {
+ set height ""
+}
+
+if {![info exists width]} {
+ set width ""
+}
+
+if {![info exists items]} {
+ set items {}
+}
+
+if {![info exists item_values]} {
+ set item_values {}
+}
+
+if {![info exists html_p]} {
+ set html_p 0
+}
+
+if {![info exists mandatory_p]} {
+ set mandatory_p f
+}
+
+if {![empty_string_p $value]} {
+ set default_value $value
+}
+if { $question_state == "read-only" && ! [km_conn admin_p]} {
+ set read_only_p t
+ switch $presentation_type {
+ "select" -
+ "radio" {
+ set formatted_value [lindex $items [lsearch $item_values $default_value]]
+ }
+ "selectmultiple" -
+ "checkbox" {
+ set selected_items {}
+ foreach value $default_value {
+ lappend selected_items [lindex $items [lsearch $item_values $value]]
+ }
+ set formatted_value [join $selected_items ", "]
+ }
+ }
+} else {
+ set read_only_p f
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-other-category.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-other-category.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-other-category.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,23 @@
+<if @read_only_p@ eq t>
+ <table><tr><td>
+ <table cellpadding=5 cellspacing=1 border=1><tr><td bgcolor="white">@formatted_value;noquote@</td></tr></table></td></tr>
+ <tr><td align="center"><include src="km-submit-button" value="Delete" name="delete.@question_id@"></td></tr></td></table>
+</if>
+<else>
+ <if @presentation_type@ eq "select">
+ <include src="km-select-tag" default="@default_value@" multiple_p="0" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@" empty_tag="--None--" mandatory_p="@mandatory_p@">
+ </if>
+ <if @presentation_type@ eq "selectmultiple">
+ <include src="km-select-tag" default="@default_value@" multiple_p="1" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@">
+ </if>
+ <if @presentation_type@ eq "checkbox">
+ <include src="km-checkbox-tag" default="@default_value@" multiple_p="1" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@">
+ </if>
+ <if @presentation_type@ eq "radio">
+ <include src="km-radio-tag" default="@default_value@" size="@height@" values="@item_values@" name="@question_id@" items="@items;noquote@" empty_tag="None" mandatory_p="@mandatory_p@">
+ </if>
+ <br>
+ If you have chosen "Other" please specify.
+ <br>
+ <input type="text" size="@other_size@" maxlength="@other_maxlength@" name="@question_id@_other" value="@other_value@">
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-other-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-other-category.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-other-category.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,78 @@
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists default_value]} {
+ set default_value ""
+}
+
+if {![info exists height]} {
+ set height ""
+}
+
+if {![info exists width]} {
+ set width ""
+}
+
+if {![info exists items]} {
+ set items {}
+}
+
+if {![info exists item_values]} {
+ set item_values {}
+}
+
+if {![info exists html_p]} {
+ set html_p 0
+}
+
+if {![info exists other_value]} {
+ set other_value ""
+}
+
+if {![info exists other_size]} {
+ set other_size 40
+}
+
+if {![info exists other_maxlength]} {
+ set other_maxlength 1000
+}
+
+if {![info exists mandatory_p]} {
+ set mandatory_p f
+}
+
+if {![info exists other_value]} {
+ set other_value ""
+}
+
+if {![empty_string_p $value]} {
+ set default_value $value
+}
+
+if { $question_state == "read-only" && ! [km_conn admin_p]} {
+ set read_only_p t
+ switch $presentation_type {
+ "select" -
+ "radio" {
+ set formatted_value [lindex $items [lsearch $item_values $default_value]]
+ if { [string equal [string toupper $formatted_value] "OTHER"] && ![empty_string_p $other_value] } {
+ append formatted_value " ($other_value)"
+ }
+ }
+ "selectmultiple" -
+ "checkbox" {
+ set selected_items {}
+ foreach value $default_value {
+ set selected_value [lindex $items [lsearch $item_values $value]]
+ if { [string equal [string toupper $selected_value] "OTHER"] && ![empty_string_p $other_value] } {
+ append selected_value " ($other_value)"
+ }
+ lappend selected_items $selected_value
+ }
+ set formatted_value [join $selected_items ", "]
+ }
+ }
+} else {
+ set read_only_p f
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-text.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-text.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-text.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,19 @@
+<if @read_only_p@ eq f>
+ <if @presentation_type@ eq "shorttext">
+ <include src="km-input-tag" value="@default_value;noquote@" size="@width@" name="@question_id@">
+ </if>
+
+ <if @presentation_type@ eq "textarea">
+ <include src="km-textarea-tag" value="@default_value;noquote@" cols="@width@" rows="@height@" name="@question_id@"></p><p><include src="km-text-select" name="@question_id@" html_p="@html_p@">
+ </if>
+
+ <if @presentation_type@ eq "textarea_with_refs">
+ <include src="km-textarea-tag" value="@default_value;noquote@" cols="@width@" rows="@height@" name="@question_id@">
+ <include src="km-ref-buttons" question_id="@question_id@" html_p="@html_p@">
+ </if>
+</if>
+<else>
+ <table><tr><td>
+ <table cellpadding=5 cellspacing=1 border=1><tr><td bgcolor="white">@formatted_value;noquote@</td></tr></table></td></tr>
+ <tr><td align="center"><include src="km-submit-button" value="Delete" name="delete.@question_id@"></td></tr></td></table>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-text.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-text.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-text.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,41 @@
+if {![info exists value]} {
+ set value ""
+}
+
+if {![info exists default_value]} {
+ set default_value ""
+}
+
+if {![info exists height]} {
+ set height ""
+}
+
+if {![info exists width]} {
+ set width ""
+}
+
+if {![info exists items]} {
+ set items {}
+}
+
+if {![info exists item_values]} {
+ set item_values {}
+}
+
+if {![info exists html_p]} {
+ set html_p 0
+}
+
+if {![empty_string_p $value]} {
+ set default_value $value
+}
+if { $question_state != "read-only" || [km_conn admin_p] } {
+ set read_only_p f
+} else {
+ set read_only_p t
+ if {$html_p} {
+ set formatted_value [util_make_href_and_mailto_links $default_value]
+ } else {
+ set formatted_value [util_make_href_and_mailto_links_and_convert_to_html $default_value]
+ }
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-user-link.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-user-link.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-user-link.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,11 @@
+<table cellspacing=0 cellpadding=0 width=100%>
+
+<if @question_state@ ne "read-only" or @admin_p@ eq 1>
+ <tr><td><a name="user_link"><include src="km-input-tag" size="30" name="user_link.@question_id@">
+ <include src="km-submit-button" value="@value@" name="add_user_ref.@question_id@"></a></td></tr>
+ <tr><td> </td></tr>
+ <if @existing_links@ ne "">
+ <include src="km-user-link-table" edit_p="@edit_p@" object_id="@object_id@" category_id="@category_id@" question_id="@question_id@" existing_links="@existing_links@">
+ </if>
+</if>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/question-field-user-link.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-field-user-link.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-field-user-link.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,35 @@
+# Displays this field for a form field.
+# Lists all of the existing links between users and this
+# object. Shows the button that leads to user linking excursion.
+
+if {![info exists edit_p]} {
+ set edit_p 0
+}
+
+if {![info exists category_id]} {
+ set category_id ""
+}
+
+if {![info exists hit_database_p]} {
+ set hit_database_p 1
+}
+
+if {![info exists admin_p]} {
+ set admin_p [km_conn admin_p]
+}
+
+set value "Link to a"
+
+# If the first letter of the system name is a vowel,
+# we have to use "an" instead of "a".
+set first_letter [string index [string tolower [km_get_community_name]] 0]
+if { [string first $first_letter "aeiou"] != -1 } {
+ append value "n"
+}
+append value " [km_get_community_name] User"
+
+if { $hit_database_p } {
+ set existing_links [km8_get_to_links $object_id $question_id]
+} else {
+ set existing_links {}
+}
Index: openacs-4/contrib/obsolete-packages/library/www/question-state.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-state.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-state.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,9 @@
+<if @question_state@ eq "deprecated">
+ <SCRIPT LANGUAGE="JavaScript" SRC="js/OpenGuidelines.js" TYPE="text/javascript"></SCRIPT>
+ (<a href="javascript:OpenGuidelines("questionState.htm")">@pretty_question_state@</a>)"
+</if>
+
+<if @question_state@ eq "read-only">
+ <SCRIPT LANGUAGE="JavaScript" SRC="js/OpenGuidelines.js" TYPE="text/javascript"></SCRIPT>
+ (<a href="javascript:OpenGuidelines("questionState.htm")">@pretty_question_state@</a>)"
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/question-state.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/question-state.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/question-state.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1 @@
+set pretty_question_state [km_pretty_question_state $question_state]
Index: openacs-4/contrib/obsolete-packages/library/www/questions.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/questions.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/questions.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,55 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+<include src="object-view-toolbar" child_p="@child_p@" object_id="@object_id@" category_id="@category_id@" default="@view_questions@">
+<hr>
+
+<if @view_questions@ eq "all">
+<img src="graphics/check.gif" width=16 height=16> = Answered
+<img src="graphics/check-gray.gif" width=16 height=16> = Partly answered
+X = @question_state_deprecated;noquote@ or @question_state_read_only;noquote@<br>
+</if>
+
+<img width=13 height=9 src="graphics/arrow.gif"> = Reference to other knowledge objects
+
+* = Mandatory for publication
+<font size=+1>...</font> = More details (drilldown)
+
+<p><table cellspacing=2 cellpadding=2>
+
+<if @view_questions@ eq "all" or @view_questions@ eq answered>
+ <tr><td>@check_img;noquote@</td><td align=left>
+ <if @change_owner_p@ eq 1>
+ <a href="owner-change?object_id=@object_id@&category_id=@category_id@">Owner</a>
+ </if><else>Owner</else>
+ </td><td><a href="../users/yp?user_id=@author_id@">@author_name@</a></td></tr>
+
+ <if @publisher_id@ not nil>
+ <tr><td>@check_img;noquote@</td><td align=left>
+ <if @change_publisher_p@ eq 1>
+ <a href="publisher-change?object_id=@object_id@&category_id=@category_id@">Publisher</a>
+ </if><else>Publisher</else>
+ </td><td><a href="../users/yp?user_id=@publisher_id@">@publisher_name@</a></td></tr>
+ </if>
+</if>
+
+<if @child_p@ eq 1>
+ <tr><td>@check_img;noquote@</td><td align=left><a href="object-view?object_id=@ancestor_object_id@">@ancestor_object_type@</a></td><td><a href="object-view?object_id=@ancestor_object_id@">@ancestor_name@</a><if @ancestor_public_p@ eq 0> <font color=red>[Private]</font></if><if @ancestor_archived_p@ eq 1> <font color=red>[Archived]</font></if><if @ancestor_review_p@ eq 1> <font color=green>[In review]</font></if></td></tr>
+</if>
+
+ <multiple name="questions">
+ <tr>
+ <td align=right>@questions.check;noquote@</td>
+ <td><a href="@questions.destination_url@">@questions.question_name@</a>@questions.star;noquote@ @questions.arrow;noquote@ @questions.dots;noquote@</td>
+<td>@questions.short_explanation;noquote@</td></tr>
+ </multiple>
+
+</table><p><hr>
+
+<if @questions:rowcount@ gt 4>
+ <include src="object-view-toolbar" child_p="@child_p@" object_id="@object_id@" category_id="@category_id@" default="@view_questions@"><p>
+</if>
+
+@object_access_toolbar;noquote@
Index: openacs-4/contrib/obsolete-packages/library/www/questions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/questions.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/questions.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,362 @@
+ad_page_contract {
+ /www/library/questions.tcl
+
+ Let the user edit an object. Display all or only the unanswered questions.
+
+ @cvs-id $Id: questions.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_id:notnull,integer
+ {path_id:integer ""}
+ {view_questions all}
+ {category_id ""}
+} -properties {
+ title:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ question_state_deprecated:onevalue
+ question_state_read_only:onevalue
+ view_question:onevalue
+ object_id:onevalue
+ author_id:onevalue
+ author_name:onevalue
+ questions:multirow
+ child_p:onevalue
+ object_access_toolbar:onevalue
+ public_p:onevalue
+ pretty_type_name:onevalue
+ create_p:onevalue
+ public_p:onevalue
+ pretty_type_name:onevalue
+ user_id:onevalue
+ admin_p:onevalue
+ ancestor_name:onevalue
+ ancestor_object_type:onevalue
+ ancestor_object_id:onevalue
+ ancestor_public_p:onevalue
+ ancestor_archived_p:onevalue
+ ancestor_review_p:onevalue
+ publisher_id:onevalue
+ publisher_name:onevalue
+ change_owner_p:onevalue
+ change_publisher_p:onevalue
+ ot_create_p:onevalue
+ ot_copy_p:onevalue
+ ot_archive_p:onevalue
+ review_p:onevalue
+ task_id:onevalue
+ archived_p:onevalue
+ approval_p:onevalue
+ review_state:onevalue
+ delete_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+set dots ""
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set object_type_id [km_conn object_type_id]
+set object_name [km_conn object_name]
+set create_p [km_conn create_p]
+set public_p [km_conn public_p]
+set admin_p [km_conn admin_p]
+set publish_p [km_conn publish_p]
+set delete_p [km_conn delete_p]
+set archived_p [km_conn archived_p]
+set edit_p [km_conn write_p]
+set review_p [km_conn in_review_p]
+set review_state [km_conn review_state]
+set approval_p [km_static approval_p $package_id]
+set ot_archive_p [km_static object_type_archive_p $object_type_id]
+set author_name [km_conn original_author_name]
+set ot_create_p [km_static object_type_create_p $object_type_id]
+set ot_copy_p [km_static object_type_copy_p $object_type_id]
+set author_id [km_conn original_author_id]
+set publisher_id [km_conn publisher_id]
+
+if ![empty_string_p $publisher_id] {
+ set publisher_name [db_string get_publisher_name {select first_names || ' ' || last_name from users where user_id = :publisher_id}]
+} else {
+ set publisher_name ""
+}
+
+if { ($user_id == $author_id && !$archived_p) || $admin_p } {
+ set change_owner_p 1
+} else {
+ set change_owner_p 0
+}
+
+if { $admin_p || $publish_p || $publisher_id == $user_id} {
+ set change_publisher_p 1
+} else {
+ set change_publisher_p 0
+}
+
+## get the task_id of the workflow task if object is in review
+if { $review_p } {
+ set task_id [db_string get_workflow_task {
+ select distinct(ut.task_id)
+ from wf_cases c, wf_user_tasks ut
+ where c.object_id = :object_id
+ and c.case_id = ut.case_id
+ and c.state = 'active'
+ and rownum = 1
+ order by ut.task_id desc
+ } -default ""]
+} else {
+ set task_id ""
+}
+
+set graphic [km_static object_type_graphic $object_type_id]
+set graphic_width [library_icon_width]
+set question_state_deprecated [km_pretty_question_state "deprecated"]
+set question_state_read_only [km_pretty_question_state "read-only"]
+
+set title "[km_static object_type_pretty_name $object_type_id]: $object_name "
+set check_img "<img src=\"graphics/check.gif\" width=16 height=16>"
+set check_gray_img "<img src=\"graphics/check-gray.gif\" width=16 height=16>"
+set pretty_type_name [km_static object_type_pretty_name $object_type_id]
+
+# This object may have some parents.
+# The proc returns pairs of parent_object_id and the object name
+set ancestors [reverse [km_get_object_ancestors $object_id]]
+if ![null_p $ancestors] {
+ set direct_ancestor [fst $ancestors]
+ set ancestor_object_id [fst $direct_ancestor]
+ set ancestor_name [snd $direct_ancestor]
+ set ancestor_object_type [km_static object_type_pretty_name [thd $direct_ancestor]]
+
+ db_1row get_public_archived_status {
+ select decode(public_p,'t',1,0) as ancestor_public_p,
+ decode(archived_p,'t',1,0) as ancestor_archived_p,
+ decode(in_review_p,'t',1,0) as ancestor_review_p
+ from sn_objects
+ where object_id = :ancestor_object_id
+ }
+ set child_p 1
+} else {
+ set child_p 0
+}
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Questions"
+set nephew_p [km_is_nephew_p $object_id]
+
+if {$child_p && !$nephew_p} {
+ if {$ot_archive_p} {
+ set return_url "object-view?[export_url_vars object_id category_id]"
+ if { $archived_p && $edit_p } {
+ set object_access_toolbar "<font color=red>\[Archived\]</font> <a href=\"object-unarchive?[export_url_vars object_id category_id return_url]\">Remove from archive</a>"
+ } else {
+ set object_access_toolbar "<a href=\"object-archive?[export_url_vars object_id category_id return_url]\">Put in archive</a>"
+ }
+ } else {
+ set object_access_toolbar ""
+ }
+} else {
+ set object_access_toolbar [km_object_access_toolbar $object_id $category_id]
+}
+
+# Get the questions that apply to this object type and indicate if
+# they have been answered or are links
+set question_states [list active deprecated read-only]
+if {$archived_p} {
+ lappend question_states invisible
+}
+set question_list [km_get_questions -question_states $question_states -all_properties_p 1 -root_node_p 1 -branch_children_p 1 -object_type_id $object_type_id -answered_p 1 -object_id $object_id]
+
+set key [head $question_list]
+set question_list [tail $question_list]
+set question_ids [fst [transpose [tail $question_list]]]
+
+# Go thru each question and decide to display it or not
+
+set abstract_data_type_ix [lsearch $key abstract_data_type]
+set question_state_ix [lsearch $key question_state]
+set branch_p_ix [lsearch $key branch_p]
+set root_branch_p_ix [lsearch $key root_branch_p]
+set entry_explanation_ix [lsearch $key entry_explanation]
+set question_id_ix [lsearch $key question_id]
+set question_name_ix [lsearch $key pretty_name]
+set mandatory_p_ix [lsearch $key mandatory_p]
+set answered_p_ix [lsearch $key answered_p]
+
+set questions_with_links [db_list_of_lists questions_10 {select unique question_id from (
+ select map.question_id,
+ acs_permission.permission_p(l.object_id_b, :user_id, 'sw_read') sw_read_p,
+ (select decode(count(*),0,'f','t') from dual where exists
+ (select decode(count(*),'f','t') from dual where exists
+ (select 1
+ from membership_rels mr_lm
+ where mr_lm.person_id = :user_id
+ and sn_group.group_list_members_p(mr_lm.group_id, l.object_id_b) > 0 ))) as user_list_p
+ from sn_links l, sn_question_link_map map, acs_objects ao
+ where l.object_id_a = :object_id
+ and l.object_id_b = ao.object_id
+ and l.link_id = map.link_id
+ ) where sw_read_p='t' or user_list_p='t'}]
+
+set i 0
+template::multirow create questions check destination_url question_name star arrow dots short_explanation question_state answered
+foreach question $question_list {
+ set abstract_data_type [lindex $question $abstract_data_type_ix]
+ set question_state [lindex $question $question_state_ix]
+ set branch_p [lindex $question $branch_p_ix]
+ set root_branch_p [lindex $question $root_branch_p_ix]
+ set arrow ""
+ set destination "one-question-edit?"
+ set explanation [lindex $question $entry_explanation_ix]
+ set question_id [lindex $question $question_id_ix]
+ set question_name [lindex $question $question_name_ix]
+ set mandatory_p [lindex $question $mandatory_p_ix]
+
+ # I think for questions of abstract data type options and categories are
+ # better checked in single queries.
+ set answered_p 0
+ switch $abstract_data_type {
+ "text" -
+ "file" -
+ "date" -
+ "integer" {
+ set answered_p [lindex $question $answered_p_ix]
+ }
+ "object_link" -
+ "user_link" -
+ "content_link" {
+ if {[lsearch $questions_with_links $question_id] < 0} {
+ set answered_p 0
+ } else {
+ set answered_p 1
+ }
+ }
+ "category" - "other_category" {
+ set answered_p [db_string questions_20 {select decode(count(*),0,0,1)
+ from dual
+ where exists
+ (select 'x'
+ from categories c, sw_flat_cat fc, sw_object_category_map cm, sn_questions q
+ where cm.object_id = :object_id
+ and q.question_id = :question_id
+ and fc.parent = q.node_id
+ and c.category_id = fc.child_category_id
+ and cm.category_id = c.category_id)}]
+ }
+ "option" {
+ set answered_p [db_string questions_20 {select decode(count(*),0,0,1)
+ from dual
+ where exists
+ (select 'x'
+ from sn_answer_options a, sn_object_option_map m
+ where a.option_id =m.option_id
+ and m.object_id = :object_id
+ and a.question_id = :question_id)}]
+ }
+ "child_object" {
+ set answer ""
+ set child_ids [km_get_child_objects $object_id $question_id]
+ foreach child_id $child_ids {
+ lappend answer [km_get_object_summary $child_id]
+ }
+ set answered_p [km_answered_p $abstract_data_type $answer]
+ }
+ "nephew_object" {
+ set answer ""
+ set nephew_ids [km_get_nephew_objects $object_id $question_id]
+ foreach nephew_id $nephew_ids {
+ lappend answer [km_get_object_summary $nephew_id]
+ }
+ set answered_p [km_answered_p $abstract_data_type $answer]
+ }
+ "composite" {
+ set child_ids [km_get_child_questions $question_id]
+ if {![null_p $child_ids]} {
+ set child_questions [km_get_questions -question_states {active deprecated read-only} -root_node_p 0 -question_ids $child_ids]
+ set answer [km_get_object_data -questions $child_questions -answers_only_p 0 $object_id]
+ set answered_p [km_answered_p $abstract_data_type $answer]
+ } else {
+ set answered_p 0
+ }
+ }
+ default {
+ ns_log Notice "Error in questions.tcl. I'm in the default branche and I shouldn't be there. Testing abstract_data_type $abstract_data_type of question $question_name"
+ set answer [km_get_object_data -questions [list question_id $question_id] $object_id]
+ set answered_p [km_answered_p $abstract_data_type $answer]
+ }
+ }
+
+
+ if { $abstract_data_type == "object_link" || \
+ $abstract_data_type == "user_link" || \
+ $abstract_data_type == "content_link" || \
+ $abstract_data_type == "child_object" || \
+ $abstract_data_type == "nephew_object"} {
+ set arrow "<img width=13 height=9 src=\"graphics/arrow.gif\">"
+ set destination "one-question-edit?"
+## set destination "object-link?"
+ }
+
+ if { $answered_p } {
+ if { $question_state == "active" } {
+ if { $abstract_data_type == "composite" } {
+ # If it's a composite question, we only mark it
+ # as answered if all children have been answered.
+
+ set all_answered_p 1
+ foreach item $answer {
+ set child_abstract_datatype [lindex $item 3]
+ set child_answer [fst $item]
+
+ if ![km_answered_p $child_abstract_datatype $child_answer] {
+ set all_answered_p 0
+ break
+ }
+ }
+
+ set check [ad_decode $all_answered_p 1 $check_img $check_gray_img]
+ set answered [ad_decode $all_answered_p 1 2 1]
+
+ } else {
+ set check $check_img
+ set answered 2
+ }
+ } else {
+ set check "X"
+ set answered 0
+ }
+ } else {
+ set check " "
+ set answered 0
+ }
+
+ # Set the question attributes using the key for the list variables
+ if { $mandatory_p == "t" } {
+ set star "*"
+ } else {
+ set star ""
+ }
+ if { $root_branch_p || $abstract_data_type == "composite" } {
+ set dots " ..."
+ } else {
+ set dots ""
+ }
+
+ set short_explanation [km_shorten_question $explanation]
+
+ if {[empty_string_p $branch_p]} {set branch_p 0}
+ if {$branch_p && [km_active_path_p $question_id $object_id $object_type_id]} {
+ set branch_p 0
+ set question_name "... $question_name"
+ }
+
+ if { ($question_state == "active" || $answered_p) &&
+ (($view_questions == "all" && !$branch_p) ||
+ ($view_questions == "unanswered" && !$answered_p && !$branch_p)) } {
+ # Display the row
+
+ template::multirow append questions $check "$destination[export_url_vars object_id category_id path_id question_id]" $question_name $star $arrow $dots $short_explanation $question_state $answered
+ }
+
+ incr i
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-add-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-add-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,252 @@
+ad_page_contract {
+ /packages/library/www/resource-application-add-2.tcl
+
+ Show a form where a user can volunteer for an XchangeTask
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: resource-application-add-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_id:notnull,integer
+ resource_req_id:integer
+ {category_id ""}
+ {return_url "."}
+ apply:optional
+ cancel:optional
+} -properties {
+ title:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ form_vars:onevalue
+ recipient:onevalue
+ role:onevalue
+ pretty_project_type:onevalue
+ subject:onevalue
+ system_url:onevalue
+ user_id:onevalue
+ contact_data:onevalue
+ nationality:onevalue
+ manager_email:onevalue
+ role_select:onevalue
+ role_other:onevalue
+ working_area:onevalue
+ first_language:onevalue
+ second_language_id:onevalue
+ third_language_id:onevalue
+ second_language_prof_id:onevalue
+ third_language_prof_id:onevalue
+ other_language:onevalue
+ languages:multirow
+ language_proficiencies:multirow
+ strengths:onevalue
+ leadership:onevalue
+ intercultural:onevalue
+ comments:onevalue
+ conditions:onevalue
+ attachments:multirow
+ dc_export:onevalue
+ edit_p:onevalue
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id $object_id] { return }
+
+if ![exists_and_not_null resource_req_id] {
+ ad_return_complaint 1 "For some reason, resource_req_id has not been supplied with this request."
+ return
+}
+
+if {[info exists cancel]} {
+ ad_returnredirect $return_url
+}
+
+set demand_type_id [km_conn object_type_id]
+set pretty_demand_type [km_static object_type_pretty_name $demand_type_id]
+set demand_name [km_conn object_name]
+set role [snd [fst [fst [km_get_object_data $resource_req_id]]]]
+set graphic [km_static object_type_graphic $demand_type_id]
+set graphic_width [library_icon_width]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Apply"
+
+if ![km_check_object_id $resource_req_id] { return }
+set project_type_id [km_conn object_type_id]
+set pretty_project_type [km_static object_type_pretty_name $project_type_id]
+set project_name [km_conn object_name]
+
+set title "Volunteer for the $pretty_project_type \"$project_name\""
+set subject "I apply for the $pretty_demand_type \"$demand_name\" of the $pretty_project_type \"$project_name\""
+
+# All users that are linked to this Xchange task object
+# will get a copy of the mail.
+
+set recipient [sn_people_responsible $user_id $object_id]
+
+set form_vars [export_form_vars object_id resource_req_id category_id return_url recipient]
+set system_url [ad_url]
+
+# Now let's get some info about the volunteer.
+
+db_1row get_user_data {
+ select email as user_email, first_names || ' ' || last_name as user_name
+ from users
+ where user_id = :user_id
+}
+
+set contact_data "Name: $user_name\nEmail: $user_email\n"
+db_foreach get_global_questions {
+ select q.question_id, q.question,
+ decode ( q.category_tree_id, null, a.answer, c.short_name ) as answer
+ from sn_reg_questions q, sn_reg_answers a, categories c
+ where q.scope = 'site_wide'
+ and q.deleted_p = 'f'
+ and q.question_id = a.question_id(+)
+ and a.category_id = c.category_id(+)
+ and a.user_id(+) = :user_id
+} {
+ append contact_data "$question: $answer\n"
+}
+
+set edit_p 0
+util_unlist [km_break_date [db_string get_sysdate {select sysdate from dual}]] from_year from_month from_day
+set to_year $from_year
+set to_month $from_month
+set to_day $from_day
+set nationality ""
+set manager_email ""
+set working_area ""
+set first_language ""
+set second_language_id ""
+set third_language_id ""
+set second_language_prof_id ""
+set third_language_prof_id ""
+set other_language ""
+set strengths ""
+set leadership ""
+set intercultural ""
+set comments ""
+set conditions ""
+template::multirow create attachments attachment_id filename title size
+
+set package_id [ad_conn package_id]
+set magic_ids_exist_p [db_0or1row get_magic_ids_for_category_trees {
+ select role_magic_id, language_magic_id, proficiency_magic_id
+ from psn_category_trees
+ where package_id = :package_id
+}]
+
+if {!$magic_ids_exist_p} {
+ ad_return_complaint 1 "Error in library setup. No magic ids for category trees for the application form found."
+ return
+}
+
+if {!$role_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+if {!$language_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+if {!$proficiency_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+
+
+set role_category_tree_assigned_p [db_0or1row role_category_tree {
+ select octr.subtree_root_node_id as role_subtree_root_id,
+ gt.root_node_id as role_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :role_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if {!$role_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+
+if { $role_subtree_root_id == $role_orig_root_id } {
+ set role_level_correction 1
+} else {
+ set role_level_correction 0
+}
+
+set language_category_tree_assigned_p [db_0or1row language_category_tree {
+ select octr.subtree_root_node_id as language_subtree_root_id,
+ gt.root_node_id as language_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :language_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if {!$language_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+
+if { $language_subtree_root_id == $language_orig_root_id } {
+ set language_level_correction 1
+} else {
+ set language_level_correction 0
+}
+
+set proficiency_category_tree_assigned_p [db_0or1row proficiency_category_tree {
+ select octr.subtree_root_node_id as proficiency_subtree_root_id,
+ gt.root_node_id as proficiency_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :proficiency_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if {!$proficiency_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+
+if { $proficiency_subtree_root_id == $proficiency_orig_root_id } {
+ set proficiency_level_correction 1
+} else {
+ set proficiency_level_correction 0
+}
+
+set role_select "<select multiple name=role_id>"
+set role_results [util_memoize [list swc_get_category_tree $role_subtree_root_id 0 {}]]
+foreach role $role_results {
+ util_unlist $role category_id category_name category_description
+ append role_select "<option value=\"$category_id\">$category_name"
+}
+append role_select "</select>"
+
+template::multirow create languages language_id name
+set language_results [util_memoize [list swc_get_category_tree $language_subtree_root_id 0 {}]]
+foreach language $language_results {
+ util_unlist $language category_id category_name category_description
+ template::multirow append languages $category_id $category_name
+}
+
+template::multirow create language_proficiencies prof_id name
+set prof_results [util_memoize [list swc_get_category_tree $proficiency_subtree_root_id 0 {}]]
+foreach prof $prof_results {
+ util_unlist $prof category_id category_name category_description
+ template::multirow append language_proficiencies $category_id $category_name
+}
+
+set role_other ""
+
+set dc_export [doubleclick::signature_html]
+
+db_release_unused_handles
+
+ad_return_template resource-application
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-add.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-add.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-add.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,18 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@project_graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+<br><font color=red>"I hereby confirm that I have consulted my direct line manager about the possible transfer. He agrees with this application."</font>
+<p>
+
+<form method=get action="resource-application-add-2">
+<csrf-token>
+@form_vars;noquote@
+ <table>
+ <tr><td align=center>
+ <input type=submit name="apply" value="I Agree">
+ <input type=submit name="cancel" value="Cancel">
+ </td></tr>
+ </table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-add.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-add.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,55 @@
+ad_page_contract {
+ /packages/library/www/resource-application-add.tcl
+
+ Show a confirmation form or redirect to saved and unsent form
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: resource-application-add.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_id:notnull,integer
+ resource_req_id:integer
+ {category_id ""}
+ {return_url "."}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ project_graphic:onevalue
+ graphic_width:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id $object_id] { return }
+
+if ![exists_and_not_null resource_req_id] {
+ ad_return_complaint 1 "For some reason, resource_req_id has not been supplied with this request."
+ return
+}
+
+set unfinished_applications_p [db_0or1row get_unfinished_applications {
+ select application_id
+ from psn_res_applications
+ where sent_p = 'f'
+ and object_id = :object_id
+ and resource_req_id = :resource_req_id
+ and user_id = :user_id
+}]
+
+if {$unfinished_applications_p} {
+ ad_returnredirect "resource-application-edit?[export_url_vars application_id category_id return_url]"
+}
+
+set project_type_id [km_conn object_type_id]
+ set pretty_project_type [km_static object_type_pretty_name $project_type_id]
+set project_graphic [km_static object_type_graphic $project_type_id]
+set project_name [km_conn object_name]
+set title "Apply for $pretty_project_type \"$project_name\""
+set graphic_width [library_icon_width]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Confirm"
+
+set form_vars [export_form_vars object_id resource_req_id category_id return_url]
+
+db_release_unused_handles
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-attach-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-attach-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-attach-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,55 @@
+ad_page_contract {
+ script to recieve the new file and insert it into the database
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @creation-date 26 Oct 2001
+ @cvs-id $Id: resource-application-attach-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ application_id:integer,notnull
+ {category_id ""}
+ return_url:notnull
+ upload_file:notnull,trim
+ upload_file.tmpfile:tmpfile
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set target "resource-application-edit?[export_url_vars application_id category_id return_url]"
+
+if {[doubleclick::check_all]} {
+ ns_sleep 2
+ ad_returnredirect $target
+ return
+}
+
+# get the filename part of the upload file
+if ![regexp {[^//\\]+$} $upload_file filename] {
+ # no match
+ set filename $upload_file
+}
+
+set mime_type [ns_guesstype $upload_file]
+
+db_transaction {
+
+ set attachment_id [db_nextval "psn_attachment_id_seq"]
+
+ db_dml insert_attachment {
+ insert into psn_attachments
+ (attachment_id, application_id, title, mime_type, filename)
+ values
+ (:attachment_id, :application_id, :filename, :mime_type, :filename)
+ }
+
+ db_dml add_attachment_to_application {
+ update psn_attachments
+ set attachment = empty_blob()
+ where attachment_id = :attachment_id
+ returning attachment into :1
+ } -blob_files [list ${upload_file.tmpfile}]
+
+}
+
+db_release_unused_handles
+
+ad_returnredirect $target
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-attach.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-attach.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-attach.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,34 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form enctype=multipart/form-data method=POST action="resource-application-attach-2">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<table border=0>
+
+<tr>
+<td align=right>Filename : </td>
+<td><input type=file name=upload_file size=20></tr>
+</tr>
+
+<tr>
+<td> </td>
+<td><font size=-1>Use the "Browse..." button to locate your file,
+ then click "Open". </font></td>
+</tr>
+
+<tr>
+<td> </td>
+<td> </td>
+</tr>
+
+<tr>
+<td></td>
+<td><input type=submit value="Submit and Upload">
+</td>
+</tr>
+
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-attach.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-attach.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-attach.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,50 @@
+ad_page_contract {
+ page to add a new file to the application
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @creation-date 26 Oct 2001
+ @cvs-id $Id: resource-application-attach.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ application_id:integer,notnull
+ {category_id ""}
+ return_url:notnull
+} -properties {
+ form_vars:onevalue
+ title:onevalue
+ dc_export:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set application_exists [db_0or1row check_existing_application {
+ select object_id, user_id as application_user_id, sent_p
+ from psn_res_applications
+ where application_id = :application_id
+}]
+if !$application_exists {
+ ad_return_complaint 1 "There is no such application."
+ return
+}
+if {![string equal $user_id $application_user_id]} {
+ ad_return_complaint 1 "This is not your application. Your are not allowed to edit it."
+ return
+}
+if {$sent_p == "t"} {
+ ad_return_complaint 1 "This application already got sent. There is no way to edit it later, but you can sent a new application."
+ return
+}
+
+set form_vars [export_form_vars application_id category_id return_url]
+set title "Attach File to Application Form"
+
+if ![km_check_object_id $object_id] { return }
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data [list "resource-application-edit?[export_url_vars application_id category_id return_url]" "Apply"] "Attach File"
+
+set dc_export [doubleclick::signature_html]
+
+db_release_unused_handles
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-edit.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-edit.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,231 @@
+ad_page_contract {
+ /packages/library/www/resource-application-edit.tcl
+
+ Show a form where a user can volunteer for an XchangeTask
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: resource-application-edit.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ application_id:notnull,integer
+ {category_id ""}
+ {return_url "."}
+} -properties {
+ title:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ form_vars:onevalue
+ recipient:onevalue
+ role:onevalue
+ pretty_project_type:onevalue
+ subject:onevalue
+ system_url:onevalue
+ user_id:onevalue
+ contact_data:onevalue
+ nationality:onevalue
+ manager_email:onevalue
+ role_select:onevalue
+ role_other:onevalue
+ working_area:onevalue
+ first_language:onevalue
+ second_language_id:onevalue
+ third_language_id:onevalue
+ second_language_prof_id:onevalue
+ third_language_prof_id:onevalue
+ languages:multirow
+ language_proficiencies:multirow
+ other_language:onevalue
+ from_date_widget:onevalue
+ to_date_widget:onevalue
+ strengths:onevalue
+ leadership:onevalue
+ intercultural:onevalue
+ comments:onevalue
+ conditions:onevalue
+ attachments:multirow
+ dc_export:onevalue
+ edit_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set application_exists [db_0or1row get_application_data {
+ select object_id, resource_req_id, recipient, subject, contact_data, nationality,
+ manager_email, working_area, first_language, second_language_id,
+ third_language_id, second_language_prof_id, role_other,
+ third_language_prof_id, other_language, from_date, to_date, strengths,
+ leadership, intercultural, comments, conditions, user_id as creator_id
+ from psn_res_applications
+ where application_id = :application_id
+}]
+
+if !$application_exists {
+ ad_return_complaint 1 "There is no such application."
+ return
+}
+if {$user_id != $creator_id} {
+ ad_return_complaint 1 "This is not your application, therefore you are not allowed to see it."
+ return
+}
+
+if ![km_check_object_id $object_id] { return }
+
+util_unlist [km_break_date $from_date] from_year from_month from_day
+util_unlist [km_break_date $to_date] to_year to_month to_day
+
+set role_id_list [db_list get_role_list_of_application {
+ select role_id from psn_res_application_roles where application_id = :application_id
+}]
+
+## attachments
+
+set demand_type_id [km_conn object_type_id]
+set pretty_demand_type [km_static object_type_pretty_name $demand_type_id]
+set demand_name [km_conn object_name]
+set role [snd [fst [fst [km_get_object_data $resource_req_id]]]]
+set graphic [km_static object_type_graphic $demand_type_id]
+set graphic_width [library_icon_width]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Apply"
+
+if ![km_check_object_id $resource_req_id] { return }
+set project_type_id [km_conn object_type_id]
+set pretty_project_type [km_static object_type_pretty_name $project_type_id]
+set project_name [km_conn object_name]
+
+set title "Volunteer for a $pretty_project_type: $project_name"
+
+set form_vars [export_form_vars application_id category_id return_url]
+set system_url [ad_url]
+
+set package_id [ad_conn package_id]
+set magic_ids_exist_p [db_0or1row get_magic_ids_for_category_trees {
+ select role_magic_id, language_magic_id, proficiency_magic_id
+ from psn_category_trees
+ where package_id = :package_id
+}]
+
+if {!$magic_ids_exist_p} {
+ ad_return_complaint 1 "Error in library setup. No magic ids for category trees for the application form found."
+ return
+}
+if {!$role_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+if {!$language_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+if {!$proficiency_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+
+set role_category_tree_assigned_p [db_0or1row role_category_tree {
+ select octr.subtree_root_node_id as role_subtree_root_id,
+ gt.root_node_id as role_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :role_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if {!$role_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+
+if { $role_subtree_root_id == $role_orig_root_id } {
+ set role_level_correction 1
+} else {
+ set role_level_correction 0
+}
+
+set language_category_tree_assigned_p [db_0or1row language_category_tree {
+ select octr.subtree_root_node_id as language_subtree_root_id,
+ gt.root_node_id as language_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :language_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if {!$language_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+
+if { $language_subtree_root_id == $language_orig_root_id } {
+ set language_level_correction 1
+} else {
+ set language_level_correction 0
+}
+
+set proficiency_category_tree_assigned_p [db_0or1row proficiency_category_tree {
+ select octr.subtree_root_node_id as proficiency_subtree_root_id,
+ gt.root_node_id as proficiency_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :proficiency_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+if {!$proficiency_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+
+if { $proficiency_subtree_root_id == $proficiency_orig_root_id } {
+ set proficiency_level_correction 1
+} else {
+ set proficiency_level_correction 0
+}
+
+set role_select "<select multiple name=role_id>"
+set role_results [util_memoize [list swc_get_category_tree $role_subtree_root_id 0 {}]]
+foreach role $role_results {
+ util_unlist $role category_id category_name category_description
+ append role_select "<option value=\"$category_id\""
+ if {[lsearch -exact $role_id_list $category_id] != -1} {
+ append role_select " selected"
+ }
+ append role_select ">$category_name"
+}
+append role_select "</select>"
+
+template::multirow create languages language_id name
+set language_results [util_memoize [list swc_get_category_tree $language_subtree_root_id 0 {}]]
+foreach language $language_results {
+ util_unlist $language category_id category_name category_description
+ template::multirow append languages $category_id $category_name
+}
+
+template::multirow create language_proficiencies prof_id name
+set prof_results [util_memoize [list swc_get_category_tree $proficiency_subtree_root_id 0 {}]]
+foreach prof $prof_results {
+ util_unlist $prof category_id category_name category_description
+ template::multirow append language_proficiencies $category_id $category_name
+}
+
+template::multirow create attachments attachment_id filename title size
+db_foreach get_attachments {
+ select attachment_id, filename, title as file_title, dbms_lob.getlength(attachment) as bytes
+ from psn_attachments
+ where application_id = :application_id
+} {
+ template::multirow append attachments $attachment_id $filename $file_title $bytes
+}
+
+set edit_p 1
+set dc_export [doubleclick::signature_html]
+
+db_release_unused_handles
+
+ad_return_template resource-application
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-save.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-save.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-save.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,274 @@
+ad_page_contract {
+ /packages/library/www/resource-application-save.tcl
+
+ Save the input the user entered in the form and either add an attachment,
+ sent the email or redirect to the return_url.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: resource-application-save.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ {application_id:integer ""}
+ {object_id:integer ""}
+ {resource_req_id:integer ""}
+ {category_id ""}
+ {return_url:notnull "."}
+ {recipient:string_length(max|4000) ""}
+ subject:string_length(max|1000)
+ contact_data:string_length(max|4000)
+ nationality:string_length(max|4000)
+ manager_email:string_length(max|4000)
+ {role_id:integer,multiple ""}
+ role_other:string_length(max|1000)
+ working_area:string_length(max|4000)
+ first_language:string_length(max|1000)
+ second_language_id:integer
+ second_language_prof_id:integer
+ third_language_id:integer
+ third_language_prof_id:integer
+ other_language:string_length(max|4000)
+ from_date:array
+ to_date:array
+ strengths:string_length(max|4000)
+ leadership:string_length(max|4000)
+ intercultural:string_length(max|4000)
+ comments:string_length(max|4000)
+ conditions:string_length(max|4000)
+ send:optional
+ save:optional
+ attach:optional
+ cancel_form:optional
+ dont_apply:optional
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set ip_address [ad_conn peeraddr]
+set package_id [ad_conn package_id]
+
+if {![empty_string_p $resource_req_id] && ![km_check_object_id $resource_req_id]} { return }
+
+if {[doubleclick::check_all] && [empty_string_p $application_id]} {
+ set application_id [db_string get_application_id {
+ select application_id
+ from psn_res_applications
+ where object_id = :object_id
+ and resource_req_id = :resource_req_id
+ } -default "0"]
+}
+
+if {[info exists cancel_form]} {
+ ad_returnredirect $return_url
+ return
+}
+
+if {[info exists dont_apply]} {
+ db_transaction {
+ db_dml delete_application_10 {delete from psn_res_application_roles where application_id = :application_id}
+ db_dml delete_application_20 {delete from psn_attachments where application_id = :application_id}
+ db_dml delete_application_30 {delete from psn_res_applications where application_id = :application_id}
+ }
+ ad_returnredirect $return_url
+ return
+}
+
+if {![empty_string_p $application_id]} {
+ set application_exists [db_0or1row check_existing_application {
+ select user_id as application_user_id, sent_p
+ from psn_res_applications
+ where application_id = :application_id
+ }]
+ if !$application_exists {
+ ad_return_complaint 1 "There is no such application."
+ return
+ }
+ if {![string equal $user_id $application_user_id]} {
+ ad_return_complaint 1 "This is not your application. Your are not allowed to edit it."
+ return
+ }
+ if {$sent_p == "t"} {
+ ad_return_complaint 1 "This application already got sent. There is no way to edit it later, but you can send a new application."
+ return
+ }
+}
+
+set form [ns_conn form]
+set form_size [ns_set size $form]
+
+set i 0
+while {$i < $form_size} {
+ set key [ns_set key $form $i]
+ set value [ns_set value $form $i]
+ if {[regexp {^delete([0-9]*)} $key match delete_attachment_id]} {
+ break
+ }
+ incr i
+}
+
+set from_date_sql "$from_date(year)-$from_date(month)-$from_date(day)"
+set to_date_sql "$to_date(year)-$to_date(month)-$to_date(day)"
+
+if {![date_p $from_date_sql]} {
+ set from_date_sql [db_string get_sysdate {select sysdate from dual}]
+}
+if {![date_p $to_date_sql]} {
+ set to_date_sql [db_string get_sysdate {select sysdate from dual}]
+}
+
+if {![empty_string_p $role_other]} {
+ set magic_ids_exist_p [db_0or1row get_magic_ids_for_category_trees {
+ select role_magic_id
+ from psn_category_trees
+ where package_id = :package_id
+ }]
+
+ if {!$magic_ids_exist_p} {
+ ad_return_complaint 1 "Error in library setup. No magic ids for category trees for the application form found."
+ return
+ }
+ if {!$role_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+ }
+
+ set role_category_tree_assigned_p [db_0or1row role_category_tree {
+ select octr.subtree_root_node_id as role_subtree_root_id,
+ gt.root_node_id as role_orig_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :role_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'}]
+
+ if {!$role_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+ }
+
+ if {[db_0or1row check_other_category_id {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as other_category_id
+ from sw_category_dim
+ where category.long_name(object_id) = 'Other'
+ start with node_id = :role_subtree_root_id
+ connect by prior node_id = parent_node_id
+ }]} {
+ if {[lsearch -exact $role_id $other_category_id] == -1} {
+ set role_other ""
+ }
+ }
+}
+
+db_transaction {
+
+ if {![empty_string_p $resource_req_id]} {
+
+ set application_id [db_exec_plsql create_new_application {
+ begin
+ :1 := acs_object.new (
+ object_type => 'psn_application',
+ creation_date => sysdate,
+ creation_user => :user_id,
+ creation_ip => :ip_address,
+ context_id => :resource_req_id
+ );
+ end;
+ }]
+
+ if ![km_check_object_id $object_id] { return }
+ set project_type_id [km_conn object_type_id]
+ set project_type [km_static object_type_pretty_name $project_type_id]
+ set project_name [km_conn object_name]
+
+ if ![km_check_object_id $resource_req_id] { return }
+ set demand_type_id [km_conn object_type_id]
+ set demand_type [km_static object_type_pretty_name $demand_type_id]
+ set demand_name [km_conn object_name]
+
+ set shortname [string range "Application for '$demand_name'" 0 199]
+ set overview "Application for the $demand_type '$demand_name' of the $project_type '$project_name'"
+
+ db_exec_plsql set_application_object_description {
+ begin
+ acs_object.new_description (
+ v_object_id => :application_id,
+ v_shortname => :shortname,
+ v_overview => :overview,
+ v_overview_html_p => 'f',
+ v_package_id => :package_id
+ );
+ end;
+ }
+
+ db_dml insert_new_application {
+ insert into psn_res_applications
+ (application_id, object_id, resource_req_id, user_id, creation_date,
+ application_date, recipient, subject, contact_data, nationality, manager_email,
+ working_area, first_language, second_language_id, third_language_id,
+ second_language_prof_id, third_language_prof_id, role_other,
+ other_language, from_date, to_date, strengths, leadership, intercultural,
+ comments, conditions)
+ values
+ (:application_id, :object_id, :resource_req_id, :user_id, sysdate,
+ null, :recipient, :subject, :contact_data, :nationality, :manager_email,
+ :working_area, :first_language, :second_language_id, :third_language_id,
+ :second_language_prof_id, :third_language_prof_id, :role_other,
+ :other_language, to_date(:from_date_sql), to_date(:to_date_sql), :strengths,
+ :leadership, :intercultural, :comments, :conditions)
+ }
+ } else {
+ db_dml update_application {
+ update psn_res_applications
+ set subject = :subject,
+ contact_data = :contact_data,
+ nationality = :nationality,
+ manager_email = :manager_email,
+ working_area = :working_area,
+ role_other = :role_other,
+ first_language = :first_language,
+ second_language_id = :second_language_id,
+ third_language_id = :third_language_id,
+ second_language_prof_id = :second_language_prof_id,
+ third_language_prof_id = :third_language_prof_id,
+ other_language = :other_language,
+ from_date = to_date(:from_date_sql),
+ to_date = to_date(:to_date_sql),
+ strengths = :strengths,
+ leadership = :leadership,
+ intercultural = :intercultural,
+ comments = :comments,
+ conditions = :conditions
+ where application_id = :application_id
+ }
+ }
+
+ db_dml delete_old_roles {
+ delete from psn_res_application_roles where application_id = :application_id
+ }
+ foreach single_role_id $role_id {
+ db_dml insert_new_roles {
+ insert into psn_res_application_roles (application_id, role_id)
+ values (:application_id, :single_role_id)
+ }
+ }
+}
+
+db_release_unused_handles
+
+if {[info exists attach]} {
+ ad_returnredirect "resource-application-attach?[export_url_vars application_id category_id return_url]"
+}
+
+if {[info exists delete_attachment_id]} {
+ db_dml delete_attachment {
+ delete from psn_attachments where attachment_id = :delete_attachment_id and application_id = :application_id
+ }
+ ad_returnredirect "resource-application-edit?[export_url_vars application_id category_id return_url]"
+}
+
+if {[info exists send]} {
+ ad_returnredirect "resource-application-send?[export_url_vars application_id category_id return_url]"
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-send-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-send-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-send-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,327 @@
+ad_page_contract {
+ /packages/library/www/resource-application-send-2.tcl
+
+ Mime encode attachments, send the email and mark the application as sent.
+ send the email or redirect to the return_url.
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: resource-application-send-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ application_id:integer,notnull
+ {category_id ""}
+ return_url:notnull
+ send:optional
+ edit:optional
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if {[info exists edit]} {
+ ad_returnredirect "resource-application-edit?[export_url_vars application_id category_id return_url]"
+ return
+}
+
+set boundary_string "------=_NextPart_000_0064_01C160A3.5C6A4A50"
+
+set application_exists [db_0or1row get_application_data {
+ select user_id as application_user_id, object_id, resource_req_id, sent_p,
+ recipient, subject, contact_data, nationality, manager_email,
+ working_area, first_language, second_language_id, role_other,
+ third_language_id, second_language_prof_id,
+ third_language_prof_id, other_language, from_date, to_date,
+ strengths, leadership, intercultural, comments, conditions
+ from psn_res_applications
+ where application_id = :application_id
+}]
+
+if !$application_exists {
+ ad_return_complaint 1 "There is no such application."
+ return
+}
+if {![string equal $user_id $application_user_id]} {
+ ad_return_complaint 1 "This is not your application. Your are not allowed to edit or sent it."
+ return
+}
+if {$sent_p == "t"} {
+ ad_return_complaint 1 "This application already got sent. There is no way to edit it later, but you can sent a new application."
+ return
+}
+
+db_1row get_username {
+ select first_names || ' ' || last_name as user_name, email as user_email
+ from users
+ where user_id = :user_id
+}
+
+db_1row get_project_and_demand_names {
+ select o1.one_line_description as demand_name,
+ o2.one_line_description as project_name,
+ ot1.pretty_name as demand_type, ot2.pretty_name as project_type
+ from sn_objects o1, sn_objects o2, sn_object_types ot1, sn_object_types ot2
+ where o1.object_id = :object_id
+ and o2.object_id = :resource_req_id
+ and o1.object_type_id = ot1.object_type_id
+ and o2.object_type_id = ot2.object_type_id
+}
+
+db_1row package_location {
+ select site_node.url(sn.node_id) as library_url
+ from site_nodes sn, acs_objects_description dsc
+ where dsc.object_id = :object_id
+ and sn.object_id = dsc.package_id
+ and rownum = 1
+}
+
+set selected_role_ids [db_list get_application_roles {
+ select role_id
+ from psn_res_application_roles
+ where application_id = :application_id
+}]
+
+set magic_ids_exist_p [db_0or1row get_magic_ids_for_category_trees {
+ select role_magic_id, language_magic_id, proficiency_magic_id
+ from psn_category_trees
+ where package_id = :package_id
+}]
+
+if {!$magic_ids_exist_p} {
+ ad_return_complaint 1 "Error in library setup. No magic ids for category trees for the application form found."
+ return
+}
+if {!$role_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+if {!$language_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+if {!$proficiency_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+set role_category_tree_assigned_p [db_0or1row role_category_tree {
+ select octr.subtree_root_node_id as role_subtree_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :role_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'
+}]
+
+if {!$role_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+
+set language_category_tree_assigned_p [db_0or1row language_category_tree {
+ select octr.subtree_root_node_id as language_subtree_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :language_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'
+}]
+
+if {!$language_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+
+set proficiency_category_tree_assigned_p [db_0or1row proficiency_category_tree {
+ select octr.subtree_root_node_id as proficiency_subtree_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :proficiency_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'
+}]
+
+if {!$proficiency_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+
+set role_list [db_list_of_lists get_role_categories {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id
+ from sw_category_dim
+ start with node_id = :role_subtree_root_id
+ connect by prior node_id = parent_node_id
+}]
+
+set roles [list]
+foreach single_role $role_list {
+ if {[lsearch $selected_role_ids [snd $single_role]] > -1} {
+ if {[string equal [fst $single_role] "Other"]} {
+ lappend roles "[fst $single_role] ($role_other)"
+ } else {
+ lappend roles [fst $single_role]
+ }
+ }
+}
+set roles [join $roles ", "]
+
+
+set language_list [db_list_of_lists get_language_categories {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id
+ from sw_category_dim
+ start with node_id = :language_subtree_root_id
+ connect by prior node_id = parent_node_id
+}]
+
+set language_id_list [map snd $language_list]
+set second_language [fst [lindex $language_list [lsearch $language_id_list $second_language_id]]]
+set third_language [fst [lindex $language_list [lsearch $language_id_list $third_language_id]]]
+
+
+set language_prof_list [db_list_of_lists get_language_prof_categories {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id
+ from sw_category_dim
+ start with node_id = :proficiency_subtree_root_id
+ connect by prior node_id = parent_node_id
+}]
+
+set language_prof_id_list [map snd $language_prof_list]
+set second_language_prof [fst [lindex $language_prof_list [lsearch $language_prof_id_list $second_language_prof_id]]]
+set third_language_prof [fst [lindex $language_prof_list [lsearch $language_prof_id_list $third_language_prof_id]]]
+
+set replacement_list [list \
+ user_name $user_name \
+ user_email $user_email \
+ library_url [ad_url]$library_url \
+ project_id $resource_req_id \
+ project_name $project_name \
+ project_type $project_type \
+ demand_id $object_id \
+ demand_name $demand_name \
+ demand_type $demand_type \
+ recipient $recipient \
+ subject $subject \
+ contact_data $contact_data \
+ nationality $nationality \
+ manager_email $manager_email \
+ roles $roles \
+ working_area $working_area \
+ first_language $first_language \
+ second_language $second_language \
+ third_language $third_language \
+ second_language_prof $second_language_prof \
+ third_language_prof $third_language_prof \
+ other_language $other_language \
+ from_date [util_AnsiDatetoPrettyDate $from_date] \
+ to_date [util_AnsiDatetoPrettyDate $to_date] \
+ strengths $strengths \
+ leadership $leadership \
+ intercultural $intercultural \
+ comments $comments \
+ conditions $conditions ]
+
+set community_id [db_string get_community_id {
+ select community_id
+ from sn_community_instances_all
+ where package_id = :package_id
+}]
+
+
+set email_set [et_process -community_id $community_id "psn_application" $replacement_list]
+
+## generate my email in a file - to prevent having all huge attachments in a tcl variable
+## first generate header
+set email_filename [ns_tmpnam]
+set fd [open $email_filename w]
+fconfigure $fd -encoding iso8859-1
+puts $fd "This is a multi-part message in MIME format.
+
+--$boundary_string
+Content-Type: text/plain; charset=\"iso-8859-1\"
+Content-Transfer-Encoding: quoted-printable
+
+"
+close $fd
+
+## cut out all carriage returns out of the email form
+regsub -all {\r} [ns_set get $email_set "body"] {} body
+
+## now append encoded cleartext-email (->input form)
+set tmp_filename [ad_mime_encode -string $body "quoted-printable"]
+exec /bin/sh -c "cat $tmp_filename >> $email_filename"
+ns_unlink $tmp_filename
+
+set attachment_list [db_list_of_lists get_attachment_id_list {
+ select attachment_id, mime_type, filename
+ from psn_attachments
+ where application_id = :application_id
+}]
+
+## now append all attachments
+foreach attachment $attachment_list {
+ util_unlist $attachment attachment_id mime_type filename
+ set tmp_filename [ns_tmpnam]
+ db_blob_get_file get_actual_attachment "
+ select attachment from psn_attachments where attachment_id = $attachment_id
+ " -file $tmp_filename
+
+ ## append attachment separator
+ set fd [open $email_filename a]
+ fconfigure $fd -encoding iso8859-1
+ puts $fd "
+--$boundary_string
+Content-Type: $mime_type; name=\"[ad_quotehtml $filename]\"
+Content-Transfer-Encoding: base64
+Content-Disposition: attachment; filename=\"[ad_quotehtml $filename]\"
+
+"
+ close $fd
+
+ ## append encoded attachment
+ set tmp_filename_enc [ad_mime_encode -file $tmp_filename base64]
+ exec /bin/sh -c "cat $tmp_filename_enc >> $email_filename"
+ ns_unlink $tmp_filename_enc
+}
+
+## append closing string at the end
+set fd [open $email_filename a]
+fconfigure $fd -encoding iso8859-1
+puts $fd "
+
+--$boundary_string\--
+"
+close $fd
+
+## now get the complete email in just one chunk in a tcl variable (yeah....)
+set fd [open $email_filename r]
+fconfigure $fd -encoding iso8859-1
+ns_set update $email_set "body" [read $fd]
+close $fd
+ns_unlink $email_filename
+
+db_transaction {
+ et_queue_email -content_type "multipart/mixed; boundary=\"$boundary_string\"" $email_set
+ ns_set update $email_set "to" $user_email
+ et_queue_email -content_type "multipart/mixed; boundary=\"$boundary_string\"" $email_set
+ db_dml set_object_state {
+ update acs_objects_description
+ set state = 'a'
+ where object_id = :application_id
+ }
+
+ db_dml set_sent_state {
+ update psn_res_applications
+ set sent_p = 't',
+ application_date = sysdate
+ where application_id = :application_id
+ }
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-send.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-send.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-send.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,36 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+<form method=post action="resource-application-send-2">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<table width=100%>
+
+<tr><th align=left valign=top>To: </th><td>@mail_to@<p></td></tr>
+
+<tr><th align=left valign=top>From: </th><td>@mail_from@<p></td></tr>
+
+<tr><th align=left valign=top>Subject: </th><td>@mail_subject@<p></td></tr>
+
+<tr><th align=left valign=top>Body: </th><td>@mail_body;noquote@<p></td></tr>
+
+<if @attachments:rowcount@ gt 0>
+ <tr><th align=left>Attachments: </th><td> </td></tr>
+ <tr><td>Filename </td><td>Size</td></tr>
+ <multiple name=attachments>
+ <tr><td>@attachments.filename@ </td><td>@attachments.bytes@</td></tr>
+ </multiple>
+</if>
+
+</table>
+
+<tr><td align=center colspan=2>
+<input type=submit name="edit" value="Edit again">
+<input type=submit name="send" value="Send Message">
+</td></tr>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application-send.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application-send.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application-send.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,266 @@
+ad_page_contract {
+ /packages/library/www/resource-application-send.tcl
+
+ Show user a confirmation page of everything that would appear in the email
+
+ @author Timo Hentschel (timo@arsdigita.com)
+ @cvs-id $Id: resource-application-send.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ application_id:integer,notnull
+ {category_id ""}
+ return_url:notnull
+} -properties {
+ mail_to:onevalue
+ mail_from:onevalue
+ mail_subject:onevalue
+ mail_body:onevalue
+ attachments:multirow
+ form_vars:onevalue
+ title:onevalue
+ pretty_demand_type:onevalue
+ demand_name:onevalue
+ pretty_project_type:onevalue
+ project_name:onevalue
+ graphic:onevalue
+ graphic_width:onevalue
+ dc_export:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+set application_exists [db_0or1row get_application_data {
+ select user_id as application_user_id, object_id, resource_req_id, sent_p,
+ recipient, subject, contact_data, nationality, manager_email,
+ working_area, first_language, second_language_id, role_other,
+ third_language_id, second_language_prof_id,
+ third_language_prof_id, other_language, from_date, to_date,
+ strengths, leadership, intercultural, comments, conditions
+ from psn_res_applications
+ where application_id = :application_id
+}]
+
+if !$application_exists {
+ ad_return_complaint 1 "There is no such application."
+ return
+}
+if {![string equal $user_id $application_user_id]} {
+ ad_return_complaint 1 "This is not your application. Your are not allowed to edit or sent it."
+ return
+}
+if {$sent_p == "t"} {
+ ad_return_complaint 1 "This application already got sent. There is no way to edit it later, but you can sent a new application."
+ return
+}
+
+if ![km_check_object_id $object_id] { return }
+
+set demand_type_id [km_conn object_type_id]
+set pretty_demand_type [km_static object_type_pretty_name $demand_type_id]
+set demand_name [km_conn object_name]
+set graphic [km_static object_type_graphic $demand_type_id]
+set graphic_width [library_icon_width]
+
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data [list "resource-application-edit?[export_url_vars application_id category_id return_url]" "Apply"] "Confirm"
+
+if ![km_check_object_id $resource_req_id] { return }
+set project_type_id [km_conn object_type_id]
+set pretty_project_type [km_static object_type_pretty_name $project_type_id]
+set project_name [km_conn object_name]
+
+set title "Confirm Application Email"
+set form_vars [export_form_vars application_id category_id return_url]
+
+db_1row get_username {
+ select first_names || ' ' || last_name as user_name, email as user_email
+ from users
+ where user_id = :user_id
+}
+
+db_1row package_location {
+ select site_node.url(sn.node_id) as library_url
+ from site_nodes sn, acs_objects_description dsc
+ where dsc.object_id = :object_id
+ and sn.object_id = dsc.package_id
+ and rownum = 1
+}
+
+set selected_role_ids [db_list get_application_roles {
+ select role_id
+ from psn_res_application_roles
+ where application_id = :application_id
+}]
+
+set magic_ids_exist_p [db_0or1row get_magic_ids_for_category_trees {
+ select role_magic_id, language_magic_id, proficiency_magic_id
+ from psn_category_trees
+ where package_id = :package_id
+}]
+
+if {!$magic_ids_exist_p} {
+ ad_return_complaint 1 "Error in library setup. No magic ids for category trees for the application form found."
+ return
+}
+if {!$role_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+if {!$language_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+if {!$proficiency_magic_id} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+set role_category_tree_assigned_p [db_0or1row role_category_tree {
+ select octr.subtree_root_node_id as role_subtree_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :role_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'
+}]
+
+if {!$role_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for roles. Please contact a library administrator."
+ return
+}
+
+set language_category_tree_assigned_p [db_0or1row language_category_tree {
+ select octr.subtree_root_node_id as language_subtree_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :language_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'
+}]
+
+if {!$language_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for languages. Please contact a library administrator."
+ return
+}
+
+set proficiency_category_tree_assigned_p [db_0or1row proficiency_category_tree {
+ select octr.subtree_root_node_id as proficiency_subtree_root_id
+ from generic_trees gt,
+ acs_rels ar,
+ object_category_tree_rels octr
+ where ar.object_id_one = :proficiency_magic_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel'
+}]
+
+if {!$proficiency_category_tree_assigned_p} {
+ ad_return_complaint 1 "No category tree assigned for language proficiencies. Please contact a library administrator."
+ return
+}
+
+set role_list [db_list_of_lists get_role_categories {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id
+ from sw_category_dim
+ start with node_id = :role_subtree_root_id
+ connect by prior node_id = parent_node_id
+}]
+
+set roles [list]
+foreach single_role $role_list {
+ if {[lsearch $selected_role_ids [snd $single_role]] > -1} {
+ if {[string equal [fst $single_role] "Other"]} {
+ lappend roles "[fst $single_role] ($role_other)"
+ } else {
+ lappend roles [fst $single_role]
+ }
+ }
+}
+set roles [join $roles ", "]
+
+
+set language_list [db_list_of_lists get_language_categories {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id
+ from sw_category_dim
+ start with node_id = :language_subtree_root_id
+ connect by prior node_id = parent_node_id
+}]
+
+set language_id_list [map snd $language_list]
+set second_language [fst [lindex $language_list [lsearch $language_id_list $second_language_id]]]
+set third_language [fst [lindex $language_list [lsearch $language_id_list $third_language_id]]]
+
+
+set language_prof_list [db_list_of_lists get_language_prof_categories {
+ select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as name,
+ object_id as category_id
+ from sw_category_dim
+ start with node_id = :proficiency_subtree_root_id
+ connect by prior node_id = parent_node_id
+}]
+
+set language_prof_id_list [map snd $language_prof_list]
+set second_language_prof [fst [lindex $language_prof_list [lsearch $language_prof_id_list $second_language_prof_id]]]
+set third_language_prof [fst [lindex $language_prof_list [lsearch $language_prof_id_list $third_language_prof_id]]]
+
+set replacement_list [list \
+ user_name $user_name \
+ user_email $user_email \
+ library_url [ad_url]$library_url \
+ project_id $resource_req_id \
+ project_name $project_name \
+ project_type $pretty_project_type \
+ demand_id $object_id \
+ demand_name $demand_name \
+ demand_type $pretty_demand_type \
+ recipient $recipient \
+ subject $subject \
+ contact_data $contact_data \
+ nationality $nationality \
+ manager_email $manager_email \
+ roles $roles \
+ working_area $working_area \
+ first_language $first_language \
+ second_language $second_language \
+ third_language $third_language \
+ second_language_prof $second_language_prof \
+ third_language_prof $third_language_prof \
+ other_language $other_language \
+ from_date [util_AnsiDatetoPrettyDate $from_date] \
+ to_date [util_AnsiDatetoPrettyDate $to_date] \
+ strengths $strengths \
+ leadership $leadership \
+ intercultural $intercultural \
+ comments $comments \
+ conditions $conditions ]
+
+set community_id [db_string get_community_id {
+ select community_id
+ from sn_community_instances_all
+ where package_id = :package_id
+}]
+
+
+set email_set [et_process -community_id $community_id "psn_application" $replacement_list]
+
+set mail_from [ns_set get $email_set "from"]
+set mail_to [ns_set get $email_set "to"]
+set mail_subject [ns_set get $email_set "subject"]
+set mail_body [util_make_href_and_mailto_links_and_convert_to_html [ns_set get $email_set "body"]]
+
+db_multirow attachments get_attachment_list {
+ select attachment_id, mime_type, filename, dbms_lob.getlength(attachment) as bytes
+ from psn_attachments
+ where application_id = :application_id
+}
+
+set dc_export [doubleclick::signature_html]
+
+db_release_unused_handles
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/resource-application.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/resource-application.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/resource-application.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,157 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+<property name="graphic_width">@graphic_width@</property>
+
+<form method=post action="resource-application-save">
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<table width=100%>
+
+<tr><td> </td><td><font size=2><b>Please fill out the following e-mail form to apply</b></font></td></tr>
+
+<tr><td> </td><td><table cellpadding=1 cellspacing=1 width=75%>
+<tr><th align=left>Your Application</th></tr>
+
+<tr><th align=left>To:</th></tr>
+
+<tr><td>@recipient@</td></tr>
+
+<tr><th align=left>Subject:</th></tr>
+
+<tr><td><input type=text size=80 name="subject" value="@subject@"></td></tr>
+
+<tr><th align=left>My contact data</th></tr>
+
+<tr><td><textarea name="contact_data" cols=80 rows=3>@contact_data@</textarea></td></tr>
+
+<tr><th align=left>Nationality</th></tr>
+
+<tr><td><input type=text size=80 name="nationality" value="@nationality@"></td></tr>
+
+<tr><th align=left>Email of my Line Manager</th></tr>
+
+<tr><td><input type=text size=80 name="manager_email" value="@manager_email@"></td></tr>
+
+<tr><th align=left>My professional background can be described as follows:</th></tr>
+
+<tr><th align=left>Role / Function</th></tr>
+<tr><td><i>Please select your areas of expertise</i> - <font size=2>Hold 'ctrl' key and click to select multiple entries</font></td></tr>
+
+<tr><td>@role_select;noquote@</td></tr>
+
+<tr><td><i>If 'Other' please specify</i></td></tr>
+<tr><td><input type=text size=80 name="role_other" value="@role_other@"></td></tr>
+
+<tr><th align=left>Working Area</th></tr>
+<tr><td><i>Please describe your professional tasks and responsibilities of the previous years</i></td></tr>
+
+<tr><td><textarea name="working_area" cols=80 rows=3>@working_area@</textarea></td></tr>
+
+<tr><th align=left>Language skills</th></tr>
+<tr><td><i>Please indicate your capability</i></td></tr>
+
+<tr><td>Native language: <input type=text size=60 name="first_language" value="@first_language@"></td></tr>
+
+<tr><td>Second language: <select name="second_language_id">
+<option value="">--Please select--
+<if @languages:rowcount@ gt 0>
+ <multiple name=languages>
+ <option value="@languages.language_id@"<if @languages.language_id@ eq @second_language_id@> selected</if>>@languages.name;noquote@
+ </multiple>
+</if>
+</select>
+proficiency: <select name="second_language_prof_id">
+<option value="">--Please select--
+<if @language_proficiencies:rowcount@ gt 0>
+ <multiple name=language_proficiencies>
+ <option value="@language_proficiencies.prof_id@"<if @language_proficiencies.prof_id@ eq @second_language_prof_id@> selected</if>>@language_proficiencies.name;noquote@
+ </multiple>
+</if>
+</select> </td></tr>
+
+<tr><td>Third language: <select name="third_language_id">
+<option value="">--Please select--
+<if @languages:rowcount@ gt 0>
+ <multiple name=languages>
+ <option value="@languages.language_id@"<if @languages.language_id@ eq @third_language_id@> selected</if>>@languages.name;noquote@
+ </multiple>
+</if>
+</select>
+proficiency: <select name="third_language_prof_id">
+<option value="">--Please select--
+<if @language_proficiencies:rowcount@ gt 0>
+ <multiple name=language_proficiencies>
+ <option value="@language_proficiencies.prof_id@"<if @language_proficiencies.prof_id@ eq @third_language_prof_id@> selected</if>>@language_proficiencies.name;noquote@
+ </multiple>
+</if>
+</select> </td></tr>
+
+<tr><th align=left>Other language skills</th></tr>
+<tr><td><i>Please also specify your level of fluency</i></td></tr>
+
+<tr><td><input type=text size=80 name="other_language" value="@other_language@"></td></tr>
+
+<tr><th align=left>Availability</th></tr>
+
+<tr><td>I am available from:</td></tr>
+
+<tr><td><include src="km-date-tag" day_value="@from_day@" month_value="@from_month@" year_value="@from_year@" presentation_type="custom" question_id="" name="from_date"></td></tr>
+
+<tr><td>To:</td></tr>
+
+<tr><td><include src="km-date-tag" day_value="@to_day@" month_value="@to_month@" year_value="@to_year@" presentation_type="custom" question_id="" name="to_date"></td></tr>
+
+<tr><th align=left>Interests & Experiences</th></tr>
+<tr><td><i>Please describe your strengths</i></td></tr>
+
+<tr><td><textarea name="strengths" cols=80 rows=5>@strengths@</textarea></td></tr>
+
+<tr><th align=left>Leadership</th></tr>
+<tr><td><i>If leadership is required in the demand</i></td></tr>
+
+<tr><td><textarea name="leadership" cols=80 rows=5>@leadership@</textarea></td></tr>
+
+<tr><th align=left>Intercultural experience</th></tr>
+<tr><td><i>If intercultural experience is required in the demand</i></td></tr>
+
+<tr><td><textarea name="intercultural" cols=80 rows=5>@intercultural@</textarea></td></tr>
+
+<tr><th align=left>Personal comments</th></tr>
+
+<tr><td><textarea name="comments" cols=80 rows=5>@comments@</textarea></td></tr>
+
+<tr><th align=left>Commercial conditions or contact person for this application</th></tr>
+<tr><td><i>If you cannot give information about the commercial conditions, please give the email address of the responsible person.</i></td></tr>
+
+<tr><td><textarea name="conditions" cols=80 rows=5>@conditions@</textarea></td></tr>
+
+<tr><th align=left>Attachments</th></tr>
+<tr><td><i>Feel free to attach more information to your application, e.g. your CV or relevant documents</i></td></tr>
+<if @attachments:rowcount@ gt 0>
+ <tr><td>
+ <table><tr><th align=left>Size </th><th align=left>Filename </th></tr>
+ <multiple name=attachments>
+ <tr><td>@attachments.size@ Bytes </td><td>@attachments.filename@ </td><td><input type=submit name="delete@attachments.attachment_id@" value="Remove"></td></tr>
+ </multiple>
+ </table>
+ </td></tr>
+</if>
+
+<tr><td> <input type=submit name="attach" value="Add an attachment"></td></tr>
+
+<tr><th align=left><font color=red>"I hereby confirm that I have consulted my direct line manager about the possible transfer. He agrees with this application."</font></th></tr>
+
+<tr><td align=center><input type=submit name="cancel_form" value="Cancel changes">
+<input type=submit name="save" value="Save to complete later">
+<input type=submit name="send" value="Send Message">
+<if @edit_p@ eq 1>
+ <input type=submit name="dont_apply" value="Cancel Application completely">
+</if>
+</td></tr>
+
+</table></td></tr>
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/result-pages.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/result-pages.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/result-pages.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,12 @@
+<if @object_count@ gt 100>
+<p>Result page:
+
+<if @prev_url@ not nil><a href="@prev_url@">Previous</a> </if>
+
+<multiple name="result_pages">
+ <if @result_pages.selected_p@ eq 1><b>@result_pages.label@</b> </if>
+ <else><a href="@result_pages.url@">@result_pages.label@</a> </else>
+</multiple>
+
+<if @next_url@ not nil><a href="@next_url@">Next</a></if>
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/result-pages.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/result-pages.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/result-pages.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,34 @@
+if { $first_row > 1 } {
+ set new_first_row [max 1 [expr $first_row - 100]]
+ set new_last_row [min $object_count [expr $new_first_row + 99]]
+
+ set prev_url "$url_stub&first_row=$new_first_row&last_row=$new_last_row"
+}
+
+if { $last_row < $object_count } {
+ set new_first_row [min $object_count [expr $first_row + 100]]
+ set new_last_row [min $object_count [expr $new_first_row + 99]]
+
+ set next_url "$url_stub&first_row=$new_first_row&last_row=$new_last_row"
+}
+
+template::multirow create result_pages url label selected_p
+
+set cur_first_row 1
+set cur_last_row [min $object_count 100]
+set counter 1
+while { $cur_first_row <= $cur_last_row && $cur_last_row <= $object_count } {
+ if { $first_row >= $cur_first_row && $first_row <= $cur_last_row } {
+ set selected_p 1
+ } else {
+ set selected_p 0
+ }
+
+ set url "$url_stub&first_row=$cur_first_row&last_row=$cur_last_row"
+
+ template::multirow append result_pages $url $counter $selected_p
+
+ incr counter
+ set cur_first_row [expr $cur_first_row + 100]
+ set cur_last_row [min $object_count [expr $cur_last_row + 100]]
+}
Index: openacs-4/contrib/obsolete-packages/library/www/send-page-ref-2.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/send-page-ref-2.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/send-page-ref-2.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,29 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<form method=post action="send-page-ref-3">
+<csrf-token>
+@form_vars;noquote@
+
+<table width=100%>
+<tr><td> </td><td><font size=2><b>Please fill out the following e-mail form to send the page to your colleague:</b></font></td></tr>
+<tr><td> </td><td><table cellpadding=1 cellspacing=1 width=75%>
+<tr><th align=left>Your Email</th></tr>
+<tr><th align=left>To:</th></tr>
+<tr><td><input type=text size=80 name="recipient" value="@recipient_name@ <@email@>"></td></tr>
+<tr><th align=left>Subject:</th></tr>
+<tr><td><input type=text size=80 name="subject" value="@subject@"></td></tr>
+<tr><th align=left>Message:</th></tr>
+<tr><td><textarea name="body" cols=80 rows=15>
+@sender_name@ has forwarded you the following @system_name@ content:
+
+@complete_page_url@
+
+</textarea></td></tr>
+<tr><td> </td></tr>
+
+<tr><td align=center><input type=submit value="Send Message"></td></tr>
+
+</table></td></tr>
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/send-page-ref-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/send-page-ref-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/send-page-ref-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,51 @@
+ad_page_contract {
+ /www/library/send-page-ref-2.tcl
+
+ Let the user edit the HREF email.
+
+ @cvs-id $Id: send-page-ref-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_id:notnull
+ page_url:notnull
+ return_title:notnull
+ user_id_from_search:notnull,integer
+ {category_id ""}
+} -properties {
+ title:onevalue
+ recipient_name:onevalue
+ email:onevalue
+ subject:onevalue
+ sender_name:onevalue
+ page_url:onevalue
+ system_name:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if {![db_0or1row send_page_ref_2_10 "
+ select first_names || ' ' || last_name as recipient_name, email
+ from users where user_id=:user_id_from_search"]} {
+ ad_return_complaint 1 "<li>The user with ID $user_id_from_search does not exist."
+ return
+}
+
+# Remove the dash added in send-page-ref.
+set page_url [string range $page_url 1 end]
+
+set system_name [km_get_community_name]
+set subject "Forwarded from the \"$system_name\" community: $return_title"
+set title "Edit Mail"
+if ![km_check_object_id $object_id] { return }
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data [list "send-page-ref?[export_url_vars page_url return_title object_id category_id]" "Send to colleague"] $title
+
+set form_vars [export_form_vars page_url user_id_from_search object_id]
+set complete_page_url "[ad_url]$page_url"
+
+# Get the sender's info, too
+set sender_name [db_string send_page_ref_2_20 "
+ select first_names || ' ' || last_name sender_name
+ from users where user_id=:user_id"]
+
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/send-page-ref-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/send-page-ref-3.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/send-page-ref-3.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,35 @@
+ad_page_contract {
+ /www/library/send-page-ref-3.tcl
+
+ Actually send the HREF mail.
+
+ @cvs-id $Id: send-page-ref-3.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ {page_url ""}
+ object_id:notnull
+ recipient:notnull
+ user_id_from_search:notnull,integer
+ subject:notnull
+ body:notnull
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+if ![km_check_object_id $object_id] { return }
+
+set sender [db_string send_page_ref_3_10 "select email from users where user_id=:user_id"]
+
+db_dml send_page_ref_3_20 "insert into recommendations_log
+ (sender_id, recipient_id, url, object_id, when)
+ values (:user_id, :user_id_from_search, :page_url, :object_id, SYSDATE)"
+
+if { [catch {ns_sendmail $recipient $sender $subject $body} errmsg] } {
+ ns_log Warning "ns_sendmail failed in send-page-ref-3.tcl: $errmsg"
+
+ ad_return_warning "Mail Error" \
+ "Your mail could not be sent. Here is the error
+ message we got: <blockquote>$errmsg</blockquote>"
+ return
+}
+
+ad_returnredirect $page_url
Index: openacs-4/contrib/obsolete-packages/library/www/send-page-ref.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/send-page-ref.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/send-page-ref.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,14 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<p>Locate your colleague by
+
+<form method=get action="user-search">
+@form_vars;noquote@
+
+<table border=0>
+<tr><td>Email address / surname contains:</td><td><input type=text name=keyword size=40></td></tr>
+<tr><td colspan=2 align="center"><input type=submit value="Search"></td></tr>
+
+</table>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/send-page-ref.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/send-page-ref.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/send-page-ref.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,38 @@
+ad_page_contract {
+ /www/library/send-page-ref.tcl
+
+ Let the user select the recipient to which he wants to send an HREF.
+
+ @cvs-id $Id: send-page-ref.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ page_url:notnull
+ return_title:notnull
+ object_id:notnull
+ {category_id ""}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+}
+
+ad_maybe_redirect_for_registration
+if {![km_check_object_id $object_id]} {
+ return
+}
+
+
+if ![km_check_object_id $object_id] { return }
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Send to colleague"
+set title "Send a Page to a Colleague"
+set target "send-page-ref-2"
+set passthrough {page_url return_title object_id category_id}
+set context_bar [list "send-page-ref?[export_url_vars page_url return_title object_id category_id]" "Send to colleague"]
+set show_myself_p f
+
+# Because of Siemens' IMS application proxy, we have to make sure
+# that page_url doesn't start with a "/".
+set page_url "-$page_url"
+
+set form_vars [export_form_vars show_myself_p target passthrough context_bar page_url return_title object_id category_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/show-descriptions.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/show-descriptions.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/show-descriptions.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,16 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+<dl>
+<multiple name=categories>
+<dt><b>@categories.item;noquote@</b></dt><dd>@categories.description@</dd>
+</multiple>
+</dl>
+
+<hr>
+
+<div align=center>
+<form>
+<input type=button value="Close this window" onclick="window.close()">
+</form>
+</div>
Index: openacs-4/contrib/obsolete-packages/library/www/show-descriptions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/show-descriptions.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/show-descriptions.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,31 @@
+ad_page_contract {
+ /www/library/show-descriptions.tcl
+
+ Show category descriptions.
+
+ @cvs-id $Id: show-descriptions.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:notnull,integer
+} -properties {
+ title:onevalue
+ categories:multirow
+}
+
+set title "Category Descriptions"
+
+template::multirow create categories item description
+
+set node_id [db_string get_node_id_from_questions {
+ select node_id from sn_questions where question_id = :question_id
+}]
+set category_list [swc_get_category_tree $node_id 0 {}]
+
+foreach category $category_list {
+ util_unlist $category category_id name description
+ if {[empty_string_p $description]} {
+ set description "-"
+ }
+ template::multirow append categories $name $description
+}
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/user-link-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/user-link-add.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/user-link-add.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,67 @@
+# /www/library/user-link-add.tcl
+#
+# $Id: user-link-add.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_contract {
+
+} {
+ user_id_from_search:notnull,integer
+ email_from_search:notnull
+ path_id:notnull,integer
+}
+csrf::authenticate
+
+if ![path_valid_p $path_id] {
+ ad_return_error "Invalid Path" \
+ "The current path ID is invalid. Perhaps you used your browser's Back button
+ and tried to add another user?"
+ return
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# Determine to which object we are going to add the user reference,
+# and if the current user is allowed to do this.
+
+set values [get_path_values -action_only_p 0 $path_id]
+set object_id [value_from_tuples $values object_id]
+set question_id [value_from_tuples $values question_id]
+set category_id [value_from_tuples $values category_id]
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set link_type bi_directional
+
+set new_link_id [db_string km_link_objects_10 "select
+sn_links_seq.nextval from dual"]
+
+db_transaction {
+
+db_dml user_link_add_20 {insert into sn_links (link_id, link_type, object_id_a,
+object_id_b, creation_user, creation_date)
+values (:new_link_id, :link_type, :object_id,
+:user_id_from_search, :user_id, sysdate)}
+
+set content "Added link to user [DoubleApos $email_from_search]"
+set ip_address [ns_conn peeraddr]
+db_exec_plsql user_link_add_30 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+}
+
+
+db_dml km_link_objects_40 {insert into sn_question_link_map (link_id, question_id)
+values (:new_link_id, :question_id)}
+
+}
+
+# All done, back to the path's origin.
+
+ad_returnredirect [get_path_return_url $path_id]
Index: openacs-4/contrib/obsolete-packages/library/www/user-link-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/user-link-delete-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/user-link-delete-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,64 @@
+# /www/library/user-link-delete-2.tcl
+#
+# Delete an object-user link.
+#
+# $Id: user-link-delete-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_variables {
+ link_id
+ return_url
+}
+csrf::authenticate
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# We are dealing with object <-> user links here.
+# The following query relies on the object being
+# referenced by the object_id_a column.
+
+set context_id [ad_conn package_id]
+if {![db_0or1row user_link_delete_2_10 {
+ select l.object_id_a as object_id, u.email, map.question_id
+ from sn_links l, users u, sn_question_link_map map
+ where l.link_id=:link_id
+ and map.link_id = l.link_id
+ and l.object_id_b = u.user_id}]} {
+ # The link already has been deleted.
+
+ ad_returnredirect $return_url
+ return
+}
+
+# Check if the user is authorized to delete this link.
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+# All checks passed - let's delete the row.
+
+db_transaction {
+
+ db_dml user_link_delete_2_20 "delete from sn_links where link_id=:link_id"
+ set content "Deleted link to user [DoubleApos $email]"
+ set ip_address [ns_conn peeraddr]
+ db_exec_plsql user_link_delete_2_40 {
+ begin
+ object.audit_object (
+ v_object_id => :object_id,
+ v_question_id => :question_id,
+ v_last_modifying_user_id => :user_id,
+ v_modifying_ip => :ip_address,
+ v_content => :content
+ );
+ end;
+ }
+
+
+ db_dml user_link_delete_2_50 "
+ update sn_objects
+ set last_modified = sysdate, last_modifying_user_id = :user_id
+ [km_link_description_update $object_id $question_id]
+ where object_id = :object_id"
+
+}
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/user-link-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/user-link-delete.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/user-link-delete.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,22 @@
+<master src="master">
+<property name="title">@title;noquote@</property>
+
+Are you sure that you want to delete this link?
+
+<p><table>
+<tr>
+ <td>
+ <form action="user-link-delete-2" method=post>
+ <csrf-token>
+ @form_vars_delete;noquote@
+ <input type=submit name=submit value="Yes, Proceed">
+ </form>
+ </td>
+ <td>
+ <form action="one-question-edit" method=get>
+ @form_vars_cancel;noquote@
+ <input type=submit name=submit value="No, Cancel">
+ </form>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/user-link-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/user-link-delete.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/user-link-delete.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,24 @@
+# /www/library/user-link-delete.tcl
+#
+# Ask for confirmation before deleting a object-user mapping.
+#
+# $Id: user-link-delete.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_variables {
+ link_id
+ object_id
+ {category_id ""}
+ question_id
+}
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set return_url "one-question-edit?[export_url_vars object_id category_id question_id]"
+set object_name [km_conn object_name]
+set title "Delete user link \"$object_name\""
+set_the_usual_klib_context_bar $object_id $category_id
+append_context_bar_data "Delete User Link"
+
+set form_vars_delete [export_form_vars link_id return_url]
+set form_vars_cancel [export_form_vars object_id category_id question_id]
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/user-search.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/user-search.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/user-search.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1 @@
+<include src="/packages/acs-subsite/www/user-search">
Index: openacs-4/contrib/obsolete-packages/library/www/util.js
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/util.js,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/util.js 2 Jul 2003 12:19:43 -0000 1.1
@@ -0,0 +1,12 @@
+/* /www/library/util.js */
+
+function OpenPopup(file)
+{
+ var newWin;
+
+ newWin = window.open( file,
+ "Popup",
+ "width=420,height=550,menubar=no,toolbar=no,scrollbars=yes");
+ newWin.moveTo(0,0);
+ newWin.focus();
+}
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-description.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-description.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-description.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,163 @@
+ad_page_contract {
+ /packages/library/www/admin/add-description.tcl
+
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @cvs-id $Id: add-description.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+ abstract_data_type
+ short_p
+} -properties {
+}
+csrf::authenticate
+
+db_transaction {
+ if {$short_p} {
+ db_dml add_description_2 {delete from sn_types_map_short_name
+ where object_type_id=:object_type_id}
+
+ db_dml add_description_4 {insert into sn_types_map_short_name
+ values (:object_type_id, :question_id, 1)}
+
+ db_dml add_description_16 {update sn_objects set one_line_description = null where object_type_id=:object_type_id}
+ } else {
+ db_dml add_description_14 {update sn_object_types set long_description = :question_id where object_type_id=:object_type_id}
+
+ db_dml add_description_16 {update sn_objects set overview = null where object_type_id=:object_type_id}
+ }
+}
+
+km_static -reset $object_type_id
+
+if { [lsearch {text file integer} $abstract_data_type] != -1 } {
+
+ if { $short_p } {
+ db_dml add_description_30 "
+ update sn_objects obj
+ set one_line_description = (select dbms_lob.substr(content,0,3999) from sn_content
+ where question_id=:question_id
+ and object_id=obj.object_id)
+ where object_type_id=:object_type_id"
+
+ db_dml add_description_35 {
+ update acs_objects_description aodesc
+ set shortname = (select dbms_lob.substr(content,0,3999) from sn_content
+ where question_id=:question_id
+ and aodesc.object_id=object_id)
+ where aodesc.object_id in
+ (select object_id from sn_objects obj where obj.object_type_id=:object_type_id)}
+
+ } else {
+ db_dml add_description_40 "
+ update sn_objects obj
+ set overview = (select dbms_lob.substr(content,0,3999) from sn_content
+ where question_id=:question_id
+ and object_id=obj.object_id),
+ overview_html_p = (select html_p from sn_content
+ where question_id=:question_id
+ and object_id=obj.object_id)
+ where object_type_id=:object_type_id"
+ }
+
+ set descriptions [db_list_of_lists add_description_50 "
+ select c.object_id, c.content, c.html_p
+ from sn_content c, sn_objects obj
+ where c.question_id=:question_id
+ and c.object_id = obj.object_id
+ and obj.object_type_id = :object_type_id"]
+
+ foreach description $descriptions {
+ set object_id [fst $description]
+ set QQcontent [util_trim_string_with_hrefs [snd $description] 2000]
+ set html_p [thd $description]
+
+ if { $short_p } {
+ db_dml add_description_60 "
+ update sn_objects
+ set one_line_description = :QQcontent
+ where object_id=:object_id"
+ } else {
+ db_dml add_description_70 "
+ update sn_objects
+ set overview = :QQcontent, overview_html_p = :html_p
+ where object_id=:object_id"
+ }
+ }
+
+} elseif { $abstract_data_type == "date" } {
+
+ set sql_add_description_80 "
+ select c.object_id, content
+ from sn_content c, sn_objects obj
+ where question_id=:question_id
+ and c.object_id = obj.object_id
+ and obj.object_type_id = :object_type_id"
+
+ db_foreach add_description_80 $sql_add_description_80 {
+ if { $short_p } {
+ db_dml add_description_90 "
+ update sn_objects
+ set one_line_description = '[util_AnsiDatetoPrettyDate $content]'
+ where object_id=:object_id"
+ } else {
+ db_dml add_description_100 "
+ update sn_objects
+ set overview = '[util_AnsiDatetoPrettyDate $content]',
+ overview_html_p = 'f'
+ where object_id=:object_id"
+ }
+ }
+
+} elseif { [lsearch {object_link user_link content_link} $abstract_data_type] != -1 } {
+
+ set sql_add_description_105 "
+ select sw2.object_id, sw1.one_line_description as name
+ from sn_links l, sn_objects sw1, sn_objects sw2
+ where l.object_id_a = sw2.object_id
+ and l.object_id_b = sw1.object_id
+ and l.question_id = :question_id
+ and sw2.object_type_id = :object_type_id
+ order by sw2.object_id, name"
+
+ set last_object_id 0
+ set names {}
+ db_foreach add_description_105 $sql_add_description_105 {
+ if { $last_object_id && $last_object_id != $object_id } {
+ if { $short_p } {
+ db_dml add_description_110 "
+ update sn_objects
+ set one_line_description = '[DoubleApos [join $names ", "]]'
+ where object_id=:last_object_id"
+ } else {
+ db_dml add_description_120 "
+ update sn_objects
+ set overview = '[DoubleApos [join $names ", "]]',
+ overview_html_p = 'f'
+ where object_id=:last_object_id"
+ }
+ set names {}
+ }
+
+ lappend names $name
+
+ set last_object_id $object_id
+ }
+
+ if { $last_object_id } {
+ if { $short_p } {
+ db_dml add_description_130 "
+ update sn_objects
+ set one_line_description = '[DoubleApos [join $names ", "]]'
+ where object_id=:last_object_id"
+ } else {
+ db_dml add_description_140 "
+ update sn_objects
+ set overview = '[DoubleApos [join $names ", "]]',
+ overview_html_p = 'f'
+ where object_id=:last_object_id"
+ }
+ }
+}
+
+ad_returnredirect "edit-question?[export_url_vars object_type_id question_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-end-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-end-date.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-end-date.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,41 @@
+ad_page_contract {
+ /packages/library/www/admin/add-end-date.tcl
+
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: add-end-date.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+} -properties {
+}
+csrf::authenticate
+
+db_transaction {
+ db_dml add_end_date_10 {
+ update sn_object_types
+ set end_date = :question_id
+ where object_type_id= :object_type_id
+ }
+
+ db_dml add_end_date_20 {
+ update sn_objects obj
+ set end_date = nvl((select to_date(dbms_lob.substr(content,20,1),'YYYY-MM-DD') from sn_content where question_id=:question_id and object_id=obj.object_id) , '9999-12-31')
+ where object_type_id=:object_type_id
+ }
+}
+
+km_static -reset $object_type_id
+
+ad_returnredirect "edit-question?[export_url_vars object_type_id question_id]"
+
+
+
+
+
+
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-linked-question.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-linked-question.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-linked-question.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,19 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-question.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: add-linked-question.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+} -properties {
+}
+csrf::authenticate
+
+db_dml add_linked_question "update sn_object_types set linked_question_id =
+:question_id where object_type_id=:object_type_id"
+
+ad_returnredirect "edit-question?[export_url_vars object_type_id question_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-option-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-option-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-option-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,27 @@
+ad_page_contract {
+ /packages/library/www/admin/add-option-2.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: add-option-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ answer_option
+}
+csrf::authenticate
+
+if {[doubleclick::check_all]} {
+ ad_returnredirect "view-options?[export_url_vars object_type_id question_id]"
+ return
+}
+
+db_dml add_option_2_10 "
+insert into sn_answer_options (option_id, question_id, answer_option, sort_key)
+select acs_object_id_seq.nextval, :question_id, :answer_option,
+(select nvl(max(sort_key),0)+10 from sn_answer_options where question_id=:question_id)
+from dual"
+
+ad_returnredirect "view-options?[export_url_vars object_type_id question_id]"
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-option.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-option.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-option.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,18 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<form action="add-option-2" method=post>
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+<table cellspacing=3 cellpadding=3 bgcolor="<%=[ad_parameter table_bgcolor library #eeeeee]%>" width=100%>
+ <tr><th align=left bgcolor="<%=[ad_parameter table_color library #eeeeee]%>" >Please enter an option for
+ this new question. This will appear in the multiple-choice list for
+ this question.</th></tr>
+ <tr><td><include src="../km-input-tag" value="@value@" name="answer_option"></td></tr>
+</table>
+<br><br><br>
+<center>
+<input type=submit name=submit value="Proceed">
+</center>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-option.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-option.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-option.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,41 @@
+ad_page_contract {
+ /packages/library/www/admin/add-option.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: add-option.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ {option_id:integer 0}
+ {invisible_p 0}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ input_tag:onevalue
+ dc_export:onevalue
+}
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+if { $option_id } {
+ set value [km_answer_option $option_id]
+} else {
+ set value ""
+}
+
+set title "New Option"
+set_context_bar_data [list "." "Knowledge Library"] [list "view-questions?object_type_id=$object_type_id" "View Questions"] [list "view-options?[export_url_vars object_type_id question_id]" "Multiple Choice Options"] $title
+
+set form_vars [export_form_vars object_type_id option_id question_id invisible_p]
+set dc_export [doubleclick::signature_html]
+
+set pretty_question [db_string view_options_10 "select pretty_name
+ from sn_questions
+ where question_id = :question_id"]
+set view_options_title "Multiple Choice Options for $pretty_question"
+
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id&invisible_p=$invisible_p" "$pretty_type Questions"] [list "view-options?object_type_id=$object_type_id&question_id=$question_id" $view_options_title] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-public-until.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-public-until.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-public-until.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,43 @@
+ad_page_contract {
+ /packages/library/www/admin/add-public-until.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: add-public-until.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+} -properties {
+}
+csrf::authenticate
+
+db_transaction {
+ db_dml add_public_until_10 {
+ update sn_object_types
+ set public_until = :question_id
+ where object_type_id= :object_type_id
+ }
+
+ db_dml add_public_until_20 {
+ update sn_objects obj
+ set public_until = nvl((select to_date(dbms_lob.substr(content,20,1),'YYYY-MM-DD') from sn_content where question_id=:question_id and object_id=obj.object_id) , null)
+ where object_type_id=:object_type_id
+ }
+}
+
+km_static -reset $object_type_id
+
+ad_returnredirect "edit-question?[export_url_vars object_type_id question_id]"
+
+
+
+
+
+
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/add-start-date.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/add-start-date.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/add-start-date.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,41 @@
+ad_page_contract {
+ /packages/library/www/admin/add-start-date.tcl
+
+ @author Timo Hentschel (timo@arsdigita.com)
+
+ @cvs-id $Id: add-start-date.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+} -properties {
+}
+csrf::authenticate
+
+db_transaction {
+ db_dml add_start_date_10 {
+ update sn_object_types
+ set start_date = :question_id
+ where object_type_id= :object_type_id
+ }
+
+ db_dml add_start_date_20 {
+ update sn_objects obj
+ set start_date = nvl((select to_date(dbms_lob.substr(content,20,1),'YYYY-MM-DD') from sn_content where question_id=:question_id and object_id=obj.object_id) , '9999-12-31')
+ where object_type_id=:object_type_id
+ }
+}
+
+km_static -reset $object_type_id
+
+ad_returnredirect "edit-question?[export_url_vars object_type_id question_id]"
+
+
+
+
+
+
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,28 @@
+ad_page_contract {
+ /www/library/admin/approval-process-toggle-2
+
+ @cvs-id $Id: approval-process-toggle-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ {user_id_from_search:integer,notnull}
+}
+csrf::authenticate
+
+set package_id [ad_conn package_id]
+
+db_dml approval_process_toggle_2_10 {insert into approval_coordinators
+ (package_id, coordinator_id)
+ values
+ (:package_id, :user_id_from_search)
+}
+
+db_exec_plsql grant_permissions {
+ begin
+ acs_permission.grant_permission(:package_id, :user_id_from_search, 'read');
+-- acs_permission.grant_permission(:package_id, :user_id_from_search, 'km_publish');
+ end;
+}
+
+km_static -reset $package_id
+
+ad_returnredirect .
+return
Index: openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,12 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<form action="user-search" method="get">
+<csrf-token>
+@form_vars_search;noquote@
+
+Email address / surname contains:
+<input type=text name=keyword size=23>
+<input type=submit name=submit value="Search">
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/approval-process-toggle.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,42 @@
+ad_page_contract {
+ /packages/library/www/admin/approval-process-toggle.tck
+
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: approval-process-toggle.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ {approvalprocessp:oneof(t|f) "f"}
+} -properties {
+ title:onevalue
+}
+csrf::authenticate
+
+set package_id [ad_conn package_id]
+
+if {[string equal $approvalprocessp t]} {
+ # Set up variables for user-search.tcl.
+ set passthrough {}
+ set target "approval-process-toggle-2"
+ set show_myself_p t
+ set object_id_dependent f
+ set extra_permission km_publish
+ set extra_package_id $package_id
+ set context_bar [list "approval-process-toggle?[export_url_vars approvalprocessp]" "Add Approval Coordinator"]
+ set form_vars_search [export_form_vars target passthrough show_myself_p object_id_dependent extra_permission extra_package_id context_bar]
+ set title "Add Approval Coordinator"
+ set_context_bar_data $title
+ ad_return_template
+} else {
+ db_dml approval_process_toggle_2_10 {
+ delete from approval_coordinators
+ where package_id=:package_id
+ }
+ km_static -reset $package_id
+
+ ad_returnredirect .
+ return
+}
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/branch-tree.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/branch-tree.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/branch-tree.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,17 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic;noquote@</property>
+<property name="graphic_width">@graphic_width;noquote@</property>
+
+<if @questions:rowcount@ gt 0>
+The tree below shows all branch questions for this object_type:
+</if>
+<else>
+There are no branches for this object type.
+</else>
+<br>
+
+<multiple name="questions">
+@questions.indentation;noquote@@questions.link;noquote@<br>
+</multiple>
+<br>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/branch-tree.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/branch-tree.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/branch-tree.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,41 @@
+ad_page_contract {
+ /packages/library/www/admin/branch-tree.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: branch-tree.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id
+} -properties {
+ questions:multirow
+}
+
+# Object type info for page display
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+set graphic_width [library_icon_width]
+
+set sql_branch_tree_10 "
+select question_id, level
+from sn_question_object_type_map
+where object_type_id = $object_type_id
+ and (branch_p = 't'
+ or question_id in (select parent_question_id from sn_question_object_type_map where branch_p = 't' and object_type_id = $object_type_id))
+start with parent_question_id=[km_static km_dummy_object_id] and object_type_id=$object_type_id
+ and question_id in (select parent_question_id from sn_question_object_type_map where object_type_id = $object_type_id)
+connect by prior question_id = parent_question_id and object_type_id = $object_type_id"
+
+# Construct a tree with links to the individual branches
+
+template::multirow create questions indentation_level indentation link
+db_foreach branch_tree_10 $sql_branch_tree_10 {
+ set pretty_question [snd [km_get_question $question_id $object_type_id]]
+
+ template::multirow append questions $level [space -size [expr $level *5]] "<a href=\"view-branches?[export_url_vars question_id object_type_id]\">$pretty_question</a>"
+
+}
+
+set title "Branch Tree for $pretty_type"
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$pretty_type Questions"] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-category-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-category-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-category-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,70 @@
+ad_page_contract {
+ /packages/library/www/admin/create-category-2.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: choose-category-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+ tree_id
+ reset_categorization:optional
+} -properties {
+}
+csrf::authenticate
+
+# Get node_id for tree root
+set node_id [db_string get_root_node {
+ select root_node_id
+ from generic_trees
+ where tree_id = :tree_id
+}]
+
+# Test if another visible question is already using this category.
+set used_p [db_string check_uniqueness {
+ select count(*)
+ from sn_questions q, sn_question_object_type_map qm
+ where q.node_id = :node_id
+ and q.question_id = qm.question_id
+ and qm.object_type_id = :object_type_id
+ and qm.question_state <> 'invisible'
+ and q.question_id <> :question_id
+}]
+
+if { $used_p } {
+ ad_return_complaint 1 "<li>The selected category is already used by another question of this object type."
+ return
+}
+
+set old_node_id [km_get_node_id $question_id]
+
+db_transaction {
+ if { [info exists reset_categorization] && ![empty_string_p $old_node_id] &&
+ $node_id != $old_node_id } {
+
+ # Remove categorization which may be left over from a previous
+ # use of this category tree.
+
+ db_dml delete_categorization {
+ delete from sw_object_category_map
+ where category_id in (select child_category_id
+ from sw_flat_cat
+ where parent = :node_id)
+ and object_id in (select object_id
+ from sn_objects
+ where object_type_id = :object_type_id)
+ }
+ }
+
+ db_dml set_tree {
+ update sn_questions
+ set tree_id = :tree_id, node_id = :node_id
+ where question_id = :question_id
+ }
+}
+
+km_static -reset $question_id
+
+ad_returnredirect "view-questions?[export_url_vars object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-category.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-category.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-category.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,50 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<if @graphic@ not nil><img src="/library-files/@graphic@" height="50" width="50"></if>
+
+<if @tree_id@ eq "">
+
+<p>Please select the category tree for question
+<cite>@pretty_question@</cite> of object type
+<cite>@pretty_type@</cite> below.
+
+</if>
+<else>
+
+<p>Question <cite>@pretty_question@</cite> is associated with category
+tree <a href="categories/tree-view?tree_id=@tree_id@"
+target="_blank">@tree_name@</a>.<br> You may either <a
+href="categories/tree-view?tree_id=@tree_id@" target="_blank">edit</a>
+this category tree, or assign a different tree below.
+
+</else>
+
+<p>When you assign a new tree, you may remove existing object
+categorizations for the newly assigned tree. This is useful when the
+tree was used for a different question of this object type in the
+past.
+
+<form action="choose-category-2" method=post>
+<csrf-token>
+@form_vars;noquote@
+
+<table>
+<tr><td>Select a tree:</td>
+<td>
+<select name="tree_id" size=10>
+<multiple name="category_trees">
+<option value="@category_trees.tree_id@" <if @category_trees.tree_id@ eq @tree_id@>selected</if>>@category_trees.tree_name@
+</multiple>
+</select>
+<br>
+
+<input type=checkbox name=reset_categorization> Remove existing object-category mappings for newly assigned tree.
+</td>
+</tr>
+
+<tr><td align=center colspan=2><input type=submit name=submit value="Proceed"></td></tr>
+</table>
+</form>
+
+<p><a href="categories/" target="_blank">Administer Categories</a>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-category.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-category.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,68 @@
+ad_page_contract {
+ /packages/library/www/admin/choose-category.tcl
+
+ After creating a new question, let the user associate it
+ with a category tree.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: choose-category.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+} -properties {
+}
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_plural [km_static object_type_pretty_plural $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+set user_id [ad_verify_and_get_user_id]
+
+set tree_id [db_string get_current_tree {
+ select tree_id
+ from sn_questions
+ where question_id = :question_id
+}]
+
+db_multirow category_trees category_trees "
+ select g.tree_id, g.tree_name
+ from generic_tree_types t, generic_trees g
+ where t.tree_struct_table = 'sw_category_dim'
+ and t.type_id = g.type_id
+ and g.hidden_p = 'f'
+ and (g.site_wide_p = 't'
+ [ad_decode $tree_id "" "" "or g.tree_id = :tree_id"]
+ or [tcl_permission_for_bind_vars_p "g.tree_id" ":user_id" "'category_tree_read'"] = 't')
+ and g.root_node_id not in (select q.node_id
+ from sn_questions q, sn_question_object_type_map qm
+ where q.node_id is not null
+ and q.question_id = qm.question_id
+ and qm.object_type_id = :object_type_id
+ and qm.question_state <> 'invisible'
+ and q.question_id <> :question_id)
+ order by lower(tree_name)
+"
+
+set pretty_question [snd [km_get_question $question_id $object_type_id]]
+
+set title "Categories"
+set_context_bar_data \
+ [list "view-questions?object_type_id=$object_type_id" "$pretty_type Questions"] \
+ $title
+
+if { [empty_string_p $tree_id] } {
+ set tree_name ""
+} else {
+ set tree_name [db_string choose_category_10 {
+ select tree_name
+ from generic_trees
+ where tree_id = :tree_id
+ }]
+}
+
+set form_vars [export_form_vars question_id object_type_id]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-object-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-object-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-object-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,28 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<img src="/library-files/@graphic@" height="50" width="50">
+
+<h4>
+<if @abstract_data_type@ eq "object_link">
+Please select an object type from the list below as a target object type for @pretty_type@:
+</if>
+<else>
+Please select an object type from the list below for this linking question:
+</else>
+</h4>
+
+<form method=post action="map-link-question">
+<csrf-token>
+@form_vars;noquote@
+
+<multiple name="object_types">
+@object_types.object_input_type;noquote@
+</multiple>
+
+<br>
+<center>
+<input type="submit" value="Proceed">
+</center>
+</form>
+<br>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-object-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-object-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-object-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,37 @@
+ad_page_contract {
+ /packages/library/www/admin/choose-object-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: choose-object-type.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+ abstract_data_type
+} -properties {
+ title:onevalue
+ abstract_data_type:onevalue
+ pretty_type:onevalue
+ submit_button_html:onevalue
+ object_types:multirow
+}
+
+# Object type info for page display
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+template::multirow create object_types object_input_type
+set checked "checked"
+foreach type [km_get_all_object_types -browsable_only_p 0] {
+ template::multirow append object_types "<input type=radio name=linked_object_type_id value=\"[fst $type]\" $checked> [snd $type]<br>"
+ set checked ""
+}
+
+
+set title "Choose Object Type"
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$pretty_type Questions"] $title
+set form_vars [export_form_vars question_id object_type_id abstract_data_type]
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,37 @@
+ad_page_contract {
+ /packages/library/www/admin/
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: choose-presentation-type-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer,notnull
+ presentation_type
+ object_type_id:integer,notnull
+ {tag_height:integer ""}
+ {tag_width:integer ""}
+ {year_from:integer "-5"}
+ {year_to:integer "5"}
+}
+csrf::authenticate
+
+if {[empty_string_p $tag_height]} { set tag_height [db_null] }
+if {[empty_string_p $tag_width]} {set tag_width [db_null] }
+if {[empty_string_p $year_from]} { set year_from [db_null] }
+if {[empty_string_p $year_to]} {set year_to [db_null] }
+
+db_dml choose_presentation_type_2 {
+ update sn_questions set
+ presentation_type = :presentation_type,
+ tag_height = :tag_height,
+ tag_width = :tag_width,
+ year_from = :year_from,
+ year_to = :year_to
+ where question_id = :question_id
+}
+
+km_static -reset $question_id
+
+ad_returnredirect "view-questions?[export_url_vars object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,51 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<form action="choose-presentation-type-2">
+<csrf-token>
+@form_vars;noquote@
+
+<table width=100% cellpadding=3 cellspacing=3>
+<tr><th colspan=@count_tags@ align=left>Select the HTML form tag that should appear for this question:</th></tr>
+
+<tr>
+<multiple name="presentation_type_tags">
+ <th align=left valign=top>@presentation_type_tags.radio_row;noquote@</th>
+</multiple>
+</tr>
+
+<tr>
+<multiple name="presentation_type_tags">
+ <td valign=center>
+ <if @presentation_type_tags.abstract_data_type@ eq "date">
+ <include src="../km-date-tag" day_value="@day_value@" month_value="@month_value@" year_value="@year_value@" presentation_type="@presentation_type_tags.tag@" question_id="@question_id@" name="demo">
+ </if>
+ <else>
+ <include src="../question-field-option" items="@presentation_type_tags.items@" width="20" height="8" presentation_type="@presentation_type_tags.tag@" question_id="demo" question_state="active>
+ </else>
+ </td>
+</multiple>
+</tr>
+
+</table>
+<if @abstract_data_type@ ne "nephew_object">
+ <table width=100% cellpadding=3 cellspacing=3>
+ <tr>
+ <th align=left>Select the height and width of the tag (leave blank to use default height 60 and width 15).</th></tr>
+ <tr><th align=left>Width: <include src="../km-input-tag" value="@tag_width@" size="3" name="tag_width">
+ Height: <include src="../km-input-tag" value="@tag_height@" size="3" name="tag_height"></th>
+ </tr>
+ <if @abstract_data_type@ eq "date">
+ <tr>
+ <th align=left>Select the year range to be displayed in the select box in respect of the default.</th></tr>
+ <tr><th align=left>From: <include src="../km-input-tag" value="@year_from@" size="3" name="year_from">
+ To: <include src="../km-input-tag" value="@year_to@" size="3" name="year_to"></th>
+ </tr>
+ </if>
+ </table>
+</if>
+<center>
+<br><br>
+<input type=submit name=submit value="Proceed">
+</center>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-presentation-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,119 @@
+ad_page_contract {
+ /packages/library/www/admin/choose-presentation-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Timo Hentschel (timo@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: choose-presentation-type.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id
+ object_type_id
+ {abstract_data_type ""}
+ {presentation_type ""}
+} -properties {
+ tag_height:onevalue
+ tag_width:onevalue
+ presentation_type:onevalue
+ pretty_question:onevalue
+ abstract_data_type:onevalue
+ title:onevalue
+ form_vars:onevalue
+ presentation_type_tags:multirow
+ count_tags:onevalue
+}
+
+if [empty_string_p $abstract_data_type] {
+
+ set attributes [km_get_questions -question_states {} -all_properties_p 1 -root_node_p 0 -question_ids [list $question_id]]
+ set key [fst $attributes]
+ set question [snd $attributes]
+ set pretty_question [snd $question]
+ set question_id [lindex $question [lsearch $key question_id]]
+ set abstract_data_type [lindex $question [lsearch $key abstract_data_type]]
+ set presentation_type [lindex $question [lsearch $key presentation_type]]
+ set tag_height [lindex $question [lsearch $key tag_height]]
+ set tag_width [lindex $question [lsearch $key tag_width]]
+ set year_from [lindex $question [lsearch $key year_from]]
+ set year_to [lindex $question [lsearch $key year_to]]
+
+} else {
+
+ set tag_height ""
+ set tag_width ""
+ set year_from "-5"
+ set year_to "5"
+ set presentation_type ""
+ set pretty_question [db_string choose_presentation_type_10 "
+ select pretty_name from sn_questions where question_id = :question_id"]
+}
+
+set object_type [km_static object_type_pretty_name $object_type_id]
+
+#Decide which html tags to offer on the basis of the abstract_data_types
+switch $abstract_data_type {
+
+ "text" {
+ set tags {shorttext textarea textarea_with_refs}
+ set pretty_tags {"Short Text" "Textarea" "Textarea with Library/Web Reference Buttons"}
+ if [empty_string_p $presentation_type] { set presentation_type "shorttext" }
+ }
+
+ "integer" {
+ set tags {shorttext}
+ set pretty_tags {"Short Text"}
+ if [empty_string_p $presentation_type] { set presentation_type "shorttext" }
+ }
+
+ "option" - "other_category" -
+ "category" {
+ set tags {select selectmultiple checkbox radio}
+ set pretty_tags {"Select" "Select Multiple" "Checkbox" "Radio Buttons"}
+ if [empty_string_p $presentation_type] { set presentation_type "select" }
+ }
+ "date" {
+ set tags {custom select}
+ set pretty_tags {"Custom" "Select"}
+ set default_date [km_default_date $question_id]
+ util_unlist $default_date year_value month_value day_value
+ if [empty_string_p $presentation_type] { set presentation_type "custom" }
+ }
+ "nephew_object" {
+ set tags {custom application}
+ set pretty_tags {"Standard List of Objects" "List of Objects with Button for Application Form on Target Object Type Page"}
+ if [empty_string_p $presentation_type] { set presentation_type "custom" }
+ }
+}
+
+# Some demo items
+set items [list "Products" "Sales" "Marketing" "Supply Chain"]
+
+# Show the demo tags for selection
+
+template::multirow create presentation_type_tags radio_row abstract_data_type tag items
+
+foreach tag $tags {
+ set pretty_tag [lindex $pretty_tags [lsearch $tags $tag]]
+ if ![string compare $tag $presentation_type] {
+ set check_string "checked"
+ } else {
+ set check_string ""
+ }
+ set radio_row "<input type=radio name=\"presentation_type\" value=\"$tag\" $check_string>$pretty_tag"
+
+ template::multirow append presentation_type_tags $radio_row $abstract_data_type $tag $items
+}
+
+
+set title "Presentation Type for $pretty_question"
+
+set form_vars [export_form_vars object_type_id question_id]
+set count_tags [llength $tags]
+
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$object_type Questions"] $title
+
+ad_return_template
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-questions.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-questions.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-questions.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,33 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<if @questions:rowcount@ gt 0>
+ <form method=post action="map-composite-questions">
+ <csrf-token>
+ @form_vars;noquote@
+ <table cellspacing=3 cellpadding=3 width=100%>
+ <tr><th align=left>
+ Check the questions below that should be contained in the new composite question.<br>
+ Please note that selecting a mandatory question will automatically make this composite question mandatory.
+ </tr>
+ <tr><td><table border=1 cellspacing=0 cellpadding=0 width=100%>
+
+ <multiple name="questions">
+ <if @questions.rownum@ odd><tr bgcolor=<%=[ad_parameter table_bgcolor library #eeeeee]%>></if>
+ <else><tr bgcolor=<%=[ad_parameter table_fieldcolor library #eeeeee]%>></else>
+ <td><input type=checkbox name="question_id" @questions.checked_string@ value=@questions.question_id@></td>
+ <td><a href="edit-question?@questions.url_vars@">@questions.pretty_name;noquote@</a></td>
+ <td>@questions.short_explanation;noquote@ </td>
+ <td align=center>@questions.checkmark;noquote@</td><td align=center>@questions.question_state@</td>
+ <td align=center>@questions.abstract_data_type;noquote@</td><td align=center>@questions.presentation_type;noquote@ </td></tr>
+ </multiple>
+ </table>
+ </td></tr>
+ </table>
+ <br><br>
+ <center><input type=submit name=submit value="Proceed"></center>
+ </form>
+</if>
+<else>
+There are no questions that can be used for this composite question.
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/choose-questions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/choose-questions.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/choose-questions.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,70 @@
+ad_page_contract {
+ /packages/library/www/admin/choose-questions.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: choose-questions.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id
+ question_id
+} -properties {
+ questions:multirow
+ title:onevalue
+ form_vars:onevalue
+ tag:onevalue
+}
+
+set composite_id $question_id
+set child_ids [km_get_child_questions $question_id]
+
+set object_pretty_name [km_static object_type_pretty_name $object_type_id]
+set question_list [km_branch_questions -root_question_id $question_id -composite_children_p 1 $object_type_id]
+set key [head $question_list]
+set question_list [tail $question_list]
+
+set question_ids [fst [transpose $question_list]]
+
+if ![null_p $child_ids] {
+ set question_list [concat $question_list [tail [km_get_questions -question_states {active deprecated read-only} -all_properties_p 1 -root_node_p 0 -form_view 2 -question_ids $child_ids]]]
+}
+
+template::multirow create questions pretty_name short_explanation question_state abstract_data_type presentation_type checkmark checked_string question_id url_vars
+
+if ![null_p $question_list] {
+ foreach question $question_list {
+ set pretty_name [lindex $question [lsearch $key pretty_name]]
+
+ # Cut the entry explanation a bit smaller.
+ set short_explanation [km_shorten_question [lindex $question [lsearch $key entry_explanation]]]
+
+ set question_id [lindex $question [lsearch $key "question_id"]]
+ set mandatory_p [ad_decode [lindex $question [lsearch $key mandatory_p]] t 1 0]
+ set abstract_data_type [km_pretty_adt [lindex $question [lsearch $key "abstract_data_type"]]]
+ set presentation_type [km_pretty_tag [lindex $question [lsearch $key "presentation_type"]]]
+ set question_state [lindex $question [lsearch $key "question_state"]]
+
+ if { $mandatory_p } {
+ set checkmark "<img src=\"../graphics/check.gif\" width=16 height=16 border=0>"
+ } else {
+ set checkmark " "
+ }
+ if { [lsearch $child_ids $question_id] >= 0 } {
+ set checked_string "checked"
+ } else {
+ set checked_string ""
+ }
+
+ set url_vars [export_url_vars object_type_id question_id]
+ template::multirow append questions $pretty_name $short_explanation $question_state \
+ $abstract_data_type $presentation_type $checkmark $checked_string $question_id $url_vars
+ }
+}
+
+set tag ""
+set title "Composite Question"
+set form_vars [export_form_vars composite_id object_type_id]
+
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$object_pretty_name Questions"] $title
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/communities-with-admin-rights.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/communities-with-admin-rights.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/communities-with-admin-rights.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,3 @@
+ <multiple name=instances>
+ <option value="@instances.package_id@">@instances.community_name@ - @instances.instance_name@
+ </multiple>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/communities-with-admin-rights.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/communities-with-admin-rights.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/communities-with-admin-rights.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,20 @@
+set package_id [ad_conn package_id]
+set user_id [ad_maybe_redirect_for_registration]
+
+set list_of_instances {}
+template::multirow create instances package_id instance_name community_name
+
+db_foreach get_libraries_with_admin "
+ select p1.package_id, p1.instance_name, p2.instance_name as community_name
+ from apm_packages p1, apm_packages p2, sn_community_instances ci
+ where p1.package_key='library'
+ and [tcl_permission_for_bind_vars_p "p1.package_id" ":user_id" "'admin'"] = 't'
+ and p1.package_id <> :package_id
+ and p2.package_id = ci.community_id
+ and p1.package_id = ci.package_id
+ order by lower(community_name), lower(p1.instance_name)
+" {
+ template::multirow append instances $package_id $instance_name $community_name
+}
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,32 @@
+ad_page_contract {
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+} {
+ object_type_id:integer,notnull
+ copy_to_package_id:integer,notnull
+} -properties {
+ context_bar:onevalue
+}
+csrf::authenticate
+
+ad_require_permission $copy_to_package_id "admin"
+ad_require_permission $object_type_id "admin"
+
+set this_package_id [ad_conn package_id]
+set ip_address [ns_conn peeraddr]
+set user_id [ad_get_user_id]
+
+db_exec_plsql copy_object_types {
+ begin
+ object_type.copy_object_type (
+ v_object_type_id => :object_type_id,
+ v_target_context_id => :copy_to_package_id,
+ v_creation_user => :user_id,
+ v_creation_ip => :ip_address
+ );
+ end;
+}
+
+##km_static -reset
+
+ad_returnredirect index
Index: openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,19 @@
+ad_page_contract {
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+} {
+ copy_to_package_id:integer,notnull
+} -properties {
+ context_bar:onevalue
+}
+csrf::authenticate
+
+ad_require_permission $copy_to_package_id "admin"
+
+set this_package_id [ad_conn package_id]
+
+library_copy_data $this_package_id $copy_to_package_id
+
+##km_static -reset
+
+ad_returnredirect index
Index: openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,16 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<p>Choose to which library instance you want to copy the object type
+definitions of this library:</p>
+
+<form method=post action="copy-object-type-structure-2">
+<csrf-token>
+<select name=copy_to_package_id>
+ <include src="communities-with-admin-rights">
+</select>
+
+<center>
+<input type="submit" value="Yes, proceed">
+</center>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type-structure.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,21 @@
+ad_page_contract {
+ /packages/library/www/admin/move-object-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+} {
+} -properties {
+ title:onevalue
+ object_type_name:onevalue
+ instances:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set title "Copy Object Type Structure another Instance"
+
+set_context_bar_data $title
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,18 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+Choose to which community you want to copy the object type definition "@object_type_name@"?
+<p>
+<form method=post action="copy-object-type-2">
+<csrf-token>
+<select name=copy_to_package_id>
+ <include src="communities-with-admin-rights">
+</select>
+
+<input type="hidden" name="object_type_id" value="@object_type_id@">
+<center>
+<input type="submit" value="Yes, proceed">
+</center>
+</form>
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/copy-object-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,41 @@
+ad_page_contract {
+ /packages/library/www/admin/copy-object-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+} {
+ object_type_id:integer
+} -properties {
+ title:onevalue
+ object_type_name:onevalue
+ instances:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set this_package_d [ad_conn package_id]
+
+set sql "select package_id, instance_name
+ from apm_packages
+ where package_key='library' and
+ acs_permission.permission_p(package_id, :user_id, 'admin')='t' and
+ package_id <> :this_package_d"
+
+set list_of_instances ""
+template::multirow create instances package_id instance_name
+
+db_foreach move_object_type_sql_10 $sql {
+ template::multirow append instances $package_id $instance_name
+}
+
+
+set object_type_name [db_string object_type_copy_10 "select pretty_plural from sn_object_types
+ where object_type_id = :object_type_id"]
+
+set title "Copy Object Type \"$object_type_name\"' Definition to another Instance"
+
+set_context_bar_data $title
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,120 @@
+ad_page_contract {
+ /packages/library/www/admin/create-object-type-2.tcl
+
+ Create a new KM library object type.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: create-object-type-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ dc_signature
+ pretty_name:trim,notnull
+ pretty_plural:trim,notnull
+ browse_p:oneof(0|1)
+ public_p:oneof(0|1)
+ create_p:oneof(0|1)
+ archive_p:oneof(0|1)
+ copy_p:oneof(0|1)
+ sweeper:oneof(none|outdated|expired)
+ sweeper_action:oneof(private|archive)
+ sweeper_warning_time:integer
+ sweeper_outdated_time:naturalnum
+ {default_age_filter:integer 365}
+ {short_name:trim ""}
+ graphic:optional
+ graphic.tmpfile:optional
+}
+csrf::authenticate
+
+if ![empty_string_p $short_name] {
+ set context_id [ad_conn package_id]
+ if [db_0or1row get_short_name {
+ select 1 from sn_object_types
+ where context_id=:context_id
+ and short_name=:short_name
+ and rownum=1 }] {
+ ad_return_complaint 1 "<li>Short name: $short_name is already used in this library instance."
+ return
+ }
+}
+
+if [empty_string_p $short_name] {
+ set short_name [db_null]
+}
+
+if {[empty_string_p $default_age_filter]} {
+ set default_age_filter 365
+}
+
+if {[doubleclick::check_all]} {
+ ad_returnredirect index
+ return
+}
+
+set browse_p [ad_decode $browse_p 1 t f]
+set public_p [ad_decode $public_p 1 t f]
+set create_p [ad_decode $create_p 1 t f]
+set archive_p [ad_decode $archive_p 1 t f]
+set copy_p [ad_decode $copy_p 1 t f]
+
+if {$copy_p == "f" && [string equal $sweeper "archive"]} {
+ set sweeper "none"
+}
+
+if { [empty_string_p $default_age_filter] || ![integer_p $default_age_filter] } {
+ set default_age_filter 365
+}
+
+set context_id [ad_conn package_id]
+set user_id [ad_verify_and_get_user_id]
+set creation_ip [ad_conn peeraddr]
+
+db_transaction {
+ set object_type_id [db_exec_plsql create_object_type {
+ begin
+ :1 := object_type.insert_object_type (
+ v_pretty_name => :pretty_name,
+ v_pretty_plural => :pretty_plural,
+ v_browse_p => :browse_p,
+ v_default_age_filter => :default_age_filter,
+ v_creation_user => :user_id,
+ v_creation_ip => :creation_ip,
+ v_short_name => :short_name,
+ v_context_id => :context_id);
+ end;
+ }]
+
+ db_dml set_create_p_flag {
+ update sn_object_types
+ set create_p = :create_p,
+ public_p = :public_p,
+ archive_p = :archive_p,
+ copy_p = :copy_p,
+ sweeper = :sweeper,
+ sweeper_action = :sweeper_action,
+ sweeper_warning_time = :sweeper_warning_time,
+ sweeper_outdated_time = :sweeper_outdated_time
+ where object_type_id = :object_type_id
+ }
+
+ if [info exists graphic] {
+ # Get the uploaded graphic, if there was one.
+ if { [regexp {\.([a-zA-Z]+)$} $graphic match graphic_ext] } {
+ set filename "$object_type_id.$graphic_ext"
+
+ ns_cp [ns_queryget graphic.tmpfile] \
+ "[ns_info pageroot]/library-files/$filename"
+
+ db_dml update_graphic {
+ update sn_object_types
+ set graphic = :filename, graphic_p = 't'
+ where object_type_id = :object_type_id
+ }
+ }
+ }
+}
+
+##km_static -reset
+
+ad_returnredirect "."
Index: openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,43 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+You have started the process of creating a new object type.
+<form action="create-object-type-2" method=post enctype=multipart/form-data>
+<csrf-token>
+@dc_export;noquote@
+<table cellspacing=3 cellpadding=3 width=100%>
+ <tr><th align=left>Enter a short name:</th></tr>
+ <tr><td><include src="../km-input-tag" name="short_name"></td></tr>
+ <tr><th align=left>Enter a presentation name:</th></tr>
+ <tr><td><include src="../km-input-tag" name="pretty_name"></td></tr>
+ <tr><th align=left>Enter a plural form of the presentation name:</th></tr>
+ <tr><td><include src="../km-input-tag" name="pretty_plural"></td></tr>
+ <tr><th align=left>Upload a graphic icon:</th></tr>
+ <tr><td><input type=file name=graphic></td></tr>
+ <tr><th align=left>Is it possible to browse objects of this object type?</th></tr>
+ <tr><td><include src="../km-yes-no" default="1" name="browse_p"></td></tr>
+ <tr><th align=left >If yes, then enter the default value for the age filter (in days):</th></tr>
+ <tr><td><include src="../km-input-tag" size="5" name="default_age_filter"></td></tr>
+ <tr><th align=left>Should this object type be visible to all users?</th></tr>
+ <tr><td><include src="../km-yes-no" default="1" name="public_p"></td></tr>
+ <tr><th align=left>Can the users create standalone objects of this type?</th></tr>
+ <tr><td><include src="../km-yes-no" default="1" name="create_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Can objects of this type be put in the archive?</th></tr>
+ <tr><td><include src="../km-yes-no" default="0" name="archive_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Can users copy objects of this type?</th></tr>
+ <tr><td><include src="../km-yes-no" default="0" name="copy_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Sweeper that should be used on old objects:</th></tr>
+ <tr><td><include src="../km-select-tag" default="none" name="sweeper" items="none {Outdated Objects (unchanged)} {Expired Objects (exceeded public_until date)}" values="none outdated expired"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Action that the sweeper should perform on old objects:</th></tr>
+ <tr><td><include src="../km-select-tag" default="private" name="sweeper_action" items="{Make Private} {Put into Archive}" values="private archive"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Amount of days after the warning email that the action should be performed (0 for no warning email):</th></tr>
+ <tr><td><include src="../km-input-tag" value="0" name="sweeper_warning_time" size=4></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Amount of days after which an unchanged object is regarded as outdated:</th></tr>
+ <tr><td><include src="../km-input-tag" value="30" name="sweeper_outdated_time" size=4></td></tr>
+</table>
+<center>
+<br><br>
+<input type=submit name=submit value="Proceed">
+</center>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/create-object-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,30 @@
+ad_page_contract {
+ /packages/library/www/admin/create-object-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: create-object-type.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+} -properties {
+ title:onevalue
+ short_name:onevalue
+ pretty_name:onevalue
+ pretty_plural:onevalue
+ browse_p:onevalue
+ default_age_filter:onevalue
+ dc_export:onevalue
+}
+
+set title "New Knowledge Object Type"
+set dc_export [doubleclick::signature_html]
+
+set_context_bar_data [list "." "Knowledge Library"] "New Object Type"
+
+ad_return_template
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-branch.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-branch.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-branch.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,33 @@
+ad_page_contract {
+ /packages/library/www/admin/delete-branch.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: delete-branch.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ branch_id
+ question_id
+ object_type_id
+} -properties {
+}
+csrf::authenticate
+
+db_transaction {
+
+ db_dml delete_branch_10 "
+ update sn_question_object_type_map
+ set default_branch = null
+ where object_type_id = $object_type_id
+ and question_id = $question_id
+ and default_branch = $branch_id"
+
+ db_dml delete_branch_20 "
+ update sn_question_object_type_map
+ set branch_p = 'f', parent_question_id = [km_static km_dummy_object_id]
+ where object_type_id = $object_type_id and question_id = $branch_id"
+
+}
+
+ad_returnredirect "view-branches?[export_url_vars question_id object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,53 @@
+ad_page_contract {
+ /packages/library/www/admin/
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: delete-object-type-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id:integer
+ {soft ""}
+ {hard ""}
+ {cancel ""}
+}
+csrf::authenticate
+
+if {![empty_string_p $cancel]} {
+ ad_returnredirect ""
+ return
+}
+
+set title "Delete an object type"
+if {![empty_string_p $hard]} {
+ if [catch {db_exec_plsql object_type_delete_2 "
+ begin
+ object_type.delete_object_type (
+ v_object_type_id => :object_type_id
+ );
+ end;"} errmsg] {
+
+ ad_return_error "Database Error" "We were not able to delete the object type from the database, this is the error message: <pre>$errmsg</pre>"
+ return
+ }
+}
+
+if {![empty_string_p $soft]} {
+ db_transaction {
+ db_dml soft10 {update sn_object_types set public_p='f', deleted_p='t' where object_type_id=:object_type_id}
+ db_dml soft20 {update acs_objects_description
+ set state='d'
+ where object_id in
+ (select object_id
+ from sn_objects
+ where object_type_id=:object_type_id)}
+ db_dml soft30 {update sn_objects
+ set expiration_date=sysdate-1
+ where object_type_id=:object_type_id}
+ }
+}
+
+km_static -reset $object_type_id
+
+ad_returnredirect index
+return
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,16 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+Are you sure that you want to delete the object type "@object_type_name@"?
+<p>
+
+<form method=get action="delete-object-type-2">
+<csrf-token>
+<input type="hidden" name="object_type_id" value="@object_type_id@">
+<center>
+<input type="submit" name="soft" value="Soft Delete">
+<input type="submit" name="hard" value="Hard Delete">
+<input type="submit" name="cancel" value="Cancel">
+</center>
+</form>
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-object-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,23 @@
+ad_page_contract {
+ /packages/library/www/admin/delete-object-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: delete-object-type.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id:integer,notnull
+} -properties {
+ title:onevalue
+ object_type_name:onevalue
+}
+
+set object_type_name [db_string object_type_delete_10 "select pretty_plural from sn_object_types
+ where object_type_id = :object_type_id"]
+
+set title "Confirm Deletion for \"$object_type_name\""
+set_context_bar_data $title
+ad_return_template
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-option-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-option-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-option-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,22 @@
+ad_page_contract {
+ /packages/library/www/admin/delete-option.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: delete-option-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ option_id:integer
+}
+csrf::authenticate
+
+db_transaction {
+
+ db_dml delete_option_2_10 "delete from sn_object_option_map where option_id=:option_id"
+ db_dml delete_option_2_20 "delete from sn_answer_options where option_id=:option_id"
+
+}
+
+ad_returnredirect "view-options?[export_url_vars object_type_id question_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-option.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-option.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-option.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,23 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+Do you really want to delete the option "@value@" from question <cite>@pretty_question@</cite> ?<br>
+This will also delete all existing answers which use this option.
+
+<p><table>
+<tr>
+ <td>
+ <form action="delete-option-2" method=post>
+ <csrf-token>
+ @delete_form_vars;noquote@
+ <input type=submit name=submit value="Yes, Proceed">
+ </form>
+ </td>
+ <td>
+ <form action="view-options" method=get>
+ @view_form_vars;noquote@
+ <input type=submit name=submit value="No, Cancel">
+ </form>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-option.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-option.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-option.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,38 @@
+ad_page_contract {
+ /packages/library/www/admin/delete-option.tcl
+
+ Ask for confirmation before deleting an option.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: delete-option.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ option_id:integer
+} -properties {
+ title:onevalue
+ pretty_question:onevalue
+ delete_form_vars:onevalue
+ view_form_vars:onevalue
+ value:onevalue
+}
+
+set question_info [km_get_question $question_id $object_type_id]
+set pretty_question [snd $question_info]
+
+set value [km_answer_option $option_id]
+set title "Delete Option $value"
+set_context_bar_data [list "." "Knowledge Library"] [list "view-options?[export_url_vars question_id object_type_id]" $pretty_question] "Delete Option"
+
+set delete_form_vars [export_form_vars question_id object_type_id option_id]
+set view_form_vars [export_form_vars question_id object_type_id]
+
+set pretty_question [db_string view_options_10 "select pretty_name
+ from sn_questions
+ where question_id = :question_id"]
+set view_options_title "Multiple Choice Options for $pretty_question"
+
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$pretty_question Questions"] [list "view-options?object_type_id=$object_type_id&question_id=$question_id" $view_options_title] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-question-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-question-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-question-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,31 @@
+ad_page_contract {
+ /packages/library/www/admin/delete-question-2.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: delete-question-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+} -properties {
+}
+csrf::authenticate
+
+if [catch {db_exec_plsql object_type_delete_2 "
+ begin
+ question.delete_question (
+ v_question_id => :question_id
+ );
+ end;"} errmsg] {
+
+ set n_errors 1
+ set error_list [list "We were not able to delete the questin from the database, this is the error message: <pre>$errmsg</pre>"]
+
+ ad_return_template "error"
+ return
+}
+
+km_static -reset $question_id
+
+ad_returnredirect index
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-question.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-question.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-question.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,13 @@
+<property name="page_title">@page_title@</property>
+
+Are you sure that you want to delete the question "@question_pretty_name@"?
+<p>
+
+<form method=post action="delete-question-2">
+<csrf-token>
+<input type="hidden" name="question_id" value="@question_id@">
+<center>
+<input type="submit" value="Yes, proceed">
+</center>
+</form>
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/delete-question.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/delete-question.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/delete-question.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,22 @@
+ad_page_contract {
+ /packages/library/www/admin/delete-question.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+ @author Jens Kordsmeier (jak@arsdigita.com)
+
+ @cvs-id $Id: delete-question.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+} -properties {
+}
+
+set page_title "Confirm Deletion"
+
+set question_pretty_name [db_string object_type_delete_10 "select pretty_name from sn_questions
+ where question_id = :question_id"]
+
+ad_return_template
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-all-questions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-all-questions.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-all-questions.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,89 @@
+# /www/admin/library/edit-all-questions.tcl
+#
+# Takes in a bunch of question_id-sort_key form vars and resorts them numerically
+# so that there is always a gap of 10 between them and NO duplicates or empty values.
+# Also updates mandatory_p.
+#
+# $Id: edit-all-questions.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+csrf::authenticate
+
+set_the_usual_form_variables
+
+set i 0
+set size [ns_set size $Vform]
+
+set mandatory_questions {}
+while {$i<$size} {
+ if { [ns_set key $Vform $i] == "mandatory_p"} {
+ lappend mandatory_questions [ns_set value $Vform $i]
+ }
+ incr i
+}
+
+set all_question_ids [fst [transpose [tail [km_get_questions -question_states {active deprecated read-only} -branch_children_p 0 -root_node_p 0 -object_type_id $object_type_id]]]]
+set not_mandatory_questions [minus $all_question_ids $mandatory_questions]
+
+if ![null_p $mandatory_questions] {
+ db_dml edit_all_questions_10 "
+ update sn_question_object_type_map
+ set mandatory_p = 't'
+ where object_type_id = :object_type_id
+ and question_id in ([join $mandatory_questions " , "])
+ and question_state = 'active'"
+
+ db_dml edit_all_questions_20 "
+ update sn_question_object_type_map
+ set mandatory_p ='f'
+ where object_type_id = :object_type_id
+ and (question_id not in ([join $mandatory_questions ","]) or question_state <> 'active')"
+
+ db_dml edit_all_questions_30 "
+ update sn_question_object_type_map qm
+ set mandatory_p = 't'
+ where object_type_id=:object_type_id
+ and (select abstract_data_type from sn_questions q where q.question_id=qm.question_id) = 'composite'
+ and qm.question_state = 'active'
+ and qm.question_id in
+ (select parent_question_id
+ from sn_question_object_type_map
+ where object_type_id=:object_type_id
+ start with question_id in ([join $mandatory_questions ","])
+ and object_type_id=:object_type_id
+ connect by prior parent_question_id = question_id)"
+
+} else {
+ db_dml edit_all_questions_40 "
+ update sn_question_object_type_map
+ set mandatory_p='f'
+ where object_type_id = :object_type_id"
+}
+
+# Sort out the sort_key form variables
+
+set sort_tuples {}
+set size [ns_set size $Vform]
+set i 0
+while { $i < $size } {
+ set key [ns_set key $Vform $i]
+ set value [ns_set value $Vform $i]
+ if [integer_p $key] {
+ #Then it's one of the question sort_key tag
+ lappend sort_tuples [list $key $value]
+ }
+ incr i
+}
+
+# Sort the variables for the sort_key column in sn_questions
+set sort_tuples [qsort $sort_tuples snd]
+set i 10
+
+foreach tuple $sort_tuples {
+ set question_id [fst $tuple]
+ db_dml edit_all_questions_50 "
+ update sn_question_object_type_map
+ set sort_key = :i
+ where question_id = :question_id and object_type_id = :object_type_id"
+ incr i 10
+}
+
+ad_returnredirect "view-questions?[export_url_vars object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,59 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-branch-2.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: edit-branch-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ branch_answer
+ operator
+ branch_id:integer
+}
+csrf::authenticate
+
+# If the branch answer is a foreign key then we store it somewhere else than when
+# it is a varchar- To figure this out we look at the abstract_data_type
+
+set abstract_data_type [db_string edit_branch_2_10 "select abstract_data_type
+ from sn_questions
+ where question_id=:question_id" -default ""]
+
+switch $abstract_data_type {
+ "integer" -
+ "text" {
+ set column "branch_answer"
+ set branch_answer '[DoubleApos $branch_answer]'
+ }
+ "option" -
+ "category" -
+ "other_category" { set column "branch_answer_foreign_key" }
+ default { ad_returnredirect "view-questions?[export_url_vars object_type_id]" }
+}
+
+db_transaction {
+ # Delete the old branch for this answer.
+ db_dml edit_branch2_10 "
+ update sn_question_object_type_map
+ set parent_question_id = [km_static km_dummy_object_id], branch_p = 'f', branch_operator = null, $column = null
+ where parent_question_id = $question_id
+ and object_type_id = $object_type_id
+ and branch_operator = '$operator'
+ and $column = $branch_answer
+ and branch_p = 't'"
+
+ # Create the new branch.
+
+ db_dml edit_branch2_20 "
+ update sn_question_object_type_map
+ set parent_question_id = $question_id, branch_p = 't',
+ branch_operator = '$operator', $column = $branch_answer
+ where question_id = $branch_id and object_type_id=$object_type_id"
+
+}
+
+##km_static -reset
+
+ad_returnredirect "view-branches?[export_url_vars question_id object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,70 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+@message@
+
+<form method=post action="edit-branch-2">
+<csrf-token>
+@form_vars;noquote@
+
+<table cellspacing=3 cellpadding=3 border=0 width=100% bgcolor="#cccfff">
+ <tr bgcolor="#cccfff"><th align=left>Select the operator to be applied to this question:</th></tr>
+ <tr><td>
+ <if @abstract_data_type@ eq "category">
+ <include src="../km-radio-tag" values="==" default="==" name="operator" items="Equals">
+ </if>
+
+ <if @abstract_data_type@ eq "text">
+ <include src="../km-radio-tag" values="==" default="==" name="operator" items="Equals">
+ </if>
+
+ <if @abstract_data_type@ eq "integer">
+ <include src="../km-radio-tag" values="@values_list;noquote@" items="@items_list@" default="@branch_operator@" name="operator">
+ </if>
+
+ <if @abstract_data_type@ eq "option">
+ <include src="../km-radio-tag" values="==" default="==" name="operator" items="Equals">
+ </if>
+
+ </td></tr>
+ <tr bgcolor="#cccfff"><th align=left>
+
+
+ <if @abstract_data_type@ eq "integer" or @abstract_data_type@ eq "text">
+ Enter the answer for this branch:<br>
+ <tr><td><include src="../km-input-tag" values="@values@" default="@this_branch_answer@" name="branch_answer"></td></tr>
+ </if>
+ <if @abstract_data_type@ eq "category" or @abstract_data_type@ eq "option">
+ Select the answer for this branch
+ <tr><td><include src="../km-select-tag" values="@values@" default="@this_branch_answer@" name="branch_answer" items="@items@"></td></tr>
+ </if>
+
+ </th></tr>
+ <tr bgcolor="#cccfff"><th align=left>Select the question that this answer will lead to:</th></tr>
+ <tr bgcolor="#cccfff"><td>
+
+<table border=1 cellspacing=0 cellpadding=0 width=100%>
+<tr bgcolor="#cccfff">
+<th> </th><th>Name</th><th>Question</th><th>Mandatory</th><th>State</th><th>Abstract Data Type</th><th>Presentation Type</th></tr>
+
+ <multiple name="questions">
+ <if @questions.rownum@ odd><tr bgcolor=#eeeeee></if>
+ <else><tr bgcolor=#eeeeee></else>
+ <td><input type=radio name="branch_id" @questions.checked_string@ value=@questions.question_id@></td>
+ <td><a href="edit-question?@questions.url_vars@">@questions.pretty_name;noquote@</a></td>
+ <td>@questions.short_explanation;noquote@ </td>
+ <td align=center>@questions.checkmark;noquote@</td><td align=center>@questions.question_state;noquote@</td>
+ <td align=center>@questions.abstract_data_type;noquote@</td><td align=center>@questions.presentation_type;noquote@ </td></tr>
+ </multiple>
+</table>
+
+
+</td>
+ </tr>
+</table>
+
+<center><input type=submit name=submit value="Proceed"></center>
+
+</form>
+
+@link;noquote@
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-branch.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,176 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-branch.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: edit-branch.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id
+ question_id
+ {operator ""}
+ {branch_id 0}
+} -properties {
+ message:onevalue
+ link:onevalue
+ form_vars:onevalue
+ abstract_data_type:onevalue
+}
+
+set values {}
+set items {}
+set link ""
+set question [km_get_question $question_id $object_type_id]
+set pretty_name [snd $question]
+set abstract_data_type [thd $question]
+set default_branch [km_default_branch $question_id]
+
+set orig_question_id $question_id
+set orig_pretty_name $pretty_name
+
+if { $branch_id } {
+ # Then we need to get the data that applies to this branch so we can show it on the form.
+
+ set this_branch [km_get_branches -branch_id $branch_id -question_attributes_p 1 $question_id $object_type_id]
+ set key [fst $this_branch]
+ set this_branch [snd $this_branch]
+ set this_branch_answer [snd $this_branch]
+ set branch_operator [lindex $this_branch [lsearch $key branch_operator]]
+ if { [lsearch {"==" "<" ">" } $branch_operator] < 0 } { set branch_operator "==" }
+
+ set message "Edit this branch by changing the answer or the question that it leads to."
+ set title "Edit Branch"
+
+ if { $branch_id == $default_branch } {
+ set link "
+<p><a href=\"unset-default-branch?[export_url_vars question_id branch_id object_type_id]\">Stop
+using this as the default branch.</a>"
+ } else {
+ set link "
+<p><a href=\"set-default-branch?[export_url_vars question_id branch_id object_type_id]\">Make
+this the default branch.</a>"
+ }
+} else {
+
+ set attributes ""
+ set this_branch_answer ""
+ set branch_operator "="
+ set title "New Branch"
+ set message "To create a branch, define an answer to $pretty_name that will
+ lead to the following question."
+ set link ""
+}
+
+
+# Get the branch answers for category and option types so that we
+# only offer the user a choice of branch answers that have not yet
+# already been mapped
+
+set branch_answers [snd [transpose [tail [km_get_branches -question_attributes_p 1 -branch_id $branch_id $question_id $object_type_id]]]]
+
+
+set form_vars [export_form_vars question_id object_type_id]
+
+switch $abstract_data_type {
+ "category" - "other_category" {
+ # Get the categories for this question
+ set categories [km_get_child_categories $question_id]
+
+ set values {}
+ set items {}
+ foreach item $categories {
+ set value [fst $item]
+ set item [snd $item]
+
+ if { [lsearch $branch_answers $value] == -1 || $this_branch_answer == $value } {
+ lappend values $value
+ lappend items $item
+ }
+ }
+ if [null_p $values] {
+ ad_return_complaint 1 "There are no answers available for a new branch."
+ return
+ }
+ }
+ "option" {
+ # Get the answer options for this question
+ set options [km_get_answer_options $question_id]
+
+ foreach item $options {
+ set value [fst $item]
+ set item [snd $item]
+
+ if { [lsearch $branch_answers $value] < 0 || $this_branch_answer == $value } {
+ lappend values $value
+ lappend items $item
+ }
+ }
+ if [null_p $values] {
+ ad_return_complaint 1 "There are no answers available for a new branch."
+ return
+ }
+ }
+ "integer" {
+ set values_list [list == < >]
+ set items_list [list Equals {Less Than} {Greater Than}]
+ }
+ "default" {
+ #Can't deal with any other abstract_data_types here
+ ad_returnredirect "view-questions?[export_url_vars object_type_id]"
+ }
+}
+
+# Get a list of questions that exist for this object_type
+# that are not already in a branch of this object_type.
+
+set root_question_id [km_get_root_branch $question_id $object_type_id]
+if ![empty_string_p $root_question_id] {
+ set question_list [km_branch_questions -branch_id $branch_id -root_question_id $root_question_id -composite_children_p 0 $object_type_id]
+} else {
+ set question_list [km_branch_questions -branch_id $branch_id -root_question_id $question_id -composite_children_p 0 $object_type_id]
+}
+
+set branch_ids [list $branch_id]
+set key [fst $question_list]
+set question_list [tail $question_list]
+
+template::multirow create questions pretty_name short_explanation question_state abstract_data_type presentation_type checkmark checked_string question_id url_vars
+
+foreach question $question_list {
+ set pretty_name [lindex $question [lsearch $key pretty_name]]
+
+ # Cut the entry explanation a bit smaller.
+ set short_explanation [km_shorten_question [lindex $question [lsearch $key entry_explanation]]]
+
+ set question_id [lindex $question [lsearch $key "question_id"]]
+ set mandatory_p [ad_decode [lindex $question [lsearch $key mandatory_p]] t 1 0]
+ set this_abstract_data_type [km_pretty_adt [lindex $question [lsearch $key "abstract_data_type"]]]
+ set presentation_type [km_pretty_tag [lindex $question [lsearch $key "presentation_type"]]]
+ set question_state [lindex $question [lsearch $key "question_state"]]
+
+ if { $mandatory_p } {
+ set checkmark "<img src=\"../graphics/check.gif\" width=16 height=16 border=0>"
+ } else {
+ set checkmark " "
+ }
+ if { [lsearch $branch_ids $question_id] >= 0 } {
+ set checked_string "checked"
+ } else {
+ set checked_string ""
+ }
+
+ set url_vars [export_url_vars object_type_id question_id]
+ template::multirow append questions $pretty_name $short_explanation $question_state \
+ $this_abstract_data_type $presentation_type $checkmark $checked_string $question_id $url_vars
+}
+
+set_context_bar_data \
+ [list "." "Knowledge Library"] \
+ [list "view-questions?object_type_id=$object_type_id" "All Questions"] \
+ [list "view-branches?[export_url_vars question_id object_type_id]" "All Branches"] "$title for $pretty_name"
+
+set object_type_name [db_string view_branches_20 "select pretty_name
+ from sn_object_types
+ where object_type_id=:object_type_id"]
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$object_type_name Questions"] [list "view-branches?question_id=$orig_question_id&object_type_id=$object_type_id" "Navigational Branches for $orig_pretty_name"] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-category.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-category.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-category.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,24 @@
+# /www/admin/library/edit-category.tcl
+#
+# A routing page used by view-questions.tcl. Depending on whether a
+# question has a category associated with it or not, it redirects to
+# /admin/categories or choose-category.tcl.
+#
+# $Id: edit-category.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_variables {
+ question_id
+ object_type_id
+}
+
+db_1row edit_category_10 "
+select q.category_id, category
+from sn_questions q, old_categories c
+where question_id=:question_id
+and c.category_id(+) = q.category_id"
+
+if ![empty_string_p $category_id] {
+ ad_returnredirect "/admin/categories/one?[export_url_vars category_id]"
+} else {
+ ad_returnredirect "choose-category?[export_url_vars question_id object_type_id]"
+}
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,124 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-object-type-2.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: edit-object-type-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ pretty_name
+ pretty_plural
+ browse_p:oneof(0|1)
+ public_p:oneof(0|1)
+ create_p:oneof(0|1)
+ archive_p:oneof(0|1)
+ copy_p:oneof(0|1)
+ sweeper:oneof(none|outdated|expired)
+ sweeper_action:oneof(private|archive)
+ sweeper_warning_time:integer
+ sweeper_outdated_time:naturalnum
+ object_type_id:integer
+ default_age_filter:integer
+ {short_name:trim ""}
+ {graphic ""}
+ {warned_p 0}
+}
+csrf::authenticate
+
+set i 0
+if {[empty_string_p $pretty_name]} {
+ append complaint "<li>Please enter a presentation name."
+ incr i
+}
+
+if {[empty_string_p $pretty_plural]} {
+ append complaint "<li>Please enter a plural form of the presentation name."
+ incr i
+}
+
+if {[empty_string_p $sweeper_warning_time]} {
+ set sweeper_warning_time 0
+}
+
+if {![empty_string_p $short_name]} {
+ set context_id [ad_conn package_id]
+ if [db_0or1row get_short_name {
+ select 1 from sn_object_types
+ where context_id=:context_id
+ and short_name=:short_name
+ and rownum=1
+ and not object_type_id=:object_type_id }] {
+ append complaint "<li>Short name: $short_name is already used in this library instance."
+ incr i
+ }
+}
+
+if {[empty_string_p $short_name]} {
+ set short_name [db_null]
+}
+
+if { $i } {
+ ad_return_complaint $i $complaint
+ return
+}
+
+if { $public_p && $browse_p && !$warned_p } {
+ # Check if the object type has a short_description.
+ set short_description [db_list get_short_description_list {
+ select short_description
+ from sn_types_map_short_name
+ where object_type_id=:object_type_id
+ order by position}]
+
+ if {[empty_string_p $short_description]} {
+ ad_return_error "Missing short description" "
+The object type is going to be public and browsable,
+but has no assigned short description.<br>
+Please <a href=\"view-questions?[export_url_vars object_type_id]\">select
+a question</a> and click on the link <cite>Make
+this question the short description</cite> on the question's properties page."
+ return
+ }
+}
+
+set browse_p [ad_decode $browse_p 1 t f]
+set public_p [ad_decode $public_p 1 t f]
+set create_p [ad_decode $create_p 1 t f]
+set archive_p [ad_decode $archive_p 1 t f]
+set copy_p [ad_decode $copy_p 1 t f]
+
+if {$copy_p == "f" && [string equal $sweeper "archive"]} {
+ set sweeper "none"
+}
+
+# Get the uploaded graphic, if there was one
+if { [regexp {\.([a-zA-Z]+)$} $graphic match graphic_ext] } {
+ set filename "$object_type_id.$graphic_ext"
+
+ ns_cp [ns_queryget graphic.tmpfile] \
+ "[ns_info pageroot]/library-files/$filename"
+
+ set graphic_update ", graphic = :filename, graphic_p = 't'"
+} else {
+ set graphic_update ""
+}
+
+
+if { [empty_string_p $default_age_filter] } { set default_age_filter 365 }
+
+db_dml update_object_type "
+ update sn_object_types
+ set pretty_name = :pretty_name, pretty_plural = :pretty_plural, short_name = :short_name,
+ browse_p = :browse_p, public_p=:public_p, create_p = :create_p,
+ archive_p = :archive_p, copy_p = :copy_p, sweeper = :sweeper,
+ sweeper_action = :sweeper_action,
+ sweeper_warning_time = :sweeper_warning_time,
+ sweeper_outdated_time = :sweeper_outdated_time,
+ default_age_filter=:default_age_filter
+ $graphic_update
+ where object_type_id = :object_type_id"
+
+# Invalidate global cache.
+km_static -reset $object_type_id
+
+ad_returnredirect "."
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,47 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+Edit this object type by changing the fields below:
+
+<form action="edit-object-type-2" method=post enctype=multipart/form-data>
+<csrf-token>
+@form_vars;noquote@
+
+<table cellspacing=3 cellpadding=3 bgcolor="#cccfff" width=100%>
+ <tr><th align=left bgcolor="#cccfff" >Enter a short name:</th></tr>
+ <tr><td><include src="../km-input-tag" value="@short_name@" name="short_name"></td></tr>
+ <tr><th align=left bgcolor="#cccfff" >Enter a presentation name:</th></tr>
+ <tr><td><include src="../km-input-tag" value="@pretty_type@" name="pretty_name"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Enter a plural form of the presentation name:</th></tr>
+ <tr><td><include src="../km-input-tag" value="@pretty_plural@" name="pretty_plural"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Upload a graphic icon:</th></tr>
+ <tr><td><input type=file name=graphic></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Is it possible to browse objects of this object type?</th></tr>
+ <tr><td><include src="../km-yes-no" default="@browse_p@" name="browse_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff" >If yes, then enter the default value for the age filter (in days):</th></tr>
+ <tr><td><include src="../km-input-tag" size="5" value="@default_age_filter@" name="default_age_filter"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Should this object type be visible to all users?</th></tr>
+ <tr><td><include src="../km-yes-no" default="@public_p@" name="public_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Can the users create standalone objects of this type?</th></tr>
+ <tr><td><include src="../km-yes-no" default="@create_p@" name="create_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Can objects of this type be put in the archive?</th></tr>
+ <tr><td><include src="../km-yes-no" default="@archive_p@" name="archive_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Can users copy objects of this type?</th></tr>
+ <tr><td><include src="../km-yes-no" default="@copy_p@" name="copy_p"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Sweeper that should be used on old objects:</th></tr>
+ <tr><td><include src="../km-select-tag" default="@sweeper@" name="sweeper" items="none {Outdated Objects (unchanged)} {Expired Objects (exceeded public_until date)}" values="none outdated expired"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Action that the sweeper should perform on old objects:</th></tr>
+ <tr><td><include src="../km-select-tag" default="@sweeper_action@" name="sweeper_action" items="{Make Private} {Put into Archive}" values="private archive"></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Amount of days after the warning email that the action should be performed (0 for no warning email):</th></tr>
+ <tr><td><include src="../km-input-tag" value="@sweeper_warning_time@" name="sweeper_warning_time" size=4></td></tr>
+ <tr><th align=left bgcolor="#cccfff">Amount of days after which an unchanged object is regarded as outdated:</th></tr>
+ <tr><td><include src="../km-input-tag" value="@sweeper_outdated_time@" name="sweeper_outdated_time" size=4></td></tr>
+</table>
+
+<br><center><input type=submit name=submit value="Proceed"></center>
+
+</form>
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-object-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,55 @@
+ad_page_contract {
+
+ edit-object-type.tcl
+
+ Edit a KM library object type.
+
+ @author Dirk
+ @cvs-id $Id: edit-object-type.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id:integer,notnull
+} -properties {
+ context_bar:onevalue
+ graphic:onevalue
+ title:onevalue
+ form_vars:onevalue
+ short_name:onevalue
+ pretty_name:onevalue
+ pretty_plural:onevalue
+ browse_p:onevalue
+ default_age:onevalue
+ public_p:onevalue
+ create_p:onevalue
+ archive_p:onevalue
+ copy_p:onevalue
+ sweeper:onevalue
+ sweeper_action:onevalue
+ sweeper_warning_time:onevalue
+ sweeper_outdated_time:onevalue
+}
+
+
+set title [km_static object_type_pretty_name $object_type_id]
+set short_name [km_static object_type_short_name $object_type_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_plural [km_static object_type_pretty_plural $object_type_id]
+set browse_p [km_static object_type_browse_p $object_type_id]
+set public_p [km_static object_type_public_p $object_type_id]
+set create_p [km_static object_type_create_p $object_type_id]
+set archive_p [km_static object_type_archive_p $object_type_id]
+set copy_p [km_static object_type_copy_p $object_type_id]
+set default_age_filter [km_static object_type_default_age_filter $object_type_id]
+
+db_1row get_sweeper_data {
+ select sweeper, sweeper_action, sweeper_warning_time, sweeper_outdated_time
+ from sn_object_types
+ where object_type_id = :object_type_id
+}
+
+set graphic [km_static object_type_graphic $object_type_id]
+
+set form_vars [export_form_vars object_type_id]
+
+set_context_bar_data $title
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-option-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-option-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-option-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,21 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-option-2.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: edit-option-2.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ option_id:integer
+ answer_option
+}
+csrf::authenticate
+
+db_dml edit_option_2_10 "
+update sn_answer_options
+set answer_option = :answer_option
+where option_id=:option_id"
+
+ad_returnredirect "view-options?[export_url_vars object_type_id question_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-option.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-option.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-option.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,17 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<form action="edit-option-2" method=post>
+<csrf-token>
+@form_vars;noquote@
+<table cellspacing=3 cellpadding=3 bgcolor="<%=[ad_parameter table_bgcolor library #eeeeee]%>" width=100%>
+ <tr><th align=left bgcolor="<%=[ad_parameter table_color library #eeeeee]%>" >Please enter an option for
+ this new question. This will appear in the multiple-choice list for
+ this question.</th></tr>
+ <tr><td><include src="../km-input-tag" value="@value@" name="answer_option"></td></tr>
+</table>
+<br><br><br>
+<center>
+<input type=submit name=submit value="Proceed">
+</center>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-option.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-option.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-option.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,37 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-option.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: edit-option.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ {option_id:integer 0}
+ {invisible_p 0}
+} -properties {
+ title:onevalue
+ form_vars:onevalue
+ input_tag:onevalue
+}
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+if { $option_id } {
+ set value [km_answer_option $option_id]
+} else {
+ set value ""
+}
+
+set title "Edit Option $value"
+
+set form_vars [export_form_vars object_type_id option_id question_id]
+set pretty_question [db_string view_options_10 "select pretty_name
+ from sn_questions
+ where question_id = :question_id"]
+set view_options_title "Multiple Choice Options for $pretty_question"
+
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id&invisible_p=$invisible_p" "$pretty_type Questions"] [list "view-options?object_type_id=$object_type_id&question_id=$question_id" $view_options_title] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-question-2.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-question-2.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-question-2.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,28 @@
+<master src="../master">
+<property name="title">@title@</property>
+
+You have changed the visibility of a question. Since this affects fulltext search,
+all @pretty_type_plural@ should be reindexed. Please note that reindexing will take
+some time, and that fulltext search won't find any @pretty_type_plural@ during this
+time.
+
+<p>Should I reindex all @pretty_type_plural@ now? (If you press Yes, please be patient
+and don't press the button again.)
+
+<p><table>
+<tr>
+ <td>
+ <form action="reindex" method=post>
+ <csrf-token>
+ @form_vars;noquote@
+ <input type=submit name=submit value="Yes, Proceed">
+ </form>
+ </td>
+ <td>
+ <form action="view-questions" method=get>
+ @form_vars;noquote@
+ <input type=submit name=submit value="No, Skip">
+ </form>
+ </td>
+ </tr>
+</table>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-question-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-question-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-question-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,267 @@
+ad_page_contract {
+
+} {
+ question_id
+ {mandatory_p 0}
+ {first_form_p 0}
+ object_type_id
+ abstract_data_type
+ {question_state "active"}
+ {order_by ""}
+ {default_value ""}
+ {pretty_name ""}
+ {entry_explanation ""}
+ {refers_to "null"}
+ {defaults_question_id "null"}
+ {max_categories "null"}
+ {browse_p ""}
+}
+csrf::authenticate
+
+#if {[doubleclick::check_all]} {
+# ns_log Notice "Going to sleep to avoid a race condition"
+# ns_sleep 10
+# ad_returnredirect "view-questions?object_type_id=$object_type_id"
+# return
+#}
+
+# First we have to set some things so that we don't have invisible mandatory questions etc.
+set link_types [list object_link content_link user_link]
+if { [lsearch $link_types $abstract_data_type] != -1 } {
+ set first_form_p 0
+}
+
+if { $question_state != "active" } {
+ set mandatory_p 0
+}
+
+set form_number $first_form_p
+set mandatory_p [ad_decode $mandatory_p 1 "t" "f"]
+
+set exists_p [db_string edit_question_2_10 "
+ select decode(count(*),0,0,1) from sn_questions
+ where question_id=:question_id"]
+
+set context_id [ad_conn package_id]
+set user_id [ad_verify_and_get_user_id]
+set creation_ip [ad_conn peeraddr]
+
+if {[empty_string_p $defaults_question_id]} { set defaults_question_id "null" }
+if {[empty_string_p $max_categories]} { set max_categories "null" }
+if {[empty_string_p $browse_p] || $browse_p} {
+ set browse_p "t"
+} else {
+ set browse_p "f"
+}
+
+if {!$exists_p} {
+ switch -exact $abstract_data_type {
+ "category" - "other_category" - "option" { set presentation_type "select" }
+ "integer" { set presentation_type "shorttext" }
+ default { set presentation_type "custom" }
+ }
+
+ set dummy [db_exec_plsql admin_edit_question_2_20 "
+ begin
+ :1 := question.insert_question (
+ v_question_id => :question_id,
+ v_pretty_name => :pretty_name,
+ v_abstract_data_type => :abstract_data_type,
+ v_order_by => :order_by,
+ v_default_value => :default_value,
+ v_entry_explanation => :entry_explanation,
+ v_creation_user => :user_id,
+ v_creation_ip => :creation_ip,
+ v_context_id => :context_id,
+ v_references_q_id => $refers_to
+ );
+ end;
+ "]
+
+} else {
+ db_exec_plsql admin_edit_question_2_30 "
+ begin
+ question.update_question (
+ v_question_id => :question_id,
+ v_pretty_name => :pretty_name,
+ v_abstract_data_type => :abstract_data_type,
+ v_order_by => :order_by,
+ v_default_value => :default_value,
+ v_entry_explanation => :entry_explanation,
+ v_modifying_user => :user_id,
+ v_modifying_ip => :creation_ip,
+ v_references_q_id => $refers_to,
+ v_def_question_id => $defaults_question_id,
+ v_max_categories => $max_categories,
+ v_browse_p => :browse_p
+ );
+ end;"
+
+ if {[db_string get_questions_browse_p { select browse_p from sn_questions where question_id = :question_id}] != $browse_p} {
+ km_flush_category_count -object_type_id $object_type_id
+ }
+}
+
+km_static -reset $question_id
+
+if {![db_0or1row edit_question_2_40 "
+ select question_state as old_state, parent_question_id, decode(branch_p,'t',1,0) as branch_p
+ from sn_question_object_type_map
+ where question_id = :question_id and object_type_id = :object_type_id"]} {
+ set old_state ""
+ set parent_question_id 0
+ set branch_p 0
+}
+
+if {[empty_string_p $parent_question_id] || $parent_question_id == [km_static km_dummy_object_id]} {
+ set parent_question_id 0
+}
+if {[empty_string_p $branch_p]} {
+ set branch_p 0
+}
+
+if { $parent_question_id && !$branch_p && $mandatory_p } {
+ # This is a mandatory child question of a composite question.
+ # Make sure that the parent question is made mandatory, too.
+
+ db_dml edit_question_2_50 "
+ update sn_question_object_type_map
+ set mandatory_p = 't'
+ where question_id = :parent_question_id
+ and object_type_id = :object_type_id"
+}
+
+if { $abstract_data_type == "composite" } {
+ # Make sure the child questions have a sensible question state.
+ # If the parent question has become invisible, all children
+ # must be invisible, too.
+ # If the parent question is made visible, we use the new
+ # question_state for its children, too.
+
+ set sql_edit_question_2_60 "
+ select question_id as child_id, question_state as child_state
+ from sn_question_object_type_map
+ where parent_question_id = :question_id
+ and object_type_id = :object_type_id"
+
+ db_foreach edit_question_2_60 $sql_edit_question_2_60 {
+ if { $question_state == "invisible" && $child_state != "invisible" } {
+ db_dml edit_question_2_70 "
+ update sn_question_object_type_map
+ set question_state = 'invisible'
+ where question_id = :child_id"
+ } elseif { $old_state == "invisible" && $question_state != "invisible" && $child_state == "invisible" } {
+ db_dml edit_question_2_80 "
+ update sn_question_object_type_map
+ set question_state = :question_state
+ where question_id = :child_id"
+ }
+ }
+}
+
+# Check if the question is the root of a branch. If it is and
+# its visibility has changed, we have to update the visibility
+# of the children, too.
+
+if {[km_root_branch_p $question_id]} {
+ set sql_edit_question_2_90 "
+ select question_id as child_id, question_state as child_state
+ from sn_question_object_type_map
+ start with parent_question_id = $question_id and object_type_id=$object_type_id
+ connect by parent_question_id = prior question_id and object_type_id=$object_type_id"
+
+ db_foreach edit_question_2_90 $sql_edit_question_2_90 {
+ if { $question_state == "invisible" && $child_state != "invisible" } {
+ db_dml edit_question_2_100 "
+ update sn_question_object_type_map
+ set question_state = 'invisible'
+ where question_id = :child_id"
+ } elseif { $old_state == "invisible" && $question_state != "invisible" && $child_state == "invisible" } {
+ db_dml edit_question_2_110 "
+ update sn_question_object_type_map
+ set question_state = '$question_state'
+ where question_id = :child_id"
+ }
+
+ }
+}
+
+# Update sn_question_object_type_map.
+if {[empty_string_p $old_state]} {
+ set max_sort_key [db_string edit_question_2_120 "
+ select max(sort_key) from sn_question_object_type_map
+ where object_type_id = :object_type_id"]
+
+ set calculcated_max_sort_key [expr $max_sort_key + 10]
+ db_dml edit_question_2_130 "
+ insert into sn_question_object_type_map
+ (object_type_id, question_id, form_number, mandatory_p, question_state, branch_p, sort_key)
+ values (:object_type_id, :question_id, :form_number, :mandatory_p,
+ :question_state, 'f', :calculcated_max_sort_key)"
+} else {
+ db_dml edit_question_2_140 "
+ update sn_question_object_type_map
+ set form_number = :form_number, mandatory_p = :mandatory_p, question_state = :question_state
+ where object_type_id = :object_type_id and question_id = :question_id"
+}
+
+
+# If a question has become invisible or visible, this affects fulltext search,
+# so ask the user if we should rebuild the Intermedia index for this
+# object type.
+
+if {![empty_string_p $old_state]} {
+ if { $old_state != $question_state &&
+ ($old_state == "invisible" || $question_state == "invisible") } {
+ if { $question_state != "invisible" } {
+ # Make sure that no two visible questions have the same sort_key.
+
+ set duplicate_p [db_string edit_question_2_150 "
+ select decode(count(*),0,0,1)
+ from sn_question_object_type_map
+ where object_type_id=:object_type_id
+ and question_id <> :question_id
+ and sort_key = (select sort_key from sn_question_object_type_map
+ where object_type_id=:object_type_id
+ and question_id=:question_id)"]
+
+ if {$duplicate_p} {
+ db_dml edit_question_2_160 "
+ update sn_question_object_type_map
+ set sort_key =
+ (select max(sort_key)+10
+ from sn_question_object_type_map
+ where object_type_id = :object_type_id)
+ where question_id=:question_id and object_type_id=:object_type_id"
+ }
+ }
+
+ set pretty_type_plural [km_static object_type_pretty_plural $object_type_id]
+ set title $pretty_name
+ set form_vars [export_form_vars object_type_id]
+ set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$pretty_name Questions"] $title
+ ad_return_template edit-question-2
+ } else {
+ set destination "view-questions"
+ ad_returnredirect "$destination?[export_url_vars question_id object_type_id abstract_data_type]"
+
+ # We don't want the template to be parsed.
+ return
+ }
+} else {
+ switch $abstract_data_type {
+ "text" { set destination "choose-presentation-type" }
+ "category" - "other_category" { set destination "choose-category" }
+ "option" { set destination "add-option" }
+ "integer" { set destination "view-questions" }
+ "composite" { set destination "choose-questions" }
+ "child_object" - "nephew_object" -
+ "object_link" { set destination "choose-object-type" }
+ "default" { set destination "view-questions" }
+ }
+ ad_returnredirect "$destination?[export_url_vars question_id object_type_id abstract_data_type]"
+
+ # We don't want the template to be parsed.
+ return
+}
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-question.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-question.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-question.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,148 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<form action="edit-question-2" method=post>
+<csrf-token>
+@form_vars;noquote@
+@dc_export;noquote@
+
+<table cellspacing=3 cellpadding=3 width=100>
+ <tr><th align=left>Enter a presentation name for this question:</th></tr>
+ <tr><td><include src="../km-input-tag" value="@pretty_name@" name="pretty_name"></td></tr>
+ <tr><th align=left>Enter this question as it should appear on input forms:</th></tr>
+ <tr><td><include src="../km-textarea-tag" cols="80" rows="15" value="@entry_explanation;noquote@" name="entry_explanation"></td></tr>
+
+<if @branch_p@ eq f>
+<tr><th align=left>Is this question mandatory for the creation of an object of this type?</th></tr>
+<tr><td><include src="../km-yes-no" default="@mandatory_p@" name="mandatory_p"></td></tr>
+</if>
+
+
+<if @state_output_p@ eq t>
+ <tr><th align=left>Which state should this question and its answers be in?</th></tr>
+ <tr><td><include src="../km-select-tag" default="@question_state@" values="@state_values@" size="1" name="question_state" items="@state_items@"></td></tr>
+</if>
+
+
+<if @appear_first_form_output_p@ eq t>
+<tr><th align=left>Should this question appear on the first input form?</th></tr>
+<tr><td><include src="../km-yes-no" default="@form_number@" name="first_form_p"></td></tr>
+</if>
+
+<if @order_output_p@ eq t>
+<tr><th align=left>In which order should linked objects be displayed?</th></tr>
+<tr><td><include src="../km-select-tag" default="@order_by@" values="@order_output_values@" size="1" name="order_by" items="@order_output_items@"></td></tr>
+</if>
+
+
+<if @refers_to_output_p@ eq t>
+<tr><th align=left>Refers to which question?</th></tr>
+<tr><td><include src="../km-select-tag" default="@references_question_id@" values="@refers_to_values@" size="1" name="refers_to" items="@refers_to_strings@"></td></tr>
+</if>
+
+<if @default_date_output_p@ eq t>
+<tr><th align=left>Default value:</th></tr>
+<tr><td><include src="../km-input-tag" value="@default_value@" name="default_value"><br>
+ <if @date_correct_p@ eq t>
+ Evaluation of current default value: <tt>@date_correct_output@</tt><br>
+ </if>
+ <else>
+ <font color=red>Warning: The current default value is invalid and causes a SQL error!</font><br>
+ </else>
+(Please enter SQL code that can replace the x in <tt>select x from dual</tt>.<br>
+ Examples: <tt>sysdate</tt> = the current date; <tt>sysdate+14</tt> = 2 weeks in the future;<br>
+ <tt>trunc(sysdate,'month')</tt> = the start of the current month)
+ </td></tr>
+</if>
+
+<if @edit_p@ eq t and @defaults_questions:rowcount@ gt 0>
+<tr><th align=left>Copy Default Values from linked object:</th></tr>
+<tr><td><select name=defaults_question_id>
+<option value="null">--use static default value--
+<multiple name=defaults_questions>
+<option value="@defaults_questions.question_id@"<if @defaults_questions.question_id@ eq @defaults_question_id@> selected</if>>@defaults_questions.object_type@: @defaults_questions.question_name@
+</multiple>
+</select></td></tr>
+</if>
+
+<if @max_categories_p@ eq t>
+<tr><th align=left>Maximum Number of selectable Categories:</th></tr>
+<tr><td><include src="../km-input-tag" value="@max_categories@" name="max_categories" size=3></td></tr>
+</if>
+
+<if @browseable_p@ eq t>
+<tr><th align=left>Should this category question be browseable?</th></tr>
+<tr><td><include src="../km-yes-no" default="@browse_p@" name="browse_p"></td></tr>
+</if>
+
+<if @edit_p@ eq f>
+<tr><th align=left>Select an abstract data type for this question:</th></tr>
+<tr><td><include src="../km-select-tag" size="1" values="@abstract_data_types@" name=abstract_data_type items="@pretty_data_types@"></td></tr>
+
+</if>
+
+</table>
+
+<center><input type=submit name=submit value="Proceed"></center>
+</form>
+
+<if @appear_first_form_output_p@ eq t>
+Note -- linking questions are not allowed to be asked first.
+</if>
+
+<if @special_type_1_output_p@ eq t>
+<p>You can make this question the
+<a href="add-description?short_p=1&@url_vars;noquote@&@csrf_link@">short description</a>,
+the <a href="add-description?short_p=0&@url_vars;noquote@&@csrf_link@>">long description</a> or
+the <a href="add-linked-question?@url_vars;noquote@"&@csrf_link@>link list</a>
+for @pretty_plural@.
+</if>
+
+<if @special_type_2_output_p@ eq t>
+<p>You can make this question the
+<a href="add-description?short_p=1&@url_vars;noquote@&@csrf_link@">short description</a>
+or the <a href="add-description?short_p=0&@url_vars;noquote@&@csrf_link@">long description</a>
+for @pretty_plural@.
+</if>
+
+<if @special_type_3_output_p@ eq t>
+<p>You can make this question the
+<if @is_public_until_p@ eq f><a href="add-public-until?@url_vars;noquote@&@csrf_link@">public visibility date</a><if @is_start_date_p@ eq f and @is_end_date_p@ eq f>, </if><else><if @is_start_date_p@ eq f or @is_end_date_p@ eq f> or the </if></else></if>
+<if @is_start_date_p@ eq f><a href="add-start-date?@url_vars;noquote@"&@csrf_link@>object start date</a><if @is_end_date_p@ eq f> or the </if></if>
+<if @is_end_date_p@ eq f><a href="add-end-date?@url_vars;noquote@"&@csrf_link@>object end date</a></if>
+for @pretty_plural@.
+</if>
+
+<if @is_short_p@ eq t>
+ <p>Note: This question is the object type's short description (or <cite>name</cite>).
+</if>
+
+<if @is_part_of_short_p@ in t>
+ <p>Note: This question is part of the object type's short description (or <cite>name</cite>).
+</if>
+
+<if @question_id@ eq @long_id@>
+ <p>Note: This question is the object type's long description (or <cite>overview</cite>).
+</if>
+
+<if @question_id@ eq @linked_question_id@>
+ <p>Note: This question is the object type's link list."
+</if>
+
+<if @is_public_until_p@ eq t>
+ <p>Note: This question is the object type's public until date.
+</if>
+<if @is_start_date_p@ eq t>
+ <p>Note: This question is the object type's start date.
+</if>
+<if @is_end_date_p@ eq t>
+ <p>Note: This question is the object type's end date.
+</if>
+
+<if @warning_output_p@ eq t>
+<p>Note: Since other branch questions depend on this question, changing the question state
+may make these questions inaccessible. Please check the
+<a href="view-branches?@url_vars;noquote@&@csrf_link@>branch tree</a>
+before switching the question state.
+</if>
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/edit-question.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/edit-question.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/edit-question.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,281 @@
+ad_page_contract {
+ /packages/library/www/admin/edit-question.tcl
+
+ Edit data associated with one object type's question.
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ $Id: edit-question.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ object_type_id
+ {question_id 0}
+} -properties {
+}
+
+set package_id [ad_conn package_id]
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set pretty_plural [km_static object_type_pretty_plural $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+set adts [km_adt_list -pretty_names_p 1]
+set abstract_data_types [fst [transpose $adts]]
+set pretty_data_types [snd [transpose $adts]]
+
+set special_type_1_output_p f
+set special_type_2_output_p f
+set special_type_3_output_p f
+set default_date_output_p f
+set refers_to_output_p f
+set date_correct_p f
+set warning_output_p f
+set state_output_p f
+set order_output_p f
+set appear_first_form_output_p f
+set short_id ""
+set long_id ""
+set linked_question_id ""
+set default_date_output ""
+set default_date ""
+set date_correct_output ""
+set max_categories_p f
+set browseable_p f
+set is_public_until_p f
+set is_start_date_p f
+set is_end_date_p f
+
+if {$question_id} {
+ set edit_p 1
+
+ # Get all existing data for this question
+ set attributes [km_get_questions -question_states {} -all_properties_p 1 -root_node_p 0 -question_ids [list $question_id]]
+ set key [fst $attributes]
+ set question [snd $attributes]
+
+ set pretty_name [lindex $question [lsearch $key "pretty_name"]]
+ set entry_explanation [lindex $question [lsearch $key "entry_explanation"]]
+ set mandatory_p [ad_decode [lindex $question [lsearch $key "mandatory_p"]] t 1 0]
+ set form_number [ad_decode [lindex $question [lsearch $key "form_number"]] 1 1 0]
+ set abstract_data_type [lindex $question [lsearch $key "abstract_data_type"]]
+ set presentation_type [lindex $question [lsearch $key "presentation_type"]]
+ set question_state [lindex $question [lsearch $key "question_state"]]
+ set order_by [lindex $question [lsearch $key "order_by"]]
+ set default_value [lindex $question [lsearch $key "default_value"]]
+ set branch_p [ad_decode [lindex $question [lsearch $key "branch_p"]] "t" 1 0]
+ set target_object_type_id [lindex $question [lsearch $key "target_object_type_id"]]
+ set defaults_question_id [lindex $question [lsearch $key "defaults_question_id"]]
+ set max_categories [lindex $question [lsearch $key "max_categories"]]
+ set browse_p [lindex $question [lsearch $key "browse_p"]]
+ set references_question_id [lindex $question [lsearch $key "references_question_id"]]
+ set root_branch_p [km_root_branch_p $question_id]
+ set parent_question_id [lindex $question [lsearch $key "parent_question_id"]]
+
+ if { $parent_question_id == [km_static km_dummy_object_id] || $branch_p } {
+ set composite_p 0
+ } else {
+ set composite_p 1
+ }
+
+ if { ([lsearch {object_link child_object nephew_object} $abstract_data_type] != -1)
+ && [empty_string_p $target_object_type_id] } {
+ ad_returnredirect "choose-object-type?[export_url_vars object_type_id question_id abstract_data_type]"
+ return
+ }
+
+ if {[lsearch [list "category" "other_category" "option"] $abstract_data_type] > -1} {
+ ## psn: maximum number of categories selectable
+ set max_categories_p t
+ }
+
+ if {[lsearch [list "category" "other_category"] $abstract_data_type] > -1} {
+ ## category browseable?
+ set browseable_p t
+ }
+
+ if {[lsearch [list "text" "date" "integer" "category" "other_category"] $abstract_data_type] > -1} {
+ ## psn: child and nephew questions can automatically get the defaults
+ ## from linked parent/uncle questions
+ db_multirow defaults_questions get_possible_defaults_questions {
+ select ot.pretty_name as object_type, ot.object_type_id,
+ q2.pretty_name as question_name, q2.question_id
+ from sn_questions q, sn_question_object_type_map qotm, sn_object_types ot,
+ sn_questions q2, sn_question_object_type_map qotm2
+ where qotm.question_id = q.question_id
+ and qotm.question_state = 'active'
+ and q.abstract_data_type in ('child_object','nephew_object')
+ and q.target_object_type_id = :object_type_id
+ and ot.object_type_id = qotm.object_type_id
+ and ot.context_id = :package_id
+ and qotm2.object_type_id = ot.object_type_id
+ and qotm2.question_state = 'active'
+ and qotm2.question_id = q2.question_id
+ and q2.abstract_data_type = :abstract_data_type
+ }
+ } else {
+ template::multirow create defaults_questions object_type object_type_id question_name question_id
+ }
+
+} else {
+
+ set edit_p 0
+ set question_id [km_new_acs_object_id]
+ set pretty_name ""
+ set entry_explanation ""
+ set mandatory_p 0
+ set form_number 0
+ set presentation_type ""
+ set question_state "active"
+ set order_by ""
+ set default_value ""
+ set branch_p 0
+ set root_branch_p 0
+ set composite_p 0
+ set references_question_id 0
+ set target_object_type_id 0
+}
+
+# Do some display things differently in the case of an edit
+if {$edit_p} {
+
+ set title "Edit Question: $pretty_name"
+ set context_title $pretty_name
+ set short_id [km_static object_type_short_description $object_type_id]
+ set long_id [km_static object_type_long_description $object_type_id]
+ set public_until_id [km_static object_type_public_until $object_type_id]
+ set start_date_id [km_static object_type_start_date $object_type_id]
+ set end_date_id [km_static object_type_end_date $object_type_id]
+ set linked_question_id [km_static object_type_linked_question_id $object_type_id]
+
+ if { $question_state == "active" && !$branch_p } {
+ if { [lsearch {text file integer date user_link object_link content_link} $abstract_data_type] != -1 &&
+ [lsearch $short_id $question_id]==-1 && $question_id != $long_id &&
+ $question_id != $linked_question_id } {
+
+ # Show a link to set this question as the short/long description or link list.
+
+ if { $abstract_data_type == "object_link" } {
+ set special_type_1_output_p t
+ } else {
+ set special_type_2_output_p t
+ }
+ }
+ if { $abstract_data_type == "date" } {
+ set special_type_3_output_p t
+ }
+ }
+
+ if {$root_branch_p} {
+ set warning_output_p t
+ }
+} else {
+ set title "New Question"
+ set context_title $title
+}
+
+if { $edit_p && [lsearch $short_id $question_id]==-1 && $question_id != $long_id && !$branch_p } {
+ if { $abstract_data_type == "composite" } {
+ # For composite questions, we don't support the read-only state.
+ set state_values {active deprecated invisible}
+ set state_items {{Active} {To be phased out} {Invisible}}
+ } else {
+ set state_values {active deprecated read-only invisible}
+ set state_items {{Active} {To be phased out} {Read-Only} {Invisible}}
+ }
+ set state_output_p t
+}
+
+if {$edit_p} {
+ if { $abstract_data_type == "object_link" || $branch_p || $composite_p } {
+ if !$form_number { set form_number 1 }
+ append footnote [export_form_vars form_number]
+ } else {
+ set appear_first_form_output_p t
+ }
+
+ if { [lsearch {object_link child_object content_link nephew_object} $abstract_data_type] != -1 } {
+ set order_output_p t
+ set order_output_values [list "name" "name desc" "last_modified" "last_modified desc" "link_id" "link_id desc"]
+ set order_output_items [list "Name" "Name desc." "Last modified" "Last modified desc." "Link date" "Link date desc."]
+ }
+
+ if { $abstract_data_type == "object_link" } {
+ set refers_to_list [db_list_of_lists edit_question_10 "
+ select q.question_id, ot.pretty_name || ' - ' || q.pretty_name as references_object_question
+ from sn_questions q, sn_question_object_type_map qm, sn_object_types ot
+ where q.target_object_type_id = :object_type_id
+ and q.abstract_data_type = 'object_link'
+ and q.question_id = qm.question_id
+ and qm.question_state <> 'invisible'
+ and qm.object_type_id = :target_object_type_id
+ and ot.object_type_id = qm.object_type_id"]
+
+ set refers_to_values "null"
+ set refers_to_strings "None"
+ foreach list_element $refers_to_list {
+ lappend refers_to_values [lindex $list_element 0]
+ lappend refers_to_strings [lindex $list_element 1]
+ }
+
+ set refers_to_output_p t
+ }
+
+ if { $abstract_data_type == "date" } {
+ set default_date_output_p t
+ if {![empty_string_p $default_value]} {
+ set db [ns_db gethandle]
+ if { ![catch {set default_date [db_string edit_question_19 "select $default_value from dual"]}] } {
+ set date_correct_p t
+ set date_correct_output "[util_AnsiDatetoPrettyDate $default_date]"
+ } else {
+ set date_correct_p f
+ }
+ }
+ }
+} else {
+ set appear_first_form_output_p t
+ set form_number 1
+}
+
+if {$branch_p} {
+ set parent_id [km_branch_parent $question_id $object_type_id]
+
+ append footnote "
+<p>Note: This question is part of a branch. Therefore, you cannot change its state.
+If you want to do so, you first have to remove it from the <a href=\"view-branches?question_id=$parent_id&object_type_id=$object_type_id\">branch tree</a>."
+}
+
+
+set branch_p [ad_decode $branch_p 1 t f]
+set edit_p [ad_decode $edit_p 1 t f]
+set form_vars [export_form_vars question_id object_type_id abstract_data_type]
+set url_vars [export_url_vars question_id object_type_id abstract_data_type]
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$pretty_type Questions"] $title
+
+if {$short_id == $question_id} {
+ set is_short_p t
+ set is_part_of_short_p f
+} else {
+ set is_short_p f
+ if {[lsearch $short_id $question_id]==-1} {
+ set is_part_of_short_p f
+ } else {
+ set is_part_of_short_p t
+ }
+}
+
+if {$edit_p} {
+ if {$public_until_id == $question_id} {
+ set is_public_until_p t
+ }
+ if {$start_date_id == $question_id} {
+ set is_start_date_p t
+ }
+ if {$end_date_id == $question_id} {
+ set is_end_date_p t
+ }
+}
+
+set dc_export [doubleclick::signature_html]
+set csrf_link [csrf::link_token]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/error.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/error.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/error.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,16 @@
+<master src="master">
+<property name=title>Application Error</property>
+
+We had
+<if @n_errors@ eq 1>
+ a problem
+</if><else>
+ some problems
+</else>
+ processing your entry:
+
+<ul>
+ <list name=error_list>
+ <li>@error_list:item;noquote@
+ </list>
+</ul>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,43 @@
+ad_page_contract {
+} {
+ {email:array ""}
+ {rating_p:array ""}
+ object_id:integer,notnull
+ root_node_id:integer,notnull
+}
+csrf::authenticate
+
+set rating_p_names [array names rating_p]
+
+foreach category_id [array names email] {
+ if { [info exists rating_p($category_id)] } {
+ set this_rating_p t
+ } else {
+ set this_rating_p f
+ }
+
+ if { $this_rating_p == "f" } {
+ set this_scale 0
+ } else {
+ set this_scale 5
+ }
+
+ set this_email $email($category_id)
+
+ db_transaction {
+ db_dml delete_category_settings "
+ delete from sn_comments_category_settings
+ where category_id=:category_id
+ and object_id = :object_id"
+
+ db_dml insert_category_settings "
+ insert into sn_comments_category_settings (object_id, category_id, email, rating_p, scale)
+ values (:object_id, :category_id, :this_email, :this_rating_p, :this_scale) "
+ } on_error {
+ ad_return_error "Error" "Blah blah Blah"
+ return
+ }
+}
+
+
+ad_returnredirect .
Index: openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,26 @@
+<master>
+<property name="title">@page_title;noquote@</property>
+
+<form method=get action="feedback-category-options-2">
+<csrf-token>
+@form_vars;noquote@
+<table>
+ <tr><th> Category Name </th><th> Email address</th><th>Rating?</th></tr>
+ <multiple name="one_tree">
+ <if @one_tree.node_id@ not eq @root_node_id@>
+ <tr>
+ <td>
+ @one_tree.level;noquote@ @one_tree.node_name;noquote@
+ </td>
+ <td>
+ <input name=email.@one_tree.category_id@ type=text value="@one_tree.email@" size=35>
+ </td>
+ <td>
+ <input name=rating_p.@one_tree.category_id@ type=checkbox <if @one_tree.rating_p@ eq "t"> checked</if> >
+ </td>
+ </if>
+ </multiple>
+ <tr><td colspan=4 align=center><input type="submit" value="Save"></td></tr>
+</table>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/feedback-category-options.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,45 @@
+ad_page_contract {
+} {
+ root_node_id:integer,notnull
+ object_id:integer,notnull
+} -properties {
+ one_tree:multirow
+ page_title:onevalue
+ form_vars
+}
+
+# CHECK PERMISSIONS AT SOME POINT
+
+# CHECK IF THIS TREE IS REALLY ASSIGNED TO THIS OBJECT
+
+
+set page_title "Set the category feedback options"
+
+set_context_bar_data $page_title
+
+set form_vars [export_form_vars root_node_id object_id]
+
+array set node [site_node_closest_ancestor_site_node "acs-subsite"]
+set subcommunity_id $node(package_id)
+
+template::multirow create one_tree node_id category_id node_name email rating_p scale level
+
+db_foreach get_one_tree "
+ select tree.* , sccs.email, sccs.rating_p, sccs.scale from
+ (select /*+INDEX(sw_category_dim sw_category_dim_long_name) */ category.long_name(object_id) as node_name,
+ node_id, parent_node_id, object_id as category_id, level
+ from sw_category_dim
+ start with node_id = :root_node_id
+ connect by prior node_id = parent_node_id) tree, sn_comments_category_settings sccs
+ where sccs.category_id(+)=tree.category_id
+ and sccs.object_id(+)=:object_id " {
+
+
+ template::multirow append one_tree $node_id $category_id $node_name $email $rating_p $scale [gt_repeat_string " " [expr $level * 5]]
+
+
+ }
+
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/index.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,77 @@
+<master src="../master">
+<property name="title">Library Administration</property>
+
+<form method=post action="sort-keys">
+ <csrf-token>
+ @form_vars;noquote@
+ <table bgcolor="#eeeeee" cellpadding=3 cellspacing=0 border=1>
+
+ <tr bgcolor="#cccfff">
+ <th width=5%>Graphic</th>
+ <th width=45%>Knowledge Object Type</th>
+ <th width=5%>Sort Key</th>
+ <th width=5%>Public</th>
+ <th width=5%>Browsable</th>
+ <th width=35%>Action</th></tr>
+
+ <multiple name="object_types">
+ <if @object_types.rownum@ odd><tr bgcolor="#eeeeee" valign=middle></if>
+ <else><tr bgcolor="#cccfff" valign=middle></else>
+
+ <if @object_types.graphic_html@ ne "">
+ <td align=center>@object_types.graphic_html;noquote@</td>
+ </if>
+ <else>
+ <td align=center> </td>
+ </else>
+ <td align=center>
+ <a href="../browse-one-type?@object_types.object_id_form_var@"><b>@object_types.pretty_plural@</b></a></td>
+ <td align=center><include src="../km-input-tag" size="4" value="@object_types.sort_key@" name="@object_types.object_type_id@"></td>
+ <td align=center>@object_types.public_html;noquote@</td>
+ <td align=center>@object_types.browse_html;noquote@</td>
+ <td><a href="edit-object-type?@object_types.object_id_form_var@"><font size=-1>Properties</font></a> |
+ <a href="view-questions?@object_types.object_id_form_var@"><font size=-1>Questions</font></a> |
+ <a href="view-sample-form?@object_types.object_id_form_var@"><font size=-1>Input Form</font></a> |
+ <a href="delete-object-type?@object_types.object_id_form_var@"><font size=-1>Delete Object Type</font></a> |
+ <a href="move-object-type?@object_types.object_id_form_var@"><font size=-1>Move to another Instance</font></a> |
+ <a href="copy-object-type?@object_types.object_id_form_var@"><font size=-1>Copy Definition to another Instance</font></a>
+ </multiple>
+ </table>
+ <br>
+ <center><input type=submit value="Edit"></center>
+</form>
+
+<a href="create-object-type">Add an Object Type</a><br>
+<if @display_copy_link_p@ eq t>
+ <a href="copy-object-type-structure">Copy Object Type Structure To Another Library Instance</a><br>
+</if>
+
+<a href="@feedback_category_admin_link@">Feedback Categories</a>
+<if @feedback_category_options_admin_link@ not nil>
+ |
+<a href="@feedback_category_options_admin_link@">Feedback Category Options</a>
+</if>
+<if @xchange_category_admin_link@ not nil>
+ |
+<a href="@xchange_category_admin_link@">People <Km-System-Name> Application Form Categories</a>
+</if>
+<br>
+<if @ApprovalProcessP@ eq 1>
+ <a href="approval-process-toggle?approvalprocessp=f&@csrf_link@">Turn off approval process</a>
+</if>
+<else>
+ <a href="approval-process-toggle?approvalprocessp=t&@csrf_link@">Turn on approval process</a>
+</else>
+
+<if @ApprovalProcessP@ eq 1>
+<h3>Approval Coordinators</h3>
+ <ul>
+ <multiple name="approval_coordinators">
+ <li><a href="../../users/yp?user_id=@approval_coordinators.coordinator_id@">@approval_coordinators.last_name@, @approval_coordinators.first_names@ (@approval_coordinators.email@)</a>
+ <a href="remove-approval-coordinator?user_id=@approval_coordinators.coordinator_id@">(remove)</a>
+ </multiple>
+ </ul>
+
+ <a href="approval-process-toggle?approvalprocessp=t&@csrf_link@">Add more approval coordinators</a><br>
+ (Note: These users need to have the permission to publish objects in this library instance.)
+</if>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/index.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,97 @@
+ad_page_contract {
+ /packages/library/www/admin/index.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: index.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+} -properties {
+ context_bar:onevalue
+ instance_name:onevalue
+ form_vars:onevalue
+ instances_with_admin_rights:onevalue
+ object_types:multirow
+ feedback_category_admin_link:onevalue
+ feedback_category_options_admin_link:onevalue
+ xchange_category_admin_link:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+set display_copy_link_p f
+template::multirow create object_types object_type_id object_id_form_var pretty_plural browse_html public_html graphic_html sort_key checkmark
+
+db_foreach object_type {
+ select object_type_id, pretty_plural, browse_p, public_p, graphic, sort_key
+ from sn_object_types
+ where deleted_p = 'f' and context_id = :package_id
+ order by sort_key
+} {
+ if {![empty_string_p $graphic]} {
+ set graphic_html "<a href=\"../browse-one-type?object_type_id=$object_type_id\"><img src=\"/library-files/$graphic\" height=[library_icon_height] width=[library_icon_width] border=0></a>"
+ } else {
+ set graphic_html ""
+ }
+ set checkmark "<img src=\"../graphics/check.gif\" width=16 height=16 border=0>"
+ set browse_html [ad_decode $browse_p t $checkmark " "]
+ set public_html [ad_decode $public_p t $checkmark " "]
+ set object_id_form_var [export_url_vars object_type_id]
+ template::multirow append object_types $object_type_id $object_id_form_var $pretty_plural $browse_html $public_html $graphic_html $sort_key $checkmark
+ set display_copy_link_p t
+}
+
+set return_url "."
+set table_name "sn_object_types"
+set key_column "object_type_id"
+set form_vars [export_form_vars table_name key_column return_url]
+
+# Let's see if this user has admin rights for more than one library instance.
+# Variable kept for backward compatibility.
+set instances_with_admin_rights 2
+
+set feedback_category_admin_link "categories/one-object?object_id=$package_id"
+set feedback_category_root_node_id [db_string get_assigned_feedback_tree {
+ select octr.subtree_root_node_id as root_node_id
+ from generic_trees gt, acs_rels ar, object_category_tree_rels octr
+ where ar.object_id_one = :package_id
+ and ar.object_id_two = gt.tree_id
+ and ar.rel_id = octr.rel_id
+ and rel_type = 'object_category_tree_rel' } -default ""]
+
+if { ![empty_string_p $feedback_category_root_node_id ] } {
+ set feedback_category_options_admin_link "feedback-category-options?root_node_id=$feedback_category_root_node_id&object_id=[ad_conn package_id]"
+}
+
+set xchange_p [db_string application_nephew_question_p {
+ select count(*)
+ from sn_questions q, sn_question_object_type_map qm, sn_object_types ot
+ where q.abstract_data_type = 'nephew_object'
+ and q.presentation_type = 'application'
+ and q.question_id = qm.question_id
+ and qm.object_type_id = ot.object_type_id
+ and ot.context_id = :package_id
+}]
+
+if { $xchange_p } {
+ set xchange_category_admin_link "xchange-categories"
+} else {
+ set xchange_category_admin_link ""
+}
+
+set ApprovalProcessP [km_static approval_p $package_id]
+
+if {$ApprovalProcessP} {
+ db_multirow approval_coordinators get_approval_coordinators {
+ select ac.coordinator_id, u.first_names, u.last_name, u.email
+ from approval_coordinators ac, users u
+ where ac.package_id=:package_id
+ and ac.coordinator_id=u.user_id
+ }
+}
+
+set_context_bar_data
+set csrf_link [csrf::link_token]
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/map-composite-questions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/map-composite-questions.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/map-composite-questions.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,42 @@
+# /www/admin/library/map-composite-questions.tcl
+#
+# $Id: map-composite-questions.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_contract {
+
+} {
+ composite_id
+ object_type_id
+ question_id:integer,notnull,multiple,trim
+}
+csrf::authenticate
+set child_ids [km_get_child_questions $composite_id]
+set dep_ids [minus $child_ids $question_id]
+
+# If even one of the children questions is mandatory, then the composite is too.
+set mandatory_p [km_mandatory_child_p -child_ids $child_ids]
+
+if { $mandatory_p } {
+ db_dml map_composite_questions_10 "
+ update sn_question_object_type_map
+ set mandatory_p='t'
+ where question_id=$composite_id and object_type_id=$object_type_id"
+}
+
+foreach one_question_id $question_id {
+ db_dml map_composite_questions_20 "
+ update sn_question_object_type_map
+ set parent_question_id = $composite_id, branch_p='f'
+ where question_id=$one_question_id and object_type_id=$object_type_id"
+
+}
+
+if ![null_p $dep_ids] {
+ db_dml map_composite_questions_30 "
+ update sn_question_object_type_map
+ set parent_question_id = [km_static km_dummy_object_id]
+ where object_type_id = $object_type_id and question_id in ([join $dep_ids ","])"
+}
+
+set question_id $composite_id
+ad_returnredirect "view-composite?[export_url_vars object_type_id question_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/map-link-question.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/map-link-question.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/map-link-question.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,12 @@
+ad_page_variables {
+ object_type_id
+ question_id
+ linked_object_type_id
+}
+csrf::authenticate
+
+db_dml map_link_question "update sn_questions set target_object_type_id=:linked_object_type_id where question_id=:question_id"
+
+km_static -reset $question_id
+
+ad_returnredirect "view-questions?[export_url_vars object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/master.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/master.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/master.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,44 @@
+<if @signatory@ nil>
+ <% # Set a default email address to sign the bottom of each page.
+ set signatory [ad_parameter -package_id [ad_acs_kernel_id] SystemOwner "admin@yourservername"] %>
+</if>
+
+<if @head_contents@ nil>
+<master>
+<property name="title">@title@</property>
+
+<h2>@title@</h2>
+
+@context_bar;noquote@
+
+<hr>
+
+<slave>
+</if>
+<else>
+ <% # Setting the default attributes for page display.
+ set bgcolor [ad_parameter -package_id [ad_acs_kernel_id] bgcolor acs-core-ui white]
+ set text [ad_parameter -package_id [ad_acs_kernel_id] textcolor acs-core-ui black]
+ set attributes "bgcolor=\"$bgcolor\" text=\"$text\"" %>
+
+<html>
+<head>
+@head_contents@
+<title>@page_title@</title>
+</head>
+<body @attributes@>
+
+<h2>@page_title@</h2>
+
+@context_bar@
+
+<hr>
+
+<slave>
+
+<hr>
+
+<address><a href="mailto:@signatory@">@signatory@</a></address>
+</body>
+</html>
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,58 @@
+ad_page_contract {
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+} {
+ object_type_id:integer
+ move_to_package_id:integer
+} -properties {
+ context_bar:onevalue
+}
+csrf::authenticate
+
+ad_require_permission $move_to_package_id "admin"
+ad_require_permission $object_type_id "admin"
+
+set this_package_id [ad_conn package_id]
+set ip_address [ns_conn peeraddr]
+set user_id [ad_get_user_id]
+
+db_transaction {
+ db_dml move_object_type_2_10 {update acs_objects
+ set context_id = :move_to_package_id,
+ last_modified = sysdate,
+ modifying_user = :user_id,
+ modifying_ip = :ip_address
+ where object_id in
+ (select object_id
+ from sn_objects
+ where object_type_id = :object_type_id)}
+
+ db_dml update_type_context {
+ update acs_objects
+ set context_id = :move_to_package_id
+ where object_id = :object_type_id
+ }
+
+ db_dml move_object_type_2_20 {update acs_objects_description
+ set package_id = :move_to_package_id
+ where object_id in
+ (select object_id
+ from sn_objects
+ where object_type_id = :object_type_id)}
+
+ db_dml move_object_type_2_30 {update sn_objects
+ set context_id = :move_to_package_id
+ where object_type_id = :object_type_id}
+
+ db_dml move_object_type_2_40 "update sn_object_types
+ set context_id = :move_to_package_id
+ where object_type_id = :object_type_id"
+
+ db_dml move_object_type_2_50 "update sn_table_name_map
+ set context_id = :move_to_package_id
+ where object_type_id = :object_type_id"
+}
+
+##km_static -reset $object_type_id
+
+ad_returnredirect index
Index: openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,19 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+Choose to which community you want to copy the object type definition "@object_type_name@"?
+<p>
+
+<form method=post action="move-object-type-2">
+<csrf-token>
+<select name=move_to_package_id>
+ <include src="communities-with-admin-rights">
+</select>
+
+<input type="hidden" name="object_type_id" value="@object_type_id@">
+<center>
+<input type="submit" value="Yes, proceed">
+</center>
+</form>
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/move-object-type.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,25 @@
+ad_page_contract {
+ /packages/library/www/admin/move-object-type.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+} {
+ object_type_id:integer
+} -properties {
+ title:onevalue
+ object_type_name:onevalue
+ instances:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set object_type_name [db_string object_type_delete_10 "select pretty_plural from sn_object_types
+ where object_type_id = :object_type_id"]
+
+set title "Move Object Type \"$object_type_name\"' to another Instance"
+
+set_context_bar_data $title
+
+ad_return_template
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/reindex.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/reindex.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/reindex.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,27 @@
+# /www/admin/library/reindex.tcl
+#
+# Rebuild the Intermedia index for a given object type.
+#
+# $Id: reindex.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_variables {
+ object_type_id
+}
+csrf::authenticate
+
+# FIXME! There is no datastore column in sn_objects
+#db_dml reindex_10 "update sn_objects set datastore = 'a' where object_type_id = :object_type_id"
+
+# o.k. fixed you. Now acs_objects_description is updated instead of sn_objects
+db_dml reindex_sn_objects "
+update (
+ select /*+ ORDERED USE_NL(acs_objects_description) INDEX( acs_objects_description acs_objects_desc_pk ) */
+ aod.datastore aod_ds
+ from acs_objects_description aod, sn_objects so
+ where aod.object_id = so.object_id
+ and so.object_type_id = :object_type_id
+ )
+ set aod_ds = 'a'
+"
+
+ad_returnredirect "view-questions?[export_url_vars object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/remove-approval-coordinator.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/remove-approval-coordinator.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/remove-approval-coordinator.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,21 @@
+ad_page_contract {
+ /www/library/admin/remove-approval-coordinator
+
+ @cvs-id $Id: remove-approval-coordinator.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ {user_id:integer,notnull}
+}
+csrf::authenticate
+
+set package_id [ad_conn package_id]
+
+db_dml remove_approval_process {
+ delete from approval_coordinators
+ where package_id = :package_id
+ and coordinator_id = :user_id
+}
+
+km_static -reset $package_id
+
+ad_returnredirect .
+return
Index: openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name-2.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,54 @@
+ad_page_contract {
+ Set composed short name
+} {
+ object_type_id:naturalnum,notnull
+ {question1:naturalnum,notnull 0}
+ {question2:naturalnum,notnull 0}
+ {question3:naturalnum,notnull 0}
+}
+csrf::authenticate
+
+if {[empty_string_p $question1]} {
+ ad_return_complaint 1 "You need to choose question 1!"
+}
+
+if {[empty_string_p $question2]} {
+ ad_return_complaint 1 "You need to choose question 2!"
+}
+
+if {[empty_string_p $question3]} {
+ set question3 0
+}
+
+db_dml clear_out_the_past {delete from sn_types_map_short_name
+ where object_type_id=:object_type_id}
+
+set sql_insert_question {insert into sn_types_map_short_name \
+ values (:object_type_id, :question_id, :position)}
+
+set position 1
+
+set question_id $question1
+db_dml insert_question_1 $sql_insert_question
+incr position
+
+if {$question2} {
+ set question_id $question2
+ db_dml insert_question_2 $sql_insert_question
+ incr position
+}
+
+if {$question3} {
+ set question_id $question3
+ db_dml insert_question_3 $sql_insert_question
+ incr position
+}
+
+db_dml update_one_line_description {
+ update sn_objects
+ set one_line_description = km_utilities.shortname_string(object_id,:question1,:question2,:question3)
+ where object_type_id=:object_type_id}
+
+km_static -reset $object_type_id
+
+ad_returnredirect "view-questions?object_type_id=$object_type_id"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,47 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+
+<!-- Support up to three questions -->
+
+<h3>Select up to three questions for your composed short name</h3>
+<form method=post action="set-composed-short-name-2">
+<csrf-token>
+@form_vars;noquote@
+<table>
+<tr>
+<td><strong>Question 1</strong></td>
+<td><strong>Question 2</strong></td>
+<td><strong>Question 3</strong></td>
+</tr>
+<tr><td>
+<select size="1" name="question1">
+<option value="0">---</option>
+<multiple name="questions">
+ <option value="@questions.question_id@">@questions.pretty_name@</option>
+</multiple>
+</select>
+</td>
+
+<td>
+<select size="1" name="question2">
+<option value="0">---</option>
+<multiple name="questions">
+ <option value="@questions.question_id@">@questions.pretty_name@</option>
+</multiple>
+</select>
+</td>
+
+<td>
+<select size="1" name="question3">
+<option value="0">---</option>
+<multiple name="questions">
+ <option value="@questions.question_id@">@questions.pretty_name@</option>
+</multiple>
+</select>
+</td></tr>
+<tr><td></td><td><br><center><input type=submit value="Set short name"></center></td><td></td></tr>
+</table>
+<p>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/set-composed-short-name.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,38 @@
+ad_page_contract {
+ Set combined short name
+} {
+ object_type_id:naturalnum,notnull
+}
+
+# Object type info for page display
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+set question_items [km_get_questions -question_states active -root_node_p 0 -all_properties_p 1 -object_type_id $object_type_id]
+set key [fst $question_items]
+set question_items [tail $question_items]
+
+set short_description [km_static object_type_short_description $object_type_id]
+
+set input_count 0
+set pretty_name_short_description ""
+
+template::multirow create questions question_id pretty_name
+
+foreach question $question_items {
+ set question_id [lindex $question [lsearch $key "question_id"]]
+ set pretty_name [lindex $question [lsearch $key "pretty_name"]]
+ set abstract_data_type [lindex $question [lsearch $key "abstract_data_type"]]
+
+ if {[string equal $abstract_data_type text]} {
+ template::multirow append questions $question_id $pretty_name
+ }
+ if { $question_id == $short_description } {
+ set pretty_name_short_description "$pretty_name is currently the short name."
+ }
+}
+
+set form_vars [export_form_vars object_type_id]
+set title "Set combined short name for $pretty_type"
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$pretty_type Questions" ] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/set-default-branch.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/set-default-branch.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/set-default-branch.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,18 @@
+ad_page_contract {
+ /packages/library/www/admin/set-default-branch.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id:
+} {
+ branch_id:integer
+ question_id:integer
+ object_type_id:integer
+}
+csrf::authenticate
+
+db_dml set_default_branch_10 "update sn_question_object_type_map set default_branch = :branch_id
+ where question_id = :question_id"
+
+ad_returnredirect "edit-branch?[export_url_vars question_id branch_id object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/sort-keys.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/sort-keys.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/sort-keys.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,50 @@
+# /www/admin/library/sort-keys.tcl
+#
+
+
+# $Id: sort-keys.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_contract {
+
+ Takes in a bunch of object_type_id-sort_key form vars and resorts them
+ numerically so that there is always a gap of 10 between them and NO
+ duplicates or empty values.
+
+ @author Dirk
+ @cvs-id $Id: sort-keys.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+} {
+ table_name:trim,notnull
+ key_column:trim,notnull
+ return_url:
+}
+
+set form [ns_conn form]
+set form_size [ns_set size $form]
+
+set tuples {}
+set i 0
+while { $i < $form_size } {
+ set key [ns_set key $form $i]
+ set value [ns_set value $form $i]
+ if [integer_p $key] {
+ # Then it's one of the sort_key tags.
+ lappend tuples [list $key $value ]
+ }
+ incr i
+}
+
+# Preliminery sort
+set tuples [qsort $tuples snd]
+
+set i 10
+
+foreach tuple $tuples {
+ set sort_key $i
+ set id [fst $tuple]
+ db_dml sort_keys "update $table_name set sort_key = :sort_key where $key_column = :id"
+ incr i 10
+}
+
+ad_returnredirect $return_url
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/toggle.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/toggle.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,25 @@
+# /www/admin/library/toggle.tcl
+#
+# $Id: toggle.tcl,v 1.1 2003/07/02 12:19:44 peterm Exp $
+
+ad_page_variables {
+ object_type_id
+ {browse_p ""}
+ {public_p ""}
+ {return_url ""}
+}
+csrf::authenticate
+
+if ![empty_string_p $browse_p] { lappend sets "browse_p='$browse_p'" }
+if ![empty_string_p $public_p] { lappend sets "public_p='$public_p'" }
+
+if [null_p $sets] {
+ ad_return_error "Missing parameters" "
+ Either browse_p or public_p have to be specified."
+}
+
+db_dml toggle_10 "
+ update sn_object_types set [join $sets ", "]
+ where object_type_id=:object_type_id"
+
+ad_returnredirect $return_url
Index: openacs-4/contrib/obsolete-packages/library/www/admin/unset-default-branch.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/unset-default-branch.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/unset-default-branch.tcl 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,20 @@
+ad_page_contract {
+ /packages/library/www/admin/unset-default-branch.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id:
+} {
+ branch_id:integer
+ question_id:integer
+ object_type_id:integer
+}
+csrf::authenticate
+
+db_dml unset_default_branch "
+ update sn_question_object_type_map
+ set default_branch = null
+ where question_id = :question_id"
+
+ad_returnredirect "edit-branch?[export_url_vars question_id branch_id object_type_id]"
Index: openacs-4/contrib/obsolete-packages/library/www/admin/user-search.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/user-search.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/user-search.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1 @@
+<include src="/packages/acs-subsite/www/user-search">
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-branches.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-branches.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-branches.adp 2 Jul 2003 12:19:44 -0000 1.1
@@ -0,0 +1,44 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<if @branches:rowcount@ gt 0>
+ The following branches exist for this question:
+ <table bgcolor="<%=[ad_parameter table_color library #cccfff]%>" cellpadding=3 cellspacing=0 border=1 width=100%>
+ <tr bgcolor="<%=[ad_parameter table_color library #cccfff]%>">
+ <th>Operator</th>
+ <th>Answer</th>
+ <th>Default Branch</th>
+ <th>Pretty Name</th>
+ <th>Question Text</th>
+ <th>Presentation Type</th>
+ <th>Abstract Data Type</th>
+ <th>Action</th>
+ </tr>
+
+ <multiple name="branches">
+ <tr>
+ <td align=center>@branches.branch_operator;noquote@</td>
+ <td>@branches.branch_answer@</td>
+ <td align=center>@branches.checkmark;noquote@</td>
+ <td>@branches.pretty_name@</td>
+ <td>@branches.entry_explanation@</td>
+ <td>@branches.presentation_type@</td>
+ <td>@branches.abstract_data_type@</td>
+ <td> @branches.edit_link;noquote@<font size=-1>Edit</font></a> |
+ @branches.delete_link;noquote@<font size=-1>Delete</font></a></td></tr>
+ </multiple>
+ </table>
+
+</if>
+<else>
+ There are no branches for this question.
+</else>
+<br><br>
+
+<if @add_branch_link_p@ eq t>
+@add_branch_link;noquote@Add a branch</a>
+</if>
+<else>
+Please note that this question is @question_state@. Therefore, you cannot add new branches.
+</else>
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-branches.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-branches.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-branches.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,83 @@
+# $Id: view-branches.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+ad_page_contract {
+
+ @author Dirk
+ @cvs-id $Id: view-branches.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+} {
+ object_type_id:integer
+ question_id:integer
+} -properties {
+ title:onevalue
+ branches:multirow
+ add_branch_link_p:onevalue
+ question_state:onevalue
+ add_branch_link:onevalue
+}
+
+set question_info [km_get_question $question_id $object_type_id]
+set pretty_question [snd $question_info]
+set question_state [lindex $question_info 3]
+
+set existing_branches [km_get_branches -question_attributes_p 1 $question_id $object_type_id]
+set key [fst $existing_branches]
+set branch_list [tail $existing_branches]
+
+set default_branch [km_default_branch $question_id]
+
+template::multirow create branches branch_operator branch_answer checkmark pretty_name entry_explanation presentation_type abstract_data_type edit_link delete_link
+
+if ![null_p $branch_list] {
+ foreach branch $branch_list {
+ set branch_answer [lindex $branch [lsearch $key branch_answer]]
+ set branch_operator [lindex $branch [lsearch $key branch_operator]]
+ set entry_explanation [km_shorten_question [lindex $branch [lsearch $key entry_explanation]]]
+ set pretty_name [lindex $branch [lsearch $key pretty_name]]
+ set presentation_type [km_pretty_tag [lindex $branch [lsearch $key presentation_type]]]
+ set abstract_data_type [km_pretty_adt [lindex $branch [lsearch $key abstract_data_type]]]
+ set branch_id [lindex $branch [lsearch $key question_id]]
+
+ if [empty_string_p $branch_operator] { set branch_operator " " }
+ if { $branch_id == $default_branch } {
+ set checkmark "<img src=\"../../graphics/check.gif\" width=16 height=16>"
+ } else {
+ set checkmark " "
+ }
+
+ set edit_link "<a href=\"edit-branch?[export_url_vars question_id branch_id object_type_id]\">"
+ set delete_link "<a href=\"delete-branch?[export_url_vars question_id branch_id object_type_id]\">"
+
+ template::multirow append branches $branch_operator $branch_answer $checkmark $pretty_name $entry_explanation $presentation_type $abstract_data_type $edit_link $delete_link
+ }
+}
+
+if { $question_state != "read-only" && $question_state != "invisible" } {
+ set add_link ""
+} else {
+ set add_link ""
+}
+
+if { $question_state != "read-only" && $question_state != "invisible" } {
+ set add_branch_link_p t
+ set question_state ""
+ set add_branch_link "<a href=\"edit-branch?[export_url_vars question_id object_type_id]\">"
+} else {
+ set add_branch_link_p f
+ set question_state "[km_pretty_question_state $question_state]"
+ set add_branch_link ""
+}
+
+
+
+set title "Navigational Branches for $pretty_question"
+set_context_bar_data \
+ [list "." "Knowledge Library"] \
+ [list "view-questions?object_type_id=$object_type_id" "All Questions"] \
+ $title
+
+set object_type_name [db_string view_branches_20 "select pretty_name
+ from sn_object_types
+ where object_type_id=:object_type_id"]
+
+
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id" "$object_type_name Questions"] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-composite.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-composite.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-composite.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,22 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<form method=post action="create-composite-2">
+<csrf-token>
+@form_vars;noquote@
+<p>The new composite question will appear on the form as shown
+below. You can change the appearance of the this question by changing
+the sort-key, presentation type, tag height or tag width of the
+individual questions.
+
+<table width=100%>
+<tr bgcolor="#123456"><th align=left>@pretty_name@</th></tr>
+<tr><td><i>@entry_explanation@</i></td></tr>
+<tr><td><include src="../question-field-composite" question_id="@question_id@"></td></tr>
+
+Or you may wish to <a href="choose-questions?@url_vars@">change questions.</a>
+
+</table>
+
+<br>
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-composite.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-composite.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-composite.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,28 @@
+ad_page_contract {
+ library/admin/view-composite.tcl
+
+ Display a composite question (used for previewing).
+
+ $Id: view-composite.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+} {
+ question_id
+ object_type_id
+} -properties {
+ form_vars:onevalue
+ url_vars:onevalue
+ pretty_name:onevalue
+ entry_explanation:onevalue
+ composite_field:onevalue
+}
+
+set composite_question [km_get_question -entry_explanation_p 1 $question_id $object_type_id]
+set pretty_name [snd $composite_question]
+set entry_explanation [lindex $composite_question 4]
+
+set title "Composite Question"
+set_context_bar_data [list "." "Knowledge Library"] [list "view-questions?object_type_id=$object_type_id" "All Questions"] "Composite Questions"
+
+
+set form_vars [export_form_vars object_type_id composite_id question_ids]
+set url_vars [export_url_vars question_id object_type_id]
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-options.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-options.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-options.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,39 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<if @options:rowcount@ gt 0>
+ <h4>The following options exist for this question:</h4>
+ <form method=post action="sort-keys">
+ <csrf-token>
+ @form_vars;noquote@
+ <table cellspacing=0 cellpadding=3 bgcolor="<%=[ad_parameter table_color library #eeeeee]%>" border=1>
+ <tr bgcolor="<%=[ad_parameter table_color library #eeeeee]%>">
+ <th align=left>Option</th><th align=center>Sort Key</th><th align=left>Action</th></tr>
+
+ <multiple name="options">
+ <if @options.rownum@ odd><tr bgcolor=<%=[ad_parameter table_color library #eeeeee]%>></if>
+ <else><tr bgcolor=<%=[ad_parameter table_bgcolor library #cfcfcf]%>></else>
+ <td>@options.answer_option@ </td>
+ <td align=center>@options.input_tag;noquote@</td>
+ <td>@options.edit_link;noquote@<font size=-1>Edit</font></a> |
+ @options.delete_link;noquote@<font size=-1>Delete</font></a></td>
+ </tr>
+
+ </multiple>
+
+ <tr><td colspan=3 align=center><input type=submit value=Sort></td></tr>
+ </table>
+ </form>
+</if>
+<else>
+ <h4>There are currently no multiple choice options for this question</h4>
+</else>
+<br>
+
+<if @add_option_link_p@ eq t>
+@add_option_link;noquote@Add an Option</a>
+</if>
+<else>
+Please note that this question is @question_state@. Therefore, you cannot add new options."
+</else>
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-options.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-options.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-options.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,62 @@
+# $Id: view-options.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+ad_page_contract {
+
+ @author Dirk
+ @cvs-id $Id: view-options.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+} {
+ question_id:integer
+ object_type_id:integer
+ {invisible_p 0}
+} -properties {
+ options:multirow
+ add_option_link_p:onevalue
+ question_state:onevalue
+ add_option_link:onevalue
+}
+
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+set question_info [km_get_question $question_id $object_type_id]
+set pretty_question [snd $question_info]
+set question_state [lindex $question_info 3]
+
+set return_url "view-options?[export_url_vars question_id object_type_id]"
+set table_name "sn_answer_options"
+set key_column "option_id"
+set form_vars [export_form_vars table_name key_column return_url invisible_p]
+
+# dig out the existing multiple choice options for this question
+set option_list [km_get_answer_options $question_id]
+
+template::multirow create options answer_option input_tag edit_link delete_link
+
+if ![null_p $option_list] {
+ foreach option $option_list {
+ set option_id [fst $option]
+ set answer_option [snd $option]
+ set sort_key [thd $option]
+
+ set input_tag "<input type=text size=4 name=$option_id value=\"$sort_key\">"
+ set edit_link "<a href=\"edit-option?[export_url_vars option_id question_id object_type_id]\">"
+ set delete_link "<a href=\"delete-option?[export_url_vars option_id question_id object_type_id]\">"
+ template::multirow append options $answer_option $input_tag $edit_link $delete_link
+ }
+}
+
+
+if { $question_state != "read-only" && $question_state != "invisible" } {
+ set add_option_link_p t
+ set question_state ""
+ set add_option_link "<a href=\"add-option?[export_url_vars object_type_id question_id]\">"
+} else {
+ set add_option_link_p f
+ set question_state "[km_pretty_question_state $question_state]"
+ set add_option_link ""
+}
+set pretty_question [db_string view_options_10 "select pretty_name
+ from sn_questions
+ where question_id = :question_id"]
+set title "Multiple Choice Options for $pretty_question"
+set_context_bar_data [list "view-questions?object_type_id=$object_type_id&invisible_p=$invisible_p" "$pretty_type Questions"] $title
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-questions.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-questions.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-questions.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,72 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+<property name="graphic">@graphic@</property>
+
+View: @choice_bar;noquote@ questions
+
+<p>
+<form method=post action="edit-all-questions">
+<csrf-token>
+@form_vars;noquote@
+<table bgcolor="#eeeeee>" cellpadding=3 cellspacing=0 border=1 width="100%">
+<tr bgcolor="#cccfff>">
+ <th>Question</th>
+ <th>Abstract Data Type</th>
+ <th>Presentation Type</th>
+ <th>Sort Key</th>
+ <th>Mandatory</th>
+ <th>State</th>
+ <th>Action</th>
+</tr>
+
+ <multiple name="questions">
+ <if @questions.rownum@ odd><tr bgcolor=#eeeeee valign=middle></if>
+ <else><tr bgcolor=#cccfff valign=middle></else>
+
+ <td>@questions.pretty_name;noquote@</td>
+ <td>@questions.abstract_data_type@</td>
+ <td>@questions.presentation_type@</td>
+
+ <td align=center>
+ <if @questions.question_state@ ne "invisible">
+ <input type=text size=4 name=@questions.question_id@ value="@questions.sort_key@">
+ </if>
+ <else>
+
+ </else>
+ </td>
+
+ <td align=center>
+ @questions.mandatory_check;noquote@
+ </td>
+
+ <td>
+ <if @branch_p@ eq 1>
+ Branch
+ </if>
+ <else>
+ @questions.pretty_question_state;noquote@
+ </else>
+ </td>
+
+ <td>@questions.edit_question_link;noquote@@questions.action;noquote@</td></tr>
+
+ </multiple>
+
+</table>
+
+
+<p><font size=-2><sup>1</sup>short description <sup>2</sup>long description <sup>3</sup>public until <sup>4</sup>link list <sup>5</sup>start date <sup>6</sup>end date</font>
+<br>
+
+<if @input_count@ gt 0>
+ <center><input type=submit value="Save"></center>
+</if>
+
+</form>
+
+<p>
+<a href="edit-question?@url_vars@">Add a Question</a> |
+<a href="view-sample-form?@url_vars@">View Input Form</a> |
+<a href="branch-tree?@url_vars@">View Branch Tree</a> |
+<a href="set-composed-short-name?@url_vars@">Create Composed Short Name</a>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-questions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-questions.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-questions.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,158 @@
+ad_page_contract {
+ /packages/library/www/admin/index.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ $Id: view-questions.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+} {
+ object_type_id
+ {invisible_p 0}
+} -properties {
+ object_type_id:onevalue
+ context_bar:onevalue
+ branch_p:onevalue
+ invisible_p:onevalue
+ questions:multirow
+ exported_url_vars:onevalue
+ exported_form_vars:onevalue
+ choice_bar:onevalue
+ form_vars:onevalue
+ url_vars:onevalue
+ input_count:onevalue
+ graphic:onevalue
+}
+
+# Object type info for page display
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+if { $invisible_p } {
+ # Allow all question states.
+ set question_states {}
+} else {
+ set question_states {active deprecated read-only}
+}
+
+set question_items [km_get_questions -question_states $question_states -root_node_p 0 -all_properties_p 1 -object_type_id $object_type_id]
+set key [fst $question_items]
+set question_items [tail $question_items]
+
+set short_description [km_static object_type_short_description $object_type_id]
+set long_description [km_static object_type_long_description $object_type_id]
+set public_until [km_static object_type_public_until $object_type_id]
+set start_date [km_static object_type_start_date $object_type_id]
+set end_date [km_static object_type_end_date $object_type_id]
+set linked_question_id [km_static object_type_linked_question_id $object_type_id]
+
+template::multirow create questions question_id pretty_name abstract_data_type presentation_type question_state mandatory_check pretty_question_state action sort_key edit_question_link
+
+set input_count 0
+
+foreach question $question_items {
+ set question_id [lindex $question [lsearch $key "question_id"]]
+ set pretty_name [lindex $question [lsearch $key "pretty_name"]]
+ set abstract_data_type [lindex $question [lsearch $key "abstract_data_type"]]
+ set presentation_type [lindex $question [lsearch $key "presentation_type"]]
+ set sort_key [lindex $question [lsearch $key "sort_key"]]
+ set mandatory_check [ad_decode [lindex $question [lsearch $key "mandatory_p"]] "t" "checked" ""]
+ set question_state [lindex $question [lsearch $key "question_state"]]
+ set pretty_question_state [km_pretty_question_state $question_state]
+ set branch_p [ad_decode [lindex $question [lsearch $key "branch_p"]] "t" 1 0]
+
+ if { $question_id == $short_description } {
+ append pretty_name " <sup><font size=-2>1</font></sup>"
+ } else {
+ if { [lsearch $short_description $question_id]>=0} { append pretty_name " <sup><font size=-2>1</font></sup>" }
+ }
+ if { $question_id == $long_description } { append pretty_name " <sup><font size=-2>2</font></sup>" }
+ if { $question_id == $public_until } { append pretty_name " <sup><font size=-2>3</font></sup>" }
+ if { $question_id == $linked_question_id } { append pretty_name " <sup><font size=-2>4</font></sup>" }
+ if { $question_id == $start_date } { append pretty_name " <sup><font size=-2>5</font></sup>" }
+ if { $question_id == $end_date } { append pretty_name " <sup><font size=-2>6</font></sup>" }
+
+ # Find out if there already is a branch leading from this question
+ if { [km_composite_child_p $question_id $object_type_id] } {
+ set branch_link ""
+ } elseif { [km_root_branch_p $question_id] } {
+ set branch_link " | <a href=\"view-branches?[export_url_vars question_id object_type_id]\"><font size=-1>Branches</font></a>"
+ } elseif { $question_state == "active" } {
+ set branch_link " | <a href=\"edit-branch?[export_url_vars question_id object_type_id]\"><font size=-1>Branches</font></a>"
+ } else {
+ set branch_link ""
+ }
+
+ # Certain abstract data types lead to certain actions
+ switch $abstract_data_type {
+ "integer" {
+ set action " |
+<a href=\"choose-presentation-type?[export_url_vars question_id object_type_id]\"><font
+size=-1>Presentation Type</font></a>$branch_link"
+ }
+ "text" {
+ set action " |
+<a href=\"choose-presentation-type?[export_url_vars question_id object_type_id]\"><font
+size=-1>Presentation Type</font></a>"
+ }
+ "category" - "other_category" {
+ set cat_target "href=\"choose-category?[export_url_vars question_id object_type_id]\""
+ set action " |
+<a href=\"choose-presentation-type?[export_url_vars question_id object_type_id]\"><font
+size=-1>Presentation Type</font></a>$branch_link |
+<a $cat_target><font size=-1>Categories</font></a>"
+ }
+ "option" {
+ set action " |
+<a href=\"choose-presentation-type?[export_url_vars question_id object_type_id]\"><font
+size=-1>Presentation Type</font></a>$branch_link |
+<a href=\"view-options?[export_url_vars question_id object_type_id]\"><font
+size=-1>Options</font></a>"
+ }
+ "composite" {
+ set action " |
+<a href=\"view-composite?[export_url_vars question_id object_type_id]\"><font
+size=-1>Questions</font></a>"
+ }
+ "date" {
+ set action " |
+<a href=\"choose-presentation-type?[export_url_vars question_id object_type_id]\"><font
+size=-1>Presentation Type</font></a>"
+ }
+ "nephew_object" {
+ set action " |
+<a href=\"choose-presentation-type?[export_url_vars question_id object_type_id]\"><font
+size=-1>Presentation Type</font></a>"
+ }
+ "default" {
+ set action ""
+ }
+ }
+
+ if [empty_string_p $presentation_type] { set presentation_type "Default" }
+
+ if { $question_state != "invisible" } {
+ set question_state_tag "<input type=text size=4 name=$question_id value=\"$sort_key\">"
+ incr input_count
+ } else {
+ set question_state_tag " "
+ }
+
+ if { $branch_p } { set pretty_question_state "Branch" }
+
+ set mandatory_check_tag "<input type=checkbox name=mandatory_p value=$question_id $mandatory_check>"
+ set edit_question_link "<a href=\"edit-question?[export_url_vars object_type_id question_id]\"><font size=-1>Properties</font></a>"
+ template::multirow append questions $question_id $pretty_name [km_pretty_adt $abstract_data_type] [km_pretty_tag $presentation_type] $question_state_tag $mandatory_check_tag $pretty_question_state $action $sort_key $edit_question_link
+}
+
+set branch_p 0
+
+set title "$pretty_type Questions"
+
+set choice_bar [ad_choice_bar {"Active, To be phased out, Read-Only" "All"} [list "view-questions?[export_url_vars object_type_id question_id]&invisible_p=0" "view-questions?[export_url_vars object_type_id question_id]&invisible_p=1"] {0 1} $invisible_p]
+
+set form_vars [export_form_vars object_type_id]
+set url_vars [export_url_vars object_type_id]
+
+set_context_bar_data $title
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-sample-form.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-sample-form.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-sample-form.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,12 @@
+<master src="../master">
+<property name="title">@title;noquote@</property>
+
+<h4>This sample form shows all input questions for @pretty_type@,
+including all branch questions. The first input form shown to the user
+will not contain all of these fields.</h4>
+
+<form method=post action="view-sample-form-2">
+<csrf-token>
+<include src="../km-form" object_type_id="@object_type_id@" question_ids="@question_list@">
+</form>
+
Index: openacs-4/contrib/obsolete-packages/library/www/admin/view-sample-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/view-sample-form.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/view-sample-form.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,42 @@
+ad_page_contract {
+ /packages/library/www/admin/view-sample-form.tcl
+
+ @author Carsten Clasohm (carsten@arsdigita.com)
+ @author Dirk Gomez (dirk@arsdigita.com)
+
+ @cvs-id $Id: view-sample-form.tcl,v 1.1 2003/07/02 12:19:45 peterm Exp $
+} {
+ object_type_id:integer
+} -properties {
+ context_bar:onevalue
+ title:onevalue
+ pretty_type:onevalue
+ form_type:onevalue
+ questions:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+if {![km_check_object_type_id $object_type_id]} {
+ return
+}
+
+# Object type info for page display
+set pretty_type [km_static object_type_pretty_name $object_type_id]
+set graphic [km_static object_type_graphic $object_type_id]
+
+template::multirow create questions pretty_name entry_explanation field
+
+set question_list [db_list_of_lists sql_view_sample_form_10 "select q.question_id
+ from sn_questions q, sn_question_object_type_map m
+ where q.question_id=m.question_id and
+ m.object_type_id=:object_type_id and
+ (m.parent_question_id = [km_static km_dummy_object_id] or m.branch_p='t') and
+ m.question_state = 'active'
+ order by m.sort_key"]
+
+set title "Sample input form for $pretty_type"
+
+set_context_bar_data [list "view-questions?[export_url_vars object_type_id]" "$pretty_type Questions"] "Sample Form"
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/xchange-categories.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/xchange-categories.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/xchange-categories.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,10 @@
+<master>
+<property name="title">@title;noquote@</property>
+
+<ul>
+<li><a href="categories/one-object?object_id=@role_magic_id@">Role / Function Category Tree</a></li>
+<li><a href="categories/one-object?object_id=@language_magic_id@">Language Category Tree</a></li>
+<li><a href="categories/one-object?object_id=@proficiency_magic_id@">Language Proficiency Category Tree</a></li>
+</ul>
+
+</form>
Index: openacs-4/contrib/obsolete-packages/library/www/admin/xchange-categories.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/xchange-categories.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/xchange-categories.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,28 @@
+ad_page_contract {
+} {
+} -properties {
+ title:onevalue
+ role_magic_id:onevalue
+ language_magic_id:onevalue
+ proficiency_magic_id:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+set magic_ids_exist_p [db_0or1row get_magic_ids_for_category_trees {
+ select role_magic_id, language_magic_id, proficiency_magic_id
+ from psn_category_trees
+ where package_id = :package_id
+}]
+
+if {!$magic_ids_exist_p} {
+ ad_return_complaint 1 \
+ "Error in library setup. No magic ids for category trees for the application form found."
+ return
+}
+
+set title "Manage categories for Xchange Application Form"
+set_context_bar_data "Manage Application Form Categories"
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/categories/index-template.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/categories/index-template.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/categories/index-template.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1 @@
+<include src="/packages/categories/www/@path_info@">
Index: openacs-4/contrib/obsolete-packages/library/www/admin/categories/index-template.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/categories/index-template.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/categories/index-template.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,10 @@
+set path_info [ad_conn path_info]
+
+if {[empty_string_p $path_info]} {
+ set path_info index
+}
+
+array set node [site_node "/categories"]
+ad_conn -set template_key $node(template_key)
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/admin/categories/index.vuh
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/admin/categories/index.vuh,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/admin/categories/index.vuh 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1 @@
+ns_return 200 text/html [ad_return_template -string index-template]
Index: openacs-4/contrib/obsolete-packages/library/www/doc/access-toolbar.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/access-toolbar.html,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/access-toolbar.html 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,91 @@
+<html>
+<head>
+<title>Workflow of the Access Toolbar</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Workflow of the Access Toolbar</h2>
+
+We need the following parameters:
+<ul>
+<li><b>write_p</b> : Has the user the permission to edit the object?</li>
+<li><b>admin_p</b> : Has the user the admin permission?</li>
+<li><b>publish_p</b> : Has the user the publish permission?</li>
+<li><b>delete_p</b> : Has the user the delete permission?</li>
+<li><b>public_p</b> : Is the object public?</li>
+<li><b>archived_p</b> : Is the object archived?</li>
+<li><b>in_review_p</b> : Is the object in review?</li>
+<li><b>review_state</b> : What is the review state? (empty, library_review or library_clarify)</li>
+<li><b>archive_p</b> : Has the archive been turned on for that object_type?</li>
+<li><b>approval_p</b> : Has the approval process been turned on for this library instance?</li>
+</ul>
+<br>
+
+<h3>Object Status</h3>
+
+<b>if (@admin_p@ eq 1) or ( (@approval_p@ eq 1) and (@publish_p@ eq 1) ):</b>
+<p>if (@public_p@ eq 1)
+<br> [Public] <a href="object-unpublish?object_id=1&category_id=1&return_url=something">Make private</a>
+<p>if (@public_p@ eq 0)
+<br> if (@approval_p@ eq 1) and (@in_review_p@ eq 1)
+<br> if (@review_state@ eq library_review)
+<br> <font color=red>[Private]</font> <font color=green>[In review]</font> <a href="object-publish?object_id=1&category_id=1&return_url=something">Make public</a>
+<br> if (@review_state@ eq library_clarify)
+<br> <font color=red>[Private]</font> <font color=green>[Needs clarification]</font> <a href="object-publish?object_id=1&category_id=1&return_url=something">Make public</a>
+<br> else
+<br> <font color=red>[Private]</font> <a href="object-publish?object_id=1&category_id=1&return_url=something">Make public</a>
+
+<p><b>if (@write_p@ eq 1) and (@archived_p@ eq 0):</b>
+<p>if (@public_p@ eq 0)
+<br> if (@in_review_p@ eq 0)
+<br> if (@approval_p@ eq 1)
+<br> <font color=red>[Private]</font> <a href="object-propose-public?object_id=1&category_id=1&return_url=something">Propose to publish</a>
+<br> else
+<br> <font color=red>[Private]</font> <a href="object-publish?object_id=1&category_id=1&return_url=something">Make public</a>
+<br> else
+<br> if (@review_state@ eq library_review)
+<br> <font color=red>[Private]</font> <a href="../approval-tasks/task?task_id=1">In review</a>
+<br> if (@review_state@ eq library_clarify)
+<br> <font color=red>[Private]</font> Review: <a href="../approval-tasks/task?task_id=1">Needs clarification</a>
+<br>if (@public_p@ eq 1)
+<br> if (@approval_p@ eq 0)
+<br> [Public] <a href="object-unpublish?object_id=1&category_id=1&return_url=something">Make private</a>
+<br> else
+<br> [Public]
+
+<p><b>all other users with read permission:</b>
+<p>if (@in_review_p@ eq 1)
+<br> <font color=red>[Private]</font> <font color=green>[In review]</font>
+<br>if (@public_p eq 1)
+<br> <font color=red>[Private]</font>
+
+<h3>Archive</h3>
+<b>if (@write_p@ eq 1) or (@admin_p@ eq 1) or ( (@approval_p@ eq 1) and (@publish_p@ eq 1) ):</b>
+<p>if (@archived_p@ eq 1)
+<br> <font color=red>[Archived]</font> <a href="object-unarchive?object_id=1&category_id=1&return_url=something">Remove from archive</a>
+<br>if (@archive_p@ eq 1) and (@archived_p@ eq 0) and ( (@admin_p@ eq 1) or (@publish_p@ eq 1) or (@approval_p@ eq 0) or ( (@public_p@ eq 0) and (@in_review_p@ eq 0) ) )
+<br> <a href="object-archive?object_id=1&category_id=1&return_url=something">Put in archive</a>
+
+<h3>Access control</h3>
+<b>if (@admin_p@ eq 1) or ( (@write_p@ eq 1) and (@archived_p@ eq 0) ):</b>
+<p><a href="object-access?object_id=1&category_id=1">Access Control</a>
+
+<h3>Delete Object</h3>
+<b>if (@delete_p@ eq 1):</b>
+<p>if (@category_id@ is nil) or (@category_id@ eq none)
+<br> <a href="object-delete?object_id=1&category_id=&return_delete=browse-one-type?object_type_id=1">Delete Object</a>
+<br>else
+<br> <a href="object-delete?object_id=1&category_id=1&return_delete=browse-one-category?object_type_id=1&category_id=1">Delete Object</a>
+
+<h3>Approval Tasks</h3>
+<b>if (@approval_p@ eq 1) and (@in_review_p@ eq 1) and ( (@publish_p@ eq 1) or (@admin_p@ eq 1) ):</b>
+<p><a href="../approval-tasks/task?task_id=1">Manage Approval</a>
+
+<p>
+</body>
+</html>
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/doc/cvs-information.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/cvs-information.html,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/cvs-information.html 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+ <head>
+ <title>CVS information Library 8</title>
+ </head>
+
+ <body>
+ <h1>CVS Tags Library 8</h1>
+
+<ul>
+
+<li>cvs tag km-snapshot-20010628: That was the vrsion with which I started
+hacking.
+
+</ul>
+
+ <hr>
+
+ <address><a href="mailto:dirk@arsdigita.com">Dirk Gomez</a></address>
+ </body>
+</html>
Index: openacs-4/contrib/obsolete-packages/library/www/doc/datamodel-changes.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/datamodel-changes.html,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/datamodel-changes.html 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,102 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+ <head>
+ <title>Datamodel changes in the Library 8</title>
+ </head>
+
+ <body>
+ <h1>Datamodel changes in the Library 8</h1>
+
+<ul>
+
+<li>sn_questions: object_type_id renamed to target_object_type_id, because
+this name makes the semantics much clearer
+
+<li>sn_content: removed long_content, made content a clob<br> Newsgroup
+posting to make sure that this is definitely not a performance risk:<br>
+
+<blockquote>
+<pre>
+From: tkyte@us.oracle.com
+Subject: Re: clobs and possible performance issues
+To: Dirk Gomez <usenet@dirkgomez.de>
+Date: Sat, 14 Jul 2001 11:58:54 -0700 (PDT)
+
+In article <m3r8vjz84g.fsf@colorado.arsdigita.de>, Dirk says...
+>
+>Hi,
+>
+>This is the current table layout:
+>
+>create table sn_content (
+> object_id
+> integer
+> constraint sn_content_object_id_fk
+> references sn_objects(object_id),
+> question_id
+> integer
+> constraint sn_content_question_id_fk
+> references sn_questions(question_id),
+> content
+> varchar(4000),
+> long_content
+> clob,
+> html_p
+> char(1)
+> constraint sn_content_html_p_ck
+> check (html_p in ('t', 'f')),
+> constraint sn_content_pk
+> primary key (object_id, question_id)
+>);
+>
+>Either content or long_content is being filled with data depending on the size
+>of content. If the content is > 4000 bytes, it is stored in the lief
+>long_content and content is set to null and vice versa.
+>
+>That has mainly historical reasons - and I would like to get rid of that.
+>
+>So retrieving content is currently done in this way (in meta pl/sql syntax):
+>
+>select content into the_content where object_id=:the_object_id and
+>question_id=:the_question_id;
+>
+>if content is null then
+>select long_content into the_contet where object_id=:the_object_id and
+>question_id=:the_question_id;
+>end if;
+>
+>Are there any performance implications when removing the content field? The
+>overall amount of queries on sn_content would get smaller, but all queries
+>would end up retrieving data from a clob or stuffing data into a clob. How do
+>queries on tables with clobs perform, mainly inserts and selects? All lookups
+>on sn_content are indexed, there are no range scans.
+>
+>cheers Dirk
+
+I'd get rid of the content column (varchar2(4000)) and just go for the clob.
+Clob data, by default, will be stored inline upto your existing 4000 bytes (you
+can control inline or out of line storage) so if the text is small, the clob
+will be stored there, if the text is large, it'll be moved out of line into the
+lob segment and stored there.
+
+You are in effect mimicking what we already do under the covers with clobs.
+
+--
+Thomas Kyte (tkyte@us.oracle.com) http://asktom.oracle.com/
+Expert one on one Oracle, programming techniques and solutions for Oracle.
+http://www.amazon.com/exec/obidos/ASIN/1861004826/
+Opinions are mine and do not necessarily reflect those of Oracle Corp
+</pre>
+</blockquote>
+
+<li>
+Removed the PL/SQL function sn_object_type_view_p and replaced it with a dummy
+called km_dirks_temporary_permission_p that always return true.
+
+</ul>
+
+ <hr>
+
+ <address><a href="mailto:dirk@arsdigita.com">Dirk Gomez</a></address>
+ </body>
+</html>
Index: openacs-4/contrib/obsolete-packages/library/www/doc/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/index.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,25 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+ <head>
+ <title>Library 8 Documentation Central</title>
+ </head>
+
+ <body>
+ <h1>Library 8 Documentation Central</h1>
+
+ <h2>General stuff</h2>
+ <ul>
+ <li><a href="km-library">Big Picture</a>
+ <li><a href="km-library-data-model">Data Model</a>
+ <li><a href="pages/index.html">Detailed documentation of the pages</a>
+ <li><a href="datamodel-changes.html">Datamodel changes</a>
+ <li><a href="cvs-information.html">CVS Information</a>
+ <li><a href="workflow.html">Workflow/Knowledge Object Approval</a>
+ <li><a href="psn-general">People <ad-parameter package=acs-kernel name=SystemName>: Features and Implementation</a>
+ <li><a href="access-toolbar.html">Detailed documentation on the access toolbar</a></li>
+ </ul>
+
+ <hr>
+ <address><a href="mailto:dirk@arsdigita.com">Dirk Gomez</a></address>
+ </body>
+</html>
Index: openacs-4/contrib/obsolete-packages/library/www/doc/km-library-data-model.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/km-library-data-model.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/km-library-data-model.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,766 @@
+<html>
+<head>
+<title>KM-Library</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>KM Library Data Model</h2>
+
+part of the <a href="index.html">ArsDigita Community System</a>
+<br>by <a href="mailto:carsten@arsdigita.com">Carsten Clasohm</a> and
+<a href="mailto:sarnold@arsdigita.com">Sarah Arnold</a><br>
+November 2000
+<hr>
+<ol type=I>
+<li><b>Objects</b>
+
+<p>
+The table sn_objects holds data the knowledge objects in the system.
+
+
+The one_line_description for knowledge objects is taken with a trigger on
+sn_content- this column always holds the answer to the question that has been
+defined as the "short_description" for this object type. The column overview
+holds the long_description for the object type. The column public_until holds
+the value from sn_content that answers the question that has been defined as
+the public_until date. The public_until date holds the date on which this
+object is no longer visible in the system except for the owner and its
+group. This is a bit confusing, since you would think that that is what the
+expiration_date column should hold. In fact, the expiration_date shown when
+this object has been deleted. So,the object is deleted and visible to no one
+when the expiration_date is less than the curren date. The user_checkoff_date
+(should be called "publication_date") is the date that the user has published
+the object, i.e. made it visible to the public. public_p holds the information
+whether the object is publicly visible or not, archived_p whether the object
+is archived or not (not yet implemented). access_total and access_month are in
+this table for performance reasons: these counts are shown on almost every
+page, so we decided to store them in this table as well.
+
+<pre>
+create table sn_objects (
+ object_id
+ integer
+ constraint sn_objects_id_pk
+ primary key,
+ object_type_id
+ integer
+ constraint sn_objects_object_type_id_fk
+ references sn_object_types (object_type_id),
+ -- objects should be subsite-aware as well
+ context_id
+ constraint sn_objects_context_id_fk
+ references apm_packages (package_id)
+ on delete cascade,
+ one_line_description
+ varchar(4000),
+ overview
+ varchar(4000),
+ overview_html_p
+ char(1)
+ constraint sn_objects_overview_html_p_ck
+ check (overview_html_p in ('t','f')),
+ creation_date
+ date,
+ original_author_id
+ integer
+ constraint sn_objects_orig_author_id_fk
+ references users (user_id),
+ last_modified
+ date,
+ last_modifying_user_id
+ integer
+ constraint sn_objects_last_mod_user_id_fk
+ references users (user_id),
+ user_checkoff_date date,
+ expiration_date
+ date default '9999-12-31'
+ constraint sn_objects_expiration_date_nn not null,
+ public_until date,
+ public_p
+ char(1) default 'f'
+ constraint sn_objects_public_p_ck
+ check (public_p in ('t','f')),
+ archived_p
+ char(1) default 'f'
+ constraint sn_objects_archived_p_ck
+ check (archived_p in ('t','f')),
+ access_total integer default 0,
+ access_month integer default 0
+);
+</pre>
+
+<p>
+And we define <em>sn_object</em> as the acs_object_type:
+<pre>
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'sn_object',
+ pretty_name => 'Library Object',
+ pretty_plural => 'Library Objects',
+ table_name => 'SN_OBJECTS',
+ id_column => 'OBJECT_ID'
+ ); end;
+/
+show errors
+</pre>
+
+<p>Some indexes for performance:
+
+<pre>
+create index sn_objects_expiration_date_ix on sn_objects (expiration_date);
+
+create index sn_objects_public_until_ix on sn_objects (public_until);
+
+create index sn_objects_checkoff_date_ix on sn_objects (user_checkoff_date);
+
+create index sn_objects_last_modified_ix on sn_objects (last_modified);
+
+create index sn_objects_new_stuff_ix on sn_objects (last_modified,
+user_checkoff_date, expiration_date, object_type_id);
+
+create index sn_objects_type_id_ix on sn_objects (object_type_id);
+
+create index sn_objects_browse_ix on sn_objects (object_type_id, context_id, expiration_date, last_modified, public_p);
+
+create index sn_objects_one_line_desc_ix on sn_objects (substr(upper(one_line_description),1,1));
+</pre>
+
+
+<li><b>Questions</b>
+
+<p>The questions table holds all of the data about the questions that
+can be asked about knowledge objects.
+
+<p>For abstract data type <cite>category</cite>, <tt>category_id</tt>
+points to the root node of the category tree associated with this
+question. XXXTomislav
+
+For questions having the abstract data type object_object_link and
+child_object, <tt>target_object_type_id</tt> defines the object type the user
+may link to. Otherwise it has no meaning and does <em>not</em> map this
+question to an object type (that is in sn_question_object_type_map). The
+entry_explanation is the text that you see under the pretty_name in the
+display of a question. The column help_text is unused at this time, but can be
+used to link to a pop-up help text for any given
+question. references_question_id references the question to which an
+object-object link points to.
+<pre>
+create table sn_questions (
+ question_id
+ integer
+ constraint sn_questions_question_id_fk
+ references acs_objects (object_id)
+ constraint sn_questions_question_id_pk
+ primary key,
+ pretty_name
+ varchar(4000),
+ abstract_data_type
+ varchar(50)
+ constraint sn_questions_abstract_data_nn not null,
+ presentation_type
+ varchar(100)
+ constraint sn_questions_presentation_t_nn not null,
+ -- for all questions which display lists
+ order_by
+ varchar(100),
+ -- default for input forms
+ default_value
+ varchar(4000),
+ entry_explanation
+ varchar(4000),
+ tag_width
+ integer,
+ tag_height
+ integer,
+ help_text
+ varchar(4000),
+ -- for object_link: which type to link to
+ target_object_type_id
+ integer,
+ -- that is merged in from a change I (and Carsten ;) already did in
+ -- 7.1
+ references_question_id
+ integer
+ constraint sn_questions_referenc_qu_id_fk
+ references sn_questions(question_id),
+ -- for question of data type category
+ tree_id
+ integer
+ constraint sn_questions_tree_ref references generic_trees,
+ node_id
+ integer
+ constraint sn_questions_node_ref references sw_category_dim,
+ -- This is only used during data migration from <ad-parameter package=acs-kernel name=SystemName> 7.
+ category_id
+ integer,
+ -- this is only for abstract_data_type date to specify what years
+ -- should be in the select box in respect to the default date.
+ year_from
+ integer default -5,
+ year_to
+ integer default 5
+);
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'sn_question',
+ pretty_name => 'Question',
+ pretty_plural => 'Questions',
+ table_name => 'SN_QUESTIONS',
+ id_column => 'QUESTION_ID'
+ );
+end;
+/
+show errors
+</pre>
+
+
+the object name
+
+<li><b>Object Types</b>
+
+<p><tt>The table sn_object_types</tt> defines the possible types of knowledge
+objects. The column <tt>long_description</tt> defines the
+overview. <tt>public_until</tt> can point to a question of abstract data type
+<cite>date</cite>, which will determine how long the object is publically
+visible (if <tt>public_p</tt> is set). If browse_p is true, than this object
+type is browsable throughout the system. Sometimes this is not desirable, as
+in the case of child_objects. In that case, browse_p is set to false and the
+object_type will only show up in a parent-child relationship to other object
+types. The default_age_filter sets the default filter in the browse pages for
+displaying this object type. Although the user can browse objects with any
+number of different age filters, it is nice for the admins to be able to
+decide what age is most appropriate as the default.
+
+<pre>
+create table sn_object_types (
+ object_type_id
+ integer
+ constraint sn_object_types_pk
+ primary key,
+ context_id
+ constraint sn_object_types_context_id_fk
+ references apm_packages (package_id)
+ on delete cascade,
+ short_name
+ varchar(100),
+ pretty_name
+ varchar(100)
+ constraint sn_object_types_pretty_name_nn not null,
+ pretty_plural
+ varchar(100),
+ -- filename for the graphic icon. This is always
+ -- $object_type_id.extension
+ graphic
+ varchar(200),
+ graphic_p
+ char(1)
+ default 'f'
+ constraint sn_object_types_graphic_p_nn not null,
+ constraint sn_object_types_graphic_p_ck
+ check (graphic_p in ('t', 'f')),
+ deleted_p
+ char(1)
+ default 'f'
+ constraint sn_object_types_deleted_p_nn not null,
+ constraint sn_object_types_deleted_p_ck
+ check (deleted_p in ('t', 'f')),
+ browse_p
+ char(1)
+ default 't'
+ constraint sn_object_types_browse_p_nn not null,
+ constraint sn_object_types_browse_p_ck
+ check (browse_p in ('t', 'f')),
+ -- If the object type is not public, consult sn_object_type_access
+ -- to determine if a user may access this type.
+ public_p
+ char(1) default 't'
+ constraint sn_object_types_public_p_nn not null,
+ constraint sn_object_types_public_p_ck
+ check (public_p in ('t','f')),
+ -- to be able to prevent standalone objects of this object type
+ -- (meaning objects which didnt created as child or nephew)
+ -- needed this for people <ad-parameter package=acs-kernel name=SystemName> - demand descriptions
+ create_p
+ char(1) default 't'
+ constraint sn_object_types_create_p_nn not null,
+ constraint sn_object_types_create_p_ck
+ check (create_p in ('t','f')),
+ sort_key
+ integer,
+ -- The admin can define which question is the name, overview or
+ -- public_until date for this object type:
+ short_description
+ integer
+ constraint sn_object_typ_short_desc_id_fk
+ references sn_questions (question_id),
+ long_description
+ integer
+ constraint sn_object_type_long_desc_id_fk
+ references sn_questions (question_id),
+ public_until
+ integer
+ constraint sn_object_t_public_until_id_fk
+ references sn_questions (question_id),
+ -- that is merged in from a change I (and Carsten ;) already did in
+ -- 7.1
+ linked_question_id
+ integer
+ constraint sn_object_t_linked_quest_id_fk
+ references sn_questions(question_id),
+ default_age_filter
+ integer default 365
+);
+
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'sn_object_type',
+ pretty_name => 'Object Type',
+ pretty_plural => 'Object Types',
+ table_name => 'SN_OBJECT_TYPES',
+ id_column => 'OBJECT_TYPE_ID'
+ );
+end;
+/
+show errors
+
+-- We can only add this foreign key after creating the object_type_table.
+alter table sn_questions
+ add constraint sn_questions_object_type_id_fk
+ foreign key (target_object_type_id)
+ references sn_object_types(object_type_id);
+
+alter table sn_types_map_short_name
+ add constraint sn_types_map_object_type_id
+ foreign key (object_type_id)
+ references sn_object_types(object_type_id);
+
+</pre>
+
+<p>
+The table sn_types_map_short_name defines the name of an object. This data has
+to be stored in another table, because it is a 1:m relationship: an object
+type can have composite short names.It has to be maps short
+
+<pre>
+create table sn_types_map_short_name (
+ object_type_id
+ integer,
+ short_description
+ integer
+ constraint sn_types_map_short_desc_id_fk
+ references sn_questions (question_id),
+ position
+ integer,
+ constraint sn_types_map_short_name_pk
+ primary key (object_type_id, short_description)
+);
+</pre>
+
+<p>This defines the set of questions associated with a given object
+type. Questions can be shared among object types and grouped together
+under one parent_question_id for composite questions. We don't share questions at this point
+for any object types, but it is possible. The column form_number is something of a relic-
+if it is set to 1 then the question appears on the first form. The sort key
+sets the order of the questions <em>outside of the branch hierarchies</em>.Note that the system will have problems
+publishing objects if an object type has any questions that are mandatory but not visible.
+
+<pre>
+create table sn_question_object_type_map (
+ question_id
+ integer
+ constraint sn_question_otm_question_id_fk
+ references sn_questions (question_id),
+ object_type_id
+ integer
+ constraint sn_question_otm_object_t_id_fk
+ references sn_object_types (object_type_id),
+ sort_key
+ integer,
+ form_number
+ integer,
+ mandatory_p
+ char(1)
+ constraint sn_question_otm_mandatory_p_ck
+ check (mandatory_p in ('t','f')),
+ question_state
+ varchar(100)
+ constraint sn_question_otm_question_st_ck
+ check(question_state in
+ ('active','deprecated','read-only','invisible')),
+ -- used for composite and branches
+ -- -50 is the magic object from acs_magic_objects where name='km_dummy_object'. Don't change it!
+ parent_question_id
+ integer
+ default -50
+ constraint sn_question_otm_parent_q_id_nn not null
+ constraint sn_question_otm_parent_q_id_fk
+ references sn_questions (question_id),
+ -- t if this question itself is a branch, NOT if this question LEADS to branches
+ branch_p
+ char(1)
+ constraint sn_question_otm_branch_p_ck
+ check (branch_p in ('t','f')),
+ -- applies to the question as the parent node of a branch
+ branch_operator
+ varchar(4000),
+ -- the answers apply to the child nodes
+ branch_answer
+ varchar(4000),
+ -- can reference categories or sn_answer_options
+ branch_answer_foreign_key
+ integer,
+ default_branch
+ integer
+ constraint sn_question_otm_default_bra_fk
+ references sn_questions (question_id),
+ constraint sn_question_object_type_map_pk
+ primary key (question_id, object_type_id)
+);
+</pre>
+
+<li><b>Question Hierarchies (Branches and Composite)</b><p>
+
+<ol>
+
+<li><b>Composite</b>
+
+<p>The above table, sn_question_object_type_map, has a column
+parent_question_id. If the abstract data type of this question_id is
+composite, then the children are not branches. They should not have
+branch_p='t' and the row for the question_id that is equal to the
+parent_question_id should not have a default branch. Composite questions can
+only go one level deep- one parent and <em>n</em> children. No questions in a
+composite relationship should have any branch column data whatsoever.</p>
+
+<li><b>Branches</b>
+
+<p>If a question leads to branches, then it will appear as the
+parent_question_id for other rows in sn_question_object_type_map. It should
+only have abstract data types of integer, option or category. It must have a
+question_id given as default branch. This question may itself be a branch, in
+which case branch_p='t', branch_operator and
+branch_answer/branch_answer_foreign_key will also be answered, but this is not
+necessarily so. This means that the field branch_p shows if a question <em>is
+itself a branch</em> and not if it leads to a branch. For the cases of options
+and categories, we use the ids from sn_answer_options or sn_categories as the
+answer in the column branch_answer_foreign_key (could be eliminated by also
+storing foreign key values in the branch_answer column). Integer answers and,
+perhaps in a future version, text answers are stored in branch_answer. We
+have not implemented branches for abstract data type text for this release,
+but it's doable.</p>
+
+</ol>
+
+<li><b> Linking</b>
+
+<p>
+Linking uses the site-wide linking service described somewhere else. Thise
+service supports only object-object linking though, so we had to add a table
+to the library datamodel to support linking on the question level:
+
+<pre>
+create table sn_question_link_map (
+ link_id
+ integer
+ constraint sn_question_link_ma_link_id_fk
+ references sn_links (link_id)
+ on delete cascade
+ constraint sn_question_link_map_pk
+ primary key,
+ question_id
+ integer
+ constraint sn_question_lin_question_id_fk
+ references sn_questions (question_id)
+ constraint sn_question_lin_question_id_nn
+ not null
+);
+
+create index sn_question_link_ma_q_id_ix on sn_question_link_map (question_id);
+</pre>
+
+<li><b> Object Content</b>
+
+<p>This table stores the content of the one-to-one questions having abstract
+data type text for any given object. It also contains the abstract data types
+file, date and integer. The questions_id shows which question the content
+answers. If a single question has more than one answer, then that data belongs
+in the multiple-choice answers tables (sn_answer_options and
+sn_object_option_map) having the abstract data type option, mapped as a
+category in site_wide_category_map, stored as a link in sn_links (see above)
+or should be constructed as composite question having the abstract data type
+composite.
+
+<p>Here is where one-to-one OBJECT DATA lives:
+
+<pre>
+create table sn_content (
+ object_id
+ integer
+ constraint sn_content_object_id_fk
+ references sn_objects(object_id),
+ question_id
+ integer
+ constraint sn_content_question_id_fk
+ references sn_questions(question_id),
+ content
+ clob,
+ html_p
+ char(1)
+ constraint sn_content_html_p_ck
+ check (html_p in ('t', 'f')),
+ constraint sn_content_pk
+ primary key (object_id, question_id)
+);
+</pre>
+
+
+<p>This table holds the answers to multiple choice questions. The poorly named
+"answer_option" is the simply the pretty_name multiple-choice answer, the
+option_ids are the values in the HTML selects and checkboxes.
+
+<pre>
+create table sn_answer_options (
+ option_id
+ integer
+ constraint sn_answer_options_option_id_pk
+ primary key,
+ question_id
+ integer
+ constraint sn_answer_options_questi_id_fk
+ references sn_questions(question_id),
+ answer_option
+ varchar(4000),
+ sort_key
+ integer
+);
+</pre>
+
+<p> This table links multiple-choice answers to objects
+<pre>
+create table sn_object_option_map (
+ object_id
+ integer
+ constraint sn_object_option_map_obj_id_fk
+ references sn_objects(object_id),
+ option_id
+ integer
+ constraint sn_object_option_map_opt_id_fk
+ references sn_answer_options(option_id)
+);
+</pre>
+
+
+<p>Whenever the content of an object is changed then we store it
+here. We don't store changes in the categorization, linking or
+multiple choice questions.
+<pre>
+create table sn_audit_table (
+ object_id
+ integer
+ constraint sn_audit_table_object_id_fk
+ references sn_objects(object_id),
+ question_id
+ integer
+ constraint sn_audit_table_question_id_fk
+ references sn_questions(question_id),
+ --this refers to the question being modified
+ last_modified
+ date
+ constraint sn_audit_table_last_modifie_nn not null,
+ last_modifying_user_id
+ integer
+ constraint sn_audit_table_last_mo_u_id_fk
+ references users (user_id),
+ content
+ varchar(4000)
+);
+</pre>
+
+<li><b>User Customisation</b>
+<li><b>Categories</b>
+
+
+XXX Tomislav
+
+<li><b>Access Control for Knowledge Object Types</b>
+
+<p>Depending on sn_object_types.public_p, a Knowledge Object Type is
+either visible to all users with access to the Library instance, or
+only to those who have admin permission.</p>
+
+
+<li><b>Access Control for Knowledge Objects</b>
+
+<p>Depending on sn_objects.public_p, a Knowledge Object is visible for
+all users with access to the Library instance, or only for those who
+have read permission. public_p only exists for performance
+reasons. For public objects, read is granted to The Public, so a
+permission check works, although it can be skipped. For private
+objects, read as well as write can be granted to individual users and
+private user groups using the system-wide permissioning system.</p>
+
+
+<li><b>Statistics</b>
+
+<p>We group object views by month, so the following table has a count
+and date column (allowing for even more flexible grouping).
+
+<pre>
+create table sn_access_counts (
+ object_id
+ integer
+ constraint sn_access_counts_object_id_fk
+ references sn_objects(object_id),
+ access_count
+ integer,
+ access_date
+ date,
+ constraint sn_access_counts_pk
+ primary key (object_id,access_date)
+);
+</pre>
+
+<li><b>Search</b><p>
+There is no more special search handling for library. For a documentation
+of the search features see the <a href="/doc/site-wide-search" >documentation
+ of site-wide-search</a>.
+<p>
+
+<li><b>People<ad-parameter package=acs-kernel name=SystemName> Tables</b>
+<p>In People<ad-parameter package=acs-kernel name=SystemName> information about understaffed projects (Project descriptions)
+are stored together with descriptions of open positions for these projects
+(Demand descriptions). Users can then apply for these open positions bu filling out
+an application form, saving the entered data, making changes later, attaching
+some files and finally sending the application as an email. In this table all
+text input and category selections for each application is stored together with
+the information about the creation date, the user, the project and demand.
+<pre>
+create table psn_res_applications (
+ application_id integer primary key,
+ object_id constraint psn_res_app_object_id_fk
+ references sn_objects on delete cascade,
+ resource_req_id constraint psn_res_app_res_req_id_fk
+ references sn_objects on delete cascade,
+ user_id constraint psn_res_app_user_id_fk
+ references users,
+ creation_date date default sysdate,
+ application_date date default null,
+ sent_p char(1) default 'f'
+ constraint psn_res_app_sent_p_ck
+ check (sent_p in ('t','f')),
+ recipient varchar2(4000),
+ subject varchar2(1000),
+ contact_data varchar2(4000),
+ nationality varchar2(4000),
+ manager_email varchar2(4000),
+ working_area varchar2(4000),
+ role_other varchar2(1000),
+ first_language varchar2(1000),
+ second_language_id integer,
+ third_language_id integer,
+ first_language_prof_id integer,
+ second_language_prof_id integer,
+ third_language_prof_id integer,
+ other_language varchar2(4000),
+ from_date date,
+ to_date date,
+ strengths varchar2(4000),
+ leadership varchar2(4000),
+ intercultural varchar2(4000),
+ comments varchar2(4000),
+ conditions varchar2(4000)
+);
+
+create index psn_res_app_object_idx on psn_res_applications (object_id);
+
+create index psn_res_app_res_idx on psn_res_applications (resource_req_id);
+
+create index psn_res_app_user_idx on psn_res_applications (user_id);
+</pre>
+
+<p>This table holds all Roles/Functions of the applicant - these are categories.
+<pre>
+create table psn_res_application_roles (
+ application_id integer
+ constraint psn_res_app_roles_app_fk
+ references psn_res_applications on delete cascade,
+ role_id integer,
+ primary key (application_id, role_id)
+);
+</pre>
+
+<p>In the application form are three different kinds of categories used:
+Roles/Functions of the applicant, languages spoken and the proficiency in the
+language. Therefore, three different category trees are needed. Since we don't
+use static categories, an admin has to map these three trees to the application.
+In order to do that and to distinguish between these three trees, three magic
+objects have to be created to map the category trees to. This table holds the
+object ids of these three magic objects for each library package instance.
+<pre>
+create table psn_category_trees (
+ package_id integer primary key,
+ role_magic_id constraint psn_cat_trees_role_fk
+ references acs_objects (object_id) on delete set null,
+ language_magic_id constraint psn_cat_trees_lang_fk
+ references acs_objects (object_id) on delete set null,
+ proficiency_magic_id constraint psn_cat_trees_prof_fk
+ references acs_objects (object_id) on delete set null
+);
+</pre>
+
+<p>This table holds all email-attachments to the application as blobs.
+<pre>
+create table psn_attachments (
+ attachment_id integer primary key,
+ application_id constraint psn_attach_appl_id_fk
+ references psn_res_applications on delete cascade,
+ title varchar2(1000),
+ mime_type varchar2(200) default 'text/plain',
+ filename varchar2(200),
+ attachment blob default empty_blob()
+);
+
+create index psn_attach_appl_id_idx on psn_attachments(application_id);
+
+create sequence psn_attachment_id_seq start with 1;
+</pre>
+
+<p>Creation of new object types for applications and magic tree objects.
+<pre>
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'psn_tree_object',
+ pretty_name => 'Demand Application Form',
+ pretty_plural => 'Demand Application Forms',
+ table_name => 'PSN_CATEGORY_TREES'
+ );
+end;
+/
+show errors
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'psn_application',
+ pretty_name => 'Demand Application',
+ pretty_plural => 'Demand Applications',
+ table_name => 'PSN_RES_APPLICATIONS',
+ id_column => 'APPLICATION_ID'
+ );
+end;
+/
+show errors
+</pre>
+
+</ol>
+<hr>
+<address><a href="mailto:sarnold@arsdigita.com">sarnold@arsdigita.com</a>,
+<a href="mailto:carsten@arsdigita.com">carsten@arsdigita.com</a></address>
+</body>
+</html>
Index: openacs-4/contrib/obsolete-packages/library/www/doc/km-library.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/km-library.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/km-library.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,361 @@
+<html>
+<head>
+<title>KM-Library</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>KM-Library</h2>
+
+<br>originally by <a href="mailto:carsten@arsdigita.com">Carsten Clasohm</a> and
+<a href="mailto:sarnold@arsdigita.com">Sarah Arnold</a><br>
+June 2000, revised November, 2000
+
+<br>ported to ACS4 mostly by <a href="mailto:dirk@arsdigita.com">Dirk Gomez</a>
+<hr>
+
+<p>
+We've rebuilt the <ad-parameter package=acs-kernel name=SystemName> library on top of a lot of procs that deal with
+meta and object data. The procs are organized into Tcl collections that we'll
+go through in this doc. The data model is described in <a
+href="/doc/km-library">KM Data Model</a>. Also see the <a
+href="lib-redesign/flowchart.html">flowchart</a> which shows all possible
+paths within the library.
+
+
+<p> We have tried to write short, well-named and highly cohesive procs that
+<em>never</em> use upvar or uplevel. We have tried to keep site navigation
+and excursion handling on the pages. It is very difficult to figure out what
+is going on with navigation if it's buried in a proc somewhere. The idea is
+that when you look at a page, you see what variables are coming in, you see
+the procs that deal with the data machinery and display, you see how the page
+handles the navigation from the page. See below about paths to follow the
+navigation mechanism.<p> The procs are strictly sorted into their own
+libraries. A proc found in km-display will
+<em>never</em> retrieve data from oracle. A proc in km-object-data does not
+display HTML. <br>km-categories.tcl holds procs that have to do with
+categories and some of these do display something. (these procs are part of
+<ad-parameter package=acs-kernel name=SystemName>'s categorization system which is part of the ACS categorization.)
+
+<p>
+km-defs.tcl has library core-procs having to do with metadata, building
+form fields, object access
+control, checking user input and excursions (aka paths).
+<ol type=I>
+<li><b>Abstract Data Types</b><p>
+<ol>
+<li><b>text</b> Text data stored together with a value of html_p in one row of sn_content.
+<li><b>option</b> Multiple choice data stored in sn_object_option_map, refers to sn_answer_options
+<li><b>category</b> Category data that maps the object to site-wide categories in site_wide_category_map
+<li><b>composite</b> A question composed of one or more children questions which are mapped in sn_question_object_type_map.
+<li><b>date</b> A date stored as text in sn_content but required to be a valid date.
+<li><b>integer</b> An integer stored as text in sn_content but required to be a valid integer.
+<li><b>file</b> An uploaded document that can be found in the document_uploads directory, the name of the file is stored in sn_content.
+<li><b>object_link</b> Maps objects to other objects in sn_links, refers to a comment in sn_link_comments.
+<li><b>user_link</b> Maps objects to users in sn_links, doesn't have a comment, but could.
+<li><b>child_object</b> The answer to this question is the completed content of another object type.
+The permissions and the public/private status of this child object are exactly the same as
+for the parent object. If the parent object is public and all mandatory questions of a child object
+get answered, it will automatically get the public status. If the parent object gets deleted, so are all its child objects.
+<li><b>nephew_object</b> The answer to this question is again the completed content of another object type.
+The permissions of uncle and nephew objects can be set seperately. To publish an uncle object,
+at least one nephew object must be published at the same time. After publishing of the uncle object,
+nephew objects can be published and unpublished seperately. If the last public nephew object of a public uncle object
+gets private, so does the uncle object. If an uncle object gets delete, so do all its nephew objects.
+This special abstract data type was needed for People <ad-parameter package=acs-kernel name=SystemName>'s Project and Demand descriptions.
+</ol><br>
+
+
+<li><b> Metadata (km-00-defs.tcl)</b>
+<p>
+There is one main proc responsible for getting metadata-
+km_get_questions. km_get_questions returns all visible question_ids and
+various other metadata attributes for any given object type as a keyed list of
+lists. km_get_question returns one question and is usually used to return the
+next or previous question in the question list by calling it with the
+"-next_p" or "-previous_p" options.
+
+<p>
+The other important metadata procs are km_get_all_object_types and
+km_object_type_attributes, which return useful stuff about the object types.
+The latter is used on almost every single page in the <ad-parameter package=acs-kernel name=SystemName> library, since
+it returns everything we need to know to display a page for any given object
+type.
+
+<p>
+km_static caches information about objects whose value is more or
+less static throughout the system's life time. The first time a
+particular information is being looked for, this information is being
+loaded from the database into the cache. km_static does _not_ do any
+error checking at the moment. It is also not the smartest caching
+system under the sun (not yet at least):
+
+<ul>
+<li>As soon as any of the supposedly mostly static information is being
+changed, the whole cache is reset.
+<li>Also there should be proc that loads the cache on server startup.
+</ul>
+
+<p>
+km_conn works very much like ad_conn: it caches information on a library
+object on a per-request basis. Put everything that could be a of interest for
+an object here and retrieve it from this function. Most of the km_conn cache
+is set in km_check_object_id.
+
+
+<p><li><b> Building dynamic forms (km-display.tcl)</b>
+
+<p>
+km_get_form builds a form of questions for any object type. It takes the
+questions from km_get_questions and presents each according to its
+
+<ol>
+<li>Abstract data type
+<li>Presentation type
+</ol>
+
+<p>
+There are various display procs that are named after the abstract data types
+that are used for them, i.e. km_user_link_field, km_option_field. Also
+important is km_get_form_field, a display proc that knows how to call procs
+that produce HTML tags from the metadata presentation types. EVERY form in
+the <ad-parameter package=acs-kernel name=SystemName> library that handles object data is produced by calling this
+proc. object-edit.tcl makes only one call to km_get_form to produce the
+entire form. one-question-edit.tcl also calls this proc with a question-id.
+
+<p>
+Only small parts of the library have been templated yet, both because we were
+working under heavy timeload and because of km_get_form's complexity.
+
+<li><b> User Input</b>
+
+<p>
+The center proc in the family of user-input procs is km_check_input. It takes
+a list of keys, a list of values and an object type and determines if there
+has been insufficent or invalid data entered as values. It does this by
+calling km_required_questions and then compares a list of required fields for
+this object type with the keys and values.
+
+
+<p>Important here is the proc km_sort_form, which takes all the various
+key-value pairs coming in from a input form and assembles them into meaningful
+lists according to the abstract data type. So, for example, a question having
+abstract data type text will have a sibling variable "html_p" that is sorted
+by this procedure into a value tuple, where the first value is the text itself
+and the second is the boolean value. Mulitiple-select variables are also
+sorted into lists matched to one key. Also: km_assemble_dates. This proc
+takes n variables of the triple form var:year var:month var:day and assembles
+them to the variable var, whose value is "YY-MM-DD". (Similar to the
+date_widget but more flexible for the method of dynamic form generation
+required in this system.) var is run through the proc date_p to make sure that
+this assembled thing is really a date.
+
+<p>If check_input finds any reason to complain, it returns a a tuple: the
+number of complaints and the message strings. These can then be easily
+formatted to ad_return_complaint on the page.
+
+
+<p><li><b> Linking</b>
+<p>
+
+
+<p><li><b> Creating an object (km-object-data.tcl)</b>
+<p>This is done by km_create_object.
+
+
+<li><b> Saving object data (km-object-data.tcl)</b>
+<p>
+The central proc in the family of procs that save object data is called
+km_save_object_data. It takes a list of keys, a list of values, a user_id and
+an object_id as arguments. It saves all data of whatever abstract data type if
+possible.
+
+<p>
+km_save_object_data actually doesn't save any data itself, it calls procs to
+deal with the data by abstract data type.
+
+
+<p>
+This proc only saves object data of other abstract data types for an object_id
+that already exists. (it doesn't make sense to categorize or link an object
+that doesn't exist.)
+
+
+<li><b> Retrieving object data</b>
+
+<p>
+In principle, data is retrieved in the same way it is saved: divided into
+abstract data types and then picked out accordingly. The proc that handles
+this is known as km_get_object_data. It only needs an object_id and it returns
+a key list of lists. Check out the form of the return lists in the proc
+itself. It returns everything you need to display this data (but this proc
+does NOT display data.) If you only want the data on a few questions or even
+just one question, then pass a list of just these questions as an optional
+argument. Otherwise it gets data for every single question that can be asked
+about this object.
+
+<p>
+Each question supplied to km_get_object_data is looped through and answered
+according to abstract data type. The answer is retrieved by calling a proc
+that know how to get this particular type of data. Many of the other procs
+that km_get_object_data calls are also in km-object-data.tcl:<br>
+km_get_answer_options, km_get_user_links.
+
+<p>
+km_get_linked_objects gets all data about linked objects for a question of
+abstract data type "object_link". It is found in
+km_links.tcl. (km_get_child_objects is actually in km-links.tcl, too, since
+"child_object" a kind of link is. <br> km_get_categories gets all category
+data for a particular question of abstract data type "categorization". It is
+found in km_categories.tcl.
+
+
+<li><b> Buttons</b>
+<p>
+The km8_button_panel returns datasources for the 5 buttons that appear as a
+navigation panel at the bottom of one-question-edit.tcl. They allow the user
+to go to a lot of places that can only be determined by analysing the name of
+the submit button. Accordingly, we have procs that create submit buttons of
+the style "my_submit_button_name:some_important_number".
+
+<p> Related to these procs is km-defs' km_button_list, which returns a list of
+all possible submit button names in <ad-parameter package=acs-kernel name=SystemName>.
+
+
+<li><b> Dates (km-display.tcl, km-defs.tcl)</b>
+<p>
+There are also some special little procs that do date stuff. For example,
+km_break_date ....breaks a date into 3 parts. Or km_empty_date_p determines if
+a date has any empty fields at all. There are some default date procs in
+km-defs.tcl.: km_default_day, km_today, km_default_year, km_default_month. The
+special proc for <ad-parameter package=acs-kernel name=SystemName> is km_library_date, which calculates a default date
+for beginning and ending projects.
+
+<li><b> Branches(km-branch.tcl)</b>
+<p>
+Branches are not abstract data types! Branches are how we call
+answer-dependent question sequences in the library. For instance, you have a
+question "Who did you vote for?". If the answer was "George W. Bush", then
+the following question might be "What reasons do you have to believe that the
+Republican party will help you personally?" If your answer was "Al Gore", then
+the following question might be "Did you vote Democratic because you were
+pleased with the present government?"
+
+<p>Refer to the <a
+href="/doc/km-library">km-library</a> document
+to grasp the finer points of the question hierarchies for branches. The most
+important procs are km_get_root_branch, which returns the highest node of the
+branch hierarchy for given question_id. Similarly, km_root_branch_p determines
+if this is a question is at all a branch node that has children. Important
+here is the concept of "active branches". An active branch is one where all
+the questions are descendents of an answer that has been chosen higher up in
+the branch tree. If later, one answer higher up is changed, then those
+questions and answers below it are no longer considered "active" and will not
+be displayed in the interface. This is why km_active_branch_p requires the
+root_question_id of a branch AND the object_id. Each object will have its own
+specific version of the active branch path. The most critical proc is
+km_next_branch. Alter with care!!!! It takes a question_id and an answer and,
+analysing them according to the abstract data type, determines which question
+should follow. It uses the default branch if it can't determine what it should
+return, or empty, if there are no children. This proc is used when navigating
+one-question-edit.tcl form "previous" question to "next". Make sure you look
+at the km8_button_panel in km-display.tcl that predetermines the previous and
+next questions when displaying one-question-edit.tcl. And also,
+km_get_question in km-defs.tcl, which does NO branch analysis but works
+together with km_next_branch in one-question-edit-2.tcl to determine what the
+next question will be.
+
+<li><b> Access Control (km-access-procs.tcl)</b><p>
+
+<p>In contrast to <ad-parameter package=acs-kernel name=SystemName> 7, the Library now uses the system-wide
+permissioning system for controlling access to the Knowledge
+Objects. Only a small part of km-access-procs.tcl is concerned with
+the actual permission checks - the large rest of the code does some
+useful things like retrieving general object information in one
+query.</p>
+
+<ol><li><b>km_check_object_id, km_check_object_type_id</b>
+
+<p>These versatile procs should be used on all pages to which an
+object or type ID may be passed. They check if the object or type
+exists, has been deleted, is readable or writeable by the given user,
+and also can print error messages. Note that
+<tt>km_check_object_id</tt> also checks permissions for the object
+type.</p>
+
+<li><b> Other Access Control Procs</b>
+
+<p>Apart from that, there are also procs for checking if a given user
+is a library administrator, may change the owner of an object and may
+read or modify an object or object type.</p>
+
+</ol>
+
+<li><b> Browsing (km-browse.tcl)</b>
+
+<p>A couple of display procs used by browse-one-type,
+browse-one-category and the object-view family of pages can be found
+here.
+
+<p>The only interesting proc is <tt>km_output_object_list</tt>, which
+is used at a couple of places to output lists of objects (name,
+overview, author), possibly with Link buttons when the user is on an
+excursion. It checks the access permissions in its own way, since for
+speed reasons we have to use SQL joins and cannot use the Tcl procs
+defined in km-access.
+
+<li><b> Category Hierarchy (km-categories.tcl)</b>
+XXX Tomislav
+<p>All the stuff related to categories resides here. We use the
+standard categories from the ACS, but need some helper procs to
+deal with them.</p>
+<ol>
+
+
+<li><b> km_category_table</b>
+
+<p>When the user browses objects of one type, he can navigate through
+the associated category tree. This proc builds a subtree starting at a
+given question or category, and displays it as a HTML table. The count
+of objects below each category is passed in as a parameter.</p>
+
+<li><b> km_get_child_categories</b>
+
+<p>Returns all the categories associated with the given question as a
+list of tuples holding the category_id and the indented category
+name. This is used for data entry, where we want to display an
+indented list in a selection box.</p>
+
+<li><b> km_get_category_counts</b>
+
+<p>Counts how many objects there are for a category and its
+subcategories. The result can then be used for km_category_table.</p>
+
+<li><b> Misc.</b>
+
+<p>Mapping between objects and categories and between questions and
+category trees; procs for handling category trees (determing the root
+category, e.g.); small display procs.</p>
+</ol>
+
+<li><b> Reuse Feedback (km-feedback.tcl)</b><p>
+
+<p>Editing and display of general comments and reuse feedback for
+knowledge objects. Uses the site-wide service general-feedback.
+
+<li><b> User Customisation (km-users.tcl)</b></p>
+
+<p>Procs used to display the users Workspace (<cite>saved items</cite>), and
+his own objects (with some information about their current state). This is
+also the place for hooking into ACS' system of listing user contributions and
+new stuff (<tt>km_contributions</tt>).
+
+</ol>
+<hr>
+<a href="mailto:sarnold@arsdigita.com"><address>sarnold@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/doc/psn-general.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/psn-general.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/psn-general.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,731 @@
+<html>
+<head>
+<title>People<ad-parameter package=acs-kernel name=SystemName>: Features and Implementation</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h1>People<ad-parameter package=acs-kernel name=SystemName>: Features and Implementation</h2>
+
+<br>by <a href="mailto:timo@arsdigita.com">Timo Hentschel</a><br>
+December 2001
+
+<hr>
+
+<h2>People<ad-parameter package=acs-kernel name=SystemName> - The Big Picture</h2>
+
+People<ad-parameter package=acs-kernel name=SystemName> is a community that deals with understaffed projects
+and open positions for these projects. The data about these projects
+and positions are stored in the knowledge library in the two object types
+"Project description" and "Demand description". In the past, People<ad-parameter package=acs-kernel name=SystemName>
+has been a TeamNet community with some changes to the knowledge library
+to reflect special requirements.
+
+<h2>Requirements</h2>
+
+<b>Project and Demand descriptions</b>
+
+<p>The knowledge library is used for holding data for the two object types
+"Project description" and "Demand description". Demand descriptions can't
+be created without a Project description. When a Project description is
+created, the author can add an arbitrary number of Demand descriptions.
+To make a Project description public, at least one Demand description must
+exist and be made public at the same time since it doesn't make sense
+to present an understaffed project without presenting any open positions.
+After publishing of a Project, the Demands can be published an published
+seperately, but if the last public Demand gets private so does the Project.
+The permissions for the Demands can be set seperately. Each Project and each
+of its Demands has an end of publication date. If this end date is reached, the
+public Project/Demand will be made private automatically and the author will
+get an email notice. If a Project get private so do all its Demands. If the
+last public Demand of a Project gets private so does the Project itself.
+If a Project gets deleted, so do all its Demands. If the last public Demand
+of a Project gets deleted, the Project itself becomes private again.
+
+<p><b>Demand applications</b>
+
+<p>Besides being able to browse Projects and Demands belonging to them, users
+can also Apply for a public Demand: They have to fill out an application
+form after being reminded that they have to make sure that their supervisor
+is aware of and complies with the application. The application can be saved
+to be completed later, in which case the list of the unfinished applications
+can be placed on the community portal. Users can attach files to the application
+that will be sent as email attachments.
+
+<p><b>Smaller features</b>
+
+<p>In addition to these bigger features, People<ad-parameter package=acs-kernel name=SystemName> also has some smaller requirements
+also:
+<ul>
+<li>#10: For date input a new widget with select boxes only is needed - instead of input
+fields</li>
+<li>#20: Admins should be able to group related questions with headings and seperators</li>
+<li>#30: Users have to fill out an extra text input field if category "Other" is
+selected</li>
+<li>#40: Users can filter the library objects based on "Duration from-to" regarding
+the start and end dates of the Projects and Demands.</li>
+<li>#100: For every Demand, the name of and the link to the Project it's belonging to
+have to be displayed</li>
+<li>#130: When a Demand is created, the contact field of the underlying Project is
+used as a default for the contact field of the Demand</li>
+</ul>
+
+<h2>Current status</h2>
+
+All requirements already got implemented except for #20, #30, #40 and #130 on the list of
+the smaller features. Also, the sweeper procedure that sets outdated public Projects
+and Demands to private still needs to be written.
+
+<h2>Implementation</h2>
+
+<b>Project and Demand descriptions</b>
+
+<p>The relationship between Projects and Demands is something like what already
+got implemented with the abstract data type <b>Child Object</b>, but not quite
+the same. Therefore, a new abstract data type <b>Nephew Object</b> got added,
+the relationship is called an uncle-nephew relationship to express that the
+nephew's public status and permissions are not as strongly coupled to the uncle
+object than it's with parent and child objects (child objects always have
+the same permissions and public status as the parent object). On the other hand,
+this naming is somewhat misleading since the nephew object is in some way
+more dependend on its nephew objects than the parent object is on its child
+objects (an uncle object can only be made public when at least one nephew object
+is made public at the same time and the uncle object will loose the public
+status if there's no longer at least one public nephew object).
+
+<p>To achieve this, the code for the parent-child relationships got copied and
+slightly modified for uncle-nephew relationships. In total, the following procs
+needed to be changed or newly added:
+
+<ul>
+<li><b>km-00-defs-procs.tcl:</b> <i>changed</i> km_get_question, km_check_input</li>
+<li><b>km-admin-lib-procs.tcl:</b> <i>changed</i> km_adt_list, km_pretty_adt</li>
+<li><b>km-branch-procs.tcl:</b> <i>changed</i> km_branch_question</li>
+<li><b>km-browse-procs.tcl:</b> <i>changed</i> km8_output_object_list</li>
+<li><b>km-display-procs.tcl:</b> <i>changed</i> km_display_answer_pretty, km_display_question, km_get_button_names, km8_get_field_html; <i>newly added</i> km_display_nephew_object, km_nephew_object_field</li>
+<li><b>km-object-data-procs.tcl:</b> <i>changed</i> km_get_object_data; <i>newly added</i> km_object_nephews_p, km_valid_nephew_publish_list_p, km_uncle_nephew_questions, km_publishable_nephews</li>
+<li><b>km-links-procs.tcl:</b> <i>changed</i> km_get_linked_objects, km_private_ancestor_p, km_check_private_status_after_edit, km_link_objects; <i>newly added</i> km_get_uncle, km_is_nephew_p, km_is_uncle_p, km_is_mandatory_nephew_p, km_is_mandatory_uncle_p, km_is_nephew_with_private_uncle_p, km_get_presentation_type_of_nephew_question, km_get_nephew_objects, km_get_nephew_count, km_uncle_needs_private_status_p</li>
+</ul>
+
+In addition to that, some user pages and some admin pages needed to be changed to support
+the new abstract data type and the People<ad-parameter package=acs-kernel name=SystemName> requirements for it:
+
+<p><b>User Pages:</b>
+<ul>
+<li><b>index.tcl:</b> check for each object type if standalone objects (i.e. Demand descriptions) of this type can be created without being linked to other objects</li>
+<li><b>object-delete.tcl:</b> before deleting an uncle show the user the list of all nephews which will also get deleted</li>
+<li><b>object-delete-2.tcl:</b> make uncle object private after deletion of the last public nephew</li>
+<li><b>object-edit-2.tcl:</b> Suport for 'Add new nephew' button (same as for child_object datatype)</li>
+<li><b>object-publish.tcl:</b> before publishing a nephew check for public uncle; before publishing an uncle, let user select which nephews to publish also</li>
+<li><b>object-publish-2.tcl:</b> publish a nephew with a public uncle; publish an uncle and all selected nephews</li>
+<li><b>object-unpublish.tcl:</b> before unpublishing last public nephew inform user that uncle will get private, too; before unpublishing an uncle inform user that all nephews will get private, too</li>
+<li><b>object-unpublish-2.tcl:</b> unpublish nephew and set uncle private if needed; unpublish uncle and set all nephews private</li>
+<li><b>object-view.tcl:</b> show toolbar for nephews (not shown for children)</li>
+<li><b>one-question-edit.tcl:</b> support for nephew_object datatype (same as for child_object)</li>
+<li><b>one-question-edit-2.tcl:</b> support for nephew_object datatype (same as for child_object)</li>
+<li><b>questions.tcl:</b> show nephew question with answers</li>
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>edit-question.tcl:</b> support for nephew_object datatype (same as for child_object)</li>
+<li><b>edit-question-2.tcl:</b> support for nephew_object datatype (same as for child_object)</li>
+</ul>
+
+<b>Datamodel:</b>
+<p>To specify whether users can create standalone objects of an object type - we
+won't allow users to create Demand descriptions without linked Project description:
+<pre>
+alter table sn_object_types add (
+ -- to be able to prevent standalone objects of this object type
+ -- (meaning objects which didnt created as child or nephew)
+ -- needed this for people <ad-parameter package=acs-kernel name=SystemName> - demand descriptions
+ create_p
+ char(1) default 't'
+ constraint sn_object_types_create_p_nn not null,
+ constraint sn_object_types_create_p_ck
+ check (create_p in ('t','f'))
+);
+</pre>
+
+<p>To have the hierarchy of parent-child and uncle-nephew relationships in the
+easily accessed table km_flat_object_hierarchy, the table and triggers had to be updated:
+<pre>
+alter table km_flat_object_hierarchy add (
+ -- we still have the unique (parent,child) constraint on this table
+ -- because we won't allow for two objects to be linked directly or
+ -- indirectly both as parent_child and uncle_nephew. That means that
+ -- one object tree in this hierarchy either only has parent_child links
+ -- or uncle_nephew links.
+ link_type
+ varchar2(100) default 'parent_child'
+);
+
+
+create or replace trigger km_flat_object_hier_insert_tr
+before insert on sn_links for each row
+begin
+ if :new.link_type = 'parent_child' or :new.link_type = 'uncle_nephew' then
+ insert into km_flat_object_hierarchy (object_hierarchy_id, parent, child, distance, link_type)
+ values (acs_object_id_seq.nextval, :new.object_id_a, :new.object_id_b, 1, :new.link_type);
+
+ insert into km_flat_object_hierarchy (object_hierarchy_id, parent, child, distance, link_type)
+ select acs_object_id_seq.nextval, parent, :new.object_id_b, distance+1, :new.link_type
+ from km_flat_object_hierarchy
+ where child = :new.object_id_a;
+ end if;
+end ;
+/
+show errors
+
+
+create or replace trigger km_flat_object_hier_delete_tr
+before delete on sn_links for each row
+begin
+ if :old.link_type = 'parent_child' or :old.link_type = 'uncle_nephew' then
+ delete from km_flat_object_hierarchy
+ where child = :old.object_id_b;
+ end if;
+end ;
+/
+show errors
+</pre>
+
+<p><b>Demand applications</b>
+
+<p>The abstract data type nephew_object got two presentation types: Standard and
+Application Form. The latter means, that on the page of a public nephew object there
+will be button that will lead to the application form which can be found in the
+<b>resource-application*</b> files.
+The application form itself got implemented as a static form according to the Spec. In
+the contact data textarea all answers to registration questions are provided as
+default. Three different kind of categories are used in the application form. Since
+they didn't get implemented as static categories (static selectboxes), an admin
+has to assign category trees to the three magic application category objects that
+are created for every library instance. The data the user enters gets inserted
+into the database so that the user can come back, edit his application data and
+finally send his application - he will receive a copy. To remind the user of
+unfinished applications, a portal element showing these got added. The email
+itself has to be MIME encoded because of the files that have to be send as email
+attachments.
+
+<p><b>Tcl Procs:</b>
+<ul>
+<li><b>km-00-defs-procs.tcl:</b> updated km_static to support new create_p flag for object types to signal if standalone objects are alowed</li>
+<li><b>km-admin-lib-procs.tcl:</b> updated km_pretty_tag to support new presentation type 'application form'</li>
+<li><b>km-psn-procs.tcl:</b> portal_saved_applications (portal proc to show all unfinished applications of the user in a portal element)</li>
+</ul>
+
+<b>User Pages:</b>
+<ul>
+<li><b>object-view.tcl:</b> show application button in nephew if presentation type of nephew question is set to application</li>
+<li><b>resource-application-add.tcl:</b> show Application Policy approval page or redirect to the edit page if there's an unfinished application for this user and Demand description</li>
+<li><b>resource-application-add.adp:</b> Application Policy approval page</li>
+<li><b>resource-application-add-2.tcl:</b> New application form with defaults for Recipient, Subject and Contact Data</li>
+<li><b>resource-application-edit.tcl:</b> unfinished application form with saved data</li>
+<li><b>resource-application.adp:</b> application form - for add and edit</li>
+<li><b>resource-application-attach.tcl:</b> attach files to application</li>
+<li><b>resource-application-attach.adp:</b> attach files to application</li>
+<li><b>resource-application-attach-2.tcl:</b> insert file into db and redirect to edit page</li>
+<li><b>resource-application-save.tcl:</b> save the entered data, delete the database entries if cancel application button got pressed and redirect either to attachment page, send page or object-view</li>
+<li><b>resource-application-send.tcl:</b> email preview and confirmation page</li>
+<li><b>resource-application-send.adp:</b> email preview and confirmation page</li>
+<li><b>resource-application-send-2.tcl:</b> MIME the whole email with all attachments and send them to the recipient and the user and redirect to object-view page</li>
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>choose-presentation-type.tcl:</b> added presentation types 'standard' and 'application' for nephew questions</li>
+<li><b>edit-object-type.tcl:</b> added support for create_p flag of object types to signal if standalone objects are alowed</li>
+<li><b>edit-object-type-2.tcl:</b> added support for create_p flag of object types to signal if standalone objects are alowed</li>
+<li><b>index.tcl:</b> added link to management page of category trees for application form (role-tree, language-tree, language-proficiency-tree)</li>
+<li><b>view-questions.tcl:</b> show presentation type of nephew question</li>
+</ul>
+
+<b>Datamodel:</b>
+<p>Table to hold most of the users data in an application:
+<pre>
+create table psn_res_applications (
+ application_id integer primary key,
+ object_id constraint psn_res_app_object_id_fk
+ references sn_objects on delete cascade,
+ resource_req_id constraint psn_res_app_res_req_id_fk
+ references sn_objects on delete cascade,
+ user_id constraint psn_res_app_user_id_fk
+ references users,
+ creation_date date default sysdate,
+ application_date date default null,
+ sent_p char(1) default 'f'
+ constraint psn_res_app_sent_p_ck
+ check (sent_p in ('t','f')),
+ recipient varchar2(4000),
+ subject varchar2(1000),
+ contact_data varchar2(4000),
+ nationality varchar2(4000),
+ manager_email varchar2(4000),
+ working_area varchar2(4000),
+ role_other varchar2(1000),
+ first_language varchar2(1000),
+ second_language_id integer,
+ third_language_id integer,
+ first_language_prof_id integer,
+ second_language_prof_id integer,
+ third_language_prof_id integer,
+ other_language varchar2(4000),
+ from_date date,
+ to_date date,
+ strengths varchar2(4000),
+ leadership varchar2(4000),
+ intercultural varchar2(4000),
+ comments varchar2(4000),
+ conditions varchar2(4000)
+);
+
+create index psn_res_app_object_idx on psn_res_applications (object_id);
+
+create index psn_res_app_res_idx on psn_res_applications (resource_req_id);
+
+create index psn_res_app_user_idx on psn_res_applications (user_id);
+</pre>
+
+<p>This table holds all Roles/Functions of the applicant - these are category ids:
+<pre>
+create table psn_res_application_roles (
+ application_id integer
+ constraint psn_res_app_roles_app_fk
+ references psn_res_applications on delete cascade,
+ role_id integer,
+ primary key (application_id, role_id)
+);
+</pre>
+
+<p>In the application form are three different kinds of categories used:
+Roles/Functions of the applicant, languages spoken and the proficiency in the
+language. This table holds the object ids of the three magic objects for each
+library package instance used to map category trees to be used in the application form:
+<pre>
+create table psn_category_trees (
+ package_id integer primary key,
+ role_magic_id constraint psn_cat_trees_role_fk
+ references acs_objects (object_id) on delete set null,
+ language_magic_id constraint psn_cat_trees_lang_fk
+ references acs_objects (object_id) on delete set null,
+ proficiency_magic_id constraint psn_cat_trees_prof_fk
+ references acs_objects (object_id) on delete set null
+);
+</pre>
+
+<p>This table holds all email-attachments to the application as blobs:
+<pre>
+create table psn_attachments (
+ attachment_id integer primary key,
+ application_id constraint psn_attach_appl_id_fk
+ references psn_res_applications on delete cascade,
+ title varchar2(1000),
+ mime_type varchar2(200) default 'text/plain',
+ filename varchar2(200),
+ attachment blob default empty_blob()
+);
+
+create index psn_attach_appl_id_idx on psn_attachments(application_id);
+
+create sequence psn_attachment_id_seq start with 1;
+</pre>
+
+<p>Creation of new object types for applications and magic tree objects:
+<pre>
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'psn_tree_object',
+ pretty_name => 'Demand Application Form',
+ pretty_plural => 'Demand Application Forms',
+ table_name => 'PSN_CATEGORY_TREES'
+ );
+end;
+/
+show errors
+
+begin
+ acs_object_type.create_type (
+ supertype => 'acs_object',
+ object_type => 'psn_application',
+ pretty_name => 'Demand Application',
+ pretty_plural => 'Demand Applications',
+ table_name => 'PSN_RES_APPLICATIONS',
+ id_column => 'APPLICATION_ID'
+ );
+end;
+/
+show errors
+</pre>
+
+<p><b>Smaller features</b>
+
+<p><b>#10: new date input widget</b>
+
+<p>To support the displaying of a valid range of years in the selectboxes,
+two columns needed to be added to the table sn_questions: year_from and
+year_to describe the range of years (in respect to the year default) that
+should be displayed in the year selectbox. Admin pages and the date widget
+page dealing with the displaying of date entry fields needed to be updated to
+reflect these changes and to deal with the additional presentation type.
+
+<p><b>User Pages:</b>
+<ul>
+<li><b>km-date-tags.tcl:</b> updated to support new presentation_type</li>
+<li><b>km-date-tags.adp:</b> updated to support new presentation_type</li>
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>choose-presentation-type.tcl:</b> added presentation type 'select' for date questions</li>
+<li><b>view-questions.tcl:</b> show pretty presentation type of date question</li>
+</ul>
+
+<b>Datamodel:</b>
+<p>Added two columns to have a varying range of years in the year selectbox.
+Values are interpreted starting from the provided default.
+<pre>
+alter table sn_questions add (
+ -- this is only for abstract_data_type date to specify what years
+ -- should be in the select box in respect to the default date.
+ year_from
+ integer default -5,
+ year_to
+ integer default 5
+);
+</pre>
+
+<p><b>#30: Input field if category 'Other' is selected</b>
+
+<p>This was implemented with an extra presentation type of the category
+questions 'other_category'. The content of the extra input-field is
+stored in sn_content like any other text input.
+
+<p><b>Tcl Procs:</b>
+<ul>
+<li><b>km-00-defs-procs.tcl:</b> support for other_category questions in km_static</li>
+<li><b>km-admin-lib-procs.tcl:</b> support for other_category questions</li>
+<li><b>km-branch-procs.tcl:</b> support for other_category questions</li>
+<li><b>km-categories-procs.tcl:</b> support for other_category questions</li>
+<li><b>km-display-procs.tcl:</b> display other_category value</li>
+<li><b>km-object-data-procs.tcl:</b> retrieve, save and edit other_category values</li>
+</ul>
+
+<b>User Pages:</b>
+<ul>
+<li><b>km-display-question-answer.tcl:</b> support for other_category questions</li>
+<li><b>km-form.tcl:</b> support for other_category questions</li>
+<li><b>one-question-edit-2.tcl:</b> support for other_category questions</li>
+<li><b>questions.tcl:</b> support for other_category questions</li>
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>choose-presentation-type.tcl:</b> support for other_category questions</li>
+<li><b>edit-question.tcl:</b> support for other_category questions</li>
+<li><b>edit-question-2.tcl:</b> support for other_category questions</li>
+<li><b>view-questions.tcl:</b> support for other_category questions</li>
+</ul>
+
+<b>Pl/Sql Packages:</b>
+<ul>
+<li><b>library-package-bodies.sql:</b> Added support for other_category questions in question.insert_question</li>
+</ul>
+
+<p><b>#40: Filtering of objects by start and end date</b>
+
+<p>We added two columns to sn_object_types and added support for marking
+date questions as start_date or end_date questions in the admin pages
+(like public_until). The filter itself has been implemented in the user pages
+- browse-one-type and browse-one-category.
+
+<p><b>Datamodel:</b>
+<pre>
+alter table sn_object_types add (
+ -- these two links to date questions have been added for
+ -- people <ad-parameter package=acs-kernel name=SystemName> (project start/end date):
+ start_date
+ integer
+ constraint sn_object_t_start_date_id_fk
+ references sn_questions (question_id),
+ end_date
+ integer
+ constraint sn_object_t_end_date_id_fk
+ references sn_questions (question_id)
+);
+</pre>
+
+<p><b>#70: Sweeper proc to check public status of uncle and nephew objects</b>
+
+<p>That was done with just a tcl proc that gets scheduled to be run
+every night or so. Email-templates are needed since the object author
+needs to be notified if an object had to be made private. Six different
+cases had to be considered: Single objects, parent objects, child objects
+that are effected by the parent, nephew objects, uncle objects effected by
+nephews, other descendants of uncles effected by nephews.
+
+<p><b>Tcl Procs:</b>
+<ul>
+<li><b>km-psn-procs.tcl:</b> Actual sweeper proc</li>
+<li><b>library-init.tcl:</b> Schedule sweeper proc</li>
+</ul>
+
+<b>#100: show linked Project on Demand page</b>
+
+<p>Since the relationship between Projects and Demands got implemented
+in the new abstract data type 'nephew_object' of the linking question,
+the uncle object will be shown in object-view of a nephew - the same way
+as i.e. 'Modified Date'.
+
+<p><b>User Pages:</b>
+<ul>
+<li><b>object-view.tcl:</b> If object is a nephew, display uncle object with
+a link</li>
+</ul>
+
+<p><b>#130: Contact data of the Project is shown as default in Demands</b>
+
+<p>To be a little bit more general with this feature, we added a column
+defaults_question_id to sn_questions which needs to be checked during editing
+of an unanswered question. The admin pages will make sure that this column
+points to a question_id of the same abstract_data_type.
+
+<p><b>Tcl Procs:</b>
+<ul>
+<li><b>km-00-defs-procs.tcl:</b> support for defaults_question_id</li>
+</ul>
+
+<b>User Pages:</b>
+<ul>
+<li><b>km-form.tcl:</b> support for defaults_question_id; get defaults from ancestor objects question if question haven't been answered yet</li>
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>edit-question.tcl:</b> support for defaults_question_id; let the user select between questions of same abstract_data_type of ancestor object-types (object-types with parent-child or uncle-nephew questions to this object-type)</li>
+<li><b>edit-question-2.tcl:</b> support for defaults_question_id</li>
+</ul>
+
+<b>Datamodel:</b>
+<pre>
+alter table sn_questions add (
+ defaults_question_id
+ integer default null
+ constraint sn_questions_defaults_qu_id_fk
+ references sn_questions(question_id)
+);
+</pre>
+
+<p><b>Maximum number of categories the user can select in a category question</b>
+<p>We added a column max_categories to the sn_questions table which can be
+changed with the admin pages.
+
+<p><b>Tcl Procs:</b>
+<ul>
+<li><b>km-00-defs-procs.tcl:</b> support for max_categories in km_static, check_input
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>edit-question.tcl:</b> support for max_categories</li>
+<li><b>edit-question-2.tcl:</b> support for max_categories</li>
+</ul>
+
+<b>Datamodel:</b>
+<pre>
+alter table sn_questions add (
+ max_categories
+ integer default null
+);
+</pre>
+
+<h2>Future Implementation</h2>
+
+<b>#20: headings to group related questions</b>
+
+<p>There might be a seperate table to store the headings since adding these
+as a special abstract data type will result in special treatments in too
+many places. The downside of a seperate table will be that we'll need to
+join with this table for one-question-edit and possibly even for object-view
+which is pretty bad. Maybe there'll be a better solutuon falling from the sky.
+
+<p><b>Archive, Sweeper, Copy</b>
+
+<p><b>Tcl Procs:</b>
+<ul>
+<li><b>km-00-defs-procs.tcl:</b> km_static-support for archive_p, copy_p, sweeper, sweeper_action, sweeper_warning_time, sweeper_outdated_time</li>
+<li><b>km-access-procs.tcl:</b> check permissions for archived objects</li>
+<li><b>km-browse-procs.tcl:</b> context bar, list of archived objects for browse pages</li>
+<li><b>km-callback-procs.tcl:</b> Support for [Archived] tag for objects</li>
+<li><b>km-categories-procs.tcl:</b> Support for category widget for archived objects</li>
+<li><b>km-display-procs.tcl:</b> Display archived objects with [Archived] tag</li>
+<li><b>km-links-procs.tcl:</b> Archive and unarchive objects</li>
+<li><b>km-object-data-procs.tcl:</b> Show list of archived objects on browse-pages, show invisible questions for archived objects</li>
+<li><b>km-psn-procs.tcl:</b> Sweeper for outdated/expired objects, warning sweeper for outdated/expired objects, copy object</li>
+<li><b>km-users-procs.tcl:</b> show copy option in toolbar</li>
+</ul>
+
+<b>User Pages:</b>
+<ul>
+<li><b>browse-one-category.tcl:</b> Let user copy objects or view the archive</li>
+<li><b>browse-one-type.tcl:</b> Let user copy objects or view the archive</li>
+<li><b>comment-add.tcl:</b> Check permissions for archived objects</li>
+<li><b>comment-add-2.tcl:</b> Check permissions for archived objects</li>
+<li><b>comment-add-3.tcl:</b> Check permissions for archived objects</li>
+<li><b>comment-add-4.tcl:</b> Check permissions for archived objects</li>
+<li><b>comment-edit.tcl:</b> Check permissions for archived objects</li>
+<li><b>comment-edit-2.tcl:</b> Check permissions for archived objects</li>
+<li><b>km-display-child-object.tcl:</b> Display archived objects with [Archived] tag</li>
+<li><b>km-display-nephew-object.tcl:</b> Display archived objects with [Archived] tag</li>
+<li><b>km-linked-object-list.tcl:</b> Display archived objects with [Archived] tag</li>
+<li><b>index.tcl:</b> Let user copy objects or view the archive</li>
+<li><b>object-archive.tcl:</b> Ask for confirmation before putting object in archive</li>
+<li><b>object-archive-2.tcl:</b> Put object in archive</b>
+<li><b>object-unarchive.tcl:</b> Ask for confirmation before removing object and selected descendants from the archive</b>
+<li><b>object-unarchive-2.tcl:</b> Remove objects from the archive or redirect to object-copy-2 if user wants to copy objects instead</li>
+<li><b>object-copy.tcl:</b> Copy object (called from index, browse-pages, one-question-edit-2, object-edit-2)</li>
+<li><b>object-copy-2.tcl:</b> Copy selected object list or specific object (called from object-copy, object-unarchive-2, object-view)</li>
+<li><b>object-copy-3.tcl:</b> Copy the objects</li>
+<li><b>object-publish.tcl:</b> Check permissions for archived objects</li>
+<li><b>object-publish-2.tcl:</b> Check permissions for archived objects</li>
+<li><b>object-unpublish.tcl:</b> Check permissions for archived objects</li>
+<li><b>object-unpublish-2.tcl:</b> Check permissions for archived objects</li>
+<li><b>object-view.tcl:</b> Display archived ancestor object with [Archived] tag</li>
+<li><b>object-edit-2.tcl:</b> Redirect to object-copy if user wants to copy objects</li>
+<li><b>one-question-edit.tcl:</b> Check permissions for archived objects</li>
+<li><b>one-question-edit-2.tcl:</b> Check permissions for archived objects, redirect to object-copy if user wants to copy objects</li>
+<li><b>questions.tcl:</b> Check permissions for archived objects</li>
+<li><b>question-field-child-object.tcl:</b> Show button to copy objects if allowed</li>
+<li><b>question-field-nephew-object.tcl:</b> Show button to copy objects if allowed</li>
+</ul>
+
+<b>Admin Pages:</b>
+<ul>
+<li><b>create-object-type.tcl:</b> support for new columns of sn_object_types</li>
+<li><b>create-object-type-2.tcl:</b> support for new columns of sn_object_types</li>
+<li><b>edit-object-type.tcl:</b> support for new columns of sn_object_types</li>
+<li><b>edit-object-type-2.tcl:</b> support for new columns of sn_object_types</li>
+</ul>
+
+<b>Pl/Sql Packages:</b>
+<ul>
+<li><b>library-packages.sql:</b> added object.copy_object to copy object</li>
+<li><b>library-package-bodies.sql:</b> Added support for archived_p, copy_p; added object.copy_object to copy object</li>
+</ul>
+
+<b>Datamodel:</b>
+
+<pre>
+alter table sn_object_types add (
+ -- can objects of this type be archived?
+ archive_p
+ char(1)
+ default 't'
+ constraint sn_object_types_archive_p_nn not null,
+ constraint sn_object_types_archive_p_ck
+ check (archive_p in ('t', 'f')),
+ -- are you allowed to copy objects of this type?
+ copy_p
+ char(1)
+ default 't'
+ constraint sn_object_types_copy_p_nn not null,
+ constraint sn_object_types_copy_p_ck
+ check (copy_p in ('t', 'f')),
+ -- which sweeper should be checking for old objects?
+ -- outdated: objects haven't been modified for a certain time
+ -- expired: public_until date has been exceeded
+ sweeper
+ varchar(10)
+ default 'none'
+ constraint sn_object_types_sweeper_nn not null,
+ constraint sn_object_types_sweeper_ck
+ check (sweeper in ('none','outdated','expired')),
+ -- action to be performed on the objects by the sweeper
+ sweeper_action
+ varchar(10)
+ default 'private'
+ constraint sn_object_types_sw_action_nn not null,
+ constraint sn_object_types_sw_action_ck
+ check (sweeper_action in ('private','archive')),
+ -- if >0 a warning email will be sent if the object is outdated/expired
+ -- specifies the amount of days the action should be performed after
+ -- the warning email
+ sweeper_warning_time
+ integer
+ default 0
+ constraint sn_object_types_warning_nn not null,
+ -- specified the amount of days after which an unchanged objects is
+ -- regarded as outdated
+ sweeper_outdated_time
+ integer
+ default 30
+);
+
+alter table sn_objects add (
+ -- date the object got archived
+ archiving_date
+ date
+ default null,
+ -- date a warning email got sent that object is outdated
+ outdated_warning_date
+ date
+ default null,
+ -- date a warning email got sent that object is expired (public_until)
+ expired_warning_date
+ date
+ default null
+);
+
+create index sn_objects_archived_p_ix on sn_objects (archived_p);
+
+create index sn_objects_o_warning_date_ix on sn_objects (outdated_warning_date);
+
+create index sn_objects_e_warning_date_ix on sn_objects (expired_warning_date);
+
+create table sn_object_archive_reasons (
+ object_id
+ integer
+ constraint sn_object_archive_re_obj_id_fk
+ references sn_objects(object_id),
+ reason_for_archiving
+ varchar(4000),
+ archived_on
+ date default sysdate,
+ constraint sn_object_archive_reasons_pk
+ primary key (object_id, archived_on)
+);
+
+alter table saved_searches add (
+ l_i_a_p varchar2(4000)
+);
+
+create table km_sweeper (
+ user_id
+ integer
+ constraint km_sweeper_user_id_fk
+ references users,
+ package_id
+ integer
+ constraint km_sweeper_package_id_fk
+ references apm_packages,
+ object_type_id
+ integer
+ constraint km_sweeper_obj_type_id_fk
+ references sn_object_types,
+ object_id
+ integer
+ constraint km_sweeper_object_id_fk
+ references sn_objects,
+ object_name
+ varchar2(4000),
+ content
+ varchar2(4000),
+ primary key (user_id, object_id)
+);
+</pre>
+
+<hr>
+<a href="mailto:timo@arsdigita.com"><address>timo@arsdigita.com</address></a>
+</body>
+</html>
Index: openacs-4/contrib/obsolete-packages/library/www/doc/workflow-visualized.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/workflow-visualized.gif,v
diff -u
Binary files differ
Index: openacs-4/contrib/obsolete-packages/library/www/doc/workflow.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/workflow.html,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/workflow.html 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,141 @@
+<html>
+<head>
+<title>Library Workflow for the Best Practice Marketplace</title>
+</head>
+
+<body bgcolor=#ffffff text=#000000>
+<h2>Library Workflow for the Best Practice Marketplace</h2>
+
+<br>Workflow stuff done by <a href="mailto:dirk@arsdigita.com">Dirk Gomez</a>
+<hr>
+
+<h2>Installation</h2>
+<p>
+The workflow module is pretty well-documented. It contains an installation
+guide. Follow it and definitely set up graphviz, because it visualizes the
+workflow process nicely.
+
+<p>
+If you have not set up graphviz, but want to see the graphical presentation,
+then <a href="workflow-visualized.gif">click here</a>.
+
+<p>
+Don't forget the necessary email templates:
+
+<ul>
+<li>library_clarify
+<li>library_review_object
+<li>library_published
+</ul>
+
+<p>
+And you have to grant access rights to the public to /workflow.
+
+<h2>How to work with the workflow module</h2>
+<p>
+The workflow module is quite fragile. It is pretty easy to ruin a whole
+workflow process and it is very hard to track down errors. At one point I even
+managed to deadlock a session. Hence I strictly stuck to changing one thing
+only, testing the whole workflow process and in case of success do more of the
+changes I had thought of as necessary.
+
+<p>
+The whole workflow process is setup by running these two SQL scripts:
+
+<ul>
+<li>sql/oracle/library-workflow-create.sql
+<li>sql/oracle/library-workflow-packages.sql
+</ul>
+
+<p>
+In case you want to recreate the library approval workflow, drop it by
+executing this script:
+
+<ul>
+<li>sql/oracle/library-workflow-drop.sql
+</ul>
+
+and rerun library-workflow-create and library-workflow-packages.
+
+<p>
+Change the SQL scripts if you want to change workflow's behaviour. The web
+interface is nice, but the export function doesn't work properly.
+
+<h2>How to change workflow's behaviour</h2>
+<p>
+It's quite unlikely that the workflow process itself has to be changed. It's
+most certain though that you have to change a transition's context info. You
+register callback PL/SQL procedures to perform a certain job whenever a token
+passes a particular transition:
+
+<ul>
+<li>Enable PL/SQL proc
+<li>Fire PL/SQL proc
+<li>Assignment PL/SQL proc
+<li>Time PL/SQL proc
+<li>Deadline PL/SQL proc
+<li>Hold Timeout PL/SQL proc
+<li>Notification PL/SQL proc
+<li>Unassigned task PL/SQL proc
+<li>Access Privilege
+</ul>
+
+<p>
+Check the sql/oracle/library-workflow-create.sql file to see which callbacks
+have been associated with which transition. It's the "insert into
+wf_context_transition_info" statements that register that information with the
+workflow module.
+
+<p>
+Let's look into what happens when a token passes the library_review transition
+- when a knowledge item is put into the "needs to be reviewed" state:
+
+<blockquote>
+<pre>
+<code>
+insert into wf_context_transition_info (
+ context_key,
+ workflow_key,
+ transition_key,
+ assignment_callback,
+ fire_callback,
+ notification_callback,
+ notification_custom_arg,
+ unassigned_callback,
+ access_privilege
+) values (
+ 'default',
+ 'library_approval_wf',
+ 'library_review',
+ 'library_callback.assign_task_to_assignee',
+ 'library_callback.review_fire',
+ 'library_callback.notification',
+ 'library_review_object',
+ 'library_callback.notify_admin',
+ 'write'
+);
+</code>
+</pre>
+</blockquote>
+
+<p>
+So if you want to change the task assignment, you either change the PL/SQL
+procedure assign_task_to_assignee, or assign another procedure to
+assignment_callback. Likewise with the fire_callback: if you want to muck
+around with the sn_objects table, then do it in review_fire.
+
+<p>
+Exercise the same caution as with the workflow process definition itself. Work
+in small steps, test completely, roll back or commit your work etc.
+
+<hr>
+<a href="mailto:dirk@arsdigita.com"><address>dirk@arsdigita.com</address></a>
+</body>
+</html>
+
+
+
+
+
+
+
Index: openacs-4/contrib/obsolete-packages/library/www/doc/pages/index.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/doc/pages/index.html,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/doc/pages/index.html 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,22 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+ <head>
+ <title>Library 8 Pages Documentation</title>
+ </head>
+
+ <body>
+ <h1>Library 8 Pages Documentation</h1>
+
+ <h2>User Pages</h2>
+ <ul>
+ <li><a href="user/user-index.html">index.tcl</a>
+ </ul>
+
+ <h2>Admin Pages</h2>
+ <ul>
+ <li><a href="admin/admin-index.html">index.tcl</a>
+ </ul>
+ <hr>
+ <address><a href="mailto:dirk@arsdigita.com">Dirk Gomez</a></address>
+ </body>
+</html>
Index: openacs-4/contrib/obsolete-packages/library/www/download/index.vuh
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/download/index.vuh,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/download/index.vuh 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1 @@
+km_serve_document
Index: openacs-4/contrib/obsolete-packages/library/www/graphics/arrow.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/graphics/arrow.gif,v
diff -u
Binary files differ
Index: openacs-4/contrib/obsolete-packages/library/www/graphics/check-gray.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/graphics/check-gray.gif,v
diff -u
Binary files differ
Index: openacs-4/contrib/obsolete-packages/library/www/graphics/check.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/graphics/check.gif,v
diff -u
Binary files differ
Index: openacs-4/contrib/obsolete-packages/library/www/groupadmin/index-template.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/groupadmin/index-template.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/groupadmin/index-template.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1 @@
+<include src="/packages/acs-subsite/www/groupadmin/@target@">
Index: openacs-4/contrib/obsolete-packages/library/www/groupadmin/index-template.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/groupadmin/index-template.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/groupadmin/index-template.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,28 @@
+ad_page_contract {
+} {
+ pass:notnull
+}
+
+regexp {^object_id([0-9]+)category_id(.*)} $pass match object_id category_id
+
+if { ![km_check_object_id -check_edit_p 1 $object_id] } { return }
+
+set_the_usual_klib_context_bar $object_id $category_id "../"
+append_context_bar_data -link_last [list "../object-access?[export_url_vars object_id category_id]" "Access control"]
+
+set path_info [ad_conn path_info]
+if {[empty_string_p $path_info]} {
+ set path_info index
+}
+
+if {[regexp {^rquestions/categories/(.*)} $path_info match path_info]} {
+ ad_conn -set path_info $path_info
+ set target "rquestions/categories/index-template"
+} else {
+ set target $path_info
+}
+
+array set node [site_node "/groupadmin"]
+ad_conn -set template_key $node(template_key)
+
+ad_return_template
Index: openacs-4/contrib/obsolete-packages/library/www/groupadmin/index.vuh
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/groupadmin/index.vuh,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/groupadmin/index.vuh 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1 @@
+ns_return 200 text/html [ad_return_template -string index-template]
Index: openacs-4/contrib/obsolete-packages/library/www/linking/index-template.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/linking/index-template.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/linking/index-template.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,6 @@
+<if @limit_object_type@ eq "">
+ <include src="/packages/bookmarks/www/@path_info@" linking=1>
+</if>
+<else>
+ <include src="/packages/bookmarks/www/@path_info@" linking=1 limit_object_type="@limit_object_type@">
+</else>
Index: openacs-4/contrib/obsolete-packages/library/www/linking/index-template.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/linking/index-template.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/linking/index-template.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,43 @@
+ad_page_contract {} {
+ source_id
+ pass
+} -properties {
+ path_info:onevalue
+ limit_object_type:onevalue
+}
+
+set path_info [ad_conn path_info]
+if {[empty_string_p $path_info]} {
+ set path_info index
+}
+
+array set node [site_node [bookmarks::get_global_instance_path]]
+ad_conn -set template_key $node(template_key)
+
+if {[info exists pass]} {
+ regexp {^([0-9]*)} $pass match path_id
+
+ set values [get_path_values -action_only_p 0 $path_id]
+ set question_id [value_from_tuples $values question_id]
+ set object_id [value_from_tuples $values object_id]
+ set category_id [value_from_tuples $values category_id]
+
+ set data_type [km_static question_abstract_data_type $question_id]
+
+ if ![km_check_object_id $object_id] { return }
+ set_the_usual_klib_context_bar $object_id $category_id
+} else {
+ set data_type "sn_object"
+ set_context_bar_data
+}
+
+switch $data_type {
+ "content_link" {
+ set limit_object_type ""
+ }
+ default {
+ set limit_object_type "sn_object"
+ }
+}
+
+ad_return_template "index-template"
Index: openacs-4/contrib/obsolete-packages/library/www/linking/index.vuh
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/linking/index.vuh,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/linking/index.vuh 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1 @@
+ns_return 200 text/html [ad_return_template -string "index-template"]
Index: openacs-4/contrib/obsolete-packages/library/www/linking/link-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/linking/link-2.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/linking/link-2.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,35 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+ad_page_contract {
+ Really link the crap.
+} {
+ target:integer,notnull
+ pass:notnull
+ {link_comment ""}
+ {html_p:oneof(1|0) "0"}
+}
+csrf::authenticate
+
+#strip the restriction crud
+regexp {(\d*)} $pass match path_id
+
+set values [get_path_values -action_only_p 0 $path_id]
+set object_id [value_from_tuples $values object_id]
+set category_id [value_from_tuples $values category_id]
+set question_id [value_from_tuples $values question_id]
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set object_type_id [km_conn object_type_id]
+
+set current_action [snd [get_path_values $path_id]]
+
+if {[string equal $current_action add_sn_ref]} {
+ ad_returnredirect "../add-sharenet-ref?path_id=$path_id&object_id=$target&category_id=$category_id"
+} else {
+ set html_p [ad_decode $html_p 1 t f]
+ km_link_objects $question_id $user_id $object_id $target $link_comment $html_p
+}
+
+ad_returnredirect "../object-link?question_id=$question_id&object_id=$object_id&category_id=$category_id"
+
Index: openacs-4/contrib/obsolete-packages/library/www/linking/link.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/linking/link.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/linking/link.adp 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,24 @@
+<master>
+<property name=title>@title;noquote@</property>
+
+Describe shortly the connection between "@object_a_name@" and the object
+you are linking it to:
+<form action="link-2" method=post>
+ <csrf-token>
+ @form_vars;noquote@
+ <table>
+ <tr>
+ <td>
+ <textarea name="link_comment" cols=49 rows=6></textarea>
+ </td>
+ </tr>
+ <tr><td><p><include src="../km-text-select"></td></tr>
+ <tr>
+ <td align=center>
+ <br>
+ <input type=submit value="Proceed">
+ </td>
+ </tr>
+ </table>
+</form>
+
Index: openacs-4/contrib/obsolete-packages/library/www/linking/link.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/contrib/obsolete-packages/library/www/linking/link.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/contrib/obsolete-packages/library/www/linking/link.tcl 2 Jul 2003 12:19:45 -0000 1.1
@@ -0,0 +1,37 @@
+set user_id [ad_maybe_redirect_for_registration]
+
+ad_page_contract {
+ Link with the news article.
+} {
+ source_id:integer,notnull
+ pass:notnull
+ target:integer,notnull
+}
+
+regexp {(\d*)} $pass match path_id
+
+set values [get_path_values -action_only_p 0 $path_id]
+set object_id [value_from_tuples $values object_id]
+set category_id [value_from_tuples $values category_id]
+set question_id [value_from_tuples $values question_id]
+
+if ![km_check_object_id -check_edit_p 1 $object_id] { return }
+
+set object_type_id [km_conn object_type_id]
+
+set current_action [snd [get_path_values $path_id]]
+
+if {[string equal $current_action add_sn_ref]} {
+ ad_returnredirect "../add-sharenet-ref?path_id=$path_id&object_id=$target&category_id=$category_id&[csrf::link_token]"
+}
+
+set title "Link with Library object"
+set_the_usual_klib_context_bar $object_id $category_id "../"
+append_context_bar_data $title
+
+set object_a_name [db_string link_object_a_name {
+ select shortname
+ from acs_objects_description
+ where object_id = :source_id}]
+set form_vars [export_form_vars source_id target pass]
+ad_return_template