Index: openacs-4/packages/xotcl-core/xotcl-core.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v
diff -u -r1.71 -r1.72
--- openacs-4/packages/xotcl-core/xotcl-core.info 5 Nov 2009 12:08:39 -0000 1.71
+++ openacs-4/packages/xotcl-core/xotcl-core.info 6 Nov 2009 12:18:56 -0000 1.72
@@ -10,10 +10,10 @@
t
xotcl
-
+
Gustaf Neumann
XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)
- 2009-11-05
+ 2009-11-06
Gustaf Neumann, WU Wien
This component contains some core functionality for OpenACS
applications using XOTcl. It includes
@@ -43,11 +43,11 @@
BSD-Style
0
-
+
-
+
$folder_id"
+ }
+
+ # register all specified content types
+ ::xo::db::CrFolder register_content_types \
+ -folder_id $folder_id \
+ -content_types $content_types
+ my log "returning from cache folder_id $folder_id"
+ return $folder_id
+ }]
+ my log "returning from require folder_id $folder_id"
+ return $folder_id
+ }
+
::xo::Package instproc set_url {-url} {
my url $url
my set object [string range [my url] [string length [my package_url]] end]
Index: openacs-4/packages/xotcl-core/tcl/cr-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cr-procs.tcl,v
diff -u -r1.33 -r1.34
--- openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 5 Nov 2009 12:06:03 -0000 1.33
+++ openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 6 Nov 2009 12:18:56 -0000 1.34
@@ -287,80 +287,6 @@
}
}
- CrClass ad_instproc require_folder {
- {-parent_id -100}
- {-content_types}
- -package_id
- -name
- } {
- Get folder_id for a community id or the actual package.
- If everything fails, return -100
-
- @return folder_id
- } {
- my instvar object_type table_name
-
- if {[info exists package_id]} {
- set cid $package_id
- } else {
- if {[my isobject ::xo::cc]} {
- set package_id [::xo::cc package_id]
- set url [::xo::cc url]
- } elseif {[ad_conn isconnected]} {
- set package_id [ad_conn package_id]
- set url [ad_conn url]
- }
-
- if {[info exists package_id]} {
- set cid ""
- if {[info command dotlrn_community::get_community_id_from_url] ne ""} {
- set cid [dotlrn_community::get_community_id_from_url -url $url]
- }
- if {$cid eq ""} {
- set cid $package_id
- }
- } else {
- error "Could not determine package id or community id"
- }
- }
- set folder_id [ns_cache eval xotcl_object_type_cache root_folder-$cid {
- set folder_name "$name: $cid"
-
- if {[info command content::item::get_id_by_name] eq ""} {
- set folder_id ""
- db_0or1row [my qn get_id_by_name] "select item_id as folder_id from cr_items \
- where name = :folder_name and parent_id = :parent_id"
- } else {
- set folder_id [content::item::get_id_by_name \
- -name $folder_name -parent_id $parent_id]
- }
- if {$folder_id eq ""} {
- set folder_id [content::folder::new \
- -name $folder_name \
- -parent_id $parent_id \
- -package_id $package_id -context_id $cid]
- }
- if {![info exists content_types]} {
- set content_types [::xo::db::Class class_to_object_type [self]]*
- #ns_log notice "CONTENT TYPES = '$content_types'"
- }
-
- # register all specified content types
- foreach content_type $content_types {
- # if a content_type ends with a *, include subtypes
- set with_subtypes [expr {[regexp {^(.*)[*]$} $content_type _ content_type] ?
- "t" : "f"}]
- ::xo::db::sql::content_folder register_content_type \
- -folder_id $folder_id \
- -content_type $content_type \
- -include_subtypes $with_subtypes
- }
- return $folder_id
- }]
-
- return $folder_id
- }
-
CrClass ad_proc require_folder_object {
-folder_id
-package_id
@@ -1404,6 +1330,21 @@
return $object
}
+ ::xo::db::CrFolder ad_proc register_content_types {
+ {-folder_id:required}
+ {-content_types ""}
+ } {
+ Register the specified content types for the folder.
+ If a content_type ends with a *, include its subtypes
+ } {
+ foreach content_type $content_types {
+ set with_subtypes [expr {[regexp {^(.*)[*]$} $content_type _ content_type] ? "t" : "f"}]
+ ::xo::db::sql::content_folder register_content_type \
+ -folder_id $folder_id \
+ -content_type $content_type \
+ -include_subtypes $with_subtypes
+ }
+ }
::xo::db::CrFolder ad_proc fetch_object {
-item_id:required
@@ -1433,18 +1374,26 @@
} {
my instvar parent_id package_id folder_id
[my info class] get_context package_id creation_user creation_ip
- set folder_id [content::folder::new \
- -name [my set name] \
- -label [my set label] \
- -description [my set description] \
- -parent_id $parent_id \
- -package_id $package_id \
+ set folder_id [::xo::db::sql::content_folder new \
+ -name [my name] -label [my label] \
+ -description [my description] \
+ -parent_id $parent_id \
+ -package_id $package_id \
-creation_user $creation_user \
-creation_ip $creation_ip]
#parent_s has_child_folders attribute could have become outdated
if { [my isobject ::$parent_id] } {
::$parent_id set has_child_folders t
}
+ # well, obtaining the allowed content_types this way is not very
+ # straightforward, but since we currently create these folders via
+ # ad_forms, and we have no form variable, this should be at least
+ # robust.
+ if {[[self class] exists allowed_content_types]} {
+ ::xo::db::CrFolder register_content_types \
+ -folder_id $folder_id \
+ -content_types [[self class] set allowed_content_types]
+ }
::xo::clusterwide ns_cache flush xotcl_object_cache ::$parent_id
# who is setting sub_folder_list?
#db_flush_cache -cache_key_pattern sub_folder_list_*
@@ -1476,7 +1425,6 @@
return
}
::xo::db::sql::content_folder del -folder_id $folder_id -cascade_p t
- ad_returnredirect [my query_parameter return_url]
}