Index: openacs-4/packages/cms/cms.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/cms.info,v diff -u -N -r1.15.2.2 -r1.15.2.3 --- openacs-4/packages/cms/cms.info 4 Oct 2005 22:17:26 -0000 1.15.2.2 +++ openacs-4/packages/cms/cms.info 31 Aug 2006 19:59:04 -0000 1.15.2.3 @@ -7,17 +7,17 @@ f f - - David Lutterkort - Karl Goldstein + Michael Steigman + Karl Goldstein + David Lutterkort A CMS implemented on top of the Content Repository - 2005-10-04 + 2006-08-31 OpenACS CMS is a full featured content management system implemented on top of the content repository which supports composite objects, dynamicly created attributes, publishing to the filesystem and categorization. CMS remains the best place to look to find examples of how the content repository should be used. - 0 + 1 - + @@ -27,6 +27,8 @@ + + Index: openacs-4/packages/cms/todo =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/todo,v diff -u -N -r1.7.2.4 -r1.7.2.5 --- openacs-4/packages/cms/todo 10 Jun 2005 22:32:42 -0000 1.7.2.4 +++ openacs-4/packages/cms/todo 31 Aug 2006 19:59:04 -0000 1.7.2.5 @@ -1,35 +1,134 @@ tasks ===== -top priority ------------- -names for templates (steal from xcms-ui, bcms) +can rename template folders? how? +root template/content folder procs returning correct info? +clean up www/modules/items/relate-items (convert old table/grid format to listbuilder ala perm-include from acs-subsite) +finish moving the content_method stuff to tcl api (then delete many of the xql files under types) + - [content::revision::delete], content method stuff using package_plsql broken? +make content_method stuff make sense (ok for now, if developer sets up the type information [content_method, mime_type] correctly?) +when you view a symlink in CMS should the path show up as the path of the linked item or the symlink (latter methinks)? +show symlinks to an item (extra tab, if they exist) or folder (where in UI?) +junk move/copy/symlink stuff in sitemap, revisions in items/templates +continue cleanup/removal of xql files add interface to allow admin to map subsite to cms instance - should copy index.vuh to /www/subsite and add entry to subsite_package_map -add track_publish_status, update_publish_status to CR, add param for sched interval - - yank plsql exec stuff there now and junk in cms +printer friendly template (steal from xcms-ui? add ad_page_contract to index.vuh with preview/printer-friendly option?) +new icon for "clipping" items - competing with new listbuilder checkboxes, confuses UI a bit +go through various listbuilder lists and remove "un-xxx" links in favor of bulk actions + unregister item templates - types/content methods & templates +redo tab files - just cycle through list of tabs to create the tab html? +floating clipboard working? +hide data model for users creating/editing items: + - for new items, if: + -> if has_text_mime_types_p, forward to create-2 with content_method=text_entry + -> if !has_text_mime_types_p & has_mime_types, forward with cm=file_upload + -> else, forward with cm=no_content + - for revisions, if: + -> if storage_type is text and content eq "", forward to revision-add-2 with content_method=no_content "Author new revision" + -> if storage_type is text and content ne "", forward to revision-add-2 with content_method=text_entry "Author new revision" + -> if storage_type is files, use content_method=file_upload "Upload new revision" -basic/cosmetic ---------- -add preview functionality (add ad_properties to index.vuh with preview/printer-friendly option?) -printer friendly template (steal from xcms-ui) -clean up www/modules/items/relate-items (remove old table format) -new icon for "clipping" items - competing with new listbuilder checkboxes, confuse UI a bit -fix "clear the clipboard" functionality -floatclipboard_p working? - plumbing -------- +dav for templates root +internationalization integrate categories and workflow packages fix search module (will try when i have tsearch2, ie upgrade to rhel4) -select from cm_modules to build tabs? questions/ideas --------- how do we get extlinks and other types (if any?) which do not sub-class content_revision into the system? comment integration? + +wf-notes +-------- + + states/roles/actions + ------------------- + +states + +- authored +- edited +- ready +- live +- expired + +roles + +- author +- editor +- publisher + +actions + +- request (initiated) +- author - cms::form::new_item (initiated) +- edit - cms::form::add_revision? +- approve/publish | reject +- comment + +[initiate] -> (initiated) + -> [author] -> (authored*) + -> [edit] -> (edited) + -> [publish] -> (ready*) ... (live) + -> (expired) + -> [revise] -> (authored) + -> [edit] -> (edited) + -> [reject] -> (authored*) + +* affects cr_items.publish_status + + lifecycles (see http://www.redhat.com/docs/manuals/cms/rhea-ag-cms-en-6.1/s1-concepts-lifecycles.html among other sites) + ------------------------ + +- simple (always live) +- expiring (content is deleted?) +- archiving? +- recurring +- migrating + +must define delay and duration, can have multiple phases (i.e., migrating) + - hidden during authoring phase + + UI and API + ----------------------- +tasks UI + - show directly assigned tasks (actions for which user is assigned) + - show all available tasks (actions user can accept) + - show tasks user has created (editable, for example to change content type or object) + - user can save changes without kicking workflow to next state (have separate option to pass on to...) + - allow editor or publisher to create new tasks + - new workflow with target user for author + - ability to select existing page as object or new items + - on item publishing tab, allow for kicking back to production state + - how to allow senior staff to request edits? (simple task overview based on object permissions?) + +api integration + - when adding new content, kick off new case execute [initiate] + - allow content creation from workspace + -> drop down for content type + -> populate second list for folders the type is registered to and writable + - new item api should accept workflow_id for when case has been initiated + - select widget - use which workflow? (if enabled... if not, then what?) + - when adding new task, kick off new case, executing [initiate] + - user will accept task and create new item or revision + -> api will update workflow with object_id once content is created + - when revising existing content, execute [initiate] on existing case + - manager can initiate update with target user (or default) + + random notes + ------------------------ +develop rss feed for workflow ala (http://www.cmswatch.com/Trends/453-Workflow-via-RSS/Atom)? + + + + + -- to drop old workflow from production: +-- ------------------------------------- drop function content_workflow__is_overdue (integer,varchar); drop function content_workflow__get_holding_user_name (integer); drop function content_workflow__get_first_place(); @@ -79,4 +178,4 @@ -- select acs_privilege__drop_privilege('cm_read'); -- select acs_privilege__drop_privilege('cm_item_workflow'); -- select acs_privilege__drop_privilege('cm_perm_admin'); --- select acs_privilege__drop_privilege('cm_perm'); \ No newline at end of file +-- select acs_privilege__drop_privilege('cm_perm'); Index: openacs-4/packages/cms/lib/ancestors-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/ancestors-oracle.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/ancestors-oracle.xql 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,80 @@ + + + + oracle8.1.6 + + + + + + decode( nvl( + content_folder.get_index_page( :item_id ),0) + ,0,'f','t') has_index_page, + + + + + + + + select + t.tree_level, t.parent_id, + content_folder.is_folder(i.item_id) is_folder, + content_item.get_title(t.parent_id) as title + from + cr_items i, + ( + select + parent_id, level as tree_level + from + cr_items + where + parent_id ^= 0 + connect by + prior parent_id = item_id + start with + item_id = :item_id + ) t + where + i.item_id = t.parent_id + order by + tree_level asc + + + + + + + + select + $index_page_sql + -- does it have a template + content_item.get_template( item_id, 'public' ) template_id, + -- symlinks to this folder will have the path of this item + content_item.get_virtual_path( item_id, :root_id ) virtual_path, + content_item.get_path( + content_symlink.resolve( item_id ), :root_id ) physical_path, + content_folder.is_folder( item_id ) is_folder, + live_revision + from + cr_items + where + item_id = :item_id + + + + + + + + select + content_item.get_template( + nvl( content_folder.get_index_page( :item_id ), 0), 'public' ) + from + dual + + + + + + Index: openacs-4/packages/cms/lib/ancestors-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/ancestors-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/ancestors-postgresql.xql 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,77 @@ + + + + postgresql7.1 + + + + + case when coalesce( + content_folder__get_index_page( :item_id ),0) = 0 then 'f' else 't' end as has_index_page, + + + + + + + + select + t.tree_level, t.parent_id, + content_folder__is_folder(i.item_id) as is_folder, + content_item__get_title(t.parent_id,'f') as title + from + cr_items i, + ( + select + i2.parent_id, tree_level(i2.tree_sortkey) as tree_level + from + (select * from cr_items where item_id = :item_id) i1, cr_items i2 + where + i2.parent_id != 0 + and + i1.tree_sortkey between i2.tree_sortkey and tree_right(i2.tree_sortkey) + ) t + where + i.item_id = t.parent_id and t.tree_level > 1 + order by + tree_level asc + + + + + + + + + select + $index_page_sql + -- does it have a template + content_item__get_template( item_id, 'public' ) as template_id, + -- symlinks to this folder will have the path of this item + content_item__get_virtual_path( item_id, :root_id ) as virtual_path, + content_item__get_path( + content_symlink__resolve( item_id ), :root_id ) as physical_path, + content_folder__is_folder( item_id ) as is_folder, + live_revision + from + cr_items + where + item_id = :item_id + + + + + + + + select + content_item__get_template( + coalesce( content_folder__get_index_page( :item_id ), 0), 'public' ) + from + dual + + + + + + Index: openacs-4/packages/cms/lib/ancestors.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/ancestors.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/ancestors.adp 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,27 @@ + Path:  + + + + + + + @context.title@ + + + + + @context.title@ + + + : + + + + @root_title@ + + + + + Index: openacs-4/packages/cms/lib/ancestors.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/ancestors.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/ancestors.tcl 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,97 @@ +# ancestors.tcl +# show ancestors with navigational links to view them +# shows path with possible link to 'preview' the item +# if the item is a sitemap folder and has an index item +# if the item is not a folder and is under the sitemap mount point + +request create -params { + item_id -datatype integer + mount_point -datatype keyword -value sitemap + index_page_id -datatype integer -optional +} + +set root_id [cm::modules::${mount_point}::getRootFolderID [ad_conn subsite_id]] +set root_title [item::get_title $root_id] + +# special case - when the item_id is null, set it to the root folder +if { [template::util::is_nil item_id] } { + set item_id $root_id +} + +# Get the cookie; prepare for setting bookmarks +#set clip [cms::clipboard::parse_cookie] + +# use the appropriate icon depending on whether the item is bookmarked or not +# sets this_item(bookmark) as the icon +#set bookmark [cms::clipboard::get_bookmark_icon $clip $mount_point $item_id] + +# get the context bar info +if { $root_id == $item_id } { + set context:rowcount 0 +} else { + db_multirow context get_context "" +} + +# pass in index_page_id to improve efficiency +if { ![template::util::is_nil index_page_id] } { + + set index_page_sql "" + set has_index_page t + +} else { + set index_page_sql [db_map index_page_p] +} + +# get the path of the item + +db_1row get_preview_info "" -column_array preview_info + +template::util::array_to_vars preview_info +# physical_path, virtual_path, is_folder, has_index_page + +if { [string equal $physical_path "../"] } { + set display_path "/" +} else { + if {[string equal [string index $physical_path 0] "/"]} { + set physical_path [string range $physical_path 1 end] + } + set display_path "/$physical_path" +} + +# preview_p - flag indicating whether the path is previewable or not +# t => if the item is a sitemap folder and has an index item +# t => if the item is not a folder and is under the sitemap mount point +set preview_p f +set preview_path $virtual_path + +# Determine the root of the preview link. If CMS is running as a package, +# the index.vuh file should be under this root. +if { [catch { + set root_path [ad_conn package_url] +} errmsg] } { + set root_path "" +} + +#set preview_path [ns_normalizepath "$root_path/$preview_path"] +set preview_path [ns_normalizepath "/acs-content-repository/$preview_path"] + +ns_log Notice "mount_point = $mount_point" +if { [string equal $mount_point sitemap] } { + ns_log Notice "is_folder = $is_folder, has_index_page = $has_index_page" + if { [string equal $is_folder t] && [string equal $has_index_page t] } { + set preview_p t + } elseif { ![string equal $is_folder t] && \ + ![template::util::is_nil live_revision] } { + set preview_p t + } +} +ns_log Notice "preview_p = $preview_p" +# an item cannot be previewed if it has no associated template +if { [string equal $has_index_page t] } { + set template_id [db_string get_template_id "" -default ""] +} + +if { [string equal $template_id ""] } { + set preview_p f +} + Index: openacs-4/packages/cms/lib/clip.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/clip.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/clip.adp 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,5 @@ + +  + +  + Index: openacs-4/packages/cms/lib/clip.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/clip.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/clip.tcl 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,10 @@ +# This is the template for a single bookmark icon +request create +request set_param mount_point -datatype keyword +request set_param id -datatype keyword + +set img_checked "[ad_conn package_url]resources/checked.gif" +set img_unchecked "[ad_conn package_url]resources/unchecked.gif" + +set package_url [ad_conn package_url] +set clipboardfloats_p [cms::clipboard::ui::floats_p] Index: openacs-4/packages/cms/lib/folder-items.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/folder-items.tcl,v diff -u -N -r1.1.2.3 -r1.1.2.4 --- openacs-4/packages/cms/lib/folder-items.tcl 31 May 2005 05:04:14 -0000 1.1.2.3 +++ openacs-4/packages/cms/lib/folder-items.tcl 31 Aug 2006 19:59:04 -0000 1.1.2.4 @@ -62,10 +62,10 @@ } if { ![ template::util::is_nil content_length ] } { - set file_size [lc_numeric [expr $content_length / 1000.00] "%.2f"] + set file_size "[lc_numeric [expr $content_length / 1000.00] "%.2f"] Kb" } else { set file_size "-" } - set copy [clipboard::ui::render_bookmark $mount_point $item_id [ad_conn package_url]] + set copy [cms::clipboard::ui::render_bookmark $mount_point $item_id [ad_conn package_url]] } Index: openacs-4/packages/cms/lib/revisions.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/revisions.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/revisions.adp 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,3 @@ +
Revision History
+

+ Index: openacs-4/packages/cms/lib/revisions.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/revisions.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/revisions.tcl 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,93 @@ +set action delete +set template_id $item_id +set return_url [ad_return_url] + +template::list::create \ + -name revisions \ + -multirow revisions \ + -key revision_id \ + -bulk_actions [list "Delete Revisions" \ + ../items/revision-handler \ + "Delete checked revisions"] \ + -bulk_action_export_vars { item_id mount_point action return_url } \ + -elements { + revision_number { + label "\#" + } + title { + label "Title" + } + description { + label "Description" + } + pretty_date { + label "Modification Date" + } + author { + label "Author" + } + file_size { + label "Size" + } + status { + label "Status" + } + options { + display_template { + View + Revise + Publish + } + } + } + +set live_revision [content::item::get_live_revision -item_id $item_id] +set content_type [content::item::get_content_type -item_id $item_id] +if { $content_type eq "content_template" } { + set revise_url_base template-ae +} else { + set revise_url_base revision-add-2 +} + +db_multirow -extend { + pretty_date + view_url + revise_url + publish_url + revision_number + file_size + status + author + options +} revisions get_revisions {} { + set title [string_truncate -len 30 $title] + if {[template::util::is_nil description]} { + set description "-" + } else { + set description [string_truncate -len 40 $description] + } + if { ![ template::util::is_nil content_length ] } { + set file_size "[lc_numeric [expr $content_length / 1000.00] "%.2f"] Kb" + } else { + set file_size "-" + } + if { $revision_id == $live_revision } { + set status "Live" + } + if { ![ template::util::is_nil author_id ] } { + set author [person::name -person_id $author_id] + } else { + set author "-" + } + + set revision_number [content::revision::get_number -revision_id $revision_id] + set pretty_date [lc_time_fmt $publish_date "%q %X"] + set revise_url [export_vars -base $revise_url_base {item_id template_id revision_id mount_point content_method return_url}] + set publish_url [export_vars -base publish { item_id revision_id return_url }] + set action view + set view_url [export_vars -base ../items/revision-handler {item_id revision_id mount_point action return_url}] + +} + +# sort by revision_number, not date +template::multirow sort revisions -decreasing revision_number Index: openacs-4/packages/cms/lib/revisions.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/lib/Attic/revisions.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/lib/revisions.xql 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,24 @@ + + + + + + + + select + revision_id, + r.title, + description, + content_length, + publish_date, + coalesce(o.modifying_user,o.creation_user) as author_id + from + cr_revisions r join acs_objects o on (r.revision_id = o.object_id) + where + r.item_id = :item_id + + + + + + Index: openacs-4/packages/cms/sql/postgresql/cms-content-methods.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/sql/postgresql/cms-content-methods.sql,v diff -u -N -r1.5 -r1.5.8.1 --- openacs-4/packages/cms/sql/postgresql/cms-content-methods.sql 17 May 2003 10:22:35 -0000 1.5 +++ openacs-4/packages/cms/sql/postgresql/cms-content-methods.sql 31 Aug 2006 19:59:04 -0000 1.5.8.1 @@ -125,6 +125,7 @@ -- create or replace package body content_method as -- function get_method +select define_function_args('content_method__get_method','content_type'); create or replace function content_method__get_method (varchar) returns varchar as ' declare @@ -173,6 +174,7 @@ -- function is_mapped +select define_function_args('content_method__is_mapped','content_type,content_method'); create or replace function content_method__is_mapped (varchar,varchar) returns boolean as ' declare @@ -193,6 +195,7 @@ -- procedure add_method +select define_function_args('content_method__add_method','content_type,content_method,is_default'); create or replace function content_method__add_method (varchar,varchar,boolean) returns integer as ' declare @@ -234,6 +237,7 @@ -- procedure add_all_methods +select define_function_args('content_method__add_all_methods','content_type'); create or replace function content_method__add_all_methods (varchar) returns integer as ' declare @@ -262,6 +266,7 @@ -- procedure set_default_method +select define_function_args('content_method__set_default_method','content_type,content_method'); create or replace function content_method__set_default_method (varchar,varchar) returns integer as ' declare @@ -284,6 +289,7 @@ -- procedure unset_default_method +select define_function_args('content_method__unset_default_method','content_type'); create or replace function content_method__unset_default_method (varchar) returns integer as ' declare @@ -299,6 +305,7 @@ -- procedure remove_method +select define_function_args('content_method__remove_method','content_type,content_method'); create or replace function content_method__remove_method (varchar,varchar) returns integer as ' declare Index: openacs-4/packages/cms/sql/postgresql/upgrade/upgrade-5.0d-5.1d.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/sql/postgresql/upgrade/upgrade-5.0d-5.1d.sql,v diff -u -N -r1.1.2.2 -r1.1.2.3 --- openacs-4/packages/cms/sql/postgresql/upgrade/upgrade-5.0d-5.1d.sql 4 Oct 2005 22:16:49 -0000 1.1.2.2 +++ openacs-4/packages/cms/sql/postgresql/upgrade/upgrade-5.0d-5.1d.sql 31 Aug 2006 19:59:04 -0000 1.1.2.3 @@ -51,3 +51,11 @@ return v_module_id; end;' language 'plpgsql'; + +select define_function_args('content_method__set_default_method','content_type,content_method'); +select define_function_args('content_method__unset_default_method','content_type'); +select define_function_args('content_method__remove_method','content_type,content_method'); +select define_function_args('content_method__add_all_methods','content_type'); +select define_function_args('content_method__add_method','content_type,content_method,is_default'); +select define_function_args('content_method__is_mapped','content_type,content_method'); +select define_function_args('content_method__get_method','content_type'); \ No newline at end of file Index: openacs-4/packages/cms/tcl/browser-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/browser-procs.tcl,v diff -u -N -r1.3 -r1.3.8.1 --- openacs-4/packages/cms/tcl/browser-procs.tcl 1 Nov 2003 08:45:38 -0000 1.3 +++ openacs-4/packages/cms/tcl/browser-procs.tcl 31 Aug 2006 19:59:04 -0000 1.3.8.1 @@ -1,622 +1,623 @@ -################################################ -# -# Procedures responsible for maintaining and updating the browser state. -# -# The browser state is saved as a tree, where each node in format -# {id list_of_child_nodes } -# The ids for top-level nodes are mount point keys. -# -# All other information is cashed in the nsv shared memory, in format -# { mount_point pretty_name folder_id children_ids expandable symlink update_time } -# children_ids is a list of the ids of this folder's children. -# -# In order to build the tree, the state is traversed in the depth-first order, -# and each folder id is mapped to the appropriate folder in the cache, which contains -# all the presentation information neccessary to display it on the tree. -# -################################################# +ad_library { -ad_proc -public initFolderTree { user_id } { + Procedures responsible for maintaining and updating the browser state. +

+ MS 04/06: not used anymore but still potentially interesting to look at +

+ The browser state is saved as a tree, where each node in format + {id list_of_child_nodes } + The ids for top-level nodes are mount point keys. +

+ All other information is cashed in the nsv shared memory, in format + { mount_point pretty_name folder_id children_ids expandable symlink update_time } + children_ids is a list of the ids of this folder's children. +

+ In order to build the tree, the state is traversed in the depth-first order, + and each folder id is mapped to the appropriate folder in the cache, which contains + all the presentation information neccessary to display it on the tree. + +} +# ad_proc -public initFolderTree { user_id } { - Initialize the workspace for the first time, - by building a state consisting only of the top-level mount points - Return the state +# Initialize the workspace for the first time, +# by building a state consisting only of the top-level mount points +# Return the state -} { +# } { - set state [list] - foreach mount_point [buildMountPoints $user_id] { - lappend state [stateNodeCreate [folderAccess mount_point $mount_point] [list]] - } - return $state +# set state [list] +# foreach mount_point [buildMountPoints $user_id] { +# lappend state [stateNodeCreate [folderAccess mount_point $mount_point] [list]] +# } +# return $state -} +# } -ad_proc -public updateTreeStateChildren { - user_id children - mount_point target_mount_point target_id - action level stateRef update_time payload -} { +# ad_proc -public updateTreeStateChildren { +# user_id children +# mount_point target_mount_point target_id +# action level stateRef update_time payload +# } { - Recursively rebuild the tree state based on the requested expand or collapse - action. Rebuild the children of each folder and return them - Payload is any extra data that needs to be passed in +# Recursively rebuild the tree state based on the requested expand or collapse +# action. Rebuild the children of each folder and return them +# Payload is any extra data that needs to be passed in -} { +# } { - set new_children [list] - upvar $stateRef state +# set new_children [list] +# upvar $stateRef state - foreach child $children { +# foreach child $children { - # If we are at the top level, retreive the mount point. - # Otherwise, retreive the folder id and use the passed in mount point - if { $level == 0 } { - set child_id "" - set mount_point [stateNodeAccess id $child] - set new_id $mount_point - } else { - set child_id [stateNodeAccess id $child] - set new_id $child_id - } +# # If we are at the top level, retreive the mount point. +# # Otherwise, retreive the folder id and use the passed in mount point +# if { $level == 0 } { +# set child_id "" +# set mount_point [stateNodeAccess id $child] +# set new_id $mount_point +# } else { +# set child_id [stateNodeAccess id $child] +# set new_id $child_id +# } - set child_children [stateNodeAccess children $child] +# set child_children [stateNodeAccess children $child] - # Set up the flags that determine what we do later on +# # Set up the flags that determine what we do later on - # Do we need to recache the folder ? - set folder_exists 1 - # Do we need to merge in new children ? - set use_new_children 0 - # Do we get the new children from the database ? - set get_db_children 1 +# # Do we need to recache the folder ? +# set folder_exists 1 +# # Do we need to merge in new children ? +# set use_new_children 0 +# # Do we get the new children from the database ? +# set get_db_children 1 - set the_folder [getFolder $user_id $mount_point $child_id state] - set folder_children [folderAccess children $the_folder] +# set the_folder [getFolder $user_id $mount_point $child_id state] +# set folder_children [folderAccess children $the_folder] - # If the folder in the db is newer than the update, retreive it from the db - if { [folderAccess update_time $the_folder] > $update_time } { - set folder_exists 0 - set use_new_children 1 - } +# # If the folder in the db is newer than the update, retreive it from the db +# if { [folderAccess update_time $the_folder] > $update_time } { +# set folder_exists 0 +# set use_new_children 1 +# } - # Perform the action if we found the target - if { [string equal $mount_point $target_mount_point] && - ([string equal $child_id $target_id] || \ - [string equal $target_id _all_]) } { - switch $action { +# # Perform the action if we found the target +# if { [string equal $mount_point $target_mount_point] && +# ([string equal $child_id $target_id] || \ +# [string equal $target_id _all_]) } { +# switch $action { - collapse { - # Collapse: empty the children list - ns_log debug "updateTreeStateChildren: COLLAPSING: [folderPath $user_id $mount_point $target_id]" - set child_children [list] - } +# collapse { +# # Collapse: empty the children list +# ns_log debug "updateTreeStateChildren: COLLAPSING: [folderPath $user_id $mount_point $target_id]" +# set child_children [list] +# } - expand { +# expand { - # Expand: fetch the new children list, unless the node is already expanded - if { [llength $child_children] == 0 } { +# # Expand: fetch the new children list, unless the node is already expanded +# if { [llength $child_children] == 0 } { - # Prevent infinite recursion: clear the target - set target_id "" - set target_mount_point "" +# # Prevent infinite recursion: clear the target +# set target_id "" +# set target_mount_point "" - ns_log debug "updateTreeStateChildren: EXPANDING: [folderPath $user_id $mount_point $target_id]" +# ns_log debug "updateTreeStateChildren: EXPANDING: [folderPath $user_id $mount_point $target_id]" - # If the list is empty, retreive children from the database and recache the folder later - if { [llength [folderAccess children $the_folder]] == 0 } { - set folder_exists 0 - } - } else { - # If the folder is expanded, and we are trying to expand it again, - # reload the folder just to make sure - set folder_exists 0 - } - set use_new_children 1 - } +# # If the list is empty, retreive children from the database and recache the folder later +# if { [llength [folderAccess children $the_folder]] == 0 } { +# set folder_exists 0 +# } +# } else { +# # If the folder is expanded, and we are trying to expand it again, +# # reload the folder just to make sure +# set folder_exists 0 +# } +# set use_new_children 1 +# } - reload { - # Reload the folder if it has changed in the db - ns_log debug "updateTreeStateChildren: RELOADING: [folderPath $user_id $mount_point $target_id]" - set folder_exists 0 - set use_new_children 1 - } +# reload { +# # Reload the folder if it has changed in the db +# ns_log debug "updateTreeStateChildren: RELOADING: [folderPath $user_id $mount_point $target_id]" +# set folder_exists 0 +# set use_new_children 1 +# } - set_children { - # Manually set the children of a folder - ns_log debug "updateTreeStateChildren: SYNCHRONIZING: [folderPath $user_id $mount_point $target_id]" - set folder_children $payload - set folder_exists 0 - set use_new_children 1 - set get_db_children 0 - } - } - } +# set_children { +# # Manually set the children of a folder +# ns_log debug "updateTreeStateChildren: SYNCHRONIZING: [folderPath $user_id $mount_point $target_id]" +# set folder_children $payload +# set folder_exists 0 +# set use_new_children 1 +# set get_db_children 0 +# } +# } +# } - # Cache the new list of children for the folder if it was updated on the server - if { !$folder_exists } { +# # Cache the new list of children for the folder if it was updated on the server +# if { !$folder_exists } { - # Hit the database for the new children - if { $get_db_children } { - set folder_children [folderChildIDs \ - [folderAccess db_children $the_folder $user_id] $user_id] - } +# # Hit the database for the new children +# if { $get_db_children } { +# set folder_children [folderChildIDs \ +# [folderAccess db_children $the_folder $user_id] $user_id] +# } - # Figure out if the folder is expandable now - if { [llength $folder_children] > 0 } { - set expandable "t" - } else { - set expandable "f" - } +# # Figure out if the folder is expandable now +# if { [llength $folder_children] > 0 } { +# set expandable "t" +# } else { +# set expandable "f" +# } - # Update the cache - set the_folder [folderMutate children $the_folder $folder_children] - set the_folder [folderMutate expandable $the_folder $expandable] - cacheOneFolder $user_id $the_folder 1 +# # Update the cache +# set the_folder [folderMutate children $the_folder $folder_children] +# set the_folder [folderMutate expandable $the_folder $expandable] +# cacheOneFolder $user_id $the_folder 1 - # Use the new children if the folder is already expanded - if { [llength $child_children] > 0 } { - set use_new_children 1 - } +# # Use the new children if the folder is already expanded +# if { [llength $child_children] > 0 } { +# set use_new_children 1 +# } - } +# } - # Merge the children in the state with the children in the folder, if - # neccessary. This ensures that, if a folder was already expanded, along - # with its subfloders, their expanded status is preserved - if { $use_new_children } { +# # Merge the children in the state with the children in the folder, if +# # neccessary. This ensures that, if a folder was already expanded, along +# # with its subfloders, their expanded status is preserved +# if { $use_new_children } { - # Stuff all the children into a hashtable for easier searching - foreach old_child $child_children { - set hash([stateNodeAccess id $old_child]) $old_child - } +# # Stuff all the children into a hashtable for easier searching +# foreach old_child $child_children { +# set hash([stateNodeAccess id $old_child]) $old_child +# } - # Merge the new children, preserving the sorted order - set child_children [list] - foreach new_child $folder_children { - set old_child_id [stateNodeAccess id $new_child] - # If the old child exists, use it instead of the new one - if { ![info exists hash($old_child_id)] } { - lappend child_children $new_child - } else { - lappend child_children $hash($old_child_id) - } - } - } +# # Merge the new children, preserving the sorted order +# set child_children [list] +# foreach new_child $folder_children { +# set old_child_id [stateNodeAccess id $new_child] +# # If the old child exists, use it instead of the new one +# if { ![info exists hash($old_child_id)] } { +# lappend child_children $new_child +# } else { +# lappend child_children $hash($old_child_id) +# } +# } +# } - # recursively evaluate the children's children - if { [llength $child_children] > 0 } { - set sub_children [updateTreeStateChildren $user_id $child_children \ - $mount_point $target_mount_point $target_id $action \ - [expr $level + 1] state $update_time $payload] - lappend new_children [stateNodeCreate $new_id $sub_children] - } else { - lappend new_children [stateNodeCreate $new_id [list]] - } - } +# # recursively evaluate the children's children +# if { [llength $child_children] > 0 } { +# set sub_children [updateTreeStateChildren $user_id $child_children \ +# $mount_point $target_mount_point $target_id $action \ +# [expr $level + 1] state $update_time $payload] +# lappend new_children [stateNodeCreate $new_id $sub_children] +# } else { +# lappend new_children [stateNodeCreate $new_id [list]] +# } +# } - return $new_children +# return $new_children -} +# } -ad_proc -public updateTreeState { - user_id state target_mount_point - target_id action update_time {payload ""} -} { +# ad_proc -public updateTreeState { +# user_id state target_mount_point +# target_id action update_time {payload ""} +# } { - Rebuild the tree state based on user's action and return the new state +# Rebuild the tree state based on user's action and return the new state -} { - return [updateTreeStateChildren $user_id $state "" $target_mount_point \ - $target_id $action 0 state $update_time $payload] -} +# } { +# return [updateTreeStateChildren $user_id $state "" $target_mount_point \ +# $target_id $action 0 state $update_time $payload] +# } -ad_proc -public fetchStateFolders { user_id stateRef } { +# ad_proc -public fetchStateFolders { user_id stateRef } { - Get a linear rendition of the folder tree suitable for presentation +# Get a linear rendition of the folder tree suitable for presentation -} { +# } { - # Reference the state - upvar $stateRef state +# # Reference the state +# upvar $stateRef state - set folderList [list] +# set folderList [list] - foreach node $state { +# foreach node $state { - set mount_point [stateNodeAccess id $node] - set mount_children [stateNodeAccess children $node] +# set mount_point [stateNodeAccess id $node] +# set mount_children [stateNodeAccess children $node] - # Fetch the information for the mount point itself - set mount_folder [getFolder $user_id $mount_point "" stateRef] - lappend mount_folder 0 - lappend mount_folder [llength $mount_children] - lappend mount_folder "" - lappend folderList $mount_folder +# # Fetch the information for the mount point itself +# set mount_folder [getFolder $user_id $mount_point "" stateRef] +# lappend mount_folder 0 +# lappend mount_folder [llength $mount_children] +# lappend mount_folder "" +# lappend folderList $mount_folder - # Fetch all the children of the mount point - fetchStateChildFolders $user_id $mount_point $mount_children folderList state 1 "" +# # Fetch all the children of the mount point +# fetchStateChildFolders $user_id $mount_point $mount_children folderList state 1 "" - } +# } - return $folderList -} +# return $folderList +# } -ad_proc -public fetchStateChildFolders { user_id mount_point children folderListRef stateRef level parent_id } { +# ad_proc -public fetchStateChildFolders { user_id mount_point children folderListRef stateRef level parent_id } { - Recursive procedure to fetch a folder's children and add them to the linear - list of folders +# Recursive procedure to fetch a folder's children and add them to the linear +# list of folders -} { +# } { - # access the growing folder list by reference - upvar $folderListRef folderList - upvar $stateRef state +# # access the growing folder list by reference +# upvar $folderListRef folderList +# upvar $stateRef state - # increment the level for the children of each folder - set nextLevel [expr $level + 1] +# # increment the level for the children of each folder +# set nextLevel [expr $level + 1] - foreach node $children { +# foreach node $children { - set node_id [stateNodeAccess id $node] - set node_children [stateNodeAccess children $node] +# set node_id [stateNodeAccess id $node] +# set node_children [stateNodeAccess children $node] - # Fetch the folder - set folder [getFolder $user_id $mount_point $node_id state] +# # Fetch the folder +# set folder [getFolder $user_id $mount_point $node_id state] - # set the folder level for proper indenting - lappend folder $level +# # set the folder level for proper indenting +# lappend folder $level - # set the number of children in this folder - lappend folder [llength $node_children] +# # set the number of children in this folder +# lappend folder [llength $node_children] - # Set the parent id of this folder - lappend folder $parent_id +# # Set the parent id of this folder +# lappend folder $parent_id - # add the folder itself - lappend folderList $folder +# # add the folder itself +# lappend folderList $folder - # add child folders - fetchStateChildFolders $user_id $mount_point $node_children folderList state $nextLevel $node_id - } -} +# # add child folders +# fetchStateChildFolders $user_id $mount_point $node_children folderList state $nextLevel $node_id +# } +# } -ad_proc -public folderPath { user_id mount_point folder_id } { +# ad_proc -public folderPath { user_id mount_point folder_id } { - Retreive a "path" to the particular folder - in fact, this is a unique hash - key used to reference the folder in the AOLServer cache +# Retreive a "path" to the particular folder - in fact, this is a unique hash +# key used to reference the folder in the AOLServer cache -} { - return "${user_id}.${mount_point}.$folder_id" -} +# } { +# return "${user_id}.${mount_point}.$folder_id" +# } -ad_proc -public folderChildrenDB { mount_point folder_id } { +# ad_proc -public folderChildrenDB { mount_point folder_id } { - Hit the database to retreive the list of children for the folder - Recache the child folders if specified +# Hit the database to retreive the list of children for the folder +# Recache the child folders if specified -} { - ns_log debug "folderChildrenDB: DATABASE HIT: $mount_point.$folder_id" - return [cm::modules::${mount_point}::getChildFolders $folder_id] -} +# } { +# ns_log debug "folderChildrenDB: DATABASE HIT: $mount_point.$folder_id" +# return [cm::modules::${mount_point}::getChildFolders $folder_id] +# } -ad_proc -public folderCreate { - mount_point name id child_ids - expandable {symlink f} {update_time 0}} { +# ad_proc -public folderCreate { +# mount_point name id child_ids +# expandable {symlink f} {update_time 0}} { - A constructtor procedure to implement the folder abstraction +# A constructtor procedure to implement the folder abstraction - } { - return [list $mount_point $name $id $child_ids $expandable $symlink $update_time] -} +# } { +# return [list $mount_point $name $id $child_ids $expandable $symlink $update_time] +# } -ad_proc -public folderAccess { op folder {user_id {}} } { +# ad_proc -public folderAccess { op folder {user_id {}} } { - An accessor procedure to implement the folder abstraction +# An accessor procedure to implement the folder abstraction -} { +# } { - switch $op { - mount_point { return [lindex $folder 0] } - name { return [lindex $folder 1] } - id { return [lindex $folder 2] } - children { return [lindex $folder 3] } - expandable { return [lindex $folder 4] } - symlink { return [lindex $folder 5] } - update_time { return [lindex $folder 6] } - level { return [lindex $folder 7] } - child_count { return [lindex $folder 8] } - parent_id { return [lindex $folder 9] } - path { - return [folderPath $user_id [lindex $folder 0] [lindex $folder 2]] - } - db_children { return [folderChildrenDB [lindex $folder 0] [lindex $folder 2]] } - default { - error "Unknown folder attribute \"$op\" in folderAccess" - } - } -} +# switch $op { +# mount_point { return [lindex $folder 0] } +# name { return [lindex $folder 1] } +# id { return [lindex $folder 2] } +# children { return [lindex $folder 3] } +# expandable { return [lindex $folder 4] } +# symlink { return [lindex $folder 5] } +# update_time { return [lindex $folder 6] } +# level { return [lindex $folder 7] } +# child_count { return [lindex $folder 8] } +# parent_id { return [lindex $folder 9] } +# path { +# return [folderPath $user_id [lindex $folder 0] [lindex $folder 2]] +# } +# db_children { return [folderChildrenDB [lindex $folder 0] [lindex $folder 2]] } +# default { +# error "Unknown folder attribute \"$op\" in folderAccess" +# } +# } +# } -ad_proc -public folderMutate { op folder new_value } { +# ad_proc -public folderMutate { op folder new_value } { - A "mutator" procedure for folders; actually, just returns the new folder +# A "mutator" procedure for folders; actually, just returns the new folder -} { +# } { - switch $op { - mount_point { return [lreplace $folder 0 0 $new_value] } - name { return [lreplace $folder 1 1 $new_value] } - id { return [lreplace $folder 2 2 $new_value] } - children { return [lreplace $folder 3 3 $new_value] } - expandable { return [lreplace $folder 4 4 $new_value] } - symlink { return [lreplace $folder 5 5 $new_value] } - update_time { return [lreplace $folder 6 6 $new_value] } - default { - error "Unknown folder attribute \"$op\" in folderMutate" - } - } -} +# switch $op { +# mount_point { return [lreplace $folder 0 0 $new_value] } +# name { return [lreplace $folder 1 1 $new_value] } +# id { return [lreplace $folder 2 2 $new_value] } +# children { return [lreplace $folder 3 3 $new_value] } +# expandable { return [lreplace $folder 4 4 $new_value] } +# symlink { return [lreplace $folder 5 5 $new_value] } +# update_time { return [lreplace $folder 6 6 $new_value] } +# default { +# error "Unknown folder attribute \"$op\" in folderMutate" +# } +# } +# } -ad_proc -public folderChildIDs { subfolder_list { user_id {}}} { +# ad_proc -public folderChildIDs { subfolder_list { user_id {}}} { - Convert a list of folders into a list of folder IDs, caching - the folders in the process +# Convert a list of folders into a list of folder IDs, caching +# the folders in the process -} { - set child_ids [list] - foreach subfolder $subfolder_list { - if { ![template::util::is_nil user_id] } { - cacheOneFolder $user_id $subfolder 1 - } - lappend child_ids [stateNodeCreate [folderAccess id $subfolder] [list]] - } +# } { +# set child_ids [list] +# foreach subfolder $subfolder_list { +# if { ![template::util::is_nil user_id] } { +# cacheOneFolder $user_id $subfolder 1 +# } +# lappend child_ids [stateNodeCreate [folderAccess id $subfolder] [list]] +# } - return $child_ids -} +# return $child_ids +# } -ad_proc -public stateNodeCreate { id children {selected ""}} { +# ad_proc -public stateNodeCreate { id children {selected ""}} { - A constructor procedure to implement the state node abstraction +# A constructor procedure to implement the state node abstraction -} { +# } { - set ret [list $id $children] +# set ret [list $id $children] - # Only append the "selected" field if neccessary - if { [string equal $selected "t"] } { - lappend ret "t" - } +# # Only append the "selected" field if neccessary +# if { [string equal $selected "t"] } { +# lappend ret "t" +# } - return $ret -} +# return $ret +# } -ad_proc -public stateNodeAccess { op node } { +# ad_proc -public stateNodeAccess { op node } { - An accessor procedure to implement the state node abstraction +# An accessor procedure to implement the state node abstraction -} { - switch $op { - id { return [lindex $node 0] } - children { return [lindex $node 1] } - selected { return [lindex $node 2] } - } -} +# } { +# switch $op { +# id { return [lindex $node 0] } +# children { return [lindex $node 1] } +# selected { return [lindex $node 2] } +# } +# } -ad_proc -public getFolder { user_id mount_point folder_id stateRef } { +# ad_proc -public getFolder { user_id mount_point folder_id stateRef } { - Retreive folder information for a particular id. If that id does not exist - in the cache, cache it. if id is the empty string, retreives the top-level - mount point +# Retreive folder information for a particular id. If that id does not exist +# in the cache, cache it. if id is the empty string, retreives the top-level +# mount point -} { +# } { - set folder_path [folderPath $user_id $mount_point $folder_id] +# set folder_path [folderPath $user_id $mount_point $folder_id] - if { ![folderIsCached $user_id $mount_point $folder_id] } { - ns_log debug "getFolder: CACHE MISS: $folder_path" +# if { ![folderIsCached $user_id $mount_point $folder_id] } { +# ns_log debug "getFolder: CACHE MISS: $folder_path" - # Traverse the state to determine the path to the current folder, caching all the folders - # on the path - upvar $stateRef state - cacheStateFolders $user_id $mount_point $folder_id state +# # Traverse the state to determine the path to the current folder, caching all the folders +# # on the path +# upvar $stateRef state +# cacheStateFolders $user_id $mount_point $folder_id state - # Most of the time, the above code will cache the correct folders. However, very rarely, - # the correct parent folder will not exist in the state. For example, this will happen - # if the server is restarted after a folder deep in the hierarchy was put on the clipboard. - # Now, we have no choice but to go through all the folders along with their children. - # This might do redundant work, but it should be able to cache the correct folder. +# # Most of the time, the above code will cache the correct folders. However, very rarely, +# # the correct parent folder will not exist in the state. For example, this will happen +# # if the server is restarted after a folder deep in the hierarchy was put on the clipboard. +# # Now, we have no choice but to go through all the folders along with their children. +# # This might do redundant work, but it should be able to cache the correct folder. - # Cache the mount point itself, along with it peers - buildMountPoints $user_id +# # Cache the mount point itself, along with it peers +# buildMountPoints $user_id - if { ![folderIsCached $user_id $mount_point $folder_id] } { - cacheMountPointFolders $user_id $mount_point $folder_id - } +# if { ![folderIsCached $user_id $mount_point $folder_id] } { +# cacheMountPointFolders $user_id $mount_point $folder_id +# } - # Now, if THAT failed, then the folder was probably deleted... Give up - if { ![folderIsCached $user_id $mount_point $folder_id] } { - ns_log debug "getFolder: CACHE FAILED for: [folderPath $user_id $mount_point $folder_id]" - return [list] - } - } +# # Now, if THAT failed, then the folder was probably deleted... Give up +# if { ![folderIsCached $user_id $mount_point $folder_id] } { +# ns_log debug "getFolder: CACHE FAILED for: [folderPath $user_id $mount_point $folder_id]" +# return [list] +# } +# } - return [nsv_get browser_state $folder_path] -} +# return [nsv_get browser_state $folder_path] +# } -ad_proc -public buildMountPoints { user_id } { +# ad_proc -public buildMountPoints { user_id } { - Build a list of all the top-level mount points, caching them in the process +# Build a list of all the top-level mount points, caching them in the process -} { +# } { - set mount_point_list [cm::modules::getMountPoints] +# set mount_point_list [cm::modules::getMountPoints] - # Cache the mount points - foreach mount_folder $mount_point_list { - if { ![folderIsCached $user_id [folderAccess mount_point $mount_folder] ""] } { - set child_ids [folderChildIDs \ - [folderAccess db_children $mount_folder] \ - $user_id ] - cacheOneFolder $user_id [folderMutate children $mount_folder $child_ids] - } - } +# # Cache the mount points +# foreach mount_folder $mount_point_list { +# if { ![folderIsCached $user_id [folderAccess mount_point $mount_folder] ""] } { +# set child_ids [folderChildIDs \ +# [folderAccess db_children $mount_folder] \ +# $user_id ] +# cacheOneFolder $user_id [folderMutate children $mount_folder $child_ids] +# } +# } - return $mount_point_list -} +# return $mount_point_list +# } -ad_proc -public cacheOneFolder { user_id folder { override 0 }} { +# ad_proc -public cacheOneFolder { user_id folder { override 0 }} { - Cache an individual folder +# Cache an individual folder -} { - set path [folderAccess path $folder $user_id] - if { $override || ![nsv_exists browser_state $path] } { - ns_log debug "cacheOneFolder: CACHING: $path $folder , override = $override" - nsv_set browser_state $path $folder - } -} +# } { +# set path [folderAccess path $folder $user_id] +# if { $override || ![nsv_exists browser_state $path] } { +# ns_log debug "cacheOneFolder: CACHING: $path $folder , override = $override" +# nsv_set browser_state $path $folder +# } +# } -ad_proc -public refreshCachedFolder { user_id mount_point folder_id } { +# ad_proc -public refreshCachedFolder { user_id mount_point folder_id } { - Change the cached update time in a folder - If thr folder is not cached, do nothing +# Change the cached update time in a folder +# If thr folder is not cached, do nothing -} { +# } { - if { [folderIsCached $user_id $mount_point $folder_id] } { - cacheOneFolder $user_id [folderMutate update_time \ - [getFolder $user_id $mount_point $folder_id ""] \ - [clock seconds]] 1 - } -} +# if { [folderIsCached $user_id $mount_point $folder_id] } { +# cacheOneFolder $user_id [folderMutate update_time \ +# [getFolder $user_id $mount_point $folder_id ""] \ +# [clock seconds]] 1 +# } +# } -ad_proc -public folderIsCached { user_id mount_point folder_id } { +# ad_proc -public folderIsCached { user_id mount_point folder_id } { - Return 1 if the folder is in the cache, 0 otherwise +# Return 1 if the folder is in the cache, 0 otherwise -} { - return [nsv_exists browser_state [folderPath $user_id $mount_point $folder_id]] -} +# } { +# return [nsv_exists browser_state [folderPath $user_id $mount_point $folder_id]] +# } -ad_proc -public uncacheFolder { user_id mount_point folder_id } { +# ad_proc -public uncacheFolder { user_id mount_point folder_id } { - Uncache a folder so that it will be reloaded from the db +# Uncache a folder so that it will be reloaded from the db -} { - set path [folderPath $user_id $mount_point $folder_id] - # Catch in case the cached state does not exist (which could happen if - # the server was restarted) - catch " nsv_unset browser_state $path " dummy -} +# } { +# set path [folderPath $user_id $mount_point $folder_id] +# # Catch in case the cached state does not exist (which could happen if +# # the server was restarted) +# catch " nsv_unset browser_state $path " dummy +# } -ad_proc -public getStateFolderPath { user_id folder_id children target_folder_id } { +# ad_proc -public getStateFolderPath { user_id folder_id children target_folder_id } { - Recursively traverse the path to some folder in a particular mount - point, which is in the form - mount_point_id parent_id_1 parent_id_2 ... folder_id - Return the new path if the folder was found, an empty string otherwise +# Recursively traverse the path to some folder in a particular mount +# point, which is in the form +# mount_point_id parent_id_1 parent_id_2 ... folder_id +# Return the new path if the folder was found, an empty string otherwise -} { +# } { - # if the folder is found, return it as the last element of the path - if { [string equal $folder_id $target_folder_id] } { - return [list $folder_id] - } +# # if the folder is found, return it as the last element of the path +# if { [string equal $folder_id $target_folder_id] } { +# return [list $folder_id] +# } - foreach child $children { - set child_id [stateNodeAccess id $child] - set child_children [stateNodeAccess children $child] - set new_path [getStateFolderPath $user_id $child_id $child_children $target_folder_id] - if { ![template::util::is_nil new_path] } { - return [concat [list $folder_id] $new_path] - } - } +# foreach child $children { +# set child_id [stateNodeAccess id $child] +# set child_children [stateNodeAccess children $child] +# set new_path [getStateFolderPath $user_id $child_id $child_children $target_folder_id] +# if { ![template::util::is_nil new_path] } { +# return [concat [list $folder_id] $new_path] +# } +# } - return "" -} +# return "" +# } -ad_proc -public cacheStateFolders { user_id target_mount_point target_folder_id stateRef } { +# ad_proc -public cacheStateFolders { user_id target_mount_point target_folder_id stateRef } { - Traverse the state tree to discover the path to a particular folder. Then, - cache all the folders on the path +# Traverse the state tree to discover the path to a particular folder. Then, +# cache all the folders on the path -} { +# } { - upvar $stateRef state +# upvar $stateRef state - # Find the mount point - foreach mount_point $state { +# # Find the mount point +# foreach mount_point $state { - if { [string equal [stateNodeAccess id $mount_point] $target_mount_point] } { - # cache the folders along the path - set mount_point_children [stateNodeAccess children $mount_point] +# if { [string equal [stateNodeAccess id $mount_point] $target_mount_point] } { +# # cache the folders along the path +# set mount_point_children [stateNodeAccess children $mount_point] - foreach id \ - [getStateFolderPath $user_id "" \ - $mount_point_children $target_folder_id] { - # Cache child folders of the current folder - set mount_point_id [stateNodeAccess id $mount_point] - foreach child_folder [folderChildrenDB $mount_point_id $id] { - # Retreive the children of this folder from the db in case another - # user has added some chilren - set new_children [folderChildIDs [folderChildrenDB $mount_point_id \ - [folderAccess id $child_folder]]] +# foreach id \ +# [getStateFolderPath $user_id "" \ +# $mount_point_children $target_folder_id] { +# # Cache child folders of the current folder +# set mount_point_id [stateNodeAccess id $mount_point] +# foreach child_folder [folderChildrenDB $mount_point_id $id] { +# # Retreive the children of this folder from the db in case another +# # user has added some chilren +# set new_children [folderChildIDs [folderChildrenDB $mount_point_id \ +# [folderAccess id $child_folder]]] - cacheOneFolder $user_id \ - [folderMutate children $child_folder $new_children] - } +# cacheOneFolder $user_id \ +# [folderMutate children $child_folder $new_children] +# } - } - } - } -} +# } +# } +# } +# } -ad_proc -public cacheMountPointFolders { user_id mount_point target_folder_id } { +# ad_proc -public cacheMountPointFolders { user_id mount_point target_folder_id } { - Go through ALL children of the mount point and cache them, one by one, - until the target folder is found. This will do a lot of redundant work, - so be careful. This procedure will execute breadth-first search, in hope of - finding the target folder quicker. +# Go through ALL children of the mount point and cache them, one by one, +# until the target folder is found. This will do a lot of redundant work, +# so be careful. This procedure will execute breadth-first search, in hope of +# finding the target folder quicker. -} { +# } { - ns_log debug "cacheMountPointFolders: CRITICAL MISS: [folderPath $user_id $mount_point $target_folder_id]" +# ns_log debug "cacheMountPointFolders: CRITICAL MISS: [folderPath $user_id $mount_point $target_folder_id]" - set queue [folderChildrenDB $mount_point ""] +# set queue [folderChildrenDB $mount_point ""] - while { [llength $queue] > 0 } { +# while { [llength $queue] > 0 } { - # Pop the front folder - set cur_folder [lindex $queue 0] - set queue [lrange $queue 1 end] +# # Pop the front folder +# set cur_folder [lindex $queue 0] +# set queue [lrange $queue 1 end] - # Process it - set cur_id [folderAccess id $cur_folder] - set child_folders [folderChildrenDB $mount_point $cur_id] - set new_children [folderChildIDs $child_folders] - cacheOneFolder $user_id [folderMutate children $cur_folder $new_children] +# # Process it +# set cur_id [folderAccess id $cur_folder] +# set child_folders [folderChildrenDB $mount_point $cur_id] +# set new_children [folderChildIDs $child_folders] +# cacheOneFolder $user_id [folderMutate children $cur_folder $new_children] - # End the process if the target folder is found - if { [string equal $cur_id $target_folder_id] } { - return - } +# # End the process if the target folder is found +# if { [string equal $cur_id $target_folder_id] } { +# return +# } - # Append its children to the queue - set queue [concat $queue $child_folders] - } +# # Append its children to the queue +# set queue [concat $queue $child_folders] +# } -} +# } Index: openacs-4/packages/cms/tcl/clipboard-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/clipboard-procs.tcl,v diff -u -N -r1.5.2.1 -r1.5.2.2 --- openacs-4/packages/cms/tcl/clipboard-procs.tcl 31 May 2005 05:04:14 -0000 1.5.2.1 +++ openacs-4/packages/cms/tcl/clipboard-procs.tcl 31 Aug 2006 19:59:04 -0000 1.5.2.2 @@ -1,29 +1,26 @@ -########################## -# -# Procedures to manipulate the clipboard -# -################ +ad_library { -namespace eval clipboard { - # See clipboard-ui-procs.tcl - namespace eval ui {} + Procedures to manipulate the clipboard data structure and cookies + } + +namespace eval cms::clipboard {} -ad_proc -public clipboard::parse_cookie {} { +ad_proc -public cms::clipboard::parse_cookie {} { Get the clipboard from a cookie and return it } { set clipboard_cookie [template::util::get_cookie content_marks] - ns_log debug "clipboard::parse_cookie: cookie $clipboard_cookie" + ns_log debug "cms::clipboard::parse_cookie: cookie $clipboard_cookie" set clip [ns_set create] set mount_branches [split $clipboard_cookie "|"] set mount_points [list] set total_items 0 foreach branch $mount_branches { if { [regexp {([a-zA-Z0-9]+):(.*)} $branch match mount_point items] } { - ns_log debug "clipboard::parse_cookie: branch: $branch" + ns_log debug "cms::clipboard::parse_cookie: branch: $branch, mount_point: $mount_point, items: $items" set items_list [split $items ","] set items_size [llength $items_list] incr total_items $items_size @@ -39,23 +36,42 @@ return $clip } -ad_proc -public clipboard::get_items { clip mount_point } { +ad_proc -public cms::clipboard::reassemble_cookie { clip } { + Reassemble the cookie from clip + + @return A string suitable for use with ad_set_cookie + +} { + + set cookie "" + set mount_point_names [ns_set get $clip __mount_points__] + set pipe "" + foreach mount_point $mount_point_names { + append cookie "$pipe${mount_point}:[join [ns_set get $clip $mount_point] ,]" + set pipe "|" + } + + return $cookie +} + +ad_proc -public cms::clipboard::get_items { clip mount_point } { + Retreive all marked items as a list } { return [ns_set get $clip $mount_point] } -ad_proc -public clipboard::get_total_items { clip } { +ad_proc -public cms::clipboard::get_total_items { clip } { Get the number of total items on the clipboard } { return [ns_set get $clip __total_items__] } -ad_proc -public clipboard::map_code { clip mount_point code } { +ad_proc -public cms::clipboard::map_code { clip mount_point code } { Execute a piece of code for each item under the specified mount point, creating an item_id @@ -68,7 +84,7 @@ } } -ad_proc -public clipboard::is_marked { clip mount_point item_id } { +ad_proc -public cms::clipboard::is_marked { clip mount_point item_id } { Determine if an item is marked @@ -82,15 +98,15 @@ } } -ad_proc -public clipboard::get_bookmark_icon { clip mount_point item_id {row_ref row} } { +ad_proc -public cms::clipboard::get_bookmark_icon { clip mount_point item_id {row_ref row} } { Use this function as part of the multirow query to set up the bookmark icon } { upvar $row_ref row - if { [clipboard::is_marked $clip $mount_point $item_id] } { + if { [cms::clipboard::is_marked $clip $mount_point $item_id] } { set row(bookmark) Bookmarked } else { set row(bookmark) Bookmarks @@ -99,9 +115,10 @@ return $row(bookmark) } -ad_proc -public clipboard::add_item { clip mount_point item_id } { +ad_proc -public cms::clipboard::add_item { clip mount_point item_id } { - Add an item to the clipboard: BROKEN + Add an item to the clipboard + @return Updated clip } { set old_items [ns_set get $clip $mount_point] @@ -122,71 +139,46 @@ ns_set update $clip __mount_points__ $old_mount_points } } + + return $clip } -ad_proc -public clipboard::remove_item { clip mount_point item_id } { +ad_proc -public cms::clipboard::remove_item { clip mount_point item } { - Remove an item from the clipboard: BROKEN + Remove an item from the clipboard + @return Updated clip } { - set old_items [ns_set get $clip $mount_point] - set index [lsearch $old_items $item_id] + set items [ns_set get $clip $mount_point] + set index [lsearch $items $item] if { $index != -1 } { - # Remove the item - set old_items [lreplace $old_items $index $index ""] - ns_set update $clip $mount_point $old_items - ns_set update $clip ${mount_point}_size \ - [expr [ns_set get $clip ${mount_point}_size] - 1] - ns_set update $clip __total_items__ \ - [expr [ns_set get $clip __total_items__] - 1] + ns_log debug "cms::clipboard::remove_item: removing $item from $mount_point" + set items [lreplace $items $index $index] + if { [llength $items] > 0 } { + ns_set update $clip $mount_point $items + ns_set update $clip ${mount_point}_size \ + [expr [ns_set get $clip ${mount_point}_size] - 1] + ns_set update $clip __total_items__ \ + [expr [ns_set get $clip __total_items__] - 1] + } else { + set mount_points [ns_set get $clip __mount_points__] + set mp_index [lsearch $mount_points $mount_point] + set mount_points [lreplace $mount_points $mp_index $mp_index] + ns_set update $clip __mount_points__ $mount_points + ns_set delkey $clip ${mount_point}_size + ns_set update $clip __total_items__ \ + [expr [ns_set get $clip __total_items__] - 1] + } } -} -ad_proc -public clipboard::set_cookie { clip } { - - Actually set the new cookie: BROKEN - -} { - set the_cookie "" - set mount_point_names [ns_set get $clip __mount_points__] - set pipe "" - foreach mount_point $mount_point_names { - append the_cookie "$pipe${mount_point}:[join [ns_set get $clip $mount_point] ,]" - set pipe "|" - } - - template::util::set_cookie session content_marks $the_cookie + return $clip } -ad_proc -public clipboard::clear_cookie {} { +ad_proc -public cms::clipboard::free { clip } { - Clear the clipboard: BROKEN - -} { - template::util::clear_cookie content_marks -} - -ad_proc -public clipboard::free { clip } { - Release the resources associated with the clipboard } { ns_set free $clip } - -ad_proc -public clipboard::floats_p {} { - - determines whether clipboard should float or not - currently incomplete, should be checking user prefs - -} { - return [ad_parameter ClipboardFloatsP] - -} - - - - - - Index: openacs-4/packages/cms/tcl/clipboard-ui-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/clipboard-ui-procs.tcl,v diff -u -N -r1.3.8.1 -r1.3.8.2 --- openacs-4/packages/cms/tcl/clipboard-ui-procs.tcl 31 May 2005 05:04:14 -0000 1.3.8.1 +++ openacs-4/packages/cms/tcl/clipboard-ui-procs.tcl 31 Aug 2006 19:59:04 -0000 1.3.8.2 @@ -1,9 +1,13 @@ -######################################### -# Procedures to manipulate clipped items -######################################### +ad_library { -ad_proc -public clipboard::ui::form_create { form_name args } { + Procedures to manipulate clipboard UI +} + +namespace eval cms::clipboard::ui {} + +ad_proc -public cms::clipboard::ui::form_create { form_name args } { + Create a form for representing clipped items, also start a multirow datasource for the items The columns created for the multirow datasource by default are @@ -39,7 +43,7 @@ set form_properties(row_elements) $elements } -ad_proc -public clipboard::ui::add_row { form_name mount_point item_id title args} { +ad_proc -public cms::clipboard::ui::add_row { form_name mount_point item_id title args} { Append a row to the multirow datasource If the -checked switch is specified, checks the box by default @@ -84,28 +88,28 @@ uplevel " upvar 0 \"${form_name}_data:$rowcount\" row - clipboard::ui::element_create $form_name $element_code + cms::clipboard::ui::element_create $form_name $element_code " set row(checked) [template::util::nvl $row(checked) 0] # Create the title inform widget set element_code [list title -datatype text -widget inform -label Title \ -value $title] - uplevel "clipboard::ui::element_create $form_name $element_code" + uplevel "cms::clipboard::ui::element_create $form_name $element_code" # Create the mount point, item_id hidden vars, remember their values # in the datasource. other hidden vars ? foreach varname {mount_point item_id} { set element_code [list $varname -datatype keyword -widget hidden \ -label $varname -value [set $varname]] set row($varname) [set $varname] - uplevel "clipboard::ui::element_create $form_name $element_code" + uplevel "cms::clipboard::ui::element_create $form_name $element_code" } } -ad_proc -public clipboard::ui::element_create { form_name element_name args } { +ad_proc -public cms::clipboard::ui::element_create { form_name element_name args } { A wrapper for element create which maintains the naming convention for the element. Appends the element to the multirow datasource @@ -141,7 +145,7 @@ } -ad_proc -public clipboard::ui::process_row { form_name row_index row_dml } { +ad_proc -public cms::clipboard::ui::process_row { form_name row_index row_dml } { Process a row of the table, executing whatever TCL code the user has passed in. @@ -170,7 +174,7 @@ uplevel $code } -ad_proc -public clipboard::ui::generate_form { form_name clip mount_point } { +ad_proc -public cms::clipboard::ui::generate_form { form_name clip mount_point } { Assemble the entire datasource based on all items under some mount point @@ -184,23 +188,23 @@ " uplevel { - set items [clipboard::get_items $__clip $__mount_point] + set items [cms::clipboard::get_items $__clip $__mount_point] cm::modules::${__mount_point}::getSortedPaths clip_rows $items for { set i 1 } { $i <= [template::multirow size clip_rows] } { incr i } { # Start the row template::multirow get clip_rows $i - clipboard::ui::add_row $__form_name $__mount_point \ + cms::clipboard::ui::add_row $__form_name $__mount_point \ $clip_rows(item_id) $clip_rows(item_path) # Append all elements upvar 0 ${__form_name}:$i row foreach element $form_properties(row_elements) { - eval clipboard::ui::element_create $__form_name $element + eval cms::clipboard::ui::element_create $__form_name $element } } } } -ad_proc -public clipboard::ui::generate_form_header { form_name {row_index 1}} { +ad_proc -public cms::clipboard::ui::generate_form_header { form_name {row_index 1}} { Generate the extra ... tags based on the elements in some row @@ -210,7 +214,7 @@ upvar "${form_name}_data:${row_index}" row if { ![info exists row] } { - ns_log notice "clipboard::ui::generate_form_header: No such row $row_index" + ns_log notice "cms::clipboard::ui::generate_form_header: No such row $row_index" return } @@ -223,7 +227,7 @@ } } -ad_proc -public clipboard::ui::process_form { form_name row_dml } { +ad_proc -public cms::clipboard::ui::process_form { form_name row_dml } { Process the entire form, executing the same DML for each row If no DML is specified, uses the global dml @@ -232,19 +236,20 @@ upvar "${form_name}_data:rowcount" rowcount for {set i 1} {$i <= $rowcount} {incr i} { - uplevel "clipboard::ui::process_row $form_name $i \{$row_dml\}" + uplevel "cms::clipboard::ui::process_row $form_name $i \{$row_dml\}" } } -ad_proc -public clipboard::ui::render_bookmark { mount_point id package_url} { +ad_proc -public cms::clipboard::ui::render_bookmark { mount_point id package_url} { Compile and eval a chunk of ADP for the bookmark + @author Michael Steigman } { set img_checked "${package_url}resources/checked.gif" set img_unchecked "${package_url}resources/unchecked.gif" - set clipboardfloats_p [clipboard::floats_p] + set clipboardfloats_p [cms::clipboard::ui::floats_p] set code " @@ -253,3 +258,13 @@ set compiled_code [template::adp_compile -string $code] return [template::adp_eval compiled_code] } + +ad_proc -public cms::clipboard::ui::floats_p {} { + + determines whether clipboard should float or not + currently incomplete, should be checking user prefs + +} { + return [ad_parameter ClipboardFloatsP] + +} Index: openacs-4/packages/cms/tcl/cms-folder-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/cms-folder-procs-oracle.xql,v diff -u -N --- openacs-4/packages/cms/tcl/cms-folder-procs-oracle.xql 14 Aug 2001 18:11:30 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,23 +0,0 @@ - - -oracle8.1.6 - - - - select - o.pretty_name, - m.content_type - from - acs_object_types o, cr_folder_type_map m - where - m.folder_id = :folder_id - and - m.content_type = o.object_type - and - content_item.is_subclass(o.object_type, 'content_revision') = 't' - order by - decode(o.object_type, 'content_revision', '----', o.pretty_name) - - - - \ No newline at end of file Index: openacs-4/packages/cms/tcl/cms-folder-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/cms-folder-procs-postgresql.xql,v diff -u -N --- openacs-4/packages/cms/tcl/cms-folder-procs-postgresql.xql 14 Aug 2001 18:11:30 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,23 +0,0 @@ - - -postgresql7.1 - - - - select - o.pretty_name, - m.content_type - from - acs_object_types o, cr_folder_type_map m - where - m.folder_id = :folder_id - and - m.content_type = o.object_type - and - content_item__is_subclass(o.object_type, 'content_revision') = 't' - order by - case when o.object_type = 'content_revision' then '----' else o.pretty_name end - - - - \ No newline at end of file Index: openacs-4/packages/cms/tcl/cms-folder-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/cms-folder-procs.tcl,v diff -u -N --- openacs-4/packages/cms/tcl/cms-folder-procs.tcl 16 Sep 2002 14:50:39 -0000 1.4 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,68 +0,0 @@ -# @namespace cms_folder - -# Procedures associated with the CMS folder listing - -namespace eval cms_folder {} - - -# @public flush - -# Flush the folder listing paginator cache - -# @param mount_point The mount point, defaults to "sitemap" -# @param id The folder id, defaults to "" (root folder) - -proc cms_folder::flush { {mount_point "sitemap"} {id ""} } { - - set cache_id "folder_contents_${mount_point}_$id" - - # use * to flush all sort orders for a cached datasource - cache flush "$cache_id*" - -} - -# @public get_registered_types -# -# Get all the content types registered to a folder -# -# @param folder_id The folder id -# -# @param datasource {default multilist} -# Either "multilist" (return a multilist, suitable for the -# -options parameter to widgets), or "multirow" -# (create a multirow datasource in the calling frame). The -# multirow datasource will have two columns, pretty_name -# and content_type -# -# @param name {default registered_types} -# The name for the multirow datasource. Ignored if the -# darasource parameter is not "multirow" -# -# @see proc cms_folder::flush_registered_types - -ad_proc cms_folder::get_registered_types { - folder_id {datasource multilist} {name registered_types} -} { - - if { [string equal $datasource "multirow"] } { - set sql [db_map get_name_type] - return [uplevel 1 "db_multirow $name not_used \"${sql}\""] - } else { - return [db_list_of_lists get_name_type ""] - } -} - -# @public flush_registered_types -# -# Flushe the registered types cache for the folder -# -# @param id {default The empty string} -# The ID of the folder to flush. If missing, all folders -# will be flushed -# -# @see proc cms_folder::flush - -proc cms_folder::flush_registered_types { {id ""} } { - set cache_id "folder_registered_types $id" - template::query::flush_cache "$cache_id*" -} Index: openacs-4/packages/cms/tcl/cms-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/cms-init.tcl,v diff -u -N -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/cms/tcl/cms-init.tcl 6 Jun 2005 17:07:23 -0000 1.1.2.1 +++ openacs-4/packages/cms/tcl/cms-init.tcl 31 Aug 2006 19:59:04 -0000 1.1.2.2 @@ -11,8 +11,6 @@ @cvs-id $Id$ } -# Should be a CR parameter +# Should be a CR parameter? set interval 120 -ad_schedule_proc -thread t $interval publish::track_publish_status - - +ad_schedule_proc -thread t $interval cms::publish::track_publish_status Index: openacs-4/packages/cms/tcl/cms-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/cms-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/cms-procs.tcl 31 Aug 2006 19:59:04 -0000 1.1.2.1 @@ -0,0 +1,11 @@ +ad_library { + CMS procs +} + +namespace eval cms {} + +ad_proc -public cms::package_key {} { + return package_key string (move this) +} { + return "cms" +} Index: openacs-4/packages/cms/tcl/content-add-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/content-add-procs.tcl,v diff -u -N --- openacs-4/packages/cms/tcl/content-add-procs.tcl 14 Aug 2002 03:57:42 -0000 1.5 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,71 +0,0 @@ -# content-add-procs.tcl - - -# @namespace content_add - -# Procedures regarding content methods - -namespace eval content_add {} - - - -# @public content_method_html - -# Generates HTML stub for revision content method choices for a content item - -# @author Michael Pih - -# @param db A database handle -# @param content_type The content type of the item -# @param item_id The item id - -ad_proc -public content_add::content_method_html { content_type item_id } { - - - @public content_method_html - - Generates HTML stub for revision content method choices for a content item - - @author Michael Pih - - @param db A database handle - @param content_type The content type of the item - @param item_id The item id - -} { - - set content_method_html "" - - set target "revision-add-2?item_id=$item_id" - - set has_text_mime_type [db_string count_text_mime_types ""] - set mime_type_count [db_string count_mime_types ""] - - if { $mime_type_count > 0 } { - - append content_method_html "Add revised content via \[" - - if { $has_text_mime_type > 0 } { - append content_method_html " - Text Entry | " - } - - append content_method_html " - File Upload | " - - if { $has_text_mime_type > 0 } { - append content_method_html " - XML Import | " - } - - append content_method_html " - No Content " - - append content_method_html " \]" - } else { - append content_method_html " - \[Add\]" - } - return $content_method_html -} - Index: openacs-4/packages/cms/tcl/content-add-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/content-add-procs.xql,v diff -u -N --- openacs-4/packages/cms/tcl/content-add-procs.xql 14 Aug 2001 18:11:30 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,19 +0,0 @@ - - - - - select count(*) - from cr_content_mime_type_map - where mime_type like ('%text/%') - and content_type = :content_type - - - - - - select count(*) - from cr_content_mime_type_map - where content_type = :content_type - - - Index: openacs-4/packages/cms/tcl/content-method-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/content-method-procs-oracle.xql,v diff -u -N --- openacs-4/packages/cms/tcl/content-method-procs-oracle.xql 25 Feb 2004 17:50:55 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,36 +0,0 @@ - - - - oracle8.1.6 - - - - - select - content_method - from - cm_content_methods m - where - content_method = content_method.get_method (:content_type ) - $text_entry_filter - - - - - - - - - select - label, content_method - from - cm_content_methods m - where - m.content_method = content_method.get_method( :content_type ) - $text_entry_filter - - - - - - Index: openacs-4/packages/cms/tcl/content-method-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/content-method-procs-postgresql.xql,v diff -u -N --- openacs-4/packages/cms/tcl/content-method-procs-postgresql.xql 25 Feb 2004 17:50:55 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,36 +0,0 @@ - - - - postgresql7.1 - - - - - select - content_method - from - cm_content_methods m - where - content_method = content_method__get_method (:content_type ) - $text_entry_filter - - - - - - - - - select - label, content_method - from - cm_content_methods m - where - m.content_method = content_method__get_method( :content_type ) - $text_entry_filter - - - - - - Index: openacs-4/packages/cms/tcl/content-method-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/content-method-procs.tcl,v diff -u -N --- openacs-4/packages/cms/tcl/content-method-procs.tcl 17 Sep 2002 21:43:09 -0000 1.9 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,155 +0,0 @@ -# content-method-procs.tcl - - -# @namespace content_method - -# Procedures regarding content methods - -namespace eval content_method {} - - -ad_proc -public content_method::get_content_methods { content_type args } { - - Returns a list of content_methods that are associated with - a content type, first checking for a default method, then for registered - content methods, and then for all content methods - - @author Michael Pih - - @param content_type The content type - @option get_labels Instead of a list of content methods, return - a list of label-value pairs of associated content methods. - @return A list of content methods or a list of label-value pairs of - content methods if the "-get_labels" option is specified - - @see content_method::get_content_method_options - @see content_method::text_entry_filter_sql - -} { - template::util::get_opts $args - - if { [info exists opts(get_labels)] } { - set methods \ - [content_method::get_content_method_options $content_type] - return $methods - } - - set text_entry_filter [text_entry_filter_sql $content_type] - - # get default content method (if any) - set default_method [db_string get_default_method ""] - - # if the default exists, return it - if { ![template::util::is_nil default_method] } { - set methods [list $default_method] - } else { - # otherwise look up all content method mappings - - set methods [db_list get_methods_1 ""] - } - - # if there are no mappings, return all methods - if { [template::util::is_nil methods] } { - - set methods [db_list get_methods_2 ""] - } - - return $methods -} - - -ad_proc -private content_method::get_content_method_options { content_type } { - - Returns a list of label, content_method pairs that are associated with - a content type, first checking for a default method, then for registered - content methods, and then for all content methods - - @author Michael Pih - @param content_type The content type - @return A list of label, value pairs of content methods - - @see content_method::get_content_methods - @see content_method::text_entry_filter_sql - -} { - - set text_entry_filter [text_entry_filter_sql $content_type] - - db_0or1row get_content_default_method "" - - if { ![template::util::is_nil content_method] } { - set methods [list [list $label $content_method]] - } else { - # otherwise look up all content methods mappings - set methods [db_list_of_lists get_methods_1 ""] - } - - # if there are no mappings, return all methods - if { [template::util::is_nil methods] } { - - set methods [db_list_of_lists get_methods_2 ""] - } - - return $methods -} - - -ad_proc -private content_method::text_entry_filter_sql { content_type } { - - Generate a SQL stub that filters out the text_entry content method - - @author Michael Pih - @param content_type mime type - - @return SQL stub that possibly filters out the text_entry content method - -} { - - set text_entry_filter_sql "" - - set has_text_mime_type [db_string count_text_mime_types ""] - - if { $has_text_mime_type == 0 } { - set text_entry_filter_sql \ - "and m.content_method <> 'text_entry'" - } - - return $text_entry_filter_sql -} - - - -ad_proc -public content_method::flush_content_methods_cache { {content_type ""} } { - - Flushes the cache for content_method_types for a given content type. If no - content type is specified, the entire content_method_types cache is - flushed - - @author Michael Pih - @param content_type The content type, default null - -} { - - if { [template::util::is_nil content_type] } { - # FIXME: figure out what to do with these after template::query calls - # are gone. - - # flush the entire content_method_types cache - template::query::flush_cache "content_method_types*" - } else { - - # flush the content_method_types cache for a content type - # 1) flush the default method cache - template::query::flush_cache \ - "content_method_types_default $content_type" - template::query::flush_cache \ - "content_method_types_n_labels_default $content_type" - - # 2) flush the mapped methods cache - template::query::flush_cache "content_method_types ${content_type}*" - - # 3) flush the all methods cache - template::query::flush_cache "content_method_types" - template::query::flush_cache "content_method_types_n_labels" - } -} Index: openacs-4/packages/cms/tcl/content-method-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/content-method-procs.xql,v diff -u -N --- openacs-4/packages/cms/tcl/content-method-procs.xql 20 Aug 2001 04:35:41 -0000 1.4 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,74 +0,0 @@ - - - - - - select count(*) - from cr_content_mime_type_map - where mime_type like ('%text/%') - and content_type = :content_type - - - - - - select - map.content_method - from - cm_content_type_method_map map, cm_content_methods m - where - map.content_method = m.content_method - and - map.content_type = :content_type - $text_entry_filter - - - - - - - - select - content_method - from - cm_content_methods m - where 1 = 1 - $text_entry_filter - - - - - - - - - - select - label, map.content_method - from - cm_content_methods m, cm_content_type_method_map map - where - m.content_method = map.content_method - and - map.content_type = :content_type - $text_entry_filter - - - - - - - - - select - label, content_method - from - cm_content_methods m - where 1 = 1 - $text_entry_filter - - - - - - Index: openacs-4/packages/cms/tcl/folder-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/folder-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/folder-procs.tcl 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,73 @@ +ad_library { + + Procs for managing content folders + +} + +namespace eval cms::folder {} + +ad_proc -public cms::folder::get { + -folder_id:required + {-revision_id "" } + {-array_name "folder_info" } +} { + get a folder revision + + @param folder_id item id of the folder you want + @return array + +} { + + if { $revision_id eq "" } { + set revision_id [content::item::get_latest_revision -item_id $folder_id] + } + upvar $array_name local_array + return [db_0or1row select_folder {} -column_array local_array] + +} + +ad_proc -public cms::folder::get_registered_types { + { folder_id } + { datasource multilist } + { name registered_types } +} { + Get all the content types registered to a folder + @param folder_id The folder id + + @param datasource default multilist + Either "multilist" (return a multilist, suitable for the + -options parameter to widgets), "multirow" + (create a multirow datasource in the calling frame) or plain old "list". The + multirow datasource will have two columns, pretty_name + and content_type + + @param name default registered_types + The name for the multirow datasource. Ignored if the + darasource parameter is not "multirow" +} { + + switch $datasource { + multirow { + return [uplevel 1 "db_multirow $name not_used \"[db_map get_types_list_of_lists]\""] + } + multilist { + return [db_list_of_lists get_types_list_of_lists {}] + } + list { + return [db_list get_types_list {}] + } + } +} + +ad_proc -public cms::folder::symlinks_allowed_p { + -folder_id:required +} { + + Can we create symlinks in this folder? + + @param folder_id The folder id + @return boolean + +} { + return [db_string symlinks_allowed_p {} -default 0] +} \ No newline at end of file Index: openacs-4/packages/cms/tcl/folder-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/folder-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/folder-procs.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,38 @@ + + + + + + + select * from cr_folders f join cr_items i on (f.folder_id = i.item_id) + where f.folder_id = :folder_id + + + + + select o.pretty_name, m.content_type + from acs_object_types o join cr_folder_type_map m on (m.content_type = o.object_type) + where m.folder_id = :folder_id + and content_item__is_subclass(o.object_type, 'content_revision') = 't' + order by case when o.object_type = 'content_revision' then '----' else o.pretty_name end + + + + + select m.content_type + from cr_folder_type_map m + where m.folder_id = :folder_id + order by content_type + + + + + select 1 where exists ( + select * from cr_folder_type_map m + where m.folder_id = :folder_id + and content_type = 'content_symlink' + ) + + + + Index: openacs-4/packages/cms/tcl/form-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/form-procs-oracle.xql,v diff -u -N -r1.17 -r1.17.2.1 --- openacs-4/packages/cms/tcl/form-procs-oracle.xql 17 May 2005 21:25:08 -0000 1.17 +++ openacs-4/packages/cms/tcl/form-procs-oracle.xql 31 Aug 2006 19:59:05 -0000 1.17.2.1 @@ -2,7 +2,7 @@ oracle8.1.6 - + select @@ -241,14 +241,6 @@ - - - - select content_item.get_title(:parent_id) from dual - - - - Index: openacs-4/packages/cms/tcl/form-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/form-procs-postgresql.xql,v diff -u -N -r1.21 -r1.21.2.1 --- openacs-4/packages/cms/tcl/form-procs-postgresql.xql 17 May 2005 21:25:08 -0000 1.21 +++ openacs-4/packages/cms/tcl/form-procs-postgresql.xql 31 Aug 2006 19:59:05 -0000 1.21.2.1 @@ -2,7 +2,7 @@ postgresql7.1 - + select @@ -160,7 +160,7 @@ - + select content_item__new(varchar :name, @@ -183,7 +183,7 @@ - + @@ -194,7 +194,7 @@ - + update @@ -209,7 +209,7 @@ - + update cr_revisions @@ -221,7 +221,7 @@ - + @@ -233,7 +233,7 @@ - + update @@ -248,7 +248,7 @@ - + update cr_revisions @@ -270,7 +270,7 @@ - + select @@ -287,24 +287,16 @@ - + - select content_item__get_title(:parent_id, 'f') - - - - - - - to_char($attr, 'YYYY MM DD HH24 MI SS') as $attr - + select @@ -349,14 +341,6 @@ - - - - select content_item__get_latest_revision(:item_id) - - - - Index: openacs-4/packages/cms/tcl/form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/form-procs.tcl,v diff -u -N -r1.27.2.2 -r1.27.2.3 --- openacs-4/packages/cms/tcl/form-procs.tcl 19 Nov 2005 23:12:09 -0000 1.27.2.2 +++ openacs-4/packages/cms/tcl/form-procs.tcl 31 Aug 2006 19:59:05 -0000 1.27.2.3 @@ -1,10 +1,14 @@ -namespace eval content { +ad_library { + These procs manage building and processing the forms used in CMS. +} +# MS: old namespace stuff - now converted to cms::form +#namespace eval content { # namespace import seems to prevent content:: procs from being recognized # namespace import ::template::query ::template::form ::template::element -} +#} +namespace eval cms::form {} - -ad_proc -private content::query_form_metadata { +ad_proc -private cms::form::query_form_metadata { {datasource_name rows} {datasource_type multirow} {extra_where {}} @@ -13,6 +17,7 @@ Helper proc: query out all the information neccessary to create a custom form element based on stored metadata Requires the variable content_type to be set in the calling frame + @ www/modules/items/relate-items-2.tcl } { # query for all attribute widget param values associated with a content # the 3 nvl subqueries are necessary because we cannot outer join @@ -41,8 +46,10 @@ } -ad_proc -private content::assemble_form_element { - datasource_ref the_attribute_name start_row {db {}} +ad_proc -private cms::form::assemble_form_element { + datasource_ref + the_attribute_name + start_row {db {}} } { Process the query and assemble the "element create..." statement @@ -70,7 +77,7 @@ template::util::array_to_vars q_row - content::get_revision_create_element + get_revision_create_element } set last_row $i @@ -97,202 +104,202 @@ } -ad_proc -public content::create_form_element { - form_name attribute_name args -} { +# ad_proc -public content::create_form_element { +# form_name attribute_name args +# } { - Create a form widget based on the given attribute. Query parameters - out of the database, override them with the passed-in parameters - if they exist. - If the -revision_id flag exists, fills in the value of the attribute from - the database, based on the given revision_id. - If the -content_type flag exists, uses the attribute for the given content - type (without inheritance). - If the -item_id flag is present, the live revision for the item will be - used. - If the -item_id and the -revision_id flags are missing, the -content_type - flag must be specified. - Example: - content::create_form_element my_form width -revision_id $image_id -size 10 - This call will create an element representing the width attribute - of the image type, with the textbox size set to 10 characters, - and query the current value of the attribute out of the database. +# Create a form widget based on the given attribute. Query parameters +# out of the database, override them with the passed-in parameters +# if they exist. +# If the -revision_id flag exists, fills in the value of the attribute from +# the database, based on the given revision_id. +# If the -content_type flag exists, uses the attribute for the given content +# type (without inheritance). +# If the -item_id flag is present, the live revision for the item will be +# used. +# If the -item_id and the -revision_id flags are missing, the -content_type +# flag must be specified. +# Example: +# content::create_form_element my_form width -revision_id $image_id -size 10 +# This call will create an element representing the width attribute +# of the image type, with the textbox size set to 10 characters, +# and query the current value of the attribute out of the database. -} { - template::util::get_opts $args +# } { +# template::util::get_opts $args - # Get the revision id if the item id is specified, or if - # it is passed in directly - if { ![template::util::is_nil opts(revision_id)] } { - set revision_id $opts(revision_id) +# # Get the revision id if the item id is specified, or if +# # it is passed in directly +# if { ![template::util::is_nil opts(revision_id)] } { +# set revision_id $opts(revision_id) - } elseif { ![template::util::is_nil opts(item_id)] } { +# } elseif { ![template::util::is_nil opts(item_id)] } { - set item_id $opts(item_id) - set revision_id [db_string get_revision_id ""] - } +# set item_id $opts(item_id) +# set revision_id [db_string get_revision_id ""] +# } - if { [info exists opts(content_type)] } { - # The type is known: use it - set content_type $opts(content_type) - } else { +# if { [info exists opts(content_type)] } { +# # The type is known: use it +# set content_type $opts(content_type) +# } else { - # Figure out the type based on revision_id - if { ![info exists revision_id] } { - template::request error invalid_element_flags " - No revision_id, item_id or content_type specified in - content::create_form_element for attribute ${form_name}:${attribute_name}" - return - } +# # Figure out the type based on revision_id +# if { ![info exists revision_id] } { +# template::request error invalid_element_flags " +# No revision_id, item_id or content_type specified in +# content::create_form_element for attribute ${form_name}:${attribute_name}" +# return +# } - set content_type [db_string get_content_type ""] - } +# set content_type [db_string get_content_type ""] +# } - # Run the gigantic uber-query. This is somewhat wasteful; should - # be replaced by 2 smaller queries: one for the attribute_id, one - # for parameter types and values. - query_form_metadata params multirow "attribute_name = :attribute_name" +# # Run the gigantic uber-query. This is somewhat wasteful; should +# # be replaced by 2 smaller queries: one for the attribute_id, one +# # for parameter types and values. +# query_form_metadata params multirow "attribute_name = :attribute_name" - if { ${params:rowcount} < 1} { - error "No widgets are registered for ${content_type}.${attribute_name}" - } +# if { ${params:rowcount} < 1} { +# error "No widgets are registered for ${content_type}.${attribute_name}" +# } - template::util::array_to_vars "params:1" - assemble_form_element params $attribute_name 1 +# template::util::array_to_vars "params:1" +# assemble_form_element params $attribute_name 1 - # If the -revision_id switch exists, look up the existing value for the - # element - if { ![template::util::is_nil revision_id] && [lsearch $code_params "-value"] < 0 } { +# # If the -revision_id switch exists, look up the existing value for the +# # element +# if { ![template::util::is_nil revision_id] && [lsearch $code_params "-value"] < 0 } { - # Handle custom datatypes... Basically, this is done so that - # the date widget will work :-/ - # In the future, upgrade the date widget and use acs_object.get_attribute +# # Handle custom datatypes... Basically, this is done so that +# # the date widget will work :-/ +# # In the future, upgrade the date widget and use acs_object.get_attribute - switch $datatype { - date { - set what [db_map cfe_attribute_name_to_char] - } +# switch $datatype { +# date { +# set what [db_map cfe_attribute_name_to_char] +# } - default { - set what [db_map cfe_attribute_name] - } - } +# default { +# set what [db_map cfe_attribute_name] +# } +# } - set element [db_string get_element_value ""] +# set element [db_string get_element_value ""] - lappend code_params -value $element_value -values [list $element_value] - } +# lappend code_params -value $element_value -values [list $element_value] +# } - set form_element "template::element create $form_name $attribute_name $code_params" - if { ![string equal $is_required t] } { - append form_element " -optional" - } +# set form_element "template::element create $form_name $attribute_name $code_params" +# if { ![string equal $is_required t] } { +# append form_element " -optional" +# } - eval $form_element -} +# eval $form_element +# } -ad_proc -public content::get_revision_form { - content_type item_id form_name {show_sections t} {element_override {}} -} { +# ad_proc -public content::get_revision_form { +# content_type item_id form_name {show_sections t} {element_override {}} +# } { - generate a form based on metadata +# generate a form based on metadata -} { +# } { - # Convert overrides to an array - array set overrides $element_override +# # Convert overrides to an array +# array set overrides $element_override - set last_type "" - set last_attribute_name "" - set new_section_p 1 +# set last_type "" +# set last_attribute_name "" +# set new_section_p 1 - set code_params [list] - set html_params [list] +# set code_params [list] +# set html_params [list] - # Perform a gigantic query to retreive all metadata - query_form_metadata +# # Perform a gigantic query to retreive all metadata +# query_form_metadata - # Process the results and create the elements - for { set i 1 } { $i <= ${rows:rowcount} } { incr i } { - upvar 0 "rows:${i}" row - template::util::array_to_vars row +# # Process the results and create the elements +# for { set i 1 } { $i <= ${rows:rowcount} } { incr i } { +# upvar 0 "rows:${i}" row +# template::util::array_to_vars row - # make a new section in the form for each type in the content type hierarchy - if { $new_section_p == 1 && [string equal $show_sections t]} { - # put attributes for each supertype in their own section - template::form section $form_name $last_type - } +# # make a new section in the form for each type in the content type hierarchy +# if { $new_section_p == 1 && [string equal $show_sections t]} { +# # put attributes for each supertype in their own section +# template::form section $form_name $last_type +# } - # check if attributes should be placed in a new content type section - if { ! [string equal $type_label $last_type] } { - set new_section_p 1 - } else { - set new_section_p 0 - } +# # check if attributes should be placed in a new content type section +# if { ! [string equal $type_label $last_type] } { +# set new_section_p 1 +# } else { +# set new_section_p 0 +# } - # if the attribute is new - if { ![string equal $last_attribute_name $attribute_name] } { +# # if the attribute is new +# if { ![string equal $last_attribute_name $attribute_name] } { - # if this is a new attribute and it isn't the first attribute ( $i != 1 ), - # then evaluate the current "element create" string, and reset the params lists - if { $i != 1 } { +# # if this is a new attribute and it isn't the first attribute ( $i != 1 ), +# # then evaluate the current "element create" string, and reset the params lists +# if { $i != 1 } { - if { [llength $html_params] } { - # widget has html parameters - lappend code_params -html $html_params - } - set form_element \ - "template::element create $form_name $last_attribute_name $code_params" - ns_log debug "content::get_revision_form: CREATING" - ns_log debug "content::get_revision_form: attribute : $last_attribute_name" - ns_log debug "content::get_revision_form: type_label: $last_type" - eval $form_element +# if { [llength $html_params] } { +# # widget has html parameters +# lappend code_params -html $html_params +# } +# set form_element \ +# "template::element create $form_name $last_attribute_name $code_params" +# ns_log debug "content::get_revision_form: CREATING" +# ns_log debug "content::get_revision_form: attribute : $last_attribute_name" +# ns_log debug "content::get_revision_form: type_label: $last_type" +# eval $form_element - set code_params [list] - set html_params [list] - } +# set code_params [list] +# set html_params [list] +# } - # start a new "element create" string - get_element_default_params - } +# # start a new "element create" string +# get_element_default_params +# } - # evaluate the param - get_revision_create_element - if { [info exists overrides($last_attribute_name)] } { - set code_params [concat $code_params $overrides($last_attribute_name)] - } +# # evaluate the param +# get_revision_create_element +# if { [info exists overrides($last_attribute_name)] } { +# set code_params [concat $code_params $overrides($last_attribute_name)] +# } - set last_attribute_name $attribute_name - set last_type $type_label - } +# set last_attribute_name $attribute_name +# set last_type $type_label +# } - # eval the last "element create" string - if { [llength $html_params] } { - # widget has html parameters - lappend code_params -html $html_params - } +# # eval the last "element create" string +# if { [llength $html_params] } { +# # widget has html parameters +# lappend code_params -html $html_params +# } - set form_element "template::element create $form_name $last_attribute_name $code_params" - ns_log debug "content::get_revision_form: ELEMENT CREATE: $form_element" - eval $form_element +# set form_element "template::element create $form_name $last_attribute_name $code_params" +# ns_log debug "content::get_revision_form: ELEMENT CREATE: $form_element" +# eval $form_element - # add some default form elements - eval template::element create $form_name content_type \ - -widget hidden -datatype keyword -value $content_type +# # add some default form elements +# eval template::element create $form_name content_type \ +# -widget hidden -datatype keyword -value $content_type - if { ![string equal $item_id ""] } { - eval template::element create $form_name item_id \ - -widget hidden -datatype integer -value $item_id - } -} +# if { ![string equal $item_id ""] } { +# eval template::element create $form_name item_id \ +# -widget hidden -datatype integer -value $item_id +# } +# } -ad_proc -public content::get_element_default_params {} { +ad_proc -public cms::form::get_element_default_params {} { PRE: requires datatype, widget, attribute_label, is_required code_params to be set in the calling frame @@ -310,7 +317,7 @@ } } -ad_proc content::get_revision_create_element {} { +ad_proc cms::form::get_revision_create_element {} { PRE: requires the following variables to be set in the uplevel scope: db, code_params, html_params, @@ -369,90 +376,90 @@ } -ad_proc -public content::process_revision_form { form_name content_type item_id {db{}} } { +# ad_proc -public content::process_revision_form { form_name content_type item_id {db{}} } { - perform the appropriate DML based on metadata +# perform the appropriate DML based on metadata -} { +# } { - template::form get_values $form_name title description mime_type +# template::form get_values $form_name title description mime_type - # create the basic revision - set revision_id [db_exec_plsql new_content_revision {}] +# # create the basic revision +# set revision_id [db_exec_plsql new_content_revision {}] - # query for extended attribute tables - set last_table "" - set last_id_column "" - db_multirow rows get_extended_attributes "" +# # query for extended attribute tables +# set last_table "" +# set last_id_column "" +# db_multirow rows get_extended_attributes "" - for { set i 1 } { $i <= ${rows:rowcount} } { incr i } { - upvar 0 "rows:${i}" row - template::util::array_to_vars row +# for { set i 1 } { $i <= ${rows:rowcount} } { incr i } { +# upvar 0 "rows:${i}" row +# template::util::array_to_vars row - ns_log debug "content::process_revision_form: attribute_name $attribute_name" - ns_log debug "content::process_revision_form: table_name $table_name" +# ns_log debug "content::process_revision_form: attribute_name $attribute_name" +# ns_log debug "content::process_revision_form: table_name $table_name" - if { ![string equal $last_table $table_name] } { - if { $i != 1 } { - content::process_revision_form_dml - } - set columns [list] - set values [list] - } +# if { ![string equal $last_table $table_name] } { +# if { $i != 1 } { +# content::process_revision_form_dml +# } +# set columns [list] +# set values [list] +# } - # fetch the value of the attribute from the form - if { ![template::util::is_nil attribute_name] } { - set $attribute_name [template::element::get_value \ - $form_name $attribute_name] +# # fetch the value of the attribute from the form +# if { ![template::util::is_nil attribute_name] } { +# set $attribute_name [template::element::get_value \ +# $form_name $attribute_name] - lappend columns $attribute_name +# lappend columns $attribute_name - # If the attribute is a date, get the date - if { [string equal $datatype date] } { - set $attribute_name \ - [template::util::date::get_property sql_date [set $attribute_name]] - # Can't use bind vars because this will be a to_date call - lappend values "[set $attribute_name]" - } else { - lappend values ":$attribute_name" - } - } - set last_table $table_name - set last_id_column $id_column - } +# # If the attribute is a date, get the date +# if { [string equal $datatype date] } { +# set $attribute_name \ +# [template::util::date::get_property sql_date [set $attribute_name]] +# # Can't use bind vars because this will be a to_date call +# lappend values "[set $attribute_name]" +# } else { +# lappend values ":$attribute_name" +# } +# } +# set last_table $table_name +# set last_id_column $id_column +# } - content::process_revision_form_dml +# content::process_revision_form_dml - return $revision_id -} +# return $revision_id +# } -ad_proc -public content::process_revision_form_dml {} { +# ad_proc -public content::process_revision_form_dml {} { - helper function for process_revision_form - PRE: the following variables must be set in the uplevel scope: - columns, values, last_table +# helper function for process_revision_form +# PRE: the following variables must be set in the uplevel scope: +# columns, values, last_table -} { +# } { - upvar last_table __last_table - upvar columns __columns - upvar values __values - upvar __sql sql - set sql [db_map insert_revision_form] +# upvar last_table __last_table +# upvar columns __columns +# upvar values __values +# upvar __sql sql +# set sql [db_map insert_revision_form] - uplevel { +# uplevel { - if { ! [string equal $last_table {}] } { - lappend columns $last_id_column - lappend values ":revision_id" +# if { ! [string equal $last_table {}] } { +# lappend columns $last_id_column +# lappend values ":revision_id" - db_dml insert_revision_form $__sql - } - } -} +# db_dml insert_revision_form $__sql +# } +# } +# } -ad_proc -public content::insert_element_data { +ad_proc -public cms::form::insert_element_data { form_name content_type exclusion_list id_value \ {suffix ""} {extra_where ""} } { @@ -462,6 +469,7 @@ exclusion_list is a list of all object types for which the elements are NOT to be inserted id_value is the revision_id + @see www/modules/items/relate-items-2 } { @@ -476,7 +484,7 @@ append query [db_map ied_get_objects_tree_order_by] - ns_log debug "content::insert_element_data: $query" + ns_log debug "cms::form::insert_element_data: $query" set last_table "" set last_id_column "" @@ -486,12 +494,12 @@ upvar 0 "rows:${i}" row template::util::array_to_vars row - ns_log debug "content::insert_element_data: attribute_name $attribute_name" - ns_log debug "content::insert_element_data: table_name $table_name" + ns_log debug "cms::form::insert_element_data: attribute_name $attribute_name" + ns_log debug "cms::form::insert_element_data: table_name $table_name" if { ![string equal $last_table $table_name] } { if { $i != 1 } { - content::process_insert_statement + process_insert_statement } set columns [list] set values [list] @@ -519,16 +527,16 @@ set last_id_column $id_column } - content::process_insert_statement + process_insert_statement } -ad_proc -public content::process_insert_statement {} { +ad_proc -public cms::form::process_insert_statement {} { helper function for process_revision_form PRE: the following variables must be set in the uplevel scope: columns, values, last_table, id_value_ref - + @see www/modules/items/relate-items-2 } { upvar last_table __last_table upvar columns __columns @@ -547,61 +555,17 @@ } } -ad_proc -public content::assemble_passthrough { args } { - - Assemble a passthrough list out of variables - -} { - set result [list] - foreach varname $args { - upvar $varname var - lappend result [list $varname $var] - } - return $result -} - -ad_proc -public content::url_passthrough { passthrough } { - - Convert passthrough to a URL fragment - -} { - - set extra_url "" - foreach pair $passthrough { - append extra_url "&[lindex $pair 0]=[lindex $pair 1]" - } - return $extra_url -} - -ad_proc -public content::assemble_url { base_url args } { - - Assemble a URL out of component parts - -} { - set result $base_url - if { [string first $base_url "?"] == -1 } { - set joiner "?" - } else { - set joiner "&" - } - foreach fragment $args { - set fragment [string trimleft $fragment "&?"] - if { ![string equal $fragment {}] } { - append result $joiner $fragment - set joiner "&" - } - } - return $result -} - ################################################################# -# @namespace content - # Procedures for generating and processing content content creation # and editing forms.. -ad_proc -public content::new_item { form_name { storage_type text } { tmpfile "" } {prefix {StArT}} } { +ad_proc -public cms::form::new_item { + form_name + { storage_type text } + { tmpfile "" } + {prefix {StArT}} +} { Create a new item, including the initial revision, based on a valid form submission. @@ -619,16 +583,16 @@ @param prefix A prefix to remove from the form when looking up attributes - @see content::add_revision + @see cms::form::add_revision } { # Here we walk the item prefixes and create them all, unless the content_prefixes var # does not exist or we are already handling the form - ns_log Warning "content::new_item: handling prefix $prefix" + ns_log Warning "cms::form::new_item: handling prefix $prefix" if {[string equal "StArT" $prefix]} { if {[template::element exists $form_name content_prefixes]} { foreach prefix [template::element get_value $form_name content_prefixes] { - lappend item_id [content::new_item $form_name $storage_type $tmpfile $prefix] + lappend item_id [new_item $form_name $storage_type $tmpfile $prefix] } return $item_id } else { @@ -645,9 +609,9 @@ # If the item does not already exist build the call to create it. if { !$exists } { - array set defaults [list item_id "" locale "" parent_id "" content_type "content_revision"] + array set defaults [list item_id "" locale "" parent_id "" content_type "content_revision" creation_ip "" creation_user ""] - foreach param { item_id name locale parent_id content_type } { + foreach param { item_id name locale parent_id content_type creation_ip creation_user } { if { [template::element exists $form_name $prefix$param] } { set $param [template::element get_value $form_name $prefix$param] @@ -678,10 +642,10 @@ db_transaction { if {!$exists} { - set item_id [db_exec_plsql get_item_id " - begin - :1 := content_item.new( [join $params ","] ); - end;"] + set item_id [content::item::new -name $name -parent_id $parent_id \ + -locale $locale -item_id $item_id -storage_type $storage_type \ + -content_type $content_type -creation_ip $creation_ip \ + -creation_user $creation_user] } add_revision $form_name $tmpfile $prefix [expr !$exists] } @@ -699,7 +663,12 @@ } -ad_proc -public content::add_revision { form_name { tmpfile "" } {prefix {}} {new_p 1}} { +ad_proc -public cms::form::add_revision { + form_name + { tmpfile "" } + { prefix "" } + { new_p 1 } +} { Create a new revision for an existing item based on a valid form submission. Queries for attribute names and inserts a row into the @@ -708,16 +677,19 @@ for the revision as well. @param form_name Name of the form from which to obtain attribute - values. The form should include an item_id and revision_id. + values. The form should include an item_id, revision_id and + creation_user/creation_ip. @param tmpfile Name of the temporary file containing the content to upload. @param prefix A prefix to prepend when looking up attributes in the form data - @param new_p Whether the revision is attached to a new cr_item or if previousrevision exist + @param new_p Whether the revision is attached to a new cr_item or if previous revision exist + + @see called by revision-add-2 in the items module } { - ns_log Debug "content::add_revision: $form_name $tmpfile $prefix $new_p" + ns_log Debug "cms::form::add_revision: $form_name $tmpfile $prefix $new_p" # initialize an ns_set to hold bind values set bind_vars [ns_set create] @@ -754,7 +726,7 @@ } -ad_proc -private content::attribute_insert_statement { +ad_proc -private cms::form::attribute_insert_statement { content_type table_name bind_vars form_name {prefix {}} {new_p 1} } { @@ -775,14 +747,10 @@ submission. } { - # get creation_user and creation_ip - ns_set put $bind_vars creation_user null - ns_set put $bind_vars creation_ip null - # initialize the column and value list - set columns [list item_id revision_id creation_user creation_ip] - set values [list :item_id :revision_id null null] + set columns [list item_id revision_id] + set values [list :item_id :revision_id] set default_columns [list] set default_values [list] set missing_columns [list] @@ -807,7 +775,7 @@ } } - if { ! [string equal $value {} ] } { + if { ! [string equal $value {}] && ![expr { [string equal $ancestor "content_revision"] && [string equal $attribute_name "title"] }] } { ns_set put $bind_vars $attribute_name $value lappend columns $attribute_name @@ -837,7 +805,7 @@ } -ad_proc -private content::add_revision_dml { statement bind_vars tmpfile filename } { +ad_proc -private cms::form::add_revision_dml { statement bind_vars tmpfile filename } { Perform the DML to insert a revision into the appropriate input view. @@ -869,7 +837,7 @@ } -ad_proc -public content::upload_content { revision_id tmpfile filename } { +ad_proc -public cms::form::upload_content { revision_id tmpfile filename } { @private upload_content @@ -919,19 +887,11 @@ db_dml upload_file_revision {} } elseif {[string equal $storage_type text]} { # upload the file into the revision content - db_dml upload_text_revision "update cr_revisions - set content = empty_blob(), - content_length = '[file size $tmpfile]' - where revision_id = :revision_id - returning content into :1" -blob_files [list $tmpfile] + db_dml upload_text_revision {} -blob_files [list $tmpfile] } else { # upload the file into the revision content - db_dml upload_revision "update cr_revisions - set content = empty_blob(), - content_length = '[file size $tmpfile]' - where revision_id = :revision_id - returning content into :1" -blob_files [list $tmpfile] + db_dml upload_revision {} -blob_files [list $tmpfile] } # this seems to abort the transaction even with the catch. @@ -951,7 +911,7 @@ } -ad_proc -private content::get_sql_value { name datatype } { +ad_proc -private cms::form::get_sql_value { name datatype } { Return the sql statement for a column value in an insert or update statement, using a bind variable for the actual value and wrapping it @@ -974,7 +934,7 @@ } -ad_proc -private content::prepare_content_file { form_name } { +ad_proc -private cms::form::prepare_content_file { form_name } { Looks for an element named "content" in a form and prepares a temporarily file in UTF-8 for uploading to the content repository. @@ -1022,7 +982,7 @@ } -ad_proc -private content::string_to_file { s } { +ad_proc -private cms::form::string_to_file { s } { Write a string in UTF-8 encoding to of temp file so it can be uploaded into a BLOB (which is blind to character encodings). @@ -1047,7 +1007,7 @@ # Form preparation procs -namespace eval content { +namespace eval cms::form { variable columns set columns [list object_type sort_order attribute_name param_type \ @@ -1057,7 +1017,7 @@ } -ad_proc -public content::new_item_form { args } { +ad_proc -public cms::form::new_item_form { args } { Adds elements to an ATS form object for creating an item and its initial revision. If the form does not already exist, creates the @@ -1128,7 +1088,7 @@ } } - if { [string equal {} $opts(item_id)] } { + if { $opts(item_id) eq "" } { # Only add all this junk for # new items. @@ -1186,7 +1146,7 @@ if { [template::form is_request $opts(form_name)] } { if {[template::util::is_nil item_id]} { - set item_id [get_object_id] + set item_id [new_object_id] template::element set_properties $opts(form_name) "$opts(prefix)item_id" -value $item_id @@ -1206,7 +1166,7 @@ } -ad_proc -public content::add_revision_form { args } { +ad_proc -public cms::form::add_revision_form { args } { Adds elements to an ATS form object for adding a revision to an existing item. If the item already exists, element values default a @@ -1273,7 +1233,7 @@ set attributes [add_attribute_elements $opts(form_name) $opts(content_type) {} $opts(prefix) $opts(section) $opts(exclude) $opts(hidden)] - ns_log debug "content::add_revision_form: content method $opts(content_method)" + ns_log debug "cms::form::add_revision_form: content method $opts(content_method); revision id $opts(revision_id)" add_content_element $opts(form_name) $opts(content_method) $opts(prefix) @@ -1283,11 +1243,11 @@ # template::element set_properties $opts(form_name) "$opts(prefix)revision_id" -value $revision_id - if { [string equal $opts(revision_id) {}] } { - set opts(revision_id) [get_latest_revision $opts(item_id)] + if { $opts(revision_id) eq "" } { + set opts(revision_id) [content::item::get_latest_revision -item_id $opts(item_id)] } - if { ! [string equal $opts(revision_id) {}] } { + if { $opts(revision_id) ne "" } { set_attribute_values $opts(form_name) $opts(content_type) \ $opts(revision_id) $attributes $opts(prefix) } @@ -1313,7 +1273,7 @@ } -ad_proc -public content::add_attribute_elements { +ad_proc -public cms::form::add_attribute_elements { form_name content_type { revision_id "" } {prefix {}} {section {}} {exclude {}} {hidden {}} } { @@ -1389,7 +1349,7 @@ } -ad_proc -public content::add_attribute_element { +ad_proc -public cms::form::add_attribute_element { form_name content_type attribute { attribute_data "" } {prefix {}} {section {}} {hidden_p 0} } { @@ -1413,8 +1373,8 @@ set command [list "template::element" create $form_name "$prefix$attribute"] - if { [string equal $attribute_data {}] } { - set attribute_data [get_attribute_params $content_type $attribute] + if { $attribute_data eq "" } { + set attribute_data [cms::form::get_attribute_params $content_type $attribute] } array set is_html $attribute_data @@ -1466,7 +1426,7 @@ -datatype $param(datatype) -section $section # changed from widget_is_required to param_is_required (OpenACS - DanW) - if { [string equal $param(param_is_required) f] } { + if { $param(param_is_required) eq "f" } { lappend command -optional } @@ -1476,7 +1436,7 @@ } -ad_proc -public content::add_content_element { +ad_proc -public cms::form::add_content_element { form_name content_method { prefix {}} @@ -1537,7 +1497,7 @@ } -ad_proc content::add_child_relation_element { form_name args } { +ad_proc cms::form::add_child_relation_element { form_name args } { Add a select box listing all valid child relation tags. The form must contain a parent_id element and a content_type element. @@ -1579,7 +1539,7 @@ } # Get the parent type. If the parent is not an item, abort - set parent_type [db_string get_parent_type ""] + set parent_type [content::item::get_content_type -item_id $parent_id] if { [template::util::is_nil parent_type] } { return @@ -1594,7 +1554,7 @@ # Create the section, if specified if { ![template::util::is_nil opts(section)] } { - set parent_title [db_string get_parent_title ""] + set parent_title [content::item::get_title -item_id $parent_id -is_live f] if { ![template::util::is_nil parent_title] } { template::form section $form_name "Relationship to $parent_title" @@ -1609,7 +1569,7 @@ } -ad_proc -private content::get_widget_param_value { +ad_proc -private cms::form::get_widget_param_value { array_ref {content_type content_revision} } { @@ -1672,7 +1632,7 @@ } -ad_proc -private content::get_type_attribute_params { args } { +ad_proc -private cms::form::get_type_attribute_params { args } { Query for attribute form metadata @@ -1704,7 +1664,7 @@ } -ad_proc -private content::get_attribute_params { content_type attribute_name } { +ad_proc -private cms::form::get_attribute_params { content_type attribute_name } { Query for parameters associated with a particular attribute @@ -1732,7 +1692,7 @@ } -ad_proc -private content::set_attribute_values { +ad_proc -private cms::form::set_attribute_values { form_name content_type revision_id attributes {prefix {}} } { @@ -1749,7 +1709,7 @@ } { if { [llength $attributes] == 0 } { - set attributes [get_attributes $content_type] + set attributes [cms::form::get_attributes $content_type] } # Assemble the list of columns to query, handling dates @@ -1798,7 +1758,7 @@ } -ad_proc -private content::set_content_value { form_name revision_id } { +ad_proc -private cms::form::set_content_value { form_name revision_id } { Set the default value for the content text area in an ATS form object based on a previous revision @@ -1808,14 +1768,14 @@ @param revision_id The revision ID of the content to revise } { + + set content [template::util::richtext::create [content::get_content_value $revision_id] {}] - set content [template::util::richtext::create [get_content_value $revision_id] {}] - template::element set_properties $form_name content -value $content } -ad_proc -private content::get_default_content_method { content_type } { +ad_proc -private cms::form::get_default_content_method { content_type } { Gets the content input method most appropriate for an content type, based on the MIME types that are registered for that content type. @@ -1824,23 +1784,20 @@ } { - set is_text [db_string count_mime_type ""] - - if { $is_text > 0 } { - set content_method text_entry + if { [cms::type::has_text_mime_types_p -content_type $content_type] } { + return text_entry } else { - set content_method file_upload + return file_upload } - return $content_method } # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # Procedure wrappers for basic ACS Object and Content Repository queries # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -ad_proc -private content::get_type_info { object_type ref args } { +ad_proc -private cms::form::get_type_info { object_type ref args } { Return specified columns from the acs_object_types table. @@ -1864,7 +1821,7 @@ } -ad_proc -public content::get_object_id {} { +ad_proc -public cms::form::new_object_id {} { Grab an object ID for creating a new ACS object. @@ -1874,7 +1831,7 @@ } -ad_proc -private content::get_attributes { content_type args } { +ad_proc -private cms::form::get_attributes { content_type args } { Returns columns from the acs_attributes table for all attributes associated with a content type. @@ -1909,7 +1866,7 @@ } -ad_proc -public content::get_attribute_enum_values { attribute_id } { +ad_proc -public cms::form::get_attribute_enum_values { attribute_id } { Returns a list of { pretty_name enum_value } for an attribute of datatype enumeration. @@ -1924,22 +1881,8 @@ return $enum } -ad_proc -public content::get_latest_revision { item_id } { +ad_proc -public cms::form::add_basic_revision { item_id revision_id title args } { - Get the ID of the latest revision for the specified content item. - - @param item_id The ID of the content item. - -} { - - set latest_revision [db_string glr_get_latest_revision ""] - - return $latest_revision -} - - -ad_proc -public content::add_basic_revision { item_id revision_id title args } { - Create a basic new revision using the content_revision PL/SQL API. @param item_id @@ -1979,7 +1922,7 @@ } -ad_proc -private content::update_content_from_file { revision_id tmpfile } { +ad_proc -private cms::form::update_content_from_file { revision_id tmpfile } { Update the BLOB column of a revision with the contents of a file @@ -2001,26 +1944,14 @@ where revision_id = :revision_id)} if {[string equal $storage_type file]} { - db_dml upload_file_revision " - update cr_revisions - set filename = '[cr_create_content_file $item_id $revision_id $tmpfile]', - content_length = [file size $tmpfile] - where revision_id = :revision_id" + db_dml upload_file_revision {} } elseif {[string equal $storage_type text]} { # upload the file into the revision content - db_dml upload_text_revision "update cr_revisions - set content = empty_blob(), - content_length = [file size $tmpfile] where - revision_id = :revision_id - returning content into :1" -blob_files [list $tmpfile] + db_dml upload_text_revision {} -blob_files [list $tmpfile] } else { # upload the file into the revision content - db_dml upload_revision "update cr_revisions - set content = empty_blob(), - content_length = [file size $tmpfile] - where revision_id = :revision_id - returning content into :1" -blob_files [list $tmpfile] + db_dml upload_revision {} -blob_files [list $tmpfile] } # delete the tempfile @@ -2029,7 +1960,7 @@ -ad_proc -public content::copy_content { revision_id_src revision_id_dest } { +ad_proc -public cms::form::copy_content { revision_id_src revision_id_dest } { Update the BLOB column of one revision with the content of another revision @@ -2039,19 +1970,13 @@ @param revision_id_dest The object ID of the revision to be updated. copied. + @see only used by attributes-edit in the items module } { db_transaction { # copy the content from the source to the target - db_exec_plsql cc_copy_content { - begin - content_revision.content_copy ( - revision_id => :revision_id_src, - revision_id_dest => :revision_id_dest - ); - end; - } + db_exec_plsql cc_copy_content {} # fetch the mime_type of the source revision set mime_type [db_string cc_get_mime_type ""] @@ -2063,7 +1988,7 @@ } -ad_proc -public content::add_content { form_name revision_id } { +ad_proc -public cms::form::add_content { form_name revision_id } { Update the BLOB column of a revision with content submitted in a form @@ -2087,7 +2012,7 @@ } } -ad_proc -public content::validate_name { form_name } { +ad_proc -public cms::form::validate_name { form_name } { Make sure that name is unique for the folder Index: openacs-4/packages/cms/tcl/form-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/form-procs.xql,v diff -u -N -r1.9 -r1.9.12.1 --- openacs-4/packages/cms/tcl/form-procs.xql 19 Sep 2002 13:09:12 -0000 1.9 +++ openacs-4/packages/cms/tcl/form-procs.xql 31 Aug 2006 19:59:05 -0000 1.9.12.1 @@ -25,7 +25,7 @@ - + and $extra_where @@ -43,15 +43,15 @@ - + and $extra_where - + order by @@ -60,7 +60,7 @@ - + insert into $__last_table ( [join $__columns ", "] @@ -70,7 +70,7 @@ - + select object_type as content_type, table_name from acs_object_types @@ -89,7 +89,7 @@ - + select @@ -108,18 +108,9 @@ - + - select content_type from cr_items - where item_id = :parent_id - - - - - - - $param(value) @@ -138,7 +129,7 @@ - + select @@ -153,7 +144,7 @@ - + select @@ -166,18 +157,9 @@ - + - select count(*) from cr_content_mime_type_map - where content_type = :content_type and mime_type like 'text/%' - - - - - - - select $ref from @@ -220,7 +202,7 @@ - + select count(1) @@ -230,7 +212,7 @@ - + select count(1) Index: openacs-4/packages/cms/tcl/image-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/image-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/image-procs.tcl 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,25 @@ +ad_library { + Helper procs for images +} + +namespace eval cms::image {} + +ad_proc -public cms::image::get { + -image_id:required + {-revision_id "" } + {-array_name "content_item" } +} { + get a template revision + + @param template_id item id of the template you want + @return array + +} { + + if { $revision_id eq "" } { + set revision_id [content::item::get_latest_revision -item_id $image_id] + } + upvar $array_name local_array + return [db_0or1row select_image {} -column_array local_array] + +} Index: openacs-4/packages/cms/tcl/image-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/image-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/image-procs.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,13 @@ + + + + + + + select * from images i join cr_revisions r on (i.image_id = r.revision_id) + join cr_items it on (r.item_id = it.item_id) + where i.image_id = :revision_id + + + + Index: openacs-4/packages/cms/tcl/install-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/install-procs-oracle.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/install-procs-oracle.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,11 @@ + + +oracle8.1.6 + + + + select acs_rel_type.create_role(:role,:pn,:pp) + + + + \ No newline at end of file Index: openacs-4/packages/cms/tcl/install-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/install-procs-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/install-procs-postgresql.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,11 @@ + + +postgresql7.1 + + + + select acs_rel_type__create_role(:role,:pn,:pp) + + + + \ No newline at end of file Index: openacs-4/packages/cms/tcl/install-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/install-procs.tcl,v diff -u -N -r1.1.2.2 -r1.1.2.3 --- openacs-4/packages/cms/tcl/install-procs.tcl 9 Jun 2005 21:15:26 -0000 1.1.2.2 +++ openacs-4/packages/cms/tcl/install-procs.tcl 31 Aug 2006 19:59:05 -0000 1.1.2.3 @@ -1,32 +1,226 @@ ad_library { - install callbacks + Install routines for CMS package } namespace eval cms::install {} +ad_proc -public cms::install::package_install {} { + Procedures to run on package installation +} { + + db_transaction { + # register callback implementations and create the basic workflow + cms::install::register_implementations + set workflow_id [cms::workflow::create] + ns_log debug "cms::install::package_install - workflow_id is $workflow_id" + + # add system roles for editors, authors and publishers + # roles will be mapped to subsite rel segments on package instantiation + # --Role-- --Pretty-- --Plural-- + set roles " [list author Author Authors] \ + [list editor Editor Editors] \ + [list publisher Publisher Publishers]" + + foreach {role pn pp} $roles { + + # Base existence check on existing role + if { ![db_0or1row role_exists {}] } { + db_1row new_role create_role {} + } + } + } +} + +ad_proc -public cms::install::package_uninstall {} { + Procedures to run on package uninstall (roles will remain in system) +} { + cms::workflow::delete + cms::install::unregister_implementations +} + ad_proc -public cms::install::package_instantiate { -package_id } { Procedures to run on package instantiation } { - # create modules for new instance + # create modules and clone workflow for new instance cm::modules::install::create_modules -package_id $package_id + cms::workflow::instance_workflow_create -package_id $package_id - set subsite_id [ad_conn subsite_id] + array set package_info [site_node::get_from_object_id -object_id $package_id] + set subsite_package [site_node::closest_ancestor_package -url $package_info(url) -element package_id] + array set subsite_info [site_node::get_from_object_id -object_id $subsite_package] + db_dml map_subsite {} - set subsite_dir "[acs_root_dir]/www" - append subsite_dir [site_node::get_url_from_object_id -object_id [ad_conn subsite_id]] + set subsite_dir "[acs_root_dir]/www/$subsite_info(url)" # check that directory exists and... if { ![file exists $subsite_dir] } { file mkdir $subsite_dir } # copy content delivery .vuh file to subsite root file copy -force [acs_root_dir]/packages/cms/www/index.vuh $subsite_dir - + + # set up subsite segments for for workflow + set app_group [application_group::group_id_from_package_id -package_id $subsite_package] + + set roles " [list author Author Authors] \ + [list editor Editor Editors] \ + [list publisher Publisher Publishers]" + set content_root [cm::modules::sitemap::getRootFolderID $subsite_package] + set template_root [cm::modules::templates::getRootFolderID $subsite_package] + + foreach { role pn pp } $roles { + set rel [rel_types::new -supertype membership_rel -role_one "" -role_two $role ${role}_rel_${subsite_package} \ + "$subsite_info(instance_name) $pn" "$subsite_info(instance_name) $pp" group 0 0 person 0 0] + rel_types::add_permissible application_group $rel + # MS: move to tcl API with 5.2 + db_dml update_group_rels {} + set segment [rel_segments_new $app_group $rel "$subsite_info(instance_name) $pp"] + switch $role { + publisher { + permission::grant -party_id $segment -object_id $content_root -privilege admin + permission::grant -party_id $segment -object_id $template_root -privilege admin + } + default { + permission::grant -party_id $segment -object_id $content_root -privilege read + permission::grant -party_id $segment -object_id $template_root -privilege read + permission::grant -party_id $segment -object_id $content_root -privilege create + permission::grant -party_id $segment -object_id $template_root -privilege create + permission::grant -party_id $segment -object_id $content_root -privilege write + permission::grant -party_id $segment -object_id $template_root -privilege write + } + } + } + + # register template folder with dav module + #set subsite_node [site_node::get_node_id_from_object_id -object_id [ad_conn subsite_id]] + #set templates_node [site_node::new -name templates -parent_id $subsite_node] + #oacs_dav::register_folder $templates_folder $templates_node } -ad_proc -public cms::install::package_uninstantiate { -package_id } { +ad_proc -public cms::install::package_uninstantiate { -package_id:required } { Procedures to run on package uninstantiation } { + # unregister template folder + #set subsite_url [site_node::get_url -node_id [site_node::get_node_id_from_object_id -object_id [ad_conn subsite_id]] -notrailing] + #array set template_node [site_node::get_from_url -url ${subsite_url}/templates] + #set template_root [cm::modules::templates::getRootFolderID $package_id $template_node(node_id)] + #oacs_dav::unregister_folder $template_root node_id + + # delete modules and workflow cm::modules::install::delete_modules -package_id $package_id + cms::workflow::instance_workflow_delete -package_id $package_id + + # remove index.vuh + set subsite_dir "[acs_root_dir]/www" + append subsite_dir [site_node::get_url_from_object_id -object_id [ad_conn subsite_id]] + file delete -force $subsite_dir/index.vuh } + + +##### +# +# Service contract implementations +# +##### + +ad_proc -private cms::install::register_implementations {} { + db_transaction { + cms::install::register_get_authors_impl + cms::install::register_get_editors_impl + cms::install::register_get_publishers_impl + cms::install::register_set_publish_status_impl + } +} + +ad_proc -private cms::install::unregister_implementations {} { + db_transaction { + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::role_default_assignees] \ + -impl_name "GetAuthors" + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::role_default_assignees] \ + -impl_name "GetEditors" + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::role_default_assignees] \ + -impl_name "GetPublishers" + + acs_sc::impl::delete \ + -contract_name [workflow::service_contract::action_side_effect] \ + -impl_name "SetPublishStatus" + + } +} + +ad_proc -private cms::install::register_get_authors_impl {} { + + set spec { + name "GetAuthors" + aliases { + GetObjectType cms::workflow::object_type + GetPrettyName cms::workflow::get_authors::pretty_name + GetAssignees cms::workflow::get_authors::get_assignees + } + } + + lappend spec contract_name [workflow::service_contract::role_default_assignees] + lappend spec owner [cms::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} + +ad_proc -private cms::install::register_get_editors_impl {} { + + set spec { + name "GetEditors" + aliases { + GetObjectType cms::workflow::object_type + GetPrettyName cms::workflow::get_editors::pretty_name + GetAssignees cms::workflow::get_editors::get_assignees + } + } + + lappend spec contract_name [workflow::service_contract::role_default_assignees] + lappend spec owner [cms::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} + +ad_proc -private cms::install::register_get_publishers_impl {} { + + set spec { + name "GetPublishers" + aliases { + GetObjectType cms::workflow::object_type + GetPrettyName cms::workflow::get_publishers::pretty_name + GetAssignees cms::workflow::get_publishers::get_assignees + } + } + + lappend spec contract_name [workflow::service_contract::role_default_assignees] + lappend spec owner [cms::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} + +ad_proc -private cms::install::register_set_publish_status_impl {} { + + set spec { + name "SetPublishStatus" + aliases { + GetObjectType cms::workflow::object_type + GetPrettyName cms::workflow::set_publish_status::pretty_name + DoSideEffect cms::workflow::set_publish_status::set_status + } + } + + lappend spec contract_name [workflow::service_contract::action_side_effect] + lappend spec owner [cms::package_key] + + acs_sc::impl::new_from_spec -spec $spec +} + + Index: openacs-4/packages/cms/tcl/install-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/install-procs.xql,v diff -u -N -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/cms/tcl/install-procs.xql 9 Jun 2005 21:15:26 -0000 1.1.2.1 +++ openacs-4/packages/cms/tcl/install-procs.xql 31 Aug 2006 19:59:05 -0000 1.1.2.2 @@ -1,12 +1,27 @@ + + + select r.pretty_name from acs_rel_roles r where r.role=:role + + + + + + insert into group_rels + (group_rel_id, group_id, rel_type) + values + (acs_object_id_seq.nextval,:app_group,:rel); + + + insert into cms_subsite_package_map (subsite_id,package_id) values - (:subsite_id,:package_id) + (:subsite_package,:package_id) Index: openacs-4/packages/cms/tcl/item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/item-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/item-procs.tcl 31 Aug 2006 19:59:05 -0000 1.10.2.2 @@ -0,0 +1,42 @@ +ad_library { + Helper procs for content items +} + +namespace eval cms::item {} + +ad_proc -public cms::item::get_id_from_revision { + -revision_id:required +} { + Retrieve the ID for given revision +} { + + return [db_string get_id {}] +} + +ad_proc -public cms::item::has_text_content_p { + -revision_id:required +} { + Does this item have any text in the content DB field? + @return boolean +} { + + return [expr [db_string get_content_length {}] > 0] +} + +ad_proc -public cms::item::storage_type { + -revision_id:required +} { + @return string containing either "text" or "file" +} { + + return [db_string get_storage_type {} -default "text"] +} + +ad_proc -public cms::item::mime_type { + -revision_id:required +} { + @return string containing mime type +} { + + return [db_string get_mime_type {}] +} Index: openacs-4/packages/cms/tcl/item-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/item-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/item-procs.xql 31 Aug 2006 19:59:05 -0000 1.5.2.2 @@ -0,0 +1,33 @@ + + + + + + select item_id from cr_revisions where revision_id = :revision_id + + + + + + select coalesce(char_length(content),0) + from cr_revisions + where revision_id = :revision_id + + + + + + select i.storage_type + from cr_items i join cr_revisions r on (i.item_id = r.item_id) + where r.revision_id = :revision_id + + + + + + select mime_type from cr_revisions where revision_id = :revision_id + + + + + Index: openacs-4/packages/cms/tcl/perm-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/perm-procs-oracle.xql,v diff -u -N --- openacs-4/packages/cms/tcl/perm-procs-oracle.xql 14 Aug 2001 18:11:30 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,97 +0,0 @@ - - - - oracle8.1.6 - - - - - select - p.privilege, - cms_permission.permission_p ( - :object_id, :user_id, p.privilege - ) as is_granted - from - acs_privileges p - - - - - - - - select - acs_object.name(:object_id) as obj_name, - pretty_name as perm_name - from - acs_privileges - where - privilege = :privilege - - - - - - - select - t.child_privilege as privilege, - lpad(' ', t.tree_level * 24, ' ') || - NVL(p.pretty_name, t.child_privilege) as label, - cms_permission.permission_p( - :object_id, :grantee_id, t.child_privilege - ) as permission_p, - cms_permission.permission_p ( - :object_id, :grantee_id, t.privilege - ) as parent_permission_p - from ( - select privilege, child_privilege, level as tree_level - from acs_privilege_hierarchy - connect by privilege = prior child_privilege - start with privilege = 'cm_root' - ) t, acs_privileges p - where - p.privilege = t.child_privilege - and ( - cms_permission.has_grant_authority ( - :object_id, :user_id, t.child_privilege - ) = 't' - or - cms_permission.has_revoke_authority ( - :object_id, :user_id, t.child_privilege, :grantee_id - ) = 't' - ) - - - - - - - begin - cms_permission.grant_permission ( - item_id => :object_id, - holder_id => :user_id, - privilege => :privilege, - recepient_id => :grantee_id, - is_recursive => :pf_is_recursive - ); - end; - - - - - - - begin - cms_permission.revoke_permission ( - item_id => :object_id, - holder_id => :user_id, - privilege => :privilege, - revokee_id => :grantee_id, - is_recursive => :pf_is_recursive - ); - end; - - - - - Index: openacs-4/packages/cms/tcl/perm-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/perm-procs-postgresql.xql,v diff -u -N --- openacs-4/packages/cms/tcl/perm-procs-postgresql.xql 8 Dec 2001 01:18:00 -0000 1.4 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,83 +0,0 @@ - - - - postgresql7.1 - - - - - - select - p.privilege, - cms_permission__permission_p ( - :object_id, :user_id, p.privilege - ) as is_granted - from - acs_privileges p - - - - - - - - select - acs_object__name(:object_id) as obj_name, - pretty_name as perm_name - from - acs_privileges - where - privilege = :privilege - - - - - - - select - t.child_privilege as privilege, - lpad(' ', t.tree_level * 24, ' ') || coalesce(p.pretty_name, t.child_privilege) as label, - cms_permission__permission_p(:object_id, :grantee_id, t.child_privilege) as permission_p, - cms_permission__permission_p (:object_id, :grantee_id, t.privilege) as parent_permission_p - from (select h1.privilege, h1.child_privilege, - tree_level(h1.tree_sortkey) as tree_level - from acs_privilege_hierarchy_index h1, acs_privilege_hierarchy_index h2 - where h2.privilege = 'cm_root' - and h1.tree_sortkey between h2.tree_sortkey and tree_right(h2.tree_sortkey) - and tree_ancestor_p(h2.tree_sortkey, h1.tree_sortkey) - ) t, acs_privileges p - where - p.privilege = t.child_privilege - and ( - cms_permission__has_grant_authority ( - :object_id, :user_id, t.child_privilege - ) = 't' - or - cms_permission__has_revoke_authority ( - :object_id, :user_id, t.child_privilege, :grantee_id - ) = 't' - ) - - - - - - - - - select cms_permission__grant_permission (:object_id, :user_id, :privilege, :grantee_id, :pf_is_recursive) - - - - - - - - - select cms_permission__revoke_permission (:object_id, :user_id, :privilege, :grantee_id, :pf_is_recursive) - - - - - - Index: openacs-4/packages/cms/tcl/perm-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/perm-procs.tcl,v diff -u -N --- openacs-4/packages/cms/tcl/perm-procs.tcl 16 Nov 2004 22:32:46 -0000 1.7 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,236 +0,0 @@ -############################################## -# -# Functions dealing with permissions -# -############################################## - -ad_proc -public content::show_error { - message {return_url {}} {passthrough {}} -} { - - Redirect the user to an error message - In the future, have this procedure produce a custom, internationalized - error message, or something - - Will pick up mount_point, id, parent_id if they exist in the calling - frame - - -} { - - if { [template::util::is_nil return_url] } { - set return_url [ns_conn url] - } - - foreach var { mount_point id parent_id } { - upvar $var $var - if { ![template::util::is_nil $var] } { - lappend passthrough [list $var [set $var]] - } - } - - template::forward "[ad_conn package_url]error?[export_vars { message return_url passthrough}]" -} - - -ad_proc -public content::check_access { object_id privilege args } { - - Query the datatbase for access, show the error page if - no sufficient access is found. Set up an array - called "user_permissions" in the calling frame, where the keys - are permissions and the values are "t" or "f" - Flags: - -user_id - -mount_point - -parent_id - -return_url - -passthrough < { {name value} {name value} ... } - -request_error: if present, use request error as opposed to error box - -refresh: if present, update query cache - - -} { - - # Set up the default options - foreach varname { mount_point return_url parent_id passthrough } { - set opts($varname) "" - } - - template::util::get_opts $args - - if { [template::util::is_nil opts(user_id)] } { - set user_id [auth::require_login] - } else { - set user_id $opts(user_id) - } - - # Query the database, set up the array - upvar user_permissions user_permissions - - if { [info exists opts(refresh)] } { - set switches "-refresh" - } else { - set switches "" - } - - set perm_list [db_list_of_lists ca_get_perm_list ""] - - template::util::list_of_lists_to_array $perm_list user_permissions - - # If we have no permission to view this page, abort - if { [string equal $user_permissions($privilege) f] } { - foreach varname { mount_point return_url parent_id passthrough } { - set $varname $opts($varname) - } - - # See if the user is even logged in - set user_name [db_string ca_get_user_name ""] - - if { [template::util::is_nil user_name] } { - set msg "You are not logged in. Press Ok to go to the login screen." - set return_url "[ad_conn package_url]signin" - } else { - - # Get the error message - db_0or1row ca_get_msg_info "" -column_array msg_info - - if { ![info exists msg_info] } { - set msg "Access Denied: no such privilege $privilege" - } else { - set msg "Access Denied: you do not possess the $msg_info(perm_name)" - append msg " privilege on $msg_info(obj_name)" - } - } - - # Show the error message - lappend passthrough [list mount_point $opts(mount_point)] \ - [list parent_id $opts(parent_id)] - - # Display either the request error or redirect ot an error box - if { [info exists opts(request_error)] } { - template::request::error access_denied $msg - return - } else { - content::show_error $msg $return_url $passthrough - } - - } - -} - -ad_proc -public content::flush_access_cache { {object_id {}} } { - - Flush the cache used by check_access - -} { - template::query::flush_cache "content::check_access ${object_id}*" -} - -ad_proc -public content::perm_form_generate { form_name_in {passthrough "" } } { - - Generate a form for modifying permissions - Requires object_id, grantee_id, user_id to be set in calling frame - -} { - - upvar perm_form_name form_name - set form_name $form_name_in - - upvar __sql sql - set sql [db_map pfg_get_permission_boxes] - - uplevel { - set is_request [form is_request $perm_form_name] - - # Get a list of all the possible permissions, along with a flag - # to see if the user has the permission - set permission_options [list] - set permission_values [list] - - db_multirow permission_boxes pfg_execute_gpb $__sql { - if { [string equal $parent_permission_p f] } { - lappend permission_options [list $label $privilege] - if { [string equal $permission_p t] && $is_request } { - lappend permission_values $privilege - } - } - } - - # Only show checkboxes if the privilege is in pf_show_boxes - # The join is just a hack for now - # set pf_show_boxes [join $pf_show_boxes "|"] - - element create $perm_form_name object_id -label "Object ID" \ - -datatype integer -widget hidden -param - - element create $perm_form_name grantee_id -label "Grantee ID" \ - -datatype integer -widget hidden -param - - element create $perm_form_name pf_boxes -label "Permissions" \ - -datatype text -widget checkbox -options $permission_options \ - -values $permission_values -optional - - element create $perm_form_name pf_is_recursive \ - -label "Apply changes to child items and subfolders ?" \ - -datatype text \ - -widget radio -options { {Yes t} {No f} } -values { f } - } - - foreach varname $passthrough { - uplevel "element create $form_name $varname -label \"$varname\" \\ - -datatype text -widget hidden -value \$$varname -optional" - } - -} - - -ad_proc -public content::perm_form_process { form_name_in } { - - Process the permission form - -} { - - upvar perm_form_name form_name - set form_name $form_name_in - - upvar __sql_grant sql_grant - upvar __sql_revoke sql_revoke - set sql_grant [db_map pfp_grant_permission_1] - set sql_revoke [db_map pfp_revoke_permission_1] - - uplevel { - - if { [form is_valid $perm_form_name] } { - - set user_id [User::getID] - - form get_values $perm_form_name object_id grantee_id pf_is_recursive - set permission_values [element get_values $perm_form_name pf_boxes] - - db_transaction { - - # Assign checked permissions, unassign unchecked ones - foreach pair $permission_options { - set privilege [lindex $pair 1] - if { [lsearch $permission_values $privilege] >= 0 } { - db_dml pfp_grant_permission $__sql_grant - } else { - db_dml pfp_revoke_permission $__sql_revoke - } - } - - } - - # Recache the permissions - content::check_access $object_id "cm_read" \ - -user_id $user_id -refresh - - } - } - -} - - - - - Index: openacs-4/packages/cms/tcl/perm-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/perm-procs.xql,v diff -u -N --- openacs-4/packages/cms/tcl/perm-procs.xql 11 Aug 2001 17:41:34 -0000 1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,13 +0,0 @@ - - - - - - - select screen_name from users where user_id = :user_id - - - - - - Index: openacs-4/packages/cms/tcl/publish-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/publish-procs-oracle.xql,v diff -u -N -r1.3 -r1.3.14.1 --- openacs-4/packages/cms/tcl/publish-procs-oracle.xql 17 Sep 2001 05:16:40 -0000 1.3 +++ openacs-4/packages/cms/tcl/publish-procs-oracle.xql 31 Aug 2006 19:59:05 -0000 1.3.14.1 @@ -3,7 +3,7 @@ oracle8.1.6 - + select @@ -23,7 +23,7 @@ - + select Index: openacs-4/packages/cms/tcl/publish-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/publish-procs-postgresql.xql,v diff -u -N -r1.4 -r1.4.14.1 --- openacs-4/packages/cms/tcl/publish-procs-postgresql.xql 17 Sep 2001 05:16:40 -0000 1.4 +++ openacs-4/packages/cms/tcl/publish-procs-postgresql.xql 31 Aug 2006 19:59:05 -0000 1.4.14.1 @@ -5,7 +5,7 @@ - + select @@ -25,7 +25,7 @@ - + select Index: openacs-4/packages/cms/tcl/publish-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/publish-procs.tcl,v diff -u -N -r1.16.2.1 -r1.16.2.2 --- openacs-4/packages/cms/tcl/publish-procs.tcl 6 Jun 2005 17:05:58 -0000 1.16.2.1 +++ openacs-4/packages/cms/tcl/publish-procs.tcl 31 Aug 2006 19:59:05 -0000 1.16.2.2 @@ -1,19 +1,18 @@ -############################################################### -# -# @namespace publish -# -# @author Stanislav Freidin -# -# The procs in this namespace are useful for publishing items, -# including items inside other items, and writing items to the -# filesystem.

