Index: openacs-4/packages/xowiki/xowiki.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v
diff -u -r1.133 -r1.134
--- openacs-4/packages/xowiki/xowiki.info 25 Jun 2010 08:49:59 -0000 1.133
+++ openacs-4/packages/xowiki/xowiki.info 8 Jul 2010 12:10:17 -0000 1.134
@@ -10,11 +10,11 @@
t
xowiki
-
+
Gustaf Neumann
A more generic xotcl-based wikis example with object types
and subtypes based on the content repository (with category support)
- 2010-06-25
+ 2010-07-08
Gustaf Neumann, WU Wien
<pre>
XoWiki is a Wiki implementation for OpenACS in XOTcl. Instead of
@@ -56,12 +56,12 @@
BSD-Style
0
-
+
-
+
Index: openacs-4/packages/xowiki/tcl/package-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v
diff -u -r1.227 -r1.228
--- openacs-4/packages/xowiki/tcl/package-procs.tcl 6 Jul 2010 12:44:06 -0000 1.227
+++ openacs-4/packages/xowiki/tcl/package-procs.tcl 8 Jul 2010 12:10:17 -0000 1.228
@@ -947,22 +947,6 @@
item_id $(item_id) parent_id $(parent_id)]
}
- Package instproc item_id_ref {
- item_id
- } {
- set name [::xo::db::CrClass get_name -item_id $item_id]
- set type [::xo::db::CrClass get_object_type -item_id $item_id]
- set parent_id [::xo::db::CrClass get_parent_id -item_id $item_id]
- #my log "lookup returned name=$name (type $type, name $name, type $type)"
-
- if {$type eq "content_folder"} {
- return [list link_type "folder" prefix "" stripped_name $name parent_id $parent_id]
- } else {
- regexp {^(.+):(.+)$} $name _ prefix stripped_name
- return [list link_type "link" prefix $prefix stripped_name $stripped_name parent_id $parent_id]
- }
- }
-
Package instproc simple_item_ref {
-default_lang:required
-parent_id:required
@@ -975,14 +959,18 @@
if {$normalize_name} {
set element [my normalize_name $element]
}
- #my msg el=[string map [list \0 MARKER] $element]-assume_folder=$assume_folder
+ #my log el=[string map [list \0 MARKER] $element]-assume_folder=$assume_folder
set (form) ""
set use_default_lang 0
if {[regexp {^(file|image|js|css|swf):(.+)$} $element _ (link_type) (stripped_name)]} {
# (typed) file links
set (prefix) file
set name file:$(stripped_name)
+ } elseif {[regexp {^folder:(.+)$} $element _ (stripped_name)]} {
+ # (typed) file links
+ array set "" [list prefix "" link_type link form "en:folder.form"]
+ set name $(stripped_name)
} elseif {[regexp {^(..):([^:]{3,}?):(..):(.+)$} $element _ form_lang form (prefix) (stripped_name)]} {
array set "" [list link_type "link" form "$form_lang:$form.form"]
set name $(prefix):$(stripped_name)
@@ -1005,13 +993,13 @@
array set "" [list link_type "link"]
set name $(prefix):$(stripped_name)
} elseif {[regexp {^(.+)\0$} $element _ (stripped_name)]} {
- array set "" [list link_type "link" form "$default_lang:folder.form" prefix $default_lang]
- set name $default_lang:$(stripped_name)
- set use_default_lang 1
+ array set "" [list link_type "link" form "en:folder.form" prefix ""]
+ set name $(stripped_name)
+ set use_default_lang 0
} elseif {$assume_folder} {
- array set "" [list link_type "link" form "$default_lang:folder.form" prefix $default_lang stripped_name $element]
- set name $default_lang:$element
- set use_default_lang 1
+ array set "" [list link_type "link" form "en:folder.form" prefix "" stripped_name $element]
+ set name $element
+ set use_default_lang 0
} else {
array set "" [list link_type "link" prefix $default_lang stripped_name $element]
set name $default_lang:$element
@@ -1021,7 +1009,7 @@
set (stripped_name) [string trimright $(stripped_name) \0]
if {$element eq "." || $element eq ".\0"} {
- array set "" [my item_id_ref $parent_id]
+ array set "" [my item_ref_from_id $parent_id]
set item_id $parent_id
set parent_id $(parent_id)
} elseif {$element eq ".." || $element eq "..\0"} {
@@ -1030,7 +1018,7 @@
# refuse to traverse past root folder
set parent_id $id
}
- array set "" [my item_id_ref $parent_id]
+ array set "" [my item_ref_from_id $parent_id]
set item_id $parent_id
set parent_id $(parent_id)
} else {
@@ -1040,13 +1028,34 @@
-use_package_path $use_package_path \
-use_site_wide_pages $use_site_wide_pages \
-name $name -parent_id $parent_id]
- #my msg "[my id] lookup -use_package_path $use_package_path -name $name -parent_id $parent_id => $item_id"
+ #my log "[my id] lookup -use_package_path $use_package_path -name $name -parent_id $parent_id => $item_id"
if {$item_id == 0} {
#
# The first lookup was not successful, so we try again.
#
- if {$(link_type) eq "link" && $use_default_lang && $(prefix) ne "en"} {
+ if {$(link_type) eq "link" && $element eq $(stripped_name)} {
+ #
+ # try a direct lookup, in case it is a folder
+ #
+ set item_id [my lookup \
+ -use_package_path $use_package_path \
+ -use_site_wide_pages $use_site_wide_pages \
+ -name $(stripped_name) -parent_id $parent_id]
+ #my msg "try again in en en:$(stripped_name) => $item_id"
+ if {$item_id > 0} {array set "" [list prefix ""]}
+ }
+
+ if {$item_id == 0 && $(link_type) eq "link" && $assume_folder && $(prefix) eq ""} {
+ set item_id [my lookup \
+ -use_package_path $use_package_path \
+ -use_site_wide_pages $use_site_wide_pages \
+ -name $default_lang:$element -parent_id $parent_id]
+ if {$item_id > 0} {array set "" [list link_type "link" prefix $default_lang stripped_name $element]
+ }
+ }
+
+ if {$item_id == 0 && $(link_type) eq "link" && $use_default_lang && $(prefix) ne "en"} {
#
# If the name was not specified explicitely (we are using
# $default_lang), try again with language "en" try again,
@@ -1096,6 +1105,51 @@
form $(form) parent_id $parent_id item_id $item_id ]
}
+ Package instproc item_ref_from_id {
+ item_id
+ } {
+ #
+ # Obtain (partial) item_ref data from id. It does not handle
+ # e.g. special link_types as for e.g file|image|js|css|swf, etc.
+ #
+ ::xo::db::CrClass get_instance_from_db -item_id $item_id
+ set name [$item_id name]
+ set parent_id [$item_id parent_id]
+ if {[$item_id is_folder_page]} {
+ return [list link_type "folder" prefix "" stripped_name $name parent_id $parent_id]
+ }
+ regexp {^(.+):(.+)$} $name _ prefix stripped_name
+ return [list link_type "link" prefix $prefix stripped_name $stripped_name parent_id $parent_id]
+ }
+
+ Package instproc item_ref_from_url {url} {
+ #
+ # Obtain item reference data (item_id parent_id name lang
+ # stripped_name) from the specified url. So far, search starts
+ # always at the root.
+ #
+ # This is drastically simplified version of resolve_request, but
+ # it does not instantiate any objects and reutrns the usual item_ref data.
+ #
+ if {[string match /* $url]} {
+ set url [string range $url [string length [my package_url]] end]
+ }
+ my get_lang_and_name -default_lang [my default_language] -path $url (lang) stripped_url
+ set (parent_id) [my get_parent_and_name -lang $(lang) -path $stripped_url -parent_id [my folder_id] \
+ parent (stripped_name)]
+ if {$(lang) ne "file"} {
+ # try a direct lookup
+ set (item_id) [::xo::db::CrClass lookup -name $(stripped_name) -parent_id $(parent_id)]
+ if {$item_id != 0} {
+ set (name) $(stripped_name)
+ return [array get ""]
+ }
+ }
+ set (name) $(lang):$(stripped_name)
+ set (item_id) [::xo::db::CrClass lookup -name $(name) -parent_id $(parent_id)]
+ return [array get ""]
+ }
+
Package instproc get_page_from_item_ref {
{-allow_cross_package_item_refs true}
{-use_package_path false}
@@ -1116,7 +1170,7 @@
#my msg "get_page_from_item_ref [self args]"
if {$allow_cross_package_item_refs && [string match //* $link]} {
set referenced_package_id [my resolve_package_path $link rest_link]
- #my log "get_page_from_item_ref recursive $rest_link in $referenced_package_id"
+ #my log "get_page_from_item_ref $link recursive rl?[info exists rest_link] in $referenced_package_id"
if {$referenced_package_id != 0 && $referenced_package_id != [my id]} {
# TODO: we have still to check, whether or not we want
# site-wide-pages etc. in cross package links, and if, under
@@ -1875,16 +1929,20 @@
}
if {$item_id eq "" && $name ne ""} {
- if {![info exists parent_id]} {set parent_id [my folder_id]}
- if {[set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]] == 0} {
- ns_log notice "lookup of '$name' failed"
- set item_id ""
+ array set "" [my item_ref_from_url $name]
+ if {$(item_id) == 0} {
+ ns_log notice "lookup of '$name' with parent_id $parent_id failed"
+ } else {
+ set parent_id $(parent_id)
+ set item_id $(item_id)
+ set name $(name)
}
} elseif {$item_id ne ""} {
if {![info exists parent_id]} {
set parent_id [::xo::db::CrClass get_parent_id -item_id $item_id]
}
}
+ #my msg item_id=$item_id
if {$item_id ne ""} {
my log "--D trying to delete $item_id $name"
Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v
diff -u -r1.415 -r1.416
--- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 5 Jul 2010 09:30:56 -0000 1.415
+++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 8 Jul 2010 12:10:17 -0000 1.416
@@ -1046,16 +1046,6 @@
} else {
set map { \" \\\" \[ \\[ \] \\] \$ \\$ \\ \\\\}
}
- if {0 && $prefix eq "1"} {
- my msg "re=$re, string=$string cmd=$cmd"
- set c [regsub -all $re [string map $map $string] "\[$cmd\]"]
- my msg c0=$c
- regsub -all {\\1([$]?)\\2} $c {\\\\\1} c1
- my msg c1=$c1
- set s [subst $c1]
- my msg s=$s
- return $s
- }
uplevel [list subst [regsub -all $re [string map $map $string] "\[$cmd\]"]]
}
@@ -1112,7 +1102,11 @@
# Include a wiki page, tailorable.
#
#set page [my resolve_included_page_name $page_name]
- set page [$package_id get_page_from_item_ref -parent_id [my parent_id] $page_name]
+ set page [$package_id get_page_from_item_ref \
+ -use_package_path true \
+ -use_site_wide_pages true \
+ -use_prototype_pages true \
+ -parent_id [my parent_id] $page_name]
if {$page ne "" && ![$page exists __decoration]} {
#
@@ -1170,10 +1164,10 @@
return $html
}
- Page instproc include_portlet {arg} {
- my log "+++ method [self proc] of [self class] is deprecated"
- return [my include $arg]
- }
+# Page instproc include_portlet {arg} {
+# my log "+++ method [self proc] of [self class] is deprecated"
+# return [my include $arg]
+# }
Page ad_instproc include {-configure arg} {
Include the html of the includelet. The method generates
@@ -1508,17 +1502,25 @@
Page instproc substitute_markup {content} {
+ my log "SUBST [my name] [my do_substitutions]"
+
+ if {[my set mime_type] eq "text/enhanced"} {
+ set content [ad_enhanced_text_to_html $content]
+ }
+ if {![my do_substitutions]} {return $content}
#
# The provided content and the returned result are strings
# containing HTML (unless we have other rich-text encodings).
#
+ # First get the right regular expression definitions
+ #
set baseclass [expr {[[my info class] exists RE] ? [my info class] : [self class]}]
$baseclass instvar RE markupmap
#my log "-- baseclass for RE = $baseclass"
- if {[my set mime_type] eq "text/enhanced"} {
- set content [ad_enhanced_text_to_html $content]
- }
- if {![my do_substitutions]} {return $content}
+
+ #
+ # secondly, iterate line-wise over the text
+ #
set output ""
set l ""
foreach l0 [split $content \n] {
Index: openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl 25 Jun 2010 13:30:31 -0000 1.1
+++ openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl 8 Jul 2010 12:10:18 -0000 1.2
@@ -524,6 +524,10 @@
::xowiki::Package initialize -package_id [::xowiki::Package first_instance]
::xowiki::Package require_site_wide_pages -refetch true
+ foreach package_id [::xowiki::Package instances] {
+ ::xowiki::Package initialize -package_id $package_id -init_url false
+ $package_id import-prototype-page weblog
+ }
}
}
}
Index: openacs-4/packages/xowiki/www/admin/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/Attic/test.tcl,v
diff -u -r1.26 -r1.27
--- openacs-4/packages/xowiki/www/admin/test.tcl 30 Apr 2010 10:34:52 -0000 1.26
+++ openacs-4/packages/xowiki/www/admin/test.tcl 8 Jul 2010 12:10:18 -0000 1.27
@@ -89,6 +89,7 @@
# create a fresh instance for testing
#
if {[site_node::exists_p -url /$instance_name]} {
+ test hint "we have an existing instance named /$instance_name, we delete it..."
# we have already an instance, get rid of it
array set info [site_node::get_from_url -url /$instance_name -exact]
# is the instance mounted?
@@ -120,16 +121,19 @@
# create a fresh instance
array set node [site_node::get -url /]
+#test code [array get node]
+
site_node::instantiate_and_mount \
-parent_node_id $node(node_id) \
-node_name $instance_name \
-package_name $instance_name \
-package_key xowiki
-#test code [array get node]
? {site_node::exists_p -url /$instance_name} 1 \
"created test instance /$instance_name"
array set info [site_node::get_from_url -url /$instance_name -exact]
+#test code [array get info]
+
? {expr {$info(package_id) ne ""}} 1 "package is mounted, package_id provided"
@@ -154,13 +158,12 @@
? {$package_id exists folder_id} 1 "folder_id is set"
set folder_id [::$package_id folder_id]
? {::xotcl::Object isobject ::$folder_id} 1 "we have a folder object"
-? {::xotcl::Object isobject ::${folder_id}::payload} 1 "we have a payload"
-? {::$folder_id name} ::$folder_id "name of folder object is ::folder_id"
-? {::$folder_id parent_id} $folder_id "parent_id of folder object is folder_id"
+? {::$folder_id name} "xowiki: $package_id" "name of folder object is 'xowiki: $package_id'"
+? {::$folder_id parent_id} -100 "parent_id of folder object is -100"
? {expr {[::$folder_id item_id]>0}} 1 "item_id given"
? {expr {[::$folder_id revision_id]>0}} 1 "revision_id given"
-? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 1 \
- "folder contains the folder object"
+? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 0 \
+ "folder contains no objects"
test subsection "Create and Render Index Page"
? {$package_id set object} "" "object name parsed"
@@ -181,8 +184,8 @@
? {expr {$content_length > 1000}} 1 \
"page rendered, content-length $content_length > 1000"
? {string first Error $content} -1 "page contains no error"
-? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 2 \
- "folder contains the folder object and the index page"
+? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 1 \
+ "folder contains the index page"
#test code [$page_item_id serialize]
test subsection "Check Permissions based on default policy"
@@ -240,13 +243,12 @@
? {$package_id exists folder_id} 1 "folder_id is set"
set folder_id [::$package_id folder_id]
? {::xotcl::Object isobject ::$folder_id} 1 "we have a folder object"
-? {::xotcl::Object isobject ::${folder_id}::payload} 1 "we have a payload"
-? {::$folder_id name} ::$folder_id "name of folder object is ::folder_id"
-? {::$folder_id parent_id} $folder_id "parent_id of folder object is folder_id"
+? {::$folder_id name} "xowiki: $package_id" "name of folder object is 'xowiki: $package_id'"
+? {::$folder_id parent_id} -100 "parent_id of folder object is -100"
? {expr {[::$folder_id item_id]>0}} 1 "item_id given"
? {expr {[::$folder_id revision_id]>0}} 1 "revision_id given"
-? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 2 \
- "folder contains the folder object and index"
+? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 1 \
+ "folder contains the index"
test subsection "Render Index Page (2nd)"
? {$package_id set object} "" "object name parsed"
@@ -294,9 +296,10 @@
? {string first Error $content} -1 "page contains no error"
#test hint $content
-? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 4 \
- "folder contains: folder object, index and weblog page (+1 includelet)"
+? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 3 \
+ "folder contains: index and weblog page (+1 includelet)"
+::xo::at_cleanup
########################################################################
@@ -313,9 +316,13 @@
? {expr {$content_length > 1000}} 1 \
"page rendered, content-length $content_length > 1000"
? {string first Error $content} -1 "page contains no error"
+? {string first file:image $content} -1 "page contains no error"
+? {expr {[string first "Index Page" $content] == -1}} 0 \
+ "weblog contains Index Page"
set full_weblog_content_length $content_length
+::xo::at_cleanup
########################################################################
test section "New Query: /$instance_name/en/weblog with summary=1"
@@ -331,11 +338,15 @@
? {expr {$content_length > 1000}} 1 \
"page rendered, content-length $content_length > 1000"
? {string first Error $content} -1 "page contains no error"
-? {expr {$full_weblog_content_length > $content_length}} 1 "summary is shorter"
+? {expr {$full_weblog_content_length > $content_length}} 1 \
+ "summary ($content_length) is shorter than full weblog $full_weblog_content_length"
+#test hint $content
+::xo::at_cleanup
+#return
########################################################################
-test section "Testing as SWA: query /$instance_name/ "
+test section "Testing as SWA: query /$instance_name/"
set swas [db_list get_swa "select grantee_id from acs_permissions \
where object_id = -4 and privilege = 'admin'"]
@@ -355,10 +366,10 @@
"SWA sees the delete link"
? {expr {[::$package_id make_link -privilege admin -link admin/ $package_id {} {}] ne ""}} 1 \
"SWA sees admin link"
-? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 4 \
- "folder contains: folder object, index and weblog page (+1 includelet)"
+? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 3 \
+ "folder contains: index and weblog page (+1 includelet)"
+::xo::at_cleanup
-
########################################################################
test section "Delete weblog-portlet via weblink"
@@ -373,8 +384,8 @@
? {::xo::cc exists __continuation} 1 "continuation exists"
? {::xo::cc set __continuation} "ad_returnredirect /$instance_name/" \
"redirect to main instance"
-? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 3 \
- "folder contains: folder object, index and weblog page (+0 includelet)"
+? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 2 \
+ "folder contains: index and weblog page (+0 includelet)"
test subsection "Create a test page named hello with package_id $package_id"
@@ -391,22 +402,24 @@
$page initialize_loaded_object
$page save_new
? {$page set package_id} $package_id "package_id $package_id not modified"
-? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 4 \
- "folder contains: folder object, index and weblog, hello page (+0 includelet)"
+? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 3 \
+ "folder contains: index and weblog, hello page (+0 includelet)"
? {expr {[$page revision_id]>0}} 1 "revision_id given"
? {expr {[$page item_id]>0}} 1 "item_id given"
set revision_id1 [$page revision_id]
set item_id1 [$page item_id]
$page append title "- V.2"
$page save
-? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 4 \
- "still 4 pages"
+? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 3 \
+ "still 3 pages"
? {expr {[$page revision_id]>$revision_id1}} 1 "revision_id > old revision_id"
? {expr {[$page item_id] == $item_id1}} 1 "item id the same"
+::xo::at_cleanup
+
########################################################################
test section "Recreate weblog-portlet"
@@ -424,6 +437,7 @@
? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 4 \
"again, 4 pages"
+::xo::at_cleanup
########################################################################
test section "Query revisions for hello page via weblink"
@@ -438,7 +452,9 @@
? {string first Error $content} -1 "page contains no error"
? {expr {[string first 2: $content]>-1}} 1 "page contains two revisions"
+::xo::at_cleanup
+
########################################################################
test section "Edit hello page via weblink"
@@ -472,6 +488,8 @@
? {set title} {Hello World- V.2}
? {set text} {Hello [[Wiki]] World.}
+::xo::at_cleanup
+
########################################################################
test section "Submit edited hello page via weblink"
@@ -506,7 +524,8 @@
? {::xo::cc set __continuation} "ad_returnredirect /$instance_name/hello" \
"redirect to hello page"
-foreach p [::xowiki::Page info instances] {$p destroy}
+::xo::at_cleanup
+
########################################################################
test section "Query revisions for hello page via weblink"
@@ -528,6 +547,9 @@
? {string first Error $content} -1 "page contains no error"
? {expr {[string first 3: $content]>-1}} 1 "page contains three revisions"
+# keep the page for the following test
+#::xo::at_cleanup
+
########################################################################
test section "Small tests"
@@ -640,7 +662,7 @@
proc require_folder {name parent_id package_id} {
set form_id [::xowiki::Weblog instantiate_forms -forms en:folder.form -package_id $package_id]
set f [$form_id create_form_page_instance \
- -name en:$name \
+ -name $name \
-nls_language en_US \
-default_variables [list title "Folder $name" parent_id $parent_id package_id $package_id]]
$f save_new
@@ -678,6 +700,7 @@
test subsection "Ingredients:"
set folder_id [$package_id folder_id]
+ test hint "folder_id => $folder_id"
# make sure, we have folder "foldername" with subfolder "f3" with subfolder "subf3"
set foldername_id [require_folder "foldername" $folder_id $package_id]
@@ -701,7 +724,8 @@
set l "folder:foldername"
set test [label "item_ref" "existing topfolder" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername"
+ && $(form) eq "en:folder.form"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "de:parentpage"
@@ -713,13 +737,13 @@
set l "foldername/"
set test [label "item_ref" "existing topfolder short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername";# this works, since "foldername" exists
set test [label "item_ref" "existing topfolder short + lookup" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "page1";# last item per default page
@@ -794,13 +818,13 @@
set l "./foldername/"
set test [label "item_ref" "existing topfolder short, relative" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "./foldername";# this works, since "foldername" exists
set test [label "item_ref" "existing topfolder short + lookup, relative" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "./page1";# last item per default page
@@ -812,7 +836,7 @@
set l "./parentpage/"
set test [label "item_ref" "not existing folder (with same name of existing page) in root_folder, relative" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "de" && $(stripped_name) eq "parentpage"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "parentpage"
&& $(parent_id) eq $folder_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "./" ;# stripped name will be the name of the root folder
@@ -833,7 +857,7 @@
set l "./foldername/."
set test [label "item_ref" "existing topfolder short, relative" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "foldername"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "./parentpage/."
@@ -848,43 +872,43 @@
set l "folder:foldername/folder:f3"
set test [label "item_ref" "existing subfolder" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "folder:foldername/f3/"
set test [label "item_ref" "existing subfolder short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "./folder:foldername/folder:f3/"
set test [label "item_ref" "existing subfolder with prefix and trailing slash" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/f3/"
set test [label "item_ref" "existing subfolder short short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "folder:foldername1/folder:f3"
set test [label "item_ref" "not existing folder with subfolder" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername1"
&& $(parent_id) eq $folder_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "foldername1/folder/"
set test [label "item_ref" "not existing folder with subfolder short short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "foldername1"
&& $(parent_id) eq $folder_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/folder1/"
set test [label "item_ref" "existing folder with not existing subfolder short short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "folder1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "folder1"
&& $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/page1"
@@ -896,25 +920,25 @@
set l "folder:foldername/folder:f3/folder:subf3"
set test [label "item_ref" "existing subsubfolder" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "subf3"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "subf3"
&& $(parent_id) eq $f3_id && $(item_id) == $subf3_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/f3/subf3"
set test [label "item_ref" "existing subsubfolder short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "subf3"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "subf3"
&& $(parent_id) eq $f3_id && $(item_id) == $subf3_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/f3/subf3/."
set test [label "item_ref" "existing subsubfolder short" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "subf3"
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "subf3"
&& $(parent_id) eq $f3_id && $(item_id) == $subf3_id}} 1 "\n$test:\n [array get {}]\n "
set l "folder:foldername/folder:f99"
set test [label "item_ref" "not existing folder in folder" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f99"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f99"
&& $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "folder:foldername/de:testpage"
@@ -947,25 +971,25 @@
set l "de:parentpage/folder:childfolder"
set test [label "item_ref" "existing folder under page" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "childfolder"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "childfolder"
&& $(parent_id) eq $parentpage_id && $(item_id) == $childfolder_id}} 1 "\n$test:\n [array get {}]\n "
set l "de:parentpage/folder:childfolder/"
set test [label "item_ref" "existing folder under page with prefix and trailing slash" $l]
array set "" [p item_ref -default_lang en -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "childfolder"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "childfolder"
&& $(parent_id) eq $parentpage_id && $(item_id) == $childfolder_id}} 1 "\n$test:\n [array get {}]\n "
set l "de:parentpage/folder:childfolder1"
set test [label "item_ref" "not existing folder under page" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "de" && $(stripped_name) eq "childfolder1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "childfolder1"
&& $(parent_id) eq $parentpage_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "de:parentpage/folder:childfolder1/"
set test [label "item_ref" "not existing folder under page with prefix and trailing slash" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "de" && $(stripped_name) eq "childfolder1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "childfolder1"
&& $(parent_id) eq $parentpage_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
set l "de:parentpage/de:childpage"
@@ -998,25 +1022,25 @@
set l "foldername/f3/subf3/.."
set test [label "item_ref" "existing subsubfolder dot dot" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/f3/subf3/../"
set test [label "item_ref" "existing subsubfolder dot dot slash" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/f3/subf3/../."
set test [label "item_ref" "existing subsubfolder dot dot slash dot" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "f3"
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "f3"
&& $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
set l "foldername/f3/subf3/../.."
set test [label "item_ref" "existing subsubfolder dot dot slash dot dot" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
- ? {expr {$(link_type) eq "link" && $(prefix) eq "en" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "foldername"
&& $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
set l "parentpage/childpage/.."
Index: openacs-4/packages/xowiki/www/prototypes/weblog-portlet.page
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/Attic/weblog-portlet.page,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/xowiki/www/prototypes/weblog-portlet.page 17 Jun 2010 10:41:42 -0000 1.16
+++ openacs-4/packages/xowiki/www/prototypes/weblog-portlet.page 8 Jul 2010 12:10:26 -0000 1.17
@@ -115,7 +115,10 @@
]
$w mixin add $renderer
- return [$w render]
+ set html [$w render]
+ $page do_substitutions 1; # reset to default
+ my log "DO_SUBST of $page set to 1"
+ return $html
}
}
Index: openacs-4/packages/xowiki/www/prototypes/weblog.page
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/Attic/weblog.page,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/xowiki/www/prototypes/weblog.page 9 Apr 2009 07:55:54 -0000 1.6
+++ openacs-4/packages/xowiki/www/prototypes/weblog.page 8 Jul 2010 12:10:26 -0000 1.7
@@ -1,7 +1,7 @@
::xowiki::Page new -title "Weblog Page" -set publish_status production -text {
>>content<<
-{{//./weblog-portlet -decoration plain}}
+{{weblog-portlet -decoration plain}}
>><<
>>sidebar<<
{{adp portlets/weblog-mini-calendar}}