Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v
diff -u -r1.181 -r1.182
--- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 9 Jul 2010 10:30:40 -0000 1.181
+++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 12 Jul 2010 15:13:19 -0000 1.182
@@ -70,6 +70,20 @@
# return [string map [list __COLON__ :] $string]
#}
+ FormField proc get_from_name {name} {
+ #
+ # Get a form field via name. The provided names are unique for a
+ # form. If multiple forms should be rendered simultaneously, we
+ # have to extend the addressing mechanism.
+ #
+ # todo: we could speed this up by an index if needed
+ foreach f [::xowiki::formfield::FormField info instances -closure] {
+ if {[$f name] eq $name} {
+ return $f
+ }
+ }
+ return ""
+ }
FormField instproc init {} {
if {![my exists label]} {my label [string totitle [my name]]}
@@ -2116,23 +2130,51 @@
} -extend_slot validator link
include instproc convert_to_internal {} {
- my instvar value object
+ my instvar object value
set page [[$object package_id] get_page_from_item_ref \
-default_lang [$object lang] \
-parent_id [$object parent_id] \
$value]
+ #my msg "$value => $page, o package_id [$object package_id] t [$page object_id]"
+
if {$page ne ""} {
- # todo: maybe add to classical references...
- $object references_add [list [list [$page item_id] object_link]]
+ set item_id [$page item_id]
+ set link_type [expr {[$page is_folder_page] ? "folder_link" : "link"}]
+ set cross_package [expr {[$object package_id] != [$page package_id]}]
+ } else {
+ set item_id 0
+ set link_type "unresolved"
+ set cross_package 0
}
+ # rewrite value field
+ set value [list item_ref $value item_id $item_id link_type $link_type cross_package $cross_package]
+ $object set_property -new 1 [my name] $value
+
}
+ include instproc convert_to_external {value} {
+ if {$value ne ""} {
+ if {[catch {array set "" $value}]} {return $value}
+ return $(item_ref)
+ }
+ return ""
+ }
include instproc pretty_value {v} {
+ if {$v eq ""} { return $v }
+ if {[catch {array set "" $v}]} {
+ my log "warning: strange value for field [my name] '$v'"
+ return $v
+ }
my instvar object
- set page [[$object package_id] get_page_from_item_ref \
+ if {$(item_id) && [info command $(item_id)] ne ""} {
+ set page $(item_id)
+ } else {
+ set page [[$object package_id] get_page_from_item_ref \
-default_lang [$object lang] \
-parent_id [$object parent_id] \
- $v]
+ $(item_ref)]
+ }
+
#my msg page=$page
if {$page eq ""} {
# Here, we could call "::xowiki::Link render" to offer the user means
@@ -2141,7 +2183,18 @@
# resolved
return "Cannot resolve symbolic link '$v'"
}
- return [$page render]
+ $object lappend references [list [$page item_id] $(link_type)]
+
+ #my msg "[$object name] ref $(item_ref) change parent from [$page parent_id] to [$object item_id]"
+ #my msg "could switch from [$page item_id] to [$object item_id]"
+ #::xo::cc set queryparm(__object) $object
+
+ # resetting esp. the item-id is dangerous. Therefore we reset it immediately after the rendering
+ $page set_resolve_context -package_id [$object package_id] -parent_id [$object parent_id] -item_id [$object item_id]
+ set html [$page render]
+ $page set item_id [$page set physical_item_id]
+
+ return $html
}
###########################################################
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.229 -r1.230
--- openacs-4/packages/xowiki/tcl/package-procs.tcl 9 Jul 2010 10:30:40 -0000 1.229
+++ openacs-4/packages/xowiki/tcl/package-procs.tcl 12 Jul 2010 15:13:19 -0000 1.230
@@ -54,7 +54,6 @@
} {
set page [::xowiki::Package instantiate_page_from_id \
-item_id $item_id -revision_id $revision_id]
- $page volatile
return [::[$page package_id] url]
}
@@ -122,7 +121,7 @@
set lang $default_lang
}
- } elseif {[regexp {^(file|image|swf|download/file|tag)/(.*)$} $path _ lang local_name]} {
+ } elseif {[regexp {^(file|image|swf|download/file|download/..|tag)/(.*)$} $path _ lang local_name]} {
} else {
set local_name $path
if {$default_lang eq ""} {set default_lang [my default_language]}
@@ -148,19 +147,20 @@
if {[regexp {^([^/]+)/(.+)$} $path _ parent local_name]} {
# try without a prefix
- set p [::xo::db::CrClass lookup -name $parent -parent_id $parent_id]
- #my log "check '$parent' returned $p"
+ #set p [::xo::db::CrClass lookup -name $parent -parent_id $parent_id]
+ set p [my lookup -name $parent -parent_id $parent_id]
+ #my log "check plain '$parent' returned $p"
if {$p == 0} {
# pages are stored with a lang prefix
- set p [::xo::db::CrClass lookup -name ${lang}:$parent -parent_id $parent_id]
- my log "check '${lang}:$parent' returned $p"
- }
+ set p [my lookup -name ${lang}:$parent -parent_id $parent_id]
+ #my log "check with prefix '${lang}:$parent' returned $p"
- if {$p == 0 && $lang ne "en"} {
- # try again with prefix "en"
- set p [::xo::db::CrClass lookup -name en:$parent -parent_id $parent_id]
- my log "check 'en:$parent' returned $p"
+ if {$p == 0 && $lang ne "en"} {
+ # try again with prefix "en"
+ set p [my lookup -name en:$parent -parent_id $parent_id]
+ #my log "check with en 'en:$parent' returned $p"
+ }
}
if {$p != 0} {
@@ -287,12 +287,12 @@
set encoded_name [string map [list %2d - %5f _ %2e .] [ns_urlencode $name]]
set folder [my folder_path -parent_id $parent_id]
- #my msg "folder_path = $folder"
+ #my msg "folder_path = $folder, default_lang [my default_language]"
- if {$folder ne ""} {
- # if folder has a different language than the content, we have to provide a prefix....
- regexp {^(..):} $folder _ default_lang
- }
+ # if {$folder ne ""} {
+ # # if folder has a different language than the content, we have to provide a prefix....
+ # regexp {^(..):} $folder _ default_lang
+ # }
#my log "h=${host}, prefix=${package_prefix}, folder=$folder, name=$encoded_name anchor=$anchor download=$download"
#my msg folder=$folder,lang=$lang,default_lang=$default_lang
@@ -445,14 +445,14 @@
#
# The method returns either the page object or empty ("").
#
- array set "" [my get_package_id_from_page_name $page_name]
- if {![info exists (package_id)]} {return ""}
-
- #my log "final resolve $(package_id) '$(page_name)'"
- return [$(package_id) resolve_request -default_lang $default_lang -simple true -path $(page_name) method_var]
+ return [my get_page_from_item_ref -allow_cross_package_item_refs true -default_lang $default_lang $page_name]
+ #array set "" [my get_package_id_from_page_name $page_name]
}
Package instproc resolve_page_name_and_init_context {{-lang} page_name} {
+ # todo: currently only used from
+ # Page->resolve_included_page_name. maybe, it could be replaced by
+ # get_page_from_name or get_page_from_item_ref
set page ""
#
# take a local copy of the package_id, since it is possible
@@ -624,14 +624,6 @@
}
}
- #Package instproc make_new_child_link {-form -parent -name -nls_language -return_url} {
- # my instvar id
- # if {[info exists form]} {
- # return [my make_link -with_entities 0 $parent \
- # create-child form return_url title name nls_language]
- # }
- #}
-
Package instproc create_new_snippet {
{-object_type ::xowiki::Page}
provided_name
@@ -688,20 +680,29 @@
}
}
+ Package instproc get_page_from_item_or_revision_id {item_id} {
+ set revision_id [my query_parameter revision_id 0]
+ set [expr {$revision_id ? "item_id" : "revision_id"}] 0
+ #my log "--instantiate item_id $item_id revision_id $revision_id"
+ return [::xo::db::CrClass get_instance_from_db -item_id $item_id -revision_id $revision_id]
+ }
+
Package instproc resolve_page {{-use_package_path true} {-simple false} -lang object method_var} {
#
# Try to resolve from object (path) and query parameter the called
- # object (might be a packge or page) and the method to be called
+ # object (might be a packge or page) and the method to be called.
#
+ # @return instaniated object or empty
+ #
upvar $method_var method
my instvar id
# get the default language if not specified
if {![info exists lang]} {
set lang [my default_language]
}
-
- #my log "resolve_page '$object', default-lang $lang"
+ #my msg "resolve_page '$object', default-lang $lang"
+
#
# First, resolve package level methods,
# having the syntax PACKAGE_URL?METHOD&....
@@ -736,73 +737,77 @@
#
# second, resolve object level
#
- set page [my resolve_request -default_lang $lang -simple $simple -path $object method]
+ #my msg "call item_info from url"
+ array set "" [my item_info_from_url -with_package_prefix false -default_lang $lang $object]
- #my log "--o resolving object '$object' -default_lang $lang -simple $simple returns '$page'"
- if {$simple || $page ne ""} {
- return $page
+ if {$(item_id) ne 0} {
+ if {$(method) ne ""} { set method $(method) }
+ return [my get_page_from_item_or_revision_id $(item_id)]
}
+ if {$simple} { return ""}
+ #my msg "NOT found object=$object"
- my get_lang_and_name -default_lang $lang -path $object lang stripped_name
- set parent_id [my get_parent_and_name -lang $lang -path $stripped_name -parent_id [my folder_id] \
- parent local_name]
- #my msg "parent_id = $parent_id, local_name = $local_name, stripped_name = $stripped_name"
- set stripped_name $local_name
-
- # stripped object is the object without a language prefix
- set stripped_object $object
- regexp {^..:(.*)$} $object _ stripped_object
-
# try standard page
- set standard_page [$id get_parameter ${object}_page]
+ set standard_page [$id get_parameter $(stripped_name)_page]
if {$standard_page ne ""} {
- set page [my resolve_request -default_lang [::xo::cc lang] -path $standard_page method]
+ #
+ # allow for now mapped standard pages just on the toplevel
+ #
+ set page [my get_page_from_item_ref \
+ -allow_cross_package_item_refs false \
+ -use_package_path true \
+ -use_site_wide_pages true \
+ -use_prototype_pages true \
+ -default_lang $lang \
+ -parent_id [my folder_id] \
+ $standard_page]
#my log "--o resolving standard_page '$standard_page' returns $page"
if {$page ne ""} {
return $page
}
-
# Maybe we are calling from a different language, but the
# standard page with en: was already instantiated.
- set standard_page "en:$stripped_object"
- set page [my resolve_request -default_lang en -path $standard_page method]
+ #set standard_page "en:$stripped_object"
+ #set page [my resolve_request -default_lang en -path $standard_page method]
#my msg "resolve -default_lang en -path $standard_page returns --> $page"
- if {$page ne ""} {
- return $page
- }
+ #if {$page ne ""} {
+ # return $page
+ #}
}
# Maybe, a prototype page was imported with language en:, but the current language is different
- if {$lang ne "en"} {
- set page [my resolve_request -default_lang en -path $stripped_object method]
- #my msg "resolve -default_lang en -path $stripped_object returns --> $page"
- if {$page ne ""} {
- return $page
- }
- }
+ #if {$lang ne "en"} {
+ # set page [my resolve_request -default_lang en -path $stripped_object method]
+ # #my msg "resolve -default_lang en -path $stripped_object returns --> $page"
+ # if {$page ne ""} {
+ # return $page
+ # }
+ #}
if {$use_package_path} {
# Check for this page along the package path
+ #my msg "check along package path"
foreach package [my package_path] {
- set page [$package resolve_page -simple $simple -lang $lang $object method]
+ set page [$package resolve_page -simple true -lang $lang $object method]
if {$page ne ""} {
#my msg "set_resolve_context inherited -package_id [my id] -parent_id [my folder_id]"
$page set_resolve_context -package_id [my id] -parent_id [my folder_id]
return $page
}
}
+ #my msg "package path done [array get {}]"
}
-
- set page [::xowiki::Package get_site_wide_page -name en:$stripped_name]
- #my log "get_site_wide_page for en:'$stripped_name' returned '$page' (stripped name)"
+
+ set page [::xowiki::Package get_site_wide_page -name en:$(stripped_name)]
+ #my msg "get_site_wide_page for en:'$(stripped_name)' returned '$page' (stripped name)"
if {$page ne ""} {
#my msg "set_resolve_context site-wide -package_id [my id] -parent_id [my folder_id]"
$page set_resolve_context -package_id [my id] -parent_id [my folder_id]
return $page
}
#my msg "we have to try to import a prototype page for $stripped_object"
- set page [my import-prototype-page $stripped_object]
+ set page [my import-prototype-page $(stripped_name)]
if {$page ne ""} {
return $page
}
@@ -838,14 +843,43 @@
return $packages
}
+ Package instproc prefixed_lookup {{-default_lang ""} -lang:required -stripped_name:required -parent_id:required} {
+ # todo unify with package->lookup
+ #
+ # This method tries a direct lookup of stripped_name under
+ # parent_id followed by a prefixed lookup. The direct lookup is
+ # only performed, when $default-lang == $lang. The prefixed lookup
+ # might change lang in the result set.
+ #
+ # @return item-ref info
+ #
+ set item_id 0
+ if {$lang eq $default_lang} {
+ # 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
+ regexp {^(..):(.+)$} $name _ lang stripped_name
+ #my msg "direct $stripped_name"
+ }
+ }
+ if {$item_id == 0} {
+ set name ${lang}:$stripped_name
+ set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]
+ #my msg "comp $name"
+ }
+ return [list item_id $item_id parent_id $parent_id \
+ lang $lang stripped_name $stripped_name name $name ]
+ }
+
Package instproc lookup {
{-use_package_path true}
{-use_site_wide_pages false}
{-default_lang ""}
-name:required
{-parent_id ""}
} {
- # Lookup of names (with maybe cross-package references) from a
+ # Lookup name (with maybe cross-package references) from a
# given parent_id or from the list of configured instances
# (obtained via package_path).
#
@@ -857,8 +891,26 @@
if {$parent_id eq ""} {set parent_id [$(package_id) folder_id]}
set item_id [::xo::db::CrClass lookup -name $(page_name) -parent_id $parent_id]
- #my msg "lookup $(page_name) $parent_id in package $(package_id) returns $item_id"
+ #my log "lookup $(page_name) $parent_id in package $(package_id) returns $item_id, parent_id $parent_id"
+ # Test for "0" is only needed when we want to create for root folder
+ if {$item_id == 0 && $parent_id ne "0"} {
+ #
+ # Page not found so far. Is the parent-page a folder-link?
+ #
+ ::xo::db::CrClass get_instance_from_db -item_id $parent_id
+ if {[$parent_id is_link_page] && [$parent_id is_folder_page]} {
+ set target [$parent_id get_page_from_link_page]
+ #my log "LINK LOOKUP from target-package [$target package_id] source package $(package_id)"
+ return [[$target package_id] lookup \
+ -use_package_path $use_package_path \
+ -use_site_wide_pages $use_site_wide_pages \
+ -default_lang $default_lang \
+ -name $name \
+ -parent_id [$target item_id]]
+ }
+ }
+
if {$item_id == 0 && $use_package_path} {
#
# Page not found so far. Is the page inherited along the package
@@ -895,14 +947,16 @@
link
} {
- An item_ref refers to an item in the content repository relative
- to some parent_id. The item might be either a folder or some kind
- of "page" (e.g. a file). An item_ref might be complex,
- i.e. consist of a path of simple_item_refs, separated by "/".
- An item_ref stops at the first unknown part in the path and
- returns item_id == 0 and the appropriate parent_id (and name etc.)
- for insertion.
+ An item_ref refers to an item (existing or nonexisting) in the
+ content repository relative to some parent_id. The item might be
+ either a folder or some kind of "page" (e.g. a file). An item_ref
+ might be complex, i.e. consist of a path of simple_item_refs,
+ separated by "/". An item_ref stops at the first unknown part in
+ the path and returns item_id == 0 and the appropriate parent_id
+ (and name etc.) for insertion.
+ @return item info containing link_type form prefix stripped_name item_id parent_id
+
} {
# A trailing slash says that the last element is a folder. We
# substitute it to allow easy iteration over the slash separated
@@ -934,6 +988,7 @@
-parent_id $parent_id \
-assume_folder [expr {[incr n] < $nr_elements}] \
$element]
+ #my log "$element => [array get {}]"
if {$(item_id) == 0} {
set parent_id $(parent_id)
break
@@ -959,7 +1014,7 @@
if {$normalize_name} {
set element [my normalize_name $element]
}
- #my log el=[string map [list \0 MARKER] $element]-assume_folder=$assume_folder
+ #my log el=[string map [list \0 MARKER] $element]-assume_folder=$assume_folder,parent_id=$parent_id
set (form) ""
set use_default_lang 0
@@ -1012,7 +1067,7 @@
set (stripped_name) [string trimright $(stripped_name) \0]
if {$element eq "." || $element eq ".\0"} {
- array set "" [my item_ref_from_id $parent_id]
+ array set "" [my item_info_from_id $parent_id]
set item_id $parent_id
set parent_id $(parent_id)
} elseif {$element eq ".." || $element eq "..\0"} {
@@ -1021,7 +1076,7 @@
# refuse to traverse past root folder
set parent_id $id
}
- array set "" [my item_ref_from_id $parent_id]
+ array set "" [my item_info_from_id $parent_id]
set item_id $parent_id
set parent_id $(parent_id)
} else {
@@ -1045,7 +1100,7 @@
-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"
+ #my msg "try again direct lookup, parent_id $parent_id $(stripped_name) => $item_id"
if {$item_id > 0} {array set "" [list prefix ""]}
}
@@ -1108,11 +1163,11 @@
form $(form) parent_id $parent_id item_id $item_id ]
}
- Package instproc item_ref_from_id {
+ Package instproc item_info_from_id {
item_id
} {
#
- # Obtain (partial) item_ref data from id. It does not handle
+ # Obtain (partial) item info 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
@@ -1124,32 +1179,61 @@
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} {
+
+ Package instproc item_info_from_url {{-with_package_prefix true} {-default_lang ""} 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.
+ # Obtain item info (item_id parent_id lang stripped_name) from the
+ # specified url. 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.
+ # @parm with_package_prefix flag, if provided url contains package-url
+ # @return item ref data (parent_id lang stripped_name method)
#
- if {[string match /* $url]} {
+ if {$with_package_prefix && [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 ""]
+ if {$default_lang eq ""} {set default_lang [my default_language]}
+ my get_lang_and_name -default_lang $default_lang -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)]
+ #my msg "get_parent_and_name '$stripped_url' returns '$(stripped_name)'"
+
+ if {![regexp {^(download)/(.+)$} $(lang) _ (method) (lang)]} {
+ set (method) ""
+ # The lang value "tag" is used for allowing tag-urls without
+ # parameters, since several tag harvester assume such a syntax
+ # and don't process arguments. We rewrite in such cases simply
+ # the url and query parameters and update the connection
+ # context.
+ if {$(lang) eq "tag"} {
+ # todo: missing: tag links to subdirectories, also on url generation
+ set tag $stripped_url
+ set summary [::xo::cc query_parameter summary 0]
+ set popular [::xo::cc query_parameter popular 0]
+ set tag_kind [expr {$popular ? "ptag" :"tag"}]
+ set weblog_page [my get_parameter weblog_page]
+ my get_lang_and_name -default_lang $default_lang -path $weblog_page (lang) (stripped_name)
+ #set name $(lang):$(stripped_name)
+ my set object $weblog_page
+ ::xo::cc set actual_query $tag_kind=$tag&summary=$summary
}
}
- set (name) $(lang):$(stripped_name)
- set (item_id) [::xo::db::CrClass lookup -name $(name) -parent_id $(parent_id)]
+ array set "" [my prefixed_lookup -parent_id $(parent_id) \
+ -default_lang $default_lang -lang $(lang) -stripped_name $(stripped_name)]
+
+ if {$(item_id) == 0} {
+ # check link (todo should happen in package->lookup?)
+ ::xo::db::CrClass get_instance_from_db -item_id $(parent_id)
+ if {[$(parent_id) is_link_page] && [$(parent_id) is_folder_page]} {
+ set target [$(parent_id) get_page_from_link_page]
+ #$target set_resolve_context -package_id [my id] -parent_id $(parent_id)
+ #my msg "LINK prefixed LOOKUP from target-package [$target package_id] source package [my id]"
+ array set "" [[$target package_id] prefixed_lookup -parent_id [$target item_id] \
+ -default_lang $default_lang -lang $(lang) -stripped_name $(stripped_name)]
+ #my msg "-lang $(lang) -stripped_name $(stripped_name) => got=$(item_id)"
+ }
+ }
return [array get ""]
}
@@ -1170,21 +1254,32 @@
#
# @return page object or empty ("").
#
- #my msg "get_page_from_item_ref [self args]"
+ #my log "get_page_from_item_ref [self args]"
+
if {$allow_cross_package_item_refs && [string match //* $link]} {
+
+ # todo check: get_package_id_from_page_name uses a different lookup based on site nodes
+
set referenced_package_id [my resolve_package_path $link rest_link]
#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
- # which parent should pages be created
+ # which parent we would like to create newly importage pages.
+ #
+ # For now, we do not want to create pages this way, we pass
+ # the root folder of the referenced package as start
+ # parent_page for the search and turn off all page creation
+ # facilities.
+
+ #my log cross-package
return [$referenced_package_id get_page_from_item_ref \
-allow_cross_package_item_refs false \
- -use_package_path $use_package_path \
- -use_site_wide_pages $use_site_wide_pages \
- -use_prototype_pages $use_prototype_pages \
+ -use_package_path false \
+ -use_site_wide_pages false \
+ -use_prototype_pages false \
-default_lang $default_lang \
- -parent_id $parent_id \
+ -parent_id [$referenced_package_id folder_id] \
$rest_link]
} else {
# it is a link to the same package, we start search for page at top.
@@ -1195,20 +1290,23 @@
set search_parent_id $parent_id
}
+ #my log "my folder [my folder_id]"
+
if {$search_parent_id eq ""} {
set search_parent_id [my folder_id]
}
if {$parent_id eq ""} {
set parent_id [my folder_id]
}
+ #my log call-item_ref-on:$link-parent_id=$parent_id,search_parent_id=$search_parent_id
array set "" [my item_ref -normalize_name false \
-use_package_path $use_package_path \
-use_site_wide_pages $use_site_wide_pages \
-default_lang $default_lang \
-parent_id $search_parent_id \
$link]
- #my msg "item-ref for '$link' search parent $search_parent_id, parent $parent_id, returns\n[array get {}]"
+ #my log "[my instance_name] (root [my folder_id]) item-ref for '$link' search parent $search_parent_id, parent $parent_id, returns\n[array get {}]"
if {$(item_id)} {
set page [::xo::db::CrClass get_instance_from_db -item_id $(item_id)]
if {[$page package_id] ne [my id] || [$page parent_id] != $(parent_id)} {
@@ -1324,7 +1422,8 @@
} {
set parent_id -100
set package_id [::xowiki::Package first_instance]
- ::xowiki::Package initialize -package_id $package_id -init_url false -keep_cc true
+ ::xowiki::Package require $package_id
+ #::xowiki::Package initialize -package_id $package_id -init_url false -keep_cc true
set package_key "xowiki"
foreach n {folder.form link.form page.form import-archive.form} {
@@ -1370,95 +1469,6 @@
}
Package instforward check_permissions {%my set policy} %proc
- Package instproc resolve_request {{-default_lang ""} {-simple false} -path method_var} {
- my instvar folder_id
- #my log "--u [self args]"
- set item_id 0
- set parent_id $folder_id
-
- if {$path ne ""} {
- #
- # Try first a direct lookup of whatever we got
- #
- set item_id [::xo::db::CrClass lookup -name $path -parent_id $parent_id]
- if {$simple} {
- if {$item_id != 0} {
- return [::xo::db::CrClass get_instance_from_db -item_id $item_id]
- }
- return ""
- }
-
- #my log "--try $path ($folder_id/$parent_id) -> $item_id"
- if {$item_id == 0} {
- set nname [my normalize_name $path]
-
- my get_lang_and_name -default_lang $default_lang -path $nname lang stripped_name
- set name ${lang}:$stripped_name
- #my log "--setting name to '$name', lang=$lang, stripped_name='$stripped_name'"
-
- if {$lang eq "download/file" || $lang eq "file"} {
- # handle subitems, currently only for files
- set parent_id [my get_parent_and_name -lang $lang \
- -path $stripped_name -parent_id $folder_id \
- parent local_name]
- #my log "get_parent_and_name returned parent_id=$parent_id, name='$local_name'"
- set item_id [::xo::db::CrClass lookup -name file:$local_name -parent_id $parent_id]
- #my log "item_id for file:$local_name = $item_id"
- if {$item_id != 0 && $lang eq "download/file"} {
- upvar $method_var method
- set method download
- }
- } elseif {$lang eq "tag"} {
- set tag $stripped_name
- set summary [::xo::cc query_parameter summary 0]
- set popular [::xo::cc query_parameter popular 0]
- set tag_kind [expr {$popular ? "ptag" :"tag"}]
- set weblog_page [my get_parameter weblog_page]
- my get_lang_and_name -default_lang $default_lang -path $weblog_page lang stripped_name
- set name $lang:$stripped_name
- my set object $weblog_page
- ::xo::cc set actual_query $tag_kind=$tag&summary=$summary
- #my msg "weblog-page=$weblog_page, actual query=$tag_kind=$tag&summary=$summary"
- }
-
- if {$item_id == 0} {
- # in case we have a folder "foldername" and a page "foldername/...", the page has
- # higher priority.
- set item_id [::xo::db::CrClass lookup -name ${lang}:$stripped_name -parent_id $parent_id]
- #my log "default_lang=$lang, ${lang}:$stripped_name / $parent_id => $item_id\n"
- }
-
- if {$item_id == 0} {
- set parent_id [my get_parent_and_name -lang $lang \
- -path $stripped_name -parent_id $folder_id \
- parent local_name]
- #my log "get_parent_and_name returned parent=$parent, parent_id=$parent_id, deflang $lang name='$local_name'"
- my get_lang_and_name -default_lang $lang -path $local_name lang stripped_name
- set item_id [::xo::db::CrClass lookup -name ${lang}:$stripped_name -parent_id $parent_id]
- #my log "--try ${lang}:$stripped_name ($folder_id/$parent_id) -> $item_id"
- }
-
- if {$item_id == 0} {
- set item_id [::xo::db::CrClass lookup -name $stripped_name -parent_id $parent_id]
- #my log "--try $stripped_name ($folder_id/$parent_id) -> $item_id"
- }
-
- }
- }
-
- if {$item_id != 0} {
- set revision_id [my query_parameter revision_id 0]
- set [expr {$revision_id ? "item_id" : "revision_id"}] 0
- #my log "--instantiate item_id $item_id revision_id $revision_id"
- set r [::xo::db::CrClass get_instance_from_db -item_id $item_id -revision_id $revision_id]
- $r set package_id [namespace tail [self]]
- #my log "--instantiate done"
- return $r
- } else {
- return ""
- }
- }
-
Package ad_instproc require_root_folder {
{-parent_id -100}
{-content_types {}}
@@ -1475,10 +1485,8 @@
set folder_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]
if {$folder_id == 0} {
- my log "folder with name '$name' and parent $parent_id does NOT EXIST"
::xowiki::Package require_site_wide_pages
set form_id [::xowiki::Weblog instantiate_forms -forms en:folder.form -package_id $id]
-
set f [FormPage new -destroy_on_cleanup \
-name $name \
-text "" \
@@ -1932,7 +1940,7 @@
}
if {$item_id eq "" && $name ne ""} {
- array set "" [my item_ref_from_url $name]
+ array set "" [my item_info_from_url $name]
if {$(item_id) == 0} {
ns_log notice "lookup of '$name' with parent_id $parent_id failed"
} else {
Index: openacs-4/packages/xowiki/tcl/weblog-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/weblog-procs.tcl,v
diff -u -r1.54 -r1.55
--- openacs-4/packages/xowiki/tcl/weblog-procs.tcl 22 Jun 2010 07:35:48 -0000 1.54
+++ openacs-4/packages/xowiki/tcl/weblog-procs.tcl 12 Jul 2010 15:13:19 -0000 1.55
@@ -36,13 +36,13 @@
set folder_id [::$package_id folder_id]
set form_item_ids [list]
foreach t [split $forms |] {
- #my msg "trying to get $t"
+ #my log "trying to get $t // parent_id $parent_id"
set page [$package_id get_page_from_item_ref \
-use_prototype_pages true \
-use_package_path true \
-parent_id $parent_id \
$t]
- #my msg "weblog form $t => $page"
+ #my log "weblog form $t => $page"
if {$page ne ""} {
lappend form_item_ids [$page item_id]
}
@@ -133,8 +133,11 @@
-forms $entries_of \
-package_id $package_id]
}
-
- append extra_where_clause " and bt.page_template in ('[join $form_ids ',']') and bt.page_instance_id = bt.revision_id "
+ if {$form_ids ne ""} {
+ append extra_where_clause " and bt.page_template in ('[join $form_ids ',']') and bt.page_instance_id = bt.revision_id "
+ } else {
+ my msg "could not lookup forms $entries_of"
+ }
set base_type ::xowiki::FormPage
set base_table xowiki_form_pagei
append attributes ,bt.page_template,bt.state
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.418 -r1.419
--- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 9 Jul 2010 10:30:40 -0000 1.418
+++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 12 Jul 2010 15:13:19 -0000 1.419
@@ -881,14 +881,51 @@
#
# check certain properties of a page (is_* methods)
#
- Page instproc is_folder_page {} {
+ Page instproc is_folder_page {{-include_folder_links true}} {
+ #
+ # Check, if current page is a folder, or a link to a folder
+ #
#my msg "[my name] istype FormPage [my istype ::xowiki::FormPage]"
if {![my istype ::xowiki::FormPage]} {return 0}
- #my msg "[my name] has template page [my page_template] [[my page_template] name]"
- if {[[my page_template] name] eq "en:folder.form"} {return 1}
+ set page_template_name [[my page_template] name]
+ if {$page_template_name eq "en:folder.form"} {return 1}
+ if {$include_folder_links && $page_template_name eq "en:link.form"} {
+ set link [my property link]
+ #my msg link=$link
+ # we are called also by the validator, maybe before convert_to_internal....
+ if {$link eq "" || [llength $link] < 2} {return 0}
+ array set "" $link
+ return [expr {[info exists (link_type)] && $(link_type) eq "folder_link"}]
+ }
return 0
}
+ Page instproc get_page_from_link_page {} {
+ if {![my is_link_page]} {return ""}
+ set link [my property link]
+ if {$link eq "" || [llength $link] < 2} {return ""}
+ array set "" $link
+ if {$(item_id) == 0} {return ""}
+ set target [::xo::db::CrClass get_instance_from_db -item_id $(item_id)]
+ set target_package_id [$target package_id]
+ if {$target_package_id != [my package_id]} {
+ ::xowiki::Package require $target_package_id
+ #::xowiki::Package initialize -package_id $target_package_id -init_url false -keep_cc true
+ }
+ return $target
+ }
+
+ Page instproc is_link_page {} {
+ #
+ # Check, if current page is a link
+ #
+ #my msg "[my name] istype FormPage [my istype ::xowiki::FormPage]"
+ if {![my istype ::xowiki::FormPage]} {return 0}
+ set page_template_name [[my page_template] name]
+ if {$page_template_name eq "en:link.form"} {return 1}
+ return 0
+ }
+
Page instproc is_form {} {
return 0
}
@@ -953,7 +990,7 @@
#
# context handling
#
- Page instproc set_resolve_context {-package_id:required -parent_id:required} {
+ Page instproc set_resolve_context {-package_id:required -parent_id:required -item_id} {
if {[my set parent_id] != $parent_id} {
my set physical_parent_id [my set parent_id]
my set parent_id $parent_id
@@ -964,6 +1001,10 @@
#my msg "doing extra require on [my set physical_package_id]"
#::xowiki::Package require [my set physical_package_id]
}
+ if {[info exists item_id] && [my item_id] != $item_id} {
+ my set physical_item_id [my set item_id]
+ my set item_id $item_id
+ }
}
Page instproc physical_parent_id {} {
@@ -990,15 +1031,22 @@
set page [self]
while {1} {
if {[$page istype ::xowiki::FormPage]} {
- set page_template [$page page_template]
- # search the page_template in the list of form_ids
- if {[lsearch $folder_form_ids $page_template] > -1} {
- break
- } elseif {[$page_template name] eq "en:folder.form"} {
- # safety belt, in case we have in different directories
- # diffenent en:folder.form
- break
- }
+ if {[$page is_folder_page]} break
+
+# set page_template [$page page_template]
+# set page_template_name [$page_template name]
+# # search the page_template in the list of form_ids
+# if {[lsearch $folder_form_ids $page_template] > -1} {
+# break
+# } elseif {$page_template_name eq "en:folder.form"} {
+# # safety belt, in case we have in different directories
+# # diffenent en:folder.form
+# break
+# } elseif {$page_template_name eq "en:link.form"} {
+# set fp [my is_folder_page]
+# my msg fp=$fp
+# break
+# }
}
set page [::xo::db::CrClass get_instance_from_db -item_id [$page parent_id]]
}
@@ -1655,26 +1703,8 @@
return 1
}
- Page instproc references_add {references} {
- # TODO: make these persistent, maybe bypass reference to in link to classical references
- my instvar item_id
- foreach ref $references {
- foreach {r link_type} $ref break
- set already_recorded [db_0or1row [my qn [self proc]] "
- select * from xowiki_references
- where page = :item_id and reference = :r and link_type = :link_type"]
- my msg "check r=$r, link_type=$link_type => $already_recorded"
-
- if {!$already_recorded} {
- my msg "RECORD $r $link_type $item_id"
- db_dml [my qn insert_reference] \
- "insert into xowiki_references (reference, link_type, page) \
- values (:r,:link_type,:item_id)"
- }
- }
- }
-
Page instproc references_update {references} {
+ #my msg $references
my instvar item_id
db_dml [my qn delete_references] \
"delete from xowiki_references where page = :item_id"
@@ -2414,6 +2444,7 @@
}
return $result
}
+
PageInstance instproc adp_subst {content} {
# initialize template variables (in case, new variables are added to template)
array set __ia [my template_vars $content]
@@ -3122,7 +3153,6 @@
FormPage instproc get_value {{-field_spec ""} {-cr_field_spec ""} before varname} {
- #my msg "varname=$varname [my exists_property $varname]"
#
# Read a property (instance attribute) and return
# its pretty value in variable substitution.
@@ -3135,12 +3165,21 @@
} elseif {$varname eq "current_url"} {
set value [::xo::cc url]
} else {
- set value [my property $varname]
+ #
+ # First check to find an existing form-field with that name
+ #
+ set f [::xowiki::formfield::FormField get_from_name $varname]
+ if {$f ne ""} {
+ set value [$f value]
+ } else {
+ #
+ # create a form-field from scratch
+ #
+ set value [my property $varname]
+ set f [my create_form_field -cr_field_spec $cr_field_spec -field_spec $field_spec $varname]
+ $f value $value
+ }
- # todo: might be more efficient to check, if the field exists already
- set f [my create_form_field -cr_field_spec $cr_field_spec -field_spec $field_spec $varname]
- $f value $value
-
if {[$f hide_value]} {
set value ""
} elseif {![$f exists show_raw_value]} {
Index: openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl,v
diff -u -r1.282 -r1.283
--- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 2 Jul 2010 10:03:22 -0000 1.282
+++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 12 Jul 2010 15:13:19 -0000 1.283
@@ -661,10 +661,11 @@
my save_data \
-use_given_publish_date [expr {[lsearch $field_names _publish_date] > -1}] \
[::xo::cc form_parameter __object_name ""] $category_ids
-
- # The data might have references. We render do the rendering here
- # instead on every view (which would be safer, but slower). This is
+ #
+ # The data might have references. Perform the rendering here to compute
+ # the references instead on every view (which would be safer, but slower). This is
# roughly the counterpart to edit_data and save_data in ad_forms.
+ #
set content [my render -update_references true]
#my msg "after save refs=[expr {[my exists references]?[my set references] : {NONE}}]"
@@ -1666,11 +1667,12 @@
}
Page ad_instproc get_form_data {-field_names form_fields} {
- Get the values from the form and store it as
- instance attributes. If the field names are not specified,
- all form parameters are used.
+
+ Get the values from the form and store it in the form fields and
+ finally as instance attributes. If the field names are not
+ specified, all form parameters are used.
+
} {
- #my msg "get_form_data [self] [my name] [self args]"
set validation_errors 0
set category_ids [list]
array set containers [list]
Index: openacs-4/packages/xowiki/www/admin/portal-element-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/portal-element-add.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/xowiki/www/admin/portal-element-add.tcl 9 Apr 2008 10:57:48 -0000 1.9
+++ openacs-4/packages/xowiki/www/admin/portal-element-add.tcl 12 Jul 2010 15:13:19 -0000 1.10
@@ -12,9 +12,9 @@
{-referer .}
}
-set page_id [$package_id resolve_request -path $page_name method]
+set page [my get_page_from_item_ref $page_name]
-if {$page_id eq ""} {
+if {$page eq ""} {
#
# If a page with the given name does not exist, return an error.
#
@@ -26,7 +26,7 @@
#
# The page exists, get the title of the page...
#
- set page_title [$page_id title]
+ set page_title [$page title]
# for the time being, we add the portlet on the first page (page 0)
set portal_page_id [portal::get_page_id -portal_id $portal_id -sort_key 0]
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.27 -r1.28
--- openacs-4/packages/xowiki/www/admin/test.tcl 8 Jul 2010 12:10:18 -0000 1.27
+++ openacs-4/packages/xowiki/www/admin/test.tcl 12 Jul 2010 15:13:19 -0000 1.28
@@ -646,30 +646,45 @@
#
#
-# proc ? {cmd expected {msg ""}} {
-# ::xo::Timestamp t1
-# set r [uplevel $cmd]
-# if {$msg eq ""} {set msg $cmd}
-# if {$r ne $expected} {
-# regsub -all \# $r "" r
-# append ::_ "Error: $msg returned \n'$r' ne \n'$expected'\n"
-# } else {
-# append ::_ "$msg - passed ([t1 diff] ms)\n"
-# }
-# }
-
# "require_folder" and "require_page" are here just for testing
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 $name \
- -nls_language en_US \
- -default_variables [list title "Folder $name" parent_id $parent_id package_id $package_id]]
- $f save_new
- set item_id [$f item_id]
+ set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]
+
+ if {$item_id == 0} {
+ set form_id [::xowiki::Weblog instantiate_forms -forms en:folder.form -package_id $package_id]
+ set f [$form_id create_form_page_instance \
+ -name $name \
+ -nls_language en_US \
+ -default_variables [list title "Folder $name" parent_id $parent_id package_id $package_id]]
+ $f save_new
+ set item_id [$f item_id]
+ }
test hint " $name => $item_id\n"
return $item_id
}
+
+ proc require_link {name parent_id package_id target_id} {
+ set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]
+
+ if {$item_id == 0} {
+ set form_id [::xowiki::Weblog instantiate_forms -forms en:link.form -package_id $package_id]
+ set target [::xo::db::CrClass get_instance_from_db -item_id $target_id]
+
+ set link_type [expr {[$target is_folder_page] ? "folder_link" : "link"}]
+ set cross_package [expr {$package_id != [$target package_id]}]
+ set value [list item_ref [$target name] item_id $target_id link_type $link_type cross_package $cross_package]
+
+ set f [$form_id create_form_page_instance \
+ -name $name \
+ -nls_language en_US \
+ -instance_attributes [list link $value] \
+ -default_variables [list title "Link $name" parent_id $parent_id package_id $package_id]]
+ $f save_new
+ set item_id [$f item_id]
+ }
+ test hint " $name => $item_id\n"
+ return $item_id
+ }
proc require_page {name parent_id package_id {file_content ""}} {
set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]
if {$item_id == 0} {
@@ -686,6 +701,7 @@
}
$f save_new
set item_id [$f item_id]
+ $f destroy_on_cleanup
}
ns_log notice "Page $name => $item_id"
test hint " $name => $item_id\n"
@@ -702,49 +718,61 @@
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]
- set f3_id [require_folder "f3" $foldername_id $package_id]
+ set folder_id [$package_id folder_id]
+
+ # make sure, we have folder "f1" with subfolder "f3" with subfolder "subf3"
+ set f1_id [require_folder "f1" $folder_id $package_id]
+ set f3_id [require_folder "f3" $f1_id $package_id]
set subf3_id [require_folder "subf3" $f3_id $package_id]
# make sure, we have the test pages
- set indexpage_id [require_page en:index $folder_id $package_id]
set parentpage_id [require_page de:parentpage $folder_id $package_id]
- set testpage_id [require_page de:testpage $foldername_id $package_id]
+ set enpage_id [require_page en:page $folder_id $package_id]
+ set testpage_id [require_page de:testpage $f1_id $package_id]
+ set f3page_id [require_page en:page $f3_id $package_id]
set childfolder_id [require_folder "childfolder" $parentpage_id $package_id]
set childpage_id [require_page "de:childpage" $parentpage_id $package_id]
- set image_id [require_page file:image.png $folder_id $package_id \
- "iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAIAAACQd1PeAAAAAXNSR0IArs4c6QAAAAxJREFUCNdj\n+P//PwAF/gL+3MxZ5wAAAABJRU5ErkJggg=="]
+ set base64 "iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAIAAACQd1PeAAAAAXNSR0IArs4c6QAAAAxJREFUCNdj\n+P//PwAF/gL+3MxZ5wAAAABJRU5ErkJggg=="
+ set image_id [require_page file:image.png $folder_id $package_id $base64]
+ set subimage_id [require_page file:image2.png $f1_id $package_id $base64]
+ set childimage_id [require_page file:image3.png $parentpage_id $package_id $base64]
+ set pagelink_id [require_link de:link1 $folder_id $package_id $parentpage_id]
+ set folderlink_id [require_link de:link2 $folder_id $package_id $f1_id]
+ set subpagelink_id [require_link de:link3 $folder_id $package_id $testpage_id]
+ set subfolderlink_id [require_link de:link4 $folder_id $package_id $f3_id]
+ set subimagelink_id [require_link de:link5 $folder_id $package_id $subimage_id]
################################
+
+
test subsection "Toplevel Tests:"
- set l "folder:foldername"
+ set l "folder:f1"
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 "" && $(stripped_name) eq "foldername"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f1"
&& $(form) eq "en:folder.form"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
set l "de:parentpage"
set test [label "item_ref" "existing page in root_folder" $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"
&& $(parent_id) eq $folder_id && $(item_id) == $parentpage_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/"
+ set l "f1/"
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 "" && $(stripped_name) eq "foldername"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f1"
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername";# this works, since "foldername" exists
+ set l "f1";# this works, since "f1" 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 "" && $(stripped_name) eq "foldername"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f1"
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
set l "page1";# last item per default page
set test [label "item_ref" "not existing page short" $l]
@@ -815,17 +843,17 @@
? {expr {$(link_type) eq "link" && $(prefix) eq "de" && $(stripped_name) eq "parentpage"
&& $(parent_id) eq $folder_id && $(item_id) == $parentpage_id}} 1 "\n$test:\n [array get {}]\n "
- set l "./foldername/"
+ set l "./f1/"
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 "" && $(stripped_name) eq "foldername"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f1"
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
- set l "./foldername";# this works, since "foldername" exists
+ set l "./f1";# this works, since "f1" 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 "" && $(stripped_name) eq "foldername"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f1"
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
set l "./page1";# last item per default page
set test [label "item_ref" "not existing page short, relative" $l]
@@ -854,11 +882,11 @@
? {expr {$(link_type) eq "folder" && $(prefix) eq ""
&& $(parent_id) eq -100 && $(item_id) == $folder_id}} 1 "\n$test:\n [array get {}]\n "
- set l "./foldername/."
+ set l "./f1/."
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 "folder" && $(prefix) eq "" && $(stripped_name) eq "foldername"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "f1"
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
set l "./parentpage/."
set test [label "item_ref" "existing page short (without language prefix), relative" $l]
@@ -869,101 +897,101 @@
################################
test subsection "Under folder:"
- set l "folder:foldername/folder:f3"
+ set l "folder:f1/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 "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "folder:foldername/f3/"
+ set l "folder:f1/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 "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "./folder:foldername/folder:f3/"
+ set l "./folder:f1/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 "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/f3/"
+ set l "f1/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 "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "folder:foldername1/folder:f3"
+ set l "folder:f11/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 "" && $(stripped_name) eq "foldername1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f11"
&& $(parent_id) eq $folder_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername1/folder/"
+ set l "f11/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 "" && $(stripped_name) eq "foldername1"
+ ? {expr {$(link_type) eq "link" && $(prefix) eq "" && $(stripped_name) eq "f11"
&& $(parent_id) eq $folder_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/folder1/"
+ set l "f1/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 "" && $(stripped_name) eq "folder1"
- && $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/page1"
+ set l "f1/page1"
set test [label "item_ref" "existing folder with not existing page short short" $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 "page1"
- && $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "folder:foldername/folder:f3/folder:subf3"
+ set l "folder:f1/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 "" && $(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 l "f1/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 "" && $(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 l "f1/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 "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 l "folder:f1/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 "" && $(stripped_name) eq "f99"
- && $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "folder:foldername/de:testpage"
+ set l "folder:f1/de:testpage"
set test [label "item_ref" "existing page in folder" $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 "testpage"
- && $(parent_id) eq $foldername_id && $(item_id) == $testpage_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $testpage_id}} 1 "\n$test:\n [array get {}]\n "
- set l "folder:foldername/de:entry"
+ set l "folder:f1/de:entry"
set test [label "item_ref" "not existing page in folder" $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 "entry"
- && $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/image:image.png"
+ set l "f1/image:image.png"
set test [label "item_ref" "not existing image" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
? {expr {$(link_type) eq "image" && $(prefix) eq "file" && $(stripped_name) eq "image.png"
- && $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/image.png"
+ set l "f1/image.png"
set test [label "item_ref" "not existing image short" $l]
array set "" [p item_ref -default_lang de -parent_id $folder_id $l]
? {expr {$(link_type) eq "image" && $(prefix) eq "file" && $(stripped_name) eq "image.png"
- && $(parent_id) eq $foldername_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == 0}} 1 "\n$test:\n [array get {}]\n "
################################
test subsection "Under page:"
@@ -1019,29 +1047,29 @@
? {expr {$(link_type) eq "folder" && $(prefix) eq ""
&& $(parent_id) == -100 && $(item_id) == $folder_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/f3/subf3/.."
+ set l "f1/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 "folder" && $(prefix) eq "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/f3/subf3/../"
+ set l "f1/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 "folder" && $(prefix) eq "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/f3/subf3/../."
+ set l "f1/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 "folder" && $(prefix) eq "" && $(stripped_name) eq "f3"
- && $(parent_id) eq $foldername_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
+ && $(parent_id) eq $f1_id && $(item_id) == $f3_id}} 1 "\n$test:\n [array get {}]\n "
- set l "foldername/f3/subf3/../.."
+ set l "f1/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 "folder" && $(prefix) eq "" && $(stripped_name) eq "foldername"
- && $(parent_id) eq $folder_id && $(item_id) == $foldername_id}} 1 "\n$test:\n [array get {}]\n "
+ ? {expr {$(link_type) eq "folder" && $(prefix) eq "" && $(stripped_name) eq "f1"
+ && $(parent_id) eq $folder_id && $(item_id) == $f1_id}} 1 "\n$test:\n [array get {}]\n "
set l "parentpage/childpage/.."
set test [label "item_ref" "existing page und page dot dot" $l]
@@ -1084,7 +1112,248 @@
? {$link render} {} "\n$test\n "
? {p array get lang_links} [subst -nocommands {found {{
}}}] "\n$test links\n "
+############################################
+ test section "page properties"
+
+ set f1 [::xo::db::CrClass get_instance_from_db -item_id $f1_id]
+ set f2 [::xo::db::CrClass get_instance_from_db -item_id $f3_id]
+ set f3 [::xo::db::CrClass get_instance_from_db -item_id $subf3_id]
+
+ set p1 [::xo::db::CrClass get_instance_from_db -item_id $parentpage_id]
+ set p2 [::xo::db::CrClass get_instance_from_db -item_id $testpage_id]
+ set p3 [::xo::db::CrClass get_instance_from_db -item_id $childpage_id]
+ set p4 [::xo::db::CrClass get_instance_from_db -item_id $enpage_id]
+ set p5 [::xo::db::CrClass get_instance_from_db -item_id $f3page_id]
+
+ set i1 [::xo::db::CrClass get_instance_from_db -item_id $image_id]
+ set i2 [::xo::db::CrClass get_instance_from_db -item_id $subimage_id]
+ set i3 [::xo::db::CrClass get_instance_from_db -item_id $childimage_id]
+
+ set l1 [::xo::db::CrClass get_instance_from_db -item_id $pagelink_id]
+ set l2 [::xo::db::CrClass get_instance_from_db -item_id $folderlink_id]
+ set l3 [::xo::db::CrClass get_instance_from_db -item_id $subpagelink_id]
+ set l4 [::xo::db::CrClass get_instance_from_db -item_id $subfolderlink_id]
+ set l5 [::xo::db::CrClass get_instance_from_db -item_id $subimagelink_id]
+
+
+
+ ? {$f1 is_folder_page} 1
+ ? {$f2 is_folder_page} 1
+ ? {$f3 is_folder_page} 1
+
+ ? {$p1 is_folder_page} 0
+
+ ? {$l1 is_folder_page} 0
+ ? {$l2 is_folder_page} 1
+ ? {$l3 is_folder_page} 0
+ ? {$l4 is_folder_page} 1
+ ? {$l5 is_folder_page} 0
+
+
+
+ test section "pretty links"
+
+ ? {$f1 pretty_link} "/XOWIKI-TEST/f1"
+ ? {$f2 pretty_link} "/XOWIKI-TEST/f1/f3"
+ ? {$f3 pretty_link} "/XOWIKI-TEST/f1/f3/subf3"
+
+ ? {$p1 pretty_link} "/XOWIKI-TEST/de/parentpage"
+ ? {$p2 pretty_link} "/XOWIKI-TEST/de/f1/testpage"
+ ? {$p3 pretty_link} "/XOWIKI-TEST/de/de:parentpage/childpage"
+ ? {$p4 pretty_link} "/XOWIKI-TEST/page"
+ ? {$p5 pretty_link} "/XOWIKI-TEST/f1/f3/page"
+
+ ? {$i1 pretty_link} "/XOWIKI-TEST/file/image.png"
+ ? {$i2 pretty_link} "/XOWIKI-TEST/file/f1/image2.png"
+ ? {$i3 pretty_link} "/XOWIKI-TEST/file/de:parentpage/image3.png"
+
+ ? {$l1 pretty_link} "/XOWIKI-TEST/de/link1"
+ ? {$l2 pretty_link} "/XOWIKI-TEST/de/link2"
+ ? {$l3 pretty_link} "/XOWIKI-TEST/de/link3"
+ ? {$l4 pretty_link} "/XOWIKI-TEST/de/link4"
+ ? {$l5 pretty_link} "/XOWIKI-TEST/de/link5"
+
+ test section "item info from pretty links"
+
+ set l [$f1 pretty_link]
+ set test [label "url" "topfolder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $f1_id && $(stripped_name) eq "f1"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$f2 pretty_link]
+ set test [label "url" "folder under topfolder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $f3_id && $(stripped_name) eq "f3"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$f3 pretty_link]
+ set test [label "url" "subsubfolder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $subf3_id && $(stripped_name) eq "subf3"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$p1 pretty_link]
+ set test [label "url" "toppage" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $parentpage_id && $(stripped_name) eq "parentpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$p2 pretty_link]
+ set test [label "url" "page in folder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $testpage_id && $(stripped_name) eq "testpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$p3 pretty_link]
+ set test [label "url" "page under page" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $childpage_id && $(stripped_name) eq "childpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$p4 pretty_link]
+ set test [label "url" "toplevel en page" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $enpage_id && $(stripped_name) eq "page"
+ && $(name) eq "en:page"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$p5 pretty_link]
+ set test [label "url" "en page under subfolder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $f3page_id && $(stripped_name) eq "page"
+ && $(name) eq "en:page"}} 1 "\n$test:\n [array get {}]\n "
+
+ # image links
+
+ set l [$i1 pretty_link]
+ set test [label "url" "toplevel image" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $image_id && $(stripped_name) eq "image.png"
+ && $(name) eq "file:image.png"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$i2 pretty_link]
+ set test [label "url" "toplevel image" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $subimage_id && $(stripped_name) eq "image2.png"
+ && $(name) eq "file:image2.png"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$i3 pretty_link]
+ set test [label "url" "toplevel image" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $childimage_id && $(stripped_name) eq "image3.png"
+ && $(name) eq "file:image3.png" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n "
+
+
+ # links
+
+ set l [$l1 pretty_link]
+ set test [label "url" "toplevel link to page" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $pagelink_id && $(stripped_name) eq "link1"
+ && $(name) eq "de:link1" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$l2 pretty_link]
+ set test [label "url" "toplevel link to folder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $folderlink_id && $(stripped_name) eq "link2"
+ && $(name) eq "de:link2" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$l3 pretty_link]
+ set test [label "url" "toplevel link to page under folder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $subpagelink_id && $(stripped_name) eq "link3"
+ && $(name) eq "de:link3" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$l4 pretty_link]
+ set test [label "url" "toplevel link to folder under folder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $subfolderlink_id && $(stripped_name) eq "link4"
+ && $(name) eq "de:link4" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n "
+
+ set l [$l5 pretty_link]
+ set test [label "url" "toplevel link to image under folder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $subimagelink_id && $(stripped_name) eq "link5"
+ && $(name) eq "de:link5" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n "
+
+
+ test section "item info from variations of pretty links"
+
+ # download
+ set l /XOWIKI-TEST/download/file/image.png
+ set test [label "url" "toplevel image download" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $image_id && $(stripped_name) eq "image.png"
+ && $(name) eq "file:image.png" && $(method) eq "download"}} 1 "\n$test:\n [array get {}]\n "
+
+ # download via link
+ set l /XOWIKI-TEST/download/de/link5
+ set test [label "url" "toplevel image download" $l]
+ array set "" [$package_id item_info_from_url -default_lang de $l]
+ ? {expr {$(item_id) == $subimagelink_id && $(stripped_name) eq "link5"
+ && $(name) eq "de:link5" && $(method) eq "download"}} 1 "\n$test:\n [array get {}]\n "
+
+ # tag link
+ set l /XOWIKI-TEST/tag/a
+ set test [label "url" "tag query" $l]
+ array set "" [$package_id item_info_from_url -default_lang de $l]
+ ? {expr {$(item_id) != 0 && $(stripped_name) eq "weblog"
+ && $(name) eq "en:weblog" && $(method) eq ""}} 1 "\n$test:\n [array get {}]\n"
+ # missing: tag links to subdirectories
+
+ # url without default lang
+ set l /XOWIKI-TEST/parentpage
+ set test [label "url" "toppage w/o de" $l]
+ array set "" [$package_id item_info_from_url -default_lang de $l]
+ ? {expr {$(item_id) == $parentpage_id && $(stripped_name) eq "parentpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ # prefixed name
+ set l /XOWIKI-TEST/de:parentpage
+ set test [label "url" "toppage prefixed eq default_lang" $l]
+ array set "" [$package_id item_info_from_url -default_lang de $l]
+ ? {expr {$(item_id) == $parentpage_id && $(stripped_name) eq "parentpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l /XOWIKI-TEST/de:parentpage
+ set test [label "url" "toppage prefixed ne default_lang" $l]
+ array set "" [$package_id item_info_from_url -default_lang en $l]
+ ? {expr {$(item_id) == $parentpage_id && $(stripped_name) eq "parentpage"}} 1 "\n$test:\n [array get {}]\n "
+
+
+ test section "item info via links to folders"
+ # reference pages over links to folders
+
+ set l /XOWIKI-TEST/de:link2/testpage
+ set test [label "url" "reference page over links to folder default-lang" $l]
+ array set "" [$package_id item_info_from_url -default_lang de $l]
+ ? {expr {$(item_id) == $testpage_id && $(stripped_name) eq "testpage"
+ && $(name) eq "de:testpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l /XOWIKI-TEST/de:link2/de:testpage
+ set test [label "url" "reference page over links to folder direct name" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $testpage_id && $(stripped_name) eq "testpage"
+ && $(name) eq "de:testpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l /XOWIKI-TEST/download/file/de:link2/image2.png
+ set test [label "url" "reference download image over links to folder" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $subimage_id && $(stripped_name) eq "image2.png"
+ && $(name) eq "file:image2.png"}} 1 "\n$test:\n [array get {}]\n "
+
+ set l /XOWIKI-TEST/de:link2/f3/page
+ set test [label "url" "path contains link and references finally page" $l]
+ array set "" [$package_id item_info_from_url $l]
+ ? {expr {$(item_id) == $f3page_id && $(stripped_name) eq "page"
+ && $(name) eq "en:page"}} 1 "\n$test:\n [array get {}]\n "
+
+
+ #test section "inherited pages"
+
+ # link to site-wide page
+
+ #set l /XOWIKI-TEST/en/folder.form
+ #set test [label "url" "site-wide-page top" $l]
+ #array set "" [$package_id item_info_from_url -default_lang de $l]
+ #? {expr {$(item_id) == $parentpage_id && $(stripped_name) eq "parentpage"}} 1 "\n$test:\n [array get {}]\n "
+
+ # link to page in other package
+ # link to dir in other package
+
ns_write "
Tests passed: [test set passed]
Index: openacs-4/packages/xowiki/www/prototypes/news.page
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/news.page,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/xowiki/www/prototypes/news.page 17 Jun 2010 10:41:42 -0000 1.16
+++ openacs-4/packages/xowiki/www/prototypes/news.page 12 Jul 2010 15:13:23 -0000 1.17
@@ -102,7 +102,7 @@
#
# If the user has creation rights (on the first form), include the RSS Bookmarklet button
#
- if {[my exists form_ids]} {
+ if {[my exists form_ids] && [my set form_ids] ne ""} {
set can_create_news_item [$package_id make_link [lindex [my set form_ids] 0] create-new return_url]
if {$can_create_news_item ne ""} {
append rss "Bookmarklet: " [$page include "bookmarklet-button -label {[$page title]}"]