-# Specifically, the content, child and -# relation tags are defined here. -# -# @see namespace item item.html +ad_library { -namespace eval publish { + The procs in this namespace are useful for publishing items, + including items inside other items, and writing items to the + filesystem.

+ Specifically, the content, child and + relation tags are defined here. + @namespace publish + @author Stanislav Freidin + @see namespace item item.html + +} + +namespace eval cms::publish { variable item_id_stack variable revision_html } @@ -93,32 +92,32 @@ -ad_proc -public publish::get_template_root {} { +# ad_proc -public publish::get_template_root {} { - @public get_template_root +# @public get_template_root - Get the template root. All templates are assumed to exist - in the filesystem with their URLs relative to this root. - The page root is controlled by the TemplateRoot parameter in CMS. - The default is /web/yourserver/templates +# Get the template root. All templates are assumed to exist +# in the filesystem with their URLs relative to this root. +# The page root is controlled by the TemplateRoot parameter in CMS. +# The default is /web/yourserver/templates - @return The template root +# @return The template root - @see content::get_template_root - @see publish::get_page_root +# @see content::get_template_root +# @see publish::get_page_root -} { - return [content::get_template_root] -} +# } { +# return [content::get_template_root] +# } -ad_proc -public content::get_template_path {} { +# ad_proc -public content::get_template_path {} { - Legacy compatibility +# Legacy compatibility -} { - return [publish::get_template_root] -} +# } { +# return [publish::get_template_root] +# } # ad_proc -public publish::mkdirs { path } { @@ -141,27 +140,33 @@ -ad_proc -private publish::delete_multiple_files { url {root_path ""}} { +ad_proc -private cms::publish::delete_multiple_files { + url + {root_path ""} +} { @private delete_multiple_files Delete the specified URL from the filesystem, for all revisions @param url Relative URL of the file to write - @see publish::get_publish_roots - @see publish::write_multiple_files - @see publish::write_multiple_blobs + @see cms::publish::get_publish_roots + @see cms::publish::write_multiple_files + @see cms::publish::write_multiple_blobs } { foreach_publish_path $url { ns_unlink -nocomplain $filename - ns_log debug "publish::delete_multiple_files: Delete file $filename" + ns_log debug "cms::cms::publish::delete_multiple_files: Delete file $filename" } $root_path } -ad_proc -public publish::publish_revision { revision_id args} { +ad_proc -public cms::publish::publish_revision { + revision_id + args +} { @public publish_revision @@ -175,8 +180,8 @@ Write the content to this path only. @see item::get_extended_url - @see publish::get_publish_roots - @see publish::handle_item + @see cms::publish::get_publish_roots + @see cms::publish::handle_item } { @@ -187,9 +192,9 @@ } else { set root_path $opts(root_path) } - ns_log debug "publish::publish_revision: root_path = $root_path" + ns_log debug "cms::publish::publish_revision: root_path = $root_path" # Get tem id - set item_id [item::get_item_from_revision $revision_id] + set item_id [cms::item::get_id_from_revision $revision_id] # Render the item set item_content [handle_item $item_id -revision_id $revision_id -embed] @@ -203,7 +208,7 @@ } -ad_proc -public publish::unpublish_item { item_id args } { +ad_proc -public cms::publish::unpublish_item { item_id args } { @public unpublish_item @@ -217,7 +222,7 @@ @option root_path {default All paths in the PublishPaths parameter} Write the content to this path only. - @see publish::publish_revision + @see cms::publish::publish_revision } { @@ -231,7 +236,7 @@ # Get revision id if { [template::util::is_nil opts(revision_id)] } { - set revision_id [item::get_live_revision $item_id] + set revision_id [content::item::get_live_revision -item_id $item_id] } else { set revision_id $opts(revision_id) } @@ -277,7 +282,7 @@ # Scheduled proc stuff -ad_proc -public publish::set_publish_status { item_id new_status {revision_id ""} } { +ad_proc -public cms::publish::set_publish_status { item_id new_status {revision_id ""} } { @public set_publish_status @@ -292,17 +297,17 @@ @param revision_id {default The live revision} The revision id to be used when publishing the item to the filesystem. - @see publish::publish_revision - @see publish::unpublish_item + @see cms::publish::publish_revision + @see cms::publish::unpublish_item } { - ns_log debug "publish::set_publish_status: Setting publish status for item_id $item_id to $new_status" + ns_log debug "cms::publish::set_publish_status: Setting publish status for item_id $item_id to $new_status" switch $new_status { production - expired { # Delete the published files - publish::unpublish_item $item_id + cms::publish::unpublish_item $item_id } ready { @@ -318,7 +323,7 @@ set new_status [list [list publish_status production]] content::item::update -item_id $item_id -attributes $new_status # Delete the published files - #publish::unpublish_item $item_id + #cms::publish::unpublish_item $item_id } else { set new_status [list [list publish_status ready]] content::item::update -item_id $item_id -attributes $new_status @@ -339,13 +344,13 @@ set new_status [list [list publish_status live]] ns_log notice "MS: got a revision, setting status to $new_status" content::item::update -item_id $item_id -attributes $new_status - #publish_revision $revision_id -root_path [publish::get_publish_roots] + #publish_revision $revision_id -root_path [cms::publish::get_publish_roots] } else { # Delete the published files set new_status [list [list publish_status production]] ns_log notice "MS: no revision, setting status to $new_status" content::item::update -item_id $item_id -attributes $new_status - #publish::unpublish_item $item_id + #cms::publish::unpublish_item $item_id #set new_status "production" } } @@ -357,17 +362,17 @@ } -ad_proc -private publish::track_publish_status {} { +ad_proc -private cms::publish::track_publish_status {} { @private track_publish_status Scheduled proc which keeps the publish status updated - @see publish::schedule_status_sweep + @see cms::publish::schedule_status_sweep } { - ns_log debug "publish::track_publish_status: Tracking publish status" + ns_log debug "cms::publish::track_publish_status: Tracking publish status" db_transaction { # if { [catch { @@ -380,26 +385,27 @@ foreach pair $items { set item_id [lindex $pair 0] set live_revision [lindex $pair 1] - publish::set_publish_status $item_id live $live_revision + cms::publish::set_publish_status $item_id live $live_revision } # Get all live but expired items, make them nonlive set items [db_list tps_get_items_onelist ""] foreach item_id $items { - publish::set_publish_status $item_id expired + cms::publish::set_publish_status $item_id expired + # MS: update workflow state here } # } errmsg] } { -# ns_log Warning "publish::track_publish_status: error: $errmsg" +# ns_log Warning "cms::publish::track_publish_status: error: $errmsg" # } } } -# ad_proc -public publish::schedule_status_sweep { {interval ""} } { +# ad_proc -public cms::publish::schedule_status_sweep { {interval ""} } { # @public schedule_status_sweep @@ -417,9 +423,9 @@ # StatusSweepInterval parameter in the server's INI file is used # (if it exists). -# @see publish::set_publish_status -# @see publish::unschedule_status_sweep -# @see publish::track_publish_status +# @see cms::publish::set_publish_status +# @see cms::publish::unschedule_status_sweep +# @see cms::publish::track_publish_status # } { @@ -431,25 +437,25 @@ # # if cms is installed but not mounted, return reasonable default # if { $interval == "" } { # set interval 3600 -# ns_log Warning "publish::schedule_status_sweep: unable to lookup package_id for cms defaulting to interval 3600" +# ns_log Warning "cms::publish::schedule_status_sweep: unable to lookup package_id for cms defaulting to interval 3600" # } -# ns_log notice "publish::schedule_status_sweep: Scheduling status sweep every $interval seconds for package_id $package_id" -# set proc_id ns_schedule_proc -thread $interval publish::track_publish_status +# ns_log notice "cms::publish::schedule_status_sweep: Scheduling status sweep every $interval seconds for package_id $package_id" +# set proc_id ns_schedule_proc -thread $interval cms::publish::track_publish_status # cache set status_sweep_proc_id_${package_id} $proc_id # } # } # } -ad_proc -public publish::unschedule_status_sweep {} { +ad_proc -public cms::publish::unschedule_status_sweep {} { @public unschedule_status_sweep Unschedule the proc which keeps track of the publish status. - @see publish::schedule_status_sweep + @see cms::publish::schedule_status_sweep } { @@ -459,8 +465,3 @@ } } - -# Actually schedule the status sweep - -#publish::schedule_status_sweep - Index: openacs-4/packages/cms/tcl/publish-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/publish-procs.xql,v diff -u -N -r1.3.2.1 -r1.3.2.2 --- openacs-4/packages/cms/tcl/publish-procs.xql 6 Jun 2005 17:05:58 -0000 1.3.2.1 +++ openacs-4/packages/cms/tcl/publish-procs.xql 31 Aug 2006 19:59:05 -0000 1.3.2.2 @@ -1,14 +1,14 @@ - + update cr_items set publish_status = :new_status where item_id = :item_id - + select package_id from apm_packages where package_key = 'cms' Index: openacs-4/packages/cms/tcl/rel-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/rel-procs.tcl,v diff -u -N -r1.5 -r1.5.8.1 --- openacs-4/packages/cms/tcl/rel-procs.tcl 17 May 2003 10:23:15 -0000 1.5 +++ openacs-4/packages/cms/tcl/rel-procs.tcl 31 Aug 2006 19:59:05 -0000 1.5.8.1 @@ -1,9 +1,11 @@ -# @namespace cms_rel -# Procedures for managing relation items and child items +ad_library { + Procedures for managing related/child items +} -namespace eval cms_rel {} +# @namespace cms::rel +namespace eval cms::rel {} -ad_proc -public cms_rel::sort_related_item_order { item_id } { +ad_proc -public cms::rel::sort_related_item_order { item_id } { @public sort_related_item_order @@ -35,7 +37,7 @@ } -ad_proc -public cms_rel::sort_child_item_order { item_id } { +ad_proc -public cms::rel::sort_child_item_order { item_id } { @public sort_child_item_order Index: openacs-4/packages/cms/tcl/rel-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/rel-procs.xql,v diff -u -N -r1.2 -r1.2.8.1 --- openacs-4/packages/cms/tcl/rel-procs.xql 17 May 2003 10:23:15 -0000 1.2 +++ openacs-4/packages/cms/tcl/rel-procs.xql 31 Aug 2006 19:59:05 -0000 1.2.8.1 @@ -1,7 +1,7 @@ - + select @@ -17,7 +17,7 @@ - + update cr_item_rels set order_n = :i @@ -26,7 +26,7 @@ - + select @@ -41,7 +41,7 @@ - + update cr_child_rels set order_n = :i Index: openacs-4/packages/cms/tcl/template-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/template-procs-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/template-procs-postgresql.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,11 @@ + + +postgresql7.2 + + + + select content_revision__new(:title, :description, current_timestamp, :mime_type, null, :content, :template_id, null, current_timestamp, :creation_user, :creation_ip) + + + + \ No newline at end of file Index: openacs-4/packages/cms/tcl/template-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/template-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/template-procs.tcl 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,124 @@ +ad_library { + + Procs for content_template, and some helper procs + +} + +namespace eval cms::template {} + +ad_proc -public cms::template::get { + -template_id:required + {-revision_id "" } + {-array_name "template_info" } +} { + get a template revision + + @param template_id item id of the template you want + @return array + +} { + + if { $revision_id eq "" } { + set revision_id [content::item::get_latest_revision -item_id $template_id] + } + upvar $array_name local_array + return [db_0or1row select_template {} -column_array local_array] + +} + +ad_proc -public cms::template::add_revision { + -template_id:required + { -title "" } + { -description "" } + { -content "" } + { -mime_type "" } + { -creation_user "" } + { -creation_ip "" } +} { + add a template revision + + + @param template_id item id of the template you want to add a new revision to + @param title title of the template + @param description description of the template + @param content content of the template + @param mime_type mime type for template + @param creation_user user_id creating this item + @param creation_ip ip address which this item is created + + @return revision_id + +} { + return [db_exec_plsql add_revision {}] +} + +ad_proc -public cms::template::mime_type_options {} { + return template mime_types +} { + return [db_list_of_lists get_mime_types {}] +} + +ad_proc -public cms::template::move { + -template_id:required + -target_folder_id:required +} { + Handle the file system part of deleting a template. You must also call content::item::move. + + @see content::item::move +} { + + set template_root [cm::modules::templates::getRootFolderID [ad_conn subsite_id]] + set base_path "[acs_root_dir]/templates" + set existing_path "${base_path}/[content::template::get_path -template_id $template_id -root_folder_id $template_root]" + # need actual template name; could split the path above but this is just as easy if a bit slower + cms::template::get -template_id $template_id + set new_path "${base_path}/[content::item::get_path -item_id $target_folder_id -root_folder_id $template_root]" + file mkdir $new_path + if { [catch { file rename -force ${existing_path}.adp ${new_path}/$template_info(name).adp } err] } { + ns_log debug "cms::template::move: encountered error moving template adp: $err" + } + if { [catch { file rename -force ${existing_path}.tcl ${new_path}/$template_info(name).tcl } err] } { + ns_log debug "cms::template::move: encountered error moving template code: $err" + } + +} + +ad_proc -public cms::template::rename { + -template_id:required + -name:required +} { + Handle the file system part of renaming a template. You must also call content::item::rename. + + @see content::item::rename +} { + set template_root [cm::modules::templates::getRootFolderID [ad_conn subsite_id]] + set base_path "[acs_root_dir]/templates" + content::item::get -item_id $template_id + set parent_path [content::item::get_path -item_id $content_item(parent_id) -root_folder_id $template_root] + set old_name "${base_path}/[content::template::get_path -template_id $template_id -root_folder_id $template_root]" + set new_name "${base_path}/${parent_path}/${name}" + if { [catch { file rename -force ${old_name}.adp ${new_name}.adp } err] } { + ns_log debug "cms::template::rename: encountered error renaming template adp: $err" + } + if { [catch { file rename -force ${old_name}.tcl ${new_name}.tcl } err] } { + ns_log debug "cms::template::rename: encountered error renaming template code: $err" + } +} + +ad_proc -public cms::template::delete { + -template_id:required +} { + Handle the file system part of deleting a template. You must also call content::item::delete. + + @see content::item::delete +} { + set template_root [cm::modules::templates::getRootFolderID [ad_conn subsite_id]] + set base_path "[acs_root_dir]/templates" + set template_path "${base_path}/[content::template::get_path -template_id $template_id -root_folder_id $template_root]" + if { [catch { file delete ${template_path}.adp } err] } { + ns_log debug "cms::template::delete: encountered error deleting template adp: $err" + } + if { [catch { file delete ${template_path}.tcl } err] } { + ns_log debug "cms::template::delete: encountered error deleting template code: $err" + } +} \ No newline at end of file Index: openacs-4/packages/cms/tcl/template-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/template-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/template-procs.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,21 @@ + + + + + + + select * from cr_templates t join cr_revisions r on (t.template_id = r.item_id) + join cr_items i on (r.item_id = i.item_id) + where t.template_id = :template_id + and r.revision_id = :revision_id + + + + + + select label, m.mime_type from cr_mime_types m, cr_content_mime_type_map t + where t.content_type = 'content_template' and t.mime_type = m.mime_type + + + + \ No newline at end of file Index: openacs-4/packages/cms/tcl/type-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/type-procs-oracle.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/type-procs-oracle.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,36 @@ + + + + oracle8.1.6 + + + + + select + content_method + from + cm_content_methods m + where + content_method = content_method.get_method (:content_type ) + $text_entry_filter + + + + + + + + + select + label, content_method + from + cm_content_methods m + where + m.content_method = content_method.get_method( :content_type ) + $text_entry_filter + + + + + + Index: openacs-4/packages/cms/tcl/type-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/type-procs-postgresql.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/type-procs-postgresql.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,36 @@ + + + + postgresql7.1 + + + + + select + content_method + from + cm_content_methods m + where + content_method = content_method__get_method (:content_type ) + $text_entry_filter + + + + + + + + + select + label, content_method + from + cm_content_methods m + where + m.content_method = content_method__get_method( :content_type ) + $text_entry_filter + + + + + + Index: openacs-4/packages/cms/tcl/type-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/type-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/type-procs.tcl 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,294 @@ +ad_library { + Helper procs for content types +} + +namespace eval cms::type {} + +ad_proc -public cms::type::pretty_name { + -content_type:required +} { + Retrieve the pretty name for given type +} { + + return [db_string get_pretty_name {}] +} + +ad_proc -public cms::type::has_subtypes_p { + -content_type:required +} { + @return boolean +} { + + return [expr [db_string get_subtype_count {}] > 0] +} + +ad_proc -public cms::type::has_mime_types_p { + -content_type:required +} { + Function based on code in old content_add::content_method_html proc + which would spit out html to allow selection of content_method + @return boolean +} { + + return [expr [db_string get_mime_type_count {}] > 0] +} + +ad_proc -public cms::type::has_text_mime_types_p { + -content_type:required +} { + Function based on code in old content_add::content_method_html proc + which would spit out html to allow selection of content_method + @return boolean +} { + + return [expr [db_string get_text_mime_type_count {}] > 0] +} + +ad_proc -public cms::type::get_content_methods { content_type args } { + + Returns a list of content_methods that are associated with + a content type, first checking for a default method, then for registered + content methods, and then for all content methods + + @author Michael Pih + + @param content_type The content type + @option get_labels Instead of a list of content methods, return + a list of label-value pairs of associated content methods. + @return A list of content methods or a list of label-value pairs of + content methods if the "-get_labels" option is specified + + @see cms::type::get_content_method_options + @see cms::type::text_entry_filter_sql + +} { + template::util::get_opts $args + + if { [info exists opts(get_labels)] } { + set methods \ + [cms::type::get_content_method_options $content_type] + return $methods + } + + set text_entry_filter [text_entry_filter_sql $content_type] + + # get default content method (if any) + set default_method [db_string get_default_method ""] + + # if the default exists, return it + if { ![template::util::is_nil default_method] } { + set methods [list $default_method] + } else { + # otherwise look up all content method mappings + + set methods [db_list get_methods_1 ""] + } + + # if there are no mappings, return all methods + if { [template::util::is_nil methods] } { + + set methods [db_list get_methods_2 ""] + } + + return $methods +} + + +ad_proc -private cms::type::get_content_method_options { content_type } { + + Returns a list of label, content_method pairs that are associated with + a content type, first checking for a default method, then for registered + content methods, and then for all content methods + + @author Michael Pih + @param content_type The content type + @return A list of label, value pairs of content methods + + @see cms::type::get_content_methods + @see cms::type::text_entry_filter_sql + +} { + + set text_entry_filter [text_entry_filter_sql $content_type] + + db_0or1row get_content_default_method "" + + if { ![template::util::is_nil content_method] } { + set methods [list [list $label $content_method]] + } else { + # otherwise look up all content methods mappings + set methods [db_list_of_lists get_methods_1 ""] + } + + # if there are no mappings, return all methods + if { [template::util::is_nil methods] } { + + set methods [db_list_of_lists get_methods_2 ""] + } + + return $methods +} + + +ad_proc -private cms::type::text_entry_filter_sql { + content_type +} { + + Generate a SQL stub that filters out the text_entry content method + + @author Michael Pih + @param content_type mime type + + @return SQL stub that possibly filters out the text_entry content method + +} { + + set text_entry_filter_sql "" + + set has_text_mime_type [db_string count_text_mime_types ""] + + if { $has_text_mime_type == 0 } { + set text_entry_filter_sql \ + "and m.content_method <> 'text_entry'" + } + + return $text_entry_filter_sql +} + + + +ad_proc -public cms::type::flush_content_methods_cache { + {content_type ""} +} { + + Flushes the cache for content_method_types for a given content type. If no + content type is specified, the entire content_method_types cache is + flushed + + @author Michael Pih + @param content_type The content type, default null + +} { + + if { [template::util::is_nil content_type] } { + # FIXME: figure out what to do with these after template::query calls + # are gone. + + # flush the entire content_method_types cache + template::query::flush_cache "content_method_types*" + } else { + + # flush the content_method_types cache for a content type + # 1) flush the default method cache + template::query::flush_cache \ + "content_method_types_default $content_type" + template::query::flush_cache \ + "content_method_types_n_labels_default $content_type" + + # 2) flush the mapped methods cache + template::query::flush_cache "content_method_types ${content_type}*" + + # 3) flush the all methods cache + template::query::flush_cache "content_method_types" + template::query::flush_cache "content_method_types_n_labels" + } +} + +ad_proc -public cms::type::set_content_method_default { + -content_type:required + -content_method:required +} { + + @author Michael Steigman + @param content_type The content type + @param content_method The new default content method + +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type] [list content_method $content_method]] \ + content_method set_default_method] +} + +ad_proc -public cms::type::unset_content_method_default { + -content_type:required +} { + + @author Michael Steigman + @param content_type The content type + @return integer +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type]] \ + content_method unset_default_method] +} + +ad_proc -public cms::type::remove_content_method { + -content_type:required + -content_method:required +} { + + @author Michael Steigman + @param content_type The content type + @param content_type The method to remove + @return integer +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type] [list content_method $content_method] \ + content_method remove_method] +} + +ad_proc -public cms::type::add_content_method { + -content_type:required + -content_method:required +} { + + @author Michael Steigman + @param content_type The content type + @param content_type The method to add + @return integer +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type] [list content_method $content_method] \ + content_method add_method] +} + +ad_proc -public cms::type::add_all_content_methods { + -content_type:required +} { + + @author Michael Steigman + @param content_type The content type + @return integer +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type]] \ + content_method add_all_methods] +} + +ad_proc -public cms::type::content_method_is_mapped_p { + -content_type:required + -content_method:required +} { + + @author Michael Steigman + @param content_type The content type + @param content_type The method to check + @return integer +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type] [list content_method $content_method] \ + content_method is_mapped] +} + +ad_proc -public cms::type::get_content_method { + -content_type:required +} { + + @author Michael Steigman + @param content_type The content type + @return integer +} { + + return [package_exec_plsql -var_list [list [list content_type $content_type] \ + content_method get_method] +} Index: openacs-4/packages/cms/tcl/type-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/type-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/type-procs.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,81 @@ + + + + + + select pretty_name from acs_object_types where object_type = :content_type + + + + + + select count(*) from acs_object_types where supertype = :content_type + + + + + + select count(*) + from cr_content_mime_type_map + where content_type = :content_type + + + + + + select count(*) + from cr_content_mime_type_map + where mime_type like ('%text/%') + and content_type = :content_type + + + + + + select count(*) + from cr_content_mime_type_map + where mime_type like ('%text/%') + and content_type = :content_type + + + + + + select map.content_method + from cm_content_type_method_map map, cm_content_methods m + where map.content_method = m.content_method + and map.content_type = :content_type + $text_entry_filter + + + + + + select content_method + from cm_content_methods m + where 1 = 1 + $text_entry_filter + + + + + + select label, map.content_method + from cm_content_methods m, cm_content_type_method_map map + where m.content_method = map.content_method + and map.content_type = :content_type + $text_entry_filter + + + + + + select label, content_method + from cm_content_methods m + where 1 = 1 + $text_entry_filter + + + + + Index: openacs-4/packages/cms/tcl/widget-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/widget-procs-postgresql.xql,v diff -u -N -r1.1 -r1.1.14.1 --- openacs-4/packages/cms/tcl/widget-procs-postgresql.xql 11 Aug 2001 17:41:34 -0000 1.1 +++ openacs-4/packages/cms/tcl/widget-procs-postgresql.xql 31 Aug 2006 19:59:05 -0000 1.1.14.1 @@ -3,7 +3,7 @@ postgresql7.1 - + select cm_form_widget__set_attribute_param_value (:content_type, :attribute_name, :param_$order, :param_value_$order, :param_type_$order, :param_source_$order) Index: openacs-4/packages/cms/tcl/widget-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/widget-procs.tcl,v diff -u -N -r1.4 -r1.4.14.1 --- openacs-4/packages/cms/tcl/widget-procs.tcl 20 Aug 2001 04:35:42 -0000 1.4 +++ openacs-4/packages/cms/tcl/widget-procs.tcl 31 Aug 2006 19:59:05 -0000 1.4.14.1 @@ -1,14 +1,11 @@ +ad_library { + Procedures for generating and processing metadata form widgets, editing + attribute widgets +} -# @namespace widget +namespace eval cms::widget {} -# Procedures for generating and processing metadata form widgets, editing -# attribute widgets - -namespace eval widget {} - - - -ad_proc -public widget::param_element_create { form param order param_id \ +ad_proc -public cms::widget::param_element_create { form param order param_id \ {default ""} {is_required ""} {param_source ""}} { @public param_element_create @@ -51,7 +48,7 @@ -ad_proc -private widget::create_param_type { form order } { +ad_proc -private cms::widget::create_param_type { form order } { @private create_param_type @@ -77,7 +74,7 @@ -ad_proc -private widget::create_param_source { form order param_source } { +ad_proc -private cms::widget::create_param_source { form order param_source } { @private create_param_source @@ -101,7 +98,7 @@ } -ad_proc -private widget::create_param_value { form order default is_required } { +ad_proc -private cms::widget::create_param_value { form order default is_required } { @private create_param_value @@ -137,7 +134,7 @@ } -ad_proc -private widget::create_text_param { form order default is_required param_source} { +ad_proc -private cms::widget::create_text_param { form order default is_required param_source} { @private create_text_param @@ -159,15 +156,15 @@ -widget hidden \ -value "onevalue" - widget::create_param_source $form $order $param_source - widget::create_param_value $form $order $default $is_required + cms::widget::create_param_source $form $order $param_source + cms::widget::create_param_value $form $order $default $is_required } -ad_proc -private widget::create_options_param { form order default is_required \ +ad_proc -private cms::widget::create_options_param { form order default is_required \ param_source} { @private create_options_param @@ -192,13 +189,13 @@ -widget hidden \ -value "multilist" - widget::create_param_source $form $order $param_source - widget::create_param_value $form $order $default $is_required + cms::widget::create_param_source $form $order $param_source + cms::widget::create_param_value $form $order $default $is_required } -ad_proc -private widget::create_values_param { form order default is_required param_source} { +ad_proc -private cms::widget::create_values_param { form order default is_required param_source} { @private create_values_param @@ -222,15 +219,15 @@ -widget hidden \ -value "onelist" - widget::create_param_source $form $order $param_source - widget::create_param_value $form $order $default $is_required + cms::widget::create_param_source $form $order $param_source + cms::widget::create_param_value $form $order $default $is_required } -ad_proc -private widget::process_param { form order content_type attribute_name } { +ad_proc -private cms::widget::process_param { form order content_type attribute_name } { @private process_param @@ -250,17 +247,7 @@ param_source_$order param_value_$order - db_exec_plsql pp_proces_param " - begin - cm_form_widget.set_attribute_param_value ( - content_type => :content_type, - attribute_name => :attribute_name, - param => :param_$order, - param_type => :param_type_$order, - param_source => :param_source_$order, - value => :param_value_$order - ); - end;" + db_exec_plsql pp_proces_param {} } Index: openacs-4/packages/cms/tcl/workflow-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/workflow-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/workflow-procs.tcl 31 Aug 2006 19:59:05 -0000 1.11.2.2 @@ -0,0 +1,263 @@ +ad_library { + Workflow proc +} + +namespace eval cms::workflow {} +namespace eval cms::workflow::get_authors {} +namespace eval cms::workflow::get_editors {} +namespace eval cms::workflow::get_publishers {} +namespace eval cms::workflow::set_publish_status {} + +ad_proc -public cms::workflow::object_type {} { + Return object type +} { + return "content_revision" +} + +ad_proc -public cms::workflow::create {} { + Create a basic workflow for content +} { + + set spec { + content { + pretty_name "Content" + package_key "cms" + object_type "content_revision" + roles { + author { + pretty_name "Author" + } + editor { + pretty_name "Editor" + callbacks { + cms.GetEditors + workflow.Role_PickList_CurrentAssignees + } + } + publisher { + pretty_name "Publisher" + callbacks { + cms.GetPublishers + workflow.Role_PickList_CurrentAssignees + } + } + } + states { + initiated { + pretty_name "Initiated" + } + authored { + pretty_name "Authored" + } + edited { + pretty_name "Edited" + } + ready { + pretty_name "Ready" + } + live { + pretty_name "Live" + } + expired { + pretty_name "Expired" + } + + } + actions { + initiate { + pretty_name "Initiate" + pretty_past_tense "Initiated" + new_state "initiated" + enabled_states { live expired } + + } + author { + pretty_name "Author" + pretty_past_tense "Authored" + new_state "authored" + callbacks { cms.SetPublishStatus } + } + edit { + pretty_name "Edit" + pretty_past_tense "Edited" + new_state "edited" + assigned_role "editor" + allowed_roles { publisher } + assigned_states { authored } + privileges { write } + } + publish { + pretty_name "Publish" + pretty_past_tense "Published" + new_state "ready" + callbacks { cms.SetPublishStatus } + assigned_role "publisher" + assigned_states { edited } + enabled_states { authored } + privileges { write } + } + reject { + pretty_name "Reject" + pretty_past_tense "Rejected" + new_state "authored" + callbacks { cms.SetPublishStatus } + assigned_role "publisher" + assigned_states { edited } + enabled_states { authored ready live } + privileges { write } + } + comment { + pretty_name "Comment" + pretty_past_tense "Commented" + privileges { read write } + always_enabled_p t + } + } + } + } + + set workflow_id [workflow::fsm::new_from_spec -spec $spec] + + return $workflow_id + + +} + +ad_proc -public cms::workflow::workflow_short_name {} { + Get the short name of the workflow for content +} { + return "content" +} + +ad_proc -public cms::workflow::get_package_workflow_id {} { + Return the workflow_id for the package (not instance) workflow +} { + return [workflow::get_id \ + -short_name [workflow_short_name] \ + -package_key [cms::package_key]] + +} + +ad_proc -public cms::workflow::get_instance_workflow_id { + {-package_id {}} +} { + Return the workflow_id for the instance (not package) workflow +} { + if { [empty_string_p $package_id] } { + set package_id [ad_conn package_id] + } + + return [workflow::get_id \ + -short_name [workflow_short_name] \ + -object_id $package_id] +} + +ad_proc -private cms::workflow::instance_workflow_create { + {-package_id:required} +} { + Creates a clone of the default bug-tracker package workflow for a + specific package instance +} { + set workflow_id [workflow::fsm::clone \ + -workflow_id [get_package_workflow_id] \ + -object_id $package_id] + + return $workflow_id +} + +ad_proc -private cms::workflow::instance_workflow_delete { + {-package_id:required} +} { + Deletes the instance workflow +} { + workflow::delete -workflow_id [get_instance_workflow_id -package_id $package_id] +} + +##### +# +# GetAuthors +# +##### + +ad_proc -private cms::workflow::get_authors::pretty_name {} { + return "GetAuthors" +} + + +ad_proc -private cms::workflow::get_authors::get_assignees {} { + case_id + object_id + action_id + entry_id +} { + set app_group [application_group::group_id_from_package_id \ + -package_id [ad_conn package_id]] + return [db_list get_authors {}] +} + +##### +# +# GetEditors +# +##### + +ad_proc -private cms::workflow::get_editors::pretty_name {} { + return "GetEditors" +} + + +ad_proc -private cms::workflow::get_editors::get_assignees {} { + case_id + object_id + action_id + entry_id +} { + set app_group [application_group::group_id_from_package_id \ + -package_id [ad_conn package_id]] + return [db_list get_editors {}] +} + +##### +# +# GetPublishers +# +##### + +ad_proc -private cms::workflow::get_publishers::pretty_name {} { + return "GetAuthors" +} + + +ad_proc -private cms::workflow::get_publishers::get_assignees {} { + case_id + object_id + action_id + entry_id +} { + set app_group [application_group::group_id_from_package_id \ + -package_id [ad_conn package_id]] + return [db_list get_publishers {}] +} + +##### +# +# SetPublishStatus +# +##### + +ad_proc -private cms::workflow::set_publish_status::pretty_name {} { + return "SetPublishStatus" +} + + +ad_proc -private cms::workflow::set_publish_status::set_status {} { + case_id + object_id + action_id + entry_id +} { + workflow::case::fsm::get -case_id $case_id -array case_info + content::item::update -item_id $object_id -attributes \ + [list publish_status $case_info(state_short_name)] +} + Index: openacs-4/packages/cms/tcl/workflow-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/tcl/Attic/workflow-procs.xql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/cms/tcl/workflow-procs.xql 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -0,0 +1,28 @@ + + + + + + select member_id from group_approved_member_map + where rel_type = 'author_rel' + and group_id = :app_group + + + + + + select member_id from group_approved_member_map + where rel_type = 'editor_rel' + and group_id = :app_group + + + + + + select member_id from group_approved_member_map + where rel_type = 'publisher_rel' + and group_id = :app_group + + + + Index: openacs-4/packages/cms/www/bookmark.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/bookmark.adp,v diff -u -N --- openacs-4/packages/cms/www/bookmark.adp 16 Nov 2004 22:32:47 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,4 +0,0 @@ -  - -  - Index: openacs-4/packages/cms/www/bookmark.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/bookmark.tcl,v diff -u -N --- openacs-4/packages/cms/www/bookmark.tcl 20 Apr 2001 20:51:09 -0000 1.1.1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,10 +0,0 @@ -# This is the template for a single bookmark icon -request create -request set_param mount_point -datatype keyword -request set_param id -datatype keyword - -set img_checked "[ad_conn package_url]resources/checked.gif" -set img_unchecked "[ad_conn package_url]resources/unchecked.gif" - -set package_url [ad_conn package_url] -set clipboardfloats_p [clipboard::floats_p] Index: openacs-4/packages/cms/www/error.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/error.adp,v diff -u -N --- openacs-4/packages/cms/www/error.adp 16 Nov 2004 22:32:47 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,17 +0,0 @@ - - -

- -

Error

- -
- - - - -@message@ - -

- - -

Index: openacs-4/packages/cms/www/error.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/error.tcl,v diff -u -N --- openacs-4/packages/cms/www/error.tcl 20 Apr 2001 20:51:09 -0000 1.1.1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,20 +0,0 @@ -# A generic error page - -request create -request set_param message -datatype text -request set_param return_url -datatype text -value [ns_conn url] -request set_param passthrough -datatype text - -# Create the vars datasource -set vars:rowcount 0 -upvar 0 vars:rowcount rowcount - -foreach pair $passthrough { - incr vars:rowcount - upvar 0 vars:$rowcount row - set row(name) [lindex $pair 0] - set row(value) [lindex $pair 1] - set row(rownum) ${vars:rowcount} -} - - Index: openacs-4/packages/cms/www/head.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/head.adp,v diff -u -N --- openacs-4/packages/cms/www/head.adp 17 May 2003 10:24:03 -0000 1.3 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,32 +0,0 @@ - - - - - -
- - - - -
My Workspace: @name@ - - Sign Out
- - - - - - Index: openacs-4/packages/cms/www/head.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/head.tcl,v diff -u -N --- openacs-4/packages/cms/www/head.tcl 16 Aug 2002 00:20:17 -0000 1.3 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,10 +0,0 @@ -# Get the name for the current user - -set user_id [User::getID] - -ns_log Notice $user_id - -set name [db_string get_name ""] - - - Index: openacs-4/packages/cms/www/head.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/head.xql,v diff -u -N --- openacs-4/packages/cms/www/head.xql 25 May 2001 02:28:33 -0000 1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,13 +0,0 @@ - - - - - - - select first_names || ' ' || last_name - from persons where person_id = :user_id - - - - - Index: openacs-4/packages/cms/www/index-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/index-oracle.xql,v diff -u -N --- openacs-4/packages/cms/www/index-oracle.xql 14 Jun 2001 00:28:06 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,24 +0,0 @@ - - - - oracle8.1.6 - - - - - select content_item.get_root_folder from dual - - - - - - - - - select content_template.get_root_folder from dual - - - - - - Index: openacs-4/packages/cms/www/index-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/index-postgresql.xql,v diff -u -N --- openacs-4/packages/cms/www/index-postgresql.xql 14 Jun 2001 00:28:06 -0000 1.2 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,24 +0,0 @@ - - - - postgresql7.1 - - - - - select content_item__get_root_folder(null) - - - - - - - - - select content_template__get_root_folder() - - - - - - Index: openacs-4/packages/cms/www/master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/master.adp,v diff -u -N -r1.6.2.1 -r1.6.2.2 --- openacs-4/packages/cms/www/master.adp 6 Jun 2005 15:39:10 -0000 1.6.2.1 +++ openacs-4/packages/cms/www/master.adp 31 Aug 2006 19:59:05 -0000 1.6.2.2 @@ -94,8 +94,5 @@ - \ No newline at end of file Index: openacs-4/packages/cms/www/table-footer.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/table-footer.adp,v diff -u -N --- openacs-4/packages/cms/www/table-footer.adp 16 Nov 2004 22:32:47 -0000 1.3 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,10 +0,0 @@ - - - - - - - @footer;noquote@ - - - \ No newline at end of file Index: openacs-4/packages/cms/www/table-footer.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/table-footer.tcl,v diff -u -N --- openacs-4/packages/cms/www/table-footer.tcl 20 Apr 2001 20:51:09 -0000 1.1.1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,3 +0,0 @@ -request create -request set_param footer -datatype text -value "" - Index: openacs-4/packages/cms/www/table-header.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/table-header.adp,v diff -u -N --- openacs-4/packages/cms/www/table-header.adp 16 Nov 2004 22:32:47 -0000 1.4 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,15 +0,0 @@ - - - - - - - - - - - -
@title;noquote@ - @header;noquote@ -   -
Index: openacs-4/packages/cms/www/table-header.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/table-header.tcl,v diff -u -N --- openacs-4/packages/cms/www/table-header.tcl 20 Apr 2001 20:51:09 -0000 1.1.1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,4 +0,0 @@ -request create -request set_param title -datatype text -value "" -request set_param header -datatype text -value "" - Index: openacs-4/packages/cms/www/modules/categories/delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/categories/delete.tcl,v diff -u -N -r1.6 -r1.6.2.1 --- openacs-4/packages/cms/www/modules/categories/delete.tcl 12 Apr 2005 21:45:42 -0000 1.6 +++ openacs-4/packages/cms/www/modules/categories/delete.tcl 31 Aug 2006 19:59:05 -0000 1.6.2.1 @@ -21,10 +21,10 @@ } # Remove it from the clipboard, if it exists - set clip [clipboard::parse_cookie] - clipboard::remove_item $clip $mount_point $id - clipboard::set_cookie $clip - clipboard::free $clip + set clip [cms::clipboard::parse_cookie] + cms::clipboard::remove_item $clip $mount_point $id + cms::clipboard::set_cookie $clip + cms::clipboard::free $clip ad_returnredirect "index?id=$parent_id&mount_point=$mount_point" } Index: openacs-4/packages/cms/www/modules/categories/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/categories/index.adp,v diff -u -N -r1.4 -r1.4.2.1 --- openacs-4/packages/cms/www/modules/categories/index.adp 12 Apr 2005 21:45:42 -0000 1.4 +++ openacs-4/packages/cms/www/modules/categories/index.adp 31 Aug 2006 19:59:05 -0000 1.4.2.1 @@ -3,7 +3,7 @@

- + @page_title;noquote@ Index: openacs-4/packages/cms/www/modules/categories/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/categories/index.tcl,v diff -u -N -r1.6.2.1 -r1.6.2.2 --- openacs-4/packages/cms/www/modules/categories/index.tcl 6 Jun 2005 17:07:23 -0000 1.6.2.1 +++ openacs-4/packages/cms/www/modules/categories/index.tcl 31 Aug 2006 19:59:05 -0000 1.6.2.2 @@ -59,7 +59,7 @@ } set page_title "$info(heading) $what" -set clip [clipboard::parse_cookie] +set clip [cms::clipboard::parse_cookie] template::list::create \ -name items \ @@ -95,5 +95,5 @@ } set id $keyword_id set keyword_url [export_vars -base index?mount_point=categories { id parent_id }] - set copy [clipboard::ui::render_bookmark categories $keyword_id [ad_conn package_url]] + set copy [cms::clipboard::ui::render_bookmark categories $keyword_id [ad_conn package_url]] } Index: openacs-4/packages/cms/www/modules/categories/keyword-assign.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/categories/keyword-assign.tcl,v diff -u -N -r1.4.2.1 -r1.4.2.2 --- openacs-4/packages/cms/www/modules/categories/keyword-assign.tcl 6 Jun 2005 17:07:23 -0000 1.4.2.1 +++ openacs-4/packages/cms/www/modules/categories/keyword-assign.tcl 31 Aug 2006 19:59:05 -0000 1.4.2.2 @@ -14,9 +14,9 @@ # Preserve the item_id since the clipboard::parse_cookie wil overwrite it set saved_item_id $item_id -set clip [clipboard::parse_cookie] +set clip [cms::clipboard::parse_cookie] db_transaction { - clipboard::map_code $clip categories { + cms::clipboard::map_code $clip categories { if { [catch { db_exec_plsql assign_keyword { @@ -28,6 +28,6 @@ } } -clipboard::free $clip +cms::clipboard::free $clip template::forward "../items/index?item_id=$saved_item_id&mount_point=$mount_point" Index: openacs-4/packages/cms/www/modules/categories/move.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/categories/move.tcl,v diff -u -N -r1.3 -r1.3.2.1 --- openacs-4/packages/cms/www/modules/categories/move.tcl 12 Apr 2005 21:45:42 -0000 1.3 +++ openacs-4/packages/cms/www/modules/categories/move.tcl 31 Aug 2006 19:59:05 -0000 1.3.2.1 @@ -15,11 +15,11 @@ set update_value "$target_id" } -set clip [clipboard::parse_cookie] +set clip [cms::clipboard::parse_cookie] db_transaction { - clipboard::map_code $clip $mount_point { + cms::clipboard::map_code $clip $mount_point { if { [catch { db_dml move_keyword_item {} db_dml move_keyword_keyword {} @@ -29,7 +29,7 @@ } } -clipboard::free $clip +cms::clipboard::free $clip set id $target_id ad_returnredirect [export_vars -base index {id mount_point}] Index: openacs-4/packages/cms/www/modules/clipboard/add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/clipboard/add.tcl,v diff -u -N --- openacs-4/packages/cms/www/modules/clipboard/add.tcl 20 Apr 2001 20:51:10 -0000 1.1.1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1 +0,0 @@ -# Add an object to the clipboard \ No newline at end of file Index: openacs-4/packages/cms/www/modules/clipboard/clear-clipboard.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/clipboard/clear-clipboard.tcl,v diff -u -N -r1.3 -r1.3.2.1 --- openacs-4/packages/cms/www/modules/clipboard/clear-clipboard.tcl 9 May 2005 23:45:14 -0000 1.3 +++ openacs-4/packages/cms/www/modules/clipboard/clear-clipboard.tcl 31 Aug 2006 19:59:05 -0000 1.3.2.1 @@ -6,5 +6,5 @@ {float_p "0"} } -#clipboard::clear_cookie -#ns_returnredirect "index" \ No newline at end of file +ad_set_cookie content_marks +ad_returnredirect "index" \ No newline at end of file Index: openacs-4/packages/cms/www/modules/clipboard/floating.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/clipboard/floating.tcl,v diff -u -N -r1.1 -r1.1.2.1 --- openacs-4/packages/cms/www/modules/clipboard/floating.tcl 16 Nov 2004 22:32:48 -0000 1.1 +++ openacs-4/packages/cms/www/modules/clipboard/floating.tcl 31 Aug 2006 19:59:05 -0000 1.1.2.1 @@ -2,7 +2,7 @@ set heads [ad_conn headers] set package_url [ad_conn package_url] -set clipboardfloats_p [clipboard::floats_p] +set clipboardfloats_p [cms::clipboard::ui::floats_p] for { set i 0 } { $i < [ns_set size $heads] } { incr i } { ns_log notice "[ns_set key $heads $i] = [ns_set value $heads $i]" @@ -34,14 +34,14 @@ # The cookie for the clipboard looks like this: # mnt:id,id,id|mnt:id,id,id|mnt:id,id,id. -set clip [clipboard::parse_cookie] +set clip [cms::clipboard::parse_cookie] -set total_items [clipboard::get_total_items $clip] -set user_id [User::getID] +set total_items [cms::clipboard::get_total_items $clip] +set user_id [auth::require_login] if { ![util::is_nil id] } { - set item_id_list [clipboard::get_items $clip $id] + set item_id_list [cms::clipboard::get_items $clip $id] ns_log Notice "item_id_list = [join $item_id_list ","]" # First, attempt to ask the module for the list of item paths in sorted order Index: openacs-4/packages/cms/www/modules/clipboard/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cms/www/modules/clipboard/index.adp,v diff -u -N -r1.5 -r1.5.2.1 --- openacs-4/packages/cms/www/modules/clipboard/index.adp 17 May 2005 22:13:52 -0000 1.5 +++ openacs-4/packages/cms/www/modules/clipboard/index.adp 31 Aug 2006 19:59:05 -0000 1.5.2.1 @@ -1,24 +1,13 @@ Clipboard - -

 Clipboard

-   Browse and delete from the clipboard below +   Manage items on the clipboard

@@ -97,47 +86,24 @@